diff --git a/Utilities/ITK/Utilities/MetaIO/CMakeLists.txt b/Utilities/ITK/Utilities/MetaIO/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..b26ced9174f8d61e38415147ba1ff9aa959f27df
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/CMakeLists.txt
@@ -0,0 +1,31 @@
+ADD_LIBRARY(ITKMetaIO
+ metaArrow.cxx
+ metaBlob.cxx
+ metaCommand.h
+ metaCommand.cxx
+ metaDTITube.cxx
+ metaEllipse.cxx
+ metaGroup.cxx
+ metaGaussian.cxx
+ metaImage.cxx
+ metaImageUtils.cxx
+ metaLandmark.cxx
+ metaLine.cxx
+ metaMesh.cxx
+ metaMesh.h
+ metaObject.cxx
+ metaScene.cxx
+ metaSurface.cxx
+ metaTube.cxx
+ metaTypes.h
+ metaUtils.cxx
+ metaVesselTube.cxx
+ metaTransform.cxx
+ metaTubeGraph.cxx
+)
+
+#SUBDIRS(tests)
+
+INSTALL_TARGETS(/lib/InsightToolkit ITKMetaIO)
+INSTALL_FILES(/include/InsightToolkit/Utilities/MetaIO "(\\.h)$")
+TARGET_LINK_LIBRARIES(ITKMetaIO ${ITK_ZLIB_LIBRARIES})
diff --git a/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.doc b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.doc
new file mode 100644
index 0000000000000000000000000000000000000000..b12521756cedd8c71da7fa059ce6121c79eebd60
Binary files /dev/null and b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.doc differ
diff --git a/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.pdf b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.pdf
new file mode 100644
index 0000000000000000000000000000000000000000..082221b1badc7ffa37ff7190e4e71d7f8993d46e
Binary files /dev/null and b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-Introduction.pdf differ
diff --git a/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-MetaCommand.doc b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-MetaCommand.doc
new file mode 100644
index 0000000000000000000000000000000000000000..d71494d9a21250a4076a247e0085c916955f99a9
Binary files /dev/null and b/Utilities/ITK/Utilities/MetaIO/doc/MetaIO-MetaCommand.doc differ
diff --git a/Utilities/ITK/Utilities/MetaIO/metaArrow.cxx b/Utilities/ITK/Utilities/MetaIO/metaArrow.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fa87acb1b71b6b7c8eec9d384a0be94a62d511a3
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaArrow.cxx
@@ -0,0 +1,154 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaArrow.h>
+
+//
+// Constructors
+//
+MetaArrow::
+MetaArrow()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaArrow()" << std::endl;
+ Clear();
+}
+
+//
+MetaArrow::
+MetaArrow(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaArrow()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaArrow::
+MetaArrow(const MetaArrow *_Arrow)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaArrow()" << std::endl;
+ Clear();
+ CopyInfo(_Arrow);
+}
+
+MetaArrow::
+MetaArrow(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaArrow()" << std::endl;
+ Clear();
+}
+
+//
+MetaArrow::
+~MetaArrow()
+{
+ M_Destroy();
+}
+
+//
+void MetaArrow::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "Length = " << M_Length << std::endl;
+}
+
+void MetaArrow::
+CopyInfo(const MetaArrow * _Arrow)
+{
+ MetaObject::CopyInfo(_Arrow);
+ M_Length = _Arrow->Length();
+}
+
+
+void MetaArrow::
+Length(float length)
+{
+ M_Length = length;
+}
+
+float MetaArrow::
+Length(void) const
+{
+ return M_Length;
+}
+
+/** Clear Arrow information */
+void MetaArrow::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaArrow: Clear" << std::endl;
+ MetaObject::Clear();
+ M_Length = 1;
+}
+
+/** Destroy Arrow information */
+void MetaArrow::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaArrow::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaArrow: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Length", MET_FLOAT, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+}
+
+void MetaArrow::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Arrow");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Length", MET_FLOAT, M_Length);
+ m_Fields.push_back(mF);
+}
+
+
+bool MetaArrow::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaArrow: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaArrow: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaArrow: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("Length", &m_Fields);
+ if(mF->defined)
+ {
+ M_Length= (float)mF->value[0];
+ }
+
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaArrow.h b/Utilities/ITK/Utilities/MetaIO/metaArrow.h
new file mode 100644
index 0000000000000000000000000000000000000000..9f93ec379d0200a74d8a78b287e47c27a9c92373
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaArrow.h
@@ -0,0 +1,84 @@
+#ifndef METAArrow_H
+#define METAArrow_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaArrow (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaArrowFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date Jan 05, 2005
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaObject.h
+ */
+
+
+class MetaArrow : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaArrow(void);
+
+ MetaArrow(const char *_headerName);
+
+ MetaArrow(const MetaArrow *_Arrow);
+
+ MetaArrow(unsigned int dim);
+
+ ~MetaArrow(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaArrow * _Arrow);
+
+ void Clear(void);
+
+ void Length(float length);
+ float Length(void) const;
+
+ void Lenght(float length) {this->Length(length);}
+ float Lenght(void) const {return Length();}
+
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ float M_Length; // default 1.0
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaBlob.cxx b/Utilities/ITK/Utilities/MetaIO/metaBlob.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f31122c6864e7c12b5a3123e7d47d4dbd650a31f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaBlob.cxx
@@ -0,0 +1,431 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaBlob.h>
+
+//
+// MedImage Constructors
+//
+MetaBlob::
+MetaBlob()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaBlob()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+}
+
+//
+MetaBlob::
+MetaBlob(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaBlob()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaBlob::
+MetaBlob(const MetaBlob *_blob)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaBlob()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+ CopyInfo(_blob);
+}
+
+
+
+//
+MetaBlob::
+MetaBlob(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaBlob()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+}
+
+//
+MetaBlob::
+~MetaBlob()
+{
+ Clear();
+ M_Destroy();
+}
+
+//
+void MetaBlob::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaBlob::
+CopyInfo(const MetaBlob * _blob)
+{
+ MetaObject::CopyInfo(_blob);
+}
+
+
+
+void MetaBlob::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaBlob::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaBlob::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaBlob::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+
+/** Clear blob information */
+void MetaBlob::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaBlob: Clear" << std::endl;
+ MetaObject::Clear();
+ if(META_DEBUG) std::cout << "MetaBlob: Clear: m_NPoints" << std::endl;
+ // Delete the list of pointers to blobs.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ BlobPnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ m_NPoints = 0;
+ strcpy(m_PointDim, "x y z red green blue alpha");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy blob information */
+void MetaBlob::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaBlob::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaBlob: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+MET_ValueEnumType MetaBlob::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaBlob::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+
+void MetaBlob::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Blob");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ char s[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_ElementType, s);
+ MET_InitWriteField(mF, "ElementType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+
+
+bool MetaBlob::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaBlob: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaBlob: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaBlob: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_ElementType);
+ }
+
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+ int* posDim= new int[m_NDims];
+ int i;
+ for(i= 0; i < m_NDims; i++)
+ {
+ posDim[i] = -1;
+ }
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+
+ int j;
+ for(j = 0; j < pntDim; j++)
+ {
+ if(!strcmp(pntVal[j], "x") || !strcmp(pntVal[j], "X"))
+ {
+ posDim[0] = j;
+ }
+ if(!strcmp(pntVal[j], "y") || !strcmp(pntVal[j], "Y"))
+ {
+ posDim[1] = j;
+ }
+ if(!strcmp(pntVal[j], "z") || !strcmp(pntVal[j], "Z"))
+ {
+ posDim[2] = j;
+ }
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+
+ delete [] pntVal;
+
+ float v[16];
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims+4)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaBlob: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ int d;
+ double td;
+ for(j=0; j<m_NPoints; j++)
+ {
+ BlobPnt* pnt = new BlobPnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ BlobPnt* pnt = new BlobPnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ int d;
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[posDim[d]];
+ }
+
+ for(d=0; d<4; d++)
+ {
+ pnt->m_Color[d] = v[d+m_NDims];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+ if(m_NPoints>0)
+ {
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+ }
+
+ delete [] posDim;
+ return true;
+}
+
+
+bool MetaBlob::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaBlob: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims+4)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ for(d = 0; d < 4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+ it++;
+ }
+ m_WriteStream->write((char *)data,(m_NDims+4)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ for(d = 0; d < 4; d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+
+ return true;
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaBlob.h b/Utilities/ITK/Utilities/MetaIO/metaBlob.h
new file mode 100644
index 0000000000000000000000000000000000000000..63d5aa99984e50212a21778fbaef2d50c6ae4c45
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaBlob.h
@@ -0,0 +1,137 @@
+#ifndef METABLOB_H
+#define METABLOB_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaBlob (.h and .cxx)
+ *
+ * Description:
+ * Reads and Writes MetaBlobFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date July 02, 2002
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaFileLib.h
+ */
+
+class BlobPnt
+{
+public:
+
+ BlobPnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ }
+
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ }
+ ~BlobPnt()
+ {
+ delete []m_X;
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ float m_Color[4];
+};
+
+
+
+
+class MetaBlob : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<BlobPnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaBlob(void);
+
+ MetaBlob(const char *_headerName);
+
+ MetaBlob(const MetaBlob *_blob);
+
+ MetaBlob(unsigned int dim);
+
+ ~MetaBlob(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaBlob * _blob);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the blob
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ MET_ValueEnumType m_ElementType;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaCommand.cxx b/Utilities/ITK/Utilities/MetaIO/metaCommand.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..86c9b2e4e2cfa25b7ea96468a50c3efc3100a44e
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaCommand.cxx
@@ -0,0 +1,1160 @@
+/*=========================================================================
+
+ Program: Insight Segmentation & Registration Toolkit
+ Module: $RCSfile: metaCommand.cxx,v $
+ Language: C++
+ Date: $Date: 2006/01/01 17:31:45 $
+ Version: $Revision: 1.13 $
+
+ Copyright (c) 2002 Insight Consortium. All rights reserved.
+ See ITKCopyright.txt or http://www.itk.org/HTML/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "metaCommand.h"
+#include <stdio.h>
+#include <string>
+
+MetaCommand::MetaCommand()
+{
+ m_HelpCallBack = NULL;
+ m_OptionVector.clear();
+ m_Version = "Not defined";
+ m_Date = "Not defined";
+ m_ParsedOptionVector.clear();
+}
+
+
+/** Extract the date from the $Date: 2006/01/01 17:31:45 $ cvs command */
+std::string MetaCommand::ExtractDateFromCVS(std::string date)
+{
+ std::string newdate;
+ for(int i=7;i<(int)date.size()-1;i++)
+ {
+ newdate += date[i];
+ }
+ return newdate.c_str();
+}
+
+
+/** */
+bool MetaCommand::SetOption(Option option)
+{
+ // need to add some tests here to check if the option is not defined yet
+ m_OptionVector.push_back(option);
+ return true;
+}
+
+bool MetaCommand::SetOption(std::string name,
+ std::string tag,
+ bool required,
+ std::string description,
+ std::vector<Field> fields)
+{
+ // need to add some tests here to check if the option is not defined yet
+ if(tag == "")
+ {
+ std::cout << "Tag cannot be empty : use AddField() instead." << std::endl;
+ return false;
+ }
+
+ Option option;
+ option.name = name;
+ option.tag = tag;
+ option.fields = fields;
+ option.required = required;
+ option.description = description;
+ option.userDefined = false;
+ option.complete = false;
+
+ m_OptionVector.push_back(option);
+ return true;
+}
+
+
+bool MetaCommand::SetOption(std::string name,
+ std::string tag,
+ bool required,
+ std::string description,
+ TypeEnumType type,
+ std::string defVal)
+{
+ // need to add some tests here to check if the option is not defined yet
+ if(tag == "")
+ {
+ std::cout << "Tag cannot be empty : use AddField() instead." << std::endl;
+ return false;
+ }
+
+ Option option;
+ option.tag = tag;
+ option.name = name;
+ option.required = required;
+ option.description = description;
+ option.userDefined = false;
+ option.complete = false;
+
+ // Create a field without description as a flag
+ Field field;
+ field.name = name;
+ field.externaldata = false;
+ field.type = type;
+ field.value = defVal;
+ field.userDefined = false;
+ field.required = true;
+ option.fields.push_back(field);
+
+ m_OptionVector.push_back(option);
+ return true;
+}
+
+
+/** Add a field */
+bool MetaCommand::AddField(std::string name,
+ std::string description,
+ TypeEnumType type,
+ bool externalData)
+{
+ // need to add some tests here to check if the option is not defined yet
+ Option option;
+ option.tag = "";
+
+ // Create a field without description with the specified type
+ Field field;
+ field.name = name;
+ field.type = type;
+ field.required = true;
+ field.userDefined = false;
+ field.externaldata = externalData;
+ option.fields.push_back(field);
+
+ option.required = true;
+ option.name = name;
+ option.description = description;
+ option.userDefined = false;
+ option.complete = false;
+
+ m_OptionVector.push_back(option);
+ return true;
+}
+
+
+/** Collect all the information until the next tag
+ * \warning this function works only if the field is of type String */
+void MetaCommand::SetOptionComplete(std::string optionName,
+ bool complete)
+{
+ OptionVector::iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ (*it).complete = complete;
+ return;
+ }
+ it++;
+ }
+ }
+
+/** Add a field to a given an option */
+bool MetaCommand::AddOptionField(std::string optionName,
+ std::string name,
+ TypeEnumType type,
+ bool required,
+ std::string defVal,
+ std::string description)
+{
+ OptionVector::iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ // Create a field without description with the specified type
+ Field field;
+ field.name = name;
+ field.type = type;
+ field.required = required;
+ field.value = defVal;
+ field.description = description;
+ field.userDefined = false;
+ field.externaldata = false;
+
+ // If this is the first field in the list we replace the current field
+ if((*it).fields[0].type == FLAG)
+ {
+ (*it).fields[0] = field;
+ }
+ else
+ {
+ (*it).fields.push_back(field);
+ }
+ return true;
+ }
+ it++;
+ }
+ return false;
+}
+
+/** Return the value of the option as a boolean */
+bool MetaCommand::GetValueAsBool(std::string optionName,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = optionName;
+ }
+
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ if((*itField).value == "true"
+ || (*itField).value == "1"
+ || (*itField).value == "True"
+ || (*itField).value == "TRUE"
+ )
+ {
+ return true;
+ }
+ return false;
+ }
+ itField++;
+ }
+ }
+ it++;
+ }
+ return false;
+}
+
+
+/** Return the value of the option as a bool */
+bool MetaCommand::GetValueAsBool(Option option,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = option.name;
+ }
+
+ std::vector<Field>::const_iterator itField = option.fields.begin();
+ while(itField != option.fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ if((*itField).value == "true"
+ || (*itField).value == "1"
+ || (*itField).value == "True"
+ || (*itField).value == "TRUE"
+ )
+ {
+ return true;
+ }
+ return false;
+ }
+ itField++;
+ }
+ return 0;
+}
+
+/** Return the value of the option as a float */
+float MetaCommand::GetValueAsFloat(std::string optionName,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = optionName;
+ }
+
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return (float)atof((*itField).value.c_str());
+ }
+ itField++;
+ }
+ }
+ it++;
+ }
+ return 0;
+}
+
+/** Return the value of the option as a float */
+float MetaCommand::GetValueAsFloat(Option option,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = option.name;
+ }
+
+ std::vector<Field>::const_iterator itField = option.fields.begin();
+ while(itField != option.fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return (float)atof((*itField).value.c_str());
+ }
+ itField++;
+ }
+ return 0;
+}
+
+/** Return the value of the option as a int */
+int MetaCommand::GetValueAsInt(std::string optionName,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = optionName;
+ }
+
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return atoi((*itField).value.c_str());
+ }
+ itField++;
+ }
+ }
+ it++;
+ }
+ return 0;
+}
+
+/** Return the value of the option as a int */
+int MetaCommand::GetValueAsInt(Option option,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = option.name;
+ }
+
+ std::vector<Field>::const_iterator itField = option.fields.begin();
+ while(itField != option.fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return atoi((*itField).value.c_str());
+ }
+ itField++;
+ }
+ return 0;
+}
+
+
+
+/** Return the value of the option as a string */
+std::string MetaCommand::GetValueAsString(std::string optionName,
+ std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = optionName;
+ }
+
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return (*itField).value;
+ }
+ itField++;
+ }
+ }
+ it++;
+ }
+ return "";
+}
+
+/** Return the value of the option as a string */
+std::string MetaCommand::GetValueAsString(Option option,std::string fieldName)
+{
+ std::string fieldname = fieldName;
+ if(fieldName == "")
+ {
+ fieldname = option.name;
+ }
+
+ std::vector<Field>::const_iterator itField = option.fields.begin();
+ while(itField != option.fields.end())
+ {
+ if((*itField).name == fieldname)
+ {
+ return (*itField).value;
+ }
+ itField++;
+ }
+ return "";
+}
+
+/** Return the value of the option as a list of strings */
+std::list<std::string> MetaCommand::
+GetValueAsList( Option option )
+{
+ std::list<std::string> results;
+ results.clear();
+ std::vector<Field>::const_iterator itField = option.fields.begin();
+ itField++;
+ while(itField != option.fields.end())
+ {
+ results.push_back((*itField).value);
+ itField++;
+ }
+ return results;
+}
+
+std::list< std::string > MetaCommand::
+GetValueAsList( std::string optionName )
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ return this->GetValueAsList( *it );
+ }
+ it++;
+ }
+ std::list< std::string > empty;
+ empty.clear();
+ return empty;
+}
+
+bool MetaCommand::
+GetOptionWasSet(Option option)
+{
+ if(option.userDefined)
+ {
+ return true;
+ }
+ return false;
+}
+
+bool MetaCommand::
+GetOptionWasSet( std::string optionName)
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).name == optionName)
+ {
+ return this->GetOptionWasSet(*it);
+ }
+ it++;
+ }
+ return false;
+}
+
+/** List the current options */
+void MetaCommand::ListOptions()
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ int i=0;
+ while(it != m_OptionVector.end())
+ {
+ std::cout << "Option #" << i << std::endl;
+ std::cout << " Name: " << (*it).name.c_str() << std::endl;
+ if((*it).tag.size() > 0)
+ {
+ std::cout << " Tag: " << (*it).tag.c_str() << std::endl;
+ }
+ std::cout << " Description: " << (*it).description.c_str() << std::endl;
+ if((*it).required)
+ {
+ std::cout << " Required: true" << std::endl;
+ }
+ else
+ {
+ std::cout << " Required: false" << std::endl;
+ }
+ std::cout << " Number of expeted values: " << (*it).fields.size()
+ << std::endl;
+
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ std::cout << " Field Name: " << (*itField).name.c_str()
+ << std::endl;
+ std::cout << " Description: " << (*itField).description.c_str()
+ << std::endl;
+ std::cout << " Type: " << this->TypeToString((*itField).type).c_str()
+ << std::endl;
+ std::cout << " Value: " << (*itField).value.c_str() << std::endl;
+
+ if((*itField).externaldata)
+ {
+ std::cout << " External Data: true" << std::endl;
+ }
+ else
+ {
+ std::cout << " External Data: false" << std::endl;
+ }
+
+ if((*itField).required)
+ {
+ std::cout << " Required: true" << std::endl;
+ }
+ else
+ {
+ std::cout << " Required: false" << std::endl;
+ }
+ itField++;
+ }
+ std::cout << std::endl;
+ i++;
+ it++;
+ }
+ if(m_HelpCallBack != NULL)
+ {
+ m_HelpCallBack();
+ }
+}
+
+/** List the current options in xml format */
+void MetaCommand::ListOptionsXML()
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ int i=0;
+ while(it != m_OptionVector.end())
+ {
+ std::cout << "<option>" << std::endl;
+ std::cout << "<number>" << i << "</number>" << std::endl;
+ std::cout << "<name>" << (*it).name.c_str() << "</name>" << std::endl;
+ std::cout << "<tag>" << (*it).tag.c_str() << "</tag>" << std::endl;
+ std::cout << "<description>" << (*it).description.c_str()
+ << "</description>" << std::endl;
+ std::cout << "<required>";
+ if((*it).required)
+ {
+ std::cout << "1</required>" << std::endl;
+ }
+ else
+ {
+ std::cout << "0</required>" << std::endl;
+ }
+
+ std::cout << "<nvalues>" << (*it).fields.size() << "</nvalues>" << std::endl;
+
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ std::cout << "<field>" << std::endl;
+ std::cout << "<name>" << (*itField).name.c_str() << "</name>" << std::endl;
+ std::cout << "<description>" << (*itField).description.c_str()
+ << "</description>" << std::endl;
+ std::cout << "<type>" << this->TypeToString((*itField).type).c_str()
+ << "</type>" << std::endl;
+ std::cout << "<value>" << (*itField).value.c_str() << "</value>"
+ << std::endl;
+ std::cout << "<external>";
+ if((*itField).externaldata)
+ {
+ std::cout << "1</external>" << std::endl;
+ }
+ else
+ {
+ std::cout << "0</external>" << std::endl;
+ }
+ std::cout << "<required>";
+ if((*itField).required)
+ {
+ std::cout << "1</required>" << std::endl;
+ }
+ else
+ {
+ std::cout << "0</required>" << std::endl;
+ }
+
+
+ std::cout << "</field>" << std::endl;
+ itField++;
+ }
+ std::cout << "</option>" << std::endl;
+ i++;
+ it++;
+ }
+}
+
+/** Internal small XML parser */
+std::string MetaCommand::GetXML(const char* buffer,
+ const char* desc,
+ unsigned long pos)
+{
+ std::string begin = "<";
+ begin += desc;
+ begin += ">";
+ std::string end = "</";
+ end += desc;
+ end += ">";
+
+ std::string buf = buffer;
+
+ long int posb = buf.find(begin,pos);
+ if(posb == -1)
+ {
+ return "";
+ }
+ long int pose = buf.find(end,posb);
+ if(pose == -1)
+ {
+ return "";
+ }
+
+ return buf.substr(posb+begin.size(),pose-posb-begin.size());
+}
+
+/** Given an XML buffer fill in the command line arguments */
+bool MetaCommand::ParseXML(const char* buffer)
+{
+ m_OptionVector.clear();
+ std::string buf = this->GetXML(buffer,"option",0);
+ long pos = 0;
+ while(buf.size() > 0)
+ {
+ Option option;
+ option.name = this->GetXML(buf.c_str(),"name",0);
+ option.tag = this->GetXML(buf.c_str(),"tag",0);
+ option.description = this->GetXML(buf.c_str(),"description",0);
+ if(atoi(this->GetXML(buf.c_str(),"required",0).c_str()) == 0)
+ {
+ option.required = false;
+ }
+ else
+ {
+ option.required = true;
+ }
+ unsigned int n = atoi(this->GetXML(buf.c_str(),"nvalues",0).c_str());
+
+ // Now check the fields
+ long posF = buf.find("<field>");
+ for(unsigned int i=0;i<n;i++)
+ {
+ std::string f = this->GetXML(buf.c_str(),"field",posF);
+ Field field;
+ field.userDefined = false;
+ field.name = this->GetXML(f.c_str(),"name",0);
+ field.description = this->GetXML(f.c_str(),"description",0);
+ field.value = this->GetXML(f.c_str(),"value",0);
+ field.type = this->StringToType(this->GetXML(f.c_str(),"type",0).c_str());
+ if(atoi(this->GetXML(f.c_str(),"external",0).c_str()) == 0)
+ {
+ field.externaldata = false;
+ }
+ else
+ {
+ field.externaldata = true;
+ }
+ if(atoi(this->GetXML(f.c_str(),"required",0).c_str()) == 0)
+ {
+ field.required = false;
+ }
+ else
+ {
+ field.required = true;
+ }
+
+ option.fields.push_back(field);
+ posF += f.size()+8;
+ }
+
+ m_OptionVector.push_back(option);
+
+ pos += buf.size()+17;
+ buf = this->GetXML(buffer,"option",pos);
+ }
+
+ return true;
+}
+
+
+/** List the current options */
+void MetaCommand::ListOptionsSimplified()
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if(!(*it).required)
+ {
+ std::cout << " [ ";
+ }
+ else
+ {
+ std::cout << " ";
+ }
+ if((*it).tag.size() > 0)
+ {
+ std::cout << "-" << (*it).tag.c_str() << " ";
+ }
+ std::vector<Field>::const_iterator itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).type != FLAG) // only display the type if it's not a FLAG
+ {
+ if((*itField).required)
+ {
+ std::cout << "<";
+ }
+ else
+ {
+ std::cout << "[";
+ }
+
+ std::cout << (*itField).name.c_str();
+
+ if((*itField).required)
+ {
+ std::cout << "> ";
+ }
+ else
+ {
+ std::cout << "] ";
+ }
+
+ }
+ itField++;
+ }
+
+ if(!(*it).required)
+ {
+ std::cout << "]";
+ }
+ std::cout << std::endl;
+
+ if((*it).description.size()>0)
+ {
+ std::cout << " = " << (*it).description.c_str();
+ std::cout << std::endl;
+ itField = (*it).fields.begin();
+ while(itField != (*it).fields.end())
+ {
+ if((*itField).description.size() > 0
+ || (*itField).value.size() > 0)
+ {
+ std::cout << " With: " << (*itField).name.c_str();
+ if((*itField).description.size() > 0)
+ {
+ std::cout << " = " << (*itField).description.c_str();
+ }
+ if((*itField).value.size() > 0)
+ {
+ std::cout << " (Default = " << (*itField).value << ")";
+ }
+ std::cout << std::endl;
+ }
+ itField++;
+ }
+ }
+
+ std::cout << std::endl;
+ it++;
+ }
+
+ if(m_HelpCallBack != NULL)
+ {
+ m_HelpCallBack();
+ }
+}
+
+/** Get the option by "-"+tag */
+bool
+MetaCommand::OptionExistsByMinusTag(std::string minusTag)
+{
+ OptionVector::const_iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ std::string tagToSearch = "-";
+ tagToSearch += (*it).tag;
+ if(tagToSearch == minusTag)
+ {
+ return true;
+ }
+ it++;
+ }
+
+ return false;
+
+}
+
+
+/** Get the option by "-"+tag */
+MetaCommand::Option *
+MetaCommand::GetOptionByMinusTag(std::string minusTag)
+{
+ OptionVector::iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ std::string tagToSearch = "-";
+ tagToSearch += (*it).tag;
+ if(tagToSearch == minusTag)
+ {
+ return &(*it);
+ }
+ it++;
+ }
+ return NULL;
+}
+
+/** Get the option by tag */
+MetaCommand::Option *
+MetaCommand::GetOptionByTag(std::string minusTag)
+{
+ OptionVector::iterator it = m_OptionVector.begin();
+ while(it != m_OptionVector.end())
+ {
+ if((*it).tag == minusTag)
+ {
+ return &(*it);
+ }
+ it++;
+ }
+ return NULL;
+}
+
+/** Return the option id. i.e the position in the vector */
+long
+MetaCommand::GetOptionId(Option* option)
+{
+ OptionVector::iterator it = m_OptionVector.begin();
+ unsigned long i = 0;
+ while(it != m_OptionVector.end())
+ {
+ if(&(*it) == option)
+ {
+ return i;
+ }
+ i++;
+ it++;
+ }
+ return -1;
+}
+
+
+
+/** Parse the command line */
+bool MetaCommand::Parse(int argc, char* argv[])
+{
+ // List the options if using -V
+ if((argc == 2 && !strcmp(argv[1],"-V"))
+ || (argc == 2 && !strcmp(argv[1],"-H")))
+ {
+ std::cout << "Usage : " << argv[0] << std::endl;
+ this->ListOptions();
+ return false;
+ }
+ // List the options if using -v
+ else if((argc == 2 && !strcmp(argv[1],"-v"))
+ || (argc == 2 && !strcmp(argv[1],"-h")))
+ {
+ std::cout << "Usage : " << argv[0] << std::endl;
+ this->ListOptionsSimplified();
+ return false;
+ }
+ else if(argc == 2 && !strcmp(argv[1],"-vxml"))
+ {
+ this->ListOptionsXML();
+ return false;
+ }
+ else if(argc == 2 && !strcmp(argv[1],"-version"))
+ {
+ std::cout << "Version: " << m_Version.c_str() << std::endl;
+ return false;
+ }
+ else if(argc == 2 && !strcmp(argv[1],"-date"))
+ {
+ std::cout << "Date: " << m_Date.c_str() << std::endl;
+ return false;
+ }
+
+ // Fill in the results
+ m_ParsedOptionVector.clear();
+ bool inArgument = false;
+ std::string tag = "";
+ std::string args;
+
+ unsigned int currentField = 0; // current field position
+ int currentOption = 0; // id of the option to fill
+ unsigned int valuesRemaining=0;
+ bool isComplete = false; // check if the option should be parse until the next tag is found
+ std::string completeString = "";
+
+ for(unsigned int i=1;i<(unsigned int)argc;i++)
+ {
+ // If this is a tag
+ if(argv[i][0] == '-' && (atof(argv[i])==0))
+ {
+ // if we have a tag before the expected values we throw an exception
+ if(valuesRemaining!=0)
+ {
+ if(!isComplete)
+ {
+ std::cout << "Found tag before end of value list!" << std::endl;
+ return false;
+ }
+ else
+ {
+ m_OptionVector[currentOption].fields[0].value = completeString;
+ m_OptionVector[currentOption].fields[0].userDefined = true;
+ m_OptionVector[currentOption].userDefined = true;
+ m_ParsedOptionVector.push_back(m_OptionVector[currentOption]);
+ }
+ }
+ inArgument = false;
+ // New tag so we add the previous values to the tag
+ tag = argv[i];
+
+ // Check if the tag is in the list
+ if(this->OptionExistsByMinusTag(tag))
+ {
+ inArgument = true;
+ valuesRemaining = this->GetOptionByMinusTag(tag)->fields.size();
+ currentOption = this->GetOptionId(this->GetOptionByMinusTag(tag));
+
+ if(currentOption < 0)
+ {
+ std::cout << "Error processing tag " << tag.c_str()
+ << ". Tag exists but cannot find its Id."
+ << std::endl;
+ }
+ else
+ {
+ isComplete = m_OptionVector[currentOption].complete;
+
+ if(m_OptionVector[currentOption].fields[0].type == FLAG)
+ {
+ // the tag exists by default
+ m_OptionVector[currentOption].fields[0].value = "true";
+ valuesRemaining = 0;
+ inArgument = false;
+ }
+ else if(m_OptionVector[currentOption].fields[0].type == LIST)
+ {
+ inArgument = true;
+ valuesRemaining = (int)atoi(argv[++i]);
+ char optName[255];
+ for(unsigned int j=0; j<valuesRemaining; j++)
+ {
+ sprintf(optName, "%03d", j);
+ this->AddOptionField( m_OptionVector[currentOption].name,
+ optName, STRING );
+ }
+ }
+ args = "";
+ }
+ }
+ else
+ {
+ std::cout << "The tag " << tag.c_str()
+ << " is not a valid argument : skipping this tag"
+ << std::endl;
+ }
+ if(inArgument)
+ {
+ i++;
+ }
+ }
+ else if(!inArgument) // If this is a field
+ {
+ // Look for the field to add
+ OptionVector::iterator it = m_OptionVector.begin();
+ unsigned long pos = 0;
+ bool found = false;
+ while(it != m_OptionVector.end())
+ {
+ if((pos >= currentField) && ((*it).tag==""))
+ {
+ currentOption = pos;
+ valuesRemaining = (*it).fields.size();
+ found = true;
+ break;
+ }
+ pos++;
+ it++;
+ }
+
+ if(!found)
+ {
+ std::cout << "Too many arguments specified in your command line! "
+ << "Skipping extra argument: " << argv[i] << std::endl;
+ }
+
+ inArgument=true;
+ currentField=currentOption+1;
+ }
+
+ // We collect the values
+ if(isComplete)
+ {
+ if(completeString.size()==0)
+ {
+ completeString = argv[i];
+ }
+ else
+ {
+ completeString += " ";
+ completeString += argv[i];
+ }
+ }
+ else if(inArgument && i<(unsigned int)argc && valuesRemaining>0)
+ {
+ if(currentOption >=0 && currentOption < (int)(m_OptionVector.size()))
+ {
+ unsigned long s = m_OptionVector[currentOption].fields.size();
+ m_OptionVector[currentOption].fields[s-valuesRemaining].value = argv[i];
+ m_OptionVector[currentOption].fields[s-valuesRemaining].userDefined =
+ true;
+ }
+ valuesRemaining--;
+ }
+
+ if(valuesRemaining == 0)
+ {
+ inArgument = false;
+ m_OptionVector[currentOption].userDefined = true;
+ m_ParsedOptionVector.push_back(m_OptionVector[currentOption]);
+ }
+ }
+
+ if(valuesRemaining>0)
+ {
+ std::cout << "Not enough parameters for "
+ << m_OptionVector[currentOption].name << std::endl;
+ std::cout << "Command: " << argv[0] << std::endl;
+ std::cout << "Options: " << std::endl
+ << " -v or -h for help listed in short format" << std::endl
+ << " -V or -H for help listed in long format" << std::endl
+ << " -vxml for help listed in xml format" << std::endl;
+
+ return false;
+ }
+
+ // Check if the options with required arguments are defined
+ OptionVector::iterator it = m_OptionVector.begin();
+ bool requiredAndNotDefined = false;
+ while(it != m_OptionVector.end())
+ {
+ if((*it).required)
+ {
+ // Check if the values are defined
+ std::vector<Field>::const_iterator itFields = (*it).fields.begin();
+ bool defined = true;
+ while(itFields != (*it).fields.end())
+ {
+ if((*itFields).value == "")
+ {
+ defined = false;
+ }
+ itFields++;
+ }
+
+ if(!defined)
+ {
+ if((*it).tag.size()>0)
+ {
+ std::cout << "Field " << (*it).tag.c_str()
+ << " is required but not defined" << std::endl;
+ }
+ else
+ {
+ std::cout << "Field " << (*it).name.c_str()
+ << " is required but not defined" << std::endl;
+ }
+ requiredAndNotDefined = true;
+ }
+ }
+ it++;
+ }
+
+ if(requiredAndNotDefined)
+ {
+ std::cout << "Command: " << argv[0] << std::endl
+ << "Options: " << std::endl
+ << " -v or -h for help listed in short format" << std::endl
+ << " -V or -H for help listed in long format" << std::endl
+ << " -vxml for help listed in xml format" << std::endl;
+ return false;
+ }
+
+ return true;
+}
+
+/** Return the string representation of a type */
+std::string MetaCommand::TypeToString(TypeEnumType type)
+{
+ switch(type)
+ {
+ case INT:
+ return "int";
+ case FLOAT:
+ return "float";
+ case STRING:
+ return "string";
+ case LIST:
+ return "list";
+ case FLAG:
+ return "flag";
+ default:
+ return "not defined";
+ }
+ return "not defined";
+}
+
+
+
+/** Return a type given a string */
+MetaCommand::TypeEnumType MetaCommand::StringToType(const char* type)
+{
+ if(!strcmp(type,"int"))
+ {
+ return INT;
+ }
+ else if(!strcmp(type,"float"))
+ {
+ return FLOAT;
+ }
+ else if(!strcmp(type,"string"))
+ {
+ return STRING;
+ }
+ else if(!strcmp(type,"list"))
+ {
+ return LIST;
+ }
+ else if(!strcmp(type,"flag"))
+ {
+ return FLAG;
+ }
+
+ return INT; // by default
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaCommand.h b/Utilities/ITK/Utilities/MetaIO/metaCommand.h
new file mode 100644
index 0000000000000000000000000000000000000000..645a8ec94bedde642407b391af9faac1f673418c
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaCommand.h
@@ -0,0 +1,181 @@
+/*=========================================================================
+
+ Program: Insight Segmentation & Registration Toolkit
+ Module: $RCSfile: metaCommand.h,v $
+ Language: C++
+ Date: $Date: 2006/01/01 17:31:45 $
+ Version: $Revision: 1.7 $
+
+ Copyright (c) 2002 Insight Consortium. All rights reserved.
+ See ITKCopyright.txt or http://www.itk.org/HTML/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef __MetaCommand_H_
+#define __MetaCommand_H_
+
+#ifdef _MSC_VER
+#pragma warning ( disable : 4786 )
+#endif
+
+#include <stdlib.h>
+#include <iostream>
+#include <string>
+#include <vector>
+#include <list>
+#include <map>
+
+class MetaCommand
+{
+
+public:
+
+ typedef enum {INT,FLOAT,CHAR,STRING,LIST,FLAG} TypeEnumType;
+
+ struct Field{
+ std::string name;
+ std::string description;
+ std::string value;
+ TypeEnumType type;
+ bool externaldata;
+ bool required;
+ bool userDefined;
+ };
+
+ struct Option{
+ std::string name;
+ std::string description;
+ std::string tag;
+ std::vector<Field> fields;
+ bool required;
+ bool userDefined;
+ bool complete;
+ };
+
+ typedef std::vector<Option> OptionVector;
+
+ MetaCommand();
+ ~MetaCommand() {}
+
+ bool SetOption(Option option);
+ bool SetOption(std::string name,
+ std::string tag,
+ bool required,
+ std::string description,
+ std::vector<Field> fields);
+ bool SetOption(std::string name,
+ std::string tag,
+ bool required,
+ std::string description,
+ TypeEnumType type = FLAG,
+ std::string defVal = "");
+
+ /** Fields are added in order */
+ bool AddField(std::string name,
+ std::string description,
+ TypeEnumType type,
+ bool externalData);
+
+ /** Add a field to an option */
+ bool AddOptionField(std::string optionName,
+ std::string name,
+ TypeEnumType type,
+ bool required=true,
+ std::string defVal = "",
+ std::string description = "");
+
+ /** Collect all the information until the next tag
+ * \warning this function works only if the field is of type String */
+ void SetOptionComplete(std::string optionName,
+ bool complete);
+
+ /** Get the values given the option name */
+ bool GetValueAsBool(std::string optionName,std::string fieldName="");
+ bool GetValueAsBool(Option option,std::string fieldName="");
+
+ float GetValueAsFloat(std::string optionName,std::string fieldName="");
+ float GetValueAsFloat(Option option,std::string fieldName="");
+
+ int GetValueAsInt(std::string optionName,std::string fieldName="");
+ int GetValueAsInt(Option option,std::string fieldName="");
+
+ std::string GetValueAsString(std::string optionName,std::string fieldName="");
+ std::string GetValueAsString(Option option,std::string fieldName="");
+
+ std::list< std::string > GetValueAsList(std::string optionName);
+ std::list< std::string > GetValueAsList(Option option);
+
+ bool GetOptionWasSet(std::string optionName);
+ bool GetOptionWasSet(Option option);
+
+ /** List the options */
+ void ListOptions();
+ void ListOptionsXML();
+ void ListOptionsSimplified();
+
+ Option * GetOptionByMinusTag(std::string minusTag);
+ Option * GetOptionByTag(std::string minusTag);
+
+ bool OptionExistsByMinusTag(std::string minusTag);
+
+ bool Parse(int argc, char* argv[]);
+
+ /** Given an XML buffer fill in the command line arguments */
+ bool ParseXML(const char* buffer);
+
+ /** Extract the date from cvs date */
+ std::string ExtractDateFromCVS(std::string date);
+
+ /** Set the version of the app */
+ std::string GetVersion()
+ { return m_Version; }
+
+ void SetVersion(const char* version)
+ { m_Version=version; }
+
+ /** Set the date of the app */
+ std::string GetDate()
+ { return m_Date; }
+
+ void SetDate(const char* date)
+ { m_Date=date; }
+
+ long GetOptionId(Option* option);
+
+ /** Return the list of options */
+ const OptionVector & GetOptions()
+ { return m_OptionVector; }
+
+ /** Return the list of parse options */
+ const OptionVector & GetParsedOptions()
+ { return m_ParsedOptionVector; }
+
+ void SetHelpCallBack(void (* newHelpCallBack)(void))
+ { m_HelpCallBack = newHelpCallBack; }
+
+protected:
+
+ std::string TypeToString(TypeEnumType type);
+ TypeEnumType StringToType(const char* type);
+
+ /** Small XML helper */
+ std::string GetXML(const char* buffer,const char* desc,unsigned long pos);
+
+ std::string m_Version;
+ std::string m_Date;
+
+private:
+
+ void (* m_HelpCallBack)(void);
+
+ OptionVector m_OptionVector;
+ OptionVector m_ParsedOptionVector; // We store the parsed option in
+ // case we have multiple options
+
+}; // end of class
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaDTITube.cxx b/Utilities/ITK/Utilities/MetaIO/metaDTITube.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e544c04d73020a0da27bc1cb09f627375e149ef6
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaDTITube.cxx
@@ -0,0 +1,646 @@
+#if defined(_MSC_VER)
+#pragma warning ( disable : 4786 )
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaDTITube.h>
+
+/** MetaDTITube Constructors */
+MetaDTITube::
+MetaDTITube()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaDTITube()" << std::endl;
+ Clear();
+}
+
+
+MetaDTITube::
+MetaDTITube(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaDTITube()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+
+MetaDTITube::
+MetaDTITube(const MetaDTITube *_DTITube)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaDTITube()" << std::endl;
+ Clear();
+ CopyInfo(_DTITube);
+}
+
+
+MetaDTITube::
+MetaDTITube(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaDTITube()" << std::endl;
+ Clear();
+}
+
+/** Destructor */
+MetaDTITube::
+~MetaDTITube()
+{
+ // Delete the list of pointers to DTITubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ DTITubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ M_Destroy();
+}
+
+//
+void MetaDTITube::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "ParentPoint = " << m_ParentPoint << std::endl;
+ if(m_Root)
+ {
+ std::cout << "Root = " << "True" << std::endl;
+ }
+ else
+ {
+ std::cout << "Root = " << "True" << std::endl;
+ }
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaDTITube::
+CopyInfo(const MetaDTITube * _DTITube)
+{
+ MetaObject::CopyInfo(_DTITube);
+}
+
+
+
+void MetaDTITube::
+PointDim(const char* pointDim)
+{
+ m_PointDim = pointDim;
+}
+
+const char* MetaDTITube::
+PointDim(void) const
+{
+ return m_PointDim.c_str();
+}
+
+void MetaDTITube::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaDTITube::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+void MetaDTITube::
+Root(bool root)
+{
+ m_Root = root;
+}
+
+bool MetaDTITube::
+Root(void) const
+{
+ return m_Root;
+}
+
+
+void MetaDTITube::
+ParentPoint(int parentpoint)
+{
+ m_ParentPoint = parentpoint;
+}
+
+int MetaDTITube::
+ParentPoint(void) const
+{
+ return m_ParentPoint;
+}
+
+/** Clear DTITube information */
+void MetaDTITube::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaDTITube: Clear" << std::endl;
+ MetaObject::Clear();
+ // Delete the list of pointers to DTITubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ DTITubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+
+ m_ParentPoint= -1;
+ m_Root = false;
+ m_NPoints = 0;
+ m_PointDim = "x y z tensor1 tensor2 tensor3 tensor4 tensor5 tensor6";
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy DTITube information */
+void MetaDTITube::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaDTITube::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaDTITube: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ // int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ParentPoint", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Root", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaDTITube::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Tube");
+ strcpy(m_ObjectSubTypeName,"DTI");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ if(m_ParentPoint>=0 && m_ParentID>=0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ParentPoint", MET_INT,m_ParentPoint);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_Root)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("True"), "True");
+ m_Fields.push_back(mF);
+ }
+ else
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("False"), "False");
+ m_Fields.push_back(mF);
+ }
+
+ // Create the new PointDim field
+ m_PointDim = "x y z tensor1 tensor2 tensor3 tensor4 tensor5 tensor6";
+
+ // All the points in the tube have the same number of fields
+ const DTITubePnt::FieldListType & extraList = (*(m_PointList.begin()))->GetExtraFields();
+ DTITubePnt::FieldListType::const_iterator itFields = extraList.begin();
+ while(itFields != extraList.end())
+ {
+ m_PointDim += " ";
+ m_PointDim += (*itFields).first;
+ itFields++;
+ }
+
+ if(m_PointDim.size()>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ m_PointDim.size(),m_PointDim.c_str());
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+/** Return the position given the name of the field */
+int MetaDTITube::GetPosition(const char* name) const
+{
+ std::vector<PositionType>::const_iterator it = m_Positions.begin();
+ while(it != m_Positions.end())
+ {
+ if(!strcmp((*it).first.c_str(),name))
+ {
+ return (*it).second;
+ }
+ ++it;
+ }
+
+ return -1;
+}
+
+bool MetaDTITube::
+M_Read(void)
+{
+ if(META_DEBUG)
+ {
+ std::cout << "MetaDTITube: M_Read: Loading Header" << std::endl;
+ }
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaDTITube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaDTITube: M_Read: Parsing Header" << std::endl;
+ }
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("ParentPoint", &m_Fields);
+ if(mF->defined)
+ {
+ m_ParentPoint= (int)mF->value[0];
+ }
+
+ m_Root = false;
+ mF = MET_GetFieldRecord("Root", &m_Fields);
+ if(mF->defined)
+ {
+ if(*((char *)(mF->value)) == 'T'
+ || *((char*)(mF->value)) == 't'
+ || *((char*)(mF->value)) == '1')
+ {
+ m_Root = true;
+ }
+ else
+ {
+ m_Root = false;
+ }
+ }
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ m_PointDim = (char *)(mF->value);
+ }
+
+ int i;
+
+ int pntDim;
+ char** pntVal = NULL;
+ char pointDim[255];
+
+ for(unsigned t = 0;t<m_PointDim.size();t++)
+ {
+ pointDim[t] = m_PointDim[t];
+ }
+ pointDim[m_PointDim.size()] = '\0';
+
+ MET_StringToWordArray(pointDim, &pntDim, &pntVal);
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaDTITube: Parsing point dim" << std::endl;
+ }
+
+ int j;
+ m_Positions.clear();
+ for(j = 0; j < pntDim; j++)
+ {
+ PositionType p(pntVal[j],j);
+ m_Positions.push_back(p);
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+ float v[50];
+
+ if(m_Event)
+ {
+ m_Event->StartReading(m_NPoints);
+ }
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*pntDim*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLine: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize
+ << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ double td;
+ int d;
+ for(j=0; j<m_NPoints; j++)
+ {
+ DTITubePnt* pnt = new DTITubePnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ for(d=0; d<6; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_TensorMatrix[d] = (float)td;
+ }
+
+ std::vector<PositionType>::const_iterator itFields = m_Positions.begin();
+ while(itFields != m_Positions.end())
+ {
+ if(strcmp((*itFields).first.c_str(),"x")
+ && strcmp((*itFields).first.c_str(),"y")
+ && strcmp((*itFields).first.c_str(),"z")
+ && strcmp((*itFields).first.c_str(),"tensor1")
+ && strcmp((*itFields).first.c_str(),"tensor2")
+ && strcmp((*itFields).first.c_str(),"tensor3")
+ && strcmp((*itFields).first.c_str(),"tensor4")
+ && strcmp((*itFields).first.c_str(),"tensor5")
+ && strcmp((*itFields).first.c_str(),"tensor6")
+ )
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->AddField((*itFields).first.c_str(),(float)td);
+ }
+ itFields++;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ if(m_Event)
+ {
+ m_Event->SetCurrentIteration(j+1);
+ }
+
+ DTITubePnt* pnt = new DTITubePnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+
+ pnt->m_X[0] = v[this->GetPosition("x")];
+ pnt->m_X[1] = v[this->GetPosition("y")];
+
+ if(m_NDims == 3)
+ {
+ pnt->m_X[2] = v[this->GetPosition("z")];
+ }
+
+ // Read tensor1
+ if(this->GetPosition("tensor1") >= 0
+ && this->GetPosition("tensor1") < pntDim)
+ {
+ pnt->m_TensorMatrix[0] = v[this->GetPosition("tensor1")];
+ }
+ // Read tensor2
+ if(this->GetPosition("tensor2") >= 0
+ && this->GetPosition("tensor2") < pntDim)
+ {
+ pnt->m_TensorMatrix[1] = v[this->GetPosition("tensor2")];
+ }
+ // Read tensor3
+ if(this->GetPosition("tensor3") >= 0
+ && this->GetPosition("tensor3") < pntDim)
+ {
+ pnt->m_TensorMatrix[2] = v[this->GetPosition("tensor3")];
+ }
+ // Read tensor4
+ if(this->GetPosition("tensor4") >= 0
+ && this->GetPosition("tensor4") < pntDim)
+ {
+ pnt->m_TensorMatrix[3] = v[this->GetPosition("tensor4")];
+ }
+ // Read tensor5
+ if(this->GetPosition("tensor5") >= 0
+ && this->GetPosition("tensor5") < pntDim)
+ {
+ pnt->m_TensorMatrix[4] = v[this->GetPosition("tensor5")];
+ }
+ // Read tensor6
+ if(this->GetPosition("tensor6") >= 0
+ && this->GetPosition("tensor6") < pntDim)
+ {
+ pnt->m_TensorMatrix[5] = v[this->GetPosition("tensor6")];
+ }
+
+ // Add the extrafields
+ std::vector<PositionType>::const_iterator itFields = m_Positions.begin();
+ while(itFields != m_Positions.end())
+ {
+ if(strcmp((*itFields).first.c_str(),"x")
+ && strcmp((*itFields).first.c_str(),"y")
+ && strcmp((*itFields).first.c_str(),"z")
+ && strcmp((*itFields).first.c_str(),"tensor1")
+ && strcmp((*itFields).first.c_str(),"tensor2")
+ && strcmp((*itFields).first.c_str(),"tensor3")
+ && strcmp((*itFields).first.c_str(),"tensor4")
+ && strcmp((*itFields).first.c_str(),"tensor5")
+ && strcmp((*itFields).first.c_str(),"tensor6")
+ )
+ {
+ pnt->AddField((*itFields).first.c_str(),
+ v[this->GetPosition((*itFields).first.c_str())]);
+ }
+ itFields++;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ if(m_Event)
+ {
+ m_Event->StopReading();
+ }
+
+ return true;
+}
+
+MET_ValueEnumType MetaDTITube::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaDTITube::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+bool MetaDTITube::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaDTITube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all DTITubes points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ unsigned int pntDim = m_NDims+6;
+ const DTITubePnt::FieldListType & extraList = (*(m_PointList.begin()))->GetExtraFields();
+ pntDim += extraList.size();
+
+ char* data = new char[pntDim*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ for(d = 0; d < 6; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_TensorMatrix[d],
+ m_ElementType, data, i++);
+ }
+
+ // Add the extra fields
+ const DTITubePnt::FieldListType & extraList2 = (*it)->GetExtraFields();
+ DTITubePnt::FieldListType::const_iterator itFields = extraList2.begin();
+ while(itFields != extraList2.end())
+ {
+ MET_DoubleToValue((double)(*itFields).second,m_ElementType,data,i++);
+ itFields++;
+ }
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,i*elementSize);
+ m_WriteStream->write("\n",1);
+ delete []data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ for(d = 0; d < 6; d++)
+ {
+ *m_WriteStream << (*it)->m_TensorMatrix[d] << " ";
+ }
+
+ // Add the extra fields
+ const DTITubePnt::FieldListType & extraList = (*it)->GetExtraFields();
+ DTITubePnt::FieldListType::const_iterator itFields = extraList.begin();
+ while(itFields != extraList.end())
+ {
+ *m_WriteStream << (*itFields).second << " ";
+ itFields++;
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+ return true;
+
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaDTITube.h b/Utilities/ITK/Utilities/MetaIO/metaDTITube.h
new file mode 100644
index 0000000000000000000000000000000000000000..8c2dcd8559b7c00c8378667536633c5685c582a6
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaDTITube.h
@@ -0,0 +1,191 @@
+#ifndef METADTITube_H
+#define METADTITube_H
+
+#if defined(_MSC_VER)
+#pragma warning ( disable : 4786 )
+#endif
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaDTITube (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaDTITubeFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ */
+
+class DTITubePnt
+{
+public:
+
+ typedef std::pair<std::string,float> FieldType;
+ typedef std::vector<FieldType> FieldListType;
+
+ const FieldListType & GetExtraFields() const {return m_ExtraFields;}
+ void AddField(const char* name, float value)
+ {
+ FieldType field(name,value);
+ m_ExtraFields.push_back(field);
+ }
+ float GetField(const char* name) const
+ {
+ FieldListType::const_iterator it = m_ExtraFields.begin();
+ while(it != m_ExtraFields.end())
+ {
+ if(!strcmp((*it).first.c_str(),name))
+ {
+ return (*it).second;
+ }
+ ++it;
+ }
+ return -1;
+ }
+
+ DTITubePnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ m_TensorMatrix = new float[6];
+
+ unsigned int i=0;
+ for(i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ }
+
+ // Initialize the tensor matrix to identity
+ for(i=0;i<6;i++)
+ {
+ m_TensorMatrix[i] = 0;
+ }
+ m_TensorMatrix[0] = 1;
+ m_TensorMatrix[3] = 1;
+ m_TensorMatrix[5] = 1;
+ }
+
+ ~DTITubePnt()
+ {
+ delete []m_X;
+ delete []m_TensorMatrix;
+ m_ExtraFields.clear();
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ float* m_TensorMatrix;
+
+ FieldListType m_ExtraFields;
+};
+
+
+
+
+class MetaDTITube : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<DTITubePnt*> PointListType;
+ typedef std::pair<std::string,unsigned int> PositionType;
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaDTITube(void);
+
+ MetaDTITube(const char *_headerName);
+
+ MetaDTITube(const MetaDTITube *_DTITube);
+
+ MetaDTITube(unsigned int dim);
+
+ ~MetaDTITube(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaDTITube * _DTITube);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the DTITube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+ // Root(...)
+ // Optional Field
+ // Set if this DTITube is a root
+ void Root(bool root);
+ bool Root(void) const;
+
+
+ // ParentPoint(...)
+ // Optional Field
+ // Set the point number of the parent DTITube where the branch occurs
+ void ParentPoint(int parentpoint);
+ int ParentPoint(void) const;
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_ParentPoint; // "ParentPoint = " -1
+
+ bool m_Root; // "Root = " False
+
+ int m_NPoints; // "NPoints = " 0
+
+ std::string m_PointDim; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+ MET_ValueEnumType m_ElementType;
+ std::vector<PositionType> m_Positions;
+
+ int GetPosition(const char*) const;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaEllipse.cxx b/Utilities/ITK/Utilities/MetaIO/metaEllipse.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..eb004a72758971278e0a59fde8a9cf5089cd188a
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaEllipse.cxx
@@ -0,0 +1,198 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+#include <string.h> // for memset
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaEllipse.h>
+
+//
+// MedImage Constructors
+//
+MetaEllipse::
+MetaEllipse()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaEllipse()" << std::endl;
+ Clear();
+
+}
+
+//
+MetaEllipse::
+MetaEllipse(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaEllipse()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaEllipse::
+MetaEllipse(const MetaEllipse *_ellipse)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaEllipse()" << std::endl;
+ Clear();
+ CopyInfo(_ellipse);
+}
+
+MetaEllipse::
+MetaEllipse(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaEllipse()" << std::endl;
+ Clear();
+}
+
+//
+MetaEllipse::
+~MetaEllipse()
+{
+ M_Destroy();
+}
+
+//
+void MetaEllipse::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "Radius = ";
+ for(int i=0;i<m_NDims;i++)
+ {
+ std::cout << m_Radius[i] << " ";
+ }
+ std::cout << std::endl;
+}
+
+void MetaEllipse::
+CopyInfo(const MetaEllipse * _ellipse)
+{
+ MetaObject::CopyInfo(_ellipse);
+}
+
+void MetaEllipse::
+Radius(const float* radius)
+{
+ for(int i=0; i<m_NDims; i++)
+ {
+ m_Radius[i] = radius[i];
+ }
+}
+
+
+void MetaEllipse::
+Radius(float radius)
+{
+ for(int i=0;i<m_NDims;i++)
+ {
+ m_Radius[i] = radius;
+ }
+}
+
+void MetaEllipse::
+Radius(float r1,float r2)
+{
+ m_Radius[0] = r1;
+ m_Radius[1] = r2;
+}
+
+void MetaEllipse::
+Radius(float r1,float r2, float r3)
+{
+ m_Radius[0] = r1;
+ m_Radius[1] = r2;
+ m_Radius[2] = r3;
+}
+
+const float* MetaEllipse::
+Radius(void) const
+{
+ return m_Radius;
+}
+
+/** Clear ellipse information */
+void MetaEllipse::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaEllipse: Clear" << std::endl;
+ MetaObject::Clear();
+ memset(m_Radius, 0, 100*sizeof(float));
+
+ for(int i=0; i<m_NDims; i++)
+ {
+ m_Radius[i] = 1;
+ }
+}
+
+/** Destroy ellipse information */
+void MetaEllipse::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaEllipse::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaEllipse: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Radius", MET_FLOAT_ARRAY, true,nDimsRecNum);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaEllipse::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Ellipse");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Radius", MET_FLOAT_ARRAY, m_NDims,m_Radius);
+ m_Fields.push_back(mF);
+}
+
+
+bool MetaEllipse::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaEllipse: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaEllipse: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaEllipse: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("Radius", &m_Fields);
+ if(mF->defined)
+ {
+ for(int i=0;i<m_NDims;i++)
+ {
+ m_Radius[i]= (float)mF->value[i];
+ }
+ }
+
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaEllipse.h b/Utilities/ITK/Utilities/MetaIO/metaEllipse.h
new file mode 100644
index 0000000000000000000000000000000000000000..6c614f71cddb0d77d6b7810ada1e6769325d0850
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaEllipse.h
@@ -0,0 +1,84 @@
+#ifndef METAEllipse_H
+#define METAEllipse_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaEllipse (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaEllipseFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaObject.h
+ */
+
+
+class MetaEllipse : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaEllipse(void);
+
+ MetaEllipse(const char *_headerName);
+
+ MetaEllipse(const MetaEllipse *_ellipse);
+
+ MetaEllipse(unsigned int dim);
+
+ ~MetaEllipse(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaEllipse * _ellipse);
+
+ void Clear(void);
+
+ void Radius(const float* radius);
+ void Radius(float radius);
+ void Radius(float r1,float r2);
+ void Radius(float r1,float r2, float r3);
+ const float* Radius(void) const;
+
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ float m_Radius[100]; // "Radius = " 0
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaEvent.h b/Utilities/ITK/Utilities/MetaIO/metaEvent.h
new file mode 100644
index 0000000000000000000000000000000000000000..b70e251677e4494da6f8866b4058805aef6ccf6b
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaEvent.h
@@ -0,0 +1,43 @@
+#ifndef METAEvent_H
+#define METAEvent_H
+
+/*! MetaEvent (.h)
+ *
+ * Description:
+ * Event abstract class
+ *
+ * \author Julien Jomier
+ * February 20, 2003
+ *
+ */
+
+
+class metaEvent
+{
+
+public:
+
+ metaEvent(){m_Level = -1;};
+ virtual ~metaEvent(){};
+
+ virtual void SetCurrentIteration(unsigned int n) {m_CurrentIteration = n;}
+ virtual void StartReading(unsigned int n)
+ {
+ m_NumberOfIterations = n;
+ m_Level++;
+ };
+ virtual void StopReading()
+ {
+ m_Level--;
+ };
+
+protected:
+
+ unsigned int m_CurrentIteration;
+ unsigned int m_NumberOfIterations;
+ int m_Level;
+
+};
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaGaussian.cxx b/Utilities/ITK/Utilities/MetaIO/metaGaussian.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d9d9e729c6d60165aedb0e777ccc4a5774e2a656
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaGaussian.cxx
@@ -0,0 +1,165 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaGaussian.h>
+
+//
+// MedImage Constructors
+//
+MetaGaussian::
+MetaGaussian()
+:MetaObject( )
+{
+ if(META_DEBUG) std::cout << "MetaGaussian()" << std::endl;
+ Clear();
+
+}
+
+//
+MetaGaussian::
+MetaGaussian(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaGaussian()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaGaussian::
+MetaGaussian(const MetaGaussian *_gaussian)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaGaussian()" << std::endl;
+ Clear();
+ CopyInfo(_gaussian);
+}
+
+MetaGaussian::
+MetaGaussian(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaGaussian()" << std::endl;
+ Clear();
+}
+
+//
+MetaGaussian::
+~MetaGaussian()
+{
+ M_Destroy();
+}
+
+//
+void MetaGaussian::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "\n"
+ << "Maximum = " << m_Maximum << "\n"
+ << "Radius = " << m_Radius
+ << std::endl;
+}
+
+void MetaGaussian::
+CopyInfo(const MetaGaussian * _gaussian)
+{
+ MetaObject::CopyInfo(_gaussian);
+}
+
+/** Clear gaussian information */
+void MetaGaussian::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaGaussian: Clear" << std::endl;
+ MetaObject::Clear();
+ m_Maximum = 1;
+ m_Radius = 1;
+}
+
+/** Destroy gaussian information */
+void MetaGaussian::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaGaussian::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaGaussian: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Maximum", MET_FLOAT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Radius", MET_FLOAT, true);
+ m_Fields.push_back(mF);
+
+}
+
+void MetaGaussian::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Gaussian");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Maximum", MET_FLOAT, m_Maximum);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Radius", MET_FLOAT,
+ m_Radius);
+ m_Fields.push_back(mF);
+
+}
+
+
+bool MetaGaussian::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaGaussian: M_Read: Loading Header"
+ << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaGaussian: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaGaussian: M_Read: Parsing Header"
+ << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("Maximum", &m_Fields);
+ if( mF->defined )
+ {
+ m_Maximum = (float)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("Radius", &m_Fields);
+ if( mF->defined )
+ {
+ m_Radius = (float)mF->value[0];
+ }
+
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaGaussian.h b/Utilities/ITK/Utilities/MetaIO/metaGaussian.h
new file mode 100644
index 0000000000000000000000000000000000000000..5708f5ed0400acf09ba63145f995ed4c82f296c3
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaGaussian.h
@@ -0,0 +1,85 @@
+#ifndef METAGaussian_H
+#define METAGaussian_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaGaussian (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaGaussianFiles.
+ *
+ * \author Mark Foskey
+ *
+ * \date February 12, 2004
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaObject.h
+ */
+
+
+class MetaGaussian : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaGaussian();
+
+ MetaGaussian(const char *_headerName);
+
+ MetaGaussian(const MetaGaussian *_gaussian);
+
+ MetaGaussian(unsigned int dim);
+
+ ~MetaGaussian(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaGaussian * _gaussian);
+
+ void Clear(void);
+
+ void Maximum(float val) { m_Maximum = val; }
+ float Maximum() const { return m_Maximum; }
+
+ void Radius(float val) { m_Radius = val; }
+ float Radius() const { return m_Radius; }
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ float m_Maximum;
+
+ float m_Radius;
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaGroup.cxx b/Utilities/ITK/Utilities/MetaIO/metaGroup.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3311cc2fcd5e66a572c9df8c54f5a83046859590
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaGroup.cxx
@@ -0,0 +1,136 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaGroup.h>
+
+//
+// MedImage Constructors
+//
+MetaGroup::
+MetaGroup()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaGroup()" << std::endl;
+ Clear();
+
+}
+
+//
+MetaGroup::
+MetaGroup(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaGroup()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaGroup::
+MetaGroup(const MetaGroup *_group)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaGroup()" << std::endl;
+ Clear();
+ CopyInfo(_group);
+}
+
+MetaGroup::
+MetaGroup(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaGroup()" << std::endl;
+ Clear();
+}
+
+//
+MetaGroup::
+~MetaGroup()
+{
+ M_Destroy();
+}
+
+//
+void MetaGroup::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+}
+
+void MetaGroup::
+CopyInfo(const MetaGroup * _group)
+{
+ MetaObject::CopyInfo(_group);
+}
+
+/** Clear group information */
+void MetaGroup::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaGroup: Clear" << std::endl;
+ MetaObject::Clear();
+}
+
+/** Destroy group information */
+void MetaGroup::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaGroup::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaGroup: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "EndGroup", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ mF = MET_GetFieldRecord("ElementSpacing", &m_Fields);
+ mF->required = false;
+}
+
+void MetaGroup::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Group");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "EndGroup", MET_NONE);
+ m_Fields.push_back(mF);
+}
+
+
+bool MetaGroup::
+M_Read(void)
+{
+ if(META_DEBUG)
+ {
+ std::cout << "MetaGroup: M_Read: Loading Header" << std::endl;
+ }
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaGroup: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaGroup: M_Read: Parsing Header" << std::endl;
+ }
+
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaGroup.h b/Utilities/ITK/Utilities/MetaIO/metaGroup.h
new file mode 100644
index 0000000000000000000000000000000000000000..952e46bb0f306f5af3b61510a40c51a402b0d7e5
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaGroup.h
@@ -0,0 +1,76 @@
+#ifndef METAGroup_H
+#define METAGroup_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaGroup (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaGroupFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaObject.h
+ */
+
+
+class MetaGroup : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaGroup(void);
+
+ MetaGroup(const char *_headerName);
+
+ MetaGroup(const MetaGroup *_group);
+
+ MetaGroup(unsigned int dim);
+
+ ~MetaGroup(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaGroup * _group);
+
+ void Clear(void);
+
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaITKUtils.h b/Utilities/ITK/Utilities/MetaIO/metaITKUtils.h
new file mode 100644
index 0000000000000000000000000000000000000000..1e6b267262bb379165d45458cfb378ac9ec09f20
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaITKUtils.h
@@ -0,0 +1,133 @@
+/*=========================================================================
+
+ Program: Insight Segmentation & Registration Toolkit
+ Module: $RCSfile: metaITKUtils.h,v $
+ Language: C++
+ Date: $Date: 2003/09/10 14:30:12 $
+ Version: $Revision: 1.4 $
+
+ Copyright (c) Insight Software Consortium. All rights reserved.
+ See ITKCopyright.txt or http://www.itk.org/HTML/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+// Utility file - definition of loadImage
+// Templated over the Pixel Type
+
+#ifndef META_ITK_UTILS_H
+#define META_ITK_UTILS_H
+
+#include<metaImage.h>
+#include<itkImage.h>
+#include<itkProcessObject.h>
+#include<itkImageRegionIterator.h>
+
+
+template <class T>
+typename itk::Image<T, 3>::Pointer
+metaITKUtilLoadImage3D(const char *fname, MET_ValueEnumType _toType,
+ double _toMinValue=0, double _toMaxValue=0)
+ {
+ MetaImage *imIO = new MetaImage();
+ imIO->Read(fname);
+ imIO->PrintInfo();
+ imIO->ConvertElementDataTo(_toType, _toMinValue, _toMaxValue);
+
+ typedef itk::Image<T,3> ImageType;
+
+ typedef typename ImageType::Pointer ImagePointer;
+ typedef typename ImageType::SizeType SizeType;
+ typedef typename ImageType::IndexType IndexType;
+ typedef typename ImageType::RegionType RegionType;
+
+ ImagePointer image = ImageType::New();
+
+ SizeType size;
+
+ double spacing[3];
+
+ size[0] = imIO->DimSize()[0];
+ size[1] = imIO->DimSize()[1];
+ if(imIO->NDims()>2)
+ size[2] = imIO->DimSize()[2];
+ else
+ size[2] = 1;
+
+ spacing[0] = imIO->ElementSpacing()[0];
+ spacing[1] = imIO->ElementSpacing()[1];
+ if(imIO->NDims()>2)
+ spacing[2] = imIO->ElementSpacing()[2];
+ else
+ spacing[2] = imIO->ElementSpacing()[1];
+
+ if (spacing[0] == 0)
+ {
+ spacing[0] = 1;
+ }
+ if (spacing[1] == 0)
+ {
+ spacing[1] = 1;
+ }
+ if (spacing[2] == 0)
+ {
+ spacing[2] = 1;
+ }
+
+ IndexType start;
+ start.Fill(0);
+
+ RegionType region;
+ region.SetSize(size);
+ region.SetIndex( start );
+ image->SetLargestPossibleRegion(region);
+ image->SetBufferedRegion(region);
+ image->SetRequestedRegion(region);
+ image->SetSpacing(spacing);
+ image->Allocate();
+
+
+ itk::ImageRegionIterator< ImageType > it(image, region);
+ it.Begin();
+ for(unsigned int i = 0; !it.IsAtEnd(); i++, ++it)
+ {
+ it.Set( static_cast< typename ImageType::PixelType >( imIO->ElementData(i) ));
+ }
+
+
+ return image;
+ }
+
+template <class imageT>
+bool metaITKUtilSaveImage(const char *fname, const char *dname,
+ typename imageT::Pointer _im,
+ MET_ValueEnumType _fromType,
+ int _numberOfChannels,
+ MET_ValueEnumType _toType,
+ double _toMinValue=0, double _toMaxValue=0)
+ {
+ int i;
+ int nd = _im->GetImageDimension();
+ int * si = new int[nd];
+ float * sp = new float[nd];
+ for(i=0; i<nd; i++)
+ {
+ si[i] = _im->GetLargestPossibleRegion().GetSize()[i];
+ sp[i] = _im->GetSpacing()[i];
+ }
+ MetaImage imIO(_im->GetImageDimension(), si, sp,
+ _fromType, _numberOfChannels,
+ (void *)_im->GetBufferPointer());
+ delete si;
+ delete sp;
+
+ imIO.ConvertElementDataTo(_toType, _toMinValue, _toMaxValue);
+
+ bool res = imIO.Write(fname, dname);
+
+ return res;
+ }
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaImage.cxx b/Utilities/ITK/Utilities/MetaIO/metaImage.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b8d407d0992c5c0e33d9501184b960d8f5939366
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaImage.cxx
@@ -0,0 +1,1905 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+#include <string.h> // for memcpy
+#include <math.h>
+
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaImage.h>
+#include <zlib.h>
+
+//
+// MetaImage Constructors
+//
+MetaImage::
+MetaImage()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ MetaImage::Clear();
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ strcpy(m_ElementDataFileName, "");
+ m_CompressedElementData = NULL;
+}
+
+//
+MetaImage::
+MetaImage(const char *_headerName)
+:MetaObject()
+ {
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ Clear();
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+ MetaImage::Read(_headerName);
+ }
+
+//
+MetaImage::
+MetaImage(MetaImage *_im)
+:MetaObject()
+ {
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ MetaImage::Clear();
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+ InitializeEssential(_im->NDims(),
+ _im->DimSize(),
+ _im->ElementSpacing(),
+ _im->ElementType(),
+ _im->ElementNumberOfChannels(),
+ _im->ElementData());
+ CopyInfo(_im);
+ }
+
+//
+MetaImage::
+MetaImage(int _nDims,
+ const int * _dimSize,
+ const float * _elementSpacing,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels,
+ void *_elementData)
+:MetaObject()
+ {
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ MetaImage::Clear();
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+ InitializeEssential(_nDims,
+ _dimSize,
+ _elementSpacing,
+ _elementType,
+ _elementNumberOfChannels,
+ _elementData);
+ }
+
+//
+MetaImage::
+MetaImage(int _x, int _y,
+ float _elementSpacingX, float _elementSpacingY,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels, void *_elementData)
+:MetaObject()
+ {
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+ int ds[2];
+ ds[0] = _x;
+ ds[1] = _y;
+ float es[2];
+ es[0] = _elementSpacingX;
+ es[1] = _elementSpacingY;
+ MetaImage::Clear();
+ InitializeEssential(2, ds, es, _elementType,
+ _elementNumberOfChannels,
+ _elementData);
+ }
+
+//
+MetaImage::
+MetaImage(int _x, int _y, int _z,
+ float _elementSpacingX,
+ float _elementSpacingY,
+ float _elementSpacingZ,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels,
+ void *_elementData)
+:MetaObject()
+ {
+ if(META_DEBUG) std::cout << "MetaImage()" << std::endl;
+ m_AutoFreeElementData = 0;
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+ int ds[3];
+ ds[0] = _x;
+ ds[1] = _y;
+ ds[2] = _z;
+ float es[3];
+ es[0] = _elementSpacingX;
+ es[1] = _elementSpacingY;
+ es[2] = _elementSpacingZ;
+ MetaImage::Clear();
+ InitializeEssential(3, ds, es, _elementType,
+ _elementNumberOfChannels,
+ _elementData);
+ }
+
+//
+MetaImage::
+~MetaImage()
+ {
+ M_Destroy();
+ }
+
+//
+void MetaImage::
+PrintInfo() const
+ {
+ int i;
+
+ MetaObject::PrintInfo();
+
+ char s[255];
+ MET_ImageModalityToString(m_Modality, s);
+ std::cout << "Modality = " << s << std::endl;
+
+ std::cout << "Quantity = " << m_Quantity << std::endl;
+
+ std::cout << "DimSize = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_DimSize[i] << " ";
+ }
+ std::cout << std::endl;
+ std::cout << "SubQuantity = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_SubQuantity[i] << " ";
+ }
+ std::cout << std::endl;
+
+ std::cout << "HeaderSize = " << m_HeaderSize << std::endl;
+
+ std::cout << "SequenceID = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_SequenceID[i] << " ";
+ }
+ std::cout << std::endl;
+
+ std::cout << "ElementSizeValid = " << (int)m_ElementSizeValid
+ << std::endl;
+ std::cout << "ElementSize = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_ElementSize[i] << " ";
+ }
+ std::cout << std::endl;
+
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+
+ std::cout << "ElementNumberOfChannels = "
+ << m_ElementNumberOfChannels << std::endl;
+
+ if(m_ElementMinMaxValid)
+ {
+ std::cout << "Min and Max are valid" << std::endl;
+ std::cout << " Min = " << m_ElementMin << std::endl;
+ std::cout << " Max = " << m_ElementMax << std::endl;
+ }
+ else
+ {
+ std::cout << "Min and Max are not valid" << std::endl;
+ }
+
+ std::cout << "AutoFreeElementData = "
+ << ((m_AutoFreeElementData)?"True":"False") << std::endl;
+
+ std::cout << "ElementData = " << ((m_ElementData==NULL)?"NULL":"Valid")
+ << std::endl;
+ }
+
+void MetaImage::
+CopyInfo(const MetaImage * _im)
+ {
+ MetaObject::CopyInfo(_im);
+
+ if(_im->ElementSizeValid())
+ {
+ ElementSize(_im->ElementSize());
+ }
+ HeaderSize(_im->HeaderSize());
+ Modality(_im->Modality());
+ SequenceID(_im->SequenceID());
+ ElementMin(_im->ElementMin());
+ ElementMax(_im->ElementMax());
+ }
+
+int MetaImage::
+HeaderSize(void) const
+ {
+ return m_HeaderSize;
+ }
+
+void MetaImage::
+HeaderSize(int _headerSize)
+ {
+ m_HeaderSize = _headerSize;
+ }
+
+MET_ImageModalityEnumType MetaImage::
+Modality(void) const
+ {
+ return m_Modality;
+ }
+
+void MetaImage::
+Modality(MET_ImageModalityEnumType _modality)
+ {
+ m_Modality = _modality;
+ }
+
+const int * MetaImage::
+DimSize(void) const
+ {
+ return m_DimSize;
+ }
+
+int MetaImage::
+DimSize(int _i) const
+ {
+ return m_DimSize[_i];
+ }
+
+int MetaImage::
+Quantity(void) const
+ {
+ return m_Quantity;
+ }
+
+const int * MetaImage::
+SubQuantity(void) const
+ {
+ return m_SubQuantity;
+ }
+
+int MetaImage::
+SubQuantity(int _i) const
+ {
+ return m_SubQuantity[_i];
+ }
+
+const float * MetaImage::
+SequenceID(void) const
+ {
+ return m_SequenceID;
+ }
+
+float MetaImage::
+SequenceID(int _i) const
+ {
+ return m_SequenceID[_i];
+ }
+
+void MetaImage::
+SequenceID(const float *_sequenceID)
+ {
+ memcpy(m_SequenceID, _sequenceID, m_NDims*sizeof(float));
+ }
+
+void MetaImage::
+SequenceID(int _i, float _value)
+ {
+ m_SequenceID[_i] = _value;
+ }
+
+bool MetaImage::
+ElementSizeValid(void) const
+ {
+ return m_ElementSizeValid;
+ }
+
+void MetaImage::
+ElementSizeValid(bool _elementSizeValid)
+ {
+ m_ElementSizeValid = _elementSizeValid;
+ }
+
+const float * MetaImage::
+ElementSize(void) const
+ {
+ return m_ElementSize;
+ }
+
+float MetaImage::
+ElementSize(int _i) const
+ {
+ return m_ElementSize[_i];
+ }
+
+void MetaImage::
+ElementSize(const float *_elementSize)
+ {
+ memcpy(m_ElementSize, _elementSize, m_NDims*sizeof(float));
+ m_ElementSizeValid = true;
+ }
+
+void MetaImage::
+ElementSize(int _i, float _value)
+ {
+ m_ElementSize[_i] = _value;
+ m_ElementSizeValid = true;
+ }
+
+MET_ValueEnumType MetaImage::
+ElementType(void) const
+ {
+ return m_ElementType;
+ }
+
+void MetaImage::
+ElementType(MET_ValueEnumType _elementType)
+ {
+ m_ElementType = _elementType;
+ }
+
+int MetaImage::
+ElementNumberOfChannels(void) const
+ {
+ return m_ElementNumberOfChannels;
+ }
+
+void MetaImage::
+ElementNumberOfChannels(int _elementNumberOfChannels)
+ {
+ m_ElementNumberOfChannels = _elementNumberOfChannels;
+ }
+
+void MetaImage::
+ElementByteOrderSwap(void)
+ {
+ if(META_DEBUG)
+ {
+ std::cout << "MetaImage: ElementByteOrderSwap" << std::endl;
+ }
+
+ int eSize;
+ MET_SizeOfType(m_ElementType, &eSize);
+ switch(eSize)
+ {
+ default:
+ case 0:
+ case 1:
+ {
+ break;
+ }
+ case 2:
+ {
+ int i;
+ for(i=0; i<m_Quantity*m_ElementNumberOfChannels; i++)
+ {
+ ((MET_USHORT_TYPE *)m_ElementData)[i] =
+ MET_ByteOrderSwapShort(((MET_USHORT_TYPE *)m_ElementData)[i]);
+ }
+ break;
+ }
+ case 4:
+ {
+ int i;
+ for(i=0; i<m_Quantity*m_ElementNumberOfChannels; i++)
+ {
+ ((MET_UINT_TYPE *)m_ElementData)[i] =
+ MET_ByteOrderSwapLong(((MET_UINT_TYPE *)m_ElementData)[i]);
+ }
+ break;
+ }
+ case 8:
+ {
+ int i;
+ char* data = (char*)m_ElementData;
+ for(i=0; i<m_Quantity*m_ElementNumberOfChannels; i++)
+ {
+ MET_ByteOrderSwap8(data);
+ data += 8;
+ }
+ break;
+ }
+ }
+ m_BinaryDataByteOrderMSB = !m_BinaryDataByteOrderMSB;
+ }
+
+bool MetaImage::
+ElementByteOrderFix(void)
+ {
+ if(m_BinaryDataByteOrderMSB != MET_SystemByteOrderMSB())
+ {
+ ElementByteOrderSwap();
+ return true;
+ }
+ return true;
+ }
+
+bool MetaImage::
+ElementMinMaxValid(void) const
+ {
+ return m_ElementMinMaxValid;
+ }
+
+void MetaImage::
+ElementMinMaxValid(bool _elementMinMaxValid)
+ {
+ m_ElementMinMaxValid = _elementMinMaxValid;
+ }
+
+void MetaImage::
+ElementMinMaxRecalc(void)
+ {
+ int i;
+ double tf;
+
+ if(m_ElementData == NULL)
+ return;
+
+ ElementByteOrderFix();
+
+ MET_ValueToDouble(m_ElementType, m_ElementData, 0, &tf);
+ m_ElementMin = tf;
+ m_ElementMax = tf;
+ for(i=1; i<m_Quantity*m_ElementNumberOfChannels; i++)
+ {
+ MET_ValueToDouble(m_ElementType, m_ElementData, i, &tf);
+ if(tf<m_ElementMin)
+ {
+ m_ElementMin = tf;
+ }
+ else if(tf>m_ElementMax)
+ {
+ m_ElementMax = tf;
+ }
+ }
+
+ m_ElementMinMaxValid = true;
+
+ std::cout << "MetaImage: ElementMinMaxRecalc: min = "
+ << m_ElementMin << " : max = "
+ << m_ElementMax << std::endl;
+
+ }
+
+double MetaImage::
+ElementMin(void) const
+ {
+ return m_ElementMin;
+ }
+
+void MetaImage::
+ElementMin(double _elementMin)
+ {
+ m_ElementMin = _elementMin;
+ }
+
+double MetaImage::
+ElementMax(void) const
+ {
+ return m_ElementMax;
+ }
+
+void MetaImage::
+ElementMax(double _elementMax)
+ {
+ m_ElementMax = _elementMax;
+ }
+
+bool MetaImage::
+ConvertElementDataTo(MET_ValueEnumType _elementType,
+ double _toMin, double _toMax)
+ {
+ int eSize;
+ MET_SizeOfType(_elementType, &eSize);
+ void * newElementData = new char[m_Quantity*m_ElementNumberOfChannels*eSize];
+
+ ElementByteOrderFix();
+ if(!ElementMinMaxValid())
+ {
+ ElementMinMaxRecalc();
+ }
+
+ int i;
+ for(i=0; i<m_Quantity*m_ElementNumberOfChannels; i++)
+ {
+ MET_ValueToValue(m_ElementType, m_ElementData, i, _elementType,
+ newElementData, m_ElementMin, m_ElementMax,
+ _toMin, _toMax);
+ }
+
+ if(m_AutoFreeElementData)
+ {
+ delete [] (char *)m_ElementData;
+ }
+ m_ElementData = newElementData;
+ m_ElementType = _elementType;
+ m_ElementMinMaxValid = true;
+ m_ElementMin = _toMin;
+ m_ElementMax = _toMax;
+ m_AutoFreeElementData = true;
+
+ return true;
+ }
+
+void * MetaImage::
+ElementData(void)
+ {
+ return m_ElementData;
+ }
+
+bool MetaImage::
+ElementData(int _i, double _v)
+ {
+ if(_i<m_Quantity)
+ {
+ MET_DoubleToValue(_v, m_ElementType, m_ElementData, _i);
+ return true;
+ }
+ return false;
+ }
+
+void MetaImage::
+ElementData(void * _elementData)
+ {
+ if(m_AutoFreeElementData)
+ {
+ delete [] (char *)m_ElementData;
+ }
+ m_ElementData = _elementData;
+ m_AutoFreeElementData = true;
+ }
+
+double MetaImage::
+ElementData(int _i) const
+ {
+ double tf = 0;
+ MET_ValueToDouble(m_ElementType, m_ElementData, _i, &tf);
+
+ return tf;
+ }
+
+bool MetaImage::
+AutoFreeElementData(void) const
+ {
+ return m_AutoFreeElementData;
+ }
+
+void MetaImage::
+AutoFreeElementData(bool _autoFreeElementData)
+ {
+ m_AutoFreeElementData = _autoFreeElementData;
+ }
+
+//
+//
+//
+const char * MetaImage::
+ElementDataFileName(void) const
+ {
+ return m_ElementDataFileName;
+ }
+
+void MetaImage::
+ElementDataFileName(const char * _elementDataFileName)
+ {
+ strcpy(m_ElementDataFileName, _elementDataFileName);
+ }
+
+
+bool MetaImage::
+Read(const char *_headerName, bool _readElements, void * _buffer)
+ {
+ M_Destroy();
+
+ MetaImage::Clear();
+
+ M_SetupReadFields();
+
+ if(_headerName != NULL)
+ {
+ strcpy(m_FileName, _headerName);
+ }
+
+ M_PrepareNewReadStream();
+ m_ReadStream->open(m_FileName, std::ios::binary | std::ios::in);
+ m_ReadStream->seekg(0,std::ios::beg);
+ if(!m_ReadStream->is_open())
+ {
+ std::cout << "MetaImage: Read: Cannot open file" << std::endl;
+ return false;
+ }
+
+ if(!M_Read())
+ {
+ std::cout << "MetaImage: Read: Cannot parse file" << std::endl;
+ m_ReadStream->close();
+ return false;
+ }
+
+ MetaImage::InitializeEssential(m_NDims,
+ m_DimSize,
+ m_ElementSpacing,
+ m_ElementType,
+ m_ElementNumberOfChannels,
+ _buffer,
+ _readElements);
+
+
+ if(_headerName != NULL)
+ {
+ strcpy(m_FileName, _headerName);
+ }
+
+ int i, j;
+ bool usePath;
+ char pathName[255];
+ char fName[255];
+ usePath = MET_GetFilePath(m_FileName, pathName);
+
+ if(_readElements)
+ {
+ if(!strcmp("Local", m_ElementDataFileName) ||
+ !strcmp("LOCAL", m_ElementDataFileName) ||
+ !strcmp("local", m_ElementDataFileName))
+ {
+ M_ReadElements(m_ReadStream, m_ElementData, m_Quantity);
+ }
+ else if(!strncmp("LIST", m_ElementDataFileName,4))
+ {
+ int fileImageDim = 0;
+ char junk[255];
+ sscanf( m_ElementDataFileName,"%s %d",junk, &fileImageDim);
+ if ( (fileImageDim == 0) || (fileImageDim > m_NDims) )
+ {
+ // if optional file dimension size is not given or is larger than
+ // overall dimension then default to a size of m_NDims - 1.
+ fileImageDim = m_NDims-1;
+ }
+ char s[255];
+ std::ifstream* readStreamTemp = new std::ifstream;
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ elementSize *= m_ElementNumberOfChannels;
+ int totalFiles = 1;
+ for (i = m_NDims; i > fileImageDim; i--)
+ {
+ totalFiles *= m_DimSize[i-1];
+ }
+ for(i=0; i< totalFiles && !m_ReadStream->eof(); i++)
+ {
+ m_ReadStream->getline(s, 255);
+ if(!m_ReadStream->eof())
+ {
+ j = strlen(s)-1;
+ while(j>0 && (isspace(s[j]) || !isprint(s[j])))
+ {
+ s[j--] = '\0';
+ }
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, s);
+ }
+ else
+ {
+ strcpy(fName, s);
+ }
+
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: cannot open slice" << std::endl;
+ continue;
+ }
+
+ M_ReadElements(readStreamTemp,
+ &(((char *)m_ElementData)[i*m_SubQuantity[fileImageDim]*
+ elementSize]),
+ m_SubQuantity[fileImageDim]);
+
+ readStreamTemp->close();
+ }
+ }
+ delete readStreamTemp;
+ }
+ else if(strstr(m_ElementDataFileName, "%"))
+ {
+ int nWrds;
+ char **wrds;
+ int minV = 1;
+ int maxV = m_DimSize[m_NDims-1];
+ int stepV = 1;
+ char s[255];
+ std::ifstream* readStreamTemp = new std::ifstream;
+ MET_StringToWordArray(m_ElementDataFileName, &nWrds, &wrds);
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ elementSize *= m_ElementNumberOfChannels;
+ if(nWrds >= 2)
+ {
+ minV = (int)atof(wrds[1]);
+ maxV = minV + m_DimSize[m_NDims-1] - 1;
+ }
+ if(nWrds >= 3)
+ {
+ maxV = (int)atof(wrds[2]);
+ stepV = (maxV-minV)/(m_DimSize[m_NDims-1]);
+ }
+ if(nWrds >= 4)
+ {
+ stepV = (int)atof(wrds[3]);
+ }
+ if (META_DEBUG)
+ {
+ std::cout << "Using string '" << wrds[0] << "' with values "
+ << minV << " to " << maxV
+ << " stepping " << stepV << std::endl;
+ }
+ int cnt = 0;
+ for(i=minV; i<=maxV; i += stepV)
+ {
+ sprintf(s, wrds[0], i);
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, s);
+ }
+ else
+ {
+ strcpy(fName, s);
+ }
+ if (META_DEBUG)
+ {
+ std::cout << " file = _" << fName << "_" << std::endl;
+ }
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: cannot construct file _"
+ << fName << "_" << std::endl;
+ continue;
+ }
+
+ M_ReadElements(readStreamTemp,
+ &(((char *)m_ElementData)[cnt*m_SubQuantity[m_NDims-1]*
+ elementSize]),
+ m_SubQuantity[m_NDims-1]);
+ cnt++;
+
+ readStreamTemp->close();
+ }
+ delete readStreamTemp;
+ }
+ else
+ {
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, m_ElementDataFileName);
+ }
+ else
+ {
+ strcpy(fName, m_ElementDataFileName);
+ }
+ std::ifstream* readStreamTemp = new std::ifstream;
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: Cannot open data file" << std::endl;
+ m_ReadStream->close();
+ return false;
+ }
+ M_ReadElements(readStreamTemp, m_ElementData, m_Quantity);
+ readStreamTemp->close();
+ delete readStreamTemp;
+ }
+ }
+
+ m_ReadStream->close();
+
+ return true;
+}
+
+
+/** Perform the compression */
+unsigned char * MetaImage::
+PerformCompression(unsigned char *source,int quantity)
+{
+ z_stream z;
+ z.zalloc = (alloc_func)0;
+ z.zfree = (free_func)0;
+ z.opaque = (voidpf)0;
+
+ // Compression rate
+ // Choices are Z_BEST_SPEED,Z_BEST_COMPRESSION,Z_DEFAULT_COMPRESSION
+ int compression_rate = Z_DEFAULT_COMPRESSION;
+
+ unsigned char *input_buffer = source;
+
+ // The buffer size is big
+ int buffer_size = quantity;
+ unsigned char * compressedData = new unsigned char[quantity];
+ unsigned char *output_buffer = new unsigned char[buffer_size];
+
+ deflateInit(&z,compression_rate);
+
+ z.avail_in = quantity;
+ z.next_in = input_buffer;
+ z.next_out = output_buffer;
+ z.avail_out = buffer_size;
+
+ int count;
+ unsigned long j=0;
+ // Perform the compression
+ for ( ; ; )
+ {
+ if ( z.avail_in == 0 )
+ {
+ deflate( &z, Z_FINISH );
+ count = buffer_size - z.avail_out;
+ if ( count )
+ {
+ memcpy((char*)compressedData+j,(char *)output_buffer,count);
+ }
+ break;
+ }
+ deflate( &z, Z_NO_FLUSH );
+ count = buffer_size - z.avail_out;
+ memcpy((char*)compressedData+j,(char*)output_buffer,count);
+ j += count;
+ z.next_out = output_buffer;
+ z.avail_out = buffer_size;
+ }
+
+ delete output_buffer;
+ m_CompressedDataSize = z.total_out;
+
+ // Print the result
+ deflateEnd(&z);
+
+ return compressedData;
+}
+
+
+//
+//
+//
+bool MetaImage::
+Write(const char *_headName, const char *_dataName, bool _writeElements)
+ {
+ if(_headName != NULL)
+ {
+ FileName(_headName);
+ }
+
+
+ bool userDataFileName = true;
+ if(_dataName == NULL && strlen(m_ElementDataFileName)==0)
+ {
+ userDataFileName = false;
+ int sPtr = 0;
+ MET_GetFileSuffixPtr(m_FileName, &sPtr);
+ if(!strcmp(&m_FileName[sPtr], "mha"))
+ {
+ ElementDataFileName("LOCAL");
+ }
+ else
+ {
+ MET_SetFileSuffix(m_FileName, "mhd");
+ strcpy(m_ElementDataFileName, m_FileName);
+ if(m_CompressedData)
+ {
+ MET_SetFileSuffix(m_ElementDataFileName, "zraw");
+ }
+ else
+ {
+ MET_SetFileSuffix(m_ElementDataFileName, "raw");
+ }
+ }
+ }
+ else if(_dataName != NULL)
+ {
+ userDataFileName = false;
+ ElementDataFileName(_dataName);
+ }
+
+ bool localData = false;
+ if(!strcmp(m_ElementDataFileName, "LOCAL"))
+ {
+ localData = true;
+ }
+
+ // make sure suffix is valid
+ if(localData)
+ {
+ MET_SetFileSuffix(m_FileName, "mha");
+ }
+ else
+ {
+ MET_SetFileSuffix(m_FileName, "mhd");
+ }
+
+ char pathName[255];
+ bool usePath = MET_GetFilePath(m_FileName, pathName);
+ if(usePath)
+ {
+ char elementPathName[255];
+ MET_GetFilePath(m_ElementDataFileName, elementPathName);
+ if(!strcmp(pathName, elementPathName))
+ {
+ strcpy(elementPathName, &m_ElementDataFileName[strlen(pathName)]);
+ strcpy(m_ElementDataFileName, elementPathName);
+ }
+ }
+
+ if(!m_WriteStream)
+ {
+ m_WriteStream = new std::ofstream;
+ }
+ // Some older sgi compilers have a error in the ofstream constructor
+ // that requires a file to exist for output
+#ifdef __sgi
+ {
+ std::ofstream tFile(m_FileName,std::ios::binary | std::ios::out);
+ tFile.close();
+ }
+#endif
+ m_WriteStream->open(m_FileName, std::ios::binary | std::ios::out);
+ if(!m_WriteStream->is_open())
+ {
+ if(!userDataFileName)
+ {
+ ElementDataFileName("");
+ }
+ return false;
+ }
+
+ if(!m_CompressedData)
+ {
+ M_SetupWriteFields();
+ M_Write();
+ }
+ else // perform compression
+ {
+ if(_writeElements && localData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int elementNumberOfBytes = elementSize*m_ElementNumberOfChannels;
+
+ m_CompressedElementData = this->PerformCompression(
+ (unsigned char *)m_ElementData,m_Quantity * elementNumberOfBytes);
+ }
+ //Now that we know the size of the compresse stream we write the header
+ M_SetupWriteFields();
+ M_Write();
+ }
+
+ if(_writeElements)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int elementNumberOfBytes = elementSize*m_ElementNumberOfChannels;
+ if(localData)
+ {
+ if(!m_CompressedData)
+ {
+ m_WriteStream->write( (char *)m_ElementData,
+ m_Quantity * elementNumberOfBytes );
+ }
+ else
+ {
+ m_WriteStream->write( (char *)m_CompressedElementData,
+ m_CompressedDataSize);
+ delete m_CompressedElementData;
+ m_CompressedElementData = NULL;
+ }
+
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ if(!userDataFileName)
+ {
+ ElementDataFileName("");
+ }
+ return true;
+ }
+ else // write the data in a separate file
+ {
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+
+ std::ofstream* writeStreamTemp = new std::ofstream;
+ char dataFileName[255];
+ if(usePath)
+ {
+ sprintf(dataFileName, "%s%s", pathName, m_ElementDataFileName);
+ }
+ else
+ {
+ strcpy(dataFileName, m_ElementDataFileName);
+ }
+ if(strstr(dataFileName, "%")) // write slice by slice
+ {
+ int i;
+ char fName[255];
+ int sliceNumberOfBytes = m_SubQuantity[m_NDims-1]*elementNumberOfBytes;
+ for(i=1; i<=m_DimSize[m_NDims-1]; i++)
+ {
+ sprintf(fName, dataFileName, i);
+ // Some older sgi compilers have a error in the ofstream constructor
+ // that requires a file to exist for output
+#ifdef __sgi
+ {
+ std::ofstream tFile(fName,std::ios::binary | std::ios::out);
+ tFile.close();
+ }
+#endif
+ writeStreamTemp->open(fName, std::ios::binary | std::ios::out);
+
+ if(!m_CompressedData)
+ {
+ writeStreamTemp->write(
+ &(((char *)m_ElementData)[(i-1)*sliceNumberOfBytes]),
+ sliceNumberOfBytes);
+ }
+ else
+ {
+ // Compress the data
+ m_CompressedElementData = this->PerformCompression(
+ &(((unsigned char *)m_ElementData)[(i-1)*sliceNumberOfBytes]),
+ sliceNumberOfBytes);
+ // Write the compressed data
+ writeStreamTemp->write( (char *)m_CompressedElementData,
+ m_CompressedDataSize);
+ delete m_CompressedElementData;
+ m_CompressedElementData = NULL;
+ }
+
+
+ writeStreamTemp->close();
+ delete writeStreamTemp;
+ writeStreamTemp = new std::ofstream;
+ }
+ }
+ else // write the image in one unique other file
+ {
+ // Some older sgi compilers have a error in the ofstream constructor
+ // that requires a file to exist for output
+#ifdef __sgi
+ {
+ std::ofstream tFile(dataFileName,std::ios::binary | std::ios::out);
+ tFile.close();
+ }
+#endif
+ writeStreamTemp->open(dataFileName, std::ios::binary | std::ios::out);
+
+ if(!m_CompressedData)
+ {
+ writeStreamTemp->write( (char *)m_ElementData,
+ m_Quantity * elementNumberOfBytes );
+ }
+ else
+ {
+ m_CompressedElementData = this->PerformCompression(
+ (unsigned char *)m_ElementData,
+ m_Quantity * elementNumberOfBytes);
+ m_WriteCompressedDataSize = false;
+ writeStreamTemp->write( (char *)m_CompressedElementData,
+ m_CompressedDataSize);
+ delete m_CompressedElementData;
+ m_CompressedElementData = NULL;
+ }
+
+ writeStreamTemp->close();
+ delete writeStreamTemp;
+ if(!userDataFileName)
+ {
+ ElementDataFileName("");
+ }
+ return true;
+ }
+ delete writeStreamTemp;
+ }
+ }
+
+ if(!userDataFileName)
+ {
+ ElementDataFileName("");
+ }
+
+ return true;
+ }
+
+void MetaImage::
+Clear(void)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: Clear" << std::endl;
+
+ strcpy(m_ElementDataFileName, "");
+
+ m_ElementType = MET_NONE;
+ m_ElementNumberOfChannels = 1;
+ m_ElementData = NULL;
+
+ m_HeaderSize = 0;
+
+ memset(m_SequenceID, 0, 4*sizeof(float));
+ memset(m_ElementSize, 0, 10*sizeof(float));
+ m_ElementSizeValid = false;
+
+ m_Modality = MET_MOD_UNKNOWN;
+
+ m_ElementMinMaxValid = false;
+ m_ElementMin = 0;
+ m_ElementMax = 0;
+ m_Quantity = 0;
+ m_SubQuantity[0] = 0;
+ m_DimSize[0] = 0;
+
+ MetaObject::Clear();
+
+ m_BinaryData = true;
+ }
+
+
+bool MetaImage::
+InitializeEssential(int _nDims,
+ const int * _dimSize,
+ const float * _elementSpacing,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels,
+ void * _elementData,
+ bool _allocElementMemory)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: Initialize" << std::endl;
+
+ MetaObject::InitializeEssential(_nDims);
+
+ int i;
+ m_Quantity = 1;
+ m_SubQuantity[0] = 1;
+ m_ElementSizeValid = false;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_DimSize[i] = _dimSize[i];
+ m_Quantity *= _dimSize[i];
+ if(i>0)
+ {
+ m_SubQuantity[i] = m_SubQuantity[i-1]*m_DimSize[i-1];
+ }
+ m_ElementSpacing[i] = _elementSpacing[i];
+ if(m_ElementSize[i] == 0)
+ {
+ m_ElementSize[i] = m_ElementSpacing[i];
+ }
+ else
+ {
+ m_ElementSizeValid = true;
+ }
+ }
+
+ m_ElementType = _elementType;
+
+ m_ElementNumberOfChannels = _elementNumberOfChannels;
+
+ if(_elementData != NULL)
+ {
+ m_AutoFreeElementData = false;
+ m_ElementData = (void *)_elementData;
+ }
+ else if(_allocElementMemory)
+ {
+ m_AutoFreeElementData = true;
+ MET_SizeOfType(m_ElementType, &i);
+ m_ElementData = new char[m_Quantity*m_ElementNumberOfChannels*i];
+ if(m_ElementData == NULL)
+ {
+ m_AutoFreeElementData = false;
+ std::cout << "MetaImage:: M_Allocate:: Insufficient memory" << std::endl;
+ return false;
+ }
+ }
+ else
+ {
+ m_AutoFreeElementData = false;
+ m_ElementData = NULL;
+ }
+
+ m_BinaryData = true;
+
+ return true;
+ }
+
+void MetaImage::
+M_Destroy(void)
+ {
+ if(m_AutoFreeElementData && m_ElementData != NULL)
+ {
+ delete [] (char *)m_ElementData;
+ }
+
+ if(m_CompressedElementData != NULL)
+ {
+ delete [] (char *)m_CompressedElementData;
+ }
+
+ m_ElementData = NULL;
+ m_CompressedElementData = NULL;
+
+ MetaObject::M_Destroy();
+ }
+
+void MetaImage::
+M_SetupReadFields(void)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "DimSize", MET_INT_ARRAY, true, nDimsRecNum);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "HeaderSize", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Modality", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ImagePosition", MET_FLOAT_ARRAY, false, nDimsRecNum);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "SequenceID", MET_INT_ARRAY, false, nDimsRecNum);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementMin", MET_FLOAT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementMax", MET_FLOAT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementNumberOfChannels", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementSize", MET_FLOAT_ARRAY, false, nDimsRecNum);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType; // Set but not used...
+ MET_InitReadField(mF, "ElementNBits", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementDataFile", MET_STRING, true);
+ mF->required = true;
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+ }
+
+void MetaImage::
+M_SetupWriteFields(void)
+ {
+ m_BinaryData = true;
+
+ strcpy(m_ObjectTypeName,"Image");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "DimSize", MET_INT_ARRAY, m_NDims, m_DimSize);
+ m_Fields.push_back(mF);
+
+ char s[255];
+ if(m_HeaderSize > 0 || m_HeaderSize == -1)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "HeaderSize", MET_INT);
+ m_Fields.push_back(mF);
+ }
+
+ int i;
+ if(m_Modality != MET_MOD_UNKNOWN)
+ {
+ mF = new MET_FieldRecordType;
+ strcpy(s, MET_ValueTypeName[m_Modality]);
+ MET_InitWriteField(mF, "Modality", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+ }
+
+ i = MET_GetFieldRecordNumber("AnatomicalOrientation", &m_Fields);
+ if(i < 0)
+ {
+ const char * str = AnatomicalOrientationAcronym();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "AnatomicalOrientation",
+ MET_STRING, strlen(str), str);
+ m_Fields.push_back(mF);
+ }
+
+ bool valid = false;
+ for(i=0; i<4; i++)
+ {
+ if(m_SequenceID[i] != 0)
+ {
+ valid = true;
+ break;
+ }
+ }
+ if(valid)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "SequenceID", MET_FLOAT_ARRAY, m_NDims,
+ m_SequenceID);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_ElementMinMaxValid)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementMin", MET_FLOAT, m_ElementMin);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementMax", MET_FLOAT, m_ElementMax);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_ElementNumberOfChannels>1)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementNumberOfChannels", MET_INT,
+ m_ElementNumberOfChannels);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_ElementSizeValid)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementSize", MET_FLOAT_ARRAY, m_NDims,
+ m_ElementSize);
+ m_Fields.push_back(mF);
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_ElementType, s);
+ MET_InitWriteField(mF, "ElementType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementDataFile", MET_STRING,
+ strlen(m_ElementDataFileName),
+ m_ElementDataFileName);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+ }
+
+//
+//
+//
+bool MetaImage::
+M_ReadElements(std::ifstream * _fstream, void * _data, int _dataQuantity)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: M_ReadElements" << std::endl;
+
+ if(m_HeaderSize>(int)0)
+ {
+ _fstream->seekg(m_HeaderSize, std::ios::beg);
+ if(!_fstream->good())
+ {
+ std::cout << "MetaImage: Read: header not read correctly" << std::endl;
+ return false;
+ }
+ }
+
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = _dataQuantity*m_ElementNumberOfChannels*elementSize;
+ if(META_DEBUG)
+ std::cout << "MetaImage: M_ReadElements: ReadSize = "
+ << readSize << std::endl;
+
+ if(m_HeaderSize == -1)
+ {
+ if(META_DEBUG)
+ std::cout << "MetaImage: M_ReadElements: Skipping header" << std::endl;
+ _fstream->seekg(-readSize, std::ios::end);
+ }
+
+ // If compressed we inflate
+ if(m_CompressedData)
+ {
+ // if m_CompressedDataSize is not defined we assume the size of the
+ // file is the size of the compressed data
+ if(m_CompressedDataSize==0)
+ {
+ _fstream->seekg(0, std::ios::end);
+ m_CompressedDataSize = _fstream->tellg();
+ _fstream->seekg(0, std::ios::beg);
+ }
+
+ unsigned char* compr = new unsigned char[m_CompressedDataSize];
+ _fstream->read((char *)compr, m_CompressedDataSize);
+
+ z_stream d_stream;
+
+ d_stream.zalloc = (alloc_func)0;
+ d_stream.zfree = (free_func)0;
+ d_stream.opaque = (voidpf)0;
+
+ inflateInit(&d_stream);
+ d_stream.next_in = compr;
+ d_stream.avail_in = m_CompressedDataSize;
+
+ for (;;)
+ {
+ d_stream.next_out = (unsigned char *)_data;
+ d_stream.avail_out = readSize;
+ int err = inflate(&d_stream, Z_NO_FLUSH);
+ if((err == Z_STREAM_END))
+ {
+ break;
+ }
+ }
+ inflateEnd(&d_stream);
+ delete []compr;
+ }
+ else // if not compressed
+ {
+ _fstream->read((char *)_data, readSize);
+ int gc = _fstream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaImage: M_ReadElements: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc
+ << std::endl;
+ return false;
+ }
+ }
+
+ return true;
+ }
+
+bool MetaImage
+::Append(const char *_headName)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: Append" << std::endl;
+
+ if(strlen(m_ElementDataFileName)==0)
+ {
+ ElementDataFileName("LOCAL");
+ }
+
+ if(_headName != NULL)
+ {
+ FileName(_headName);
+ }
+
+ M_SetupWriteFields();
+
+ if(!m_WriteStream)
+ {
+ m_WriteStream = new std::ofstream;
+ }
+
+ m_WriteStream->open(m_FileName,
+ std::ios::binary | std::ios::app | std::ios::out);
+ if(!m_WriteStream->is_open())
+ {
+ return false;
+ }
+
+ M_Write();
+
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int elementNumberOfBytes = elementSize*m_ElementNumberOfChannels;
+ if(!strcmp(m_ElementDataFileName, "LOCAL"))
+ {
+ m_WriteStream->write((char *)m_ElementData,
+ m_Quantity * elementNumberOfBytes);
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ return true;
+ }
+ else
+ {
+ char pathName[255];
+ bool usePath = MET_GetFilePath(m_FileName, pathName);
+ std::ofstream* writeStreamTemp = new std::ofstream;
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ char dataFileName[255];
+ if(usePath)
+ {
+ sprintf(dataFileName, "%s%s", pathName, m_ElementDataFileName);
+ }
+ else
+ {
+ strcpy(dataFileName, m_ElementDataFileName);
+ }
+ if(strstr(dataFileName, "%"))
+ {
+ int i;
+ char fName[255];
+ int sliceNumberOfBytes = m_SubQuantity[m_NDims-1]*elementNumberOfBytes;
+ for(i=1; i<=m_DimSize[m_NDims-1]; i++)
+ {
+ sprintf(fName, dataFileName, i);
+ // Some older sgi compilers have a error in the ofstream constructor
+ // that requires a file to exist for output
+#ifdef __sgi
+ {
+ std::ofstream tFile(fName,std::ios::binary | std::ios::out);
+ tFile.close();
+ }
+#endif
+ writeStreamTemp->open(fName, std::ios::binary | std::ios::out);
+ writeStreamTemp->write(&(((char *)m_ElementData)[i*sliceNumberOfBytes]),
+ sliceNumberOfBytes);
+ writeStreamTemp->close();
+ delete writeStreamTemp;
+ }
+ }
+ else
+ {
+ // Some older sgi compilers have a error in the ofstream constructor
+ // that requires a file to exist for output
+#ifdef __sgi
+ {
+ std::ofstream tFile(dataFileName,std::ios::binary | std::ios::out);
+ tFile.close();
+ }
+#endif
+ writeStreamTemp->open(dataFileName, std::ios::binary | std::ios::out);
+ writeStreamTemp->write( (char *)m_ElementData,
+ m_Quantity * elementNumberOfBytes);
+ writeStreamTemp->close();
+ delete writeStreamTemp;
+ return true;
+ }
+ delete writeStreamTemp;
+ }
+ return true;
+
+ }
+
+bool MetaImage::
+M_Read(void)
+ {
+ if(META_DEBUG) std::cout << "MetaImage: M_Read: Loading Header" << std::endl;
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaImage: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaImage: M_Read: Parsing Header" << std::endl;
+ MET_FieldRecordType * mF;
+
+ if(META_DEBUG)
+ std::cout << "metaImage: M_Read: elementSpacing[" << 0 << "] = "
+ << m_ElementSpacing[0] << std::endl;
+
+ mF = MET_GetFieldRecord("DimSize", &m_Fields);
+ if(mF && mF->defined)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_DimSize[i] = (int)mF->value[i];
+ }
+ }
+
+ mF = MET_GetFieldRecord("HeaderSize", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_HeaderSize = (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("Modality", &m_Fields);
+ if(mF && mF->defined)
+ {
+ MET_StringToImageModality((char *)mF->value, &m_Modality);
+ }
+
+ mF = MET_GetFieldRecord("SequenceID", &m_Fields);
+ if(mF && mF->defined)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_SequenceID[i] = (float)(mF->value[i]);
+ }
+ }
+
+ mF = MET_GetFieldRecord("ImagePosition", &m_Fields);
+ if(mF && mF->defined)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_Offset[i] = static_cast<double>(mF->value[i]);
+ }
+ }
+
+ mF = MET_GetFieldRecord("ElementMin", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ElementMin = mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementMax", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ElementMax = mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementNumberOfChannels", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ElementNumberOfChannels = (int)mF->value[0];
+ }
+
+
+ mF = MET_GetFieldRecord("ElementSize", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ElementSizeValid = true;
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_ElementSize[i] = (float)(mF->value[i]);
+ }
+ mF = MET_GetFieldRecord("ElementSpacing", &m_Fields);
+ if(mF && !mF->defined)
+ {
+ for(i=0; i<m_NDims; i++)
+ {
+ m_ElementSpacing[i] = m_ElementSize[i];
+ }
+ }
+ }
+ else
+ {
+ int i;
+ m_ElementSizeValid = false;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_ElementSize[i] = m_ElementSpacing[i];
+ }
+ }
+
+ mF = MET_GetFieldRecord("ElementType", &m_Fields);
+ if(mF && mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_ElementType);
+ }
+
+ mF = MET_GetFieldRecord("ElementDataFile", &m_Fields);
+ if(mF && mF->defined)
+ {
+ strcpy(m_ElementDataFileName, (char *)(mF->value));
+ }
+
+ return true;
+ }
+
+bool MetaImage::
+ReadStream(int ndims, std::ifstream * stream)
+{
+ if(META_DEBUG) std::cout << "MetaImage: ReadStream" << std::endl;
+
+ M_Destroy();
+ Clear();
+
+ M_SetupReadFields();
+
+ MET_FieldRecordType * mF = MET_GetFieldRecord("NDims", &m_Fields);
+ mF->value[0] = ndims;
+ mF->defined = true;
+
+ if(m_ReadStream)
+ {
+ delete m_ReadStream;
+ }
+
+ m_ReadStream = stream;
+
+ if(!M_Read())
+ {
+ std::cout << "MetaImage: Read: Cannot parse file" << std::endl;
+ return false;
+ }
+
+ InitializeEssential(m_NDims,
+ m_DimSize,
+ m_ElementSpacing,
+ m_ElementType,
+ m_ElementNumberOfChannels,
+ NULL);
+
+ int i, j;
+ bool usePath;
+ char pathName[255];
+ char fName[255];
+ usePath = MET_GetFilePath(m_FileName, pathName);
+
+ if(!strcmp("Local", m_ElementDataFileName) ||
+ !strcmp("LOCAL", m_ElementDataFileName) ||
+ !strcmp("local", m_ElementDataFileName))
+ {
+ M_ReadElements(m_ReadStream, m_ElementData, m_Quantity);
+ }
+ else if(!strncmp("LIST", m_ElementDataFileName,4))
+ {
+ int fileImageDim = 0;
+ char junk[255];
+ sscanf( m_ElementDataFileName,"%s %d",junk, &fileImageDim);
+ if ( (fileImageDim == 0) || (fileImageDim > m_NDims) )
+ {
+ // if optional file dimension size is not give or is larger than
+ // overall dimension then default to a size of m_NDims - 1.
+ fileImageDim = m_NDims-1;
+ }
+ char s[255];
+ std::ifstream* readStreamTemp = new std::ifstream;
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ elementSize *= m_ElementNumberOfChannels;
+ int totalFiles = 1;
+ for (i = m_NDims; i > fileImageDim; i--)
+ {
+ totalFiles *= m_DimSize[i-1];
+ }
+ for(i=0; i< totalFiles && !m_ReadStream->eof(); i++)
+ {
+ m_ReadStream->getline(s, 255);
+ if(!m_ReadStream->eof())
+ {
+ j = strlen(s)-1;
+ while(j>0 && (isspace(s[j]) || !isprint(s[j])))
+ {
+ s[j--] = '\0';
+ }
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, s);
+ }
+ else
+ {
+ strcpy(fName, s);
+ }
+
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: cannot open slice" << std::endl;
+ continue;
+ }
+ M_ReadElements(readStreamTemp,
+ &(((char *)m_ElementData)[i*m_SubQuantity[fileImageDim]*
+ elementSize]),
+ m_SubQuantity[fileImageDim]);
+ readStreamTemp->close();
+ }
+ }
+ delete readStreamTemp;
+ }
+ else if(strstr(m_ElementDataFileName, "%"))
+ {
+ int nWrds;
+ char **wrds;
+ int minV = 1;
+ int maxV = m_DimSize[m_NDims-1];
+ int stepV = 1;
+ char s[255];
+ std::ifstream* readStreamTemp = new std::ifstream;
+ MET_StringToWordArray(m_ElementDataFileName, &nWrds, &wrds);
+ if(nWrds > 2)
+ {
+ minV = (int)atof(wrds[1]);
+ }
+ if(nWrds > 3)
+ {
+ maxV = (int)atof(wrds[2]);
+ }
+ if(nWrds > 4)
+ {
+ stepV = (int)atof(wrds[3]);
+ }
+ for(i=minV; i<=maxV; i += stepV)
+ {
+ sprintf(s, wrds[0], i);
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, fName);
+ }
+ else
+ {
+ strcpy(fName, s);
+ }
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: cannot construct file" << std::endl;
+ continue;
+ }
+
+ M_ReadElements(readStreamTemp,
+ &(((char *)m_ElementData)[m_SubQuantity[m_NDims-1]*i]),
+ m_SubQuantity[m_NDims-1]);
+
+ readStreamTemp->close();
+ }
+ delete readStreamTemp;
+ }
+ else
+ {
+ if(usePath)
+ {
+ sprintf(fName, "%s%s", pathName, m_ElementDataFileName);
+ std::cout << "MetaImage: Read: Element file with path = " << fName
+ << std::endl;
+ }
+ else
+ {
+ strcpy(fName, m_ElementDataFileName);
+ if(META_DEBUG)
+ {
+ std::cout << "MetaImage: Read: Element file = " << fName << std::endl;
+ }
+ }
+ std::ifstream* readStreamTemp = new std::ifstream;
+ readStreamTemp->open(fName, std::ios::binary | std::ios::in);
+ if(!readStreamTemp->is_open())
+ {
+ std::cout << "MetaImage: Read: Cannot open data file" << std::endl;
+ return false;
+ }
+ M_ReadElements(readStreamTemp, m_ElementData, m_Quantity);
+ readStreamTemp->close();
+ delete readStreamTemp;
+ }
+
+ m_ReadStream=NULL;
+
+ return true;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaImage.h b/Utilities/ITK/Utilities/MetaIO/metaImage.h
new file mode 100644
index 0000000000000000000000000000000000000000..a1206d9db593eaa395f046e592e9970218d8db3f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaImage.h
@@ -0,0 +1,261 @@
+#ifndef METAIMAGE_H
+#define METAIMAGE_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <metaImageTypes.h>
+#include <metaImageUtils.h>
+
+/*! MetaImage (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaImageFiles.
+ * MetaImageFiles can be in one of two possible formats:
+ * a combined header/data format, typically designated .mha files
+ * or as separate header and data files, typically designated .mhd and .mda files
+ *
+ * Features:
+ * Header information is in ascii format - for easy creation, editing, and review.
+ * If separate files are used, a specified number of header-bytes in the datafile can be skipped
+ * - in this manner, different file formats (e.g., bmp, img, and /usr/Image) can
+ * be converted to metaImageFile format by merely specifying a separate text header
+ * (.mhd) file and in that file specifying how many data-header-bytes should be skipped.
+ * Thereby the data files can serve a dual role (as bitmap files and as metaImage data files)
+ * Supports all pixel formats
+ * Handles byte ordering (MSB/LSB)
+ * Provides the ability to handle associated medical image information (element size, element spacing, etc).
+ * Has required and optional header data (provides rapid formation or extensive documentation).
+ * REQUIRED: NDims, DimSize, ByteOrderMSB, DataFileName
+ *
+ * \author Stephen R. Aylward
+ *
+ * \date August 29, 1999
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaFileLib.h
+ */
+class MetaImage : public MetaObject
+ {
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ char m_ElementDataFileName[255];
+
+ int m_DimSize[10];
+ int m_Quantity;
+ int m_SubQuantity[10];
+
+ MET_ImageModalityEnumType m_Modality;
+
+ int m_HeaderSize;
+
+ float m_SequenceID[4];
+
+ bool m_ElementSizeValid;
+ float m_ElementSize[10];
+
+ MET_ValueEnumType m_ElementType;
+ int m_ElementNumberOfChannels;
+
+ bool m_ElementMinMaxValid;
+ double m_ElementMin;
+ double m_ElementMax;
+
+ bool m_AutoFreeElementData;
+ void * m_ElementData;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_ReadElements(std::ifstream * _fstream, void * _data,
+ int _dataQuantity);
+
+ bool M_Read(void);
+
+ unsigned char * m_CompressedElementData;
+ unsigned char * PerformCompression(unsigned char *source,int quantity);
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaImage(void);
+
+ MetaImage(const char *_headerName);
+
+ MetaImage(MetaImage *_im); // share memory
+
+ MetaImage(int _nDims,
+ const int * _dimSize,
+ const float *_elementSpacing,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels=1,
+ void *_elementData=NULL);
+
+ MetaImage(int _x, int _y,
+ float _elementSpacingX,
+ float _elementSpacingY,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels=1,
+ void *_elementData=NULL);
+
+ MetaImage(int _x, int _y, int _z,
+ float _elementSpacingX,
+ float _elementSpacingY,
+ float _elementSpacingZ,
+ MET_ValueEnumType _elementType,
+ int _elementNumberOfChannels=1,
+ void *_elementData=NULL);
+
+ ~MetaImage(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaImage * _im);
+
+ int HeaderSize(void) const;
+ void HeaderSize(int _headerSize);
+
+ ////
+ //
+ // Utility Code
+ //
+ ////
+
+ MET_ImageModalityEnumType Modality(void) const;
+ void Modality(MET_ImageModalityEnumType _modality);
+
+ // DimSize(...)
+ // REQUIRED Field
+ // Number of elements along each dimension
+ const int * DimSize(void) const;
+ int DimSize(int _i) const;
+ //void DimSize(const int * _dimSize);
+ //void DimSize(int _i, int _value);
+
+ // Quantity()
+ // Not a field in file
+ // Total number of elements in image (Prod(dimSize[i]))
+ int Quantity(void) const;
+
+ // SubQuantity(...)
+ // Not a field in file
+ // Number of elements in image spanning sub-dimensions
+ // E.g., elements per line, 2D sub-image, 3D sub-volume,
+ const int * SubQuantity(void) const;
+ int SubQuantity(int _i) const;
+
+ // SequenceID(...)
+ // Optional Field
+ // DICOM designation of this image relative to other images
+ // acquired at the same time
+ const float * SequenceID(void) const;
+ float SequenceID(int _i) const;
+ void SequenceID(const float * _sequenceID);
+ void SequenceID(int _i, float _value);
+
+ // ElemSize(...)
+ // Optional Field
+ // Physical size (in MM) of each element in the image
+ // (0 = xSize, 1 = ySize, 2 = zSize)
+ void ElementSizeValid(bool _elementSizeValid);
+ bool ElementSizeValid(void) const;
+ const float * ElementSize(void) const;
+ float ElementSize(int i) const;
+ void ElementSize(const float * _pointSize);
+ void ElementSize(int _i, float _value);
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ int ElementNumberOfChannels(void) const;
+ void ElementNumberOfChannels(int _elementNumberOfChannels);
+
+ // ElemMakeByteOrderMSB(), ElemMakeByteOrderLSB(),
+ // ElemByteOrderSwap(), ElemByteOrderFix()
+ // The following functions are available only after
+ // ReadImageData() or if _read_and_close=TRUE when read
+ void ElementByteOrderSwap(void);
+ bool ElementByteOrderFix(void);
+
+ // Min(...) Max(...)
+ // The default max returned is the largest allowed by
+ // ElemNBytes (12 bit uint16_t will give 4096 max).
+ // This may not represent the true max. Use _reCalc=true
+ // to force a calcuation of the actual max element value.
+ bool ElementMinMaxValid(void) const;
+ void ElementMinMaxValid(bool _elementMinMaxValid);
+ void ElementMinMaxRecalc(void);
+ double ElementMin(void) const;
+ void ElementMin(double _elementMin);
+ double ElementMax(void) const;
+ void ElementMax(double _elementMax);
+
+ // ConverTo(...)
+ // Converts to a new data type
+ // Rescales using Min and Max (see above)
+ bool ConvertElementDataTo(MET_ValueEnumType _elementType=MET_UCHAR,
+ double _toMin=0, double _toMax=0);
+
+ //
+ //
+ //
+ void * ElementData(void);
+ double ElementData(int _i) const;
+ void ElementData(void * _data);
+ bool ElementData(int _i, double _v);
+
+ bool AutoFreeElementData(void) const;
+ void AutoFreeElementData(bool _freeData);
+
+ //
+ //
+ //
+ const char * ElementDataFileName(void) const;
+ void ElementDataFileName(const char * _dataFileName);
+
+ //
+ //
+ //
+ virtual bool Read(const char *_headerName=NULL, bool _readElements=true,
+ void * _buffer=NULL);
+
+ virtual bool Write(const char *_headName=NULL, const char *_dataName=NULL,
+ bool _writeElements=true);
+
+ virtual bool Append(const char *_headName=NULL);
+
+ bool ReadStream(int _nDims, std::ifstream * _stream);
+
+ void Clear(void);
+
+ bool InitializeEssential(int _nDims,
+ const int * _dimSize,
+ const float * _elementSpacing,
+ MET_ValueEnumType _elementType,
+ const int _elementNumberOfChannels=1,
+ void *_elementData=NULL,
+ bool _allocElementMemory=true);
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaImageTypes.h b/Utilities/ITK/Utilities/MetaIO/metaImageTypes.h
new file mode 100644
index 0000000000000000000000000000000000000000..4fa542f6b1f857e30dd44ca4b913a43b743c814a
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaImageTypes.h
@@ -0,0 +1,17 @@
+#ifndef METAIMAGETYPES_H
+#define METAIMAGETYPES_H
+
+typedef enum { MET_MOD_CT, MET_MOD_MR, MET_MOD_NM, MET_MOD_US, MET_MOD_OTHER,
+ MET_MOD_UNKNOWN } MET_ImageModalityEnumType;
+
+#define MET_NUM_IMAGE_MODALITY_TYPES 6
+
+const char MET_ImageModalityTypeName[MET_NUM_IMAGE_MODALITY_TYPES][17] = {
+ {'M','E','T','_','M','O','D','_','C','T','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','M','O','D','_','M','R','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','M','O','D','_','N','M','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','M','O','D','_','U','S','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','M','O','D','_','O','T','H','E','R','\0',' ',' ',' '},
+ {'M','E','T','_','M','O','D','_','U','N','K','N','O','W','N','\0',' '}};
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaImageUtils.cxx b/Utilities/ITK/Utilities/MetaIO/metaImageUtils.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bdcd5c2c782e12b1fde705e7c02cd03781dcf6e6
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaImageUtils.cxx
@@ -0,0 +1,32 @@
+#ifndef METAIMAGEUTILS_H
+#define METAIMAGEUTILS_H
+
+#include <stdio.h>
+#include <string.h>
+#include <metaImageTypes.h>
+
+bool MET_StringToImageModality(const char * _str,
+ MET_ImageModalityEnumType * _type)
+ {
+ int i;
+
+ for(i=0; i<MET_NUM_IMAGE_MODALITY_TYPES; i++)
+ if(!strcmp(MET_ImageModalityTypeName[i], _str))
+ {
+ *_type = (MET_ImageModalityEnumType)i;
+ return true;
+ }
+
+ *_type = MET_MOD_UNKNOWN;
+
+ return false;
+ }
+
+bool MET_ImageModalityToString(MET_ImageModalityEnumType _type,
+ char * _str)
+ {
+ strcpy(_str, MET_ImageModalityTypeName[(int)_type]);
+ return true;
+ }
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaImageUtils.h b/Utilities/ITK/Utilities/MetaIO/metaImageUtils.h
new file mode 100644
index 0000000000000000000000000000000000000000..fff37c2985e7b9091139508300a8b3864c5fc5ea
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaImageUtils.h
@@ -0,0 +1,12 @@
+#ifndef METAIMAGEUTILS_H
+#define METAIMAGEUTILS_H
+
+#include <metaImageTypes.h>
+
+extern bool MET_StringToImageModality(const char * _str,
+ MET_ImageModalityEnumType * _type);
+
+extern bool MET_ImageModalityToString(MET_ImageModalityEnumType _type,
+ char * _str);
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaLandmark.cxx b/Utilities/ITK/Utilities/MetaIO/metaLandmark.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..eb7fe674e20c825d33b2b6be20a288b74d63c455
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaLandmark.cxx
@@ -0,0 +1,429 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaLandmark.h>
+
+//
+// MedImage Constructors
+//
+MetaLandmark::
+MetaLandmark()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaLandmark()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+}
+
+//
+MetaLandmark::
+MetaLandmark(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaLandmark()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaLandmark::
+MetaLandmark(const MetaLandmark *_tube)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaLandmark()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+ CopyInfo(_tube);
+}
+
+
+
+//
+MetaLandmark::
+MetaLandmark(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaLandmark()" << std::endl;
+ m_NPoints = 0;
+ Clear();
+}
+
+//
+MetaLandmark::
+~MetaLandmark()
+{
+ Clear();
+ M_Destroy();
+}
+
+//
+void MetaLandmark::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaLandmark::
+CopyInfo(const MetaLandmark * _tube)
+{
+ MetaObject::CopyInfo(_tube);
+}
+
+
+
+void MetaLandmark::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaLandmark::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaLandmark::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaLandmark::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+
+/** Clear tube information */
+void MetaLandmark::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaLandmark: Clear" << std::endl;
+ MetaObject::Clear();
+ if(META_DEBUG) std::cout << "MetaLandmark: Clear: m_NPoints" << std::endl;
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ LandmarkPnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ m_NPoints = 0;
+ strcpy(m_PointDim, "x y z red green blue alpha");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy tube information */
+void MetaLandmark::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaLandmark::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaLandmark: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+MET_ValueEnumType MetaLandmark::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaLandmark::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+
+void MetaLandmark::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Landmark");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ char s[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_ElementType, s);
+ MET_InitWriteField(mF, "ElementType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+
+
+bool MetaLandmark::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaLandmark: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaLandmark: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaLandmark: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_ElementType);
+ }
+
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+ int* posDim= new int[m_NDims];
+ int i;
+ for(i= 0; i < m_NDims; i++)
+ {
+ posDim[i] = -1;
+ }
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+
+ int j;
+ for(j = 0; j < pntDim; j++)
+ {
+ if(!strcmp(pntVal[j], "x") || !strcmp(pntVal[j], "X"))
+ {
+ posDim[0] = j;
+ }
+ if(!strcmp(pntVal[j], "y") || !strcmp(pntVal[j], "Y"))
+ {
+ posDim[1] = j;
+ }
+ if(!strcmp(pntVal[j], "z") || !strcmp(pntVal[j], "Z"))
+ {
+ posDim[2] = j;
+ }
+
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+ float v[16];
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims+4)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLandmark: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ int d;
+ double td;
+ for(j=0; j<m_NPoints; j++)
+ {
+ LandmarkPnt* pnt = new LandmarkPnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ LandmarkPnt* pnt = new LandmarkPnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ int d;
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[posDim[d]];
+ }
+
+ for(d=0; d<4; d++)
+ {
+ pnt->m_Color[d] = v[d+m_NDims];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ delete [] posDim;
+ return true;
+}
+
+
+bool MetaLandmark::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaLandmark: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims+4)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ for(d = 0; d < 4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+ it++;
+ }
+ m_WriteStream->write((char *)data,(m_NDims+4)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ for(d = 0; d < 4; d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+
+ return true;
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaLandmark.h b/Utilities/ITK/Utilities/MetaIO/metaLandmark.h
new file mode 100644
index 0000000000000000000000000000000000000000..27df1429bdc14f354b42f9f43e9acb16375507bb
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaLandmark.h
@@ -0,0 +1,137 @@
+#ifndef METALANDMARK_H
+#define METALANDMARK_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaLandmark (.h and .cxx)
+ *
+ * Description:
+ * Reads and Writes MetaLandmarkFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date July 02, 2002
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaFileLib.h
+ */
+
+class LandmarkPnt
+{
+public:
+
+ LandmarkPnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ }
+
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ }
+ ~LandmarkPnt()
+ {
+ delete []m_X;
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ float m_Color[4];
+};
+
+
+
+
+class MetaLandmark : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<LandmarkPnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaLandmark(void);
+
+ MetaLandmark(const char *_headerName);
+
+ MetaLandmark(const MetaLandmark *_tube);
+
+ MetaLandmark(unsigned int dim);
+
+ ~MetaLandmark(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaLandmark * _tube);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the tube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ MET_ValueEnumType m_ElementType;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaLine.cxx b/Utilities/ITK/Utilities/MetaIO/metaLine.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d1e27f82d87b3394e8149eb5fb5fc28c34759356
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaLine.cxx
@@ -0,0 +1,445 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaLine.h>
+
+//
+// MetaLine Constructors
+//
+MetaLine::
+MetaLine()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaLine()" << std::endl;
+ Clear();
+}
+
+//
+MetaLine::
+MetaLine(const char *_headerName)
+:MetaObject(_headerName)
+{
+ if(META_DEBUG) std::cout << "MetaLine()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaLine::
+MetaLine(const MetaLine *_line)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaLine()" << std::endl;
+ Clear();
+ CopyInfo(_line);
+}
+
+
+
+//
+MetaLine::
+MetaLine(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaLine()" << std::endl;
+ Clear();
+}
+
+//
+MetaLine::
+~MetaLine()
+{
+ Clear();
+ M_Destroy();
+}
+
+//
+void MetaLine::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaLine::
+CopyInfo(const MetaLine * _line)
+{
+ MetaObject::CopyInfo(_line);
+}
+
+
+
+void MetaLine::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaLine::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaLine::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaLine::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+/** Clear line information */
+void MetaLine::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaLine: Clear" << std::endl;
+ MetaObject::Clear();
+ m_NPoints = 0;
+ // Delete the list of pointers to lines.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ LinePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+
+ strcpy(m_PointDim, "x y z v1x v1y v1z");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy line information */
+void MetaLine::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaLine::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaLine: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ //int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaLine::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Line");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ char s[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_ElementType, s);
+ MET_InitWriteField(mF, "ElementType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+MET_ValueEnumType MetaLine::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaLine::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+
+bool MetaLine::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaLine: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaLine: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaLine: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_ElementType);
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+ int ii;
+ for(ii=0;ii<pntDim;ii++)
+ {
+ delete [] pntVal[ii];
+ }
+ delete [] pntVal;
+
+ float v[16];
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims*m_NDims+4)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLine: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ int i=0;
+ double td;
+ int d;
+ for(int j=0; j<m_NPoints; j++)
+ {
+ LinePnt* pnt = new LinePnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ for(int l=0;l<m_NDims-1;l++)
+ {
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V[l][d] = (float)td;
+ }
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(int j=0; j<m_NPoints; j++)
+ {
+ LinePnt* pnt = new LinePnt(m_NDims);
+
+ int k;
+ int d;
+ for(k=0; k<m_NDims; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ //float* x = new float[m_NDims];
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[d];
+ }
+
+ //pnt.m_X = x;
+
+ for(k=0; k<m_NDims-1; k++)
+ {
+ for(int jj=0; jj<m_NDims; jj++)
+ {
+ *m_ReadStream >> v[jj];
+ m_ReadStream->get();
+ }
+
+ //float* n = new float[m_NDims];
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_V[k][d] = v[d];
+ }
+ //pnt.m_V[k] = n;
+ }
+ for(k=0; k<4; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ pnt->m_Color[k] = v[k];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognized characters
+ }
+ }
+
+ return true;
+}
+
+
+bool MetaLine::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaLine: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims*m_NDims+4)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ for(int j=0;j<m_NDims-1;j++)
+ {
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V[j][d],m_ElementType,data,i++);
+ }
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,(m_NDims*m_NDims+4)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ for(d = 0; d < m_NDims-1; d++)
+ {
+ for(int i = 0; i < m_NDims; i++)
+ {
+ *m_WriteStream << (*it)->m_V[d][i] << " ";
+ }
+ }
+
+ for(d=0;d<4;d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+
+ return true;
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaLine.h b/Utilities/ITK/Utilities/MetaIO/metaLine.h
new file mode 100644
index 0000000000000000000000000000000000000000..cf8fc10c0948e0269e840d2e19fde221c2c07af2
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaLine.h
@@ -0,0 +1,151 @@
+#ifndef METALINE_H
+#define METALINE_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaLine (.h and .cxx)
+ *
+ * Description:
+ * Reads and Writes MetaLineFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date July 02, 2002
+ *
+ */
+
+class LinePnt
+{
+public:
+
+ LinePnt(int dim)
+ {
+ m_Dim = dim;
+
+ m_X = new float[m_Dim];
+ m_V = new float*[m_Dim-1];
+
+ for(unsigned int i=0;i<m_Dim-1;i++)
+ {
+ m_V[i] = new float[m_Dim];
+ for(unsigned int j=0;j<m_Dim;j++)
+ {
+ m_V[i][j] = 0;
+ m_X[j] = 0;
+ }
+ }
+
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ }
+
+ ~LinePnt()
+ {
+ delete [] m_X;
+ for(unsigned int i=0;i<m_Dim-1;i++)
+ {
+ delete [] m_V[i];
+ }
+ delete [] m_V;
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ float** m_V;
+ float m_Color[4];
+};
+
+
+
+
+class MetaLine : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<LinePnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaLine(void);
+
+ MetaLine(const char *_headerName);
+
+ MetaLine(const MetaLine *_line);
+
+ MetaLine(unsigned int dim);
+
+ ~MetaLine(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaLine * _line);
+
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the line
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ MET_ValueEnumType m_ElementType;
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaMesh.cxx b/Utilities/ITK/Utilities/MetaIO/metaMesh.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d7a40145173af27b7a1b19530a587055ce9cac9b
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaMesh.cxx
@@ -0,0 +1,1274 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaMesh.h>
+
+//
+// MetaMesh Constructors
+//
+MetaMesh::
+MetaMesh()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaMesh()" << std::endl;
+ m_NPoints = 0;
+
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ m_CellListArray[i] = NULL;
+ }
+ Clear();
+}
+
+//
+MetaMesh::
+MetaMesh(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaMesh()" << std::endl;
+ m_NPoints = 0;
+
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ m_CellListArray[i] = NULL;
+ }
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaMesh::
+MetaMesh(const MetaMesh *_mesh)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaMesh()" << std::endl;
+ m_NPoints = 0;
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ m_CellListArray[i] = NULL;
+ }
+ Clear();
+ CopyInfo(_mesh);
+}
+
+
+
+//
+MetaMesh::
+MetaMesh(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaMesh()" << std::endl;
+ m_NPoints = 0;
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ m_CellListArray[i] = NULL;
+ }
+ Clear();
+}
+
+/** Destructor */
+MetaMesh::
+~MetaMesh()
+{
+ Clear();
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ delete m_CellListArray[i];
+ m_CellListArray[i] = NULL;
+ }
+
+ M_Destroy();
+}
+
+//
+void MetaMesh::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_PointType, str);
+ std::cout << "PointType = " << str << std::endl;
+ MET_TypeToString(m_PointDataType, str);
+ std::cout << "PointDataType = " << str << std::endl;
+ MET_TypeToString(m_CellDataType, str);
+ std::cout << "CellDataType = " << str << std::endl;
+}
+
+void MetaMesh::
+CopyInfo(const MetaMesh * _tube)
+{
+ MetaObject::CopyInfo(_tube);
+}
+
+int MetaMesh::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+int MetaMesh::
+NCells(void) const
+{
+ return m_NCells;
+}
+
+int MetaMesh::
+NCellLinks(void) const
+{
+ return m_NCellLinks;
+}
+
+/** Clear tube information */
+void MetaMesh::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaMesh: Clear" << std::endl;
+ MetaObject::Clear();
+ if(META_DEBUG) std::cout << "MetaMesh: Clear: m_NPoints" << std::endl;
+
+ // Delete the list of pointers to points.
+ PointListType::iterator it_pnt = m_PointList.begin();
+ while(it_pnt != m_PointList.end())
+ {
+ MeshPoint* pnt = *it_pnt;
+ it_pnt++;
+ delete pnt;
+ }
+
+ // Delete the list of pointers to celllinks
+ CellLinkListType::iterator it_celllinks = m_CellLinks.begin();
+ while(it_celllinks != m_CellLinks.end())
+ {
+ MeshCellLink* link = *it_celllinks;
+ it_celllinks++;
+ delete link;
+ }
+
+ // Delete the list of pointers to pointdata
+ PointDataListType::iterator it_pointdata = m_PointData.begin();
+ while(it_pointdata != m_PointData.end())
+ {
+ MeshDataBase* data = *it_pointdata;
+ it_pointdata++;
+ delete data;
+ }
+
+ // Delete the list of pointers to celldata
+ CellDataListType::iterator it_celldata = m_CellData.begin();
+ while(it_celldata != m_CellData.end())
+ {
+ MeshDataBase* data = *it_celldata;
+ it_celldata++;
+ delete data;
+ }
+
+ // Initialize the new array
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ if(m_CellListArray[i])
+ {
+ // Delete the list of pointers to cells.
+ CellListType::iterator it_cell = m_CellListArray[i]->begin();
+ while(it_cell != m_CellListArray[i]->end())
+ {
+ MeshCell* cell = *it_cell;
+ it_cell++;
+ delete cell;
+ }
+ delete m_CellListArray[i];
+ }
+ m_CellListArray[i] = new CellListType;
+ }
+
+ m_PointList.clear();
+ m_PointData.clear();
+ m_CellData.clear();
+
+ m_NPoints = 0;
+ m_NCells = 0;
+ m_NCellLinks=0;
+ m_NCellData = 0;
+ m_NPointData = 0;
+ strcpy(m_PointDim, "ID x y ...");
+ m_PointType = MET_FLOAT;
+ m_PointDataType = MET_FLOAT;
+ m_CellDataType = MET_FLOAT;
+}
+
+/** Destroy tube information */
+void MetaMesh::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaMesh::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaMesh: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NCellTypes", MET_INT,true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDataType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellDataType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+
+}
+
+void MetaMesh::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Mesh");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ char s[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_PointType, s);
+ MET_InitWriteField(mF, "PointType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ // Find the pointDataType
+ if(m_PointData.size()>0)
+ {
+ m_PointDataType = (*m_PointData.begin())->GetMetaType();
+ }
+
+ char s1[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_PointDataType, s1);
+ MET_InitWriteField(mF, "PointDataType", MET_STRING, strlen(s1), s1);
+ m_Fields.push_back(mF);
+
+ char s2[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_CellDataType, s2);
+ MET_InitWriteField(mF, "CellDataType", MET_STRING, strlen(s2), s2);
+ m_Fields.push_back(mF);
+
+ unsigned int numberOfCellTypes = 0;
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ if(m_CellListArray[i]->size()>0)
+ {
+ numberOfCellTypes++;
+ }
+ }
+ if(numberOfCellTypes)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NCellTypes", MET_INT,numberOfCellTypes);
+ m_Fields.push_back(mF);
+ }
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+}
+
+
+
+bool MetaMesh::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaMesh: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaMesh: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaMesh: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ unsigned int numberOfCellTypes =0;
+ mF = MET_GetFieldRecord("NCellTypes", &m_Fields);
+ if(mF->defined)
+ {
+ numberOfCellTypes= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("PointType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_PointType);
+ }
+
+ mF = MET_GetFieldRecord("PointDataType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_PointDataType);
+ }
+
+ mF = MET_GetFieldRecord("CellDataType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_CellDataType);
+ }
+
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+ int j;
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_PointType, &elementSize);
+ int readSize = m_NPoints*(m_NDims)*elementSize+m_NPoints*sizeof(int);
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaMesh: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ int i=0;
+ int d;
+ double td;
+ for(j=0; j<m_NPoints; j++)
+ {
+ MeshPoint* pnt = new MeshPoint(m_NDims);
+
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ pnt->m_Id=static_cast<int>(td);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_PointType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ MeshPoint* pnt = new MeshPoint(m_NDims);
+
+ float v[10];
+ for(int k=0; k<m_NDims+1; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ int d;
+ pnt->m_Id=(int)v[0];
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[d+1];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+
+ // Now reading the cells
+ for(unsigned int nCellType=0;nCellType<numberOfCellTypes;nCellType++)
+ {
+ MetaObject::ClearFields();
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellType", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NCells", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Cells", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ if(!MET_Read(*m_ReadStream, & m_Fields))
+ {
+ std::cout << "MetaObject: Read: MET_Read Failed" << std::endl;
+ return false;
+ }
+
+ mF = MET_GetFieldRecord("NCells", &m_Fields);
+ if(mF->defined)
+ {
+ m_NCells= (int)mF->value[0];
+ }
+
+ MET_CellGeometry celltype = MET_VERTEX_CELL;
+
+ mF = MET_GetFieldRecord("CellType", &m_Fields);
+ if(mF->defined)
+ {
+ for(j=0;j<MET_NUM_CELL_TYPES;j++)
+ {
+ if(!strncmp((char *)(mF->value),MET_CellTypeName[j],3))
+ {
+ celltype=(MET_CellGeometry)j;
+ }
+ }
+ }
+
+ if(m_BinaryData)
+ {
+ unsigned int totalcellsize = (MET_CellSize[celltype]+1)*m_NCells;
+ int readSize = totalcellsize*sizeof(int);
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaMesh: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ int i=0;
+ int d;
+ double td;
+ for(j=0; j<m_NCells; j++)
+ {
+ int n = MET_CellSize[celltype];
+ MeshCell* cell = new MeshCell(n);
+
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ cell->m_Id = (int)td;
+
+ for(d=0; d<n; d++)
+ {
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ cell->m_PointsId[d] = (int)td;
+ }
+
+ m_CellListArray[celltype]->push_back(cell);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NCells; j++)
+ {
+ int v;
+ int n = MET_CellSize[celltype];
+ MeshCell* cell = new MeshCell(MET_CellSize[celltype]);
+
+ *m_ReadStream >> v;
+ m_ReadStream->get();
+ cell->m_Id = v;
+
+ for(int k=0; k<n; k++)
+ {
+ *m_ReadStream >> v;
+ m_ReadStream->get();
+ cell->m_PointsId[k] = v;
+ }
+ m_CellListArray[celltype]->push_back(cell);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognized characters
+ }
+ }
+ }
+
+ long int pos = m_ReadStream->tellg();
+
+ // Now reading the cell links
+ MetaObject::ClearFields();
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NCellLinks", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellLinksSize", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellLinks", MET_NONE, false);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ if(!MET_Read(*m_ReadStream, & m_Fields,'=',false,false))
+ {
+ std::cout << "MetaObject: Read: MET_Read Failed" << std::endl;
+ return false;
+ }
+
+ mF = MET_GetFieldRecord("NCellLinks", &m_Fields);
+ if(mF->defined)
+ {
+ m_NCellLinks= (int)mF->value[0];
+ }
+
+ unsigned int totalCellLink=0;
+ mF = MET_GetFieldRecord("CellLinksSize", &m_Fields);
+ if(m_BinaryData)
+ {
+ if(mF->defined)
+ {
+ totalCellLink= (int)mF->value[0];
+ }
+ }
+
+ if(m_BinaryData)
+ {
+ int readSize = totalCellLink*sizeof(int);
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaMesh: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+ int i=0;
+ int d;
+ double td;
+ for(j=0; j<m_NCellLinks; j++)
+ {
+ MeshCellLink* link = new MeshCellLink();
+
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ link->m_Id = (int)td;
+
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ int n = (int)td;
+
+ for(d=0; d<n; d++)
+ {
+ MET_ValueToDouble(MET_INT, _data, i++, &td);
+ link->m_Links.push_back((int)td);
+ }
+ m_CellLinks.push_back(link);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NCellLinks; j++)
+ {
+ int v;
+ MeshCellLink* link = new MeshCellLink();
+
+ *m_ReadStream >> v;
+ m_ReadStream->get();
+ link->m_Id = v;
+
+ *m_ReadStream >> v;
+ m_ReadStream->get();
+ int count = v;
+
+ for(int i=0;i<count;i++)
+ {
+ *m_ReadStream >> v;
+ m_ReadStream->get();
+ link->m_Links.push_back(v);
+ }
+ m_CellLinks.push_back(link);
+ }
+
+ if(m_NCellLinks > 0)
+ {
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognized characters
+ }
+ }
+ }
+
+ if(m_NCellLinks == 0)
+ {
+ m_ReadStream->clear();
+ m_ReadStream->seekg(pos,std::ios::beg);
+ }
+ pos = m_ReadStream->tellg();
+
+ // Now reading the point data
+ MetaObject::ClearFields();
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPointData", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDataSize", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointData", MET_NONE, false);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ if(!MET_Read(*m_ReadStream, & m_Fields,'=',false,false))
+ {
+ std::cout << "MetaObject: Read: MET_Read Failed" << std::endl;
+ return false;
+ }
+
+ mF = MET_GetFieldRecord("NPointData", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPointData= (int)mF->value[0];
+ }
+
+ unsigned int pointDataSize=0;
+ mF = MET_GetFieldRecord("PointDataSize", &m_Fields);
+ if(mF->defined)
+ {
+ pointDataSize= (int)mF->value[0];
+ }
+
+ char* _data = new char[pointDataSize];
+ m_ReadStream->read((char *)_data, pointDataSize);
+
+ unsigned int gc = m_ReadStream->gcount();
+ if(gc != pointDataSize)
+ {
+ std::cout << "MetaMesh: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << pointDataSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+ int i=0;
+ double td;
+
+ for(j=0; j<m_NPointData; j++)
+ {
+ MeshDataBase* pd;
+
+ unsigned int k;
+ char* num = new char[sizeof(int)];
+ for(k=0;k<sizeof(int);k++)
+ {
+ num[k] = _data[i+k];
+ }
+ td = (double)((int*)num)[0];
+
+ delete [] num;
+ i+=sizeof(int);
+
+ int elementSize;
+ MET_SizeOfType(m_PointDataType, &elementSize);
+ num = new char[elementSize];
+ for(k=0;k<static_cast<unsigned int>(elementSize);k++)
+ {
+ num[k] = _data[i+k];
+ }
+ i+=elementSize;
+
+ if(m_PointDataType == MET_CHAR)
+ {
+ double val = (double)((char*)num)[0];
+ pd = new MeshData<char>();
+ static_cast<MeshData<char>*>(pd)->m_Data = (char)val;
+ }
+ else if(m_PointDataType == MET_UCHAR)
+ {
+ double val = (double)((unsigned char*)num)[0];
+ pd = new MeshData<unsigned char>();
+ static_cast<MeshData<unsigned char>*>(pd)->m_Data = (unsigned char)val;
+ }
+ else if(m_PointDataType == MET_SHORT)
+ {
+ double val = (double)((short*)num)[0];
+ pd = new MeshData<short>();
+ static_cast<MeshData<short>*>(pd)->m_Data = (short)val;
+ }
+ else if(m_PointDataType == MET_USHORT)
+ {
+ double val = (double)((unsigned short*)num)[0];
+ pd = new MeshData<unsigned short>();
+ static_cast<MeshData<unsigned short>*>(pd)->m_Data = (unsigned short)val;
+ }
+ else if(m_PointDataType == MET_INT)
+ {
+ double val = (double)((int*)num)[0];
+ pd = new MeshData<int>();
+ static_cast<MeshData<int>*>(pd)->m_Data = (int)val;
+ }
+ else if(m_PointDataType == MET_UINT)
+ {
+ double val = (double)((char*)num)[0];
+ pd = new MeshData<unsigned int>();
+ static_cast<MeshData<unsigned int>*>(pd)->m_Data = (unsigned int)val;
+ }
+ else if(m_PointDataType == MET_LONG)
+ {
+ double val = (double)((long*)num)[0];
+ pd = new MeshData<long>();
+ static_cast<MeshData<long>*>(pd)->m_Data = (long)val;
+ }
+ else if(m_PointDataType == MET_ULONG)
+ {
+ double val = (double)((unsigned long*)num)[0];
+ pd = new MeshData<unsigned long>();
+ static_cast<MeshData<unsigned long>*>(pd)->m_Data = (unsigned long)val;
+ }
+ else if(m_PointDataType == MET_FLOAT)
+ {
+ double val = (double)((float*)num)[0];
+ pd = new MeshData<float>();
+ static_cast<MeshData<float>*>(pd)->m_Data = (float)val;
+ }
+ else if(m_PointDataType == MET_DOUBLE)
+ {
+ double val = (double)((double*)num)[0];
+ pd = new MeshData<double>();
+ static_cast<MeshData<double>*>(pd)->m_Data = val;
+ }
+
+ delete [] num;
+ pd->m_Id = (int)td;
+ m_PointData.push_back(pd);
+ }
+ delete [] _data;
+
+ // If no point data, reset the pointer to the stream to the previous position
+ if(m_NPointData == 0)
+ {
+ m_ReadStream->clear();
+ m_ReadStream->seekg(pos,std::ios::beg);
+ }
+ pos = m_ReadStream->tellg();
+
+ // Now reading the cell data
+ MetaObject::ClearFields();
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NCellData", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellDataSize", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CellData", MET_NONE, false);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ if(!MET_Read(*m_ReadStream, & m_Fields,'=',false,false))
+ {
+ std::cout << "MetaObject: Read: MET_Read Failed" << std::endl;
+ return false;
+ }
+
+
+ mF = MET_GetFieldRecord("NCellData", &m_Fields);
+ if(mF->defined)
+ {
+ m_NCellData= (int)mF->value[0];
+ }
+
+ unsigned int cellDataSize=0;
+ mF = MET_GetFieldRecord("CellDataSize", &m_Fields);
+ if(mF->defined)
+ {
+ cellDataSize= (int)mF->value[0];
+ }
+
+ char* _celldata = new char[cellDataSize];
+ m_ReadStream->read((char *)_celldata, cellDataSize);
+
+ unsigned int gcCell = m_ReadStream->gcount();
+ if(gcCell != cellDataSize)
+ {
+ std::cout << "MetaMesh: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << cellDataSize << " : actual = " << gcCell << std::endl;
+ return false;
+ }
+
+ i=0;
+ for(j=0; j<m_NCellData; j++)
+ {
+ MeshDataBase* cd;
+
+ unsigned int k;
+ char* num = new char[sizeof(int)];
+ for(k=0;k<sizeof(int);k++)
+ {
+ num[k] = _celldata[i+k];
+ }
+ td = (double)((int*)num)[0];
+
+ delete [] num;
+ i+=sizeof(int);
+
+ int elementSize;
+ MET_SizeOfType(m_CellDataType, &elementSize);
+ num = new char[elementSize];
+ for(k=0;k<static_cast<unsigned int>(elementSize);k++)
+ {
+ num[k] = _celldata[i+k];
+ }
+ i+=elementSize;
+
+ if(m_CellDataType == MET_CHAR)
+ {
+ double val = (double)((char*)num)[0];
+ cd = new MeshData<char>();
+ static_cast<MeshData<char>*>(cd)->m_Data = (char)val;
+ }
+ else if(m_CellDataType == MET_UCHAR)
+ {
+ double val = (double)((unsigned char*)num)[0];
+ cd = new MeshData<unsigned char>();
+ static_cast<MeshData<unsigned char>*>(cd)->m_Data = (unsigned char)val;
+ }
+ else if(m_CellDataType == MET_SHORT)
+ {
+ double val = (double)((short*)num)[0];
+ cd = new MeshData<short>();
+ static_cast<MeshData<short>*>(cd)->m_Data = (short)val;
+ }
+ else if(m_CellDataType == MET_USHORT)
+ {
+ double val = (double)((unsigned short*)num)[0];
+ cd = new MeshData<unsigned short>();
+ static_cast<MeshData<unsigned short>*>(cd)->m_Data = (unsigned short)val;
+ }
+ else if(m_CellDataType == MET_INT)
+ {
+ double val = (double)((int*)num)[0];
+ cd = new MeshData<int>();
+ static_cast<MeshData<int>*>(cd)->m_Data = (int)val;
+ }
+ else if(m_CellDataType == MET_UINT)
+ {
+ double val = (double)((unsigned int*)num)[0];
+ cd = new MeshData<unsigned int>();
+ static_cast<MeshData<unsigned int>*>(cd)->m_Data = (unsigned int)val;
+ }
+ else if(m_CellDataType == MET_LONG)
+ {
+ double val = (double)((long*)num)[0];
+ cd = new MeshData<long>();
+ static_cast<MeshData<long>*>(cd)->m_Data = (long)val;
+ }
+ else if(m_CellDataType == MET_ULONG)
+ {
+ double val = (double)((unsigned long*)num)[0];
+ cd = new MeshData<unsigned long>();
+ static_cast<MeshData<unsigned long>*>(cd)->m_Data = (unsigned long)val;
+ }
+ else if(m_CellDataType == MET_FLOAT)
+ {
+ double val = (double)((float*)num)[0];
+ cd = new MeshData<float>();
+ static_cast<MeshData<float>*>(cd)->m_Data = (float)val;
+ }
+ else if(m_CellDataType == MET_DOUBLE)
+ {
+ double val = (double)((double*)num)[0];
+ cd = new MeshData<double>();
+ static_cast<MeshData<double>*>(cd)->m_Data = val;
+ }
+
+ delete [] num;
+
+ cd->m_Id = (int)td;
+ m_CellData.push_back(cd);
+ }
+
+ delete [] _celldata;
+
+ // If no cell data, reset the pointer to the stream to the previous position
+ if(m_NCellData == 0)
+ {
+ m_ReadStream->clear();
+ m_ReadStream->seekg(pos,std::ios::beg);
+ }
+
+ return true;
+}
+
+
+bool MetaMesh::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaMesh: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_PointType, &elementSize);
+
+ char* data = new char[(m_NDims)*m_NPoints*elementSize+m_NPoints*sizeof(int)];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ MET_DoubleToValue((double)(*it)->m_Id,MET_INT,data,i++);
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_PointType,data,i++);
+ }
+ it++;
+ }
+ m_WriteStream->write((char *)data,(m_NDims+1)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete []data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ *m_WriteStream << (*it)->m_Id << " ";
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+
+ // Loop trough the array of cell types and write them if they exists
+ for(unsigned int i=0;i<MET_NUM_CELL_TYPES;i++)
+ {
+ if(m_CellListArray[i]->size()>0)
+ {
+ // clear the fields and add new fields for a new write
+ MetaObject::ClearFields();
+ MET_FieldRecordType * mF;
+ if(strlen(MET_CellTypeName[i])>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CellType", MET_STRING,
+ strlen(MET_CellTypeName[i]),MET_CellTypeName[i]);
+ m_Fields.push_back(mF);
+ }
+
+ m_NCells = m_CellListArray[i]->size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NCells", MET_INT,m_NCells);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Cells", MET_NONE);
+ m_Fields.push_back(mF);
+
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaMesh: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all cells */
+ if(m_BinaryData)
+ {
+ unsigned int totalCellsSize = m_CellListArray[i]->size()*(MET_CellSize[i]+1);
+ char* data = new char[totalCellsSize*sizeof(int)];
+ unsigned int d;
+ int j=0;
+ CellListType::const_iterator it = m_CellListArray[i]->begin();
+ while(it != m_CellListArray[i]->end())
+ {
+ MET_DoubleToValue((double)(*it)->m_Id,MET_INT,data,j++);
+ for(d = 0; d < (*it)->m_Dim; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_PointsId[d],MET_INT,data,j++);
+ }
+ it++;
+ }
+ m_WriteStream->write((char *)data,totalCellsSize*sizeof(int));
+ m_WriteStream->write("\n",1);
+ delete []data;
+ }
+ else
+ {
+ CellListType::const_iterator it = m_CellListArray[i]->begin();
+
+ unsigned int d;
+ while(it != m_CellListArray[i]->end())
+ {
+ *m_WriteStream << (*it)->m_Id << " ";
+ for(d = 0; d < (*it)->m_Dim; d++)
+ {
+ *m_WriteStream << (*it)->m_PointsId[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+ }
+ }
+
+ // Now write the cell links
+ if(m_CellLinks.size()>0)
+ {
+ MetaObject::ClearFields();
+ m_NCellLinks = m_CellLinks.size();
+ MET_FieldRecordType * mF;
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NCellLinks", MET_INT,m_NCellLinks);
+ m_Fields.push_back(mF);
+
+ int cellLinksSize = 0;
+ if(m_BinaryData)
+ {
+ CellLinkListType::const_iterator it = m_CellLinks.begin();
+ while(it != m_CellLinks.end())
+ {
+ cellLinksSize += 2+(*it)->m_Links.size();
+ it++;
+ }
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CellLinksSize", MET_INT,cellLinksSize);
+ m_Fields.push_back(mF);
+ }
+
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CellLinks", MET_NONE);
+ m_Fields.push_back(mF);
+
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaMesh: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all cell links */
+ if(m_BinaryData)
+ {
+ char* data = new char[cellLinksSize*sizeof(int)];
+ int j=0;
+ CellLinkListType::const_iterator it = m_CellLinks.begin();
+ while(it != m_CellLinks.end())
+ {
+ MET_DoubleToValue((double)(*it)->m_Id,MET_INT,data,j++);
+ MET_DoubleToValue((double)(*it)->m_Links.size(),MET_INT,data,j++);
+ std::list<int>::const_iterator it2 = (*it)->m_Links.begin();
+ while(it2 != (*it)->m_Links.end())
+ {
+ MET_DoubleToValue((double)(*it2),MET_INT,data,j++);
+ it2++;
+ }
+ it++;
+ }
+ m_WriteStream->write((char *)data,cellLinksSize*sizeof(int));
+ m_WriteStream->write("\n",1);
+ delete []data;
+ }
+ else
+ {
+ CellLinkListType::const_iterator it = m_CellLinks.begin();
+
+ while(it != m_CellLinks.end())
+ {
+ *m_WriteStream << (*it)->m_Id << " ";
+ *m_WriteStream << (*it)->m_Links.size() << " ";
+ std::list<int>::const_iterator it2 = (*it)->m_Links.begin();
+ while(it2 != (*it)->m_Links.end())
+ {
+ *m_WriteStream << (*it2) << " ";
+ it2++;
+ }
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+ }
+
+ // Now write the point data
+ // Point Data type is the same for the whole mesh
+ if(m_PointData.size()>0)
+ {
+ MetaObject::ClearFields();
+ m_NPointData = m_PointData.size();
+ MET_FieldRecordType * mF;
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPointData", MET_INT,m_NPointData);
+ m_Fields.push_back(mF);
+
+ int pointDataSize = 0;
+ PointDataListType::const_iterator it = m_PointData.begin();
+ while(it != m_PointData.end())
+ {
+ pointDataSize += (*it)->GetSize();
+ it++;
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDataSize", MET_INT,pointDataSize);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointData", MET_NONE);
+ m_Fields.push_back(mF);
+
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaMesh: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ // Then copy all Point data :
+ // Always binary to be compatible with everything
+ it = m_PointData.begin();
+ while(it != m_PointData.end())
+ {
+ (*it)->Write(m_WriteStream);
+ it++;
+ }
+ m_WriteStream->write("\n",1);
+
+ }
+
+ // Now write the cell data
+ // Cell Data type is the same for the whole mesh
+ if(m_CellData.size()>0)
+ {
+ MetaObject::ClearFields();
+ m_NCellData = m_CellData.size();
+ MET_FieldRecordType * mF;
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NCellData", MET_INT,m_NCellData);
+ m_Fields.push_back(mF);
+
+ int cellDataSize = 0;
+ CellDataListType::const_iterator it = m_CellData.begin();
+ while(it != m_CellData.end())
+ {
+ cellDataSize += (*it)->GetSize();
+ it++;
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CellDataSize", MET_INT,cellDataSize);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CellData", MET_NONE);
+ m_Fields.push_back(mF);
+
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaMesh: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ // Then copy all Cell data :
+ // Always binary to be compatible with everything
+ it = m_CellData.begin();
+ while(it != m_CellData.end())
+ {
+ (*it)->Write(m_WriteStream);
+ it++;
+ }
+ m_WriteStream->write("\n",1);
+ }
+
+ return true;
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaMesh.h b/Utilities/ITK/Utilities/MetaIO/metaMesh.h
new file mode 100644
index 0000000000000000000000000000000000000000..63bb3367beb62150e8210487c3a106ae9b0f3b8f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaMesh.h
@@ -0,0 +1,302 @@
+#ifndef METAMESH_H
+#define METAMESH_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaMesh (.h and .cxx)
+ *
+ * Description:
+ * Reads and Writes MetaMeshFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date June, 2004
+ *
+ * Depends on:
+ * MetaUtils.h
+ */
+
+
+/** Typedef for the type of cells */
+#define MET_NUM_CELL_TYPES 9
+
+enum MET_CellGeometry {MET_VERTEX_CELL=0, MET_LINE_CELL, MET_TRIANGLE_CELL, MET_QUADRILATERAL_CELL,
+ MET_POLYGON_CELL, MET_TETRAHEDRON_CELL, MET_HEXAHEDRON_CELL,
+ MET_QUADRATIC_EDGE_CELL, MET_QUADRATIC_TRIANGLE_CELL};
+
+const unsigned char MET_CellSize[MET_NUM_VALUE_TYPES] = {
+ 1,2,3,4,5,4,8,3,6};
+
+const char MET_CellTypeName[MET_NUM_VALUE_TYPES][4] = {
+ {'V','R','T','\0'},
+ {'L','N','E','\0'},
+ {'T','R','I','\0'},
+ {'Q','A','D','\0'},
+ {'P','L','Y','\0'},
+ {'T','E','T','\0'},
+ {'H','E','X','\0'},
+ {'Q','E','D','\0'},
+ {'Q','T','R','\0'}};
+
+
+/** Define a mesh point */
+class MeshPoint
+{
+public:
+
+ MeshPoint(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ }
+ }
+ ~MeshPoint()
+ {
+ delete []m_X;
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ int m_Id;
+};
+
+
+/** Define a mesh cell
+ * a cell contains a list of Ids corresponding to the list
+ * of points */
+class MeshCell
+{
+public:
+
+ MeshCell(int dim)
+ {
+ m_Dim = dim;
+ m_Id = -1;
+ m_PointsId = new int[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_PointsId[i] = -1;
+ }
+
+ }
+ ~MeshCell()
+ {
+ delete []m_PointsId;
+ };
+
+ int m_Id;
+ unsigned int m_Dim;
+ int* m_PointsId;
+};
+
+/** Define a mesh cell links
+ * a celllink contains a list of Ids corresponding to the list
+ * of links cells */
+class MeshCellLink
+{
+public:
+
+ MeshCellLink()
+ {
+ m_Id = 0;
+ }
+ ~MeshCellLink()
+ {
+ };
+
+ int m_Id; // id of the cell link
+ std::list<int> m_Links;
+};
+
+/** Define a mesh point data */
+class MeshDataBase
+{
+public:
+
+ MeshDataBase()
+ {
+ m_Id = -1;
+ }
+ virtual ~MeshDataBase()
+ {
+ };
+
+ virtual void Write( std::ofstream* stream) = 0;
+ virtual unsigned int GetSize(void) = 0;
+ virtual MET_ValueEnumType GetMetaType() = 0;
+ int m_Id;
+
+protected:
+
+ std::ifstream* m_ReadStream;
+ std::ofstream* m_WriteStream;
+
+};
+
+/** Mesh point data class for basic types (i.e int, float ... ) */
+template<typename TElementType>
+class MeshData : public MeshDataBase
+{
+public:
+
+ MeshData() {m_Id=-1;}
+ ~MeshData() {};
+
+ virtual MET_ValueEnumType GetMetaType()
+ {
+ return MET_GetPixelType(typeid(TElementType));
+ }
+
+ virtual void Write( std::ofstream* stream)
+ {
+ char* id = new char[sizeof(int)];
+ MET_DoubleToValue((double)m_Id,MET_INT,id,0);
+ stream->write((char *)id,sizeof(int));
+ delete [] id;
+ char* data = new char[sizeof(m_Data)];
+ MET_DoubleToValue((double)m_Data,GetMetaType(),data,0);
+ stream->write((char *)data,sizeof(m_Data));
+ delete []data;
+ }
+
+ virtual unsigned int GetSize(void)
+ {
+ unsigned int size = sizeof(int);
+ size += sizeof(m_Data);
+ return size;
+ }
+
+ TElementType m_Data;
+};
+
+
+class MetaMesh : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<MeshPoint*> PointListType;
+ typedef std::list<MeshCell*> CellListType;
+ typedef std::list<MeshCellLink*> CellLinkListType;
+ typedef std::list<MeshDataBase*> PointDataListType;
+ typedef std::list<MeshDataBase*> CellDataListType;
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaMesh(void);
+
+ MetaMesh(const char *_headerName);
+
+ MetaMesh(const MetaMesh *_tube);
+
+ MetaMesh(unsigned int dim);
+
+ ~MetaMesh(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaMesh * _mesh);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the mesh
+ int NPoints(void) const;
+
+ // NCells(...)
+ // Required Field
+ // Number of cells wich compose the mesh
+ int NCells(void) const;
+
+ // NCellLinks(...)
+ // Required Field
+ // Number of cellLinks wich compose the mesh
+ int NCellLinks(void) const;
+
+ // NCellTypes(...)
+ // Required Field
+ // Number of celles wich compose the mesh
+ void NCellTypes(int ncelltypes);
+ int NCellTypes(void) const;
+
+ /** Clear the metaMesh */
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ CellListType & GetCells(MET_CellGeometry geom) {return *(m_CellListArray[geom]);}
+ const CellListType & GetCells(MET_CellGeometry geom) const {return *(m_CellListArray[geom]);}
+
+ CellLinkListType & GetCellLinks(void) {return m_CellLinks;}
+ const CellLinkListType & GetCellLinks(void) const {return m_CellLinks;}
+
+ PointDataListType & GetPointData(void) {return m_PointData;}
+ const PointDataListType & GetPointData(void) const {return m_PointData;}
+
+ CellDataListType & GetCellData(void) {return m_CellData;}
+ const CellDataListType & GetCellData(void) const {return m_CellData;}
+
+ MET_ValueEnumType PointDataType(void) const {return m_PointDataType;}
+ void PointDataType(MET_ValueEnumType _elementType){m_PointDataType = _elementType;}
+
+ MET_ValueEnumType CellDataType(void) const {return m_CellDataType;}
+ void CellDataType(MET_ValueEnumType _elementType){m_CellDataType = _elementType;}
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NPoints;
+ int m_NCells;
+ int m_NCellLinks;
+ int m_NPointData;
+ int m_NCellData;
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ // We store the Cell lists in a vector
+ CellListType* m_CellListArray[MET_NUM_CELL_TYPES];
+ CellLinkListType m_CellLinks;
+ PointDataListType m_PointData;
+ CellDataListType m_CellData;
+
+ MET_ValueEnumType m_PointType;
+ MET_ValueEnumType m_PointDataType;
+ MET_ValueEnumType m_CellDataType;
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaObject.cxx b/Utilities/ITK/Utilities/MetaIO/metaObject.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3f8cb18656523ea97aee21a614d2a74b175fb92f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaObject.cxx
@@ -0,0 +1,1669 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <iostream>
+#include <fstream>
+#include <string.h>
+#include <math.h>
+
+
+#include <metaUtils.h>
+#include <metaObject.h>
+
+int META_DEBUG = 0;
+//
+// MetaObject Constructors
+//
+MetaObject::
+MetaObject(void)
+ {
+ m_NDims = 0;
+ this->ClearFields();
+ this->ClearUserFields();
+ MetaObject::Clear();
+ m_ReadStream = NULL;
+ m_WriteStream = NULL;
+ m_FileName[0] = '\0';
+ m_Event = NULL;
+ m_DoublePrecision = 6;
+ }
+
+MetaObject::
+MetaObject(const char * _fileName)
+ {
+ m_NDims = 0;
+ this->ClearFields();
+ this->ClearUserFields();
+ MetaObject::Clear();
+ m_ReadStream = NULL;
+ m_WriteStream = NULL;
+ this->Read(_fileName);
+ m_Event = NULL;
+ m_DoublePrecision = 6;
+ }
+
+MetaObject::
+MetaObject(unsigned int dim)
+ {
+ m_NDims = 0;
+ this->ClearFields();
+ this->ClearUserFields();
+ MetaObject::Clear();
+ m_ReadStream = NULL;
+ m_WriteStream = NULL;
+ m_FileName[0] = '\0';
+ InitializeEssential(dim);
+ m_Event = NULL;
+ m_DoublePrecision = 6;
+ }
+
+
+MetaObject::
+~MetaObject(void)
+{
+ M_Destroy();
+ delete m_ReadStream;
+ delete m_WriteStream;
+
+ this->ClearFields();
+ this->ClearUserFields();
+}
+
+
+//
+// Clear Fields only, if the pointer is in the UserField list it is not deleted.
+void MetaObject::
+ClearFields()
+{
+ if(META_DEBUG) std::cout << "MetaObject:ClearFields" << std::endl;
+
+ FieldsContainerType::iterator it = m_Fields.begin();
+ FieldsContainerType::iterator end = m_Fields.end();
+ while( it != end )
+ {
+ MET_FieldRecordType* field = *it;
+ it++;
+
+ // Check if the pointer is not in one of the user's list
+ bool exists = false;
+ FieldsContainerType::iterator it2 = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::iterator end2 = m_UserDefinedWriteFields.end();
+ while( it2 != end2 )
+ {
+ if(*it2 == field)
+ {
+ exists = true;
+ break;
+ }
+ it2++;
+ }
+
+ if(!exists)
+ {
+ it2 = m_UserDefinedReadFields.begin();
+ end2 = m_UserDefinedReadFields.end();
+ while( it2 != end2 )
+ {
+ if(*it2 == field)
+ {
+ exists = true;
+ break;
+ }
+ it2++;
+ }
+ }
+
+ if(!exists)
+ {
+ delete field;
+ }
+ }
+ m_Fields.clear();
+}
+
+
+// Clear UserFields
+void MetaObject
+::ClearUserFields()
+{
+ // Clear write field
+ FieldsContainerType::iterator it = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::iterator end = m_UserDefinedWriteFields.end();
+ while( it != end )
+ {
+ MET_FieldRecordType* field = *it;
+ it++;
+ delete field;
+ }
+
+
+ // Clear read field
+ it = m_UserDefinedReadFields.begin();
+ end = m_UserDefinedReadFields.end();
+ while( it != end )
+ {
+ MET_FieldRecordType* field = *it;
+
+ // check if the pointer has not been deleted yet
+ bool deleted = false;
+ FieldsContainerType::iterator it2 = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::iterator end2 = m_UserDefinedWriteFields.end();
+ while( it2 != end2 )
+ {
+ if(*it2 == *it)
+ {
+ deleted = true;
+ break;
+ }
+ it2++;
+ }
+
+ it++;
+
+ if(!deleted)
+ {
+ delete field;
+ }
+ }
+
+ m_UserDefinedWriteFields.clear();
+ m_UserDefinedReadFields.clear();
+}
+
+//
+//
+void MetaObject::
+FileName(const char *_fileName)
+ {
+ if(_fileName != NULL)
+ {
+ if(_fileName[0] != '\0')
+ {
+ strcpy(m_FileName, _fileName);
+ }
+ }
+ }
+
+const char * MetaObject::
+FileName(void) const
+ {
+ return m_FileName;
+ }
+
+void MetaObject::
+CopyInfo(const MetaObject * _object)
+ {
+ if(NDims() != _object->NDims())
+ {
+ std::cout << "MetaObject: CopyInfo: Warning: NDims not same size"
+ << std::endl;
+ }
+
+ FileName(_object->FileName());
+ Comment(_object->Comment());
+ ObjectTypeName(_object->ObjectTypeName());
+ ObjectSubTypeName(_object->ObjectSubTypeName());
+ CenterOfRotation(_object->CenterOfRotation());
+ Offset(_object->Offset());
+ TransformMatrix(_object->TransformMatrix());
+ ElementSpacing(_object->ElementSpacing());
+ ID(_object->ID());
+ Color(_object->Color());
+ ParentID(_object->ParentID());
+ Name(_object->Name());
+ BinaryData(_object->BinaryData());
+ BinaryDataByteOrderMSB(_object->BinaryDataByteOrderMSB());
+ }
+
+bool MetaObject::
+Read(const char *_fileName)
+ {
+ if(META_DEBUG) std::cout << "MetaObject: Read" << std::endl;
+ if(_fileName != NULL)
+ {
+ strcpy(m_FileName, _fileName);
+ }
+
+ M_Destroy();
+
+ Clear();
+
+ M_SetupReadFields();
+ M_PrepareNewReadStream();
+
+ // m_ReadStream->precision(30);
+
+
+ m_ReadStream->open(m_FileName);
+ if(!m_ReadStream->is_open())
+ {
+ std::cout << "MetaObject: Read: Cannot open file" << std::endl;
+ return false;
+ }
+
+ bool result = M_Read();
+
+ m_ReadStream->close();
+ m_ReadStream->clear();
+ return result;
+ }
+
+bool MetaObject::
+ReadStream(int _nDims, std::ifstream * _stream)
+{
+ if(META_DEBUG) std::cout << "MetaObject: ReadStream" << std::endl;
+
+ M_Destroy();
+
+ fflush(NULL);
+
+ Clear();
+
+ M_SetupReadFields();
+
+ MET_FieldRecordType * mF = MET_GetFieldRecord("NDims", &m_Fields);
+ mF->value[0] = _nDims;
+ mF->defined = true;
+
+ if(m_ReadStream)
+ {
+ delete m_ReadStream;
+ }
+
+ m_ReadStream = _stream;
+
+ bool result = M_Read();
+ m_ReadStream= NULL;
+ return result;
+}
+
+
+
+bool MetaObject::
+Write(const char *_fileName)
+ {
+ if(_fileName != NULL)
+ {
+ FileName(_fileName);
+ }
+
+ M_SetupWriteFields();
+
+ if(!m_WriteStream)
+ {
+ m_WriteStream = new std::ofstream;
+ }
+
+#ifdef __sgi
+ // Create the file. This is required on some older sgi's
+ std::ofstream tFile(m_FileName,std::ios::out);
+ tFile.close();
+#endif
+ m_WriteStream->open(m_FileName,std::ios::binary | std::ios::out);
+ if(!m_WriteStream->is_open())
+ {
+ return false;
+ }
+
+ bool result = M_Write();
+
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+
+ return result;
+ }
+
+//
+//
+void MetaObject::
+PrintInfo(void) const
+ {
+ int i, j;
+
+ std::cout << "FileName = _" << m_FileName << "_" << std::endl;
+ std::cout << "Comment = _" << m_Comment << "_" << std::endl;
+ std::cout << "ObjectType = _" << m_ObjectTypeName << "_" << std::endl;
+ std::cout << "ObjectSubType = _" << m_ObjectSubTypeName << "_" << std::endl;
+ std::cout << "NDims = " << m_NDims << std::endl;
+ std::cout << "Name = " << m_Name << std::endl;
+ std::cout << "ID = " << m_ID << std::endl;
+ std::cout << "ParentID = " << m_ParentID << std::endl;
+ if(m_CompressedData)
+ std::cout << "CompressedData = True" << std::endl;
+ else
+ std::cout << "CompressedData = False" << std::endl;
+ std::cout << "m_CompressedDataSize = " << m_CompressedDataSize << std::endl;
+ if(m_BinaryData)
+ std::cout << "BinaryData = True" << std::endl;
+ else
+ std::cout << "BinaryData = False" << std::endl;
+ if(m_BinaryData && m_BinaryDataByteOrderMSB)
+ std::cout << "BinaryDataByteOrderMSB = True" << std::endl;
+ else
+ std::cout << "BinaryDataByteOrderMSB = False" << std::endl;
+ std::cout << "Color = " ;
+ for(i=0; i<4; i++)
+ {
+ std::cout << m_Color[i] << " ";
+ }
+ std::cout << std::endl;
+
+ std::cout << "Offset = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_Offset[i] << " ";
+ }
+ std::cout << std::endl;
+
+ std::cout << "TransformMatrix = ";
+ std::cout << std::endl;
+ for(i=0; i<m_NDims; i++)
+ {
+ for(j=0; j<m_NDims; j++)
+ {
+ std::cout << m_TransformMatrix[i*m_NDims+j] << " ";
+ }
+ std::cout << std::endl;
+ }
+
+ std::cout << "CenterOfRotation = ";
+ std::cout << std::endl;
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_CenterOfRotation[i] << " ";
+ }
+ std::cout << std::endl;
+
+ std::cout << "ElementSpacing = ";
+ for(i=0; i<m_NDims; i++)
+ {
+ std::cout << m_ElementSpacing[i] << " ";
+ }
+ std::cout << std::endl;
+
+
+ // Print User's fields :
+ FieldsContainerType::const_iterator itw = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::const_iterator itr = m_UserDefinedReadFields.begin();
+ FieldsContainerType::const_iterator endw = m_UserDefinedWriteFields.end();
+ FieldsContainerType::const_iterator it;
+ while( itw != endw )
+ {
+ if((*itw)->defined)
+ {
+ it=itw;
+ }
+ else
+ {
+ it=itr;
+ }
+
+ printf("%s: ",(*it)->name);
+
+ if((*it)->type == MET_STRING)
+ {
+ printf("%s",(char *) (*it)->value);
+ }
+ else if( (*it)->type == MET_ASCII_CHAR ||
+ (*it)->type == MET_CHAR ||
+ (*it)->type == MET_UCHAR ||
+ (*it)->type == MET_SHORT ||
+ (*it)->type == MET_USHORT ||
+ (*it)->type == MET_LONG ||
+ (*it)->type == MET_ULONG ||
+ (*it)->type == MET_INT ||
+ (*it)->type == MET_UINT ||
+ (*it)->type == MET_FLOAT ||
+ (*it)->type == MET_DOUBLE )
+ {
+ printf("%s : %f\n",(*it)->name,(*it)->value[0]);
+ }
+ else if( (*it)->type ==MET_CHAR_ARRAY ||
+ (*it)->type ==MET_UCHAR_ARRAY ||
+ (*it)->type ==MET_SHORT_ARRAY ||
+ (*it)->type ==MET_USHORT_ARRAY ||
+ (*it)->type ==MET_INT_ARRAY ||
+ (*it)->type ==MET_UINT_ARRAY ||
+ (*it)->type ==MET_FLOAT_ARRAY ||
+ (*it)->type ==MET_DOUBLE_ARRAY )
+ {
+ for(i=0; i<(*it)->length; i++)
+ {
+ printf("%f ",(*it)->value[i]);
+ }
+ }
+ else if((*it)->type == MET_FLOAT_MATRIX)
+ {
+ std::cout << std::endl;
+ for(i=0; i<(*it)->length*(*it)->length; i++)
+ {
+ printf("%f ",(*it)->value[i]);
+ if(i==(*it)->length-1)
+ {
+ std::cout << std::endl;
+ }
+ }
+ }
+ std::cout << std::endl;
+
+ itw++;
+ itr++;
+ }
+ }
+
+const char * MetaObject::
+Comment(void) const
+ {
+ return m_Comment;
+ }
+
+void MetaObject::
+Comment(const char * _comment)
+ {
+ strcpy(m_Comment, _comment);
+ }
+
+const char * MetaObject::
+ObjectTypeName(void) const
+ {
+ return m_ObjectTypeName;
+ }
+
+void MetaObject::
+ObjectTypeName(const char * _objectTypeName)
+ {
+ strcpy(m_ObjectTypeName, _objectTypeName);
+ }
+
+const char * MetaObject::
+ObjectSubTypeName(void) const
+ {
+ return m_ObjectSubTypeName;
+ }
+
+void MetaObject::
+ObjectSubTypeName(const char * _objectSubTypeName)
+ {
+ strcpy(m_ObjectSubTypeName, _objectSubTypeName);
+ }
+
+int MetaObject::
+NDims(void) const
+ {
+ return m_NDims;
+ }
+
+const double * MetaObject::
+Offset(void) const
+ {
+ return m_Offset;
+ }
+
+double MetaObject::
+Offset(int _i) const
+ {
+ return m_Offset[_i];
+ }
+
+void MetaObject::
+Offset(const double * _position)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_Offset[i] = _position[i];
+ }
+ }
+
+void MetaObject::
+Offset(int _i, double _value)
+ {
+ m_Offset[_i] = _value;
+ }
+
+
+const double * MetaObject::
+Position(void) const
+ {
+ return m_Offset;
+ }
+
+double MetaObject::
+Position(int _i) const
+ {
+ return m_Offset[_i];
+ }
+
+void MetaObject::
+Position(const double * _position)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_Offset[i] = _position[i];
+ }
+ }
+
+void MetaObject::
+Position(int _i, double _value)
+ {
+ m_Offset[_i] = _value;
+ }
+
+const double * MetaObject::
+Origin(void) const
+ {
+ return m_Offset;
+ }
+
+double MetaObject::
+Origin(int _i) const
+ {
+ return m_Offset[_i];
+ }
+
+void MetaObject::
+Origin(const double * _position)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_Offset[i] = _position[i];
+ }
+ }
+
+void MetaObject::
+Origin(int _i, double _value)
+ {
+ m_Offset[_i] = _value;
+ }
+
+//
+//
+const double * MetaObject::
+TransformMatrix(void) const
+ {
+ return m_TransformMatrix;
+ }
+
+double MetaObject::
+TransformMatrix(int _i, int _j) const
+ {
+ return m_TransformMatrix[_i*m_NDims+_j];
+ }
+
+void MetaObject::
+TransformMatrix(const double * _orientation)
+ {
+ int i;
+ for(i=0; i<m_NDims*m_NDims; i++)
+ {
+ m_TransformMatrix[i] = _orientation[i];
+ }
+ }
+
+void MetaObject::
+TransformMatrix(int _i, int _j, double _value)
+ {
+ m_TransformMatrix[_i*m_NDims+_j] = _value;
+ }
+
+//
+const double * MetaObject::
+Rotation(void) const
+ {
+ return m_TransformMatrix;
+ }
+
+double MetaObject::
+Rotation(int _i, int _j) const
+ {
+ return m_TransformMatrix[_i*m_NDims+_j];
+ }
+
+void MetaObject::
+Rotation(const double * _orientation)
+ {
+ int i;
+ for(i=0; i<m_NDims*m_NDims; i++)
+ {
+ m_TransformMatrix[i] = _orientation[i];
+ }
+ }
+
+void MetaObject::
+Rotation(int _i, int _j, double _value)
+ {
+ m_TransformMatrix[_i*m_NDims+_j] = _value;
+ }
+
+//
+const double * MetaObject::
+Orientation(void) const
+ {
+ return m_TransformMatrix;
+ }
+
+double MetaObject::
+Orientation(int _i, int _j) const
+ {
+ return m_TransformMatrix[_i*m_NDims+_j];
+ }
+
+void MetaObject::
+Orientation(const double * _orientation)
+ {
+ int i;
+ for(i=0; i<m_NDims*m_NDims; i++)
+ {
+ m_TransformMatrix[i] = _orientation[i];
+ }
+ }
+
+void MetaObject::
+Orientation(int _i, int _j, double _value)
+ {
+ m_TransformMatrix[_i*m_NDims+_j] = _value;
+ }
+
+//
+//
+const double * MetaObject::
+CenterOfRotation(void) const
+ {
+ return m_CenterOfRotation;
+ }
+
+double MetaObject::
+CenterOfRotation(int _i) const
+ {
+ return m_CenterOfRotation[_i];
+ }
+
+void MetaObject::
+CenterOfRotation(const double * _position)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_CenterOfRotation[i] = _position[i];
+ }
+ }
+
+void MetaObject::
+CenterOfRotation(int _i, double _value)
+ {
+ m_CenterOfRotation[_i] = _value;
+ }
+
+//
+//
+const char * MetaObject::
+AnatomicalOrientationAcronym(void) const
+ {
+ static char str[10];
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ str[i] = MET_OrientationTypeName[m_AnatomicalOrientation[i]][0];
+ }
+ str[i] = '\0';
+ return str;
+ }
+
+const MET_OrientationEnumType * MetaObject::
+AnatomicalOrientation(void) const
+ {
+ return m_AnatomicalOrientation;
+ }
+
+MET_OrientationEnumType MetaObject::
+AnatomicalOrientation(int _dim) const
+ {
+ return m_AnatomicalOrientation[_dim];
+ }
+
+void MetaObject::
+AnatomicalOrientation(const char *_ao)
+ {
+ int i, j;
+ for(i=0; i<m_NDims; i++)
+ {
+ for(j=0; j<MET_NUM_ORIENTATION_TYPES; j++)
+ {
+ if(_ao[i] == MET_OrientationTypeName[j][0])
+ {
+ m_AnatomicalOrientation[i] = (MET_OrientationEnumType)j;
+ break;
+ }
+ }
+ if(j == MET_NUM_ORIENTATION_TYPES)
+ {
+ m_AnatomicalOrientation[i] = MET_ORIENTATION_UNKNOWN;
+ }
+ }
+ }
+
+void MetaObject::
+AnatomicalOrientation(const MET_OrientationEnumType *_ao)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_AnatomicalOrientation[i] = _ao[i];
+ }
+ }
+
+void MetaObject::
+AnatomicalOrientation(int _dim, MET_OrientationEnumType _ao)
+ {
+ m_AnatomicalOrientation[_dim] = _ao;
+ }
+
+void MetaObject::
+AnatomicalOrientation(int _dim, char _ao)
+ {
+ int j;
+ for(j=0; j<MET_NUM_ORIENTATION_TYPES; j++)
+ {
+ if(_ao == MET_OrientationTypeName[j][0])
+ {
+ m_AnatomicalOrientation[_dim] = (MET_OrientationEnumType)j;
+ return;
+ }
+ }
+
+ m_AnatomicalOrientation[_dim] = MET_ORIENTATION_UNKNOWN;
+ }
+
+//
+//
+const float * MetaObject::
+ElementSpacing(void) const
+ {
+ return m_ElementSpacing;
+ }
+
+float MetaObject::
+ElementSpacing(int _i) const
+ {
+ return m_ElementSpacing[_i];
+ }
+
+void MetaObject::
+ElementSpacing(const float * _elementSpacing)
+ {
+ int i;
+ for(i=0; i<m_NDims; i++)
+ {
+ m_ElementSpacing[i] = _elementSpacing[i];
+ }
+ }
+
+void MetaObject::
+ElementSpacing(int _i, float _value)
+ {
+ m_ElementSpacing[_i] = _value;
+ }
+
+
+void MetaObject::
+Name(const char *_Name)
+{
+ if(_Name != NULL)
+ {
+ strcpy(m_Name, _Name);
+ }
+}
+
+const char * MetaObject::
+Name(void) const
+{
+ return m_Name;
+}
+
+
+const float * MetaObject::
+Color(void) const
+{
+ return m_Color;
+}
+
+void MetaObject::
+Color(float _r, float _g, float _b, float _a)
+{
+ m_Color[0] = _r;
+ m_Color[1] = _g;
+ m_Color[2] = _b;
+ m_Color[3] = _a;
+}
+void MetaObject::
+Color(const float * _color)
+{
+ for(unsigned int i=0; i<4; i++)
+ {
+ m_Color[i] = _color[i];
+ }
+}
+
+
+void MetaObject::
+ID(int _id)
+{
+ m_ID = _id;
+}
+
+int MetaObject::
+ID(void) const
+{
+ return m_ID;
+}
+
+void MetaObject::
+ParentID(int _parentId)
+{
+ m_ParentID = _parentId;
+}
+
+int MetaObject::ParentID(void) const
+{
+ return m_ParentID;
+}
+
+void MetaObject::CompressedData(bool _compressedData)
+{
+ m_CompressedData = _compressedData;
+}
+
+bool MetaObject::CompressedData(void) const
+{
+ return m_CompressedData;
+}
+
+void MetaObject::BinaryData(bool _binaryData)
+{
+ m_BinaryData = _binaryData;
+}
+
+bool MetaObject::BinaryData(void) const
+{
+ return m_BinaryData;
+}
+
+bool MetaObject::
+BinaryDataByteOrderMSB(void) const
+ {
+ return m_BinaryDataByteOrderMSB;
+ }
+
+void MetaObject::
+BinaryDataByteOrderMSB(bool _elementByteOrderMSB)
+ {
+ m_BinaryDataByteOrderMSB = _elementByteOrderMSB;
+ }
+
+void MetaObject::
+Clear(void)
+ {
+ if(META_DEBUG) std::cout << "MetaObject: Clear()" << std::endl;
+ strcpy(m_Comment, "");
+ strcpy(m_ObjectTypeName, "Object");
+ strcpy(m_ObjectSubTypeName, "");
+ strcpy(m_Name, "");
+
+ memset(m_Offset, 0, 10*sizeof(float));
+ memset(m_TransformMatrix, 0, 100*sizeof(float));
+ memset(m_CenterOfRotation, 0, 10*sizeof(float));
+ memset(m_Color, 0, 4*sizeof(float));
+
+ m_ID = -1;
+ m_Color[0]=1.0;
+ m_Color[1]=1.0;
+ m_Color[2]=1.0;
+ m_Color[3]=1.0; // white by default
+ m_ParentID = -1;
+ m_BinaryData = false;
+ m_BinaryDataByteOrderMSB = MET_SystemByteOrderMSB();
+ m_CompressedDataSize = 0;
+ m_CompressedData = false;
+ m_WriteCompressedDataSize = true;
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaObject: Clear: m_NDims=" << m_NDims << std::endl;
+ }
+ int i;
+ for(i=0; i<10; i++)
+ {
+ m_ElementSpacing[i] = 1;
+ m_AnatomicalOrientation[i] = MET_ORIENTATION_UNKNOWN;
+ }
+/*
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+ for(fieldIter=m_Fields.begin(); fieldIter!=m_Fields.end(); fieldIter++)
+ {
+ if(META_DEBUG) std::cout << "field = " << (*fieldIter)->name << std::endl;
+ MET_FieldRecordType* field = *fieldIter;
+ delete field;
+ field = NULL;
+ if(META_DEBUG) std::cout << " has been deleted." << std::endl;
+ }
+ m_Fields.clear();*/
+ this->ClearFields();
+ }
+
+bool MetaObject::
+InitializeEssential(int _nDims)
+ {
+ if(META_DEBUG) std::cout << "MetaObject: Initialize" << std::endl;
+
+ M_Destroy();
+
+ if(_nDims > 10)
+ {
+ std::cout
+ << "MetaObject: Initialize: Warning: Number of dimensions limited to 10"
+ << std::endl
+ << "Resetting number of dimensions to 10"
+ << std::endl;
+ _nDims = 10;
+ }
+
+ if(_nDims < 0)
+ {
+ std::cout
+ << "MetaObject: Initialize: Warning: Number of dimensions must be >= 0"
+ << std::endl
+ << "Resetting number of dimensions to 0"
+ << std::endl;
+ _nDims = 0;
+ }
+
+ m_NDims = _nDims;
+
+ return true;
+ }
+
+void MetaObject::
+M_Destroy(void)
+ {
+ if(META_DEBUG) std::cout << "MetaObject: Destroy" << std::endl;
+ }
+
+void MetaObject::
+M_SetupReadFields(void)
+ {
+ this->ClearFields();
+ if(META_DEBUG) std::cout << "MetaObject: M_SetupReadFields" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Comment", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType; // Set but not used
+ MET_InitReadField(mF, "AcquisitionDate", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ObjectType", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ObjectSubType", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NDims", MET_INT, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ int nDimsRecordNumber = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Name", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ID", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ParentID", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CompressedData", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CompressedDataSize", MET_FLOAT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "BinaryData", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementByteOrderMSB", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "BinaryDataByteOrderMSB", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Color", MET_FLOAT_ARRAY, false,-1,4);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Position", MET_FLOAT_ARRAY, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Origin", MET_FLOAT_ARRAY, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Offset", MET_FLOAT_ARRAY, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "TransformMatrix", MET_FLOAT_MATRIX, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Rotation", MET_FLOAT_MATRIX, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Orientation", MET_FLOAT_MATRIX, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "CenterOfRotation", MET_FLOAT_ARRAY, false,
+ nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "AnatomicalOrientation", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementSpacing", MET_FLOAT_ARRAY, false,
+ nDimsRecordNumber);
+ mF->required = false;
+ m_Fields.push_back(mF);
+
+ // Add User's field
+ FieldsContainerType::iterator it = m_UserDefinedReadFields.begin();
+ FieldsContainerType::iterator end = m_UserDefinedReadFields.end();
+ while( it != end )
+ {
+ m_Fields.push_back(*it);
+ it++;
+ }
+
+
+ }
+
+
+void MetaObject::
+M_SetupWriteFields(void)
+ {
+ if(META_DEBUG) std::cout << "MetaObject: M_SetupWriteFields" << std::endl;
+
+ this->ClearFields();
+
+ if(META_DEBUG) std::cout << "MetaObject: M_SetupWriteFields: Creating Fields"
+ << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ if(strlen(m_Comment)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Comment", MET_STRING, strlen(m_Comment), m_Comment);
+ m_Fields.push_back(mF);
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ObjectType", MET_STRING, strlen(m_ObjectTypeName),
+ m_ObjectTypeName);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_ObjectSubTypeName)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ObjectSubType", MET_STRING,
+ strlen(m_ObjectSubTypeName),
+ m_ObjectSubTypeName);
+ m_Fields.push_back(mF);
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NDims", MET_INT, m_NDims);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_Name)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Name", MET_STRING, strlen(m_Name),m_Name);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_ID>=0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ID", MET_INT, m_ID);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_ParentID >= 0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ParentID", MET_INT, m_ParentID);
+ m_Fields.push_back(mF);
+ }
+
+ bool valSet = false;
+ int i;
+ for(i=0; i<4; i++)
+ {
+ if(m_Color[i] != 1)
+ {
+ valSet = true;
+ break;
+ }
+ }
+ if(valSet)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Color", MET_FLOAT_ARRAY, 4,
+ m_Color);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_CompressedData)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CompressedData", MET_STRING, strlen("True"),
+ "True");
+ m_Fields.push_back(mF);
+
+ if(m_WriteCompressedDataSize)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CompressedDataSize", MET_UINT,
+ m_CompressedDataSize);
+ m_Fields.push_back(mF);
+ }
+ }
+
+ if(m_BinaryData)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "BinaryData", MET_STRING, strlen("True"), "True");
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ if(m_BinaryDataByteOrderMSB)
+ MET_InitWriteField(mF, "BinaryDataByteOrderMSB", MET_STRING,
+ strlen("True"), "True");
+ else
+ MET_InitWriteField(mF, "BinaryDataByteOrderMSB", MET_STRING,
+ strlen("False"), "False");
+ m_Fields.push_back(mF);
+ }
+
+
+
+ valSet = false;
+ for(i=0; i<m_NDims*m_NDims; i++)
+ {
+ if(m_TransformMatrix[i] != 0)
+ {
+ valSet = true;
+ break;
+ }
+ }
+ if(!valSet)
+ {
+ for(i=0; i<m_NDims; i++)
+ {
+ m_TransformMatrix[i+i*m_NDims] = 1;
+ }
+ }
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "TransformMatrix", MET_FLOAT_MATRIX, m_NDims,
+ m_TransformMatrix);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Offset", MET_FLOAT_ARRAY, m_NDims,
+ m_Offset);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "CenterOfRotation", MET_FLOAT_ARRAY, m_NDims,
+ m_CenterOfRotation);
+ m_Fields.push_back(mF);
+
+ if(m_AnatomicalOrientation[0] != MET_ORIENTATION_UNKNOWN)
+ {
+ const char * str = AnatomicalOrientationAcronym();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "AnatomicalOrientation",
+ MET_STRING, strlen(str), str);
+ m_Fields.push_back(mF);
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementSpacing", MET_FLOAT_ARRAY, m_NDims,
+ m_ElementSpacing);
+ m_Fields.push_back(mF);
+
+ // Add User's field
+ FieldsContainerType::iterator it = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::iterator end = m_UserDefinedWriteFields.end();
+ while( it != end )
+ {
+ m_Fields.push_back(*it);
+ it++;
+ }
+ }
+
+bool MetaObject::
+M_Read(void)
+ {
+
+ if(!MET_Read(*m_ReadStream, & m_Fields))
+ {
+ std::cout << "MetaObject: Read: MET_Read Failed" << std::endl;
+ return false;
+ }
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("Comment", &m_Fields);
+ if(mF && mF->defined)
+ {
+ strcpy(m_Comment, (char *)(mF->value));
+ }
+
+ mF = MET_GetFieldRecord("ObjectType", &m_Fields);
+ if(mF && mF->defined)
+ {
+ strcpy(m_ObjectTypeName, (char *)(mF->value));
+ }
+
+ mF = MET_GetFieldRecord("ObjectSubType", &m_Fields);
+ if(mF && mF->defined)
+ {
+ strcpy(m_ObjectSubTypeName, (char *)(mF->value));
+ }
+
+ mF = MET_GetFieldRecord("NDims", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_NDims = (int)mF->value[0];
+ }
+
+ if(m_NDims>0)
+ {
+ MetaObject::InitializeEssential(m_NDims);
+ }
+
+ mF = MET_GetFieldRecord("Name", &m_Fields);
+ if(mF && mF->defined)
+ {
+ strcpy(m_Name, (char *)(mF->value));
+ }
+
+ mF = MET_GetFieldRecord("ID", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ID = (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ParentID", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_ParentID = (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("CompressedData", &m_Fields);
+ if(mF && mF->defined)
+ {
+ if(((char *)(mF->value))[0] == 'T' || ((char *)(mF->value))[0] == 't'
+ || ((char *)(mF->value))[0] == '1')
+ m_CompressedData = true;
+ else
+ m_CompressedData = false;
+ }
+ else
+ {
+ m_BinaryData = false;
+ }
+
+ mF = MET_GetFieldRecord("CompressedDataSize", &m_Fields);
+ if(mF && mF->defined)
+ {
+ m_CompressedDataSize = (unsigned int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("BinaryData", &m_Fields);
+ if(mF && mF->defined)
+ {
+ if(((char *)(mF->value))[0] == 'T' || ((char *)(mF->value))[0] == 't'
+ || ((char *)(mF->value))[0] == '1')
+ m_BinaryData = true;
+ else
+ m_BinaryData = false;
+ }
+ else
+ {
+ m_BinaryData = false;
+ }
+
+ mF = MET_GetFieldRecord("ElementByteOrderMSB", &m_Fields);
+ if(mF && mF->defined)
+ {
+ if(((char *)(mF->value))[0] == 'T' || ((char *)(mF->value))[0] == 't'
+ || ((char *)(mF->value))[0] == '1')
+ m_BinaryDataByteOrderMSB = true;
+ else
+ m_BinaryDataByteOrderMSB = false;
+ }
+
+ mF = MET_GetFieldRecord("BinaryDataByteOrderMSB", &m_Fields);
+ if(mF && mF->defined)
+ {
+ if(((char *)(mF->value))[0] == 'T' || ((char *)(mF->value))[0] == 't'
+ || ((char *)(mF->value))[0] == '1')
+ m_BinaryDataByteOrderMSB = true;
+ else
+ m_BinaryDataByteOrderMSB = false;
+ }
+
+ int i;
+ mF = MET_GetFieldRecord("Color", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_Color[i] = static_cast<float>( mF->value[i] );
+ }
+ }
+ else
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_Color[i] = static_cast<unsigned int>( 1 );
+ }
+ }
+
+ mF = MET_GetFieldRecord("Position", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_Offset[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ mF = MET_GetFieldRecord("Offset", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_Offset[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ mF = MET_GetFieldRecord("Origin", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_Offset[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+
+ bool transformMatrixDefined = false;
+ mF = MET_GetFieldRecord("Orientation", &m_Fields);
+ if(mF && mF->defined)
+ {
+ transformMatrixDefined = true;
+ int len = mF->length;
+ for(i=0; i<len*len; i++)
+ {
+ m_TransformMatrix[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ mF = MET_GetFieldRecord("Rotation", &m_Fields);
+ if(mF && mF->defined)
+ {
+ transformMatrixDefined = true;
+ int len = mF->length;
+ for(i=0; i<len*len; i++)
+ {
+ m_TransformMatrix[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ mF = MET_GetFieldRecord("TransformMatrix", &m_Fields);
+ if(mF && mF->defined)
+ {
+ transformMatrixDefined = true;
+ int len = mF->length;
+ for(i=0; i<len*len; i++)
+ {
+ m_TransformMatrix[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ if(!transformMatrixDefined)
+ {
+ for(i=0; i<m_NDims; i++)
+ {
+ m_TransformMatrix[i+i*m_NDims] = 1;
+ }
+ }
+
+ mF = MET_GetFieldRecord("CenterOfRotation", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_CenterOfRotation[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+ else
+ {
+ for(i=0; i<m_NDims; i++)
+ {
+ m_CenterOfRotation[i] = 0;
+ }
+ }
+
+ mF = MET_GetFieldRecord("AnatomicalOrientation", &m_Fields);
+ if(mF && mF->defined)
+ {
+ AnatomicalOrientation((char *)(mF->value));
+ }
+
+ mF = MET_GetFieldRecord("ElementSpacing", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_ElementSpacing[i] = static_cast<float>( mF->value[i] );
+ if (META_DEBUG)
+ std::cout << "metaObject: M_Read: elementSpacing[" << i << "] = "
+ << m_ElementSpacing[i] << std::endl;
+ }
+ }
+ else
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ m_ElementSpacing[i] = 1;
+ if (META_DEBUG)
+ std::cout << "metaObject: M_Read: elementSpacing[" << i << "] = "
+ << m_ElementSpacing[i] << std::endl;
+ }
+ }
+
+ // Set the read record field in the m_UserDefinedWriteFields
+ FieldsContainerType::iterator it = m_UserDefinedReadFields.begin();
+ FieldsContainerType::iterator end = m_UserDefinedReadFields.end();
+ while( it != end )
+ {
+ mF = MET_GetFieldRecord((*it)->name, &m_Fields);
+ m_UserDefinedWriteFields.push_back(mF);
+ it++;
+ }
+
+ return true;
+ }
+
+bool MetaObject::
+M_Write(void)
+ {
+ m_WriteStream->precision(m_DoublePrecision);
+
+ if(!MET_Write(*m_WriteStream, & m_Fields))
+ {
+ std::cout << "MetaObject: Write: MET_Write Failed" << std::endl;
+ return false;
+ }
+
+ return true;
+ }
+
+
+bool MetaObject
+::Append(const char *_headName)
+{
+ if(META_DEBUG) std::cout << "MetaObject: Append" << std::endl;
+
+ if(_headName != NULL)
+ {
+ FileName(_headName);
+ }
+
+ M_SetupWriteFields();
+
+ if(!m_WriteStream)
+ {
+ m_WriteStream = new std::ofstream;
+ }
+
+#ifndef __sgi
+ m_WriteStream->open(m_FileName,
+ std::ios::binary | std::ios::out | std::ios::app);
+ if(!m_WriteStream->is_open())
+ {
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ return false;
+ }
+#else
+ m_WriteStream->open(m_FileName,
+ std::ios::binary | std::ios::out | std::ios::in);
+ if(!m_WriteStream->is_open())
+ {
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ return false;
+ }
+ m_WriteStream->seekp(0,std::ios::end);
+#endif
+
+ M_Write();
+
+ m_WriteStream->close();
+
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ return true;
+
+}
+
+
+
+// Get the user field
+void* MetaObject
+::GetUserField(const char* _name)
+{
+ FieldsContainerType::iterator it = m_UserDefinedWriteFields.begin();
+ FieldsContainerType::iterator end = m_UserDefinedWriteFields.end();
+ while( it != end )
+ {
+ int eSize;
+ MET_SizeOfType((*it)->type, &eSize);
+ const unsigned int itLength =
+ static_cast<unsigned int>( (*it)->length );
+ void * out;
+ if(!strcmp((*it)->name,_name))
+ {
+ if((*it)->type == MET_STRING)
+ {
+ out = (void*) (new char[(itLength+1)*eSize] );
+ memcpy( out, (*it)->value, itLength * eSize );
+ static_cast<char*>(out)[itLength]=0;
+ }
+ else if((*it)->type == MET_FLOAT_MATRIX)
+ {
+ const unsigned int numMatrixElements = itLength * itLength;
+ out = (void*) (new char[numMatrixElements*eSize] );
+ for( unsigned int i=0; i < numMatrixElements; i++ )
+ {
+ MET_DoubleToValue((*it)->value[i],(*it)->type,out,i);
+ }
+ }
+ else
+ {
+ out = (void*) (new char[itLength*eSize] );
+ for( unsigned int i=0; i < itLength; i++ )
+ {
+ MET_DoubleToValue((*it)->value[i],(*it)->type,out,i);
+ }
+ }
+ return out;
+ }
+ it++;
+ }
+ return NULL;
+}
+
+
+bool MetaObject
+::AddUserField(const char* _fieldName,MET_ValueEnumType _type,int _length,
+ bool _required,int _dependsOn)
+{
+ MET_FieldRecordType* mFr = new MET_FieldRecordType;
+ MET_InitReadField(mFr,_fieldName, _type, _required,_dependsOn,_length);
+ m_UserDefinedReadFields.push_back(mFr);
+ return 1;
+}
+
+void MetaObject::M_PrepareNewReadStream()
+{
+ if(m_ReadStream)
+ {
+ if(m_ReadStream->is_open())
+ {
+ m_ReadStream->close();
+ }
+ m_ReadStream->clear();
+ }
+ else
+ {
+ m_ReadStream = new std::ifstream;
+ }
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaObject.h b/Utilities/ITK/Utilities/MetaIO/metaObject.h
new file mode 100644
index 0000000000000000000000000000000000000000..cffd3e84cd7808b7ad595c30c6fa06389843859f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaObject.h
@@ -0,0 +1,274 @@
+#ifndef METAOBJECT_H
+#define METAOBJECT_H
+
+#include <iostream>
+#include <fstream>
+
+#include <metaUtils.h>
+#include <metaEvent.h>
+
+extern int META_DEBUG;
+
+
+class MetaObject
+ {
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ std::ifstream* m_ReadStream;
+ std::ofstream* m_WriteStream;
+
+ typedef std::vector<MET_FieldRecordType *> FieldsContainerType;
+
+ FieldsContainerType m_Fields;
+ FieldsContainerType m_UserDefinedWriteFields;
+ FieldsContainerType m_UserDefinedReadFields;
+ char m_FileName[255];
+
+ char m_Comment[255]; // "Comment = " ""
+
+ char m_ObjectTypeName[255]; // "ObjectType = " defined by suffix
+ char m_ObjectSubTypeName[255]; // "ObjectSubType = " defined by suffix
+
+ int m_NDims; // "NDims = " required
+
+ double m_Offset[10]; // "Offset = " 0,0,0
+ double m_TransformMatrix[100]; // "TransformMatrix = " 1,0,0,0,1,0,0,0,1
+ double m_CenterOfRotation[10]; // "CenterOfRotation = " 0 0 0
+
+ MET_OrientationEnumType m_AnatomicalOrientation[10];
+
+ float m_ElementSpacing[10]; // "ElementSpacing = " 0,0,0
+
+ float m_Color[4]; // "Color = " 1.0, 0.0, 0.0, 1.0
+
+ int m_ID; // "ID = " 0
+
+ int m_ParentID; // "ParentID = " -1
+
+ char m_Name[255]; // "Name = " ""
+
+ bool m_BinaryData; // "BinaryData = " False
+
+ bool m_BinaryDataByteOrderMSB;
+
+ unsigned int m_CompressedDataSize;
+ bool m_WriteCompressedDataSize; // Used internally to set if the dataSize should be written
+ bool m_CompressedData;
+
+ virtual void M_Destroy(void);
+
+ virtual void M_SetupReadFields(void);
+
+ virtual void M_SetupWriteFields(void);
+
+ virtual bool M_Read(void);
+
+ virtual bool M_Write(void);
+
+ virtual void M_PrepareNewReadStream();
+
+ metaEvent* m_Event;
+ //MET_FieldRecordType * M_GetFieldRecord(const char * _fieldName);
+ //int M_GetFieldRecordNumber(const char * _fieldName);
+
+ unsigned int m_DoublePrecision;
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ // Constructors & Destructor
+ ////
+ MetaObject(void);
+ MetaObject(const char * _fileName);
+ MetaObject(unsigned int dim);
+
+ virtual ~MetaObject(void);
+
+ void FileName(const char *_fileName);
+ const char * FileName(void) const;
+
+ void CopyInfo(const MetaObject * _object);
+
+ bool Read(const char * _fileName=NULL);
+
+ bool ReadStream(int _nDims, std::ifstream * _stream);
+
+ bool Write(const char * _fileName=NULL);
+
+ virtual bool Append(const char *_headName=NULL);
+
+ ////
+ //
+ // Common fields
+ //
+ ////
+
+ // PrintMetaInfo()
+ // Writes image parameters to stdout
+ virtual void PrintInfo(void) const;
+
+ // Comment(...)
+ // Optional Field
+ // Arbitrary string
+ const char * Comment(void) const;
+ void Comment(const char * _comment);
+
+ const char * ObjectTypeName(void) const;
+ void ObjectTypeName(const char * _objectTypeName);
+ const char * ObjectSubTypeName(void) const;
+ void ObjectSubTypeName(const char * _objectSubTypeName);
+
+ // NDims()
+ // REQUIRED Field
+ // Number of dimensions to the image
+ int NDims(void) const;
+
+ // Offset(...)
+ // Optional Field
+ // Physical location (in millimeters and wrt machine coordinate
+ // system or the patient) of the first element in the image
+ const double * Offset(void) const;
+ double Offset(int _i) const;
+ void Offset(const double * _position);
+ void Offset(int _i, double _value);
+ const double * Position(void) const;
+ double Position(int _i) const;
+ void Position(const double * _position);
+ void Position(int _i, double _value);
+ const double * Origin(void) const;
+ double Origin(int _i) const;
+ void Origin(const double * _position);
+ void Origin(int _i, double _value);
+
+ // TransformMatrix(...)
+ // Optional Field
+ // Physical orientation of the object as an NDims x NDims matrix
+ const double * TransformMatrix(void) const;
+ double TransformMatrix(int _i, int _j) const;
+ void TransformMatrix(const double * _orientation);
+ void TransformMatrix(int _i, int _j, double _value);
+ const double * Rotation(void) const;
+ double Rotation(int _i, int _j) const;
+ void Rotation(const double * _orientation);
+ void Rotation(int _i, int _j, double _value);
+ const double * Orientation(void) const;
+ double Orientation(int _i, int _j) const;
+ void Orientation(const double * _orientation);
+ void Orientation(int _i, int _j, double _value);
+
+ //
+ //
+ //
+ const double * CenterOfRotation(void) const;
+ double CenterOfRotation(int _i) const;
+ void CenterOfRotation(const double * _position);
+ void CenterOfRotation(int _i, double _value);
+
+ const char * AnatomicalOrientationAcronym(void) const;
+ const MET_OrientationEnumType * AnatomicalOrientation(void) const;
+ MET_OrientationEnumType AnatomicalOrientation(int _dim) const;
+ void AnatomicalOrientation(const char *_ao);
+ void AnatomicalOrientation(const MET_OrientationEnumType *_ao);
+ void AnatomicalOrientation(int _dim, MET_OrientationEnumType _ao);
+ void AnatomicalOrientation(int _dim, char ao);
+
+
+ // ElementSpacing(...)
+ // Optional Field
+ // Physical Spacing (in same units as position)
+ const float * ElementSpacing(void) const;
+ float ElementSpacing(int _i) const;
+ void ElementSpacing(const float * _elementSpacing);
+ void ElementSpacing(int _i, float _value);
+
+ // Name(...)
+ // Optional Field
+ // Name of the current metaObject
+ void Name(const char *_Name);
+ const char * Name(void) const;
+
+ // Color(...)
+ // Optional Field
+ // Color of the current metaObject
+ const float * Color(void) const;
+ void Color(float _r, float _g, float _b, float _a);
+ void Color(const float * _color);
+
+ // ID(...)
+ // Optional Field
+ // ID number of the current metaObject
+ void ID(int _id);
+ int ID(void) const;
+
+ // ParentID(...)
+ // Optional Field
+ // ID number of the parent metaObject
+ void ParentID(int _parentId);
+ int ParentID(void) const;
+
+ // BinaryData(...)
+ // Optional Field
+ // Data is binary or not
+ void BinaryData(bool _binaryData);
+ bool BinaryData(void) const;
+
+ void BinaryDataByteOrderMSB(bool _binaryDataByteOrderMSB);
+ bool BinaryDataByteOrderMSB(void) const;
+
+
+ void CompressedData(bool _compressedData);
+ bool CompressedData(void) const;
+
+
+ virtual void Clear(void);
+
+ void ClearFields(void);
+
+ bool InitializeEssential(int m_NDims);
+
+ //
+ //
+ // User's field definitions
+ bool AddUserField(const char* _fieldName,MET_ValueEnumType _type,int _length=0,
+ bool _required=true,int _dependsOn=-1);
+ // Add a user's field
+ template <class T>
+ bool AddUserField(const char* _fieldName,MET_ValueEnumType _type, int _length,
+ T *_v,bool _required=true,int _dependsOn=-1 )
+ {
+ MET_FieldRecordType* mFw = new MET_FieldRecordType;
+ MET_InitWriteField(mFw, _fieldName, _type, _length,_v);
+ m_UserDefinedWriteFields.push_back(mFw);
+
+ MET_FieldRecordType* mFr = new MET_FieldRecordType;
+ MET_InitReadField(mFr,_fieldName, _type, _required,_dependsOn,_length);
+ m_UserDefinedReadFields.push_back(mFr);
+
+ return true;
+ }
+
+ // Clear UserFields
+ void ClearUserFields();
+
+ // Get the user field
+ void* GetUserField(const char* _name);
+ void SetEvent(metaEvent* event) {m_Event = event;}
+
+ // Set the double precision for writing
+ void SetDoublePrecision(unsigned int precision) {m_DoublePrecision = precision;}
+ unsigned int GetDoublePrecision() {return m_DoublePrecision;}
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaScene.cxx b/Utilities/ITK/Utilities/MetaIO/metaScene.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3dff40fb7ca1fbcaabe4707bbd048f29dfaacaf7
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaScene.cxx
@@ -0,0 +1,493 @@
+#if defined(_MSC_VER)
+#pragma warning ( disable : 4786 )
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaScene.h>
+#include <metaTube.h>
+#include <metaDTITube.h>
+#include <metaVesselTube.h>
+#include <metaEllipse.h>
+#include <metaGaussian.h>
+#include <metaImage.h>
+#include <metaBlob.h>
+#include <metaLandmark.h>
+#include <metaLine.h>
+#include <metaGroup.h>
+#include <metaSurface.h>
+#include <metaLandmark.h>
+#include <metaMesh.h>
+#include <metaArrow.h>
+#include <metaTransform.h>
+#include <metaTubeGraph.h>
+
+//
+// MetaScene Constructors
+//
+MetaScene::
+MetaScene()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaScene()" << std::endl;
+ Clear();
+}
+
+
+//
+MetaScene::
+MetaScene(const MetaScene *_scene)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaScene()" << std::endl;
+ Clear();
+ CopyInfo(_scene);
+}
+
+//
+MetaScene::
+MetaScene(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaScene()" << std::endl;
+ Clear();
+}
+
+
+/** Destructor */
+MetaScene::
+~MetaScene()
+{
+ Clear();
+ M_Destroy();
+}
+
+//
+void MetaScene::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "Number of Objects = " << m_NObjects << std::endl;
+}
+
+void MetaScene::
+CopyInfo(const MetaScene * _tube)
+{
+ MetaObject::CopyInfo(_tube);
+}
+
+
+void MetaScene::
+NObjects(int nobjects)
+{
+ m_NObjects = nobjects;
+}
+
+int MetaScene::
+NObjects(void) const
+{
+ return m_NObjects;
+}
+
+void MetaScene::
+AddObject(MetaObject* object)
+{
+ m_ObjectList.push_back(object);
+}
+
+bool MetaScene::
+Read(const char *_headerName)
+{
+ if(META_DEBUG) std::cout << "MetaScene: Read" << std::endl;
+
+ int i = 0;
+ char suf[80];
+ suf[0] = '\0';
+ if(MET_GetFileSuffixPtr(_headerName, &i))
+ {
+ strcpy(suf, &_headerName[i]);
+ }
+
+ M_Destroy();
+
+ Clear();
+
+ M_SetupReadFields();
+
+ if(_headerName != NULL)
+ {
+ strcpy(m_FileName, _headerName);
+ }
+
+ if(META_DEBUG) std::cout << "MetaScene: Read: Opening stream" << std::endl;
+
+ M_PrepareNewReadStream();
+
+ m_ReadStream->open(m_FileName, std::ios::binary | std::ios::in);
+
+ if(!m_ReadStream->is_open())
+ {
+ std::cout << "MetaScene: Read: Cannot open file" << std::endl;
+ return false;
+ }
+
+ if(!M_Read())
+ {
+ std::cout << "MetaScene: Read: Cannot parse file" << std::endl;
+ m_ReadStream->close();
+ return false;
+ }
+
+ if(_headerName != NULL)
+ {
+ strcpy(m_FileName, _headerName);
+ }
+
+ if(m_Event)
+ {
+ m_Event->StartReading(m_NObjects);
+ }
+
+ /** Objects should be added here */
+ for(i=0;i<m_NObjects;i++)
+ {
+ if(META_DEBUG) std::cout << MET_ReadType(*m_ReadStream) << std::endl;
+
+ if(m_Event)
+ {
+ m_Event->SetCurrentIteration(i+1);
+ }
+
+ if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Tube",4) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "tre")))
+ {
+ char* subtype = MET_ReadSubType(*m_ReadStream);
+ if(!strncmp(subtype,"Vessel",6))
+ {
+ MetaVesselTube* vesseltube = new MetaVesselTube();
+ vesseltube->SetEvent(m_Event);
+ vesseltube->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(vesseltube);
+ }
+ else if(!strncmp(subtype,"DTI",3))
+ {
+ MetaDTITube* dtitube = new MetaDTITube();
+ dtitube->SetEvent(m_Event);
+ dtitube->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(dtitube);
+ }
+ else
+ {
+ MetaTube* tube = new MetaTube();
+ tube->SetEvent(m_Event);
+ tube->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(tube);
+ }
+ delete []subtype;
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Transform",9))
+ {
+ MetaTransform* transform = new MetaTransform();
+ transform->SetEvent(m_Event);
+ transform->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(transform);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"TubeGraph",9))
+ {
+ MetaTubeGraph* tubeGraph = new MetaTubeGraph();
+ tubeGraph->SetEvent(m_Event);
+ tubeGraph->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(tubeGraph);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Ellipse",7) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "elp")))
+ {
+ MetaEllipse* ellipse = new MetaEllipse();
+ ellipse->SetEvent(m_Event);
+ ellipse->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(ellipse);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Arrow",5))
+ {
+ MetaArrow* arrow = new MetaArrow();
+ arrow->SetEvent(m_Event);
+ arrow->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(arrow);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Gaussian",8) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "gau")))
+ {
+ MetaGaussian* gaussian = new MetaGaussian();
+ gaussian->SetEvent(m_Event);
+ gaussian->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(gaussian);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Image",5) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) &&
+ (!strcmp(suf, "mhd") || !strcmp(suf, "mha"))))
+ {
+ MetaImage* image = new MetaImage();
+ image->SetEvent(m_Event);
+ image->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(image);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Blob",4) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "blb")))
+ {
+ MetaBlob* blob = new MetaBlob();
+ blob->SetEvent(m_Event);
+ blob->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(blob);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Landmark",8) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "ldm")))
+ {
+ MetaLandmark* landmark = new MetaLandmark();
+ landmark->SetEvent(m_Event);
+ landmark->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(landmark);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Surface",5) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "suf")))
+ {
+ MetaSurface* surface = new MetaSurface();
+ surface->SetEvent(m_Event);
+ surface->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(surface);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Line",5) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "lin")))
+ {
+ MetaLine* line = new MetaLine();
+ line->SetEvent(m_Event);
+ line->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(line);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Group",5) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "grp")))
+ {
+ MetaGroup* group = new MetaGroup();
+ group->SetEvent(m_Event);
+ group->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(group);
+ }
+
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"AffineTransform",15) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "trn")))
+ {
+ MetaGroup* group = new MetaGroup();
+ group->SetEvent(m_Event);
+ group->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(group);
+ }
+ else if(!strncmp(MET_ReadType(*m_ReadStream).c_str(),"Mesh",4) ||
+ ((MET_ReadType(*m_ReadStream).size()==0) && !strcmp(suf, "msh")))
+ {
+ MetaMesh* mesh = new MetaMesh();
+ mesh->SetEvent(m_Event);
+ mesh->ReadStream(m_NDims,m_ReadStream);
+ m_ObjectList.push_back(mesh);
+ }
+ }
+
+ if(m_Event)
+ {
+ m_Event->StopReading();
+ }
+
+ m_ReadStream->close();
+
+ return true;
+}
+
+
+//
+//
+//
+bool MetaScene::
+Write(const char *_headName)
+{
+ if(META_DEBUG) std::cout << "MetaScene: Write" << std::endl;
+
+ if(_headName != NULL)
+ {
+ FileName(_headName);
+ }
+
+ // Set the number of objects based on the net list
+ //ObjectListType::const_iterator itNet = m_ObjectList.begin();
+ m_NObjects = m_ObjectList.size();
+
+ M_SetupWriteFields();
+
+ if(!m_WriteStream)
+ {
+ m_WriteStream = new std::ofstream;
+ }
+
+#ifdef __sgi
+ // Create the file. This is required on some older sgi's
+ std::ofstream tFile(m_FileName,std::ios::out);
+ tFile.close();
+#endif
+
+ m_WriteStream->open(m_FileName, std::ios::binary | std::ios::out);
+ if(!m_WriteStream->is_open())
+ {
+ return false;
+ delete m_WriteStream;
+ m_WriteStream = 0;
+ }
+
+ M_Write();
+
+ m_WriteStream->close();
+ delete m_WriteStream;
+ m_WriteStream = 0;
+
+ /** Then we write all the objects in the scene */
+ ObjectListType::iterator it = m_ObjectList.begin();
+ while(it != m_ObjectList.end())
+ {
+ (*it)->BinaryData(this->BinaryData());
+ (*it)->Append(_headName);
+ it++;
+ }
+
+ return true;
+}
+
+/** Clear tube information */
+void MetaScene::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaScene: Clear" << std::endl;
+ MetaObject::Clear();
+ // Delete the list of pointers to objects in the scene.
+ ObjectListType::iterator it = m_ObjectList.begin();
+ while(it != m_ObjectList.end())
+ {
+ MetaObject* object = *it;
+ it++;
+ delete object;
+ }
+
+ m_ObjectList.clear();
+
+}
+
+/** Destroy tube information */
+void MetaScene::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaScene::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaScene: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NObjects", MET_INT, false);
+ mF->required = true;
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+ mF = MET_GetFieldRecord("ElementSpacing", &m_Fields);
+ mF->required = false;
+}
+
+void MetaScene::
+M_SetupWriteFields(void)
+{
+ this->ClearFields();
+
+ MET_FieldRecordType * mF;
+
+ if(strlen(m_Comment)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Comment", MET_STRING, strlen(m_Comment), m_Comment);
+ m_Fields.push_back(mF);
+ }
+
+ strcpy(m_ObjectTypeName,"Scene");
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ObjectType", MET_STRING, strlen(m_ObjectTypeName),
+ m_ObjectTypeName);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NDims", MET_INT, m_NDims);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NObjects", MET_INT, m_NObjects);
+ m_Fields.push_back(mF);
+}
+
+
+
+bool MetaScene::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout<<"MetaScene: M_Read: Loading Header"<<std::endl;
+ if(strncmp(MET_ReadType(*m_ReadStream).c_str(),"Scene",5))
+ {
+ m_NObjects = 1;
+ return true;
+ }
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaScene: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaScene: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NObjects", &m_Fields);
+ if(mF->defined)
+ {
+ m_NObjects= (int)mF->value[0];
+ }
+
+ return true;
+}
+
+bool MetaScene::
+M_Write(void)
+{
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaScene: M_Write: Error parsing file" << std::endl;
+ return false;
+ }
+
+ return true;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaScene.h b/Utilities/ITK/Utilities/MetaIO/metaScene.h
new file mode 100644
index 0000000000000000000000000000000000000000..362436cd68fa3c4061536f6ed8fb99a0bc5ab0fc
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaScene.h
@@ -0,0 +1,102 @@
+#ifndef METASCENE_H
+#define METASCENE_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaScene (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaTubeFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date July, 2002
+ *
+ */
+
+
+class MetaScene : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<MetaObject*> ObjectListType;
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaScene(void);
+
+ MetaScene(const MetaScene *_scene);
+
+ MetaScene(unsigned int dim);
+
+ ~MetaScene(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaScene * _scene);
+
+ void AddObject(MetaObject* object);
+
+ //
+ //
+ //
+ // This function only reads registered tubes
+ bool Read(const char *_headerName=NULL);
+
+ bool Write(const char *_headName=NULL);
+
+ bool Append(const char* =NULL) {std::cout << "Not Implemented !" << std::endl;return true;}
+
+ void Clear(void);
+
+
+ // NObjects(...)
+ // Required Field
+ // Number of points wich compose the tube
+ void NObjects(int nobjects);
+ int NObjects(void) const;
+
+
+ ObjectListType * GetObjectList(void) {return & m_ObjectList;}
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NObjects; // "NObjects = " 0
+
+ ObjectListType m_ObjectList;
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaSurface.cxx b/Utilities/ITK/Utilities/MetaIO/metaSurface.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3edadacb5366cb9a10cb7ebc3cec90b96fe7023f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaSurface.cxx
@@ -0,0 +1,425 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaSurface.h>
+
+//
+// MetaSurface Constructors
+//
+MetaSurface::
+MetaSurface()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaSurface()" << std::endl;
+ Clear();
+}
+
+//
+MetaSurface::
+MetaSurface(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaSurface()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaSurface::
+MetaSurface(const MetaSurface *_surface)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaSurface()" << std::endl;
+ Clear();
+ CopyInfo(_surface);
+}
+
+
+
+//
+MetaSurface::
+MetaSurface(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaSurface()" << std::endl;
+ Clear();
+}
+
+//
+MetaSurface::
+~MetaSurface()
+{
+ Clear();
+
+ M_Destroy();
+}
+
+//
+void MetaSurface::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaSurface::
+CopyInfo(const MetaSurface * _surface)
+{
+ MetaObject::CopyInfo(_surface);
+}
+
+
+
+void MetaSurface::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaSurface::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaSurface::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaSurface::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+/** Clear Surface information */
+void MetaSurface::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaSurface: Clear" << std::endl;
+ MetaObject::Clear();
+ m_NPoints = 0;
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ SurfacePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ strcpy(m_PointDim, "x y z v1x v1y v1z r g b");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy Surface information */
+void MetaSurface::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaSurface::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaSurface: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementType", MET_STRING, true);
+ mF->required = true;
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaSurface::
+M_SetupWriteFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaSurface: M_SetupWriteFields" << std::endl;
+
+ strcpy(m_ObjectTypeName,"Surface");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ char s[255];
+ mF = new MET_FieldRecordType;
+ MET_TypeToString(m_ElementType, s);
+ MET_InitWriteField(mF, "ElementType", MET_STRING, strlen(s), s);
+ m_Fields.push_back(mF);
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+MET_ValueEnumType MetaSurface::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaSurface::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+
+bool MetaSurface::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaSurface: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaSurface: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaSurface: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("ElementType", &m_Fields);
+ if(mF->defined)
+ {
+ MET_StringToType((char *)(mF->value), &m_ElementType);
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+ int i;
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+
+ float v[16];
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims*2+4)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaSurface: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ int d;
+ double td;
+ for(int j=0; j<m_NPoints; j++)
+ {
+ SurfacePnt* pnt = new SurfacePnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V[d] = (float)td;
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(int j=0; j<m_NPoints; j++)
+ {
+ SurfacePnt* pnt = new SurfacePnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get(); // char c =
+ }
+
+ int d;
+ for(d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[d];
+ }
+
+ for(d=m_NDims; d<m_NDims*2; d++)
+ {
+ pnt->m_V[d-m_NDims] = v[d];
+ }
+
+ for(d=0; d<4; d++)
+ {
+ pnt->m_Color[d] = v[d+2*m_NDims];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ return true;
+}
+
+
+bool MetaSurface::
+M_Write(void)
+{
+
+ if(META_DEBUG) std::cout << "MetaSurface: M_Write" << std::endl;
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaSurface: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims*2+4)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V[d],m_ElementType,data,i++);
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,(m_NDims*2+4)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_V[d] << " ";
+ }
+
+ for(d=0;d<4;d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+
+ return true;
+
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/metaSurface.h b/Utilities/ITK/Utilities/MetaIO/metaSurface.h
new file mode 100644
index 0000000000000000000000000000000000000000..cdffbcc80b536e7fc2453f1e2462048d86a6e19d
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaSurface.h
@@ -0,0 +1,138 @@
+#ifndef METASURFACE_H
+#define METASURFACE_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaSurface (.h and .cxx)
+ *
+ * Description:
+ * Reads and Writes MetaSurfaceFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date July 02, 2002
+ *
+ */
+
+class SurfacePnt
+{
+public:
+
+ SurfacePnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ m_V = new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ m_V[i] = 0;
+ }
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ }
+ ~SurfacePnt()
+ {
+ delete []m_X;
+ delete []m_V;
+ };
+
+ unsigned int m_Dim;
+ float* m_X;
+ float* m_V;
+ float m_Color[4];
+};
+
+
+
+
+class MetaSurface : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<SurfacePnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaSurface(void);
+
+ MetaSurface(const char *_headerName);
+
+ MetaSurface(const MetaSurface *_surface);
+
+ MetaSurface(unsigned int dim);
+
+ ~MetaSurface(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaSurface * _surface);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the tube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ MET_ValueEnumType m_ElementType;
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTransform.cxx b/Utilities/ITK/Utilities/MetaIO/metaTransform.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bf8099a076a115ba6b48e41a849ff68c94b31731
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTransform.cxx
@@ -0,0 +1,537 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaTransform.h>
+
+/** MetaTransform constructors */
+MetaTransform::
+MetaTransform()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTransform()" << std::endl;
+ Clear();
+}
+
+//
+MetaTransform::
+MetaTransform(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTransform()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+//
+MetaTransform::
+MetaTransform(const MetaTransform *_group)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTransform()" << std::endl;
+ Clear();
+ CopyInfo(_group);
+}
+
+MetaTransform::
+MetaTransform(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaTransform()" << std::endl;
+ Clear();
+}
+
+//
+MetaTransform::
+~MetaTransform()
+{
+ delete parameters;
+ M_Destroy();
+}
+
+//
+void MetaTransform::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+}
+
+void MetaTransform::
+CopyInfo(const MetaTransform * _transform)
+{
+ MetaObject::CopyInfo(_transform);
+}
+
+/** Clear group information */
+void MetaTransform::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaTransform: Clear" << std::endl;
+ MetaObject::Clear();
+ if(parameters)
+ {
+ delete parameters;
+ }
+ parameters = NULL;
+ parametersDimension = 0;
+ transformOrder = 0;
+
+
+ for(unsigned int i=0;i<100;i++)
+ {
+ gridSpacing[i] = 1;
+ gridOrigin[i] = 0;
+ gridRegionSize[i] = 0;
+ gridRegionIndex[i] = 0;
+ }
+}
+
+/** Destroy group information */
+void MetaTransform::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaTransform::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaTransform: M_SetupReadFields" << std::endl;
+ MetaObject::M_SetupReadFields();
+
+ int nDimsRecordNumber = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ MET_FieldRecordType* mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Order", MET_INT,false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "GridRegionSize", MET_DOUBLE_ARRAY,false,nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "GridRegionIndex", MET_DOUBLE_ARRAY,false,nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "GridOrigin", MET_DOUBLE_ARRAY,false,nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "GridSpacing", MET_DOUBLE_ARRAY,false,nDimsRecordNumber);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NParameters", MET_INT,true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Parameters", MET_NONE);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaTransform::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Transform");
+ MetaObject::M_SetupWriteFields();
+
+ // We don't want to write the matrix and the offset
+ MET_FieldRecordType * mF;
+ mF = MET_GetFieldRecord("TransformMatrix",&m_Fields);
+
+ FieldsContainerType::iterator it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ mF = MET_GetFieldRecord("Offset",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ mF = MET_GetFieldRecord("ElementSpacing",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ int i;
+ bool writeCoR = false;
+ for(i=0;i<m_NDims;i++)
+ {
+ if(m_CenterOfRotation[i] != 0.0)
+ {
+ writeCoR = true;
+ break;
+ }
+ }
+
+ if(!writeCoR)
+ {
+ mF = MET_GetFieldRecord("CenterOfRotation",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+ }
+
+ if(transformOrder > 0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Order", MET_INT,transformOrder);
+ m_Fields.push_back(mF);
+ }
+
+ // Grid Spacing
+ bool writeGridSpacing = false;
+ for(i=0;i<100;i++)
+ {
+ if(gridSpacing[i] != 1)
+ {
+ writeGridSpacing = true;
+ break;
+ }
+ }
+
+ if(writeGridSpacing)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "GridSpacing", MET_DOUBLE_ARRAY,m_NDims,gridSpacing);
+ m_Fields.push_back(mF);
+ }
+
+ // Grid Origin
+ bool writeGridOrigin = false;
+ for(i=0;i<100;i++)
+ {
+ if(gridOrigin[i] != 0)
+ {
+ writeGridOrigin = true;
+ break;
+ }
+ }
+
+ if(writeGridOrigin)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "GridOrigin", MET_DOUBLE_ARRAY,m_NDims,gridOrigin);
+ m_Fields.push_back(mF);
+ }
+
+ // Grid region size
+ bool writeGridRegionSize = false;
+ for(i=0;i<100;i++)
+ {
+ if(gridRegionSize[i] != 0)
+ {
+ writeGridRegionSize = true;
+ break;
+ }
+ }
+
+ if(writeGridRegionSize)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "GridRegionSize", MET_DOUBLE_ARRAY,m_NDims,gridRegionSize);
+ m_Fields.push_back(mF);
+ }
+
+
+ // Grid region index
+ bool writeGridRegionIndex = false;
+ for(i=0;i<100;i++)
+ {
+ if(gridRegionIndex[i] != 0)
+ {
+ writeGridRegionIndex = true;
+ break;
+ }
+ }
+
+ if(writeGridRegionIndex)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "GridRegionIndex", MET_DOUBLE_ARRAY,m_NDims,gridRegionIndex);
+ m_Fields.push_back(mF);
+ }
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NParameters", MET_INT,parametersDimension);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Parameters", MET_NONE);
+ m_Fields.push_back(mF);
+}
+
+bool MetaTransform::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaLandmark: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all points */
+ if(m_BinaryData)
+ {
+ char* data = new char[parametersDimension*sizeof(double)];
+ unsigned int j=0;
+ for(unsigned int i=0;i<parametersDimension;i++)
+ {
+ data[j] = (char)parameters[i];
+ j+=sizeof(double);
+ }
+ m_WriteStream->write((char *)data,parametersDimension*sizeof(double));
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ for(unsigned int i=0;i<parametersDimension;i++)
+ {
+ *m_WriteStream << parameters[i] << " ";
+ }
+ *m_WriteStream << std::endl;
+ }
+
+ return true;
+
+}
+
+
+// Set/Get the spacing
+const double * MetaTransform::GridSpacing(void) const
+{
+ return gridSpacing;
+}
+
+void MetaTransform::GridSpacing(const double * _gridSpacing)
+{
+ for(int i=0;i<m_NDims;i++)
+ {
+ gridSpacing[i] = _gridSpacing[i];
+ }
+}
+
+// Set/Get the grid index
+const double * MetaTransform::GridOrigin(void) const
+{
+ return gridOrigin;
+}
+
+void MetaTransform::GridOrigin(const double * _gridOrigin)
+{
+ for(int i=0;i<m_NDims;i++)
+ {
+ gridOrigin[i] = _gridOrigin[i];
+ }
+}
+
+// Set/Get the region size
+const double * MetaTransform::GridRegionSize(void) const
+{
+ return gridRegionSize;
+}
+
+void MetaTransform::GridRegionSize(const double * _gridRegionSize)
+{
+ for(int i=0;i<m_NDims;i++)
+ {
+ gridRegionSize[i] = _gridRegionSize[i];
+ }
+}
+
+// Set/Get the region index
+const double * MetaTransform::GridRegionIndex(void) const
+{
+ return gridRegionIndex;
+}
+
+void MetaTransform::GridRegionIndex(const double * _gridRegionIndex)
+{
+ for(int i=0;i<m_NDims;i++)
+ {
+ gridRegionIndex[i] = _gridRegionIndex[i];
+ }
+}
+
+const double * MetaTransform::Parameters(void) const
+{
+ return parameters;
+}
+
+
+void MetaTransform::Parameters(unsigned int dimension, const double * _parameters)
+{
+ parametersDimension = dimension;
+
+ if(parameters)
+ {
+ delete parameters;
+ }
+
+ parameters = new double[parametersDimension];
+
+ // Copy the parameters
+ for(unsigned int i=0;i<parametersDimension;i++)
+ {
+ parameters[i] = _parameters[i];
+ }
+}
+
+bool MetaTransform::
+M_Read(void)
+{
+ if(META_DEBUG)
+ {
+ std::cout << "MetaTransform: M_Read: Loading Header" << std::endl;
+ }
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaTransform: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaTransform: M_Read: Parsing Header" << std::endl;
+ }
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("NParameters", &m_Fields);
+ if(mF->defined)
+ {
+ parametersDimension = (unsigned int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("GridSpacing", &m_Fields);
+ int i;
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ gridSpacing[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+
+ mF = MET_GetFieldRecord("GridOrigin", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ gridOrigin[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+
+ mF = MET_GetFieldRecord("GridRegionSize", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ gridRegionSize[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+
+ mF = MET_GetFieldRecord("GridRegionIndex", &m_Fields);
+ if(mF && mF->defined)
+ {
+ for(i=0; i<mF->length; i++)
+ {
+ gridRegionIndex[i] = static_cast<double>( mF->value[i] );
+ }
+ }
+
+
+ mF = MET_GetFieldRecord("Order", &m_Fields);
+ if(mF->defined)
+ {
+ transformOrder = (unsigned int)mF->value[0];
+ }
+
+ if(parameters)
+ {
+ delete parameters;
+ }
+
+ parameters = new double[parametersDimension];
+
+ if(m_BinaryData)
+ {
+ char* _data = new char[parametersDimension*sizeof(double)];
+ m_ReadStream->read((char *)_data, parametersDimension*sizeof(double));
+
+ unsigned int gc = m_ReadStream->gcount();
+ if(gc != parametersDimension*sizeof(double))
+ {
+ std::cout << "MetaTransform: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << parametersDimension*sizeof(double) << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ unsigned long k=0;
+
+ for(unsigned int j=0; j<parametersDimension; j++)
+ {
+ parameters[j] = _data[k];
+ k += sizeof(double);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(unsigned int k=0; k<parametersDimension; k++)
+ {
+ *m_ReadStream >> parameters[k];
+ m_ReadStream->get();
+ }
+ }
+
+/*
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ */
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTransform.h b/Utilities/ITK/Utilities/MetaIO/metaTransform.h
new file mode 100644
index 0000000000000000000000000000000000000000..7507f91f174dedc47f526ff4cf9edaa6dde1e6f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTransform.h
@@ -0,0 +1,111 @@
+#ifndef MetaTransform_H
+#define MetaTransform_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaTransform (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaTransformFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date Feb 14, 2005
+ *
+ * Depends on:
+ * MetaUtils.h
+ * MetaObject.h
+ */
+
+
+class MetaTransform : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaTransform(void);
+
+ MetaTransform(const char *_headerName);
+
+ MetaTransform(const MetaTransform *_group);
+
+ MetaTransform(unsigned int dim);
+
+ ~MetaTransform(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaTransform * _group);
+
+ void Clear(void);
+
+ // Set/Get the parameters of the transforms
+ const double * Parameters(void) const;
+ void Parameters(unsigned int dimension, const double * _parameters);
+
+ unsigned int NParameters() {return parametersDimension;}
+
+ unsigned int TransformOrder() {return transformOrder;}
+ void TransformOrder(unsigned int order) {transformOrder = order;}
+
+ // Set/Get the grid spacing
+ const double * GridSpacing(void) const;
+ void GridSpacing(const double * _gridSize);
+
+ // Set/Get the grid origin
+ const double * GridOrigin(void) const;
+ void GridOrigin(const double * _gridOrigin);
+
+ // Set/Get the grid region size
+ const double * GridRegionSize(void) const;
+ void GridRegionSize(const double * _gridRegionSize);
+
+ // Set/Get the grid region index
+ const double * GridRegionIndex(void) const;
+ void GridRegionIndex(const double * _gridRegionIndex);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+ bool M_Write(void);
+
+ double* parameters;
+ unsigned int parametersDimension;
+ unsigned int transformOrder;
+
+ // This ivars are used for the BSplineTransform
+ double gridSpacing[100];
+ double gridOrigin[100];
+ double gridRegionSize[100];
+ double gridRegionIndex[100];
+
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTube.cxx b/Utilities/ITK/Utilities/MetaIO/metaTube.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..17ddf20cd6c28fa06f59f1b1bf096012a5ee7319
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTube.cxx
@@ -0,0 +1,736 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaTube.h>
+
+/** MetaTube Constructors */
+MetaTube::
+MetaTube()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTube()" << std::endl;
+ Clear();
+}
+
+
+MetaTube::
+MetaTube(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTube()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+
+MetaTube::
+MetaTube(const MetaTube *_tube)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTube()" << std::endl;
+ Clear();
+ CopyInfo(_tube);
+}
+
+
+MetaTube::
+MetaTube(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaTube()" << std::endl;
+ Clear();
+}
+
+/** Destructor */
+MetaTube::
+~MetaTube()
+{
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ TubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ M_Destroy();
+}
+
+//
+void MetaTube::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "ParentPoint = " << m_ParentPoint << std::endl;
+ if(m_Root)
+ {
+ std::cout << "Root = " << "True" << std::endl;
+ }
+ else
+ {
+ std::cout << "Root = " << "True" << std::endl;
+ }
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaTube::
+CopyInfo(const MetaTube * _tube)
+{
+ MetaObject::CopyInfo(_tube);
+}
+
+
+
+void MetaTube::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaTube::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaTube::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaTube::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+void MetaTube::
+Root(bool root)
+{
+ m_Root = root;
+}
+
+bool MetaTube::
+Root(void) const
+{
+ return m_Root;
+}
+
+
+void MetaTube::
+ParentPoint(int parentpoint)
+{
+ m_ParentPoint = parentpoint;
+}
+
+int MetaTube::
+ParentPoint(void) const
+{
+ return m_ParentPoint;
+}
+
+/** Clear tube information */
+void MetaTube::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaTube: Clear" << std::endl;
+ MetaObject::Clear();
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ TubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+
+ m_ParentPoint= -1;
+ m_Root = false;
+ m_NPoints = 0;
+ strcpy(m_PointDim, "x y z r v1x v1y v1z v2x v2y v2z tx ty tz red green blue alpha id");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy tube information */
+void MetaTube::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaTube::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaTube: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ // int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ParentPoint", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Root", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaTube::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Tube");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ if(m_ParentPoint>=0 && m_ParentID>=0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ParentPoint", MET_INT,m_ParentPoint);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_Root)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("True"), "True");
+ m_Fields.push_back(mF);
+ }
+ else
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("False"), "False");
+ m_Fields.push_back(mF);
+ }
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+
+
+bool MetaTube::
+M_Read(void)
+{
+ if(META_DEBUG)
+ {
+ std::cout << "MetaTube: M_Read: Loading Header" << std::endl;
+ }
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaTube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaTube: M_Read: Parsing Header" << std::endl;
+ }
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("ParentPoint", &m_Fields);
+ if(mF->defined)
+ {
+ m_ParentPoint= (int)mF->value[0];
+ }
+
+ m_Root = false;
+ mF = MET_GetFieldRecord("Root", &m_Fields);
+ if(mF->defined)
+ {
+ if(*((char *)(mF->value)) == 'T'
+ || *((char*)(mF->value)) == 't'
+ || *((char*)(mF->value)) == '1')
+ {
+ m_Root = true;
+ }
+ else
+ {
+ m_Root = false;
+ }
+ }
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+
+ int* posDim= new int[m_NDims];
+ int i;
+ for(i= 0; i < m_NDims; i++)
+ {
+ posDim[i] = -1;
+ }
+ int posR = -1;
+ int posV1x = -1;
+ int posV1y = -1;
+ int posV1z = -1;
+ int posV2x = -1;
+ int posV2y = -1;
+ int posV2z = -1;
+ int posTx = -1;
+ int posTy = -1;
+ int posTz = -1;
+ int posRed = -1;
+ int posGreen = -1;
+ int posBlue = -1;
+ int posAlpha = -1;
+ int posID = -1;
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaTube: Parsing point dim" << std::endl;
+ }
+
+ int j;
+ for(j = 0; j < pntDim; j++)
+ {
+ if(!strcmp(pntVal[j], "x") || !strcmp(pntVal[j], "X"))
+ {
+ posDim[0] = j;
+ }
+ if(!strcmp(pntVal[j], "y") || !strcmp(pntVal[j], "Y"))
+ {
+ posDim[1] = j;
+ }
+ if(!strcmp(pntVal[j], "z") || !strcmp(pntVal[j], "Z"))
+ {
+ posDim[2] = j;
+ }
+ if(((char *)pntVal[j])[0] == 'w' || ((char *)pntVal[j])[0] == 'W')
+ {
+ posDim[(int)pntVal[j][1]+3] = j;
+ }
+ if(!strcmp(pntVal[j], "s") || !strcmp(pntVal[j], "S") ||
+ !strcmp(pntVal[j], "r") || !strcmp(pntVal[j], "R") ||
+ !strcmp(pntVal[j], "rad") || !strcmp(pntVal[j], "Rad") ||
+ !strcmp(pntVal[j], "radius") || !strcmp(pntVal[j], "Radius"))
+ {
+ posR = j;
+ }
+ if(!strcmp(pntVal[j], "v1x"))
+ {
+ posV1x = j;
+ }
+ if(!strcmp(pntVal[j], "v1y"))
+ {
+ posV1y = j;
+ }
+ if(!strcmp(pntVal[j], "v1z"))
+ {
+ posV1z = j;
+ }
+ if(!strcmp(pntVal[j], "v2x"))
+ {
+ posV2x = j;
+ }
+ if(!strcmp(pntVal[j], "v2y"))
+ {
+ posV2y = j;
+ }
+ if(!strcmp(pntVal[j], "v2z"))
+ {
+ posV2z = j;
+ }
+ if(!strcmp(pntVal[j], "tx"))
+ {
+ posTx = j;
+ }
+ if(!strcmp(pntVal[j], "ty"))
+ {
+ posTy = j;
+ }
+ if(!strcmp(pntVal[j], "tz"))
+ {
+ posTz = j;
+ }
+ if(!strcmp(pntVal[j], "red"))
+ {
+ posRed = j;
+ }
+ if(!strcmp(pntVal[j], "green"))
+ {
+ posGreen = j;
+ }
+
+ if(!strcmp(pntVal[j], "blue"))
+ {
+ posBlue = j;
+ }
+ if(!strcmp(pntVal[j], "alpha"))
+ {
+ posAlpha = j;
+ }
+ if(!strcmp(pntVal[j], "id") || !strcmp(pntVal[j], "ID"))
+ {
+ posID = j;
+ }
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+ float v[30];
+
+ if(m_Event)
+ {
+ m_Event->StartReading(m_NPoints);
+ }
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims*(2+m_NDims)+10)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLine: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize
+ << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ double td;
+ int d;
+ for(j=0; j<m_NPoints; j++)
+ {
+ TubePnt* pnt = new TubePnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_R = (float)td;
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V1[d] = (float)td;
+ }
+
+ if(m_NDims==3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V2[d] = (float)td;
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_T[d] = (float)td;
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+ MET_ValueToDouble(m_ElementType,_data,i++,&td);
+ pnt->m_ID=(int)td;
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ if(m_Event)
+ {
+ m_Event->SetCurrentIteration(j+1);
+ }
+
+ TubePnt* pnt = new TubePnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ for(int d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[posDim[d]];
+ }
+
+ pnt->m_R = v[posR];
+
+ if(posV1x>=0 && posV1x<pntDim)
+ {
+ pnt->m_V1[0] = v[posV1x];
+ if(posV1y >= 0 && posV1y<pntDim)
+ {
+ pnt->m_V1[1] = v[posV1y];
+ }
+ if(posV1z >= 0 && m_NDims>2 && posV1z<pntDim)
+ {
+ pnt->m_V1[2] = v[posV1z];
+ }
+ }
+ if(posV2x >= 0 && posV2x<pntDim)
+ {
+ pnt->m_V2[0] = v[posV2x];
+ if(posV2y >= 0 && posV2y<pntDim)
+ {
+ pnt->m_V2[1] = v[posV2y];
+ }
+ if(posV2z >= 0 && m_NDims>2 && posV2z<pntDim)
+ {
+ pnt->m_V2[2] = v[posV2z];
+ }
+ }
+ if(posTx >= 0 && posTx<pntDim)
+ {
+ pnt->m_T[0] = v[posTx];
+ if(posTy >= 0 && posTy<pntDim)
+ {
+ pnt->m_T[1] = v[posTy];
+ }
+ if(posTz >= 0 && m_NDims>2 && posTz<pntDim)
+ {
+ pnt->m_T[2] = v[posTz];
+ }
+ }
+
+ if(posRed >= 0 && posRed < pntDim)
+ {
+ pnt->m_Color[0] = v[posRed];
+ }
+
+ if(posGreen >= 0 && posGreen < pntDim)
+ {
+ pnt->m_Color[1] = v[posGreen];
+ }
+
+ if(posBlue >= 0 && posBlue < pntDim)
+ {
+ pnt->m_Color[2] = v[posBlue];
+ }
+
+ if(posAlpha >= 0 && posAlpha < pntDim)
+ {
+ pnt->m_Color[3] = v[posAlpha];
+ }
+
+ if(posID >= 0 && posID < pntDim)
+ {
+ pnt->m_ID = (int)v[posID];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ if(m_Event)
+ {
+ m_Event->StopReading();
+ }
+
+ delete []posDim;
+ return true;
+}
+
+MET_ValueEnumType MetaTube::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaTube::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+bool MetaTube::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaTube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all tubes points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims*(2+m_NDims)+10)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ MET_DoubleToValue((double)(*it)->m_R,m_ElementType,data,i++);
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V1[d],m_ElementType,data,i++);
+ }
+
+ if(m_NDims==3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V2[d],m_ElementType,data,i++);
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_T[d],m_ElementType,data,i++);
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+
+ MET_DoubleToValue((double)(*it)->m_ID,m_ElementType,data,i++);
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,
+ (m_NDims*(2+m_NDims)+10)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ *m_WriteStream << (*it)->m_R << " ";
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_V1[d] << " ";
+ }
+
+ if(m_NDims>=3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_V2[d] << " ";
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_T[d] << " ";
+ }
+
+ for(d=0;d<4;d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << (*it)->m_ID << " ";
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+ return true;
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTube.h b/Utilities/ITK/Utilities/MetaIO/metaTube.h
new file mode 100644
index 0000000000000000000000000000000000000000..a2df07a4858104e51128f95a5317753103275c36
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTube.h
@@ -0,0 +1,164 @@
+#ifndef METATUBE_H
+#define METATUBE_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaTube (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaTubeFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ */
+
+class TubePnt
+{
+public:
+
+ TubePnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ m_T = new float[m_Dim];
+ m_V1= new float[m_Dim];
+ m_V2= new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ m_V1[i]= 0;
+ m_V2[i]= 0;
+ m_T[i]= 0;
+ }
+ m_R=0;
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ m_ID = -1;
+ }
+
+ ~TubePnt()
+ {
+ delete []m_X;
+ delete []m_V1;
+ delete []m_V2;
+ delete []m_T;
+ };
+
+ unsigned int m_Dim;
+ float* m_V1;
+ float* m_V2;
+ float* m_X;
+ float* m_T;
+ float m_R;
+ float m_Color[4];
+ int m_ID;
+};
+
+
+
+
+class MetaTube : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<TubePnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaTube(void);
+
+ MetaTube(const char *_headerName);
+
+ MetaTube(const MetaTube *_tube);
+
+ MetaTube(unsigned int dim);
+
+ ~MetaTube(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaTube * _tube);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the tube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+ // Root(...)
+ // Optional Field
+ // Set if this tube is a root
+ void Root(bool root);
+ bool Root(void) const;
+
+
+ // ParentPoint(...)
+ // Optional Field
+ // Set the point number of the parent tube where the branch occurs
+ void ParentPoint(int parentpoint);
+ int ParentPoint(void) const;
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_ParentPoint; // "ParentPoint = " -1
+
+ bool m_Root; // "Root = " 0
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+ MET_ValueEnumType m_ElementType;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.cxx b/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..58ecf37f3ac3f5c8f4ad3b643501d90b7253c419
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.cxx
@@ -0,0 +1,536 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaTubeGraph.h>
+
+/** MetaTubeGraph Constructors */
+MetaTubeGraph::
+MetaTubeGraph()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph()" << std::endl;
+ Clear();
+}
+
+
+MetaTubeGraph::
+MetaTubeGraph(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+
+MetaTubeGraph::
+MetaTubeGraph(const MetaTubeGraph *_tube)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph()" << std::endl;
+ Clear();
+ CopyInfo(_tube);
+}
+
+
+MetaTubeGraph::
+MetaTubeGraph(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph()" << std::endl;
+ Clear();
+}
+
+/** Destructor */
+MetaTubeGraph::
+~MetaTubeGraph()
+{
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ TubeGraphPnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ M_Destroy();
+}
+
+//
+void MetaTubeGraph::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "Root = " << m_Root << std::endl;
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaTubeGraph::
+CopyInfo(const MetaTubeGraph * _tube)
+{
+ MetaObject::CopyInfo(_tube);
+}
+
+
+
+void MetaTubeGraph::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaTubeGraph::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaTubeGraph::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaTubeGraph::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+void MetaTubeGraph::
+Root(int root)
+{
+ m_Root = root;
+}
+
+int MetaTubeGraph::
+Root(void) const
+{
+ return m_Root;
+}
+
+
+/** Clear tube information */
+void MetaTubeGraph::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph: Clear" << std::endl;
+ MetaObject::Clear();
+ // Delete the list of pointers to tubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ TubeGraphPnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+
+ m_Root = 0;
+ m_NPoints = 0;
+ strcpy(m_PointDim, "Node r p txx txy txz tyx tyy tyz tzx tzy tzz");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy tube information */
+void MetaTubeGraph::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaTubeGraph::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Root", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaTubeGraph::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"TubeGraph");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+ FieldsContainerType::iterator it;
+
+ mF = MET_GetFieldRecord("TransformMatrix",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ mF = MET_GetFieldRecord("Offset",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ mF = MET_GetFieldRecord("ElementSpacing",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ mF = MET_GetFieldRecord("CenterOfRotation",&m_Fields);
+ it = m_Fields.begin();
+ while(it != m_Fields.end())
+ {
+ if(*it == mF)
+ {
+ m_Fields.erase(it);
+ break;
+ }
+ it++;
+ }
+
+ if(m_Root>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_INT,m_Root);
+ m_Fields.push_back(mF);
+ }
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+
+
+bool MetaTubeGraph::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaTubeGraph: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaTubeGraph: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaTubeGraph: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("Root", &m_Fields);
+ if(mF->defined)
+ {
+ m_Root= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+
+ int i;
+ int posR = -1;
+ int posP = -1;
+ int posTx = -1;
+ int posGraphNode = -1;
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+ if(META_DEBUG)
+ { std::cout << "MetaTubeGraph: Parsing point dim" << std::endl; }
+
+ int j;
+ for(j = 0; j < pntDim; j++)
+ {
+ if(!strcmp(pntVal[j], "node") || !strcmp(pntVal[j], "Node"))
+ {
+ posGraphNode = j;
+ }
+ if(!strcmp(pntVal[j], "s") || !strcmp(pntVal[j], "S") ||
+ !strcmp(pntVal[j], "r") || !strcmp(pntVal[j], "R") ||
+ !strcmp(pntVal[j], "rad") || !strcmp(pntVal[j], "Rad") ||
+ !strcmp(pntVal[j], "radius") || !strcmp(pntVal[j], "Radius"))
+ {
+ posR = j;
+ }
+ if(!strcmp(pntVal[j], "p") || !strcmp(pntVal[j], "P"))
+ {
+ posP = j;
+ }
+ if(!strcmp(pntVal[j], "txx"))
+ {
+ posTx = j;
+ }
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+ float v[30];
+
+ if(m_Event)
+ {
+ m_Event->StartReading(m_NPoints);
+ }
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*pntDim*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLine: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize << " : actual = " << gc
+ << std::endl;
+ return false;
+ }
+
+ double td;
+ for(j=0; j<m_NPoints; j++)
+ {
+ TubeGraphPnt* pnt = new TubeGraphPnt(m_NDims);
+
+ MET_ValueToDouble(m_ElementType,_data,posGraphNode,&td);
+ pnt->m_GraphNode=(int)td;
+
+ if(posR != -1)
+ {
+ MET_ValueToDouble(m_ElementType, _data, posR, &td);
+ pnt->m_R = (float)td;
+ }
+
+ if(posP != -1)
+ {
+ MET_ValueToDouble(m_ElementType, _data, posP, &td);
+ pnt->m_P = (float)td;
+ }
+
+ if(posTx != -1)
+ {
+ for(int r=0; r<m_NDims*m_NDims; r++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, posTx+r, &td);
+ pnt->m_T[r] = (float)td;
+ }
+ }
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ if(m_Event)
+ {
+ m_Event->SetCurrentIteration(j+1);
+ }
+
+ TubeGraphPnt* pnt = new TubeGraphPnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ pnt->m_GraphNode = (int)v[posGraphNode];
+
+ if(posR != -1)
+ {
+ pnt->m_R = v[posR];
+ }
+
+ if(posP != -1)
+ {
+ pnt->m_P = v[posP];
+ }
+
+ if(posTx >= 0 && posTx<pntDim)
+ {
+ for(int r=0; r<m_NDims*m_NDims; r++)
+ {
+ pnt->m_T[r] = v[posTx+r];
+ }
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ if(m_Event)
+ {
+ m_Event->StopReading();
+ }
+
+ return true;
+}
+
+MET_ValueEnumType MetaTubeGraph::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaTubeGraph::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+bool MetaTubeGraph::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaTubeGraph: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all tubes points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims*m_NDims+3)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ MET_DoubleToValue((double)(*it)->m_GraphNode,m_ElementType,data,i++);
+
+ MET_DoubleToValue((double)(*it)->m_R,m_ElementType,data,i++);
+
+ MET_DoubleToValue((double)(*it)->m_P,m_ElementType,data,i++);
+
+ for(d = 0; d < m_NDims*m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_T[d],m_ElementType,data,i++);
+ }
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,
+ (m_NDims*m_NDims+3)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ *m_WriteStream << (*it)->m_GraphNode << " ";
+
+ *m_WriteStream << (*it)->m_R << " ";
+
+ *m_WriteStream << (*it)->m_P << " ";
+
+ for(d = 0; d < m_NDims*m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_T[d] << " ";
+ }
+
+ *m_WriteStream << std::endl;
+
+ it++;
+ }
+ }
+ return true;
+
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.h b/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.h
new file mode 100644
index 0000000000000000000000000000000000000000..274510bd08ea1f425962bb92dae18df25b030346
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTubeGraph.h
@@ -0,0 +1,135 @@
+#ifndef METATUBEGRAPH_H
+#define METATUBEGRAPH_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <vector>
+
+
+/*! MetaTubeGraph (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaTubeGraph Files.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ */
+
+class TubeGraphPnt
+{
+public:
+
+ TubeGraphPnt(int dim)
+ {
+ m_Dim = dim;
+ m_GraphNode = -1;
+ m_R = 0;
+ m_P = 0;
+ m_T = new float[m_Dim*m_Dim];
+ }
+
+ ~TubeGraphPnt()
+ {
+ delete m_T;
+ };
+
+ unsigned int m_Dim;
+ int m_GraphNode;
+ float m_R;
+ float m_P;
+ float* m_T;
+};
+
+
+
+
+class MetaTubeGraph : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::vector<TubeGraphPnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaTubeGraph(void);
+
+ MetaTubeGraph(const char *_headerName);
+
+ MetaTubeGraph(const MetaTubeGraph *_tube);
+
+ MetaTubeGraph(unsigned int dim);
+
+ ~MetaTubeGraph(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaTubeGraph * _tube);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the tube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+ // Root(...)
+ // Optional Field
+ // Set if this tube is a root
+ void Root(int root);
+ int Root(void) const;
+
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_Root; // "Root = " 0
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+
+ MET_ValueEnumType m_ElementType;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaTypes.h b/Utilities/ITK/Utilities/MetaIO/metaTypes.h
new file mode 100644
index 0000000000000000000000000000000000000000..13da03abb37738b29ea58e70a95b31153edd6feb
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaTypes.h
@@ -0,0 +1,151 @@
+/*!
+ * File:
+ * MetaTypes (.h and .cpp)
+ *
+ * Description:
+ * This file provides the definition of the enumerated types used by
+ * metaObjects as well as the record structured used to describe the
+ * fields to be read and written by MetaObjects.
+ *
+ *
+ * \author Stephen R. Aylward
+ * \date August 29, 1999
+ *
+ */
+
+
+#ifndef METATYPES_H
+#define METATYPES_H
+
+typedef char MET_ASCII_CHAR_TYPE;
+typedef char MET_CHAR_TYPE;
+typedef unsigned char MET_UCHAR_TYPE;
+typedef short MET_SHORT_TYPE;
+typedef unsigned short MET_USHORT_TYPE;
+typedef int MET_INT_TYPE;
+typedef unsigned int MET_UINT_TYPE;
+typedef int MET_LONG_TYPE;
+typedef unsigned int MET_ULONG_TYPE;
+#if defined(_WIN32) && !defined(__CYGWIN__) && !defined(__MING_W32__)
+typedef __int64 MET_LONG_LONG_TYPE;
+typedef unsigned __int64 MET_ULONG_LONG_TYPE;
+#else
+typedef long long MET_LONG_LONG_TYPE;
+typedef unsigned long long MET_ULONG_LONG_TYPE;
+#endif
+typedef float MET_FLOAT_TYPE;
+typedef double MET_DOUBLE_TYPE;
+typedef char * MET_STRING_TYPE;
+
+
+// Value types for the variables in a metaFile
+// Format for variables defined in a metaFile is
+// <variable> = <value>
+// where <variable> is a designated fieldname/keyword (e.g., NDims)
+// and value is an instance of that fieldname's associated valueType
+#define MET_NUM_VALUE_TYPES 29
+
+typedef enum
+ {
+ MET_NONE,
+ MET_ASCII_CHAR,
+ MET_CHAR,
+ MET_UCHAR,
+ MET_SHORT,
+ MET_USHORT,
+ MET_INT,
+ MET_UINT,
+ MET_LONG,
+ MET_ULONG,
+ MET_LONG_LONG,
+ MET_ULONG_LONG,
+ MET_FLOAT,
+ MET_DOUBLE,
+ MET_STRING,
+ MET_CHAR_ARRAY,
+ MET_UCHAR_ARRAY,
+ MET_SHORT_ARRAY,
+ MET_USHORT_ARRAY,
+ MET_INT_ARRAY,
+ MET_UINT_ARRAY,
+ MET_LONG_ARRAY,
+ MET_ULONG_ARRAY,
+ MET_LONG_LONG_ARRAY,
+ MET_ULONG_LONG_ARRAY,
+ MET_FLOAT_ARRAY,
+ MET_DOUBLE_ARRAY,
+ MET_FLOAT_MATRIX,
+ MET_OTHER
+ } MET_ValueEnumType;
+
+
+const unsigned char MET_ValueTypeSize[MET_NUM_VALUE_TYPES] = {
+ 0, 1, 1, 1, 2, 2, 4, 4, 4, 4, 8, 8, 4, 8, 1, 1, 1, 2, 2, 4, 4, 4, 4, 8, 8, 4, 8, 4, 0 };
+
+const char MET_ValueTypeName[MET_NUM_VALUE_TYPES][21] = {
+ {'M','E','T','_','N','O','N','E','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','A','S','C','I','I','_','C','H','A','R','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','C','H','A','R','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','C','H','A','R','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','S','H','O','R','T','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','S','H','O','R','T','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','I','N','T','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','I','N','T','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','L','O','N','G','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','L','O','N','G','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','L','O','N','G','_','L','O','N','G','\0',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','L','O','N','G','_','L','O','N','G','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','F','L','O','A','T','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','D','O','U','B','L','E','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','S','T','R','I','N','G','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','C','H','A','R','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','C','H','A','R','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' '},
+ {'M','E','T','_','S','H','O','R','T','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','S','H','O','R','T','_','A','R','R','A','Y','\0',' ',' ',' ',' '},
+ {'M','E','T','_','I','N','T','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','I','N','T','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','L','O','N','G','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' ',' '},
+ {'M','E','T','_','U','L','O','N','G','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' '},
+ {'M','E','T','_','L','O','N','G','_','L','O','N','G','_','A','R','R','A','Y','\0',' '},
+ {'M','E','T','_','U','L','O','N','G','_','L','O','N','G','_','A','R','R','A','Y','\0'},
+ {'M','E','T','_','F','L','O','A','T','_','A','R','R','A','Y','\0',' ',' ',' ',' ',' '},
+ {'M','E','T','_','D','O','U','B','L','E','_','A','R','R','A','Y','\0',' ',' ',' ',' '},
+ {'M','E','T','_','F','L','O','A','T','_','M','A','T','R','I','X','\0',' ',' ',' ',' '},
+ {'M','E','T','_','O','T','H','E','R','\0',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '}};
+
+
+typedef enum { MET_ORIENTATION_RL, MET_ORIENTATION_LR, MET_ORIENTATION_AP,
+ MET_ORIENTATION_PA, MET_ORIENTATION_SI, MET_ORIENTATION_IS,
+ MET_ORIENTATION_UNKNOWN } MET_OrientationEnumType;
+
+#define MET_NUM_ORIENTATION_TYPES 7
+
+const char MET_OrientationTypeName[MET_NUM_ORIENTATION_TYPES][3] = {
+ {'R','L','\0'},
+ {'L','R','\0'},
+ {'A','P','\0'},
+ {'P','A','\0'},
+ {'S','I','\0'},
+ {'I','S','\0'},
+ {'?','?','\0'}};
+
+
+// Structure used to define a field (variable = value definition) in a MetaFile
+typedef struct
+ {
+ char name[255]; // Fieldname / keyword to designate a variable
+ MET_ValueEnumType type; // Expected value type of the field
+ bool required; // Is this field a required field in a metaFile
+ int dependsOn; // If value type is an array, the size of this
+ // array can be defined by a different field
+ // (e.g., DimSize array depends on NDims)
+ bool defined; // Has this field already been defined in the
+ // MetaFile being parsed
+ int length; // Actual/expect length of an array
+ double value[255]; // Memory and pointers for the field's value(s).
+ bool terminateRead; // Set to true if field indicates end of
+ // meta data
+ } MET_FieldRecordType;
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaUtils.cxx b/Utilities/ITK/Utilities/MetaIO/metaUtils.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..eb60ce796fe49b2077dd5e4d1f09ffe6f58ea922
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaUtils.cxx
@@ -0,0 +1,1242 @@
+#include <stdio.h>
+#include <iostream>
+#include <ctype.h>
+
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#ifndef _WIN32
+#include <unistd.h>
+#include <arpa/inet.h>
+#endif
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+
+#include <stdlib.h>
+#include <string>
+
+char MET_SeperatorChar = '=';
+
+bool MET_SystemByteOrderMSB(void)
+ {
+ const int l = 1;
+ const char * u = (const char *) & l;
+
+ if (u[0])
+ {
+ return false;
+ }
+ else
+ {
+ return true;
+ }
+ }
+
+MET_FieldRecordType *
+MET_GetFieldRecord(const char * _fieldName,
+ std::vector<MET_FieldRecordType *> * _fields)
+ {
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+ for(fieldIter=_fields->begin(); fieldIter!=_fields->end(); fieldIter++)
+ {
+ if(!strcmp((*fieldIter)->name, _fieldName))
+ {
+ return *fieldIter;
+ }
+ }
+ return NULL;
+ }
+
+
+int
+MET_GetFieldRecordNumber(const char * _fieldName,
+ std::vector<MET_FieldRecordType *> * _fields)
+ {
+ int i;
+ for(i=0; i<(int)_fields->size(); i++)
+ {
+ if(!strcmp((*_fields)[i]->name, _fieldName))
+ {
+ return i;
+ }
+ }
+ return -1;
+ }
+
+
+//
+// Read the type of the object
+//
+std::string MET_ReadType(std::istream &_fp)
+ {
+ unsigned int pos = _fp.tellg();
+ std::vector<MET_FieldRecordType *> fields;
+ MET_FieldRecordType* mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ObjectType", MET_STRING, false);
+ mF->required = false;
+ mF->terminateRead = true;
+ fields.push_back(mF);
+
+ MET_Read(_fp, &fields, '=', true);
+ _fp.seekg(pos);
+
+ std::string value;
+
+ if(mF && mF->defined)
+ {
+ value = (char *)(mF->value);
+ delete mF;
+ return value;
+ }
+
+ value[0] = '\0';
+ delete mF;
+ return value;
+ }
+
+//
+// Read the subtype of the object
+//
+char* MET_ReadSubType(std::istream &_fp)
+ {
+ unsigned int pos = _fp.tellg();
+ std::vector<MET_FieldRecordType *> fields;
+ MET_FieldRecordType* mF;
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ObjectType", MET_STRING, false);
+ mF->required = false;
+ fields.push_back(mF);
+
+ MET_Read(_fp, &fields, '=', true);
+
+ // Find the line right after the ObjectType
+ char s[1024];
+ _fp.getline( s, 500 );
+ std::string value = s;
+ int position = value.find("=");
+ if(position!=-1)
+ {
+ value = value.substr(position+2,value.size()-position);
+ }
+ _fp.seekg(pos);
+
+ char* ret = new char[value.size()+1];
+ strncpy(ret,value.c_str(),value.size());
+ ret[value.size()] = '\0';
+ delete mF;
+ return ret;
+ }
+
+
+//
+// String To Type
+//
+bool MET_StringToType(const char *_s, MET_ValueEnumType *_vType)
+ {
+ int i;
+ for(i=0; i<MET_NUM_VALUE_TYPES; i++)
+ {
+ if(!strcmp(_s, MET_ValueTypeName[i]))
+ {
+ *_vType = (MET_ValueEnumType)i;
+ return true;
+ }
+ }
+
+ *_vType = MET_OTHER;
+ return false;
+ }
+
+//
+// METType To String
+//
+bool MET_TypeToString(MET_ValueEnumType _vType, char *_s)
+ {
+ if(_vType>=0 && _vType<=MET_NUM_VALUE_TYPES)
+ {
+ sprintf(_s, MET_ValueTypeName[_vType]);
+ return true;
+ }
+
+ return false;
+ }
+
+
+//
+// Sizeof METTYPE
+//
+bool MET_SizeOfType(MET_ValueEnumType _vType, int *s)
+ {
+ *s = MET_ValueTypeSize[_vType];
+ if(_vType < MET_STRING)
+ {
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+ }
+
+//
+// Value to Double
+//
+bool MET_ValueToDouble(MET_ValueEnumType _type, const void *_data, int _index,
+ double *_value)
+ {
+ switch(_type)
+ {
+ case MET_ASCII_CHAR:
+ case MET_CHAR:
+ case MET_CHAR_ARRAY:
+ *_value = (double)(((const MET_CHAR_TYPE *)_data)[_index]);
+ return true;
+ case MET_UCHAR:
+ case MET_UCHAR_ARRAY:
+ *_value = (double)(((const MET_UCHAR_TYPE *)_data)[_index]);
+ return true;
+ case MET_SHORT:
+ case MET_SHORT_ARRAY:
+ *_value = (double)(((const MET_SHORT_TYPE *)_data)[_index]);
+ return true;
+ case MET_USHORT:
+ case MET_USHORT_ARRAY:
+ *_value = (double)(((const MET_USHORT_TYPE *)_data)[_index]);
+ return true;
+ case MET_INT:
+ case MET_INT_ARRAY:
+ *_value = (double)(((const MET_INT_TYPE *)_data)[_index]);
+ return true;
+ case MET_LONG:
+ case MET_LONG_ARRAY:
+ *_value = (double)(((const MET_LONG_TYPE *)_data)[_index]);
+ return true;
+ case MET_UINT:
+ case MET_UINT_ARRAY:
+ *_value = (double)(((const MET_UINT_TYPE *)_data)[_index]);
+ return true;
+ case MET_ULONG:
+ case MET_ULONG_ARRAY:
+ *_value = (double)(((const MET_ULONG_TYPE *)_data)[_index]);
+ return true;
+ case MET_LONG_LONG:
+ case MET_LONG_LONG_ARRAY:
+ *_value = (double)(((const MET_LONG_LONG_TYPE *)_data)[_index]);
+ return true;
+ case MET_ULONG_LONG:
+ case MET_ULONG_LONG_ARRAY:
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ *_value = (double)((MET_LONG_LONG_TYPE)((((const MET_ULONG_LONG_TYPE *)_data)[_index])));
+#else
+ *_value = (double)((((const MET_ULONG_LONG_TYPE *)_data)[_index]));
+#endif
+ return true;
+ case MET_FLOAT:
+ case MET_FLOAT_ARRAY:
+ case MET_FLOAT_MATRIX:
+ *_value = (double)(((const MET_FLOAT_TYPE *)_data)[_index]);
+ return true;
+ case MET_DOUBLE:
+ case MET_DOUBLE_ARRAY:
+ *_value = (double)(((const MET_DOUBLE_TYPE *)_data)[_index]);
+ return true;
+ case MET_STRING:
+ *_value = atof(&(((const MET_CHAR_TYPE *)_data)[_index]));
+ return true;
+ default:
+ *_value = 0;
+ return false;
+ }
+ }
+
+bool MET_DoubleToValue(double _value, MET_ValueEnumType _type, void *_data, int _index)
+ {
+ switch(_type)
+ {
+ case MET_ASCII_CHAR:
+ case MET_CHAR:
+ case MET_CHAR_ARRAY:
+ ((MET_CHAR_TYPE *)_data)[_index] = (MET_CHAR_TYPE)_value;
+ return true;
+ case MET_UCHAR:
+ case MET_UCHAR_ARRAY:
+ ((MET_UCHAR_TYPE *)_data)[_index] = (MET_UCHAR_TYPE)_value;
+ return true;
+ case MET_SHORT:
+ case MET_SHORT_ARRAY:
+ ((MET_SHORT_TYPE *)_data)[_index] = (MET_SHORT_TYPE)_value;
+ return true;
+ case MET_USHORT:
+ case MET_USHORT_ARRAY:
+ ((MET_USHORT_TYPE *)_data)[_index] = (MET_USHORT_TYPE)_value;
+ return true;
+ case MET_INT:
+ case MET_INT_ARRAY:
+ ((MET_INT_TYPE *)_data)[_index] = (MET_INT_TYPE)_value;
+ return true;
+ case MET_LONG:
+ case MET_LONG_ARRAY:
+ ((MET_LONG_TYPE *)_data)[_index] = (MET_LONG_TYPE)_value;
+ return true;
+ case MET_UINT:
+ case MET_UINT_ARRAY:
+ ((MET_UINT_TYPE *)_data)[_index] = (MET_UINT_TYPE)_value;
+ return true;
+ case MET_ULONG:
+ case MET_ULONG_ARRAY:
+ ((MET_ULONG_TYPE *)_data)[_index] = (MET_ULONG_TYPE)_value;
+ return true;
+ case MET_LONG_LONG:
+ case MET_LONG_LONG_ARRAY:
+ ((MET_LONG_LONG_TYPE *)_data)[_index] = (MET_LONG_LONG_TYPE)_value;
+ return true;
+ case MET_ULONG_LONG:
+ case MET_ULONG_LONG_ARRAY:
+ ((MET_ULONG_LONG_TYPE *)_data)[_index] = (MET_ULONG_LONG_TYPE)_value;
+ return true;
+ case MET_FLOAT:
+ case MET_FLOAT_ARRAY:
+ case MET_FLOAT_MATRIX:
+ ((MET_FLOAT_TYPE *)_data)[_index] = (MET_FLOAT_TYPE)_value;
+ return true;
+ case MET_DOUBLE:
+ case MET_DOUBLE_ARRAY:
+ ((MET_DOUBLE_TYPE *)_data)[_index] = (MET_DOUBLE_TYPE)_value;
+ return true;
+ case MET_STRING:
+ sprintf(&(((MET_CHAR_TYPE *)_data)[_index]), "%f", _value);
+ return true;
+ default:
+ return false;
+ }
+ }
+
+bool MET_ValueToValue(MET_ValueEnumType _fromType, const void *_fromData,
+ int _index,
+ MET_ValueEnumType _toType, void *_toData,
+ double _fromMin, double _fromMax,
+ double _toMin, double _toMax)
+ {
+ double tf;
+ MET_ValueToDouble(_fromType, _fromData, _index, &tf);
+ if(_toMin != _toMax && _fromMin != _fromMax)
+ {
+ tf = (tf-_fromMin)/(_fromMax-_fromMin) * (_toMax-_toMin) + _toMin;
+ if(tf<_toMin)
+ {
+ tf = _toMin;
+ }
+ else if(tf>_toMax)
+ {
+ tf = _toMax;
+ }
+ }
+ switch(_toType)
+ {
+ case MET_ASCII_CHAR:
+ case MET_CHAR:
+ case MET_CHAR_ARRAY:
+ (((MET_CHAR_TYPE *)_toData)[_index]) = (MET_CHAR_TYPE)tf;
+ return true;
+ case MET_UCHAR:
+ case MET_UCHAR_ARRAY:
+ (((MET_UCHAR_TYPE *)_toData)[_index]) = (MET_UCHAR_TYPE)tf;
+ return true;
+ case MET_SHORT:
+ case MET_SHORT_ARRAY:
+ (((MET_SHORT_TYPE *)_toData)[_index]) = (MET_SHORT_TYPE)tf;
+ return true;
+ case MET_USHORT:
+ case MET_USHORT_ARRAY:
+ (((MET_USHORT_TYPE *)_toData)[_index]) = (MET_USHORT_TYPE)tf;
+ return true;
+ case MET_INT:
+ case MET_INT_ARRAY:
+ (((MET_INT_TYPE *)_toData)[_index]) = (MET_INT_TYPE)tf;
+ return true;
+ case MET_LONG:
+ case MET_LONG_ARRAY:
+ (((MET_LONG_TYPE *)_toData)[_index]) = (MET_LONG_TYPE)tf;
+ return true;
+ case MET_UINT:
+ case MET_UINT_ARRAY:
+ (((MET_UINT_TYPE *)_toData)[_index]) = (MET_UINT_TYPE)tf;
+ return true;
+ case MET_ULONG:
+ case MET_ULONG_ARRAY:
+ (((MET_ULONG_TYPE *)_toData)[_index]) = (MET_ULONG_TYPE)tf;
+ return true;
+ case MET_LONG_LONG:
+ case MET_LONG_LONG_ARRAY:
+ (((MET_LONG_LONG_TYPE *)_toData)[_index]) = (MET_LONG_LONG_TYPE)tf;
+ return true;
+ case MET_ULONG_LONG:
+ case MET_ULONG_LONG_ARRAY:
+ (((MET_ULONG_LONG_TYPE *)_toData)[_index]) = (MET_ULONG_LONG_TYPE)tf;
+ return true;
+ case MET_DOUBLE:
+ case MET_DOUBLE_ARRAY:
+ (((MET_DOUBLE_TYPE *)_toData)[_index]) = (MET_DOUBLE_TYPE)tf;
+ return true;
+ case MET_FLOAT:
+ case MET_FLOAT_ARRAY:
+ case MET_FLOAT_MATRIX:
+ (((MET_FLOAT_TYPE *)_toData)[_index]) = (MET_FLOAT_TYPE)tf;
+ return true;
+ case MET_STRING:
+ sprintf(&(((MET_CHAR_TYPE *)_toData)[_index]), "%f", tf);
+ return true;
+ default:
+ return false;
+ }
+ }
+
+//
+//
+//
+bool MET_StringToWordArray(const char *s, int *n, char ***val)
+{
+ long l = static_cast<long>( strlen(s) );
+
+ int p = 0;
+ while(p<l && s[p] == ' ')
+ {
+ p++;
+ }
+
+ *n = 0;
+ int pp = p;
+ bool space = false;
+ while(pp<l)
+ {
+ if(s[pp] == ' ' && !space)
+ {
+ (*n)++;
+ space = true;
+ }
+ else
+ {
+ space = false;
+ }
+ pp++;
+ }
+ pp=l-1;
+ if(s[pp] == ' ')
+ {
+ while(pp>=0 && s[pp] == ' ')
+ {
+ (*n)--;
+ pp--;
+ }
+ }
+ else
+ {
+ (*n)++;
+ }
+
+ *val = new char *[*n];
+
+ long i, j;
+ for(i=0; i<*n; i++)
+ {
+ if(p == l)
+ {
+ return false;
+ }
+
+ (*val)[i] = new char [80];
+ while(p<l && s[p] == ' ')
+ {
+ p++;
+ }
+ j = 0;
+ while(p<l && s[p] != ' ')
+ {
+ (*val)[i][j++] = s[p++];
+ }
+ (*val)[i][j] = '\0';
+ }
+
+ return true;
+}
+
+//
+//
+//
+bool MET_GetFilePath(const char *_fName, char *_fPath)
+ {
+ long i;
+
+ long l = static_cast<long>( strlen(_fName) );
+
+ for(i=l-1; i>=0; i--)
+ if(_fName[i] == '\\' || _fName[i] == '/')
+ break;
+
+ if(i >= 0 && (_fName[i] == '/' || _fName[i] == '\\'))
+ {
+ strcpy(_fPath, _fName);
+ _fPath[i+1] = '\0';
+ return true;
+ }
+ else
+ {
+ _fPath[0] = '\0';
+ return false;
+ }
+ }
+
+//
+//
+//
+bool MET_GetFileSuffixPtr(const char *_fName, int *i)
+ {
+ *i = static_cast<int>( strlen(_fName) );
+ int j = *i - 5;
+ if(j<0)
+ {
+ j = 0;
+ }
+ while(*i>j)
+ {
+ if(_fName[(*i)-1] == '.')
+ {
+ return true;
+ }
+ else
+ {
+ (*i)--;
+ }
+ }
+ *i = 0;
+ return false;
+ }
+
+//
+//
+//
+bool MET_SetFileSuffix(char *_fName, const char *_suf)
+ {
+ int i;
+ MET_GetFileSuffixPtr(_fName, &i);
+ if(i>0)
+ {
+ if(_suf[0] == '.')
+ _fName[i-1] = '\0';
+ else
+ _fName[i] = '\0';
+ strcat(_fName, _suf);
+ return true;
+ }
+ else
+ {
+ strcat(_fName, _suf);
+ return true;
+ }
+ }
+
+//
+//
+//
+bool MET_InitWriteField(MET_FieldRecordType * _mf,
+ const char *_name,
+ MET_ValueEnumType _type,
+ double _v)
+ {
+ strcpy(_mf->name, _name);
+ _mf->type = _type;
+ _mf->defined = true;
+ _mf->length = 1;
+ _mf->dependsOn = -1;
+ _mf->required = false;
+ _mf->terminateRead = false;
+ _mf->value[0] = _v;
+ return true;
+ }
+
+bool MET_InitReadField(MET_FieldRecordType * _mf,
+ const char *_name,
+ MET_ValueEnumType _type,
+ bool _required,
+ int _dependsOn,
+ int _length)
+ {
+ strcpy(_mf->name, _name);
+ _mf->type = _type;
+ _mf->defined = false;
+ _mf->dependsOn = _dependsOn;
+ _mf->required = _required;
+ _mf->terminateRead = false;
+ _mf->length = _length;
+ _mf->value[0] = 0;
+ return true;
+ }
+
+//
+//
+//
+bool MET_SkipToVal(std::istream &fp)
+ {
+ char c;
+ if( fp.eof() )
+ {
+ return false;
+ }
+
+ c = fp.get();
+
+ while( c != MET_SeperatorChar && c != ':' && !fp.eof() )
+ {
+ c = fp.get();
+ }
+
+ while( ( c == MET_SeperatorChar || c == ':' || isspace(c) ) && !fp.eof() )
+ {
+ c = fp.get();
+ }
+
+ if( fp.eof() )
+ {
+ std::cerr << "Incomplete file record definition" << std::endl;
+ return false;
+ }
+
+ fp.putback(c);
+
+ return true;
+ }
+
+//
+//
+//
+bool MET_IsComplete(std::vector<MET_FieldRecordType *> * fields)
+ {
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+ for(fieldIter=fields->begin(); fieldIter!=fields->end(); fieldIter++)
+ {
+ if((*fieldIter)->required && !(*fieldIter)->defined)
+ {
+ std::cerr << (*fieldIter)->name << " required and not defined."
+ << std::endl;
+ return false;
+ }
+ }
+ return true;
+ }
+
+//
+bool MET_Read(std::istream &fp, std::vector<MET_FieldRecordType *> * fields,
+ char _MET_SeperatorChar, bool oneLine, bool display_warnings)
+ {
+
+ char s[1024];
+ int i, j;
+
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+
+ MET_SeperatorChar = _MET_SeperatorChar;
+
+ bool found;
+
+ unsigned char c;
+ while(!fp.eof())
+ {
+ i = 0;
+ c = fp.get();
+ while(!fp.eof() && c != MET_SeperatorChar && c != ':'
+ && (c == '\n' || isspace(c)))
+ {
+ c = fp.get();
+ }
+ while(!fp.eof() && c != MET_SeperatorChar && c != ':' && c != '\n' && i<500)
+ {
+ s[i++] = c;
+ c = fp.get();
+ }
+ if(fp.eof() || i >= 500)
+ {
+ break;
+ }
+ fp.putback(c);
+ s[i] = '\0';
+
+ i--;
+ while((s[i] == ' ' || s[i] == '\t') && i>0)
+ {
+ s[i--] = '\0';
+ }
+
+ found = false;
+ for(fieldIter=fields->begin(); fieldIter!=fields->end(); fieldIter++)
+ {
+ if(!strcmp((*fieldIter)->name, s))
+ {
+ if((*fieldIter)->dependsOn >= 0)
+ if(!(*fields)[(*fieldIter)->dependsOn]->defined)
+ {
+ std::cerr << (*fieldIter)->name << " defined prior to defining ";
+ std::cerr << (*fields)[(*fieldIter)->dependsOn]->name << std::endl;
+ return false;
+ }
+ switch((*fieldIter)->type)
+ {
+ case MET_NONE:
+ fp.getline( s, 500 );
+ break;
+ case MET_ASCII_CHAR:
+ {
+ MET_SkipToVal(fp);
+ if(fp.eof())
+ {
+ break;
+ }
+ MET_CHAR_TYPE c = fp.get();
+ c = fp.get();
+ (*fieldIter)->value[0] = (double)c;
+ fp.getline( s, 500 );
+ break;
+ }
+ default:
+ case MET_CHAR:
+ case MET_UCHAR:
+ case MET_SHORT:
+ case MET_USHORT:
+ case MET_INT:
+ case MET_UINT:
+ case MET_LONG:
+ case MET_ULONG:
+ case MET_LONG_LONG:
+ case MET_ULONG_LONG:
+ case MET_FLOAT:
+ case MET_DOUBLE:
+ {
+ MET_SkipToVal(fp);
+ if(fp.eof())
+ {
+ break;
+ }
+ fp >> (*fieldIter)->value[0];
+ fp.getline( s, 500 );
+ break;
+ }
+ case MET_STRING:
+ {
+ MET_SkipToVal(fp);
+ if(fp.eof())
+ {
+ break;
+ }
+ MET_CHAR_TYPE * str = (MET_CHAR_TYPE *)((*fieldIter)->value);
+ fp.getline( str, 500 );
+ j = static_cast<long>( strlen(str) ) - 1;
+ while(!isprint(str[j]) || isspace(str[j]))
+ {
+ str[j--] = '\0';
+ }
+ (*fieldIter)->length = static_cast<int>( strlen( str ) );
+ break;
+ }
+ case MET_CHAR_ARRAY:
+ case MET_UCHAR_ARRAY:
+ case MET_SHORT_ARRAY:
+ case MET_USHORT_ARRAY:
+ case MET_INT_ARRAY:
+ case MET_UINT_ARRAY:
+ case MET_LONG_ARRAY:
+ case MET_ULONG_ARRAY:
+ case MET_LONG_LONG_ARRAY:
+ case MET_ULONG_LONG_ARRAY:
+ case MET_FLOAT_ARRAY:
+ case MET_DOUBLE_ARRAY:
+ {
+ MET_SkipToVal(fp);
+ if(fp.eof())
+ {
+ break;
+ }
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ (*fieldIter)->length =
+ (int)((*fields)[(*fieldIter)->dependsOn]->value[0]);
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+ fp >> (*fieldIter)->value[j];
+ }
+ }
+ else
+ {
+ if((*fieldIter)->length <= 0)
+ {
+ std::cerr <<
+ "Arrays must have dependency or pre-specified lengths"
+ << std::endl;
+ return false;
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+ fp >> (*fieldIter)->value[j];
+ }
+ }
+ fp.getline( s, 500 );
+ break;
+ }
+ case MET_FLOAT_MATRIX:
+ {
+ MET_SkipToVal(fp);
+ if(fp.eof())
+ {
+ break;
+ }
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ (*fieldIter)->length =
+ (int)((*fields)[(*fieldIter)->dependsOn]->value[0]);
+ for(j=0; j<(*fieldIter)->length*(*fieldIter)->length;
+ j++)
+ {
+ fp >> (*fieldIter)->value[j];
+ }
+ }
+ else
+ {
+ if((*fieldIter)->length <= 0)
+ {
+ std::cerr <<
+ "Arrays must have dependency or pre-specified lengths"
+ << std::endl;
+ return false;
+ }
+ for(j=0; j<(*fieldIter)->length*(*fieldIter)->length; j++)
+ {
+ fp >> (*fieldIter)->value[j];
+ }
+ }
+ fp.getline( s, 500 );
+ break;
+ }
+ case MET_OTHER:
+ {
+ fp.getline( s, 500 );
+ break;
+ }
+ }
+ found = true;
+ (*fieldIter)->defined = true;
+ if((*fieldIter)->terminateRead)
+ {
+ return MET_IsComplete(fields);
+ }
+ break;
+ }
+ }
+ if(!found)
+ {
+ if(display_warnings)
+ {
+ std::cerr << "Skipping unrecognized field " << s << std::endl;
+ }
+ fp.getline( s, 500 );
+ }
+ if(oneLine)
+ {
+ return MET_IsComplete(fields);
+ }
+ }
+
+ return MET_IsComplete(fields);
+ }
+
+//
+bool MET_Write(std::ostream &fp, std::vector<MET_FieldRecordType *> * fields,
+ char _MET_SeperatorChar)
+ {
+ MET_SeperatorChar = _MET_SeperatorChar;
+
+ int j;
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+ for(fieldIter=fields->begin(); fieldIter!=fields->end(); fieldIter++)
+ {
+ switch((*fieldIter)->type)
+ {
+ case MET_NONE:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " "
+ << std::endl;
+ break;
+ }
+ case MET_ASCII_CHAR:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " ";
+ fp << (MET_CHAR_TYPE)(*fieldIter)->value[0] << std::endl;
+ break;
+ }
+ case MET_CHAR:
+ case MET_SHORT:
+ case MET_LONG:
+ case MET_INT:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " ";
+ fp << (MET_LONG_TYPE)((*fieldIter)->value[0]) << std::endl;
+ break;
+ }
+ case MET_LONG_LONG:
+ {
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ fp << (double)((MET_LONG_LONG_TYPE)((*fieldIter)->value[0]))
+ << std::endl;
+ std::cerr << "Programs compiled using MSV6 cannot write 64 bit ints"
+ << std::endl;
+ std::cerr << " Writing as double instead. Loss of precision results."
+ << std::endl;
+#else
+ fp << (MET_LONG_LONG_TYPE)((*fieldIter)->value[0]) << std::endl;
+#endif
+ break;
+ }
+ case MET_UCHAR:
+ case MET_USHORT:
+ case MET_UINT:
+ case MET_ULONG:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " ";
+ fp << (MET_ULONG_TYPE)((*fieldIter)->value[0]) << std::endl;
+ break;
+ }
+ case MET_ULONG_LONG:
+ {
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ fp << (double)((MET_LONG_LONG_TYPE)((MET_ULONG_LONG_TYPE)((*fieldIter)->value[0])))
+ << std::endl;
+ std::cerr << "Programs compiled using MSV6 cannot write 64 bit ints"
+ << std::endl;
+ std::cerr << " Writing as double instead. Loss of precision results."
+ << std::endl;
+#else
+ fp << (MET_ULONG_LONG_TYPE)((*fieldIter)->value[0]) << std::endl;
+#endif
+ break;
+ }
+ case MET_FLOAT:
+ case MET_DOUBLE:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " ";
+ fp << (MET_DOUBLE_TYPE)(*fieldIter)->value[0] << std::endl;
+ break;
+ }
+ case MET_STRING:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar << " ";
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning:";
+ std::cerr << "length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ fp.write( (char *)((*fieldIter)->value), (*fieldIter)->length );
+ fp << std::endl;
+ break;
+ }
+ case MET_CHAR_ARRAY:
+ case MET_SHORT_ARRAY:
+ case MET_INT_ARRAY:
+ case MET_LONG_ARRAY:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "Length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+ fp << " " << (MET_LONG_TYPE)((*fieldIter)->value[j]);
+ }
+ fp << std::endl;
+ break;
+ }
+ case MET_LONG_LONG_ARRAY:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "Length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ fp << " " << (double)((MET_LONG_LONG_TYPE)((*fieldIter)->value[j]));
+ std::cerr << "Programs compiled using MSV6 cannot write 64 bit ints"
+ << std::endl;
+ std::cerr << " Writing as double instead. Loss of precision results."
+ << std::endl;
+#else
+ fp << " " << (MET_LONG_LONG_TYPE)((*fieldIter)->value[j]);
+#endif
+ }
+ fp << std::endl;
+ break;
+ }
+
+ case MET_UCHAR_ARRAY:
+ case MET_USHORT_ARRAY:
+ case MET_UINT_ARRAY:
+ case MET_ULONG_ARRAY:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "Length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+ fp << " " << (MET_ULONG_TYPE)((*fieldIter)->value[j]);
+ }
+ fp << std::endl;
+ break;
+ }
+ case MET_ULONG_LONG_ARRAY:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "Length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ fp << " " << (double)((MET_LONG_LONG_TYPE)((MET_ULONG_LONG_TYPE)((*fieldIter)->value[j])));
+ std::cerr << "Programs compiled using MSV6 cannot write 64 bit ints"
+ << std::endl;
+ std::cerr << " Writing as double instead. Loss of precision results."
+ << std::endl;
+#else
+ fp << " " << (MET_ULONG_LONG_TYPE)((*fieldIter)->value[j]);
+#endif
+ }
+ fp << std::endl;
+ break;
+ }
+
+ case MET_FLOAT_ARRAY:
+ case MET_DOUBLE_ARRAY:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length; j++)
+ {
+ fp << " " << (double)(*fieldIter)->value[j];
+ }
+ fp << std::endl;
+ break;
+ }
+ case MET_FLOAT_MATRIX:
+ {
+ fp << (*fieldIter)->name << " " << MET_SeperatorChar;
+ if((*fieldIter)->dependsOn >= 0)
+ {
+ if((*fieldIter)->length !=
+ (*fields)[(*fieldIter)->dependsOn]->value[0])
+ {
+ std::cerr << "Warning: ";
+ std::cerr << "length and dependsOn values not equal in write";
+ std::cerr << std::endl;
+ }
+ }
+ for(j=0; j<(*fieldIter)->length*(*fieldIter)->length; j++)
+ {
+ fp << " " << (double)(*fieldIter)->value[j];
+ }
+ fp << std::endl;
+ break;
+ }
+ case MET_OTHER:
+ {
+ break;
+ }
+ }
+ }
+ return true;
+}
+
+bool MET_WriteFieldToFile(std::ostream & _fp, const char *_fieldName,
+ MET_ValueEnumType _pType, int _n, const void *_v)
+ {
+ int i;
+ MET_FieldRecordType f;
+
+ sprintf(f.name, "%s", _fieldName);
+ f.defined = false;
+ f.dependsOn = -1;
+ f.length = _n;
+ f.required = false;
+ f.type = _pType;
+ switch(_pType)
+ {
+ case MET_ASCII_CHAR:
+ case MET_CHAR:
+ case MET_CHAR_ARRAY:
+ for(i = 0; i < _n; i++)
+ {
+ f.value[i] = (double)(((const MET_CHAR_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_UCHAR:
+ case MET_UCHAR_ARRAY:
+ for(i = 0; i < _n; i++)
+ {
+ f.value[i] = (double)(((const MET_UCHAR_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_SHORT:
+ case MET_SHORT_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_SHORT_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_USHORT:
+ case MET_USHORT_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_USHORT_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_INT:
+ case MET_INT_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_INT_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_UINT:
+ case MET_UINT_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_UINT_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_LONG:
+ case MET_LONG_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_LONG_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_ULONG:
+ case MET_ULONG_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_ULONG_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_LONG_LONG:
+ case MET_LONG_LONG_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_LONG_LONG_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_ULONG_LONG:
+ case MET_ULONG_LONG_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+#if defined(_MSC_VER) // NOTE: you cannot use __int64 in an ostream in MSV6
+ f.value[i] = (double)((MET_LONG_LONG_TYPE)(((const MET_ULONG_LONG_TYPE *)_v)[i]));
+#else
+ f.value[i] = (double)(((const MET_ULONG_LONG_TYPE *)_v)[i]);
+#endif
+ }
+ break;
+ case MET_FLOAT:
+ case MET_FLOAT_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)((const MET_FLOAT_TYPE *)_v)[i];
+ }
+ break;
+ case MET_DOUBLE:
+ case MET_DOUBLE_ARRAY:
+ for(i=0; i<_n; i++)
+ {
+ f.value[i] = (double)(((const MET_DOUBLE_TYPE *)_v)[i]);
+ }
+ break;
+ case MET_STRING:
+ strcpy((MET_CHAR_TYPE *)(f.value), (const MET_CHAR_TYPE *)_v);
+ break;
+ case MET_FLOAT_MATRIX:
+ for(i=0; i<_n*_n; i++)
+ {
+ f.value[i] = (double)((const MET_FLOAT_TYPE *)_v)[i];
+ }
+ break;
+ default:
+ break;
+ }
+
+ std::vector<MET_FieldRecordType *> l;
+ l.clear();
+ l.push_back(&f);
+ MET_Write(_fp, &l);
+
+ return true;
+ }
+
+bool MET_WriteFieldToFile(std::ostream & _fp, const char *_fieldName,
+ MET_ValueEnumType _pType, double _v)
+ {
+ MET_FieldRecordType f;
+
+ sprintf(f.name, "%s", _fieldName);
+ f.defined = false;
+ f.dependsOn = -1;
+ f.length = 1;
+ f.required = false;
+ f.type = _pType;
+ f.value[0] = _v;
+
+ std::vector<MET_FieldRecordType *> l;
+ l.clear();
+ l.push_back(&f);
+ MET_Write(_fp, &l);
+
+ return true;
+ }
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaUtils.h b/Utilities/ITK/Utilities/MetaIO/metaUtils.h
new file mode 100644
index 0000000000000000000000000000000000000000..ab1d02887a64460d66bc0dd37739bb4d73df73a3
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaUtils.h
@@ -0,0 +1,248 @@
+/**
+ * MetaUtils (.h and .cpp)
+ *
+ * Description:
+ * This file provides generic ascii file parsing capabilities.
+ * It assumes that the files consist of a set of fields
+ * Each field is list of variable = value pairs
+ *
+ * Features:
+ * There can be dependencies between fields, required fields,
+ * and optional fields.
+ * Undefined fields are skipped.
+ * Values must conform to expected types. There can be default
+ * values for fields.
+ *
+ * Author:
+ * Stephen R. Aylward
+ *
+ * Date:
+ * February 22, 2002
+ *
+ **/
+#ifndef METAFILEUTILS_H
+#define METAFILEUTILS_H
+
+#include <iostream>
+#include <vector>
+#include <string>
+#include <typeinfo>
+
+#include <metaTypes.h>
+
+
+
+extern MET_FieldRecordType * MET_GetFieldRecord(const char * _fieldName,
+ std::vector<MET_FieldRecordType *> * _fields);
+
+extern int MET_GetFieldRecordNumber(const char * _fieldName,
+ std::vector<MET_FieldRecordType *> * _fields);
+
+extern bool MET_SystemByteOrderMSB(void);
+
+inline unsigned short MET_ByteOrderSwapShort(unsigned short x)
+ {
+ return (unsigned short)((unsigned short)(x<<8) | (unsigned short)(x>>8));
+ }
+
+inline unsigned long MET_ByteOrderSwapLong(unsigned int x)
+ {
+ return (((x<<24) & 0xff000000) |
+ ((x<<8) & 0x00ff0000) |
+ ((x>>8) & 0x0000ff00) |
+ ((x>>24) & 0x000000ff));
+ }
+
+inline void MET_ByteOrderSwap8(void* x)
+ {
+ char one_byte;
+ char* p = reinterpret_cast<char*>(x);
+ one_byte = p[0];
+ p[0] = p[7];
+ p[7] = one_byte;
+
+ one_byte = p[1];
+ p[1] = p[6];
+ p[6] = one_byte;
+
+ one_byte = p[2];
+ p[2] = p[5];
+ p[5] = one_byte;
+
+ one_byte = p[3];
+ p[3] = p[4];
+ p[4] = one_byte;
+ }
+
+extern bool MET_StringToType(const char *_str, MET_ValueEnumType *_type);
+
+extern bool MET_TypeToString(MET_ValueEnumType _type, char *_str);
+
+extern bool MET_SizeOfType(MET_ValueEnumType _type, int *_size);
+
+extern bool MET_ValueToDouble(MET_ValueEnumType _pType,
+ const void *_data,
+ int _index,
+ double *_value);
+
+extern bool MET_DoubleToValue(double _value,
+ MET_ValueEnumType _type,
+ void *_data,
+ int _index);
+
+extern bool MET_ValueToValue(MET_ValueEnumType _fromType,
+ const void *_fromData,
+ int _index,
+ MET_ValueEnumType _toType,
+ void *_toData,
+ double _fromMin=0, double _fromMax=0,
+ double _toMin=0, double _toMax=0);
+
+extern bool MET_StringToWordArray(const char *s, int *n, char ***val);
+
+//
+//
+//
+extern bool MET_GetFilePath(const char *_fName, char *_fPath);
+
+extern bool MET_GetFileSuffixPtr(const char *_fName, int *i);
+
+extern bool MET_SetFileSuffix(char *_fName, const char *_suf);
+
+//
+//
+//
+extern bool MET_InitWriteField(MET_FieldRecordType * _mf,
+ const char *_name,
+ MET_ValueEnumType _type,
+ double _v=0);
+
+template <class T>
+bool MET_InitWriteField(MET_FieldRecordType * _mf,
+ const char *_name,
+ MET_ValueEnumType _type,
+ int _length,
+ T *_v)
+ {
+ strcpy(_mf->name, _name);
+ _mf->type = _type;
+ _mf->defined = true;
+ _mf->length = _length;
+ _mf->dependsOn = -1;
+ _mf->required = false;
+ _mf->terminateRead = false;
+ if(_type == MET_FLOAT_MATRIX)
+ {
+ int i;
+ for(i=0; i<_length*_length; i++)
+ {
+ _mf->value[i] = (double)(_v[i]);
+ }
+ }
+ else if(_type != MET_STRING)
+ {
+ int i;
+ for(i=0; i<_length; i++)
+ {
+ _mf->value[i] = (double)(_v[i]);
+ }
+ }
+ else
+ {
+ strcpy((char *)(_mf->value), (const char *)_v);
+ }
+ return true;
+ }
+
+
+extern bool MET_InitReadField(MET_FieldRecordType * _mf,
+ const char *_name,
+ MET_ValueEnumType _type,
+ bool _required=true,
+ int _dependsOn=-1,
+ int _length=0);
+
+// Given an array of fieldRec that define a metaFile format, parse that file
+// fTerm specifies what field (if any) marks the field (variable name)
+// at which file parsing should stop (e.g., if binary data follows)
+// fromTopOfFile indicates whether the File pointer fp should be reset
+// to topOfFile before parsing begins
+extern bool MET_Read(std::istream &fp,
+ std::vector<MET_FieldRecordType *> * fields,
+ char _sepChar='=', bool oneLine=false, bool display_warnings=true);
+
+// Given an array of fieldRecs, creates a metaFile.
+extern bool MET_Write(std::ostream &fp,
+ std::vector<MET_FieldRecordType *> * fields,
+ char _sepChar='=');
+
+extern bool MET_WriteFieldToFile(std::ostream &_fp, const char *_fieldName,
+ MET_ValueEnumType _pType, int _n, const void *_v);
+
+extern bool MET_WriteFieldToFile(std::ostream &_fp, const char *_fieldName,
+ MET_ValueEnumType _pType, double _v);
+
+
+
+extern std::string MET_ReadType(std::istream & _fp);
+
+extern char* MET_ReadSubType(std::istream & _fp);
+
+inline MET_ValueEnumType MET_GetPixelType(const std::type_info& ptype)
+{
+ if( ptype == typeid(MET_UCHAR_TYPE) )
+ {
+ return MET_UCHAR;
+ }
+ else if( ptype == typeid(MET_CHAR_TYPE) )
+ {
+ return MET_CHAR;
+ }
+ else if( ptype == typeid(MET_USHORT_TYPE))
+ {
+ return MET_USHORT;
+ }
+ else if( ptype == typeid(MET_SHORT_TYPE) )
+ {
+ return MET_SHORT;
+ }
+ else if( ptype == typeid(MET_UINT_TYPE) )
+ {
+ return MET_UINT;
+ }
+ else if( ptype == typeid(MET_INT_TYPE) )
+ {
+ return MET_INT;
+ }
+ else if( ptype == typeid(MET_ULONG_TYPE))
+ {
+ return MET_ULONG;
+ }
+ else if( ptype == typeid(MET_LONG_TYPE) )
+ {
+ return MET_LONG;
+ }
+ else if( ptype == typeid(MET_ULONG_LONG_TYPE) )
+ {
+ return MET_ULONG_LONG;
+ }
+ else if( ptype == typeid(MET_LONG_LONG_TYPE) )
+ {
+ return MET_LONG_LONG;
+ }
+ else if( ptype == typeid(MET_FLOAT_TYPE) )
+ {
+ return MET_FLOAT;
+ }
+ else if( ptype == typeid(MET_DOUBLE_TYPE) )
+ {
+ return MET_DOUBLE;
+ }
+ else
+ {
+ std::cerr <<"Couldn't convert pixel type" << std::endl;
+ return MET_NONE;
+ }
+}
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/metaVesselTube.cxx b/Utilities/ITK/Utilities/MetaIO/metaVesselTube.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a9fc9c08f8e2ee2484c044fa58b083ca49ce9f0d
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaVesselTube.cxx
@@ -0,0 +1,904 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <iostream>
+#include <fstream>
+#include <string>
+
+#include <metaUtils.h>
+#include <metaObject.h>
+#include <metaVesselTube.h>
+
+/** MetaVesselTube Constructors */
+MetaVesselTube::
+MetaVesselTube()
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube()" << std::endl;
+ Clear();
+}
+
+
+MetaVesselTube::
+MetaVesselTube(const char *_headerName)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube()" << std::endl;
+ Clear();
+ Read(_headerName);
+}
+
+
+MetaVesselTube::
+MetaVesselTube(const MetaVesselTube *_VesselTube)
+:MetaObject()
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube()" << std::endl;
+ Clear();
+ CopyInfo(_VesselTube);
+}
+
+
+MetaVesselTube::
+MetaVesselTube(unsigned int dim)
+:MetaObject(dim)
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube()" << std::endl;
+ Clear();
+}
+
+/** Destructor */
+MetaVesselTube::
+~MetaVesselTube()
+{
+ // Delete the list of pointers to VesselTubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ VesselTubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+ M_Destroy();
+}
+
+//
+void MetaVesselTube::
+PrintInfo() const
+{
+ MetaObject::PrintInfo();
+ std::cout << "ParentPoint = " << m_ParentPoint << std::endl;
+ if(m_Root)
+ {
+ std::cout << "Root = " << "True" << std::endl;
+ }
+ else
+ {
+ std::cout << "Root = " << "False" << std::endl;
+ }
+ std::cout << "Artery = " << m_Artery << std::endl;
+ std::cout << "PointDim = " << m_PointDim << std::endl;
+ std::cout << "NPoints = " << m_NPoints << std::endl;
+ char str[255];
+ MET_TypeToString(m_ElementType, str);
+ std::cout << "ElementType = " << str << std::endl;
+}
+
+void MetaVesselTube::
+CopyInfo(const MetaVesselTube * _VesselTube)
+{
+ MetaObject::CopyInfo(_VesselTube);
+}
+
+
+
+void MetaVesselTube::
+PointDim(const char* pointDim)
+{
+ strcpy(m_PointDim,pointDim);
+}
+
+const char* MetaVesselTube::
+PointDim(void) const
+{
+ return m_PointDim;
+}
+
+void MetaVesselTube::
+NPoints(int npnt)
+{
+ m_NPoints = npnt;
+}
+
+int MetaVesselTube::
+NPoints(void) const
+{
+ return m_NPoints;
+}
+
+void MetaVesselTube::
+Root(bool root)
+{
+ m_Root = root;
+}
+
+bool MetaVesselTube::
+Root(void) const
+{
+ return m_Root;
+}
+
+
+void MetaVesselTube::
+Artery(bool artery)
+{
+ m_Artery = artery;
+}
+
+bool MetaVesselTube::
+Artery(void) const
+{
+ return m_Artery;
+}
+
+
+void MetaVesselTube::
+ParentPoint(int parentpoint)
+{
+ m_ParentPoint = parentpoint;
+}
+
+int MetaVesselTube::
+ParentPoint(void) const
+{
+ return m_ParentPoint;
+}
+
+/** Clear VesselTube information */
+void MetaVesselTube::
+Clear(void)
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube: Clear" << std::endl;
+ MetaObject::Clear();
+ // Delete the list of pointers to VesselTubes.
+ PointListType::iterator it = m_PointList.begin();
+ while(it != m_PointList.end())
+ {
+ VesselTubePnt* pnt = *it;
+ it++;
+ delete pnt;
+ }
+ m_PointList.clear();
+
+ m_ParentPoint= -1;
+ m_Root = false;
+ m_Artery = true;
+ m_NPoints = 0;
+ strcpy(m_PointDim, "x y z r rn mn bn mk v1x v1y v1z v2x v2y v2z tx ty tz a1 a2 a3 red green blue alpha id");
+ m_ElementType = MET_FLOAT;
+}
+
+/** Destroy VesselTube information */
+void MetaVesselTube::
+M_Destroy(void)
+{
+ MetaObject::M_Destroy();
+}
+
+/** Set Read fields */
+void MetaVesselTube::
+M_SetupReadFields(void)
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube: M_SetupReadFields" << std::endl;
+
+ MetaObject::M_SetupReadFields();
+
+ MET_FieldRecordType * mF;
+
+ // int nDimsRecNum = MET_GetFieldRecordNumber("NDims", &m_Fields);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ParentPoint", MET_INT, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Root", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Artery", MET_STRING, false);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "PointDim", MET_STRING, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NPoints", MET_INT, true);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "Points", MET_NONE, true);
+ mF->terminateRead = true;
+ m_Fields.push_back(mF);
+
+}
+
+void MetaVesselTube::
+M_SetupWriteFields(void)
+{
+ strcpy(m_ObjectTypeName,"Tube");
+ strcpy(m_ObjectSubTypeName,"Vessel");
+ MetaObject::M_SetupWriteFields();
+
+ MET_FieldRecordType * mF;
+
+ if(m_ParentPoint>=0 && m_ParentID>=0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ParentPoint", MET_INT,m_ParentPoint);
+ m_Fields.push_back(mF);
+ }
+
+ if(m_Root)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("True"), "True");
+ m_Fields.push_back(mF);
+ }
+ else
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Root", MET_STRING, strlen("False"), "False");
+ m_Fields.push_back(mF);
+ }
+
+ if(m_Artery)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Artery", MET_STRING, strlen("True"), "True");
+ m_Fields.push_back(mF);
+ }
+ else
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Artery", MET_STRING, strlen("False"), "False");
+ m_Fields.push_back(mF);
+ }
+
+ if(strlen(m_PointDim)>0)
+ {
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "PointDim", MET_STRING,
+ strlen(m_PointDim),m_PointDim);
+ m_Fields.push_back(mF);
+ }
+
+ m_NPoints = m_PointList.size();
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NPoints", MET_INT,m_NPoints);
+ m_Fields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "Points", MET_NONE);
+ m_Fields.push_back(mF);
+
+}
+
+
+
+bool MetaVesselTube::
+M_Read(void)
+{
+ if(META_DEBUG) std::cout << "MetaVesselTube: M_Read: Loading Header" << std::endl;
+
+ if(!MetaObject::M_Read())
+ {
+ std::cout << "MetaVesselTube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ if(META_DEBUG) std::cout << "MetaVesselTube: M_Read: Parsing Header" << std::endl;
+
+ MET_FieldRecordType * mF;
+
+ mF = MET_GetFieldRecord("ParentPoint", &m_Fields);
+ if(mF->defined)
+ {
+ m_ParentPoint= (int)mF->value[0];
+ }
+
+ m_Root = false;
+ mF = MET_GetFieldRecord("Root", &m_Fields);
+ if(mF->defined)
+ {
+ if(*((char *)(mF->value)) == 'T'
+ || *((char*)(mF->value)) == 't'
+ || *((char*)(mF->value)) == '1')
+ {
+ m_Root = true;
+ }
+ else
+ {
+ m_Root = false;
+ }
+ }
+
+ m_Artery = true;
+ mF = MET_GetFieldRecord("Artery", &m_Fields);
+ if(mF->defined)
+ {
+ if(*((char *)(mF->value)) == 'T' || *((char*)(mF->value)) == 't')
+ {
+ m_Artery = true;
+ }
+ else
+ {
+ m_Artery = false;
+ }
+ }
+
+ mF = MET_GetFieldRecord("NPoints", &m_Fields);
+ if(mF->defined)
+ {
+ m_NPoints= (int)mF->value[0];
+ }
+
+ mF = MET_GetFieldRecord("PointDim", &m_Fields);
+ if(mF->defined)
+ {
+ strcpy(m_PointDim,(char *)(mF->value));
+ }
+
+
+ int* posDim= new int[m_NDims];
+ int i;
+ for(i= 0; i < m_NDims; i++)
+ {
+ posDim[i] = -1;
+ }
+ int posR = -1;
+ int posRn = -1;
+ int posMn = -1;
+ int posBn = -1;
+ int posMk = -1;
+ int posV1x = -1;
+ int posV1y = -1;
+ int posV1z = -1;
+ int posV2x = -1;
+ int posV2y = -1;
+ int posV2z = -1;
+ int posTx = -1;
+ int posTy = -1;
+ int posTz = -1;
+ int posA1 = -1;
+ int posA2 = -1;
+ int posA3 = -1;
+ int posRed = -1;
+ int posGreen = -1;
+ int posBlue = -1;
+ int posAlpha = -1;
+ int posID = -1;
+
+ int pntDim;
+ char** pntVal = NULL;
+ MET_StringToWordArray(m_PointDim, &pntDim, &pntVal);
+
+ if(META_DEBUG)
+ {
+ std::cout << "MetaVesselTube: Parsing point dim" << std::endl;
+ }
+
+ int j;
+ for(j = 0; j < pntDim; j++)
+ {
+ if(!strcmp(pntVal[j], "x") || !strcmp(pntVal[j], "X"))
+ {
+ posDim[0] = j;
+ }
+ if(!strcmp(pntVal[j], "y") || !strcmp(pntVal[j], "Y"))
+ {
+ posDim[1] = j;
+ }
+ if(!strcmp(pntVal[j], "z") || !strcmp(pntVal[j], "Z"))
+ {
+ posDim[2] = j;
+ }
+ if(((char *)pntVal[j])[0] == 'w' || ((char *)pntVal[j])[0] == 'W')
+ {
+ posDim[(int)pntVal[j][1]+3] = j;
+ }
+ if(!strcmp(pntVal[j], "s") || !strcmp(pntVal[j], "S") ||
+ !strcmp(pntVal[j], "r") || !strcmp(pntVal[j], "R") ||
+ !strcmp(pntVal[j], "rad") || !strcmp(pntVal[j], "Rad") ||
+ !strcmp(pntVal[j], "radius") || !strcmp(pntVal[j], "Radius"))
+ {
+ posR = j;
+ }
+
+ if(!strcmp(pntVal[j], "rn") || !strcmp(pntVal[j], "RN"))
+ {
+ posRn = j;
+ }
+ if(!strcmp(pntVal[j], "mn") || !strcmp(pntVal[j], "MN"))
+ {
+ posMn = j;
+ }
+ if(!strcmp(pntVal[j], "bn") || !strcmp(pntVal[j], "BN"))
+ {
+ posBn = j;
+ }
+ if(!strcmp(pntVal[j], "mk") || !strcmp(pntVal[j], "MK"))
+ {
+ posMk = j;
+ }
+ if(!strcmp(pntVal[j], "v1x"))
+ {
+ posV1x = j;
+ }
+ if(!strcmp(pntVal[j], "v1y"))
+ {
+ posV1y = j;
+ }
+ if(!strcmp(pntVal[j], "v1z"))
+ {
+ posV1z = j;
+ }
+ if(!strcmp(pntVal[j], "v2x"))
+ {
+ posV2x = j;
+ }
+ if(!strcmp(pntVal[j], "v2y"))
+ {
+ posV2y = j;
+ }
+ if(!strcmp(pntVal[j], "v2z"))
+ {
+ posV2z = j;
+ }
+ if(!strcmp(pntVal[j], "tx"))
+ {
+ posTx = j;
+ }
+ if(!strcmp(pntVal[j], "ty"))
+ {
+ posTy = j;
+ }
+ if(!strcmp(pntVal[j], "tz"))
+ {
+ posTz = j;
+ }
+ if(!strcmp(pntVal[j], "a1"))
+ {
+ posA1 = j;
+ }
+ if(!strcmp(pntVal[j], "a2"))
+ {
+ posA2 = j;
+ }
+ if(!strcmp(pntVal[j], "a3"))
+ {
+ posA3 = j;
+ }
+
+ if(!strcmp(pntVal[j], "red"))
+ {
+ posRed = j;
+ }
+ if(!strcmp(pntVal[j], "green"))
+ {
+ posGreen = j;
+ }
+
+ if(!strcmp(pntVal[j], "blue"))
+ {
+ posBlue = j;
+ }
+ if(!strcmp(pntVal[j], "alpha"))
+ {
+ posAlpha = j;
+ }
+ if(!strcmp(pntVal[j], "id") || !strcmp(pntVal[j], "ID"))
+ {
+ posID = j;
+ }
+ }
+
+ for(i=0;i<pntDim;i++)
+ {
+ delete [] pntVal[i];
+ }
+ delete [] pntVal;
+
+ float v[50];
+
+ if(m_Event)
+ {
+ m_Event->StartReading(m_NPoints);
+ }
+
+ if(m_BinaryData)
+ {
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+ int readSize = m_NPoints*(m_NDims*(2+m_NDims)+10)*elementSize;
+
+ char* _data = new char[readSize];
+ m_ReadStream->read((char *)_data, readSize);
+
+ int gc = m_ReadStream->gcount();
+ if(gc != readSize)
+ {
+ std::cout << "MetaLine: m_Read: data not read completely"
+ << std::endl;
+ std::cout << " ideal = " << readSize
+ << " : actual = " << gc << std::endl;
+ return false;
+ }
+
+ i=0;
+ double td;
+ int d;
+ for(j=0; j<m_NPoints; j++)
+ {
+ VesselTubePnt* pnt = new VesselTubePnt(m_NDims);
+
+ for(d=0; d<m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_X[d] = (float)td;
+ }
+
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_R = (float)td;
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Ridgeness = (float)td;
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Medialness = (float)td;
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Branchness = (float)td;
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ if((float)td == 1.0)
+ {
+ pnt->m_Mark = true;
+ }
+ else
+ {
+ pnt->m_Mark = false;
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V1[d] = (float)td;
+ }
+
+ if(m_NDims==3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_V2[d] = (float)td;
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_T[d] = (float)td;
+ }
+
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Alpha1 = (float)td;
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Alpha2 = (float)td;
+
+ if(m_NDims>=3)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Alpha3 = (float)td;
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_ValueToDouble(m_ElementType, _data, i++, &td);
+ pnt->m_Color[d] = (float)td;
+ }
+
+ MET_ValueToDouble(m_ElementType,_data,i++,&td);
+ pnt->m_ID=(int)td;
+
+ m_PointList.push_back(pnt);
+ }
+ delete [] _data;
+ }
+ else
+ {
+ for(j=0; j<m_NPoints; j++)
+ {
+ if(m_Event)
+ {
+ m_Event->SetCurrentIteration(j+1);
+ }
+
+ VesselTubePnt* pnt = new VesselTubePnt(m_NDims);
+
+ for(int k=0; k<pntDim; k++)
+ {
+ *m_ReadStream >> v[k];
+ m_ReadStream->get();
+ }
+
+ for(int d=0; d<m_NDims; d++)
+ {
+ pnt->m_X[d] = v[posDim[d]];
+ }
+
+ pnt->m_R = v[posR];
+
+ if(posMn >= (int)0 && posMn < pntDim)
+ {
+ pnt->m_Medialness = v[posMn];
+ }
+
+ if(posRn >= (int)0 && posRn < pntDim)
+ {
+ pnt->m_Ridgeness = v[posRn];
+ }
+
+ if(posBn >= (int)0 && posBn < pntDim)
+ {
+ pnt->m_Branchness = v[posBn];
+ }
+
+ if(posMk >= 0 && posMk < pntDim)
+ {
+ pnt->m_Mark = (v[posMk] > 0) ? true:false;
+ }
+
+ if(posV1x>=0 && posV1x<pntDim)
+ {
+ pnt->m_V1[0] = v[posV1x];
+ if(posV1y >= 0 && posV1y<pntDim)
+ {
+ pnt->m_V1[1] = v[posV1y];
+ }
+ if(posV1z >= 0 && m_NDims>2 && posV1z<pntDim)
+ {
+ pnt->m_V1[2] = v[posV1z];
+ }
+ }
+ if(posV2x >= 0 && posV2x<pntDim)
+ {
+ pnt->m_V2[0] = v[posV2x];
+ if(posV2y >= 0 && posV2y<pntDim)
+ {
+ pnt->m_V2[1] = v[posV2y];
+ }
+ if(posV2z >= 0 && m_NDims>2 && posV2z<pntDim)
+ {
+ pnt->m_V2[2] = v[posV2z];
+ }
+ }
+ if(posTx >= 0 && posTx<pntDim)
+ {
+ pnt->m_T[0] = v[posTx];
+ if(posTy >= 0 && posTy<pntDim)
+ {
+ pnt->m_T[1] = v[posTy];
+ }
+ if(posTz >= 0 && m_NDims>2 && posTz<pntDim)
+ {
+ pnt->m_T[2] = v[posTz];
+ }
+ }
+ if(posA1 >= 0 && posA1<pntDim)
+ {
+ pnt->m_Alpha1 = v[posA1];
+ }
+ if(posA2 >= 0 && posA2<pntDim)
+ {
+ pnt->m_Alpha2 = v[posA2];
+ }
+ if(posA3 >= 0 && posA3<pntDim)
+ {
+ pnt->m_Alpha3 = v[posA3];
+ }
+
+ if(posRed >= 0 && posRed < pntDim)
+ {
+ pnt->m_Color[0] = v[posRed];
+ }
+
+ if(posGreen >= 0 && posGreen < pntDim)
+ {
+ pnt->m_Color[1] = v[posGreen];
+ }
+
+ if(posBlue >= 0 && posBlue < pntDim)
+ {
+ pnt->m_Color[2] = v[posBlue];
+ }
+
+ if(posAlpha >= 0 && posAlpha < pntDim)
+ {
+ pnt->m_Color[3] = v[posAlpha];
+ }
+
+ if(posID >= 0 && posID < pntDim)
+ {
+ pnt->m_ID = (int)v[posID];
+ }
+
+ m_PointList.push_back(pnt);
+ }
+
+
+ char c = ' ';
+ while( (c!='\n') && (!m_ReadStream->eof()))
+ {
+ c = m_ReadStream->get();// to avoid unrecognize charactere
+ }
+ }
+
+ if(m_Event)
+ {
+ m_Event->StopReading();
+ }
+
+ delete []posDim;
+ return true;
+}
+
+MET_ValueEnumType MetaVesselTube::
+ElementType(void) const
+{
+ return m_ElementType;
+}
+
+void MetaVesselTube::
+ElementType(MET_ValueEnumType _elementType)
+{
+ m_ElementType = _elementType;
+}
+
+bool MetaVesselTube::
+M_Write(void)
+{
+
+ if(!MetaObject::M_Write())
+ {
+ std::cout << "MetaVesselTube: M_Read: Error parsing file" << std::endl;
+ return false;
+ }
+
+ /** Then copy all VesselTubes points */
+ if(m_BinaryData)
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+ int elementSize;
+ MET_SizeOfType(m_ElementType, &elementSize);
+
+ char* data = new char[(m_NDims*(2+m_NDims)+10)*m_NPoints*elementSize];
+ int i=0;
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_X[d],m_ElementType,data,i++);
+ }
+
+ MET_DoubleToValue((double)(*it)->m_R,m_ElementType,data,i++);
+ MET_DoubleToValue((double)(*it)->m_Ridgeness,m_ElementType,data,i++);
+ MET_DoubleToValue((double)(*it)->m_Medialness,m_ElementType,data,i++);
+ MET_DoubleToValue((double)(*it)->m_Branchness,m_ElementType,data,i++);
+ MET_DoubleToValue((double)(*it)->m_Mark,m_ElementType,data,i++);
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V1[d],m_ElementType,data,i++);
+ }
+
+ if(m_NDims==3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_V2[d],m_ElementType,data,i++);
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_T[d],m_ElementType,data,i++);
+ }
+
+ MET_DoubleToValue((double)(*it)->m_Alpha1,m_ElementType,data,i++);
+ MET_DoubleToValue((double)(*it)->m_Alpha2,m_ElementType,data,i++);
+
+ if(m_NDims>=3)
+ {
+ MET_DoubleToValue((double)(*it)->m_Alpha3,m_ElementType,data,i++);
+ }
+
+ for(d=0; d<4; d++)
+ {
+ MET_DoubleToValue((double)(*it)->m_Color[d],m_ElementType,data,i++);
+ }
+
+ MET_DoubleToValue((double)(*it)->m_ID,m_ElementType,data,i++);
+
+ it++;
+ }
+
+ m_WriteStream->write((char *)data,
+ (m_NDims*(2+m_NDims)+10)*m_NPoints*elementSize);
+ m_WriteStream->write("\n",1);
+ delete [] data;
+ }
+ else
+ {
+ PointListType::const_iterator it = m_PointList.begin();
+
+ int d;
+ while(it != m_PointList.end())
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_X[d] << " ";
+ }
+
+ *m_WriteStream << (*it)->m_R << " ";
+ *m_WriteStream << (*it)->m_Ridgeness << " ";
+ *m_WriteStream << (*it)->m_Medialness << " ";
+ *m_WriteStream << (*it)->m_Branchness << " ";
+ if((*it)->m_Mark)
+ {
+ *m_WriteStream << 1 << " ";
+ }
+ else
+ {
+ *m_WriteStream << 0 << " ";
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_V1[d] << " ";
+ }
+
+ if(m_NDims>=3)
+ {
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_V2[d] << " ";
+ }
+ }
+
+ for(d = 0; d < m_NDims; d++)
+ {
+ *m_WriteStream << (*it)->m_T[d] << " ";
+ }
+
+ *m_WriteStream << (*it)->m_Alpha1 << " ";
+ *m_WriteStream << (*it)->m_Alpha2 << " ";
+
+ if(m_NDims>=3)
+ {
+ *m_WriteStream << (*it)->m_Alpha3 << " ";
+ }
+
+ for(d=0;d<4;d++)
+ {
+ *m_WriteStream << (*it)->m_Color[d] << " ";
+ }
+
+ *m_WriteStream << (*it)->m_ID << " ";
+
+ *m_WriteStream << std::endl;
+ it++;
+ }
+ }
+ return true;
+
+}
+
diff --git a/Utilities/ITK/Utilities/MetaIO/metaVesselTube.h b/Utilities/ITK/Utilities/MetaIO/metaVesselTube.h
new file mode 100644
index 0000000000000000000000000000000000000000..cd7f324f78fe37b926bfaee37fa3dabb7e9bbbb3
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/metaVesselTube.h
@@ -0,0 +1,187 @@
+#ifndef METAVesselTube_H
+#define METAVesselTube_H
+
+#include <metaTypes.h>
+#include <metaUtils.h>
+#include <metaObject.h>
+
+#include <list>
+
+
+/*! MetaVesselTube (.h and .cpp)
+ *
+ * Description:
+ * Reads and Writes MetaVesselTubeFiles.
+ *
+ * \author Julien Jomier
+ *
+ * \date May 22, 2002
+ */
+
+class VesselTubePnt
+{
+public:
+
+ VesselTubePnt(int dim)
+ {
+ m_Dim = dim;
+ m_X = new float[m_Dim];
+ m_T = new float[m_Dim];
+ m_V1= new float[m_Dim];
+ m_V2= new float[m_Dim];
+ for(unsigned int i=0;i<m_Dim;i++)
+ {
+ m_X[i] = 0;
+ m_V1[i]= 0;
+ m_V2[i]= 0;
+ m_T[i]= 0;
+ }
+ m_Alpha1=0;
+ m_Alpha2=0;
+ m_Alpha3=0;
+ m_R=0;
+ m_Medialness=0;
+ m_Ridgeness=0;
+ m_Branchness=0;
+ m_Mark=false;
+
+ //Color is red by default
+ m_Color[0]=1.0;
+ m_Color[1]=0.0;
+ m_Color[2]=0.0;
+ m_Color[3]=1.0;
+ m_ID = -1;
+ }
+
+ ~VesselTubePnt()
+ {
+ delete []m_X;
+ delete []m_V1;
+ delete []m_V2;
+ delete []m_T;
+ };
+
+ unsigned int m_Dim;
+ float* m_V1;
+ float* m_V2;
+ float* m_X;
+ float* m_T;
+ float m_Alpha1;
+ float m_Alpha2;
+ float m_Alpha3;
+ float m_R;
+ float m_Medialness;
+ float m_Ridgeness;
+ float m_Branchness;
+ bool m_Mark;
+ float m_Color[4];
+ int m_ID;
+};
+
+
+
+
+class MetaVesselTube : public MetaObject
+ {
+
+ /////
+ //
+ // PUBLIC
+ //
+ ////
+ public:
+
+ typedef std::list<VesselTubePnt*> PointListType;
+ ////
+ //
+ // Constructors & Destructor
+ //
+ ////
+ MetaVesselTube(void);
+
+ MetaVesselTube(const char *_headerName);
+
+ MetaVesselTube(const MetaVesselTube *_VesselTube);
+
+ MetaVesselTube(unsigned int dim);
+
+ ~MetaVesselTube(void);
+
+ void PrintInfo(void) const;
+
+ void CopyInfo(const MetaVesselTube * _VesselTube);
+
+ // NPoints(...)
+ // Required Field
+ // Number of points wich compose the VesselTube
+ void NPoints(int npnt);
+ int NPoints(void) const;
+
+ // PointDim(...)
+ // Required Field
+ // Definition of points
+ void PointDim(const char* pointDim);
+ const char* PointDim(void) const;
+
+ // Root(...)
+ // Optional Field
+ // Set if this VesselTube is a root
+ void Root(bool root);
+ bool Root(void) const;
+
+ // Artery(...)
+ // Optional Field
+ // Set if this VesselTube is a root
+ void Artery(bool artery);
+ bool Artery(void) const;
+
+
+ // ParentPoint(...)
+ // Optional Field
+ // Set the point number of the parent VesselTube where the branch occurs
+ void ParentPoint(int parentpoint);
+ int ParentPoint(void) const;
+
+ void Clear(void);
+
+ PointListType & GetPoints(void) {return m_PointList;}
+ const PointListType & GetPoints(void) const {return m_PointList;}
+
+ MET_ValueEnumType ElementType(void) const;
+ void ElementType(MET_ValueEnumType _elementType);
+
+ ////
+ //
+ // PROTECTED
+ //
+ ////
+ protected:
+
+ bool m_ElementByteOrderMSB;
+
+ void M_Destroy(void);
+
+ void M_SetupReadFields(void);
+
+ void M_SetupWriteFields(void);
+
+ bool M_Read(void);
+
+ bool M_Write(void);
+
+ int m_ParentPoint; // "ParentPoint = " -1
+
+ bool m_Root; // "Root = " false
+
+ bool m_Artery; // "Artery = " true
+
+ int m_NPoints; // "NPoints = " 0
+
+ char m_PointDim[255]; // "PointDim = " "x y z r"
+
+ PointListType m_PointList;
+ MET_ValueEnumType m_ElementType;
+ };
+
+
+#endif
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/.NoDartCoverage b/Utilities/ITK/Utilities/MetaIO/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/CMakeLists.txt b/Utilities/ITK/Utilities/MetaIO/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..6320d2e4d6149a54caeb3bd2973ba3878aa7e9eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/CMakeLists.txt
@@ -0,0 +1,33 @@
+INCLUDE (${CMAKE_ROOT}/Modules/FindITK.cmake)
+IF(USE_ITK_FILE)
+ INCLUDE(${USE_ITK_FILE})
+ENDIF(USE_ITK_FILE)
+
+LINK_LIBRARIES( ITKMetaIO )
+
+SET( testMeta1Utils_SRCS testMeta1Utils.cxx )
+ADD_EXECUTABLE( testMeta1Utils ${testMeta1Utils_SRCS} )
+
+SET( testMeta2Object_SRCS testMeta2Object.cxx )
+ADD_EXECUTABLE( testMeta2Object ${testMeta2Object_SRCS} )
+
+SET( testMeta3Image_SRCS testMeta3Image.cxx )
+ADD_EXECUTABLE( testMeta3Image ${testMeta3Image_SRCS} )
+
+SET( testMeta4Tube_SRCS testMeta4Tube.cxx )
+ADD_EXECUTABLE( testMeta4Tube ${testMeta4Tube_SRCS} )
+
+SET( testMeta5Blob_SRCS testMeta5Blob.cxx )
+ADD_EXECUTABLE( testMeta5Blob ${testMeta5Blob_SRCS} )
+
+SET( testMeta6Surface_SRCS testMeta6Surface.cxx )
+ADD_EXECUTABLE( testMeta6Surface ${testMeta6Surface_SRCS} )
+
+SET( testMeta7Line_SRCS testMeta7Line.cxx )
+ADD_EXECUTABLE( testMeta7Line ${testMeta7Line_SRCS} )
+
+SET( testMeta8Scene_SRCS testMeta8Scene.cxx )
+ADD_EXECUTABLE( testMeta8Scene ${testMeta8Scene_SRCS} )
+
+SET( testMeta9Landmark_SRCS testMeta9Landmark.cxx )
+ADD_EXECUTABLE( testMeta9Landmark ${testMeta9Landmark_SRCS} )
\ No newline at end of file
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta1Utils.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta1Utils.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..199c3775fe6a47aa26f784a0d7def9a9db5abfc1
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta1Utils.cxx
@@ -0,0 +1,228 @@
+#include <stdio.h>
+#include <fstream>
+#include <ctype.h>
+
+
+#include <metaUtils.h>
+
+int main(int argc, char **argv)
+ {
+
+ if(MET_SystemByteOrderMSB())
+ {
+ std::cout << "MET_SYSTEM_BYTE_ORDER_MSB = TRUE" << std::endl;
+ }
+ else
+ {
+ std::cout << "MET_SYSTEM_BYTE_ORDER_MSB = FALSE" << std::endl;
+ }
+ unsigned short x = 256;
+ std::cout << "MET_ByteSwapShort: ";
+ if(MET_ByteOrderSwapShort(x) != 1)
+ std::cout << "FAILED: 256->" << MET_ByteOrderSwapShort(x) << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+ x = 1;
+ std::cout << "MET_ByteSwapShort: ";
+ if(MET_ByteOrderSwapShort(x) != 256)
+ std::cout << "FAILED: 1->" << MET_ByteOrderSwapShort(x) << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ MET_ValueEnumType metType = MET_USHORT;
+ MET_ValueEnumType tmpMetType = MET_USHORT;
+ char tmpString[80];
+ sprintf(tmpString, "MET_USHORT");
+ std::cout << "MET_StringToType: ";
+ MET_StringToType(tmpString, &tmpMetType);
+ if(tmpMetType != metType)
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ std::cout << "MET_TypeToString: ";
+ MET_TypeToString(MET_USHORT, tmpString);
+ if(strcmp(tmpString, "MET_USHORT"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ int n;
+ std::cout << "MET_SizeOfType: ";
+ MET_SizeOfType(MET_USHORT, &n);
+ if(2 != n)
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ char **wordArray;
+ MET_StringToWordArray("This is a test", &n, &wordArray);
+ std::cout << "MET_StringToWordArray: N: ";
+ if(n != 4)
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+ std::cout << "MET_StringToWordArray: 1: ";
+ if(strcmp(wordArray[0], "This"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+ std::cout << "MET_StringToWordArray: 2: ";
+ if(strcmp(wordArray[1], "is"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+ std::cout << "MET_StringToWordArray: 3: ";
+ if(strcmp(wordArray[2], "a"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+ std::cout << "MET_StringToWordArray: 4: ";
+ if(strcmp(wordArray[3], "test"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ char fName[80];
+ sprintf(fName, "this/is/a/test.com");
+
+ std::cout << "MET_GetFilePathTest: ";
+ MET_GetFilePath(fName, tmpString);
+ if(strcmp(tmpString, "this/is/a/"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ int tmpI;
+ std::cout << "MET_GetFileSuffixPtr: ";
+ MET_GetFileSuffixPtr(fName, &tmpI);
+ if(fName[tmpI] != 'c')
+ {
+ std::cout << "FAILED" << std::endl;
+ std::cout << &(fName[tmpI]) << std::endl;
+ }
+ else
+ std::cout << "PASSED" << std::endl;
+
+ std::cout << "MET_SetFileSuffix: ";
+ MET_SetFileSuffix(fName, ".net");
+ if(strcmp(fName, "this/is/a/test.net"))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ std::ofstream fout;
+ fout.open("testMetaFileUtils.txt", std::ios::out);
+
+ MET_FieldRecordType * mF;
+ std::vector<MET_FieldRecordType *> mFields;
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "NDims", MET_UCHAR, 2);
+ mFields.push_back(mF);
+
+ float vTmp[10];
+ vTmp[0] = 0.5;
+ vTmp[1] = 0.75;
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "ElementSize", MET_FLOAT_ARRAY, 2, vTmp);
+ mFields.push_back(mF);
+
+ char s[80];
+ strcpy(s, "X-AXIS Y-AXIS");
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "DirNames", MET_STRING, strlen(s), s);
+ mFields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitWriteField(mF, "END", MET_NONE);
+ mF->terminateRead = true;
+ mFields.push_back(mF);
+
+ MET_Write(fout, &mFields);
+
+ MET_WriteFieldToFile(fout, "Beyond", MET_STRING, 4, "True");
+ MET_WriteFieldToFile(fout, "Extra", MET_USHORT, 1);
+
+ fout.flush();
+
+ std::vector<MET_FieldRecordType *>::iterator fieldIter;
+ for(fieldIter=mFields.begin(); fieldIter!=mFields.end(); fieldIter++)
+ delete *fieldIter;
+ mFields.clear();
+
+ //
+ //
+ //
+ std::ifstream fin;
+ fin.open("testMetaFileUtils.txt", std::ios::in);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "NDims", MET_INT);
+ mFields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "ElementSize", MET_FLOAT_ARRAY, true, 0);
+ mFields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "DirNames", MET_STRING);
+ mFields.push_back(mF);
+
+ mF = new MET_FieldRecordType;
+ MET_InitReadField(mF, "END", MET_NONE);
+ mF->terminateRead = true;
+ mFields.push_back(mF);
+
+ std::cout << "MET_Read: ";
+ if(!MET_Read(fin, &mFields))
+ std::cout << "FAILED" << std::endl;
+ else
+ std::cout << "PASSED" << std::endl;
+
+ fieldIter = mFields.begin();
+ int nDims = 0;
+ if((*fieldIter)->defined)
+ {
+ nDims = (int)((*fieldIter)->value[0]);
+ if(nDims != 2)
+ std::cout << "nDims not equal to 2" << std::endl;
+ else
+ std::cout << "nDims: Passed" << std::endl;
+ }
+ else
+ std::cout << "nDims not defined" << std::endl;
+
+ float eSize[2];
+ fieldIter++;
+ if((*fieldIter)->defined)
+ {
+ eSize[0] = (*fieldIter)->value[0];
+ eSize[1] = (*fieldIter)->value[1];
+ if(eSize[0] != 0.5 || eSize[1] != 0.75)
+ std::cout << "ElementSizes are wrong: " << eSize[0] << ", " << eSize[1] << std::endl;
+ else
+ std::cout << "ElementSizes: Passed" << std::endl;
+ }
+ else
+ std::cout << "ElementSize not defined" << std::endl;
+
+ int nNames;
+ char **names;
+ fieldIter++;
+ if((*fieldIter)->defined)
+ {
+ MET_StringToWordArray((char *)((*fieldIter)->value), &nNames, &names);
+ if(nNames != 2)
+ std::cout << "nNames wrong : " << nNames << std::endl;
+ else
+ if(strcmp(names[0], "X-AXIS") || strcmp(names[1], "Y-AXIS"))
+ std::cout << "names wrong : _" << names[0] << "_, _" << names[1] << "_" << std::endl;
+ else
+ std::cout << "Names: Passed" << std::endl;
+ }
+ else
+ std::cout << "DirNames not defined" << std::endl;
+
+ return 1;
+ }
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta2Object.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta2Object.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..92e647d5a9c86c2acb73f94454120acea4619dfd
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta2Object.cxx
@@ -0,0 +1,132 @@
+#include <stdio.h>
+#include <fstream>
+#include <ctype.h>
+
+#include <metaObject.h>
+
+int main(int argc, char **argv)
+ {
+ MetaObject tObj;
+
+ tObj.InitializeEssential(3);
+ tObj.FileName("testObject.txt");
+ tObj.Comment("TestObject");
+ tObj.ObjectTypeName("Object");
+ tObj.ObjectSubTypeName("MinorObject");
+ tObj.Position(0, 1);
+ tObj.Position(1, 2);
+ tObj.Position(2, 3);
+ double orient[9];
+ int i;
+ for(i=0; i<9; i++)
+ {
+ orient[i] = 0;
+ }
+ orient[0] = 1;
+ orient[5] = 1;
+ orient[7] = 1;
+ tObj.Orientation(orient);
+ tObj.ElementSpacing(0, 1);
+ tObj.ElementSpacing(1, 2);
+ tObj.ElementSpacing(2, 1);
+
+ // Add user's defined fields
+ int myarray[3];
+ myarray[0]=1;
+ myarray[1]=2;
+ myarray[2]=3;
+ tObj.AddUserField("MyName", MET_STRING, strlen("Julien"), "Julien");
+ tObj.AddUserField("MyArray", MET_INT_ARRAY,3,myarray);
+
+ float myMatrix[4];
+ for(i=0; i<4; i++)
+ {
+ myMatrix[i] = i;
+ }
+ tObj.AddUserField("MyMatrix", MET_FLOAT_MATRIX,2,myMatrix);
+
+ tObj.PrintInfo();
+ tObj.Write();
+
+ tObj.Clear();
+ tObj.ClearUserFields();
+
+ tObj.AddUserField("MyName", MET_STRING);
+ tObj.AddUserField("MyArray", MET_INT_ARRAY,3);
+ tObj.AddUserField("MyMatrix", MET_FLOAT_MATRIX,2);
+
+ tObj.Read();
+ tObj.PrintInfo();
+
+ const char* name = static_cast<const char*>(tObj.GetUserField("MyName"));
+ if(strcmp(name,"Julien"))
+ {
+ std::cout << "MyName: FAIL" << std::endl;
+ return 0;
+ }
+
+ const int* array = static_cast<const int*>(tObj.GetUserField("MyArray"));
+
+ for(i=0;i<3;i++)
+ {
+ if(array[i] != i+1)
+ {
+ std::cout << "MyArray: FAIL" << std::endl;
+ return 0;
+ }
+ }
+
+ const float* matrix = static_cast<const float*>(tObj.GetUserField("MyMatrix"));
+ for(i=0; i<4; i++)
+ {
+ if(matrix[i] != i)
+ {
+ std::cout << "MyMatrix: FAIL" << std::endl;
+ }
+ }
+
+ std::cout << "PASSED!" << std::endl;
+
+ tObj.Clear();
+ tObj.ClearUserFields();
+
+ tObj.FileName("testObject2.txt");
+ tObj.InitializeEssential(2);
+ tObj.Position(0, 4);
+ tObj.ElementSpacing(0,2);
+ tObj.PrintInfo();
+ tObj.Write();
+ tObj.Clear();
+
+ tObj.Read();
+ tObj.PrintInfo();
+ if(tObj.NDims() != 2)
+ {
+ std::cout << "NDims: FAIL" << std::endl;
+ }
+ else
+ {
+ std::cout << "NDims: PASS" << std::endl;
+ }
+
+ int zero = 0;
+ if(tObj.Position(zero) != 4)
+ {
+ std::cout << "Position: FAIL :" << tObj.Position(zero) << std::endl;
+ }
+ else
+ {
+ std::cout << "Position: PASS" << std::endl;
+ }
+
+ if(tObj.ElementSpacing(zero) != 2)
+ {
+ std::cout << "ElementSpacing: FAIL: " << tObj.ElementSpacing(zero) << std::endl;
+ }
+ else
+ {
+ std::cout << "ElementSpacing: PASS" << std::endl;
+ }
+
+ return 1;
+ }
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta3Image.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta3Image.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cff968c1742e2be69ab01fec72117470b0cde75d
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta3Image.cxx
@@ -0,0 +1,39 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaImage.h>
+
+int main(int argc, char **argv)
+ {
+
+ MetaImage tIm(8, 8, 1, 2, MET_CHAR);
+
+ int i;
+ for(i=0; i<64; i++)
+ tIm.ElementData(i, i);
+
+ for(i=0; i<64; i++)
+ {
+ if(i != tIm.ElementData(i))
+ {
+ std::cout << "Assigned Element Values Maintained: FAIL" << std::endl;
+ return 0;
+ }
+ }
+
+ tIm.Write("test.mha");
+ tIm.PrintInfo();
+
+ MetaImage tIm2("test.mha");
+ tIm2.PrintInfo();
+ for(i=0; i<64; i++)
+ {
+ if(i != tIm.ElementData(i))
+ {
+ std::cout << "Read Element Values: FAIL" << std::endl;
+ return 0;
+ }
+ }
+
+
+ return 1;
+ }
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta4Tube.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta4Tube.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e4b46758601c2d246ba8bcecef3f163f4070f21a
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta4Tube.cxx
@@ -0,0 +1,97 @@
+#include <stdio.h>
+#include <iostream>
+#include <ctype.h>
+#include <metaTube.h>
+#include <metaScene.h>
+#include <metaEllipse.h>
+
+int main(int argc, char **argv)
+{
+
+ std::cout << "Initializing scene ..." << std::endl;
+ MetaScene myScene = MetaScene(3);
+
+ std::cout << "Creating test file ..." << std::endl;
+
+ //MetaTubeNet* tubenet = new MetaTubeNet();
+
+ // add two tube to the list of tubenet
+ std::cout << " Creating first tube ..." << std::endl;
+ MetaTube* tube1 = new MetaTube(3);
+ tube1->ID(0);
+ TubePnt* pnt;
+
+ unsigned int i;
+ for(i=0;i<10;i++)
+ {
+ pnt = new TubePnt(3);
+ pnt->m_X[0]=i;pnt->m_X[1]=i;pnt->m_X[2]=i;
+ pnt->m_R=i;
+ tube1->GetPoints().push_back(pnt);
+ }
+
+ std::cout << " Creating second tube ..." << std::endl;
+ MetaTube* tube2 = new MetaTube(3);
+ tube2->ID(1);
+ for(i=0;i<5;i++)
+ {
+ pnt = new TubePnt(3);
+ pnt->m_X[0]=i;pnt->m_X[1]=i;pnt->m_X[2]=i;
+ pnt->m_R=i;
+ tube2->GetPoints().push_back(pnt);
+ }
+
+ // Add an ellipse
+ std::cout << " Creating ellipse ..." << std::endl;
+ MetaEllipse* ellipse = new MetaEllipse();
+ std::cout << " Initializing ellipse ..." << std::endl;
+ ellipse->InitializeEssential(3);
+ std::cout << " Setting radius ..." << std::endl;
+ ellipse->Radius(1,2,3);
+
+ myScene.AddObject(tube1);
+ myScene.AddObject(tube2);
+ myScene.AddObject(ellipse);
+
+ myScene.Write("test.scn");
+
+ std::cout << "done" << std::endl;
+ std::cout << "Reading test file ..." << std::endl;
+
+ // Read the result
+ MetaScene myScene2 = MetaScene();
+ myScene2.InitializeEssential(3);
+
+ std::cout << " ... reading scene " << std::endl;
+ myScene2.Read("test.scn");
+ std::cout << " ... read scene " << std::endl;
+
+ typedef MetaScene::ObjectListType ListType;
+ ListType * list = myScene2.GetObjectList();
+ ListType::iterator it = list->begin();
+
+ std::cout << " ... beginning loop " << std::endl;
+ for(i=0;i< list->size();i++)
+ {
+
+ (*it)->PrintInfo();
+ if(!strncmp((*it)->ObjectTypeName(),"Tube",4))
+ {
+ typedef MetaTube::PointListType ListType;
+ MetaTube* tube = dynamic_cast<MetaTube*>(*it);
+ ListType::iterator it2 = tube->GetPoints().begin();
+
+ for(unsigned int j=0;j< tube->GetPoints().size();j++)
+ {
+ std::cout << (*it2)->m_X[0]
+ << " " << (*it2)->m_X[1] << " " << (*it2)->m_X[2] << std::endl;
+ it2++;
+ }
+ }
+
+ it++;
+ }
+
+ std::cout << "done" << std::endl;
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta5Blob.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta5Blob.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2468560fd948abe768719efec43284ad245db75f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta5Blob.cxx
@@ -0,0 +1,55 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaBlob.h>
+
+int main(int argc, char **argv)
+{
+
+ std::cout << "Creating test file ..." << std::endl;
+ MetaBlob blob(3);
+ blob.ID(0);
+ BlobPnt* pnt;
+
+ std::cout << "Allocating points..." << std::endl;
+ unsigned int i;
+ for(i=0;i<10;i++)
+ {
+ pnt = new BlobPnt(3);
+ pnt->m_X[0]=(float)0.2;pnt->m_X[1]=i;pnt->m_X[2]=i;
+ blob.GetPoints().push_back(pnt);
+ }
+
+ std::cout << "Writing test file ..." << std::endl;
+
+ blob.BinaryData(true);
+ blob.ElementType(MET_FLOAT);
+ blob.Write("myCNC.meta");
+
+ std::cout << " done" << std::endl;
+
+ std::cout << "Reading test file ..." << std::endl;
+ blob.Read("myCNC.meta");
+
+ std::cout << " done" << std::endl;
+
+ blob.PrintInfo();
+
+ std::cout << "Accessing pointlist..." << std::endl;
+
+ MetaBlob::PointListType plist = blob.GetPoints();
+ MetaBlob::PointListType::const_iterator it = plist.begin();
+
+ while(it != plist.end())
+ {
+ for(unsigned int d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_X[d] << " ";
+ }
+
+ std::cout << std::endl;
+ it++;
+ }
+
+ std::cout << "done" << std::endl;
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta6Surface.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta6Surface.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..acd2236d6e565c435a0889e85041a9abe71b173f
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta6Surface.cxx
@@ -0,0 +1,90 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaSurface.h>
+
+int main(int argc, char **argv)
+{
+
+ std::cout << "Creating test file ...";
+ MetaSurface* surface = new MetaSurface(3);
+ surface->ID(0);
+ SurfacePnt* pnt;
+
+ unsigned int i;
+ for(i=0;i<10;i++)
+ {
+ pnt = new SurfacePnt(3);
+ pnt->m_X[0]=(float)0.2;
+ pnt->m_X[1]=i;
+ pnt->m_X[2]=i;
+ pnt->m_V[0]=(float)0.8;
+ pnt->m_V[1]=i;
+ pnt->m_V[2]=i;
+ surface->GetPoints().push_back(pnt);
+ }
+
+
+ std::cout << "Writing ASCII test file ...";
+
+ surface->Write("mySurface.meta");
+
+ std::cout << "done" << std::endl;
+ std::cout << "Reading ASCII test file ...";
+
+ surface->Clear();
+ surface->Read("mySurface.meta");
+ surface->PrintInfo();
+
+ MetaSurface::PointListType list = surface->GetPoints();
+ MetaSurface::PointListType::const_iterator it = list.begin();
+
+ unsigned int d=0;
+ while(it != list.end())
+ {
+
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_X[d] << " ";
+ }
+ std::cout << std::endl;
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_V[d] << " ";
+ }
+ std::cout << std::endl;
+ it++;
+ }
+
+ std::cout << "Writing Binary test file ...";
+ surface->BinaryData(true);
+ surface->ElementType(MET_FLOAT);
+ surface->Write("mySurface.meta");
+
+ std::cout << "done" << std::endl;
+ std::cout << "Reading Binary test file ...";
+
+ surface->Clear();
+ surface->Read("mySurface.meta");
+ surface->PrintInfo();
+
+ MetaSurface::PointListType list2 = surface->GetPoints();
+ it = list2.begin();
+
+ while(it != list2.end())
+ {
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_X[d] << " ";
+ }
+ std::cout << std::endl;
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_V[d] << " ";
+ }
+ std::cout << std::endl;
+ it++;
+ }
+
+ std::cout << "done" << std::endl;
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta7Line.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta7Line.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dbe98751cadffa99a53719ba7b0f85942b281163
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta7Line.cxx
@@ -0,0 +1,68 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaLine.h>
+
+int main(int argc, char **argv)
+{
+
+ std::cout << "Creating test file ...";
+ MetaLine* Line = new MetaLine(3);
+ Line->ID(0);
+ LinePnt* pnt;
+
+ unsigned int i;
+ for(i=0;i<10;i++)
+ {
+ pnt = new LinePnt(3);
+ pnt->m_X[0]=(float)0.2;pnt->m_X[1]=i;pnt->m_X[2]=i;
+ pnt->m_V[0][0]=(float)0.3;pnt->m_V[0][1]=i;pnt->m_V[0][2]=i;
+ pnt->m_V[1][0]=(float)0.4;pnt->m_V[1][1]=i+1;pnt->m_V[1][2]=i+1;
+ Line->GetPoints().push_back(pnt);
+ }
+
+ std::cout << "Writing test file ...";
+
+ Line->BinaryData(true);
+
+ Line->Write("myLine.meta");
+
+ std::cout << "done" << std::endl;
+ std::cout << "Reading test file ...";
+
+ Line->Clear();
+ Line->Read("myLine.meta");
+
+ Line->PrintInfo();
+
+ MetaLine::PointListType list = Line->GetPoints();
+ MetaLine::PointListType::const_iterator it = list.begin();
+
+ i=0;
+ while(it != list.end())
+ {
+ std::cout << "Point #" << i++ << ":" << std::endl;
+ std::cout << "position = ";
+ unsigned int d=0;
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_X[d] << " ";
+ }
+ std::cout << std::endl;
+ std::cout << "First normal = ";
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_V[0][d] << " ";
+ }
+ std::cout << std::endl;
+ std::cout << "Second normal = ";
+ for(d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_V[1][d] << " ";
+ }
+ std::cout << std::endl;
+ it++;
+ }
+
+ std::cout << "done" << std::endl;
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta8Scene.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta8Scene.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bf6b3f05996b8ac3020dbca50c5c6dfcf6791301
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta8Scene.cxx
@@ -0,0 +1,85 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaScene.h>
+#include <metaGroup.h>
+#include <metaEllipse.h>
+
+int main(int argc, char **argv)
+{
+
+ std::cout << "Creating test scene ..." << std::endl;
+ MetaScene * s = new MetaScene(3);
+
+ MetaEllipse * e1 = new MetaEllipse(3);
+ e1->ID(0);
+ e1->Radius(3);
+
+ MetaEllipse * e2 = new MetaEllipse(3);
+ e2->ID(1);
+ e2->Radius(4);
+
+ MetaGroup * g1 = new MetaGroup(3);
+ g1->ID(2);
+
+ e1->ParentID(2);
+ e2->ParentID(2);
+
+ s->AddObject(g1);
+ s->AddObject(e1);
+ s->AddObject(e2);
+
+ std::cout << "...[ok]" << std::endl;
+
+ std::cout << "Writing test file ..." << std::endl;
+
+ s->Write("scene.scn");
+
+ std::cout << "...[ok]" << std::endl;
+
+ std::cout << "Clearing the scene..." << std::endl;
+ s->Clear();
+ std::cout << "...[ok]" << std::endl;
+
+ std::cout << "Reading test file ..." << std::endl;
+
+ s->Read("scene.scn");
+
+ if(s->NObjects() != 3)
+ {
+ std::cout << "Number of obejcts: " << s->NObjects()
+ << " != 3...[FAILED]" << std::endl;
+ return 0;
+ }
+
+ std::cout << "...[ok]" << std::endl;
+
+ s->Clear();
+
+ std::cout << "Writing single object..." << std::endl;
+
+ e1 = new MetaEllipse(3);
+ e1->ID(0);
+ e1->Radius(3);
+ e1->Write("ellipse.elp");
+
+ std::cout << "[OK]" << std::endl;
+
+ s->Clear();
+
+ std::cout << "Reading test file ..." << std::endl;
+
+ s->Read("ellipse.elp");
+
+ if(s->NObjects() != 1)
+ {
+ std::cout << "Number of obejcts: " << s->NObjects()
+ << " != 1...[FAILED]" << std::endl;
+ return 0;
+ }
+
+ std::cout << "[OK]" << std::endl;
+
+ // (*(s->GetObjectList()->begin()))->PrintInfo();
+
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/MetaIO/tests/testMeta9Landmark.cxx b/Utilities/ITK/Utilities/MetaIO/tests/testMeta9Landmark.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..329165c70a8cb4950a97eb562b972f92b96d157a
--- /dev/null
+++ b/Utilities/ITK/Utilities/MetaIO/tests/testMeta9Landmark.cxx
@@ -0,0 +1,55 @@
+#include <stdio.h>
+#include <ctype.h>
+#include <metaLandmark.h>
+
+int main(int , char * [])
+{
+
+ std::cout << "Creating test file ..." << std::endl;
+ MetaLandmark Landmark(3);
+ Landmark.ID(0);
+ LandmarkPnt* pnt;
+
+ std::cout << "Allocating points..." << std::endl;
+ unsigned int i;
+ for(i=0;i<10;i++)
+ {
+ pnt = new LandmarkPnt(3);
+ pnt->m_X[0]=(float)0.2;pnt->m_X[1]=i;pnt->m_X[2]=i;
+ Landmark.GetPoints().push_back(pnt);
+ }
+
+ std::cout << "Writing test file ..." << std::endl;
+
+ Landmark.BinaryData(true);
+ Landmark.ElementType(MET_FLOAT);
+ Landmark.Write("Landmarks.meta");
+
+ std::cout << " done" << std::endl;
+
+ std::cout << "Reading test file ..." << std::endl;
+ Landmark.Read("Landmarks.meta");
+
+ std::cout << " done" << std::endl;
+
+ Landmark.PrintInfo();
+
+ std::cout << "Accessing pointlist..." << std::endl;
+
+ MetaLandmark::PointListType plist = Landmark.GetPoints();
+ MetaLandmark::PointListType::const_iterator it = plist.begin();
+
+ while(it != plist.end())
+ {
+ for(unsigned int d = 0; d < 3; d++)
+ {
+ std::cout << (*it)->m_X[d] << " ";
+ }
+
+ std::cout << std::endl;
+ it++;
+ }
+
+ std::cout << "done" << std::endl;
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/.NoDartCoverage b/Utilities/ITK/Utilities/NrrdIO/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/NrrdIO/000-README.txt b/Utilities/ITK/Utilities/NrrdIO/000-README.txt
new file mode 100644
index 0000000000000000000000000000000000000000..5204ff91b6c3dcb4e2797f2a60068b356879d6cf
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/000-README.txt
@@ -0,0 +1,122 @@
+---------------------------------------------------------------------------
+License -------------------------------------------------------------------
+---------------------------------------------------------------------------
+
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+
+---------------------------------------------------------------------------
+General information -------------------------------------------------------
+---------------------------------------------------------------------------
+
+** NOTE: These source files have been copied and/or modified from Teem,
+** Gordon Kindlmann's research software; <http://teem.sourceforge.net>.
+** Teem is licensed under the GNU Lesser Public License. The
+** non-copyleft licensing defined above applies to only the source
+** files in the NrrdIO distribution, and not to any files in the Teem
+** distribution.
+
+NrrdIO is a modified and highly abbreviated version of the Teem. NrrdIO
+contains only the source files (or portions thereof) required for
+creating and destroying nrrds, and for getting them into and out of
+files. The NrrdIO sources are created from the Teem sources by using
+GNU Make.
+
+NrrdIO makes it very easy to add support for the NRRD file format to
+your program, which is a good thing considering and design and
+flexibility of the NRRD file format, and the existence of the "unu"
+command-line tool for operating on nrrds. Using NrrdIO requires
+exactly one header file, "NrrdIO.h", and exactly one library,
+libNrrdIO.
+
+Currently, the API presented by NrrdIO is a strict subset of the Teem
+API. There is no additional encapsulation or abstraction. This could
+be annoying in the sense that you still have to deal with the biff
+(for error messages) and the air (for utilities) library function
+calls. Or it could be good and sane in the sense that code which uses
+NrrdIO can be painlessly "upgraded" to use more of Teem. Also, the
+API documentation for the same functionality in Teem will apply
+directly to NrrdIO.
+
+NrrdIO was originally created with the help of Josh Cates in order to
+add support for the NRRD file format to the Insight Toolkit (ITK).
+
+---------------------------------------------------------------------------
+NrrdIO API crash course ---------------------------------------------------
+---------------------------------------------------------------------------
+
+Please read <http://teem.sourceforge.net/nrrd/lib.html>. The
+functions that are explained in detail are all present in NrrdIO. Be
+aware, however, that NrrdIO currently supports ONLY the NRRD file
+format, and not: PNG, PNM, VTK, or EPS.
+
+The functionality in Teem which is NOT in NrrdIO is basically all
+those non-trivial manipulations of the values in the nrrd, or their
+ordering in memory. Still, NrrdIO can do a fair amount, namely all
+the functions listed in these sections of the "Overview of rest of
+API" in the above web page:
+
+- Basic "methods"
+- Manipulation of per-axis meta-information
+- Utility functions
+- Comments in nrrd
+- Key/value pairs
+- Endianness (byte ordering)
+- Getting/Setting values (crude!)
+- Input from, Output to files
+
+---------------------------------------------------------------------------
+Files comprising NrrdIO ---------------------------------------------------
+---------------------------------------------------------------------------
+
+NrrdIO.h: The single header file that declares all the functions and
+variables that NrrdIO provides.
+
+sampleIO.c: Tiny little command-line program demonstrating the basic
+NrrdIO API. Read this for examples of how NrrdIO is used to read
+and write NRRD files.
+
+CMakeLists.txt: to build NrrdIO with CMake
+
+pre-GNUmakefile: how NrrdIO sources are created from the Teem
+sources. Requires that TEEM_SRC_ROOT be set, and uses the following
+two files.
+
+unteem.pl: used to make small modifications to the source files to
+make them less Teem-dependent.
+
+preamble.c: the preamble describing the non-copyleft licensing of
+NrrdIO.
+
+qnanhibit.c: discover variable which, like endianness, is architecture
+dependent and which are required for building NrrdIO (as well as
+Teem), but unlike endianness, are completely obscure and unheard of.
+
+encodingBzip2.c, formatEPS.c, formatPNG.c, formatPNM.c, formatText.c,
+formatVTK.c: These files create stubs for functionality which is fully
+present in Teem, but which has been removed from NrrdIO in the
+interest of simplicity. The filenames are in fact unfortunately
+misleading, but they should be understood as listing the functionality
+that is MISSING in NrrdIO.
+
+All other files: copied/modified from the air, biff, and nrrd
+libraries of Teem.
diff --git a/Utilities/ITK/Utilities/NrrdIO/754.c b/Utilities/ITK/Utilities/NrrdIO/754.c
new file mode 100644
index 0000000000000000000000000000000000000000..1ecd790d4d31dcf1a5b2dd0008b9b128325b0541
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/754.c
@@ -0,0 +1,569 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+#include "privateAir.h"
+#include "teemEndian.h"
+#include "teemQnanhibit.h"
+
+/*
+** all this is based on a reading of
+** Hennessy + Patterson "Computer Architecture, A Quantitative Approach"
+** pages A-13 - A-17
+**
+** and some assorted web pages
+*/
+
+/*
+** The hex numbers in braces are examples of C's "initial member of a union"
+** aggregate initialization.
+*/
+
+#if TEEM_QNANHIBIT == 1
+const int airMyQNaNHiBit = 1;
+const airFloat airFloatQNaN = {0x7fffffff};
+const airFloat airFloatSNaN = {0x7fbfffff};
+#else
+const int airMyQNaNHiBit = 0;
+const airFloat airFloatQNaN = {0x7fbfffff};
+const airFloat airFloatSNaN = {0x7fffffff};
+#endif
+
+const airFloat airFloatPosInf = {0x7f800000};
+const airFloat airFloatNegInf = {0xff800000}; /* why does solaris whine? */
+
+/*
+** these shouldn't be needed, but here they are if need be:
+
+in this file:
+const airFloat airFloatMax = {0x7f7fffff};
+const airFloat airFloatMin = {0x00800000};
+const airDouble airDoubleMax = {AIR_ULLONG(0x7fefffffffffffff)};
+const airDouble airDoubleMin = {AIR_ULLONG(0x0010000000000000)};
+
+in air.h:
+extern air_export const airFloat airFloatMax;
+extern air_export const airFloat airFloatMin;
+extern air_export const airDouble airDoubleMax;
+extern air_export const airDouble airDoubleMin;
+#define AIR_FLT_MIN (airFloatMin.f)
+#define AIR_FLT_MAX (airFloatMax.f)
+#define AIR_DBL_MIN (airDoubleMin.d)
+#define AIR_DBL_MAX (airDoubleMax.d)
+*/
+
+#define FP_SET_F(flt, s, e, m) \
+ flt.c.sign = (s); \
+ flt.c.expo = (e); \
+ flt.c.mant = (m)
+
+#define FP_GET_F(s, e, m, flt) \
+ (s) = flt.c.sign; \
+ (e) = flt.c.expo; \
+ (m) = flt.c.mant
+
+#define FP_SET_D(dbl, s, e, m0, m1) \
+ dbl.c.sign = (s); \
+ dbl.c.expo = (e); \
+ dbl.c.mant0 = (m0); \
+ dbl.c.mant1 = (m1)
+
+#define FP_GET_D(s, e, m0, m1, dbl) \
+ (s) = dbl.c.sign; \
+ (e) = dbl.c.expo; \
+ (m0) = dbl.c.mant0; \
+ (m1) = dbl.c.mant1
+
+
+float
+airFPPartsToVal_f(unsigned int sign,
+ unsigned int expo,
+ unsigned int mant) {
+ _airFloat f;
+ FP_SET_F(f, sign, expo, mant);
+ return f.v;
+}
+
+void
+airFPValToParts_f(unsigned int *signP,
+ unsigned int *expoP,
+ unsigned int *mantP, float v) {
+ _airFloat f;
+ f.v = v;
+ FP_GET_F(*signP, *expoP, *mantP, f);
+}
+
+double
+airFPPartsToVal_d(unsigned int sign,
+ unsigned int expo,
+ unsigned int mant0,
+ unsigned int mant1) {
+ _airDouble d;
+ FP_SET_D(d, sign, expo, mant0, mant1);
+ return d.v;
+}
+
+/*
+** Disable the 'local variable used without having been initialized'
+** warning produced by the MSVC compiler
+*/
+#ifdef _WIN32
+#pragma warning(push)
+#pragma warning(disable : 4700)
+#endif
+void
+airFPValToParts_d(unsigned int *signP,
+ unsigned int *expoP,
+ unsigned int *mant0P,
+ unsigned int *mant1P, double v) {
+ _airDouble d;
+ d.v = v;
+ FP_GET_D(*signP, *expoP, *mant0P, *mant1P, d);
+}
+#ifdef _WIN32
+#pragma warning(pop)
+#endif
+
+/*
+******** airFPGen_f()
+**
+** generates a floating point value which is a member of the given class
+*/
+float
+airFPGen_f(int cls) {
+ _airFloat f;
+
+ switch(cls) {
+ case airFP_SNAN:
+ /* sgn: anything, mant: anything non-zero with high bit !TEEM_QNANHIBIT */
+ FP_SET_F(f, 0, 0xff, (!TEEM_QNANHIBIT << 22) | 0x3fffff);
+ break;
+ case airFP_QNAN:
+ /* sgn: anything, mant: anything non-zero with high bit TEEM_QNANHIBIT */
+ FP_SET_F(f, 0, 0xff, (TEEM_QNANHIBIT << 22) | 0x3fffff);
+ break;
+ case airFP_POS_INF:
+ FP_SET_F(f, 0, 0xff, 0);
+ break;
+ case airFP_NEG_INF:
+ FP_SET_F(f, 1, 0xff, 0);
+ break;
+ case airFP_POS_NORM:
+ /* exp: anything non-zero but < 0xff, mant: anything */
+ FP_SET_F(f, 0, 0x80, 0x7ff000);
+ break;
+ case airFP_NEG_NORM:
+ /* exp: anything non-zero but < 0xff, mant: anything */
+ FP_SET_F(f, 1, 0x80, 0x7ff000);
+ break;
+ case airFP_POS_DENORM:
+ /* mant: anything non-zero */
+ FP_SET_F(f, 0, 0, 0xff);
+ break;
+ case airFP_NEG_DENORM:
+ /* mant: anything non-zero */
+ FP_SET_F(f, 1, 0, 0xff);
+ break;
+ case airFP_POS_ZERO:
+ FP_SET_F(f, 0, 0, 0);
+ break;
+ case airFP_NEG_ZERO:
+ FP_SET_F(f, 1, 0, 0);
+ break;
+ default:
+ /* User is a moron. What can you do? */
+ f.v = 42;
+ break;
+ }
+ return f.v;
+}
+
+/*
+******** airFPGen_d()
+**
+** generates a floating point value which is a member of the given class
+*/
+double
+airFPGen_d(int cls) {
+ _airDouble f;
+
+ switch(cls) {
+ case airFP_SNAN:
+ /* sgn: anything, mant: anything non-zero with high bit !TEEM_QNANHIBIT */
+ FP_SET_D(f, 0, 0x7ff, (!TEEM_QNANHIBIT << 19) | 0x7ffff, 0xffffffff);
+ break;
+ case airFP_QNAN:
+ /* sgn: anything, mant anything non-zero with high bit TEEM_QNANHIBIT */
+ FP_SET_D(f, 0, 0x7ff, (TEEM_QNANHIBIT << 19) | 0x7ffff, 0xffffffff);
+ break;
+ case airFP_POS_INF:
+ FP_SET_D(f, 0, 0x7ff, 0, 0);
+ break;
+ case airFP_NEG_INF:
+ FP_SET_D(f, 1, 0x7ff, 0, 0);
+ break;
+ case airFP_POS_NORM:
+ /* exp: anything non-zero but < 0xff, mant: anything */
+ FP_SET_D(f, 0, 0x400, 0x0ff00, 0);
+ break;
+ case airFP_NEG_NORM:
+ /* exp: anything non-zero but < 0xff, mant: anything */
+ FP_SET_D(f, 1, 0x400, 0x0ff00, 0);
+ break;
+ case airFP_POS_DENORM:
+ /* mant: anything non-zero */
+ FP_SET_D(f, 0, 0, 0xff, 0);
+ break;
+ case airFP_NEG_DENORM:
+ /* mant: anything non-zero */
+ FP_SET_D(f, 1, 0, 0xff, 0);
+ break;
+ case airFP_POS_ZERO:
+ FP_SET_D(f, 0, 0, 0, 0);
+ break;
+ case airFP_NEG_ZERO:
+ FP_SET_D(f, 1, 0, 0, 0);
+ break;
+ default:
+ /* User is a moron. What can you do? */
+ f.v = 42;
+ break;
+ }
+ return f.v;
+}
+
+/*
+******** airFPClass_f()
+**
+** given a floating point number, tells which class its in
+*/
+int
+airFPClass_f(float val) {
+ _airFloat f;
+ unsigned int sign, exp, mant;
+ int index, ret = 0;
+
+ f.v = val;
+ FP_GET_F(sign, exp, mant, f);
+ index = ((!!sign) << 2) | ((!!exp) << 1) | (!!mant);
+ switch(index) {
+ case 0:
+ /* all fields are zero */
+ ret = airFP_POS_ZERO;
+ break;
+ case 1:
+ /* only mantissa is non-zero */
+ ret = airFP_POS_DENORM;
+ break;
+ case 2:
+ /* only exponent field is non-zero */
+ if (0xff == exp) {
+ ret = airFP_POS_INF;
+ } else {
+ ret = airFP_POS_NORM;
+ }
+ break;
+ case 3:
+ /* exponent and mantissa fields are non-zero */
+ if (0xff == exp) {
+ if (TEEM_QNANHIBIT == mant >> 22) {
+ ret = airFP_QNAN;
+ } else {
+ ret = airFP_SNAN;
+ }
+ } else {
+ ret = airFP_POS_NORM;
+ }
+ break;
+ case 4:
+ /* only sign field is non-zero */
+ ret = airFP_NEG_ZERO;
+ break;
+ case 5:
+ /* sign and mantissa fields are non-zero */
+ ret = airFP_NEG_DENORM;
+ break;
+ case 6:
+ /* sign and exponent fields are non-zero */
+ if (0xff > exp) {
+ ret = airFP_NEG_NORM;
+ } else {
+ ret = airFP_NEG_INF;
+ }
+ break;
+ case 7:
+ /* all fields are non-zero */
+ if (0xff > exp) {
+ ret = airFP_NEG_NORM;
+ } else {
+ if (TEEM_QNANHIBIT == mant >> 22) {
+ ret = airFP_QNAN;
+ } else {
+ ret = airFP_SNAN;
+ }
+ }
+ break;
+ }
+ return ret;
+}
+
+/*
+** Disable the 'local variable used without having been initialized'
+** warning produced by the MSVC compiler
+*/
+#ifdef _WIN32
+#pragma warning(push)
+#pragma warning(disable : 4700)
+#endif
+/*
+******** airFPClass_d()
+**
+** given a double, tells which class its in
+*/
+int
+airFPClass_d(double val) {
+ _airDouble f;
+ unsigned int sign, expo, mant0, mant1;
+ int hibit, index, ret=0;
+
+ f.v = val;
+ sign = f.c.sign;
+ expo = f.c.expo; /* this seems to be a WIN32 bug: on a quiet-NaN, f.c.exp
+ should be non-zero, but it was completely zero, so that
+ this function returned airFP_NEG_DENORM instead of
+ airFP_QNAN */
+ mant0 = f.c.mant0;
+ mant1 = f.c.mant1;
+ hibit = mant0 >> 20;
+
+ index = ((!!sign) << 2) | ((!!expo) << 1) | (!!mant0 || !!mant1);
+ switch(index) {
+ case 0:
+ /* all fields are zero */
+ ret = airFP_POS_ZERO;
+ break;
+ case 1:
+ /* only fractional field is non-zero */
+ ret = airFP_POS_DENORM;
+ break;
+ case 2:
+ /* only exponent field is non-zero */
+ if (0x7ff > expo) {
+ ret = airFP_POS_NORM;
+ } else {
+ ret = airFP_POS_INF;
+ }
+ break;
+ case 3:
+ /* exponent and fractional fields are non-zero */
+ if (0x7ff > expo) {
+ ret = airFP_POS_NORM;
+ } else {
+ if (TEEM_QNANHIBIT == hibit) {
+ ret = airFP_QNAN;
+ } else {
+ ret = airFP_SNAN;
+ }
+ }
+ break;
+ case 4:
+ /* only sign field is non-zero */
+ ret = airFP_NEG_ZERO;
+ break;
+ case 5:
+ /* sign and fractional fields are non-zero */
+ ret = airFP_NEG_DENORM;
+ break;
+ case 6:
+ /* sign and exponent fields are non-zero */
+ if (0x7ff > expo) {
+ ret = airFP_NEG_NORM;
+ } else {
+ ret = airFP_NEG_INF;
+ }
+ break;
+ case 7:
+ /* all fields are non-zero */
+ if (0x7ff > expo)
+ ret = airFP_NEG_NORM;
+ else {
+ if (TEEM_QNANHIBIT == hibit) {
+ ret = airFP_QNAN;
+ } else {
+ ret = airFP_SNAN;
+ }
+ }
+ break;
+ }
+ return ret;
+}
+#ifdef _WIN32
+#pragma warning(pop)
+#endif
+
+/*
+******** airIsNaN()
+**
+** returns 1 if input is either kind of NaN, 0 otherwise. It is okay
+** to only have a double version of this function, as opposed to
+** having one for float and one for double, because Section 6.2 of the
+** 754 spec tells us that that NaN is to be preserved across precision
+** changes (and airSanity() explicitly checks for this).
+*/
+int
+airIsNaN(double g) {
+ _airFloat f;
+
+ f.v = (float)g;
+ return (0xff == f.c.expo && f.c.mant);
+}
+
+/*
+******** airIsInf_f(), airIsInf_d()
+**
+** returns 1 if input is positive infinity,
+** -1 if negative infinity,
+** or 0 otherwise (including NaN)
+**
+** thus the non-zero-ness of the return is an easy way to do a
+** boolean check of whether the value is infinite
+*/
+int
+airIsInf_f(float f) {
+ int c, ret;
+
+ c = airFPClass_f(f);
+ if (airFP_POS_INF == c) {
+ ret = 1;
+ } else if (airFP_NEG_INF == c) {
+ ret = -1;
+ } else {
+ ret = 0;
+ }
+ return ret;
+}
+int
+airIsInf_d(double d) {
+ int c, ret;
+
+ c = airFPClass_d(d);
+ if (airFP_POS_INF == c) {
+ ret = 1;
+ } else if (airFP_NEG_INF == c) {
+ ret = -1;
+ } else {
+ ret = 0;
+ }
+ return ret;
+}
+
+/* airExists_f() airExists_d() were nixed because they weren't used-
+ you can just use AIR_EXISTS_F and AIR_EXISTS_D directly */
+
+/*
+******** airExists()
+**
+** an optimization-proof alternative to AIR_EXISTS
+*/
+int
+airExists(double val) {
+ _airDouble d;
+
+ d.v = val;
+ return 0x7ff != d.c.expo;
+}
+
+/*
+******** airNaN()
+**
+** returns a float quiet NaN
+*/
+float
+airNaN(void) {
+
+ return airFPGen_f(airFP_QNAN);
+}
+
+/*
+******** airFPFprintf_f()
+**
+** prints out the bits of a "float", indicating the three different fields
+*/
+void
+airFPFprintf_f(FILE *file, float val) {
+ int i;
+ unsigned int sign, expo, mant;
+ _airFloat f;
+
+ if (file) {
+ f.v = val;
+ FP_GET_F(sign, expo, mant, f);
+ fprintf(file, "%f: class %d; 0x%08x = ",val, airFPClass_f(val), f.i);
+ fprintf(file, "sign:0x%x, expo:0x%02x, mant:0x%06x = \n",
+ sign, expo, mant);
+ fprintf(file, " S [ . . Exp . . ] "
+ "[ . . . . . . . . . Mant. . . . . . . . . . ]\n");
+ fprintf(file, " %d ", sign);
+ for (i=7; i>=0; i--) {
+ fprintf(file, "%d ", (expo >> i) & 1);
+ }
+ for (i=22; i>=0; i--) {
+ fprintf(file, "%d ", (mant >> i) & 1);
+ }
+ fprintf(file, "\n");
+ }
+}
+
+/*
+******** airFPFprintf_d()
+**
+** prints out the bits of a "double", indicating the three different fields
+*/
+void
+airFPFprintf_d(FILE *file, double val) {
+ int i;
+ _airDouble d;
+
+ if (file) {
+ d.v = val;
+ fprintf(file, "%f: class %d; 0x%08x %08x = \n",
+ val, airFPClass_d(val), d.h.half1, d.h.half0);
+ fprintf(file, "sign:0x%x, expo:0x%03x, mant:0x%05x %08x = \n",
+ d.c.sign, d.c.expo, d.c.mant0, d.c.mant1);
+ fprintf(file, "S[...Exp...][.......................Mant.......................]\n");
+ fprintf(file, "%d", d.c.sign);
+ for (i=10; i>=0; i--) {
+ fprintf(file, "%d", (d.c.expo >> i) & 1);
+ }
+ for (i=19; i>=0; i--) {
+ fprintf(file, "%d", (d.c.mant0 >> i) & 1);
+ }
+ for (i=31; i>=0; i--) {
+ fprintf(file, "%d", (d.c.mant1 >> i) & 1);
+ }
+ fprintf(file, "\n");
+ }
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/CMakeLists.txt b/Utilities/ITK/Utilities/NrrdIO/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..9efc9f8d315daffdf19b1779ea2035b9ddc68db0
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/CMakeLists.txt
@@ -0,0 +1,63 @@
+PROJECT(ITKNrrdIO)
+INCLUDE_REGULAR_EXPRESSION("^.*.h$")
+
+#
+# This CMake file configures the NrrdIO library build. NrrdIO
+# is used by Insight/Code/IO/itkNrrdIO for reading/writing
+# "Nearly Raw Raster Data" within the open-source Teem software
+# package. See http://teem.sourceforge.net for more information.
+#
+
+SET(nrrdio_SRCS 754.c mop.c array.c parseAir.c dio.c sane.c endianAir.c
+string.c enum.c miscAir.c biffbiff.c accessors.c defaultsNrrd.c enumsNrrd.c
+arraysNrrd.c methodsNrrd.c reorder.c axis.c simple.c comment.c
+keyvalue.c endianNrrd.c parseNrrd.c gzio.c read.c write.c format.c
+formatNRRD.c encoding.c encodingRaw.c encodingAscii.c encodingHex.c
+encodingGzip.c subset.c encodingBzip2.c formatEPS.c formatPNG.c
+formatPNM.c formatText.c formatVTK.c )
+
+# Turn on TEEM_BUILD so that the proper dll export def's are
+# used on windows builds.
+ADD_DEFINITIONS(-DTEEM_BUILD=1)
+
+# Set compiler flags for endian-ness.
+IF(CMAKE_WORDS_BIGENDIAN)
+ ADD_DEFINITIONS(-DTEEM_ENDIAN=4321)
+ELSE(CMAKE_WORDS_BIGENDIAN)
+ ADD_DEFINITIONS(-DTEEM_ENDIAN=1234)
+ENDIF(CMAKE_WORDS_BIGENDIAN)
+
+# Set compiler flags for 32 or 64 bit architecture (based on the size
+# of a void pointer).
+IF(CMAKE_SIZEOF_VOID_P MATCHES 8)
+ ADD_DEFINITIONS(-DTEEM_32BIT=0)
+ELSE(CMAKE_SIZEOF_VOID_P MATCHES 8)
+ ADD_DEFINITIONS(-DTEEM_32BIT=1)
+ENDIF(CMAKE_SIZEOF_VOID_P MATCHES 8)
+
+#The QNANHIBIT variable is configured by the root level CMakeLists.txt
+IF(QNANHIBIT)
+ ADD_DEFINITIONS(-DTEEM_QNANHIBIT=1)
+ELSE(QNANHIBIT)
+ ADD_DEFINITIONS(-DTEEM_QNANHIBIT=0)
+ENDIF(QNANHIBIT)
+
+#DirectIO is the fast way to do multi-gigabyte I/O and currently only available
+#for SGI platforms. Use of DirectIO is enabled manually for now.
+#OPTION(USE_DIRECTIO "Use DirectIO for Nrrd file IO. Only valid on SGI systems." 0)
+#MARK_AS_ADVANCED(USE_DIRECTIO)
+#IF(USE_DIRECTIO)
+# ADD_DEFINITIONS(-DTEEM_DIO=1)
+#ELSE(USE_DIRECTIO)
+ ADD_DEFINITIONS(-DTEEM_DIO=0)
+#ENDIF(USE_DIRECTIO)
+
+# Tell NRRD to enable nrrdEncodingGzip
+ADD_DEFINITIONS(-DTEEM_ZLIB=1)
+
+ADD_LIBRARY(ITKNrrdIO ${nrrdio_SRCS} )
+TARGET_LINK_LIBRARIES(ITKNrrdIO ${ITK_ZLIB_LIBRARIES} )
+
+INSTALL_TARGETS(/lib/InsightToolkit ITKNrrdIO)
+INSTALL_FILES(/include/InsightToolkit/Utilities/NrrdIO "(\\.h)$")
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/NrrdIO.h b/Utilities/ITK/Utilities/NrrdIO/NrrdIO.h
new file mode 100644
index 0000000000000000000000000000000000000000..5aed653859d824d3266bfa585cc14934dc4cf416
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/NrrdIO.h
@@ -0,0 +1,2028 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <string.h>
+#include <ctype.h>
+#include <stdarg.h>
+#include <float.h>
+
+#define TEEM_VERSION_MAJOR 1 /* 1 digit */
+#define TEEM_VERSION_MINOR 9 /* 1 or 2 digits */
+#define TEEM_VERSION_RELEASE 0 /* 1 or 2 digits */
+#define TEEM_VERSION 10900 /* can be compared numerically */
+#define TEEM_VERSION_STRING "1.9.0" /* cannot be compared numerically */
+
+/* THE FOLLOWING INCLUDE IS ONLY FOR THE ITK DISTRIBUTION.
+ This header mangles the symbols in the NrrdIO library, preventing
+ conflicts in applications linked against two versions of NrrdIO. */
+#include "itk_NrrdIO_mangle.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* define TEEM_API */
+#define TEEM_BUILD 1
+#if defined(_WIN32) && !defined(__CYGWIN__) && !defined(TEEM_STATIC)
+# if defined(TEEM_BUILD)
+# define TEEM_API extern __declspec(dllexport)
+# else
+# define TEEM_API extern __declspec(dllimport)
+# endif
+#else /* TEEM_STATIC || UNIX */
+# define TEEM_API extern
+#endif
+
+#if defined(_WIN32) && !defined(__CYGWIN__) && !defined(__MINGW32__)
+typedef signed __int64 airLLong;
+typedef unsigned __int64 airULLong;
+#define AIR_LLONG_FMT "%I64d"
+#define AIR_ULLONG_FMT "%I64u"
+#define AIR_LLONG(x) x##i64
+#define AIR_ULLONG(x) x##ui64
+#else
+typedef signed long long airLLong;
+typedef unsigned long long airULLong;
+#define AIR_LLONG_FMT "%lld"
+#define AIR_ULLONG_FMT "%llu"
+#define AIR_LLONG(x) x##ll
+#define AIR_ULLONG(x) x##ull
+#endif
+
+/* This is annoying, thanks to windows */
+#define AIR_PI 3.14159265358979323846
+#define AIR_E 2.71828182845904523536
+
+#define AIR_STRLEN_SMALL (128+1)
+#define AIR_STRLEN_MED (256+1)
+#define AIR_STRLEN_LARGE (512+1)
+#define AIR_STRLEN_HUGE (1024+1)
+
+/* enum.c: enum value <--> string conversion utility */
+typedef struct {
+ char name[AIR_STRLEN_SMALL];
+ /* what are these things? */
+ unsigned int M;
+ /* If "val" is NULL, the the valid enum values are from 1
+ to M (represented by strings str[1] through str[M]), and
+ the unknown/invalid value is 0. If "val" is non-NULL, the
+ valid enum values are from val[1] to val[M] (but again,
+ represented by strings str[1] through str[M]), and the
+ unknown/invalid value is val[0]. In both cases, str[0]
+ is the string to represent an unknown/invalid value */
+ char (*str)[AIR_STRLEN_SMALL];
+ /* "canonical" textual representation of the enum values */
+ int *val; /* non-NULL iff valid values in the enum are not [1..M], and/or
+ if value for unknown/invalid is not zero */
+ char (*desc)[AIR_STRLEN_MED];
+ /* desc[i] is a short description of the enum values represented
+ by str[i] (thereby starting with the unknown value), to be
+ used to by things like hest */
+ char (*strEqv)[AIR_STRLEN_SMALL];
+ /* All the variations in strings recognized in mapping from
+ string to value (the values in valEqv). This **MUST** be
+ terminated by a zero-length string ("") so as to signify
+ the end of the list. This should not contain the string
+ for unknown/invalid. If "strEqv" is NULL, then mapping
+ from string to value is done by traversing "str", and
+ "valEqv" is ignored. */
+ int *valEqv; /* The values corresponding to the strings in strEqv; there
+ should be one integer for each non-zero-length string in
+ strEqv: strEqv[i] is a valid string representation for
+ value valEqv[i]. This should not contain the value for
+ unknown/invalid. This "valEqv" is ignored if "strEqv" is
+ NULL. */
+ int sense; /* require case matching on strings */
+} airEnum;
+TEEM_API int airEnumUnknown(airEnum *enm);
+TEEM_API int airEnumValCheck(airEnum *enm, int val);
+TEEM_API const char *airEnumStr(airEnum *enm, int val);
+TEEM_API const char *airEnumDesc(airEnum *enm, int val);
+TEEM_API int airEnumVal(airEnum *enm, const char *str);
+TEEM_API char *airEnumFmtDesc(airEnum *enm, int val, int canon,
+ const char *fmt);
+
+/*
+******** airEndian enum
+**
+** for identifying how a file was written to disk, for those encodings
+** where the raw data on disk is dependent on the endianness of the
+** architecture.
+*/
+enum {
+ airEndianUnknown, /* 0: nobody knows */
+ airEndianLittle = 1234, /* 1234: Intel and friends */
+ airEndianBig = 4321, /* 4321: the rest */
+ airEndianLast
+};
+/* endianAir.c */
+TEEM_API airEnum *airEndian;
+TEEM_API const int airMyEndian;
+
+/* array.c: poor-man's dynamically resizable arrays */
+typedef struct {
+ void *data, /* where the data is */
+ **dataP; /* (possibly NULL) address of user's data variable,
+ kept in sync with internal "data" variable */
+ unsigned int len, /* length of array: # units for which there is
+ considered to be data (which is <= total # units
+ allocated). The # bytes which contain data is
+ len*unit. Always updated (unlike "*lenP") */
+ *lenP, /* (possibly NULL) address of user's length variable,
+ kept in sync with internal "len" variable */
+ incr, /* the granularity of the changes in amount of space
+ allocated: when the length reaches a multiple of
+ "incr", then the array is resized */
+ size; /* array is allocated to have "size" increments, or,
+ size*incr elements, or,
+ size*incr*unit bytes */
+ size_t unit; /* the size in bytes of one element in the array */
+ int noReallocWhenSmaller; /* as it says */
+
+ /* the following are all callbacks useful for maintaining either an array
+ of pointers (allocCB and freeCB) or array of structs (initCB and
+ doneCB). allocCB or initCB is called when the array length increases,
+ and freeCB or doneCB when it decreases. Any of them can be NULL if no
+ such activity is desired. allocCB sets values in the array (as in
+ storing the return from malloc(); freeCB is called on values in the
+ array (as in calling free()), and the values are cast to void*. allocCB
+ and freeCB don't care about the value of "unit" (though perhaps they
+ should). initCB and doneCB are called on the _addresses_ of elements in
+ the array. allocCB and initCB are called for the elements in ascending
+ order in the array, and freeCB and doneCB are called in descending
+ order. allocCB and initCB are mutually exclusive- they can't both be
+ non-NULL. Same goes for freeCB and doneCB */
+ void *(*allocCB)(void); /* values of new elements set to return of this */
+ void *(*freeCB)(void *); /* called on the values of invalidated elements */
+ void (*initCB)(void *); /* called on addresses of new elements */
+ void (*doneCB)(void *); /* called on addresses of invalidated elements */
+
+} airArray;
+TEEM_API airArray *airArrayNew(void **dataP, unsigned int *lenP, size_t unit,
+ unsigned int incr);
+TEEM_API void airArrayStructCB(airArray *a, void (*initCB)(void *),
+ void (*doneCB)(void *));
+TEEM_API void airArrayPointerCB(airArray *a, void *(*allocCB)(void),
+ void *(*freeCB)(void *));
+TEEM_API void airArrayLenSet(airArray *a, unsigned int newlen);
+TEEM_API void airArrayLenPreSet(airArray *a, unsigned int newlen);
+TEEM_API unsigned int airArrayLenIncr(airArray *a, int delta);
+TEEM_API airArray *airArrayNix(airArray *a);
+TEEM_API airArray *airArrayNuke(airArray *a);
+
+
+/*
+******** airFP enum
+**
+** the different kinds of floating point number afforded by IEEE 754,
+** and the values returned by airFPClass_f().
+**
+** The values probably won't agree with those in #include's like
+** ieee.h, ieeefp.h, fp_class.h. This is because IEEE 754 hasn't
+** defined standard values for these, so everyone does it differently.
+**
+** This enum uses underscores (against teem convention) to help
+** legibility while also conforming to the spirit of the somewhat
+** standard naming conventions
+*/
+enum {
+ airFP_Unknown, /* 0: nobody knows */
+ airFP_SNAN, /* 1: signalling NaN */
+ airFP_QNAN, /* 2: quiet NaN */
+ airFP_POS_INF, /* 3: positive infinity */
+ airFP_NEG_INF, /* 4: negative infinity */
+ airFP_POS_NORM, /* 5: positive normalized non-zero */
+ airFP_NEG_NORM, /* 6: negative normalized non-zero */
+ airFP_POS_DENORM, /* 7: positive denormalized non-zero */
+ airFP_NEG_DENORM, /* 8: negative denormalized non-zero */
+ airFP_POS_ZERO, /* 9: +0.0, positive zero */
+ airFP_NEG_ZERO, /* 10: -0.0, negative zero */
+ airFP_Last /* after the last valid one */
+};
+/* 754.c: IEEE-754 related stuff values */
+typedef union {
+ unsigned int i;
+ float f;
+} airFloat;
+typedef union {
+ airULLong i;
+ double d;
+} airDouble;
+TEEM_API const int airMyQNaNHiBit;
+TEEM_API float airFPPartsToVal_f(unsigned int sign,
+ unsigned int expo,
+ unsigned int mant);
+TEEM_API void airFPValToParts_f(unsigned int *signP,
+ unsigned int *expoP,
+ unsigned int *mantP, float v);
+TEEM_API double airFPPartsToVal_d(unsigned int sign,
+ unsigned int expo,
+ unsigned int mant0,
+ unsigned int mant1);
+TEEM_API void airFPValToParts_d(unsigned int *signP,
+ unsigned int *expoP,
+ unsigned int *mant0P,
+ unsigned int *mant1P,
+ double v);
+TEEM_API float airFPGen_f(int cls);
+TEEM_API double airFPGen_d(int cls);
+TEEM_API int airFPClass_f(float val);
+TEEM_API int airFPClass_d(double val);
+TEEM_API void airFPFprintf_f(FILE *file, float val);
+TEEM_API void airFPFprintf_d(FILE *file, double val);
+TEEM_API const airFloat airFloatQNaN;
+TEEM_API const airFloat airFloatSNaN;
+TEEM_API const airFloat airFloatPosInf;
+TEEM_API const airFloat airFloatNegInf;
+TEEM_API float airNaN(void);
+TEEM_API int airIsNaN(double d);
+TEEM_API int airIsInf_f(float f);
+TEEM_API int airIsInf_d(double d);
+TEEM_API int airExists(double d);
+
+
+/*
+******** airType
+**
+** Different types which air cares about.
+** Currently only used in the command-line parsing, but perhaps will
+** be used elsewhere in air later
+*/
+enum {
+ airTypeUnknown, /* 0 */
+ airTypeBool, /* 1 */
+ airTypeInt, /* 2 */
+ airTypeUInt, /* 3 */
+ airTypeSize_t, /* 4 */
+ airTypeFloat, /* 5 */
+ airTypeDouble, /* 6 */
+ airTypeChar, /* 7 */
+ airTypeString, /* 8 */
+ airTypeEnum, /* 9 */
+ airTypeOther, /* 10 */
+ airTypeLast
+};
+#define AIR_TYPE_MAX 10
+/* parseAir.c */
+TEEM_API double airAtod(const char *str);
+TEEM_API int airSingleSscanf(const char *str, const char *fmt, void *ptr);
+TEEM_API airEnum *airBool;
+TEEM_API unsigned int airParseStrB(int *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrI(int *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrUI(unsigned int *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrZ(size_t *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrF(float *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrD(double *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrC(char *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* (nothing used) */);
+TEEM_API unsigned int airParseStrS(char **out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* REQUIRED even if n>1: int greedy */);
+TEEM_API unsigned int airParseStrE(int *out, const char *s,
+ const char *ct, unsigned int n,
+ ... /* REQUIRED: airEnum *e */);
+TEEM_API unsigned int (*airParseStr[AIR_TYPE_MAX+1])(void *, const char *,
+ const char *,
+ unsigned int, ...);
+
+/* string.c */
+TEEM_API char *airStrdup(const char *s);
+TEEM_API size_t airStrlen(const char *s);
+TEEM_API int airStrtokQuoting;
+TEEM_API char *airStrtok(char *s, const char *ct, char **last);
+TEEM_API unsigned int airStrntok(const char *s, const char *ct);
+TEEM_API char *airStrtrans(char *s, char from, char to);
+TEEM_API int airEndsWith(const char *s, const char *suff);
+TEEM_API char *airUnescape(char *s);
+TEEM_API char *airOneLinify(char *s);
+TEEM_API char *airToLower(char *str);
+TEEM_API char *airToUpper(char *str);
+TEEM_API unsigned int airOneLine(FILE *file, char *line, int size);
+
+/* sane.c */
+/*
+******** airInsane enum
+**
+** reasons for why airSanity() failed (specifically, the possible
+** return values for airSanity()
+*/
+enum {
+ airInsane_not, /* 0: actually, all sanity checks passed */
+ airInsane_endian, /* 1: airMyEndian is wrong */
+ airInsane_pInfExists, /* 2: AIR_EXISTS(positive infinity) was true */
+ airInsane_nInfExists, /* 3: AIR_EXISTS(negative infinity) was true */
+ airInsane_NaNExists, /* 4: AIR_EXISTS(NaN) was true */
+ airInsane_FltDblFPClass, /* 5: double -> float assignment messed up the
+ airFPClass_f() of the value */
+ airInsane_QNaNHiBit, /* 6: airMyQNaNHiBit is wrong */
+ airInsane_dio, /* 7: airMyDio set to something invalid */
+ airInsane_32Bit, /* 8: airMy32Bit is wrong */
+ airInsane_UCSize, /* 9: unsigned char isn't 8 bits */
+ airInsane_FISize, /* 10: sizeof(float), sizeof(int) not 4 */
+ airInsane_DLSize /* 11: sizeof(double), sizeof(airLLong) not 8 */
+};
+#define AIR_INSANE_MAX 11
+TEEM_API const char *airInsaneErr(int insane);
+TEEM_API int airSanity(void);
+
+/* miscAir.c */
+TEEM_API const char *airTeemVersion;
+TEEM_API const char *airTeemReleaseDate;
+TEEM_API void *airNull(void);
+TEEM_API void *airSetNull(void **ptrP);
+TEEM_API void *airFree(void *ptr);
+TEEM_API FILE *airFopen(const char *name, FILE *std, const char *mode);
+TEEM_API FILE *airFclose(FILE *file);
+TEEM_API int airSinglePrintf(FILE *file, char *str, const char *fmt, ...);
+TEEM_API const int airMy32Bit;
+
+/* dio.c */
+/*
+******** airNoDio enum
+**
+** reasons for why direct I/O won't be used with a particular
+** file/pointer combination
+*/
+enum {
+ airNoDio_okay, /* 0: actually, you CAN do direct I/O */
+ airNoDio_arch, /* 1: Teem thinks this architecture can't do it */
+ airNoDio_format, /* 2: Teem thinks given data file format can't use it */
+ airNoDio_std, /* 3: DIO isn't possible for std{in|out|err} */
+ airNoDio_fd, /* 4: couldn't get underlying file descriptor */
+ airNoDio_dioinfo, /* 5: calling fcntl() to get direct I/O info failed */
+ airNoDio_small, /* 6: requested size is too small */
+ airNoDio_size, /* 7: requested size not a multiple of d_miniosz */
+ airNoDio_ptr, /* 8: pointer not multiple of d_mem */
+ airNoDio_fpos, /* 9: current file position not multiple of d_miniosz */
+ airNoDio_setfl, /* 10: fcntl(fd, SETFL, FDIRECT) failed */
+ airNoDio_test, /* 11: couldn't memalign() even a small bit of memory */
+ airNoDio_disable /* 12: someone disabled it with airDisableDio */
+};
+#define AIR_NODIO_MAX 12
+TEEM_API const char *airNoDioErr(int noDio);
+TEEM_API const int airMyDio;
+TEEM_API int airDisableDio;
+TEEM_API void airDioInfo(int *align, int *min, int *max, int fd);
+TEEM_API int airDioTest(int fd, const void *ptr, size_t size);
+TEEM_API void *airDioMalloc(size_t size, int fd);
+TEEM_API size_t airDioRead(int fd, void *ptr, size_t size);
+TEEM_API size_t airDioWrite(int fd, const void *ptr, size_t size);
+
+/* mop.c: clean-up utilities */
+enum {
+ airMopNever,
+ airMopOnError,
+ airMopOnOkay,
+ airMopAlways
+};
+typedef void *(*airMopper)(void *);
+typedef struct {
+ void *ptr; /* the thing to be processed */
+ airMopper mop; /* the function to which does the processing */
+ int when; /* from the airMopWhen enum */
+} airMop;
+TEEM_API airArray *airMopNew(void);
+TEEM_API void airMopAdd(airArray *arr, void *ptr, airMopper mop, int when);
+TEEM_API void airMopSub(airArray *arr, void *ptr, airMopper mop);
+TEEM_API void airMopMem(airArray *arr, void *_ptrP, int when);
+TEEM_API void airMopUnMem(airArray *arr, void *_ptrP);
+TEEM_API void airMopPrint(airArray *arr, const void *_str, int when);
+TEEM_API void airMopDone(airArray *arr, int error);
+TEEM_API void airMopError(airArray *arr);
+TEEM_API void airMopOkay(airArray *arr);
+TEEM_API void airMopDebug(airArray *arr);
+
+/******* the interminable sea of defines and macros *******/
+
+#define AIR_TRUE 1
+#define AIR_FALSE 0
+#define AIR_WHITESPACE " \t\n\r\v\f" /* K+R pg. 157 */
+
+/*
+******** AIR_UNUSED
+**
+** one way of reconciling "warning: unused parameter" with
+** C's "error: parameter name omitted"
+*/
+#define AIR_UNUSED(x) (void)(x)
+
+/*
+******** AIR_ENDIAN, AIR_QNANHIBIT, AIR_DIO
+**
+** These reflect particulars of hardware which we're running on.
+** The reason to have these in addition to TEEM_ENDIAN, TEEM_DIO, etc.,
+** is that those are not by default defined for every source-file
+** compilation: the teem library has to define NEED_ENDIAN, NEED_DIO, etc,
+** and these in turn generate appropriate compile command-line flags
+** by Common.mk. By having these defined here, they become available
+** to anyone who simply links against the air library (and includes air.h),
+** with no command-line flags required, and no usage of Common.mk required.
+*/
+#define AIR_ENDIAN (airMyEndian)
+#define AIR_QNANHIBIT (airMyQNaNHiBit)
+#define AIR_DIO (airMyDio)
+#define AIR_32BIT (airMy32Bit)
+
+/*
+******** AIR_NAN, AIR_QNAN, AIR_SNAN, AIR_POS_INF, AIR_NEG_INF
+**
+** its nice to have these values available without the cost of a
+** function call.
+**
+** NOTE: AIR_POS_INF and AIR_NEG_INF correspond to the _unique_
+** bit-patterns which signify positive and negative infinity. With
+** the NaNs, however, they are only one of many possible
+** representations.
+*/
+#define AIR_NAN (airFloatQNaN.f)
+#define AIR_QNAN (airFloatQNaN.f)
+#define AIR_SNAN (airFloatSNaN.f)
+#define AIR_POS_INF (airFloatPosInf.f)
+#define AIR_NEG_INF (airFloatNegInf.f)
+
+/*
+******** AIR_EXISTS
+**
+** is non-zero (true) only for values which are not NaN or +/-infinity
+**
+** You'd think that (x == x) might work, but no no no, some optimizing
+** compilers (e.g. SGI's cc) say "well of course they're equal, for all
+** possible values". Bastards!
+**
+** One of the benefits of IEEE 754 floating point numbers is that
+** gradual underflow means that x = y <==> x - y = 0 for any (positive
+** or negative) normalized or denormalized float. Otherwise this
+** macro could not be valid; some floating point conventions say that
+** a zero-valued exponent means zero, regardless of the mantissa.
+**
+** However, there MAY be problems on machines which use extended
+** (80-bit) floating point registers, such as Intel chips- where the
+** same initial value 1) directly read from the register, versus 2)
+** saved to memory and loaded back, may end up being different. I
+** have yet to produce this behavior, or convince myself it can't
+** happen. If you have problems, then use the version of the macro
+** which is a function call to airExists_d(), and please email me:
+** gk@bwh.harvard.edu
+**
+** The reason to #define AIR_EXISTS as airExists_d is that on some
+** optimizing compilers, the !((x) - (x)) doesn't work. This has been
+** the case on Windows and 64-bit irix6 (64 bit) with -Ofast. If
+** airSanity fails because a special value "exists", then use the
+** first version of AIR_EXISTS.
+**
+** There are two performance consequences of using airExists_d(x):
+** 1) Its a function call (but WIN32 can __inline it)
+** 2) (via AIR_EXISTS_D) It requires bit-wise operations on 64-bit
+** ints, which might be terribly slow.
+**
+** The reason for using airExists_d and not airExists_f is for
+** doubles > FLT_MAX: airExists_f would say these are infinity.
+*/
+#if 1
+#define AIR_EXISTS(x) (airExists(x))
+#else
+#define AIR_EXISTS(x) (!((x) - (x)))
+#endif
+
+
+/*
+******** AIR_MAX(a,b), AIR_MIN(a,b), AIR_ABS(a)
+**
+** the usual
+*/
+#define AIR_MAX(a,b) ((a) > (b) ? (a) : (b))
+#define AIR_MIN(a,b) ((a) < (b) ? (a) : (b))
+#define AIR_ABS(a) ((a) > 0 ? (a) : -(a))
+
+/*
+******** AIR_COMPARE(a,b)
+**
+** the sort of compare that qsort() wants for ascending sort
+*/
+#define AIR_COMPARE(a,b) ((a) < (b) \
+ ? -1 \
+ : ((a) > (b) \
+ ? 1 \
+ : 0))
+
+/*
+******** AIR_IN_OP(a,b,c), AIR_IN_CL(a,b,c)
+**
+** is true if the middle argument is in the open/closed interval
+** defined by the first and third arguments
+**
+** AIR_IN_OP is new name for old AIR_BETWEEN
+** AIR_IN_CL is new name for odl AIR_INSIDE
+*/
+#define AIR_IN_OP(a,b,c) ((a) < (b) && (b) < (c)) /* closed interval */
+#define AIR_IN_CL(a,b,c) ((a) <= (b) && (b) <= (c)) /* open interval */
+
+/*
+******** AIR_CLAMP(a,b,c)
+**
+** returns the middle argument, after being clamped to the closed
+** interval defined by the first and third arguments
+*/
+#define AIR_CLAMP(a,b,c) ((b) < (a) \
+ ? (a) \
+ : ((b) > (c) \
+ ? (c) \
+ : (b)))
+
+/*
+******** AIR_MOD(i, N)
+**
+** returns that integer in [0, N-1] which is i plus a multiple of N. It
+** may be unfortunate that the expression (i)%(N) appears three times;
+** this should be inlined. Or perhaps the compiler's optimizations
+** (common sub-expression elimination) will save us.
+**
+** Note: integer divisions are not very fast on some modern chips;
+** don't go silly using this one.
+*/
+#define AIR_MOD(i, N) ((i)%(N) >= 0 ? (i)%(N) : N + (i)%(N))
+
+/*
+******** AIR_LERP(w, a, b)
+**
+** returns a when w=0, and b when w=1, and linearly varies in between
+*/
+#define AIR_LERP(w, a, b) ((w)*((b) - (a)) + (a))
+
+/*
+******** AIR_AFFINE(i,x,I,o,O)
+**
+** given intervals [i,I], [o,O] and a value x which may or may not be
+** inside [i,I], return the value y such that y stands in the same
+** relationship to [o,O] that x does with [i,I]. Or:
+**
+** y - o x - i
+** ------- = -------
+** O - o I - i
+**
+** It is the callers responsibility to make sure I-i and O-o are
+** both non-zero. Strictly speaking, real problems arise only when
+** when I-i is zero: division by zero generates either NaN or infinity
+*/
+#define AIR_AFFINE(i,x,I,o,O) ( \
+((double)(O)-(o))*((double)(x)-(i)) / ((double)(I)-(i)) + (o))
+
+/*
+******** AIR_DELTA(i,x,I,o,O)
+**
+** given intervals [i,I] and [o,O], calculates the number y such that
+** a change of x within [i,I] is proportional to a change of y within
+** [o,O]. Or:
+**
+** y x
+** ------- = -------
+** O - o I - i
+**
+** It is the callers responsibility to make sure I-i and O-o are
+** both non-zero
+*/
+#define AIR_DELTA(i,x,I,o,O) ( \
+((double)(O)-(o))*((double)(x)) / ((double)(I)-(i)) )
+
+/*
+******** AIR_ROUNDUP, AIR_ROUNDDOWN
+**
+** rounds integers up or down; just wrappers around floor and ceil
+*/
+#define AIR_ROUNDUP(x) ((int)(floor((x)+0.5)))
+#define AIR_ROUNDDOWN(x) ((int)(ceil((x)-0.5)))
+
+/*
+******** _AIR_SIZE_T_CNV, _AIR_PTRDIFF_T_CNV,
+**
+** Conversion sequence to use when printf/fprintf/sprintf-ing a value of
+** type size_t or ptrdiff_t. In C99, this is done with "%z" and "%t",
+** respecitvely.
+**
+** This is not a useful macro for the world at large- only for teem
+** source files. Why: we need to leave this as a bare string, so that
+** we can exploit C's implicit string concatenation in forming a
+** format string. Therefore, unlike the definition of AIR_ENDIAN,
+** AIR_DIO, etc, AIR_SIZE_T_CNV can NOT just refer to a const variable
+** (like airMyEndian). Therefore, TEEM_32BIT has to be defined for
+** ALL source files which want to use AIR_SIZE_T_CNV, and to be
+** conservative, that's all teem files. The converse is, since there is
+** no expectation that other projects which use teem will be defining
+** TEEM_32BIT, this is not useful outside teem, thus the leading _.
+*/
+#ifdef __APPLE__
+# define _AIR_SIZE_T_CNV "%lu"
+# define _AIR_PTRDIFF_T_CNV "%d"
+#else
+# if TEEM_32BIT == 0
+# define _AIR_SIZE_T_CNV "%lu"
+# define _AIR_PTRDIFF_T_CNV "%ld"
+# elif TEEM_32BIT == 1
+# define _AIR_SIZE_T_CNV "%u"
+# define _AIR_PTRDIFF_T_CNV "%d"
+# else
+# define _AIR_SIZE_T_CNV "(no _AIR_SIZE_T_CNV w/out TEEM_32BIT %*d)"
+# define _AIR_PTRDIFF_T_CNV "(no _AIR_PTRDIFF_T_CNV w/out TEEM_32BIT %*d)"
+# endif
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define BIFF_MAXKEYLEN 128 /* maximum allowed key length (not counting
+ the null termination) */
+
+TEEM_API void biffAdd(const char *key, const char *err);
+TEEM_API void biffMaybeAdd(const char *key, const char *err, int useBiff);
+TEEM_API int biffCheck(const char *key);
+TEEM_API void biffDone(const char *key);
+TEEM_API void biffMove(const char *destKey, const char *err,
+ const char *srcKey);
+TEEM_API char *biffGet(const char *key);
+TEEM_API int biffGetStrlen(const char *key);
+TEEM_API void biffSetStr(char *str, const char *key);
+TEEM_API char *biffGetDone(const char *key);
+TEEM_API void biffSetStrDone(char *str, const char *key);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#include <limits.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* feel free to set these to higher values and recompile */
+#define NRRD_DIM_MAX 16 /* Max array dimension (nrrd->dim) */
+#define NRRD_SPACE_DIM_MAX 8 /* Max dimension of "space" around array
+ (nrrd->spaceDim) */
+
+#define NRRD_EXT_NRRD ".nrrd"
+#define NRRD_EXT_NHDR ".nhdr"
+#define NRRD_EXT_PGM ".pgm"
+#define NRRD_EXT_PPM ".ppm"
+#define NRRD_EXT_PNG ".png"
+#define NRRD_EXT_VTK ".vtk"
+#define NRRD_EXT_TEXT ".txt"
+#define NRRD_EXT_EPS ".eps"
+
+#define NRRD_KERNEL_PARMS_NUM 8 /* max # arguments to a kernel-
+ this is weird: it isn't the max
+ of any of the NrrdKernels
+ defined by the nrrd library
+ (that is more like 3), but is
+ the max number of parms of any
+ NrrdKernel used by anyone using
+ teem, such as in gage.
+ Enforcing one global max
+ simplifies implementation. */
+
+/*
+** For the 64-bit integer types (not standard except in C99), we try
+** to use the names for the _MIN and _MAX values which are used in C99
+** (as well as gcc) such as LLONG_MAX.
+**
+** If these aren't defined, we try the ones used on SGI such as
+** LONGLONG_MAX.
+**
+** If these aren't defined either, we go wild and define something
+** ourselves (which just happen to be the values defined in C99), with
+** total disregard to what the architecture and compiler actually
+** support. These values are tested, however, by nrrdSanity().
+*/
+
+#ifdef LLONG_MAX
+# define NRRD_LLONG_MAX LLONG_MAX
+#else
+# ifdef LONGLONG_MAX
+# define NRRD_LLONG_MAX LONGLONG_MAX
+# else
+# define NRRD_LLONG_MAX AIR_LLONG(9223372036854775807)
+# endif
+#endif
+
+#ifdef LLONG_MIN
+# define NRRD_LLONG_MIN LLONG_MIN
+#else
+# ifdef LONGLONG_MIN
+# define NRRD_LLONG_MIN LONGLONG_MIN
+# else
+# define NRRD_LLONG_MIN (-NRRD_LLONG_MAX-AIR_LLONG(1))
+# endif
+#endif
+
+#ifdef ULLONG_MAX
+# define NRRD_ULLONG_MAX ULLONG_MAX
+#else
+# ifdef ULONGLONG_MAX
+# define NRRD_ULLONG_MAX ULONGLONG_MAX
+# else
+# define NRRD_ULLONG_MAX AIR_ULLONG(18446744073709551615)
+# endif
+#endif
+
+/*
+** Chances are, you shouldn't mess with these
+*/
+
+#define NRRD_COMMENT_CHAR '#'
+#define NRRD_FILENAME_INCR 32
+#define NRRD_COMMENT_INCR 16
+#define NRRD_KEYVALUE_INCR 32
+#define NRRD_LIST_FLAG "LIST"
+#define NRRD_PNM_COMMENT "# NRRD>" /* this is designed to be robust against
+ the mungling that xv does, but no
+ promises for any other image
+ programs */
+
+#define NRRD_PNG_FIELD_KEY "NRRD" /* this is the key used for getting nrrd
+ fields into/out of png comments */
+#define NRRD_PNG_COMMENT_KEY "NRRD#" /* this is the key used for getting nrrd
+ comments into/out of png comments */
+
+#define NRRD_UNKNOWN "???" /* how to represent something unknown in
+ a field of the nrrd header, when it
+ being unknown is not an error */
+#define NRRD_NONE "none" /* like NRRD_UNKNOWN, but with an air
+ of certainty */
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*******
+******** NONE of these enums should have values set explicitly in their
+******** definition. The values should simply start at 0 (for Unknown)
+******** and increase one integer per value. The _nrrdCheckEnums()
+******** sanity check assumes this, and there is no reason to use
+******** explicit values for any of the enums.
+*******/
+
+/*
+******** nrrdIoState* enum
+**
+** the various things it makes sense to get and set in nrrdIoState struct
+** via nrrdIoStateGet and nrrdIoStateSet
+*/
+enum {
+ nrrdIoStateUnknown,
+ nrrdIoStateDetachedHeader,
+ nrrdIoStateBareText,
+ nrrdIoStateCharsPerLine,
+ nrrdIoStateValsPerLine,
+ nrrdIoStateSkipData,
+ nrrdIoStateKeepNrrdDataFileOpen,
+ nrrdIoStateZlibLevel,
+ nrrdIoStateZlibStrategy,
+ nrrdIoStateBzip2BlockSize,
+ nrrdIoStateLast
+};
+
+/*
+******** nrrdFormatType enum
+**
+** the different file formats which nrrd supports
+*/
+enum {
+ nrrdFormatTypeUnknown,
+ nrrdFormatTypeNRRD, /* 1: basic nrrd format (associated with any of
+ the magics starting with "NRRD") */
+ nrrdFormatTypePNM, /* 2: PNM image */
+ nrrdFormatTypePNG, /* 3: PNG image */
+ nrrdFormatTypeVTK, /* 4: VTK Structured Points datasets (v1.0 and 2.0) */
+ nrrdFormatTypeText, /* 5: bare ASCII text for 2D arrays */
+ nrrdFormatTypeEPS, /* 6: Encapsulated PostScript (write-only) */
+ nrrdFormatTypeLast
+};
+#define NRRD_FORMAT_TYPE_MAX 6
+
+/*
+******** nrrdBoundary enum
+**
+** when resampling, how to deal with the ends of a scanline
+*/
+enum {
+ nrrdBoundaryUnknown,
+ nrrdBoundaryPad, /* 1: fill with some user-specified value */
+ nrrdBoundaryBleed, /* 2: copy the last/first value out as needed */
+ nrrdBoundaryWrap, /* 3: wrap-around */
+ nrrdBoundaryWeight, /* 4: normalize the weighting on the existing samples;
+ ONLY sensible for a strictly positive kernel
+ which integrates to unity (as in blurring) */
+ nrrdBoundaryLast
+};
+#define NRRD_BOUNDARY_MAX 4
+
+/*
+******** nrrdType enum
+**
+** all the different types, identified by integer
+**
+** 18 July 03: After some consternation, I decided to set
+** nrrdTypeUnknown and nrrdTypeDefault to the same thing, with the
+** reasoning that the only times that nrrdTypeDefault is used is when
+** controlling an *output* type (the type of "nout"), or rather,
+** choosing not to control an output type. As output types must be
+** known, there is no confusion between being unset/unknown (invalid)
+** and being simply default.
+*/
+enum {
+ nrrdTypeUnknown=0, /* 0: signifies "type is unset/unknown" */
+ nrrdTypeDefault=0, /* 0: signifies "determine output type for me" */
+ nrrdTypeChar, /* 1: signed 1-byte integer */
+ nrrdTypeUChar, /* 2: unsigned 1-byte integer */
+ nrrdTypeShort, /* 3: signed 2-byte integer */
+ nrrdTypeUShort, /* 4: unsigned 2-byte integer */
+ nrrdTypeInt, /* 5: signed 4-byte integer */
+ nrrdTypeUInt, /* 6: unsigned 4-byte integer */
+ nrrdTypeLLong, /* 7: signed 8-byte integer */
+ nrrdTypeULLong, /* 8: unsigned 8-byte integer */
+ nrrdTypeFloat, /* 9: 4-byte floating point */
+ nrrdTypeDouble, /* 10: 8-byte floating point */
+ nrrdTypeBlock, /* 11: size user defined at run time; MUST BE LAST */
+ nrrdTypeLast
+};
+#define NRRD_TYPE_MAX 11
+#define NRRD_TYPE_SIZE_MAX 8 /* max(sizeof()) over all scalar types */
+#define NRRD_TYPE_BIGGEST double /* this should be a basic C type which
+ requires for storage the maximum size
+ of all the basic C types */
+
+/*
+******** nrrdEncodingType enum
+**
+** how data might be encoded into a bytestream
+*/
+enum {
+ nrrdEncodingTypeUnknown,
+ nrrdEncodingTypeRaw, /* 1: same as memory layout (modulo endianness) */
+ nrrdEncodingTypeAscii, /* 2: decimal values are spelled out in ascii */
+ nrrdEncodingTypeHex, /* 3: hexidecimal (two chars per byte) */
+ nrrdEncodingTypeGzip, /* 4: gzip'ed raw data */
+ nrrdEncodingTypeBzip2, /* 5: bzip2'ed raw data */
+ nrrdEncodingTypeLast
+};
+#define NRRD_ENCODING_TYPE_MAX 5
+
+/*
+******** nrrdZlibStrategy enum
+**
+** how gzipped data is compressed
+*/
+enum {
+ nrrdZlibStrategyUnknown,
+ nrrdZlibStrategyDefault, /* 1: default (Huffman + string match) */
+ nrrdZlibStrategyHuffman, /* 2: Huffman only */
+ nrrdZlibStrategyFiltered, /* 3: specialized for filtered data */
+ nrrdZlibStrategyLast
+};
+#define NRRD_ZLIB_STRATEGY_MAX 3
+
+/*
+******** nrrdCenter enum
+**
+** node-centered vs. cell-centered
+*/
+enum {
+ nrrdCenterUnknown, /* 0: no centering known for this axis */
+ nrrdCenterNode, /* 1: samples at corners of things
+ (how "voxels" are usually imagined)
+ |\______/|\______/|\______/|
+ X X X X */
+ nrrdCenterCell, /* 2: samples at middles of things
+ (characteristic of histogram bins)
+ \___|___/\___|___/\___|___/
+ X X X */
+ nrrdCenterLast
+};
+#define NRRD_CENTER_MAX 2
+
+/*
+******** nrrdKind enum
+**
+** For describing the information along one axis of an array. This is
+** most important for clarifying the representation of non-scalar
+** data, in order to distinguish between axes that are genuine image
+** domain axes, and axes that exist just to store the multiple
+** attributes per sample. One could argue that this information
+** should be per-array and not per-axis, but you still have to
+** indicate which one of the axes is the attribute axis. And, if you
+** have, say, the gradient of RGB colors, you want the per-pixel 3x3
+** array to have those two attribute axes tagged accordingly.
+**
+** More of these may be added in the future, such as when nrrd
+** supports bricking. Since nrrd is never going to be in the business
+** of manipulating the kind information or supporting kind-specific
+** semantics, there can be proliferation of nrrdKinds, provided
+** pointless redundancy is avoided.
+**
+** There is a relationship between some of these (nrrdKindSpace is a
+** specific nrrdKindDomain), but currently there is no effort to
+** record this meta-kind information.
+**
+** Keep in sync:
+** enumsNrrd.c: nrrdKind airEnum
+** axis.c: nrrdKindSize()
+** axis.c: _nrrdKindAltered()
+**
+** NOTE: The nrrdKindSize() function returns the valid size for these.
+**
+*/
+enum {
+ nrrdKindUnknown,
+ nrrdKindDomain, /* 1: any image domain */
+ nrrdKindSpace, /* 2: a spatial domain */
+ nrrdKindTime, /* 3: a temporal domain */
+ /* -------------------------- end domain kinds */
+ /* -------------------------- begin range kinds */
+ nrrdKindList, /* 4: any list of values, non-resample-able */
+ nrrdKindPoint, /* 5: coords of a point */
+ nrrdKindVector, /* 6: coeffs of (contravariant) vector */
+ nrrdKindCovariantVector, /* 7: coeffs of covariant vector (eg gradient) */
+ nrrdKindNormal, /* 8: coeffs of unit-length covariant vector */
+ /* -------------------------- end arbitrary size kinds */
+ /* -------------------------- begin size-specific kinds */
+ nrrdKindStub, /* 9: axis with one sample (a placeholder) */
+ nrrdKindScalar, /* 10: effectively, same as a stub */
+ nrrdKindComplex, /* 11: real and imaginary components */
+ nrrdKind2Vector, /* 12: 2 component vector */
+ nrrdKind3Color, /* 13: ANY 3-component color value */
+ nrrdKindRGBColor, /* 14: RGB, no colorimetry */
+ nrrdKindHSVColor, /* 15: HSV, no colorimetry */
+ nrrdKindXYZColor, /* 16: perceptual primary colors */
+ nrrdKind4Color, /* 17: ANY 4-component color value */
+ nrrdKindRGBAColor, /* 18: RGBA, no colorimetry */
+ nrrdKind3Vector, /* 19: 3-component vector */
+ nrrdKind3Gradient, /* 20: 3-component covariant vector */
+ nrrdKind3Normal, /* 21: 3-component covector, assumed normalized */
+ nrrdKind4Vector, /* 22: 4-component vector */
+ nrrdKindQuaternion, /* 23: (x,y,z,w), not necessarily normalized */
+ nrrdKind2DSymMatrix, /* 24: Mxx Mxy Myy */
+ nrrdKind2DMaskedSymMatrix, /* 25: mask Mxx Mxy Myy */
+ nrrdKind2DMatrix, /* 26: Mxx Mxy Myx Myy */
+ nrrdKind2DMaskedMatrix, /* 27: mask Mxx Mxy Myx Myy */
+ nrrdKind3DSymMatrix, /* 28: Mxx Mxy Mxz Myy Myz Mzz */
+ nrrdKind3DMaskedSymMatrix, /* 29: mask Mxx Mxy Mxz Myy Myz Mzz */
+ nrrdKind3DMatrix, /* 30: Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz */
+ nrrdKind3DMaskedMatrix, /* 31: mask Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz */
+ nrrdKindLast
+};
+#define NRRD_KIND_MAX 31
+
+/*
+******** nrrdAxisInfo enum
+**
+** the different pieces of per-axis information recorded in a nrrd
+*/
+enum {
+ nrrdAxisInfoUnknown,
+ nrrdAxisInfoSize, /* 1: number of samples along axis */
+#define NRRD_AXIS_INFO_SIZE_BIT (1<< 1)
+ nrrdAxisInfoSpacing, /* 2: spacing between samples */
+#define NRRD_AXIS_INFO_SPACING_BIT (1<< 2)
+ nrrdAxisInfoThickness, /* 3: thickness of sample region */
+#define NRRD_AXIS_INFO_THICKNESS_BIT (1<< 3)
+ nrrdAxisInfoMin, /* 4: min pos. assoc. w/ 1st sample */
+#define NRRD_AXIS_INFO_MIN_BIT (1<< 4)
+ nrrdAxisInfoMax, /* 5: max pos. assoc. w/ last sample */
+#define NRRD_AXIS_INFO_MAX_BIT (1<< 5)
+ nrrdAxisInfoSpaceDirection, /* 6: inter-sample vector in "space" */
+#define NRRD_AXIS_INFO_SPACEDIRECTION_BIT (1<< 6)
+ nrrdAxisInfoCenter, /* 7: cell vs. node */
+#define NRRD_AXIS_INFO_CENTER_BIT (1<< 7)
+ nrrdAxisInfoKind, /* 8: from the nrrdKind* enum */
+#define NRRD_AXIS_INFO_KIND_BIT (1<< 8)
+ nrrdAxisInfoLabel, /* 9: string describing the axis */
+#define NRRD_AXIS_INFO_LABEL_BIT (1<< 9)
+ nrrdAxisInfoUnits, /* 10: from the nrrdUnit* enum */
+#define NRRD_AXIS_INFO_UNITS_BIT (1<<10)
+ nrrdAxisInfoLast
+};
+#define NRRD_AXIS_INFO_MAX 10
+#define NRRD_AXIS_INFO_ALL \
+ ((1<<1)|(1<<2)|(1<<3)|(1<<4)|(1<<5)|(1<<6)|(1<<7)|(1<<8)|(1<<9)|(1<<10))
+#define NRRD_AXIS_INFO_NONE 0
+
+/*
+******** nrrdBasicInfo enum
+**
+** the non-per-axis (or per-array) pieces of information that could
+** meaningfully be copied between nrrds (hence the void *data is not
+** included).
+**
+** "Basic" is named after the "basic field specifications" described
+** in the NRRD file format definition
+*/
+enum {
+ nrrdBasicInfoUnknown,
+ nrrdBasicInfoData, /* 1 */
+#define NRRD_BASIC_INFO_DATA_BIT (1<< 1)
+ nrrdBasicInfoType, /* 2 */
+#define NRRD_BASIC_INFO_TYPE_BIT (1<< 2)
+ nrrdBasicInfoBlocksize, /* 3 */
+#define NRRD_BASIC_INFO_BLOCKSIZE_BIT (1<< 3)
+ nrrdBasicInfoDimension, /* 4 */
+#define NRRD_BASIC_INFO_DIMENSION_BIT (1<< 4)
+ nrrdBasicInfoContent, /* 5 */
+#define NRRD_BASIC_INFO_CONTENT_BIT (1<< 5)
+ nrrdBasicInfoSampleUnits, /* 6 */
+#define NRRD_BASIC_INFO_SAMPLEUNITS_BIT (1<< 6)
+ nrrdBasicInfoSpace, /* 7 */
+#define NRRD_BASIC_INFO_SPACE_BIT (1<< 7)
+ nrrdBasicInfoSpaceDimension, /* 8 */
+#define NRRD_BASIC_INFO_SPACEDIMENSION_BIT (1<< 8)
+ nrrdBasicInfoSpaceUnits, /* 9 */
+#define NRRD_BASIC_INFO_SPACEUNITS_BIT (1<< 9)
+ nrrdBasicInfoSpaceOrigin, /* 10 */
+#define NRRD_BASIC_INFO_SPACEORIGIN_BIT (1<<10)
+ nrrdBasicInfoMeasurementFrame, /* 11 */
+#define NRRD_BASIC_INFO_MEASUREMENTFRAME_BIT (1<<11)
+ nrrdBasicInfoOldMin, /* 12 */
+#define NRRD_BASIC_INFO_OLDMIN_BIT (1<<12)
+ nrrdBasicInfoOldMax, /* 13 */
+#define NRRD_BASIC_INFO_OLDMAX_BIT (1<<13)
+ nrrdBasicInfoComments, /* 14 */
+#define NRRD_BASIC_INFO_COMMENTS_BIT (1<<14)
+ nrrdBasicInfoKeyValuePairs, /* 15 */
+#define NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT (1<<15)
+ nrrdBasicInfoLast
+};
+#define NRRD_BASIC_INFO_MAX 15
+#define NRRD_BASIC_INFO_ALL \
+ ((1<<1)|(1<<2)|(1<<3)|(1<<4)|(1<<5)|(1<<6)|(1<<7)|(1<<8)|(1<<9)|(1<<10)\
+ |(1<<11)|(1<<12)|(1<<13)|(1<<14)|(1<<15))
+#define NRRD_BASIC_INFO_SPACE (NRRD_BASIC_INFO_SPACE_BIT \
+ | NRRD_BASIC_INFO_SPACEDIMENSION_BIT \
+ | NRRD_BASIC_INFO_SPACEUNITS_BIT \
+ | NRRD_BASIC_INFO_SPACEORIGIN_BIT \
+ | NRRD_BASIC_INFO_MEASUREMENTFRAME_BIT)
+#define NRRD_BASIC_INFO_NONE 0
+
+/*
+** the "endian" enum is actually in the air library, but it is very
+** convenient to have it incorporated into the nrrd enum framework for
+** the purposes of string<-->int conversion. Unfortunately, the
+** little and big values are 1234 and 4321 respectively, so
+** NRRD_ENDIAN_MAX is not actually the highest valid value, but only
+** an indicator of how many valid values there are.
+*/
+#define NRRD_ENDIAN_MAX 2
+
+/*
+******** nrrdField enum
+**
+** the various fields we can parse in a NRRD header
+**
+** other things which must be kept in sync:
+** arraysNrrd.c:
+** _nrrdFieldValidInImage[]
+** _nrrdFieldOnePerAxis[]
+** _nrrdFieldValidInText[]
+** _nrrdFieldRequired[]
+** parseNrrd.c:
+** _nrrdReadNrrdParseInfo[]
+** enumsNrrd.c:
+** nrrdField definition
+** simple.c:
+** _nrrdFieldCheck[]
+** write.c:
+** _nrrdFieldInteresting()
+** _nrrdSprintFieldInfo()
+** to some extent, in this file:
+** nrrdAxisInfo and nrrdBasicInfo enums
+** axis.c (for per-axis info):
+** _nrrdAxisInfoCopy()
+** methodsNrrd.c:
+** lots of functions, but you knew that ...
+*/
+enum {
+ nrrdField_unknown,
+ nrrdField_comment, /* 1 */
+ nrrdField_content, /* 2 */
+ nrrdField_number, /* 3 */
+ nrrdField_type, /* 4 */
+ nrrdField_block_size, /* 5 */
+ nrrdField_dimension, /* 6 */
+ nrrdField_space, /* 7 */
+ nrrdField_space_dimension, /* 8 */
+ nrrdField_sizes, /* 9 ----- begin per-axis ----- */
+ nrrdField_spacings, /* 10 */
+ nrrdField_thicknesses, /* 11 */
+ nrrdField_axis_mins, /* 12 */
+ nrrdField_axis_maxs, /* 13 */
+ nrrdField_space_directions, /* 14 */
+ nrrdField_centers, /* 15 */
+ nrrdField_kinds, /* 16 */
+ nrrdField_labels, /* 17 */
+ nrrdField_units, /* 18 ------ end per-axis ------ */
+ nrrdField_min, /* 19 */
+ nrrdField_max, /* 20 */
+ nrrdField_old_min, /* 21 */
+ nrrdField_old_max, /* 22 */
+ nrrdField_endian, /* 23 */
+ nrrdField_encoding, /* 24 */
+ nrrdField_line_skip, /* 25 */
+ nrrdField_byte_skip, /* 26 */
+ nrrdField_keyvalue, /* 27 */
+ nrrdField_sample_units, /* 28 */
+ nrrdField_space_units, /* 29 */
+ nrrdField_space_origin, /* 30 */
+ nrrdField_measurement_frame, /* 31 */
+ nrrdField_data_file, /* 32 */
+ nrrdField_last
+};
+#define NRRD_FIELD_MAX 32
+
+/*
+******** nrrdHasNonExist* enum
+**
+** oh look, I'm violating my rules outline above for how the enum values
+** should be ordered. The reason for this is that its just too bizarro to
+** have the logical value of both nrrdHasNonExistFalse and nrrdHasNonExistTrue
+** to be (in C) true. For instance, nrrdHasNonExist() should be able to
+** return a value from this enum which also functions in a C expressions as
+** the expected boolean value. If for some reason (outide the action of
+** nrrdHasNonExist(), nrrdHasNonExistUnknown is interpreted as true, that's
+** probably harmlessly conservative. Time will tell.
+*/
+enum {
+ nrrdHasNonExistFalse, /* 0: no non-existent values were seen */
+ nrrdHasNonExistTrue, /* 1: some non-existent values were seen */
+ nrrdHasNonExistOnly, /* 2: NOTHING BUT non-existant values were seen */
+ nrrdHasNonExistUnknown, /* 3 */
+ nrrdHasNonExistLast
+};
+#define NRRD_HAS_NON_EXIST_MAX 3
+
+/*
+******** nrrdSpace* enum
+**
+** Identifies the space in which which the origin and direction
+** vectors have their coordinates measured. When a direction is named
+** here (like "Left" or "Anterior"), that implies a basis vector that
+** points in that direction, along which that coordinate becomes *larger*
+** (this is the opposite of MetaIO, for example).
+**
+** All of these spaces have a well-defined expected dimension, as
+** determined by nrrdSpaceDimension(), and setting a nrrd to be in
+** such a space, by nrrdSpaceSet(), will automatically set nrrd->spaceDim.
+**
+** The first six spaces here are PATIENT-ORIENTED spaces, which are
+** properly speaking aligned with the patient, and not the scanner
+** itself. But nrrdSpaceScannerXYZ and nrrdSpaceScannerXYZTime are
+** DEVICE-ORIENTED spaces, irrespective of the patient, used in a
+** previous version of the DICOM standard. When the two spaces are
+** lined up with normal patient orientation in the scanner,
+** nrrdSpaceScannerXYZ is the same as nrrdSpaceLeftPosteriorSuperior.
+** To quote Part 3 (Information Object Definitions) of the DICOM spec
+** (page 275): "If a patient lies parallel to the ground, face-up on
+** the table, with his feet-to-head direction same as the
+** front-to-back direction of the imaging equipment, the direction of
+** the axes of this patient based coordinate system and the equipment
+** based coordinate system in previous versions of this Standard will
+** coincide."
+**
+** Keep in sync:
+** enumsNrrd.c: nrrdSpace airEnum
+** simple.c: int nrrdSpaceDimension(int space)
+*/
+enum {
+ nrrdSpaceUnknown,
+ nrrdSpaceRightAnteriorSuperior, /* 1: NIFTI-1 (right-handed) */
+ nrrdSpaceLeftAnteriorSuperior, /* 2: standard Analyze (left-handed) */
+ nrrdSpaceLeftPosteriorSuperior, /* 3: DICOM 3.0 (right-handed) */
+ nrrdSpaceRightAnteriorSuperiorTime, /* 4: */
+ nrrdSpaceLeftAnteriorSuperiorTime, /* 5: */
+ nrrdSpaceLeftPosteriorSuperiorTime, /* 6: */
+ nrrdSpaceScannerXYZ, /* 7: ACR/NEMA 2.0 (pre-DICOM 3.0) */
+ nrrdSpaceScannerXYZTime, /* 8: */
+ nrrdSpace3DRightHanded, /* 9: */
+ nrrdSpace3DLeftHanded, /* 10: */
+ nrrdSpace3DRightHandedTime, /* 11: */
+ nrrdSpace3DLeftHandedTime, /* 12: */
+ nrrdSpaceLast
+};
+#define NRRD_SPACE_MAX 12
+
+/*
+******** nrrdSpacingStatus* enum
+**
+** a way of describing how spacing information is known or not known for a
+** given axis, as determined by nrrdSpacingCalculate
+*/
+enum {
+ nrrdSpacingStatusUnknown, /* 0: nobody knows,
+ or invalid axis choice */
+ nrrdSpacingStatusNone, /* 1: neither axis->spacing nor
+ axis->spaceDirection is set */
+ nrrdSpacingStatusScalarNoSpace, /* 2: axis->spacing set,
+ w/out space info */
+ nrrdSpacingStatusScalarWithSpace, /* 3: axis->spacing set, but there *is*
+ space info, which means the spacing
+ does *not* live in the surrounding
+ space */
+ nrrdSpacingStatusDirection, /* 4: axis->spaceDirection set, and
+ measured according to surrounding
+ space */
+ nrrdSpacingStatusLast
+};
+
+/*
+******** nrrdOriginStatus* enum
+**
+** how origin information was or was not computed by nrrdOriginCalculate
+*/
+enum {
+ nrrdOriginStatusUnknown, /* 0: nobody knows, or invalid parms */
+ nrrdOriginStatusDirection, /* 1: chosen axes have spaceDirections */
+ nrrdOriginStatusNoMin, /* 2: axis->min doesn't exist */
+ nrrdOriginStatusNoMaxOrSpacing, /* 3: axis->max or ->spacing doesn't exist */
+ nrrdOriginStatusOkay, /* 4: all is well */
+ nrrdOriginStatusLast
+};
+
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+******** NRRD_CELL_POS, NRRD_NODE_POS, NRRD_POS
+******** NRRD_CELL_IDX, NRRD_NODE_IDX, NRRD_IDX
+**
+** the guts of nrrdAxisPos() and nrrdAxisIdx(), for converting
+** between "index space" location and "position" or "world space" location,
+** given the centering, min and max "position", and number of samples.
+**
+** Unlike nrrdAxisPos() and nrrdAxisIdx(), this assumes that center
+** is either nrrdCenterCell or nrrdCenterNode, but not nrrdCenterUnknown.
+*/
+/* index to position, cell centering */
+#define NRRD_CELL_POS(min, max, size, idx) \
+ AIR_AFFINE(0, (idx) + 0.5, (size), (min), (max))
+
+/* index to position, node centering */
+#define NRRD_NODE_POS(min, max, size, idx) \
+ AIR_AFFINE(0, (idx), (size)-1, (min), (max))
+
+/* index to position, either centering */
+#define NRRD_POS(center, min, max, size, idx) \
+ (nrrdCenterCell == (center) \
+ ? NRRD_CELL_POS((min), (max), (size), (idx)) \
+ : NRRD_NODE_POS((min), (max), (size), (idx)))
+
+/* position to index, cell centering */
+#define NRRD_CELL_IDX(min, max, size, pos) \
+ (AIR_AFFINE((min), (pos), (max), 0, (size)) - 0.5)
+
+/* position to index, node centering */
+#define NRRD_NODE_IDX(min, max, size, pos) \
+ AIR_AFFINE((min), (pos), (max), 0, (size)-1)
+
+/* position to index, either centering */
+#define NRRD_IDX(center, min, max, size, pos) \
+ (nrrdCenterCell == (center) \
+ ? NRRD_CELL_IDX((min), (max), (size), (pos)) \
+ : NRRD_NODE_IDX((min), (max), (size), (pos)))
+
+/*
+******** NRRD_SPACING
+**
+** the guts of nrrdAxisSpacing(), determines the inter-sample
+** spacing, given centering, min and max "position", and number of samples
+**
+** Unlike nrrdAxisSpacing, this assumes that center is either
+** nrrdCenterCell or nrrdCenterNode, but not nrrdCenterUnknown.
+*/
+#define NRRD_SPACING(center, min, max, size) \
+ (nrrdCenterCell == center \
+ ? ((max) - (min))/(size) \
+ : ((max) - (min))/((size) - 1)) \
+
+/*
+******** NRRD_COORD_UPDATE
+**
+** This is for doing the "carrying" associated with gradually
+** incrementing an array of coordinates. Assuming that the given
+** coordinate array "coord" has been incrementing by adding 1 to THE
+** FIRST, THE ZERO-ETH, ELEMENT (this is a strong assumption), then,
+** this macro is good for propagating the change up to higher axes
+** (which really only happens when the position has stepped over the
+** limit on a lower axis.) Relies on the array of axes sizes "size",
+** as as the length "dim" of "coord" and "size".
+**
+** This may be turned into something more general purpose soon.
+*/
+#define NRRD_COORD_UPDATE(coord, size, dim) \
+do { \
+ unsigned int d; \
+ for (d=0; \
+ d < (dim)-1 && (coord)[d] == (size)[d]; \
+ d++) { \
+ (coord)[d] = 0; \
+ (coord)[d+1]++; \
+ } \
+} while (0)
+
+/*
+******** NRRD_COORD_INCR
+**
+** same as NRRD_COORD_UPDATE, but starts by incrementing coord[idx]
+*/
+#define NRRD_COORD_INCR(coord, size, dim, idx) \
+do { \
+ unsigned int d; \
+ for (d=idx, (coord)[d]++; \
+ d < (dim)-1 && (coord)[d] == (size)[d]; \
+ d++) { \
+ (coord)[d] = 0; \
+ (coord)[d+1]++; \
+ } \
+} while (0)
+
+/*
+******** NRRD_INDEX_GEN
+**
+** Given a coordinate array "coord", as well as the array sizes "size"
+** and dimension "dim", calculates the linear index, and stores it in
+** "I".
+*/
+#define NRRD_INDEX_GEN(I, coord, size, dim) \
+do { \
+ int d; \
+ for (d=(dim)-1, (I)=(coord)[d--]; \
+ d >= 0; \
+ d--) { \
+ (I) = (coord)[d] + (size)[d]*(I); \
+ } \
+} while (0)
+
+/*
+******** NRRD_COORD_GEN
+**
+** opposite of NRRD_INDEX_GEN: going from linear index "I" to
+** coordinate array "coord".
+**
+** HUGE NOTE: the I argument will end up as ZERO when this is done!
+** If passing a loop control variable, pass a copy instead!
+** Hello, side-effects! This is awful!
+*/
+#define NRRD_COORD_GEN(coord, size, dim, I) \
+do { \
+ unsigned int d; \
+ for (d=0; d<=(dim)-1; d++) { \
+ (coord)[d] = I % (size)[d]; \
+ I /= (size)[d]; \
+ } \
+} while (0)
+
+#ifdef __cplusplus
+}
+#endif
+
+
+
+#include <errno.h>
+
+
+#include <stddef.h> /* for ptrdiff_t */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define NRRD nrrdBiffKey
+
+/*
+******** NrrdAxis struct
+**
+** all the information which can sensibly be associated with
+** one axis of a nrrd. The only member which MUST be explicitly
+** set to something meaningful is "size".
+**
+** If an axis lies conceptually along some direction in an enclosing
+** space of dimension nrrd->spaceDim, then the first nrrd->spaceDim
+** entries of spaceDirection[] must be non-NaN, and min, max, spacing,
+** and units must NOT be set; thickness, center, and label can still
+** be used. The mutual exclusion between axis-aligned and general
+** direction information is enforced per-axis, not per-array.
+**
+** The min and max values give the range of positions "represented"
+** by the samples along this axis. In node-centering, "min" IS the
+** position at the lowest index. In cell-centering, the position at
+** the lowest index is between min and max (a touch bigger than min,
+** assuming min < max).
+**
+** There needs to be a one-to-one correspondence between these variables
+** and the nrrdAxisInfo* enum (nrrdEnums.h), the per-axis header fields
+** (see nrrdField* enum in nrrdEnums.h), and the various methods in axis.c
+*/
+typedef struct {
+ size_t size; /* number of elements along each axis */
+ double spacing; /* if non-NaN, distance between samples */
+ double thickness; /* if non-NaN, nominal thickness of region
+ represented by one sample along the axis. No
+ semantics relative to spacing are assumed or
+ imposed, and unlike spacing, there is no
+ sensible way to alter thickness- it is either
+ copied (as with cropping and slicing) or set to
+ NaN (when resampled). */
+ double min, max; /* if non-NaN, range of positions spanned by the
+ samples on this axis. Obviously, one can set
+ "spacing" to something incompatible with min
+ and max: the idea is that only one (min and
+ max, or spacing) should be taken to be
+ significant at any time. */
+ double spaceDirection[NRRD_SPACE_DIM_MAX];
+ /* the vector, in "space" (as described by
+ nrrd->space and/or nrrd->spaceDim), from one
+ sample to the next sample along this axis. It
+ is the column vector of the transform from
+ index space to "space" space */
+ int center; /* cell vs. node centering (value should be one of
+ nrrdCenter{Unknown,Node,Cell} */
+ int kind; /* what kind of information is along this axis
+ (from the nrrdKind* enum) */
+ char *label, /* short info string for each axis */
+ *units; /* string identifying the unit */
+} NrrdAxisInfo;
+
+/*
+******** Nrrd struct
+**
+** The struct used to wrap around the raw data array
+*/
+typedef struct {
+ /*
+ ** NECESSARY information describing the main array. This is
+ ** generally set at the same time that either the nrrd is created,
+ ** or at the time that the nrrd is wrapped around an existing array
+ */
+
+ void *data; /* the data in memory */
+ int type; /* a value from the nrrdType enum */
+ unsigned int dim; /* the dimension (rank) of the array */
+
+ /*
+ ** All per-axis specific information
+ */
+ NrrdAxisInfo axis[NRRD_DIM_MAX]; /* axis[0] is the fastest axis in the scan-
+ line ordering, the one who's coordinates
+ change the fastest as the elements are
+ accessed in the order in which they
+ appear in memory */
+
+ /*
+ ** Optional information descriptive of whole array, some of which is
+ ** meaningfuly for only some uses of a nrrd
+ */
+ char *content; /* brief account of what this data is */
+ char *sampleUnits; /* units of measurement of the values
+ stored in the array itself (not the
+ array axes and not space coordinates).
+ The logical name might be "dataUnits",
+ but that's perhaps ambiguous. Note that
+ these units may apply to non-scalar
+ kinds (e.g. coefficients of a vector
+ have the same units) */
+ int space; /* from nrrdSpace* enum, and often
+ implies the value of spaceDim */
+ unsigned int spaceDim; /* if non-zero, the dimension of the space
+ in which the regular sampling grid
+ conceptually lies. This is a separate
+ variable because this dimension can be
+ different than the array dimension.
+ The non-zero-ness of this value is in
+ fact the primary indicator that space
+ and orientation information is set.
+ This identifies the number of entries in
+ "origin" and the per-axis "direction"
+ vectors that are taken as meaningful */
+ char *spaceUnits[NRRD_SPACE_DIM_MAX];
+ /* units for coordinates of space */
+ double spaceOrigin[NRRD_SPACE_DIM_MAX];
+ /* the location of the center the first
+ (lowest memory address) array sample,
+ regardless of node-vs-cell centering */
+ double measurementFrame[NRRD_SPACE_DIM_MAX][NRRD_SPACE_DIM_MAX];
+ /* if spaceDim is non-zero, this may store
+ a spaceDim-by-spaceDim matrix which
+ transforms vector/matrix coefficients
+ in the "measurement frame" to those in
+ the world space described by spaceDim
+ (and hopefully space). Coeff [i][j] is
+ column i and row j. There are no
+ semantics linking this to the "kind" of
+ any axis, for a variety of reasons */
+ size_t blockSize; /* for nrrdTypeBlock, block byte size */
+ double oldMin, oldMax; /* if non-NaN, and if nrrd is of integral
+ type, extremal values for the array
+ BEFORE it was quantized */
+ void *ptr; /* never read or set by nrrd; use/abuse
+ as you see fit */
+
+ /*
+ ** Comments. Read from, and written to, header.
+ ** The comment array "cmt" is NOT NULL-terminated.
+ ** The number of comments is cmtArr->len.
+ */
+ char **cmt;
+ airArray *cmtArr;
+
+ /*
+ ** Key-value pairs.
+ */
+ char **kvp;
+ airArray *kvpArr;
+} Nrrd;
+
+struct NrrdIoState_t;
+struct NrrdEncoding_t;
+
+/*
+******** NrrdFormat
+**
+** All information and behavior relevent to one datafile format
+*/
+typedef struct {
+ char name[AIR_STRLEN_SMALL]; /* short identifying string */
+ int isImage, /* this format is intended solely for "2D" images, which
+ controls the invocation of _nrrdReshapeUpGrayscale()
+ if nrrdStateGrayscaleImage3D */
+ readable, /* we can read as well as write this format */
+ usesDIO; /* this format can use Direct IO */
+
+ /* tests if this format is currently available in this build */
+ int (*available)(void);
+
+ /* (for writing) returns non-zero if a given filename could likely be
+ represented by this format */
+ int (*nameLooksLike)(const char *filename);
+
+ /* (for writing) returns non-zero if a given nrrd/encoding pair will fit
+ in this format */
+ int (*fitsInto)(const Nrrd *nrrd, const struct NrrdEncoding_t *encoding,
+ int useBiff);
+
+ /* (for reading) returns non-zero if what has been read in so far
+ is recognized as the beginning of this format */
+ int (*contentStartsLike)(struct NrrdIoState_t *nio);
+
+ /* reader and writer */
+ int (*read)(FILE *file, Nrrd *nrrd, struct NrrdIoState_t *nio);
+ int (*write)(FILE *file, const Nrrd *nrrd, struct NrrdIoState_t *nio);
+} NrrdFormat;
+
+/*
+******** NrrdEncoding
+**
+** All information and behavior relevent to one way of encoding data
+**
+** The data readers are responsible for memory allocation.
+** This is necessitated by the memory restrictions of direct I/O
+*/
+typedef struct NrrdEncoding_t {
+ char name[AIR_STRLEN_SMALL], /* short identifying string */
+ suffix[AIR_STRLEN_SMALL]; /* costumary filename suffix */
+ int endianMatters,
+ isCompression;
+ int (*available)(void);
+ /* The "data" and "elementNum" values have to be passed explicitly
+ to read/wrote because they will be different from nrrd->data and
+ nrrdElementNumber(nrrd) in the case of multiple data files. You
+ might think that the only other thing required to be passed is
+ nrrdElementSize(nrrd), but no, it is in fact best to pass the
+ whole Nrrd, instead of just certain attributes. The stupid details:
+ nrrd->dim: needed to know whether to put one value per line
+ in case of 1-D nrrdEncodingAscii
+ nrrd->axis[0].size: need for proper formatting of nrrdEncodingAscii
+ nrrd->type: needed for nrrdEncodingAscii, since its action is
+ entirely parameterized by type
+ nrrd->blockSize: needed for nrrdElementSize in case of nrrdTypeBlock */
+ int (*read)(FILE *file, void *data, size_t elementNum,
+ Nrrd *nrrd, struct NrrdIoState_t *nio);
+ int (*write)(FILE *file, const void *data, size_t elementNum,
+ const Nrrd *nrrd, struct NrrdIoState_t *nio);
+} NrrdEncoding;
+
+/*
+******** NrrdIoState struct
+**
+** Everything relating to how the nrrd is read and written.
+** Multiple parameters for writing are set here (like format, encoding,
+** zlib parameters). Also, this is the place where those few parameters
+** of reading are stored (like skipData and keepNrrdDataFileOpen). Also,
+** after the nrrd has been read, it is a potentially useful record of what
+** it took to read it in.
+*/
+typedef struct NrrdIoState_t {
+ char *path, /* allows us to remember the directory
+ from whence this nrrd was "load"ed, or
+ to whence this nrrd is "save"ed, MINUS the
+ trailing "/", so as to facilitate games with
+ header-relative data files */
+ *base, /* when "save"ing a nrrd into seperate
+ header and data, the name of the header
+ file (e.g. "output.nhdr") MINUS the ".nhdr".
+ This is massaged to produce a header-
+ relative data filename. */
+ *line, /* buffer for saving one line from file */
+ *dataFNFormat, /* if non-NULL, the format string (containing
+ something like "%d" as a substring) to be
+ used to identify multiple detached datafiles.
+ NB: This is "format" in the sense of a printf-
+ style format string, not in the sense of a
+ file format. This may need header-relative
+ path processing. */
+ **dataFN; /* ON READ + WRITE: array of data filenames. These
+ are not passed directly to fopen, they may need
+ header-relative path processing. Like the
+ cmtArr in the Nrrd, this array is not NULL-
+ terminated */
+ airArray *dataFNArr; /* for managing the above */
+
+ FILE *headerFile, /* if non-NULL, the file from which the NRRD
+ header is being read */
+ *dataFile; /* this used to be a central part of how the
+ I/O code worked, but now it is simply the
+ place to store the dataFile in the case of
+ keepNrrdDataFileOpen */
+ unsigned int dataFileDim, /* The dimension of the data in each data file.
+ Together with dataFNArr->len, this determines
+ how many bytes should be in each data file */
+ lineLen, /* allocated size of line, including the
+ last character for \0 */
+ charsPerLine, /* when writing ASCII data in which we
+ intend only to write a huge long list
+ of numbers whose text formatting
+ implies nothing, then how many
+ characters do we limit ourselves to per
+ line */
+ valsPerLine, /* when writing ASCII data in which we DO
+ intend to sigify (or at least hint at)
+ something with the formatting, then
+ what is the max number of values to
+ write on a line */
+ lineSkip; /* if dataFile non-NULL, the number of
+ lines in dataFile that should be
+ skipped over (so as to bypass another
+ form of ASCII header preceeding raw
+ data) */
+ int dataFNMin, /* used with dataFNFormat to identify ...*/
+ dataFNMax, /* ... all the multiple detached datafiles */
+ dataFNStep, /* how to step from max to min */
+ dataFNIndex, /* which of the data files are being read */
+ pos, /* line[pos] is beginning of stuff which
+ still has yet to be parsed */
+ endian, /* endian-ness of the data in file, for
+ those encoding/type combinations for
+ which it matters (from nrrdEndian) */
+ byteSkip, /* exactly like lineSkip, but bytes
+ instead of lines. First the lines are
+ skipped, then the bytes */
+ seen[NRRD_FIELD_MAX+1], /* for error checking in header parsing */
+ detachedHeader, /* ON WRITE: request for file (NRRD format only)
+ to be split into distinct header and data.
+ This only has an effect if detaching the header
+ is not already necessary, as it is with multiple
+ data files */
+ bareText, /* when writing a plain text file, is there any
+ effort made to record the nrrd struct
+ info in the text file */
+ skipData, /* if non-zero (all formats):
+ ON READ: don't allocate memory for, and don't
+ read in, the data portion of the file (but we
+ do verify that for nrrds, detached datafiles
+ can be opened). Note: Does NOT imply
+ keepNrrdDataFileOpen. Warning: resulting
+ nrrd struct will have "data" pointer NULL.
+ ON WRITE: don't write data portion of file
+ (for nrrds, don't even try to open detached
+ datafiles). Warning: can result in broken
+ noncomformant files.
+ (be careful with this) */
+ keepNrrdDataFileOpen, /* ON READ: when there is only a single dataFile,
+ don't close nio->dataFile when
+ you otherwise would, when reading the
+ nrrd format. Probably used in conjunction with
+ skipData. (currently for "unu data")
+ ON WRITE: no semantics */
+ zlibLevel, /* zlib compression level (0-9, -1 for
+ default[6], 0 for no compression). */
+ zlibStrategy, /* zlib compression strategy, can be one
+ of the nrrdZlibStrategy enums, default is
+ nrrdZlibStrategyDefault. */
+ bzip2BlockSize; /* block size used for compression,
+ roughly equivalent to better but slower
+ (1-9, -1 for default[9]). */
+ void *oldData; /* ON READ: if non-NULL, pointer to space that
+ has already been allocated for oldDataSize */
+ size_t oldDataSize; /* ON READ: size of mem pointed to by oldData */
+
+ /* The format and encoding. These are initialized to nrrdFormatUnknown
+ and nrrdEncodingUnknown, respectively. USE THESE VALUES for
+ any kind of initialization or flagging; DO NOT USE NULL */
+ const NrrdFormat *format;
+ const NrrdEncoding *encoding;
+} NrrdIoState;
+
+
+/******** defaults (nrrdDef..) and state (nrrdState..) */
+/* defaultsNrrd.c */
+TEEM_API const NrrdEncoding *nrrdDefWriteEncoding;
+TEEM_API int nrrdDefWriteBareText;
+TEEM_API int nrrdDefWriteCharsPerLine;
+TEEM_API int nrrdDefWriteValsPerLine;
+TEEM_API int nrrdDefCenter;
+TEEM_API double nrrdDefSpacing;
+TEEM_API int nrrdStateVerboseIO;
+TEEM_API int nrrdStateAlwaysSetContent;
+TEEM_API int nrrdStateDisableContent;
+TEEM_API char *nrrdStateUnknownContent;
+TEEM_API int nrrdStateGrayscaleImage3D;
+TEEM_API int nrrdStateKeyValueReturnInternalPointers;
+TEEM_API int nrrdStateKindNoop;
+
+/******** all the airEnums used through-out nrrd */
+/*
+** the actual C enums are in nrrdEnums.h; experience has shown that it
+** is not particularly useful to name those enums, since the shortest
+** name is best used for the airEnums here
+*/
+/* enumsNrrd.c */
+TEEM_API airEnum *nrrdFormatType;
+TEEM_API airEnum *nrrdType;
+TEEM_API airEnum *nrrdEncodingType;
+TEEM_API airEnum *nrrdCenter;
+TEEM_API airEnum *nrrdKind;
+TEEM_API airEnum *nrrdField;
+TEEM_API airEnum *nrrdSpace;
+
+/******** arrays of things (poor-man's functions/predicates) */
+/* arraysNrrd.c */
+TEEM_API const char nrrdTypePrintfStr[][AIR_STRLEN_SMALL];
+TEEM_API const size_t nrrdTypeSize[];
+TEEM_API const double nrrdTypeMin[];
+TEEM_API const double nrrdTypeMax[];
+TEEM_API const int nrrdTypeIsIntegral[];
+TEEM_API const int nrrdTypeIsUnsigned[];
+TEEM_API const double nrrdTypeNumberOfValues[];
+
+/******** pseudo-constructors, pseudo-destructors, and such */
+/* methodsNrrd.c */
+TEEM_API NrrdIoState *nrrdIoStateNew(void);
+TEEM_API void nrrdIoStateInit(NrrdIoState *nio);
+TEEM_API NrrdIoState *nrrdIoStateNix(NrrdIoState *nio);
+TEEM_API void nrrdInit(Nrrd *nrrd);
+TEEM_API Nrrd *nrrdNew(void);
+TEEM_API Nrrd *nrrdNix(Nrrd *nrrd);
+TEEM_API Nrrd *nrrdEmpty(Nrrd *nrrd);
+TEEM_API Nrrd *nrrdNuke(Nrrd *nrrd);
+TEEM_API int nrrdWrap_nva(Nrrd *nrrd, void *data, int type,
+ unsigned int dim, const size_t *size);
+TEEM_API int nrrdWrap(Nrrd *nrrd, void *data, int type, unsigned int dim,
+ ... /* sx, sy, .., axis(dim-1) size */);
+TEEM_API void nrrdBasicInfoInit(Nrrd *nrrd, int excludeBitflag);
+TEEM_API int nrrdBasicInfoCopy(Nrrd *nout, const Nrrd *nin,
+ int excludeBitflag);
+TEEM_API int nrrdCopy(Nrrd *nout, const Nrrd *nin);
+TEEM_API int nrrdAlloc_nva(Nrrd *nrrd, int type, unsigned int dim,
+ const size_t *size);
+TEEM_API int nrrdAlloc(Nrrd *nrrd, int type, unsigned int dim,
+ ... /* sx, sy, .., axis(dim-1) size */);
+TEEM_API int nrrdMaybeAlloc_nva(Nrrd *nrrd, int type, unsigned int dim,
+ const size_t *size);
+TEEM_API int nrrdMaybeAlloc(Nrrd *nrrd, int type, unsigned int dim,
+ ... /* sx, sy, .., axis(dim-1) size */);
+TEEM_API int nrrdPPM(Nrrd *, size_t sx, size_t sy);
+TEEM_API int nrrdPGM(Nrrd *, size_t sx, size_t sy);
+
+/******** axis info related */
+/* axis.c */
+TEEM_API int nrrdKindIsDomain(int kind);
+TEEM_API unsigned int nrrdKindSize(int kind);
+TEEM_API int nrrdAxisInfoCopy(Nrrd *nout, const Nrrd *nin,
+ const int *axmap, int excludeBitflag);
+TEEM_API void nrrdAxisInfoSet_nva(Nrrd *nin, int axInfo, const void *info);
+TEEM_API void nrrdAxisInfoSet(Nrrd *nin, int axInfo,
+ ... /* const void* */);
+TEEM_API void nrrdAxisInfoGet_nva(const Nrrd *nrrd, int axInfo, void *info);
+TEEM_API void nrrdAxisInfoGet(const Nrrd *nrrd, int axInfo,
+ ... /* void* */);
+TEEM_API double nrrdAxisInfoPos(const Nrrd *nrrd, unsigned int ax, double idx);
+TEEM_API double nrrdAxisInfoIdx(const Nrrd *nrrd, unsigned int ax, double pos);
+TEEM_API void nrrdAxisInfoPosRange(double *loP, double *hiP,
+ const Nrrd *nrrd, unsigned int ax,
+ double loIdx, double hiIdx);
+TEEM_API void nrrdAxisInfoIdxRange(double *loP, double *hiP,
+ const Nrrd *nrrd, unsigned int ax,
+ double loPos, double hiPos);
+TEEM_API void nrrdAxisInfoSpacingSet(Nrrd *nrrd, unsigned int ax);
+TEEM_API void nrrdAxisInfoMinMaxSet(Nrrd *nrrd, unsigned int ax,
+ int defCenter);
+TEEM_API unsigned int nrrdDomainAxesGet(Nrrd *nrrd,
+ unsigned int axisIdx[NRRD_DIM_MAX]);
+TEEM_API unsigned int nrrdRangeAxesGet(Nrrd *nrrd,
+ unsigned int axisIdx[NRRD_DIM_MAX]);
+TEEM_API int nrrdSpacingCalculate(const Nrrd *nrrd, unsigned int ax,
+ double *spacing,
+ double vector[NRRD_SPACE_DIM_MAX]);
+
+/******** simple things */
+/* simple.c */
+TEEM_API const char *nrrdBiffKey;
+TEEM_API unsigned int nrrdSpaceDimension(int space);
+TEEM_API int nrrdSpaceSet(Nrrd *nrrd, int space);
+TEEM_API int nrrdSpaceDimensionSet(Nrrd *nrrd, unsigned int spaceDim);
+TEEM_API void nrrdSpaceGet(const Nrrd *nrrd, int *space,
+ unsigned int *spaceDim);
+TEEM_API unsigned int nrrdSpaceOriginGet(const Nrrd *nrrd,
+ double vector[NRRD_SPACE_DIM_MAX]);
+TEEM_API int nrrdSpaceOriginSet(Nrrd *nrrd,
+ double vector[NRRD_SPACE_DIM_MAX]);
+TEEM_API int nrrdOriginCalculate(const Nrrd *nrrd,
+ unsigned int *axisIdx,
+ unsigned int axisIdxNum,
+ int defaultCenter, double *origin);
+TEEM_API int nrrdContentSet(Nrrd *nout, const char *func,
+ const Nrrd *nin, const char *format,
+ ... /* printf-style arg list */ );
+TEEM_API void nrrdDescribe(FILE *file, const Nrrd *nrrd);
+TEEM_API int nrrdCheck(const Nrrd *nrrd);
+TEEM_API int _nrrdCheck(const Nrrd *nrrd, int checkData, int useBiff);
+TEEM_API size_t nrrdElementSize(const Nrrd *nrrd);
+TEEM_API size_t nrrdElementNumber(const Nrrd *nrrd);
+TEEM_API int nrrdSanity(void);
+TEEM_API int nrrdSameSize(const Nrrd *n1, const Nrrd *n2, int useBiff);
+
+/******** comments related */
+/* comment.c */
+TEEM_API int nrrdCommentAdd(Nrrd *nrrd, const char *str);
+TEEM_API void nrrdCommentClear(Nrrd *nrrd);
+TEEM_API int nrrdCommentCopy(Nrrd *nout, const Nrrd *nin);
+
+/******** key/value pairs */
+/* keyvalue.c */
+TEEM_API unsigned int nrrdKeyValueSize(const Nrrd *nrrd);
+TEEM_API int nrrdKeyValueAdd(Nrrd *nrrd, const char *key, const char *value);
+TEEM_API char *nrrdKeyValueGet(const Nrrd *nrrd, const char *key);
+TEEM_API void nrrdKeyValueIndex(const Nrrd *nrrd,
+ char **keyP, char **valueP, unsigned int ki);
+TEEM_API int nrrdKeyValueErase(Nrrd *nrrd, const char *key);
+TEEM_API void nrrdKeyValueClear(Nrrd *nrrd);
+TEEM_API int nrrdKeyValueCopy(Nrrd *nout, const Nrrd *nin);
+
+/******** endian related */
+/* endianNrrd.c */
+TEEM_API void nrrdSwapEndian(Nrrd *nrrd);
+
+/******** getting information to and from files */
+/* formatXXX.c */
+TEEM_API const NrrdFormat *const nrrdFormatNRRD;
+TEEM_API const NrrdFormat *const nrrdFormatPNM;
+TEEM_API const NrrdFormat *const nrrdFormatPNG;
+TEEM_API const NrrdFormat *const nrrdFormatVTK;
+TEEM_API const NrrdFormat *const nrrdFormatText;
+TEEM_API const NrrdFormat *const nrrdFormatEPS;
+/* format.c */
+TEEM_API const NrrdFormat *const nrrdFormatUnknown;
+TEEM_API const NrrdFormat *
+ const nrrdFormatArray[NRRD_FORMAT_TYPE_MAX+1];
+/* encodingXXX.c */
+TEEM_API const NrrdEncoding *const nrrdEncodingRaw;
+TEEM_API const NrrdEncoding *const nrrdEncodingAscii;
+TEEM_API const NrrdEncoding *const nrrdEncodingHex;
+TEEM_API const NrrdEncoding *const nrrdEncodingGzip;
+TEEM_API const NrrdEncoding *const nrrdEncodingBzip2;
+/* encoding.c */
+TEEM_API const NrrdEncoding *const nrrdEncodingUnknown;
+TEEM_API const NrrdEncoding *
+ const nrrdEncodingArray[NRRD_ENCODING_TYPE_MAX+1];
+/* parseNrrd.c */
+/* this needs the "FILE *file" first arg for the sole reason that
+ parsing a "data file: " field which identifies a LIST must then
+ read in all the data filenames from the same file */
+TEEM_API int (*nrrdFieldInfoParse[NRRD_FIELD_MAX+1])(FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio,
+ int useBiff);
+/* read.c */
+TEEM_API int nrrdLineSkip(FILE *dataFile, NrrdIoState *nio);
+TEEM_API int nrrdByteSkip(FILE *dataFile, Nrrd *nrrd, NrrdIoState *nio);
+TEEM_API int nrrdLoad(Nrrd *nrrd, const char *filename, NrrdIoState *nio);
+TEEM_API int nrrdRead(Nrrd *nrrd, FILE *file, NrrdIoState *nio);
+/* write.c */
+TEEM_API int nrrdIoStateSet(NrrdIoState *nio, int parm, int value);
+TEEM_API int nrrdIoStateEncodingSet(NrrdIoState *nio,
+ const NrrdEncoding *encoding);
+TEEM_API int nrrdIoStateFormatSet(NrrdIoState *nio,
+ const NrrdFormat *format);
+TEEM_API int nrrdIoStateGet(NrrdIoState *nio, int parm);
+TEEM_API const NrrdEncoding *nrrdIoStateEncodingGet(NrrdIoState *nio);
+TEEM_API const NrrdFormat *nrrdIoStateFormatGet(NrrdIoState *nio);
+TEEM_API int nrrdSave(const char *filename, const Nrrd *nrrd,
+ NrrdIoState *nio);
+TEEM_API int nrrdWrite(FILE *file, const Nrrd *nrrd,
+ NrrdIoState *nio);
+
+/******** getting value into and out of an array of general type, and
+ all other simplistic functionality pseudo-parameterized by type */
+/* accessors.c */
+TEEM_API int (*nrrdILoad[NRRD_TYPE_MAX+1])(const void *v);
+TEEM_API float (*nrrdFLoad[NRRD_TYPE_MAX+1])(const void *v);
+TEEM_API double (*nrrdDLoad[NRRD_TYPE_MAX+1])(const void *v);
+TEEM_API int (*nrrdIStore[NRRD_TYPE_MAX+1])(void *v, int j);
+TEEM_API float (*nrrdFStore[NRRD_TYPE_MAX+1])(void *v, float f);
+TEEM_API double (*nrrdDStore[NRRD_TYPE_MAX+1])(void *v, double d);
+TEEM_API int (*nrrdILookup[NRRD_TYPE_MAX+1])(const void *v, size_t I);
+TEEM_API float (*nrrdFLookup[NRRD_TYPE_MAX+1])(const void *v, size_t I);
+TEEM_API double (*nrrdDLookup[NRRD_TYPE_MAX+1])(const void *v, size_t I);
+TEEM_API int (*nrrdIInsert[NRRD_TYPE_MAX+1])(void *v, size_t I, int j);
+TEEM_API float (*nrrdFInsert[NRRD_TYPE_MAX+1])(void *v, size_t I, float f);
+TEEM_API double (*nrrdDInsert[NRRD_TYPE_MAX+1])(void *v, size_t I, double d);
+TEEM_API int (*nrrdSprint[NRRD_TYPE_MAX+1])(char *, const void *);
+
+
+/******** permuting, shuffling, and all flavors of reshaping */
+/* reorder.c */
+TEEM_API int nrrdAxesInsert(Nrrd *nout, const Nrrd *nin, unsigned int ax);
+TEEM_API int nrrdInvertPerm(unsigned int *invp, const unsigned int *perm,
+ unsigned int n);
+TEEM_API int nrrdAxesPermute(Nrrd *nout, const Nrrd *nin,
+ const unsigned int *axes);
+TEEM_API int nrrdShuffle(Nrrd *nout, const Nrrd *nin, unsigned int axis,
+ const size_t *perm);
+
+/******** sampling, slicing, cropping */
+/* subset.c */
+TEEM_API int nrrdSlice(Nrrd *nout, const Nrrd *nin,
+ unsigned int axis, size_t pos);
+TEEM_API int nrrdCrop(Nrrd *nout, const Nrrd *nin,
+ size_t *min, size_t *max);
+
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/NrrdIO_Srcs.txt b/Utilities/ITK/Utilities/NrrdIO/NrrdIO_Srcs.txt
new file mode 100644
index 0000000000000000000000000000000000000000..6648680a308577ffbd2385eacfed0502607d6f5d
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/NrrdIO_Srcs.txt
@@ -0,0 +1 @@
+754.c mop.c array.c parseAir.c dio.c sane.c endianAir.c string.c enum.c miscAir.c biffbiff.c accessors.c defaultsNrrd.c enumsNrrd.c arraysNrrd.c methodsNrrd.c reorder.c axis.c simple.c comment.c keyvalue.c endianNrrd.c parseNrrd.c gzio.c read.c write.c format.c formatNRRD.c encoding.c encodingRaw.c encodingAscii.c encodingHex.c encodingGzip.c subset.c encodingBzip2.c formatEPS.c formatPNG.c formatPNM.c formatText.c formatVTK.c
diff --git a/Utilities/ITK/Utilities/NrrdIO/accessors.c b/Utilities/ITK/Utilities/NrrdIO/accessors.c
new file mode 100644
index 0000000000000000000000000000000000000000..9b0c0968ec182370c60282382594195647f72dc8
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/accessors.c
@@ -0,0 +1,228 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+#include "float.h"
+
+/*
+** making these typedefs here allows us to used one token for both
+** constructing function names, and for specifying argument types
+*/
+typedef signed char CH;
+typedef unsigned char UC;
+typedef signed short SH;
+typedef unsigned short US;
+/* Microsoft apparently uses 'IN' as a keyword, so we changed 'IN' to 'JN'. */
+typedef signed int JN;
+typedef unsigned int UI;
+typedef airLLong LL;
+/* ui64 to double conversion is not implemented, sorry */
+#if _MSC_VER < 1300
+typedef airLLong UL;
+#else
+typedef airULLong UL;
+#endif
+typedef float FL;
+typedef double DB;
+
+#define MAP(F, A) \
+F(A, CH) \
+F(A, UC) \
+F(A, SH) \
+F(A, US) \
+F(A, JN) \
+F(A, UI) \
+F(A, LL) \
+F(A, UL) \
+F(A, FL) \
+F(A, DB)
+
+/*
+** _nrrdLoad<TA><TB>(<TB> *v)
+**
+** Dereferences v as TB*, casts it to TA, returns it.
+*/
+#define LOAD_DEF(TA, TB) \
+TA \
+_nrrdLoad##TA##TB(TB *v) { \
+ return (TA)(*v); \
+}
+#define LOAD_LIST(TA, TB) \
+ (TA (*)(const void *))_nrrdLoad##TA##TB,
+
+MAP(LOAD_DEF, JN)
+MAP(LOAD_DEF, FL)
+MAP(LOAD_DEF, DB)
+
+int (*
+nrrdILoad[NRRD_TYPE_MAX+1])(const void*) = {
+ NULL, MAP(LOAD_LIST, JN) NULL
+};
+float (*
+nrrdFLoad[NRRD_TYPE_MAX+1])(const void*) = {
+ NULL, MAP(LOAD_LIST, FL) NULL
+};
+double (*
+nrrdDLoad[NRRD_TYPE_MAX+1])(const void*) = {
+ NULL, MAP(LOAD_LIST, DB) NULL
+};
+
+
+/*
+** _nrrdStore<TA><TB>(<TB> *v, <TA> j)
+**
+** Takes a TA j, and stores it in *v, thereby implicitly casting it to TB.
+** Returns the result of the assignment, which may not be the same as
+** the value that was passed in.
+*/
+#define STORE_DEF(TA, TB) \
+TA \
+_nrrdStore##TA##TB(TB *v, TA j) { \
+ return (TA)(*v = (TB)j); \
+}
+#define STORE_LIST(TA, TB) \
+ (TA (*)(void *, TA))_nrrdStore##TA##TB,
+
+MAP(STORE_DEF, JN)
+MAP(STORE_DEF, FL)
+MAP(STORE_DEF, DB)
+
+int (*
+nrrdIStore[NRRD_TYPE_MAX+1])(void *, int) = {
+ NULL, MAP(STORE_LIST, JN) NULL
+};
+float (*
+nrrdFStore[NRRD_TYPE_MAX+1])(void *, float) = {
+ NULL, MAP(STORE_LIST, FL) NULL
+};
+double (*
+nrrdDStore[NRRD_TYPE_MAX+1])(void *, double) = {
+ NULL, MAP(STORE_LIST, DB) NULL
+};
+
+
+/*
+** _nrrdLookup<TA><TB>(<TB> *v, size_t I)
+**
+** Looks up element I of TB array v, and returns it cast to a TA.
+*/
+#define LOOKUP_DEF(TA, TB) \
+TA \
+_nrrdLookup##TA##TB(TB *v, size_t I) { \
+ return (TA)v[I]; \
+}
+#define LOOKUP_LIST(TA, TB) \
+ (TA (*)(const void*, size_t))_nrrdLookup##TA##TB,
+
+MAP(LOOKUP_DEF, JN)
+MAP(LOOKUP_DEF, FL)
+MAP(LOOKUP_DEF, DB)
+
+int (*
+nrrdILookup[NRRD_TYPE_MAX+1])(const void *, size_t) = {
+ NULL, MAP(LOOKUP_LIST, JN) NULL
+};
+float (*
+nrrdFLookup[NRRD_TYPE_MAX+1])(const void *, size_t) = {
+ NULL, MAP(LOOKUP_LIST, FL) NULL
+};
+double (*
+nrrdDLookup[NRRD_TYPE_MAX+1])(const void *, size_t) = {
+ NULL, MAP(LOOKUP_LIST, DB) NULL
+};
+
+
+/*
+** _nrrdInsert<TA><TB>(<TB> *v, size_t I, <TA> j)
+**
+** Given TA j, stores it in v[i] (implicitly casting to TB).
+** Returns the result of the assignment, which may not be the same as
+** the value that was passed in.
+*/
+#define INSERT_DEF(TA, TB) \
+TA \
+_nrrdInsert##TA##TB(TB *v, size_t I, TA j) { \
+ return (TA)(v[I] = (TB)j); \
+}
+#define INSERT_LIST(TA, TB) \
+ (TA (*)(void*, size_t, TA))_nrrdInsert##TA##TB,
+
+MAP(INSERT_DEF, JN)
+MAP(INSERT_DEF, FL)
+MAP(INSERT_DEF, DB)
+
+int (*
+nrrdIInsert[NRRD_TYPE_MAX+1])(void *, size_t, int) = {
+ NULL, MAP(INSERT_LIST, JN) NULL
+};
+float (*
+nrrdFInsert[NRRD_TYPE_MAX+1])(void *, size_t, float) = {
+ NULL, MAP(INSERT_LIST, FL) NULL
+};
+double (*
+nrrdDInsert[NRRD_TYPE_MAX+1])(void *, size_t, double) = {
+ NULL, MAP(INSERT_LIST, DB) NULL
+};
+
+/*
+******** nrrdSprint
+**
+** Dereferences pointer v and sprintf()s that value into given string s,
+** returns the result of sprintf()
+*/
+int _nrrdSprintCH(char *s, const CH *v) { return sprintf(s, "%d", *v); }
+int _nrrdSprintUC(char *s, const UC *v) { return sprintf(s, "%u", *v); }
+int _nrrdSprintSH(char *s, const SH *v) { return sprintf(s, "%d", *v); }
+int _nrrdSprintUS(char *s, const US *v) { return sprintf(s, "%u", *v); }
+int _nrrdSprintIN(char *s, const JN *v) { return sprintf(s, "%d", *v); }
+int _nrrdSprintUI(char *s, const UI *v) { return sprintf(s, "%u", *v); }
+int _nrrdSprintLL(char *s, const LL *v) {
+ return sprintf(s, AIR_LLONG_FMT, *v);
+}
+int _nrrdSprintUL(char *s, const UL *v) {
+ return sprintf(s, AIR_ULLONG_FMT, *v);
+}
+/* HEY: sizeof(float) and sizeof(double) assumed here, since we're
+ basing "8" and "17" on 6 == FLT_DIG and 15 == DBL_DIG, which are
+ digits of precision for floats and doubles, respectively */
+int _nrrdSprintFL(char *s, const FL *v) {
+ return airSinglePrintf(NULL, s, "%.8g", (double)(*v)); }
+int _nrrdSprintDB(char *s, const DB *v) {
+ return airSinglePrintf(NULL, s, "%.17g", *v); }
+int (*
+nrrdSprint[NRRD_TYPE_MAX+1])(char *, const void *) = {
+ NULL,
+ (int (*)(char *, const void *))_nrrdSprintCH,
+ (int (*)(char *, const void *))_nrrdSprintUC,
+ (int (*)(char *, const void *))_nrrdSprintSH,
+ (int (*)(char *, const void *))_nrrdSprintUS,
+ (int (*)(char *, const void *))_nrrdSprintIN,
+ (int (*)(char *, const void *))_nrrdSprintUI,
+ (int (*)(char *, const void *))_nrrdSprintLL,
+ (int (*)(char *, const void *))_nrrdSprintUL,
+ (int (*)(char *, const void *))_nrrdSprintFL,
+ (int (*)(char *, const void *))_nrrdSprintDB,
+ NULL};
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/array.c b/Utilities/ITK/Utilities/NrrdIO/array.c
new file mode 100644
index 0000000000000000000000000000000000000000..f728e25c094f32b80a8785238ce3207cf9486a55
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/array.c
@@ -0,0 +1,327 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+
+void
+_airLenSet(airArray *a, unsigned int len) {
+
+ a->len = len;
+ /* printf(" HEY: len = %d\n", a->len); */
+ if (a->lenP) {
+ *(a->lenP) = len;
+ /* printf(" HEY: *(a->lenP) = *(%lu) = %d\n",
+ (unsigned long)a->lenP, *(a->lenP)); */
+ }
+}
+
+void
+_airSetData(airArray *a, void *data) {
+
+ a->data = data;
+ if (a->dataP) {
+ *(a->dataP) = data;
+ }
+}
+
+/*
+******** airArrayNew()
+**
+** creates a new airArray struct and returns a pointer to it.
+** dataP is a pointer to the user's data pointer
+** lenP is a pointer to the user's array length variable (optional)
+** unit is the size (in bytes) of one element in the array
+** incr is the number of units by which the array will grow or shrink
+**
+** returns NULL on error, or the new airArray pointer if okay
+** errors: bogus arguments, or couldn't alloc airArray struct
+**
+** --> The user CAN NOT change the pointer variable (of which *dataP
+** is the address) after this is called, or else everything will
+** get all bolloxed up. The same goes for the array length
+** variable, if its address is passed- though in that case the
+** correct value will over-write any other.
+*/
+airArray *
+airArrayNew(void **dataP, unsigned int *lenP, size_t unit, unsigned int incr) {
+ airArray *a;
+
+ if (unit<=0 || incr<=0) {
+ return NULL;
+ }
+
+ a = (airArray *)calloc(1, sizeof(airArray));
+ if (!a) {
+ return NULL;
+ }
+
+ a->dataP = dataP;
+ _airSetData(a, NULL);
+ a->lenP = lenP;
+ _airLenSet(a, 0);
+ a->incr = incr;
+ a->unit = unit;
+ a->noReallocWhenSmaller = AIR_FALSE;
+
+ a->allocCB = NULL;
+ a->freeCB = NULL;
+ a->initCB = NULL;
+ a->doneCB = NULL;
+
+ return a;
+}
+
+/*
+******** airArrayStructCB()
+**
+** set callbacks to maintain array of structs
+*/
+void
+airArrayStructCB(airArray *a,
+ void (*initCB)(void *), void (*doneCB)(void *)) {
+
+ if (a) {
+ a->initCB = initCB;
+ a->doneCB = doneCB;
+ a->allocCB = NULL;
+ a->freeCB = NULL;
+ }
+}
+
+/*
+******** airArrayPointerCB()
+**
+** set callbacks to maintain array of pointers
+*/
+void
+airArrayPointerCB(airArray *a,
+ void *(*allocCB)(void), void *(*freeCB)(void *)) {
+
+ if (a) {
+ a->initCB = NULL;
+ a->doneCB = NULL;
+ a->allocCB = allocCB;
+ a->freeCB = freeCB;
+ }
+}
+
+/*
+******** airArrayLenPreSet()
+**
+** allocates the array to hold up to given length, without
+** actually changing the length. In order for this to be
+** useful, this also turns on noReallocWhenSmaller
+**
+** NB: this used to have a "boolean" return to indicate allocation
+** error, but nothing in Teem actually did the error checking. Now
+** conscientious users can look at NULL-ity of a->data to detect such
+** an error.
+*/
+void
+airArrayLenPreSet(airArray *a, unsigned int newlen) {
+ unsigned int newsize;
+ void *newdata;
+
+ if (!a) {
+ return;
+ }
+
+ if (newlen == 0) {
+ /* there is no pre-set length, turn off noReallocWhenSmaller */
+ a->noReallocWhenSmaller = AIR_FALSE;
+ } else {
+ newsize = (newlen-1)/a->incr + 1;
+ if (newsize > a->size) {
+ newdata = calloc(newsize*a->incr, a->unit);
+ if (!newdata) {
+ free(a->data);
+ _airSetData(a, NULL);
+ return;
+ }
+ memcpy(newdata, a->data, AIR_MIN(a->len*a->unit,
+ newsize*a->incr*a->unit));
+ free(a->data);
+ _airSetData(a, newdata);
+ a->size = newsize;
+ }
+ a->noReallocWhenSmaller = AIR_TRUE;
+ }
+
+ return;
+}
+
+/*
+******** airArrayLenSet()
+**
+** Set the length of the array, allocating or freeing as needed
+**
+** returns 1 on error, otherwise 0 if okay
+** possible errors: bogus arguments, or couldn't allocate new memory segment
+**
+** In case we can't allocate the new space, the old space is left untouched,
+** however if the new length is smaller, the free/done callbacks will
+** have been called on invalidated elements
+**
+** NB: this used to have a "boolean" return to indicate allocation
+** error, but almost nothing in Teem actually did the error checking.
+** Now conscientious users can look at NULL-ity of a->data to detect
+** such an error.
+*/
+void
+airArrayLenSet(airArray *a, unsigned int newlen) {
+ unsigned int newsize;
+ int ii;
+ void *addr, *newdata;
+
+ if (!a) {
+ /* user is a moron, what can you do */
+ return;
+ }
+
+ if (newlen == a->len) {
+ /* nothing to do */
+ return;
+ }
+
+ /* call freeCB/doneCB on all the elements which are going bye-bye */
+ if (newlen < a->len && (a->freeCB || a->doneCB)) {
+ for (ii=a->len-1; ii>=(int)newlen; ii--) {
+ addr = (char*)(a->data) + ii*a->unit;
+ if (a->freeCB) {
+ (a->freeCB)(*((void**)addr));
+ } else {
+ (a->doneCB)(addr);
+ }
+ }
+ }
+
+ newsize = newlen ? (newlen-1)/a->incr + 1 : 0;
+ if (newsize != a->size) {
+ /* we have to change the size of the array */
+ if (newsize) {
+ /* array should be bigger or smaller, but not zero-length */
+ if (newsize > a->size
+ || (newsize < a->size && !(a->noReallocWhenSmaller)) ) {
+ newdata = calloc(newsize*a->incr, a->unit);
+ if (!newdata) {
+ free(a->data);
+ _airSetData(a, NULL);
+ return;
+ }
+ memcpy(newdata, a->data, AIR_MIN(a->len*a->unit,
+ newsize*a->incr*a->unit));
+ free(a->data);
+ _airSetData(a, newdata);
+ a->size = newsize;
+ }
+ } else {
+ /* array should be zero-length */
+ free(a->data);
+ _airSetData(a, NULL);
+ a->size = newsize;
+ }
+ }
+ /* else new size is still within current allocated length,
+ and neither "size" nor "data" need to change */
+
+ /* call allocCB/initCB on newly created elements */
+ if (newlen > a->len && (a->allocCB || a->initCB)) {
+ for (ii=newlen; ii<(int)(a->len); ii++) {
+ addr = (char*)(a->data) + ii*a->unit;
+ if (a->allocCB) {
+ *((void**)addr) = (a->allocCB)();
+ } else {
+ (a->initCB)(addr);
+ }
+ }
+ }
+ _airLenSet(a, newlen);
+
+ return;
+}
+
+/*
+******** airArrayLenIncr()
+**
+** Like airArrayLenSet, but works with an increment instead of an
+** absolute length. Return value is different:
+** got NULL: return 0
+** allocation error: return 0, and a->data set to NULL
+** no error, delta > 0: return index of 1st element in newly allocated
+** segment (a->len before length was increased)
+** no error, delta <= 0: return 0, and a->data unchanged
+*/
+unsigned int
+airArrayLenIncr(airArray *a, int delta) {
+ unsigned int oldlen, ret;
+
+ if (!a) {
+ return 0;
+ }
+ if (delta < 0 && (unsigned int)(-delta) > a->len) {
+ /* error: asked for newlength to be negative */
+ airArrayLenSet(a, 0);
+ return 0;
+ }
+ oldlen = a->len;
+ airArrayLenSet(a, oldlen + delta);
+ if (!a->data) {
+ /* allocation error */
+ ret = 0;
+ } else {
+ ret = (delta <= 0 ? 0 : oldlen);
+ }
+
+ return ret;
+}
+
+/*
+******** airArrayNuke()
+**
+** free both the memory pointed to by the struct and the struct itself
+*/
+airArray *
+airArrayNuke(airArray *a) {
+
+ if (a) {
+ airArrayLenSet(a, 0);
+ free(a);
+ }
+ return NULL;
+}
+
+/*
+******** airArrayNix()
+**
+** frees just the struct, leaving the memory it points to untouched
+*/
+airArray *
+airArrayNix(airArray *a) {
+
+ if (a) {
+ free(a);
+ }
+ return NULL;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/arraysNrrd.c b/Utilities/ITK/Utilities/NrrdIO/arraysNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..d9e11585d64b1b7e054f2b4ca0c40299dce6cb29
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/arraysNrrd.c
@@ -0,0 +1,335 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/* learned: /usr/bin/c++ on mac (at least) won't actually put a
+const int blah[] array in an object file if it hasn't been declared
+as "extern" */
+
+const char
+nrrdTypePrintfStr[NRRD_TYPE_MAX+1][AIR_STRLEN_SMALL] = {
+ "%*d", /* what else? sscanf: skip, printf: use "minimum precision" */
+ "%d",
+ "%u",
+ "%hd",
+ "%hu",
+ "%d",
+ "%u",
+ AIR_LLONG_FMT,
+ AIR_ULLONG_FMT,
+ "%f",
+ "%lf",
+ "%*d" /* what else? */
+};
+
+/*
+** the setting of NRRD_TYPE_BIGGEST has to be in accordance with this
+*/
+const size_t
+nrrdTypeSize[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ 1, /* char */
+ 1, /* unsigned char */
+ 2, /* short */
+ 2, /* unsigned short */
+ 4, /* int */
+ 4, /* unsigned int */
+ 8, /* long long */
+ 8, /* unsigned long long */
+ 4, /* float */
+ 8, /* double */
+ 0 /* effectively unknown; user has to set explicitly */
+};
+
+const int
+nrrdTypeIsIntegral[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ 1, /* char */
+ 1, /* unsigned char */
+ 1, /* short */
+ 1, /* unsigned short */
+ 1, /* int */
+ 1, /* unsigned int */
+ 1, /* long long */
+ 1, /* unsigned long long */
+ 0, /* float */
+ 0, /* double */
+ 1 /* for some reason we pretend that blocks are integers */
+};
+
+const int
+nrrdTypeIsUnsigned[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ 0, /* char */
+ 1, /* unsigned char */
+ 0, /* short */
+ 1, /* unsigned short */
+ 0, /* int */
+ 1, /* unsigned int */
+ 0, /* long long */
+ 1, /* unsigned long long */
+ 0, /* float */
+ 0, /* double */
+ 0 /* for some reason we pretend that blocks are signed */
+};
+
+/*
+******** nrrdTypeMin[]
+******** nrrdTypeMax[]
+**
+** only intended for small (<= 32 bits) integral types,
+** so that we know how to "unquantize" integral values.
+** A 64-bit double can correctly store the 32-bit integral
+** mins and maxs, but gets the last few places wrong in the
+** 64-bit mins and max.
+*/
+const double
+nrrdTypeMin[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ SCHAR_MIN, /* char */
+ 0, /* unsigned char */
+ SHRT_MIN, /* short */
+ 0, /* unsigned short */
+ INT_MIN, /* int */
+ 0, /* unsigned int */
+ (double)NRRD_LLONG_MIN, /* long long */
+ 0, /* unsigned long long */
+ 0, /* float */
+ 0, /* double */
+ 0 /* punt */
+},
+nrrdTypeMax[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ SCHAR_MAX, /* char */
+ UCHAR_MAX, /* unsigned char */
+ SHRT_MAX, /* short */
+ USHRT_MAX, /* unsigned short */
+ INT_MAX, /* int */
+ UINT_MAX, /* unsigned int */
+ (double)NRRD_LLONG_MAX, /* long long */
+ (double)NRRD_ULLONG_MAX, /* unsigned long long */
+ 0, /* float */
+ 0, /* double */
+ 0 /* punt */
+};
+
+/*
+******** nrrdTypeNumberOfValues[]
+**
+** only meaningful for integral values, and only correct for
+** 32-bit values; tells the number of different integral values that
+** can be represented by the type
+*/
+const double
+nrrdTypeNumberOfValues[NRRD_TYPE_MAX+1] = {
+ 0, /* unknown */
+ UCHAR_MAX+1, /* char */
+ UCHAR_MAX+1, /* unsigned char */
+ USHRT_MAX+1, /* short */
+ USHRT_MAX+1, /* unsigned short */
+ (double)UINT_MAX+1, /* int */
+ (double)UINT_MAX+1, /* unsigned int */
+ (double)NRRD_ULLONG_MAX+1, /* long long */
+ (double)NRRD_ULLONG_MAX+1, /* unsigned long long */
+ 0, /* float */
+ 0, /* double */
+ 0 /* punt */
+};
+
+/*
+** _nrrdFieldValidInImage[]
+**
+** these fields are valid embedded in PNM and PNG comments
+** This does NOT include the fields who's values are constrained
+** by the image format (and in the case of PNM, magic) itself.
+*/
+const int
+_nrrdFieldValidInImage[NRRD_FIELD_MAX+1] = {
+ 0, /* nrrdField_unknown */
+ 1, /* nrrdField_comment */
+ 1, /* nrrdField_content */
+ 0, /* nrrdField_number */
+ 0, /* nrrdField_type */
+ 0, /* nrrdField_block_size */
+ 0, /* nrrdField_dimension */
+ 1, /* nrrdField_space */
+ 1, /* nrrdField_space_dimension */
+ 0, /* nrrdField_sizes */
+ 1, /* nrrdField_spacings */
+ 1, /* nrrdField_thicknesses */
+ 1, /* nrrdField_axis_mins */
+ 1, /* nrrdField_axis_maxs */
+ 1, /* nrrdField_space_directions */
+ 1, /* nrrdField_centers */
+ 1, /* nrrdField_kinds */
+ 1, /* nrrdField_labels */
+ 1, /* nrrdField_units */
+ 0, /* nrrdField_min */
+ 0, /* nrrdField_max */
+ 1, /* nrrdField_old_min */
+ 1, /* nrrdField_old_max */
+ 0, /* nrrdField_endian */
+ 0, /* nrrdField_encoding */
+ 0, /* nrrdField_line_skip */
+ 0, /* nrrdField_byte_skip */
+ 1, /* nrrdField_keyvalue */
+ 1, /* nrrdField_sample_units */
+ 1, /* nrrdField_space_units */
+ 1, /* nrrdField_space_origin */
+ 1, /* nrrdField_measurement_frame */
+ 0 /* nrrdField_data_file */
+};
+
+/*
+** _nrrdFieldOnePerAxis
+**
+** whether or not you need one value per axis, like labels and spacings
+*/
+const int
+_nrrdFieldOnePerAxis[NRRD_FIELD_MAX+1] = {
+ 0, /* nrrdField_unknown */
+ 0, /* nrrdField_comment */
+ 0, /* nrrdField_content */
+ 0, /* nrrdField_number */
+ 0, /* nrrdField_type */
+ 0, /* nrrdField_block_size */
+ 0, /* nrrdField_dimension */
+ 0, /* nrrdField_space */
+ 0, /* nrrdField_space_dimension */
+ 1, /* nrrdField_sizes */
+ 1, /* nrrdField_spacings */
+ 1, /* nrrdField_thicknesses */
+ 1, /* nrrdField_axis_mins */
+ 1, /* nrrdField_axis_maxs */
+ 1, /* nrrdField_space_directions */
+ 1, /* nrrdField_centers */
+ 1, /* nrrdField_kinds */
+ 1, /* nrrdField_labels */
+ 1, /* nrrdField_units */
+ 0, /* nrrdField_min */
+ 0, /* nrrdField_max */
+ 0, /* nrrdField_old_min */
+ 0, /* nrrdField_old_max */
+ 0, /* nrrdField_endian */
+ 0, /* nrrdField_encoding */
+ 0, /* nrrdField_line_skip */
+ 0, /* nrrdField_byte_skip */
+ 0, /* nrrdField_keyvalue */
+ 0, /* nrrdField_sample_units */
+ 0, /* nrrdField_space_units */
+ 0, /* nrrdField_space_origin */
+ 0, /* nrrdField_measurement_frame */
+ 0 /* nrrdField_data_file */
+};
+
+/*
+** _nrrdFieldValidInText[]
+**
+** these fields are valid embedded in plain text comments
+** This does NOT include the fields who's values are constrained
+** the plain text format itself.
+*/
+const int
+_nrrdFieldValidInText[NRRD_FIELD_MAX+1] = {
+ 0, /* nrrdField_unknown */
+ 1, /* nrrdField_comment */
+ 1, /* nrrdField_content */
+ 0, /* nrrdField_number */
+ 0, /* nrrdField_type: decided AGAINST plain text holding general type
+ (but I forget why ...) */
+ 0, /* nrrdField_block_size */
+ 1, /* nrrdField_dimension: but can only be 1 or 2 */
+ 0, /* nrrdField_space */
+ 0, /* nrrdField_space_dimension */
+ 0, /* nrrdField_sizes */
+ 1, /* nrrdField_spacings */
+ 1, /* nrrdField_thicknesses */
+ 1, /* nrrdField_axis_mins */
+ 1, /* nrrdField_axis_maxs */
+ 1, /* nrrdField_space_directions */
+ 1, /* nrrdField_centers */
+ 1, /* nrrdField_kinds */
+ 1, /* nrrdField_labels */
+ 1, /* nrrdField_units */
+ 0, /* nrrdField_min */
+ 0, /* nrrdField_max */
+ 1, /* nrrdField_old_min */
+ 1, /* nrrdField_old_max */
+ 0, /* nrrdField_endian */
+ 0, /* nrrdField_encoding */
+ 0, /* nrrdField_line_skip */
+ 0, /* nrrdField_byte_skip */
+ 0, /* nrrdField_keyvalue */
+ 0, /* nrrdField_sample_units */
+ 0, /* nrrdField_space_units */
+ 0, /* nrrdField_space_origin */
+ 0, /* nrrdField_measurement_frame */
+ 0 /* nrrdField_data_file */
+};
+
+/*
+** _nrrdFieldRequired[]
+**
+** regardless of whether its a nrrd, PNM, or plain text, these things
+** need to be conveyed, either explicity or implicitly
+*/
+const int
+_nrrdFieldRequired[NRRD_FIELD_MAX+1] = {
+ 0, /* "Ernesto \"Che\" Guevara" */
+ 0, /* "#" */
+ 0, /* nrrdField_content */
+ 0, /* nrrdField_number */
+ 1, /* nrrdField_type */
+ 0, /* nrrdField_block size */
+ 1, /* nrrdField_dimension */
+ 0, /* nrrdField_space */
+ 0, /* nrrdField_space_dimension */
+ 1, /* nrrdField_sizes */
+ 0, /* nrrdField_spacings */
+ 0, /* nrrdField_thicknesses */
+ 0, /* nrrdField_axis mins */
+ 0, /* nrrdField_axis maxs */
+ 0, /* nrrdField_space_directions */
+ 0, /* nrrdField_centers */
+ 0, /* nrrdField_kinds */
+ 0, /* nrrdField_labels */
+ 0, /* nrrdField_units */
+ 0, /* nrrdField_min */
+ 0, /* nrrdField_max */
+ 0, /* nrrdField_old min */
+ 0, /* nrrdField_old max */
+ 0, /* nrrdField_endian */
+ 1, /* nrrdField_encoding */
+ 0, /* nrrdField_line_skip */
+ 0, /* nrrdField_byte_skip */
+ 0, /* nrrdField_keyvalue */
+ 0, /* nrrdField_sample_units */
+ 0, /* nrrdField_space_units */
+ 0, /* nrrdField_space_origin */
+ 0, /* nrrdField_measurement_frame */
+ 0 /* nrrdField_data file */
+};
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/axis.c b/Utilities/ITK/Utilities/NrrdIO/axis.c
new file mode 100644
index 0000000000000000000000000000000000000000..7e40f9cf6ab56d1e1fc5ec7ab1a0d8b6e8ed56da
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/axis.c
@@ -0,0 +1,1044 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/* ------------------------------------------------------------ */
+
+void
+_nrrdAxisInfoInit(NrrdAxisInfo *axis) {
+ int dd;
+
+ if (axis) {
+ axis->size = 0;
+ axis->spacing = axis->thickness = AIR_NAN;
+ axis->min = axis->max = AIR_NAN;
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ axis->spaceDirection[dd] = AIR_NAN;
+ }
+ axis->center = nrrdCenterUnknown;
+ axis->kind = nrrdKindUnknown;
+ axis->label = (char *)airFree(axis->label);
+ axis->units = (char *)airFree(axis->units);
+ }
+}
+
+void
+_nrrdAxisInfoNewInit(NrrdAxisInfo *axis) {
+
+ if (axis) {
+ axis->label = NULL;
+ axis->units = NULL;
+ _nrrdAxisInfoInit(axis);
+ }
+}
+
+/* ------------------------------------------------------------ */
+
+/*
+******** nrrdKindIsDomain
+**
+** returns non-zero for kinds (from nrrdKind* enum) that are domain
+** axes, or independent variable axes, or resample-able axes, all
+** different ways of describing the same thing
+*/
+int
+nrrdKindIsDomain(int kind) {
+
+ return (nrrdKindDomain == kind
+ || nrrdKindSpace == kind
+ || nrrdKindTime == kind);
+}
+
+/*
+******** nrrdKindSize
+**
+** returns suggested size (length) of an axis with the given kind, or,
+** 0 if either (1) there is no suggested size because the axis is the
+** kind of an independent or domain variable or (2) the kind is invalid
+*/
+unsigned int
+nrrdKindSize(int kind) {
+ char me[]="nrrdKindSize";
+ int ret;
+
+ if (!( AIR_IN_OP(nrrdKindUnknown, kind, nrrdKindLast) )) {
+ /* they gave us invalid or unknown kind */
+ return 0;
+ }
+
+ switch (kind) {
+ case nrrdKindDomain:
+ case nrrdKindSpace:
+ case nrrdKindTime:
+ case nrrdKindList:
+ case nrrdKindPoint:
+ case nrrdKindVector:
+ case nrrdKindCovariantVector:
+ case nrrdKindNormal:
+ ret = 0;
+ break;
+ case nrrdKindStub:
+ case nrrdKindScalar:
+ ret = 1;
+ break;
+ case nrrdKindComplex:
+ case nrrdKind2Vector:
+ ret = 2;
+ break;
+ case nrrdKind3Color:
+ case nrrdKindRGBColor:
+ case nrrdKindHSVColor:
+ case nrrdKindXYZColor:
+ ret = 3;
+ break;
+ case nrrdKind4Color:
+ case nrrdKindRGBAColor:
+ ret = 4;
+ break;
+ case nrrdKind3Vector:
+ case nrrdKind3Normal:
+ ret = 3;
+ break;
+ case nrrdKind4Vector:
+ case nrrdKindQuaternion:
+ ret = 4;
+ break;
+ case nrrdKind2DSymMatrix:
+ ret = 3;
+ break;
+ case nrrdKind2DMaskedSymMatrix:
+ ret = 4;
+ break;
+ case nrrdKind2DMatrix:
+ ret = 4;
+ break;
+ case nrrdKind2DMaskedMatrix:
+ ret = 5;
+ break;
+ case nrrdKind3DSymMatrix:
+ ret = 6;
+ break;
+ case nrrdKind3DMaskedSymMatrix:
+ ret = 7;
+ break;
+ case nrrdKind3DMatrix:
+ ret = 9;
+ break;
+ case nrrdKind3DMaskedMatrix:
+ ret = 10;
+ break;
+ default:
+ fprintf(stderr, "%s: PANIC: nrrdKind %d not implemented!\n", me, kind);
+ exit(1);
+ }
+
+ return ret;
+}
+
+/*
+** _nrrdKindAltered:
+**
+** implements logic for how kind should be updated when samples
+** along the axis are altered
+*/
+int
+_nrrdKindAltered(int kindIn, int resampling) {
+ int kindOut;
+
+ if (nrrdStateKindNoop) {
+ kindOut = nrrdKindUnknown;
+ /* HEY: setting the kindOut to unknown is arguably not a no-op.
+ It is more like pointedly and stubbornly simplistic. So maybe
+ nrrdStateKindNoop could be renamed ... */
+ } else {
+ if (nrrdKindIsDomain(kindIn)
+ || (0 == nrrdKindSize(kindIn) && !resampling)) {
+ kindOut = kindIn;
+ } else {
+ kindOut = nrrdKindUnknown;
+ }
+ }
+ return kindOut;
+}
+
+/*
+** _nrrdAxisInfoCopy
+**
+** HEY: we have a void return even though this function potentially
+** involves calling airStrdup!!
+*/
+void
+_nrrdAxisInfoCopy(NrrdAxisInfo *dest, const NrrdAxisInfo *src, int bitflag) {
+ int ii;
+
+ if (!(NRRD_AXIS_INFO_SIZE_BIT & bitflag)) {
+ dest->size = src->size;
+ }
+ if (!(NRRD_AXIS_INFO_SPACING_BIT & bitflag)) {
+ dest->spacing = src->spacing;
+ }
+ if (!(NRRD_AXIS_INFO_THICKNESS_BIT & bitflag)) {
+ dest->thickness = src->thickness;
+ }
+ if (!(NRRD_AXIS_INFO_MIN_BIT & bitflag)) {
+ dest->min = src->min;
+ }
+ if (!(NRRD_AXIS_INFO_MAX_BIT & bitflag)) {
+ dest->max = src->max;
+ }
+ if (!(NRRD_AXIS_INFO_SPACEDIRECTION_BIT & bitflag)) {
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ dest->spaceDirection[ii] = src->spaceDirection[ii];
+ }
+ }
+ if (!(NRRD_AXIS_INFO_CENTER_BIT & bitflag)) {
+ dest->center = src->center;
+ }
+ if (!(NRRD_AXIS_INFO_KIND_BIT & bitflag)) {
+ dest->kind = src->kind;
+ }
+ if (!(NRRD_AXIS_INFO_LABEL_BIT & bitflag)) {
+ if (dest->label != src->label) {
+ dest->label = (char *)airFree(dest->label);
+ dest->label = (char *)airStrdup(src->label);
+ }
+ }
+ if (!(NRRD_AXIS_INFO_UNITS_BIT & bitflag)) {
+ if (dest->units != src->units) {
+ dest->units = (char *)airFree(dest->units);
+ dest->units = (char *)airStrdup(src->units);
+ }
+ }
+
+ return;
+}
+
+/*
+******** nrrdAxisInfoCopy()
+**
+** For copying all the per-axis peripheral information. Takes a
+** permutation "map"; map[d] tells from which axis in input should the
+** output axis d copy its information. The length of this permutation
+** array is nout->dim. If map is NULL, the identity permutation is
+** assumed. If map[i]==-1 for any i in [0,dim-1], then nothing is
+** copied into axis i of output. The "bitflag" field controls which
+** per-axis fields will NOT be copied; if bitflag==0, then all fields
+** are copied. The value of bitflag should be |'s of NRRD_AXIS_INFO_*
+** defines.
+**
+** Decided to Not use Biff, since many times map will be NULL, in
+** which case the only error is getting a NULL nrrd, or an invalid map
+** permutation, which will probably be unlikely given the contexts in
+** which this is called. For the paranoid, the integer return value
+** indicates error.
+**
+** Sun Feb 27 21:12:57 EST 2005: decided to allow nout==nin, so now
+** use a local array of NrrdAxisInfo as buffer.
+*/
+int
+nrrdAxisInfoCopy(Nrrd *nout, const Nrrd *nin, const int *axmap, int bitflag) {
+ NrrdAxisInfo axisBuffer[NRRD_DIM_MAX];
+ const NrrdAxisInfo *axis;
+ unsigned int from, axi;
+
+ if (!(nout && nin)) {
+ return 1;
+ }
+ if (axmap) {
+ for (axi=0; axi<nout->dim; axi++) {
+ if (-1 == axmap[axi]) {
+ continue;
+ }
+ if (!AIR_IN_CL(0, axmap[axi], (int)nin->dim-1)) {
+ return 3;
+ }
+ }
+ }
+ if (nout == nin) {
+ /* copy axis info to local buffer */
+ for (axi=0; axi<nin->dim; axi++) {
+ _nrrdAxisInfoNewInit(axisBuffer + axi);
+ _nrrdAxisInfoCopy(axisBuffer + axi, nin->axis + axi, bitflag);
+ }
+ axis = axisBuffer;
+ } else {
+ axis = nin->axis;
+ }
+ for (axi=0; axi<nout->dim; axi++) {
+ if (axmap && -1 == axmap[axi]) {
+ /* for this axis, we don't touch a thing */
+ continue;
+ }
+ from = axmap ? (unsigned int)axmap[axi] : axi;
+ _nrrdAxisInfoCopy(nout->axis + axi, axis + from, bitflag);
+ }
+ if (nout == nin) {
+ /* free dynamically allocated stuff */
+ for (axi=0; axi<nin->dim; axi++) {
+ _nrrdAxisInfoInit(axisBuffer + axi);
+ }
+ }
+ return 0;
+}
+
+/*
+******** nrrdAxisInfoSet_nva()
+**
+** Simple means of setting fields of the axis array in the nrrd.
+**
+** type to pass for third argument:
+** nrrdAxisInfoSize: size_t*
+** nrrdAxisInfoSpacing: double*
+** nrrdAxisInfoThickness: double*
+** nrrdAxisInfoMin: double*
+** nrrdAxisInfoMax: double*
+** nrrdAxisInfoSpaceDirection: double (*var)[NRRD_SPACE_DIM_MAX]
+** nrrdAxisInfoCenter: int*
+** nrrdAxisInfoKind: int*
+** nrrdAxisInfoLabel: char**
+** nrrdAxisInfoUnits: char**
+*/
+void
+nrrdAxisInfoSet_nva(Nrrd *nrrd, int axInfo, const void *_info) {
+ _nrrdAxisInfoSetPtrs info;
+ int exists;
+ unsigned int ai, si, minsi;
+
+ if (!( nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && AIR_IN_OP(nrrdAxisInfoUnknown, axInfo, nrrdAxisInfoLast)
+ && _info )) {
+ return;
+ }
+ info.P = _info;
+
+ for (ai=0; ai<nrrd->dim; ai++) {
+ switch (axInfo) {
+ case nrrdAxisInfoSize:
+ nrrd->axis[ai].size = info.ST[ai];
+ break;
+ case nrrdAxisInfoSpacing:
+ nrrd->axis[ai].spacing = info.D[ai];
+ break;
+ case nrrdAxisInfoThickness:
+ nrrd->axis[ai].thickness = info.D[ai];
+ break;
+ case nrrdAxisInfoMin:
+ nrrd->axis[ai].min = info.D[ai];
+ break;
+ case nrrdAxisInfoMax:
+ nrrd->axis[ai].max = info.D[ai];
+ break;
+ case nrrdAxisInfoSpaceDirection:
+ /* we won't allow setting an invalid direction */
+ exists = AIR_EXISTS(info.V[ai][0]);
+ minsi = nrrd->spaceDim;
+ for (si=0; si<nrrd->spaceDim; si++) {
+ nrrd->axis[ai].spaceDirection[si] = info.V[ai][si];
+ if (exists ^ AIR_EXISTS(info.V[ai][si])) {
+ minsi = 0;
+ break;
+ }
+ }
+ for (si=minsi; si<NRRD_SPACE_DIM_MAX; si++) {
+ nrrd->axis[ai].spaceDirection[si] = AIR_NAN;
+ }
+ break;
+ case nrrdAxisInfoCenter:
+ nrrd->axis[ai].center = info.I[ai];
+ break;
+ case nrrdAxisInfoKind:
+ nrrd->axis[ai].kind = info.I[ai];
+ break;
+ case nrrdAxisInfoLabel:
+ nrrd->axis[ai].label = (char *)airFree(nrrd->axis[ai].label);
+ nrrd->axis[ai].label = (char *)airStrdup(info.CP[ai]);
+ break;
+ case nrrdAxisInfoUnits:
+ nrrd->axis[ai].units = (char *)airFree(nrrd->axis[ai].units);
+ nrrd->axis[ai].units = (char *)airStrdup(info.CP[ai]);
+ break;
+ }
+ }
+ if (nrrdAxisInfoSpaceDirection == axInfo) {
+ for (ai=nrrd->dim; ai<NRRD_DIM_MAX; ai++) {
+ for (si=0; si<NRRD_SPACE_DIM_MAX; si++) {
+ nrrd->axis[ai].spaceDirection[si] = AIR_NAN;
+ }
+ }
+ }
+ return;
+}
+
+/*
+******** nrrdAxisInfoSet()
+**
+** var args front-end for nrrdAxisInfoSet_nva
+**
+** types to pass, one for each dimension:
+** nrrdAxisInfoSize: size_t
+** nrrdAxisInfoSpacing: double
+** nrrdAxisInfoThickness: double
+** nrrdAxisInfoMin: double
+** nrrdAxisInfoMax: double
+** nrrdAxisInfoSpaceDirection: double*
+** nrrdAxisInfoCenter: int
+** nrrdAxisInfoKind: int
+** nrrdAxisInfoLabel: char*
+** nrrdAxisInfoUnits: char*
+*/
+void
+nrrdAxisInfoSet(Nrrd *nrrd, int axInfo, ...) {
+ NRRD_TYPE_BIGGEST *buffer[NRRD_DIM_MAX];
+ _nrrdAxisInfoSetPtrs info;
+ unsigned int ai, si;
+ va_list ap;
+ double *dp, svec[NRRD_DIM_MAX][NRRD_SPACE_DIM_MAX];
+
+ if (!( nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && AIR_IN_OP(nrrdAxisInfoUnknown, axInfo, nrrdAxisInfoLast) )) {
+ return;
+ }
+
+ info.P = buffer;
+ va_start(ap, axInfo);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ switch (axInfo) {
+ case nrrdAxisInfoSize:
+ info.ST[ai] = va_arg(ap, size_t);
+ /*
+ printf("!%s: got int[%d] = %d\n", "nrrdAxisInfoSet", d, info.I[ai]);
+ */
+ break;
+ case nrrdAxisInfoSpaceDirection:
+ dp = va_arg(ap, double*); /* punting on using info enum */
+ /*
+ printf("!%s: got dp = %lu\n", "nrrdAxisInfoSet",
+ (unsigned long)(dp));
+ */
+ for (si=0; si<nrrd->spaceDim; si++) {
+ /* nrrd->axis[ai].spaceDirection[si] = dp[si]; */
+ svec[ai][si] = dp[si];
+ }
+ for (si=nrrd->spaceDim; si<NRRD_SPACE_DIM_MAX; si++) {
+ /* nrrd->axis[ai].spaceDirection[si] = AIR_NAN; */
+ svec[ai][si] = dp[si];
+ }
+ break;
+ case nrrdAxisInfoCenter:
+ case nrrdAxisInfoKind:
+ info.I[ai] = va_arg(ap, int);
+ /*
+ printf("!%s: got int[%d] = %d\n",
+ "nrrdAxisInfoSet", d, info.I[ai]);
+ */
+ break;
+ case nrrdAxisInfoSpacing:
+ case nrrdAxisInfoThickness:
+ case nrrdAxisInfoMin:
+ case nrrdAxisInfoMax:
+ info.D[ai] = va_arg(ap, double);
+ /*
+ printf("!%s: got double[%d] = %g\n",
+ "nrrdAxisInfoSet", d, info.D[ai]);
+ */
+ break;
+ case nrrdAxisInfoLabel:
+ /* we DO NOT do the airStrdup() here because this pointer value is
+ just going to be handed to nrrdAxisInfoSet_nva(), which WILL do the
+ airStrdup(); we're not violating the rules for axis labels */
+ info.CP[ai] = va_arg(ap, char *);
+ /*
+ printf("!%s: got char*[%d] = |%s|\n",
+ "nrrdAxisInfoSet", d, info.CP[ai]);
+ */
+ break;
+ case nrrdAxisInfoUnits:
+ /* see not above */
+ info.CP[ai] = va_arg(ap, char *);
+ break;
+ }
+ }
+ va_end(ap);
+
+ if (nrrdAxisInfoSpaceDirection != axInfo) {
+ /* now set the quantities which we've gotten from the var args */
+ nrrdAxisInfoSet_nva(nrrd, axInfo, info.P);
+ } else {
+ nrrdAxisInfoSet_nva(nrrd, axInfo, svec);
+ }
+
+ return;
+}
+
+/*
+******** nrrdAxisInfoGet_nva()
+**
+** get any of the axis fields into an array
+**
+** Note that getting axes labels involves implicitly allocating space
+** for them, due to the action of airStrdup(). The user is
+** responsible for free()ing these strings when done with them.
+**
+** type to pass for third argument:
+** nrrdAxisInfoSize: size_t*
+** nrrdAxisInfoSpacing: double*
+** nrrdAxisInfoThickness: double*
+** nrrdAxisInfoMin: double*
+** nrrdAxisInfoMax: double*
+** nrrdAxisInfoSpaceDirection: double (*var)[NRRD_SPACE_DIM_MAX]
+** nrrdAxisInfoCenter: int*
+** nrrdAxisInfoKind: int*
+** nrrdAxisInfoLabel: char**
+** nrrdAxisInfoUnits: char**
+*/
+void
+nrrdAxisInfoGet_nva(const Nrrd *nrrd, int axInfo, void *_info) {
+ _nrrdAxisInfoGetPtrs info;
+ unsigned int ai, si;
+
+ if (!( nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && AIR_IN_OP(nrrdAxisInfoUnknown, axInfo, nrrdAxisInfoLast) )) {
+ return;
+ }
+
+ info.P = _info;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ switch (axInfo) {
+ case nrrdAxisInfoSize:
+ info.ST[ai] = nrrd->axis[ai].size;
+ break;
+ case nrrdAxisInfoSpacing:
+ info.D[ai] = nrrd->axis[ai].spacing;
+ break;
+ case nrrdAxisInfoThickness:
+ info.D[ai] = nrrd->axis[ai].thickness;
+ break;
+ case nrrdAxisInfoMin:
+ info.D[ai] = nrrd->axis[ai].min;
+ break;
+ case nrrdAxisInfoMax:
+ info.D[ai] = nrrd->axis[ai].max;
+ break;
+ case nrrdAxisInfoSpaceDirection:
+ for (si=0; si<nrrd->spaceDim; si++) {
+ info.V[ai][si] = nrrd->axis[ai].spaceDirection[si];
+ }
+ for (si=nrrd->spaceDim; si<NRRD_SPACE_DIM_MAX; si++) {
+ info.V[ai][si] = AIR_NAN;
+ }
+ break;
+ case nrrdAxisInfoCenter:
+ info.I[ai] = nrrd->axis[ai].center;
+ break;
+ case nrrdAxisInfoKind:
+ info.I[ai] = nrrd->axis[ai].kind;
+ break;
+ case nrrdAxisInfoLabel:
+ /* note airStrdup()! */
+ info.CP[ai] = airStrdup(nrrd->axis[ai].label);
+ break;
+ case nrrdAxisInfoUnits:
+ /* note airStrdup()! */
+ info.CP[ai] = airStrdup(nrrd->axis[ai].units);
+ break;
+ }
+ }
+ if (nrrdAxisInfoSpaceDirection == axInfo) {
+ for (ai=nrrd->dim; ai<NRRD_DIM_MAX; ai++) {
+ for (si=0; si<NRRD_SPACE_DIM_MAX; si++) {
+ info.V[ai][si] = AIR_NAN;
+ }
+ }
+ }
+ return;
+}
+
+/*
+** types to pass, one for each dimension:
+** nrrdAxisInfoSize: size_t*
+** nrrdAxisInfoSpacing: double*
+** nrrdAxisInfoThickness: double*
+** nrrdAxisInfoMin: double*
+** nrrdAxisInfoMax: double*
+** nrrdAxisInfoSpaceDirection: double*
+** nrrdAxisInfoCenter: int*
+** nrrdAxisInfoKind: int*
+** nrrdAxisInfoLabel: char**
+** nrrdAxisInfoUnits: char**
+*/
+void
+nrrdAxisInfoGet(const Nrrd *nrrd, int axInfo, ...) {
+ void *buffer[NRRD_DIM_MAX], *ptr;
+ _nrrdAxisInfoGetPtrs info;
+ unsigned int ai, si;
+ va_list ap;
+ double svec[NRRD_DIM_MAX][NRRD_SPACE_DIM_MAX];
+
+ if (!( nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && AIR_IN_OP(nrrdAxisInfoUnknown, axInfo, nrrdAxisInfoLast) )) {
+ return;
+ }
+
+ if (nrrdAxisInfoSpaceDirection != axInfo) {
+ info.P = buffer;
+ nrrdAxisInfoGet_nva(nrrd, axInfo, info.P);
+ } else {
+ nrrdAxisInfoGet_nva(nrrd, axInfo, svec);
+ }
+
+ va_start(ap, axInfo);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ptr = va_arg(ap, void*);
+ /*
+ printf("!%s(%d): ptr = %lu\n",
+ "nrrdAxisInfoGet", d, (unsigned long)ptr);
+ */
+ switch (axInfo) {
+ case nrrdAxisInfoSize:
+ *((size_t*)ptr) = info.ST[ai];
+ break;
+ case nrrdAxisInfoSpacing:
+ case nrrdAxisInfoThickness:
+ case nrrdAxisInfoMin:
+ case nrrdAxisInfoMax:
+ *((double*)ptr) = info.D[ai];
+ /* printf("!%s: got double[%d] = %lg\n", "nrrdAxisInfoGet", d,
+ *((double*)ptr)); */
+ break;
+ case nrrdAxisInfoSpaceDirection:
+ for (si=0; si<nrrd->spaceDim; si++) {
+ ((double*)ptr)[si] = svec[ai][si];
+ }
+ for (si=nrrd->spaceDim; si<NRRD_SPACE_DIM_MAX; si++) {
+ ((double*)ptr)[si] = AIR_NAN;
+ }
+ break;
+ case nrrdAxisInfoCenter:
+ case nrrdAxisInfoKind:
+ *((int*)ptr) = info.I[ai];
+ /* printf("!%s: got int[%d] = %d\n",
+ "nrrdAxisInfoGet", d, *((int*)ptr)); */
+ break;
+ case nrrdAxisInfoLabel:
+ case nrrdAxisInfoUnits:
+ /* we DO NOT do the airStrdup() here because this pointer value just
+ came from nrrdAxisInfoGet_nva(), which already did the airStrdup() */
+ *((char**)ptr) = info.CP[ai];
+ /* printf("!%s: got char*[%d] = |%s|\n", "nrrdAxisInfoSet", d,
+ *((char**)ptr)); */
+ break;
+ }
+ }
+ va_end(ap);
+
+ return;
+}
+
+/*
+** _nrrdCenter()
+**
+** for nrrdCenterCell and nrrdCenterNode, return will be the same
+** as input. Converts nrrdCenterUnknown into nrrdDefCenter,
+** and then clamps to (nrrdCenterUnknown+1, nrrdCenterLast-1).
+**
+** Thus, this ALWAYS returns nrrdCenterNode or nrrdCenterCell
+** (as long as those are the only two centering schemes).
+*/
+int
+_nrrdCenter(int center) {
+
+ center = (nrrdCenterUnknown == center
+ ? nrrdDefCenter
+ : center);
+ center = AIR_CLAMP(nrrdCenterUnknown+1, center, nrrdCenterLast-1);
+ return center;
+}
+
+int
+_nrrdCenter2(int center, int defCenter) {
+
+ center = (nrrdCenterUnknown == center
+ ? defCenter
+ : center);
+ center = AIR_CLAMP(nrrdCenterUnknown+1, center, nrrdCenterLast-1);
+ return center;
+}
+
+
+/*
+******** nrrdAxisInfoPos()
+**
+** given a nrrd, an axis, and a (floating point) index space position,
+** return the position implied the axis's min, max, and center
+** Does the opposite of nrrdAxisIdx().
+**
+** does not use biff
+*/
+double
+nrrdAxisInfoPos(const Nrrd *nrrd, unsigned int ax, double idx) {
+ int center;
+ unsigned int size;
+ double min, max;
+
+ if (!( nrrd && ax <= nrrd->dim-1 )) {
+ return AIR_NAN;
+ }
+ center = _nrrdCenter(nrrd->axis[ax].center);
+ min = nrrd->axis[ax].min;
+ max = nrrd->axis[ax].max;
+ size = nrrd->axis[ax].size;
+
+ return NRRD_POS(center, min, max, size, idx);
+}
+
+/*
+******** nrrdAxisInfoIdx()
+**
+** given a nrrd, an axis, and a (floating point) world space position,
+** return the index implied the axis's min, max, and center.
+** Does the opposite of nrrdAxisPos().
+**
+** does not use biff
+*/
+double
+nrrdAxisInfoIdx(const Nrrd *nrrd, unsigned int ax, double pos) {
+ int center;
+ unsigned int size;
+ double min, max;
+
+ if (!( nrrd && ax <= nrrd->dim-1 )) {
+ return AIR_NAN;
+ }
+ center = _nrrdCenter(nrrd->axis[ax].center);
+ min = nrrd->axis[ax].min;
+ max = nrrd->axis[ax].max;
+ size = nrrd->axis[ax].size;
+
+ return NRRD_IDX(center, min, max, size, pos);
+}
+
+/*
+******** nrrdAxisInfoPosRange()
+**
+** given a nrrd, an axis, and two (floating point) index space positions,
+** return the range of positions implied the axis's min, max, and center
+** The opposite of nrrdAxisIdxRange()
+*/
+void
+nrrdAxisInfoPosRange(double *loP, double *hiP,
+ const Nrrd *nrrd, unsigned int ax,
+ double loIdx, double hiIdx) {
+ int center, flip = 0;
+ unsigned size;
+ double min, max, tmp;
+
+ if (!( loP && hiP && nrrd && ax <= nrrd->dim-1 )) {
+ *loP = *hiP = AIR_NAN;
+ return;
+ }
+ center = _nrrdCenter(nrrd->axis[ax].center);
+ min = nrrd->axis[ax].min;
+ max = nrrd->axis[ax].max;
+ size = nrrd->axis[ax].size;
+
+ if (loIdx > hiIdx) {
+ flip = 1;
+ tmp = loIdx; loIdx = hiIdx; hiIdx = tmp;
+ }
+ if (nrrdCenterCell == center) {
+ *loP = AIR_AFFINE(0, loIdx, size, min, max);
+ *hiP = AIR_AFFINE(0, hiIdx+1, size, min, max);
+ } else {
+ *loP = AIR_AFFINE(0, loIdx, size-1, min, max);
+ *hiP = AIR_AFFINE(0, hiIdx, size-1, min, max);
+ }
+ if (flip) {
+ tmp = *loP; *loP = *hiP; *hiP = tmp;
+ }
+
+ return;
+}
+
+/*
+******** nrrdAxisInfoIdxRange()
+**
+** given a nrrd, an axis, and two (floating point) world space positions,
+** return the range of index space implied the axis's min, max, and center
+** The opposite of nrrdAxisPosRange().
+**
+** Actually- there are situations where sending an interval through
+** nrrdAxisIdxRange -> nrrdAxisPosRange -> nrrdAxisIdxRange
+** such as in cell centering, when the range of positions given does
+** not even span one sample. Such as:
+** axis->size = 4, axis->min = -4, axis->max = 4, loPos = 0, hiPos = 1
+** --> nrrdAxisIdxRange == (2, 1.5) --> nrrdAxisPosRange == (2, -1)
+** The basic problem is that because of the 0.5 offset inherent in
+** cell centering, there are situations where (in terms of the arguments
+** to nrrdAxisIdxRange()) loPos < hiPos, but *loP > *hiP.
+*/
+void
+nrrdAxisInfoIdxRange(double *loP, double *hiP,
+ const Nrrd *nrrd, unsigned int ax,
+ double loPos, double hiPos) {
+ int center, flip = 0;
+ unsigned size;
+ double min, max, tmp;
+
+ if (!( loP && hiP && nrrd && ax <= nrrd->dim-1 )) {
+ *loP = *hiP = AIR_NAN;
+ return;
+ }
+ center = _nrrdCenter(nrrd->axis[ax].center);
+ min = nrrd->axis[ax].min;
+ max = nrrd->axis[ax].max;
+ size = nrrd->axis[ax].size;
+
+ if (loPos > hiPos) {
+ flip = 1;
+ tmp = loPos; loPos = hiPos; hiPos = tmp;
+ }
+ if (nrrdCenterCell == center) {
+ if (min < max) {
+ *loP = AIR_AFFINE(min, loPos, max, 0, size);
+ *hiP = AIR_AFFINE(min, hiPos, max, -1, size-1);
+ } else {
+ *loP = AIR_AFFINE(min, loPos, max, -1, size-1);
+ *hiP = AIR_AFFINE(min, hiPos, max, 0, size);
+ }
+ } else {
+ *loP = AIR_AFFINE(min, loPos, max, 0, size-1);
+ *hiP = AIR_AFFINE(min, hiPos, max, 0, size-1);
+ }
+ if (flip) {
+ tmp = *loP; *loP = *hiP; *hiP = tmp;
+ }
+
+ return;
+}
+
+void
+nrrdAxisInfoSpacingSet(Nrrd *nrrd, unsigned int ax) {
+ int sign;
+ double min, max, tmp;
+
+ if (!( nrrd && ax <= nrrd->dim-1 )) {
+ return;
+ }
+
+ min = nrrd->axis[ax].min;
+ max = nrrd->axis[ax].max;
+ if (!( AIR_EXISTS(min) && AIR_EXISTS(max) )) {
+ /* there's no actual basis on which to set the spacing information,
+ but we have to set it something, so here goes ... */
+ nrrd->axis[ax].spacing = nrrdDefSpacing;
+ return;
+ }
+
+ if (min > max) {
+ tmp = min; min = max; max = tmp;
+ sign = -1;
+ } else {
+ sign = 1;
+ }
+
+ /* the skinny */
+ nrrd->axis[ax].spacing = NRRD_SPACING(_nrrdCenter(nrrd->axis[ax].center),
+ min, max, nrrd->axis[ax].size);
+ nrrd->axis[ax].spacing *= sign;
+
+ return;
+}
+
+void
+nrrdAxisInfoMinMaxSet(Nrrd *nrrd, unsigned int ax, int defCenter) {
+ int center;
+ double spacing;
+
+ if (!( nrrd && ax <= nrrd->dim-1 )) {
+ return;
+ }
+
+ center = _nrrdCenter2(nrrd->axis[ax].center, defCenter);
+ spacing = nrrd->axis[ax].spacing;
+ if (!AIR_EXISTS(spacing))
+ spacing = nrrdDefSpacing;
+ if (nrrdCenterCell == center) {
+ nrrd->axis[ax].min = 0;
+ nrrd->axis[ax].max = spacing*nrrd->axis[ax].size;
+ } else {
+ nrrd->axis[ax].min = 0;
+ nrrd->axis[ax].max = spacing*(nrrd->axis[ax].size - 1);
+ }
+
+ return;
+}
+
+/*
+******** nrrdDomainAxesGet
+**
+** learns which are the domain (resample-able) axes of an image, in
+** other words, the axes which correspond to independent variables.
+** The return value is the number of domain axes, and that many values
+** are set in the given axisIdx[] array
+**
+** NOTE: this takes a wild guess that an unset (nrrdKindUnknown) kind
+** is a domain axis.
+*/
+unsigned int
+nrrdDomainAxesGet(Nrrd *nrrd, unsigned int axisIdx[NRRD_DIM_MAX]) {
+ unsigned int domAxi, axi;
+
+ if (!( nrrd && axisIdx )) {
+ return 0;
+ }
+ domAxi = 0;
+ for (axi=0; axi<nrrd->dim; axi++) {
+ if (nrrdKindUnknown == nrrd->axis[axi].kind
+ || nrrdKindIsDomain(nrrd->axis[axi].kind)) {
+ axisIdx[domAxi++] = axi;
+ }
+ }
+ return domAxi;
+}
+
+/*
+******** nrrdRangeAxesGet
+**
+** learns which are the range (non-resample-able) axes of an image, in
+** other words, the axes which correspond to dependent variables. The
+** return value is the number of range axes; that number of values
+** are set in the given axisIdx[] array
+*/
+unsigned int
+nrrdRangeAxesGet(Nrrd *nrrd, unsigned int axisIdx[NRRD_DIM_MAX]) {
+ unsigned int domNum, domIdx[NRRD_DIM_MAX], rngAxi, axi, ii, isDom;
+
+ if (!( nrrd && axisIdx )) {
+ return 0;
+ }
+ domNum = nrrdDomainAxesGet(nrrd, domIdx);
+ rngAxi = 0;
+ for (axi=0; axi<nrrd->dim; axi++) {
+ isDom = AIR_FALSE;
+ for (ii=0; ii<domNum; ii++) { /* yes, inefficient */
+ isDom |= axi == domIdx[ii];
+ }
+ if (!isDom) {
+ axisIdx[rngAxi++] = axi;
+ }
+ }
+ return rngAxi;
+}
+
+
+/*
+******** nrrdSpacingCalculate
+**
+** Determine nrrdSpacingStatus, and whatever can be calculated about
+** spacing for a given axis. Takes a nrrd, an axis, a double pointer
+** (for returning a scalar), a space vector, and an int pointer for
+** returning the known length of the space vector.
+**
+** The behavior of what has been set by the function is determined by
+** the return value, which takes values from the nrrdSpacingStatus*
+** enum, as follows:
+**
+** returned status value: what it means, and what it set
+** ---------------------------------------------------------------------------
+** nrrdSpacingStatusUnknown Something about the given arguments is
+** invalid.
+** *spacing = NaN,
+** vector = all NaNs
+**
+** nrrdSpacingStatusNone There is no spacing info at all:
+** *spacing = NaN,
+** vector = all NaNs
+**
+** nrrdSpacingStatusScalarNoSpace There is no surrounding space, but the
+** axis's spacing was known.
+** *spacing = axis->spacing,
+** vector = all NaNs
+**
+** nrrdSpacingStatusScalarWithSpace There *is* a surrounding space, but the
+** given axis does not live in that space,
+** because it has no space direction. Caller
+** may want to think about what's going on.
+** *spacing = axis->spacing,
+** vector = all NaNs
+**
+** nrrdSpacingStatusDirection There is a surrounding space, in which
+** this axis has a direction V:
+** *spacing = |V| (length of direction),
+** vector = V/|V| (normalized direction)
+** NOTE: it is still possible for both
+** *spacing and vector to be all NaNs!!
+*/
+int
+nrrdSpacingCalculate(const Nrrd *nrrd, unsigned int ax,
+ double *spacing, double vector[NRRD_SPACE_DIM_MAX]) {
+ int ret;
+
+ if (!( nrrd && spacing && vector
+ && ax <= nrrd->dim-1
+ && !_nrrdCheck(nrrd, AIR_FALSE, AIR_FALSE) )) {
+ /* there's a problem with the arguments. Note: the _nrrdCheck()
+ call does not check on non-NULL-ity of nrrd->data */
+ ret = nrrdSpacingStatusUnknown;
+ if (spacing) {
+ *spacing = AIR_NAN;
+ }
+ if (vector) {
+ _nrrdSpaceVecSetNaN(vector);
+ }
+ } else {
+ if (AIR_EXISTS(nrrd->axis[ax].spacing)) {
+ if (nrrd->spaceDim > 0) {
+ ret = nrrdSpacingStatusScalarWithSpace;
+ } else {
+ ret = nrrdSpacingStatusScalarNoSpace;
+ }
+ *spacing = nrrd->axis[ax].spacing;
+ _nrrdSpaceVecSetNaN(vector);
+ } else {
+ if (nrrd->spaceDim > 0) {
+ ret = nrrdSpacingStatusDirection;
+ *spacing = _nrrdSpaceVecNorm(nrrd->spaceDim,
+ nrrd->axis[ax].spaceDirection);
+ _nrrdSpaceVecScale(vector, 1.0/(*spacing),
+ nrrd->axis[ax].spaceDirection);
+ } else {
+ ret = nrrdSpacingStatusNone;
+ *spacing = AIR_NAN;
+ _nrrdSpaceVecSetNaN(vector);
+ }
+ }
+ }
+ return ret;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/biffbiff.c b/Utilities/ITK/Utilities/NrrdIO/biffbiff.c
new file mode 100644
index 0000000000000000000000000000000000000000..558022026a207ef147e1fd45b26deffc05481daf
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/biffbiff.c
@@ -0,0 +1,574 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+
+/*
+** This is mostly garbage.
+** It needs to be re-written.
+** I apologize.
+*/
+
+/*
+** _biffEntry struct
+**
+** hold information and messages associated with one key
+*/
+typedef struct {
+ char key[BIFF_MAXKEYLEN+1]; /* the key */
+ char **err; /* array of error strings; the err array itself
+ is NOT null-terminated */
+ unsigned int num; /* length of "err" == # strings stored */
+ airArray *AA; /* air array for err and num */
+} _biffEntry;
+
+_biffEntry **_biffErr=NULL; /* master array of _biffEntry pointers */
+unsigned int _biffNum=0; /* length of _biffErr == # keys maintained */
+int _biffIdx=-1; /* hack: index of latest key found */
+airArray *_biffAA=NULL; /* air array of _biffErr and _biffNum */
+
+#define _BIFF_INCR 2
+
+typedef union {
+ _biffEntry ***b;
+ void **v;
+} _beu;
+
+/*
+** _biffInit()
+**
+** allocates data structers needed by biff. Panics and exit(1)s if
+** anything goes wrong. Can be harmlessly called multiple times.
+*/
+void
+_biffInit(void) {
+ char me[]="_biffInit";
+ _beu uu;
+
+ uu.b = &_biffErr;
+ if (!_biffAA) {
+ _biffAA = airArrayNew(uu.v, &_biffNum, sizeof(_biffEntry*), _BIFF_INCR);
+ if (!_biffAA) {
+ fprintf(stderr, "%s: PANIC: couldn't allocate internal data\n", me);
+ exit(1);
+ }
+ }
+ return;
+}
+
+void
+_biffNuke(void) {
+
+ if (_biffAA) {
+ /* setting to NULL is needed to put biff back in initial state
+ so that next calls to biff re-trigger _biffInit() */
+ _biffAA = airArrayNuke(_biffAA);
+ }
+ return;
+}
+
+/*
+** _biffCheckKey()
+**
+** makes sure given key is kosher. Panics and exit(1)s if given a NULL key
+** or if key is too long
+*/
+void
+_biffCheckKey(const char *key) {
+ char me[] = "_biffCheckKey";
+
+ if (!key) {
+ fprintf(stderr, "%s: PANIC: given NULL key\n", me);
+ exit(1);
+ }
+ if (strlen(key) > BIFF_MAXKEYLEN) {
+ fprintf(stderr, "%s: PANIC: key \"%s\" exceeds %d chars\n",
+ me, key, BIFF_MAXKEYLEN);
+ exit(1);
+ }
+ return;
+}
+
+/*
+** _biffFindKey()
+**
+** returns a pointer to the entry which contains the given key, or
+** NULL if it was not found
+*/
+_biffEntry *
+_biffFindKey(const char *key) {
+ int ii=-1;
+ _biffEntry *ent;
+
+ if (_biffNum) {
+ for (ii=0; ii<(int)_biffNum; ii++) {
+ /* printf("HEY: comparing key[%d]=\"%s\" to \"%s\"\n",
+ ii, _biffErr[i]->key, key); */
+ if (!strcmp(_biffErr[ii]->key, key)) {
+ break;
+ }
+ }
+ if (ii == (int)_biffNum) {
+ ii = -1;
+ }
+ }
+ /* printf("HEY: index(\"%s\") = %d\n", key, ii); */
+ if (-1 == ii) {
+ ent = NULL;
+ _biffIdx = -1;
+ }
+ else {
+ ent = _biffErr[ii];
+ _biffIdx = ii;
+ }
+ return ent;
+}
+
+/*
+** _biffNewEntry()
+**
+** creates and initializes one new _biffEntry, returning a pointer to it
+** panics and exit(1)s if there is a problem.
+*/
+_biffEntry *
+_biffNewEntry(const char *key) {
+ char me[]="_biffInitEntry";
+ _biffEntry *ent;
+
+ ent = (_biffEntry *)calloc(1, sizeof(_biffEntry));
+ if (!ent) {
+ fprintf(stderr, "%s: couldn't make entry for new key \"%s\"\n", me, key);
+ exit(1);
+ }
+ strcpy(ent->key, key);
+ ent->AA = airArrayNew((void**)&(ent->err),
+ &(ent->num), sizeof(char*), _BIFF_INCR);
+ if (!ent->AA) {
+ fprintf(stderr, "%s: couldn't make array for new key \"%s\"\n", me, key);
+ exit(1);
+ }
+ airArrayPointerCB(ent->AA, NULL, airFree);
+ return ent;
+}
+
+/*
+** _biffNukeEntry()
+**
+** deletes given entry, and all info contained therein
+*/
+void
+_biffNukeEntry(_biffEntry *ent) {
+
+ if (ent) {
+ airArrayLenSet(ent->AA, 0);
+ airArrayNuke(ent->AA);
+ free(ent);
+ }
+ return;
+}
+
+/*
+** _biffAddKey()
+**
+** adds a key to _biffErr, and returns a pointer to the new entry
+** assumes that given key does NOT appear in current list.
+** panics and exit(1)s if there is a problem
+*/
+_biffEntry *
+_biffAddKey(const char *key) {
+ char me[]="_biffAddKey";
+ int ii, newIdx;
+ _biffEntry *ent;
+
+ /* find index of new key */
+ for (ii=0; ii<(int)_biffNum; ii++) {
+ if (strcmp(key, _biffErr[ii]->key) < 0) {
+ /* we've hit the one which comes after the new key */
+ break;
+ }
+ }
+ /* if the for loop was never broken, _biffNum is the correct new index */
+ newIdx = ii;
+ /* printf("HEY: index(new key \"%s\") = %d\n", key, ii); */
+
+ airArrayLenIncr(_biffAA, 1);
+ if (!_biffAA->data) {
+ fprintf(stderr, "%s: PANIC: couldn't accomodate one more key\n", me);
+ exit(1);
+ }
+
+ /* _biffNum is now one bigger */
+ for (ii=_biffNum-2; ii>=newIdx; ii--) {
+ _biffErr[ii+1] = _biffErr[ii];
+ }
+ ent = _biffErr[newIdx] = _biffNewEntry(key);
+
+ return ent;
+}
+
+/*
+** _biffAddErr()
+**
+** adds a given message to the given entry. The message is processed to
+** convert all whitespace into ' ', and to eliminate whitespace at the
+** end of the message.
+** panics and exit(1)s if there is a problem
+*/
+void
+_biffAddErr(_biffEntry *e, const char *err) {
+ char *buf, me[]="_biffAddErr";
+ int ii, len;
+
+ /* printf("%s: HEY(before): err[%s]->num = %d\n", me, e->key, e->num); */
+ airArrayLenIncr(e->AA, 1);
+ if (!e->AA->data) {
+ fprintf(stderr, "%s: PANIC: couldn't add message for key %s\n",
+ me, e->key);
+ exit(1);
+ }
+ /* printf("%s: HEY(after): err[%s]->num = %d\n", me, e->key, e->num); */
+ buf = airStrdup(err);
+ len = strlen(buf);
+ for (ii=0; ii<=len-1; ii++) {
+ if (isspace(buf[ii])) {
+ buf[ii] = ' ';
+ }
+ }
+ ii = len-1;
+ while (isspace(buf[ii])) {
+ buf[ii--] = 0;
+ }
+ /* printf("%s: HEY(after): err[%s]->num = %d\n", me, e->key, e->num); */
+ /* printf("%s: HEY: err[%s][%d] now \"%s\"\n", me, e->key, e->num-1, buf); */
+ e->err[e->num-1] = buf;
+ return;
+}
+
+void
+_biffFindMaxAndSum(unsigned int *maxP, unsigned int *sumP, _biffEntry *ent) {
+ unsigned int ii, len;
+
+ if (!ent->num) {
+ /* there's a key, but no error messages. Odd. */
+ *maxP = 1;
+ *sumP = 1;
+ return;
+ }
+
+ *maxP = *sumP = 0;
+ for (ii=0; ii<ent->num; ii++) {
+ len = strlen(ent->err[ii]) + strlen(ent->key) + strlen("[] \n");
+ *sumP += len;
+ *maxP = AIR_MAX(*maxP, len);
+ }
+ *sumP += 1;
+ *maxP += 1;
+ return;
+}
+
+/***********************************************************************/
+/***********************************************************************/
+
+/*
+******** biffAdd()
+**
+** Adds string "err" at key "key", whether or not there are any
+** existing messages there. Since biffSet() was killed
+** Wed Apr 20 11:11:51 EDT 2005, this has become the main biff
+** function.
+*/
+void
+biffAdd(const char *key, const char *err) {
+ _biffEntry *ent;
+
+ _biffInit();
+ _biffCheckKey(key);
+
+ ent = _biffFindKey(key);
+ if (!ent) {
+ ent = _biffAddKey(key);
+ }
+
+ /* add the new message */
+ _biffAddErr(ent, err);
+ return;
+}
+
+/*
+******** biffMaybeAdd()
+**
+** wrapper around biffAdd() but doesn't actually do anything if !useBiff
+*/
+void
+biffMaybeAdd(const char *key, const char *err, int useBiff) {
+
+ if (useBiff) {
+ biffAdd(key, err);
+ }
+ return;
+}
+
+void
+_biffGetStr(char *ret, char *buf, _biffEntry *ent) {
+ int ii;
+
+ if (!ent->num) {
+ /* there's a key, but no error messages. Odd. */
+ strcpy(ret, "");
+ }
+ for (ii=ent->num-1; ii>=0; ii--) {
+ sprintf(buf, "[%s] %s\n", ent->key, ent->err[ii]);
+ strcat(ret, buf);
+ }
+ return;
+}
+
+/*
+******** biffGet()
+**
+** creates a string which records all the errors at given key and
+** returns it. Returns NULL in case of error. This function should
+** be considered a glorified strdup(): it is the callers responsibility
+** to free this string later
+*/
+char *
+biffGet(const char *key) {
+ unsigned int max, sum;
+ char me[] = "biffGet", *ret, *buf;
+ _biffEntry *ent;
+
+ _biffInit();
+ _biffCheckKey(key);
+ ent = _biffFindKey(key);
+ if (!ent) {
+ /* error: not a key we remember seeing */
+ fprintf(stderr, "%s: WARNING: no information for key \"%s\"\n", me, key);
+ return NULL;
+ }
+
+ _biffFindMaxAndSum(&max, &sum, ent);
+ buf = (char*)calloc(max, sizeof(char));
+ ret = (char*)calloc(sum, sizeof(char));
+ if (!(buf && ret)) {
+ fprintf(stderr, "%s: PANIC: unable to allocate buffers\n", me);
+ exit(1);
+ }
+ _biffGetStr(ret, buf, ent);
+ free(buf);
+
+ return ret;
+}
+
+/*
+******** biffGetStrlen()
+**
+** for when you want to allocate the buffer for the biff string, this is
+** how you learn its length
+*/
+int
+biffGetStrlen(const char *key) {
+ unsigned int max, sum;
+ char me[] = "biffGetStrlen";
+ _biffEntry *ent;
+
+ _biffInit();
+ _biffCheckKey(key);
+ ent = _biffFindKey(key);
+ if (!ent) {
+ /* error: not a key we remember seeing */
+ fprintf(stderr, "%s: WARNING: no information for key \"%s\"\n", me, key);
+ return 0;
+ }
+
+ _biffFindMaxAndSum(&max, &sum, ent);
+ return sum;
+}
+
+/*
+******** biffSetStr()
+**
+** for when you want to allocate the buffer for the biff string, this is
+** how you get the error message itself
+*/
+void
+biffSetStr(char *str, const char *key) {
+ unsigned int max, sum;
+ char me[] = "biffSetStr", *buf;
+ _biffEntry *ent;
+
+ if (!str) {
+ fprintf(stderr, "%s: ERROR: got NULL buffer \"%s\"\n", me, key);
+ return;
+ }
+
+ _biffInit();
+ _biffCheckKey(key);
+ ent = _biffFindKey(key);
+ if (!ent) {
+ /* error: not a key we remember seeing */
+ fprintf(stderr, "%s: WARNING: no information for key \"%s\"\n", me, key);
+ return;
+ }
+
+ _biffFindMaxAndSum(&max, &sum, ent);
+ buf = (char*)calloc(max, sizeof(char));
+ if (!buf) {
+ fprintf(stderr, "%s: PANIC: unable to allocate buffer\n", me);
+ exit(1);
+ }
+ _biffGetStr(str, buf, ent);
+ free(buf);
+
+ return;
+}
+
+/*
+******** biffCheck()
+**
+** sees how many messages there are for a given key
+** returns 0 if the key doesn't exist.
+*/
+int
+biffCheck(const char *key) {
+ _biffEntry *ent;
+
+ _biffInit();
+ _biffCheckKey(key);
+
+ ent = _biffFindKey(key);
+ if (!ent) {
+ return 0;
+ }
+
+ return ent->num;
+}
+
+/*
+******** biffDone()
+**
+** frees everything associated with given key, and shrinks list of keys
+*/
+void
+biffDone(const char *key) {
+ char me[]="biffDone";
+ int i, idx;
+ _biffEntry *ent;
+
+ _biffInit();
+ _biffCheckKey(key);
+
+ ent = _biffFindKey(key);
+ if (!ent) {
+ fprintf(stderr, "%s: WARNING: no information for key \"%s\"\n", me, key);
+ return;
+ }
+ idx = _biffIdx;
+
+ _biffNukeEntry(ent);
+ for (i=idx; i<(int)_biffNum-1; i++) {
+ _biffErr[i] = _biffErr[i+1];
+ }
+ airArrayLenIncr(_biffAA, -1);
+
+ return;
+}
+
+void
+biffMove(const char *destKey, const char *err, const char *srcKey) {
+ unsigned int ii, len, max;
+ char me[] = "biffMove", *buf;
+ _biffEntry *dest, *src;
+
+ _biffInit();
+ _biffCheckKey(destKey);
+ _biffCheckKey(srcKey);
+
+ /* if srcKey and destKey are the same, this degenerates to biffAdd() */
+ if (!strcmp(destKey, srcKey)) {
+ biffAdd(srcKey, err);
+ return;
+ }
+
+ dest = _biffFindKey(destKey);
+ if (!dest) {
+ dest = _biffAddKey(destKey);
+ }
+ src = _biffFindKey(srcKey);
+ if (!src) {
+ fprintf(stderr, "%s: WARNING: key \"%s\" unknown\n", me, srcKey);
+ return;
+ }
+
+ max = 0;
+ for (ii=0; ii<src->num; ii++) {
+ len = strlen(src->err[ii]) + strlen(src->key) + 4;
+ max = AIR_MAX(max, len);
+ }
+ buf = (char*)calloc(max+1, sizeof(char));
+ if (!buf) {
+ fprintf(stderr, "%s: PANIC: can't allocate buffer\n", me);
+ exit(1);
+ }
+
+ for (ii=0; ii<src->num; ii++) {
+ sprintf(buf, "[%s] %s", srcKey, src->err[ii]);
+ /* printf("%s: HEY: moving \"%s\" to %s\n", me, buf, destKey); */
+ _biffAddErr(dest, buf);
+ }
+ if (err) {
+ _biffAddErr(dest, err);
+ }
+ biffDone(srcKey);
+ free(buf);
+
+ return;
+}
+
+char *
+biffGetDone(const char *key) {
+ char *ret;
+
+ _biffInit();
+ _biffCheckKey(key);
+
+ ret = biffGet(key);
+ biffDone(key);
+ _biffNuke();
+
+ return ret;
+}
+
+void
+biffSetStrDone(char *str, const char *key) {
+
+ _biffInit();
+ _biffCheckKey(key);
+
+ biffSetStr(str, key);
+ biffDone(key);
+ _biffNuke();
+
+ return;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/comment.c b/Utilities/ITK/Utilities/NrrdIO/comment.c
new file mode 100644
index 0000000000000000000000000000000000000000..e71c6d8bc6dbd5f037f24168dad52fe9c78aebc9
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/comment.c
@@ -0,0 +1,131 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+******** nrrdCommentAdd()
+**
+** Adds a given string to the list of comments
+** Leading spaces (' ') and comment chars ('#') are not included.
+**
+** This function does NOT use biff.
+*/
+int
+nrrdCommentAdd(Nrrd *nrrd, const char *_str) {
+ char /* me[]="nrrdCommentAdd", err[512], */ *str;
+ int i;
+
+ if (!(nrrd && _str)) {
+ /*
+ sprintf(err, "%s: got NULL pointer", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ */
+ return 1;
+ }
+ _str += strspn(_str, " #");
+ if (!strlen(_str)) {
+ /* we don't bother adding comments with no length */
+ return 0;
+ }
+ if (!strcmp(_str, _nrrdFormatURLLine0)
+ || !strcmp(_str, _nrrdFormatURLLine1)) {
+ /* sneaky hack: don't store the format URL comment lines */
+ return 0;
+ }
+ str = airStrdup(_str);
+ if (!str) {
+ /*
+ sprintf(err, "%s: couldn't strdup given string", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ */
+ return 1;
+ }
+ /* clean out carraige returns that would screw up reader */
+ airOneLinify(str);
+ i = airArrayLenIncr(nrrd->cmtArr, 1);
+ if (!nrrd->cmtArr->data) {
+ /*
+ sprintf(err, "%s: couldn't lengthen comment array", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ */
+ return 1;
+ }
+ nrrd->cmt[i] = str;
+ return 0;
+}
+
+/*
+******** nrrdCommentClear()
+**
+** blows away comments, but does not blow away the comment airArray
+*/
+void
+nrrdCommentClear(Nrrd *nrrd) {
+
+ if (nrrd) {
+ airArrayLenSet(nrrd->cmtArr, 0);
+ }
+}
+
+/*
+******** nrrdCommentCopy()
+**
+** copies comments from one nrrd to another
+** Existing comments in nout are blown away
+**
+** This does NOT use biff.
+*/
+int
+nrrdCommentCopy(Nrrd *nout, const Nrrd *nin) {
+ /* char me[]="nrrdCommentCopy", err[512]; */
+ int numc, i, E;
+
+ if (!(nout && nin)) {
+ /*
+ sprintf(err, "%s: got NULL pointer", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ */
+ return 1;
+ }
+ if (nout == nin) {
+ /* can't satisfy semantics of copying with nout==nin */
+ return 2;
+ }
+ nrrdCommentClear(nout);
+ numc = nin->cmtArr->len;
+ E = 0;
+ for (i=0; i<numc; i++) {
+ if (!E) E |= nrrdCommentAdd(nout, nin->cmt[i]);
+ }
+ if (E) {
+ /*
+ sprintf(err, "%s: couldn't add all comments", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ */
+ return 3;
+ }
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/defaultsNrrd.c b/Utilities/ITK/Utilities/NrrdIO/defaultsNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..f78a307d14d93a1e56a2539d8f136f2457f90fee
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/defaultsNrrd.c
@@ -0,0 +1,71 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+** these aren't "const"s because the user should be able to change
+** default behavior- until a more sophisticated mechanism for this
+** kind of control is developed, it seems simple and usable enough to
+** have this be global state which we agree to treat nicely, as in,
+** threads shouldn't be changing these willy-nilly.
+**
+** What IS a "default"? A default is the assertion of a certain
+** choice in situations where the user hasn't set it explicitly, but
+** COULD. The pad value in resampling is a good example: it is set by
+** a constructor to nrrdDefRsmpPadValue, but the user can also set it
+** explicitly.
+*/
+
+const NrrdEncoding *nrrdDefWriteEncoding = &_nrrdEncodingRaw;
+int nrrdDefWriteBareText = AIR_TRUE;
+int nrrdDefWriteCharsPerLine = 75;
+int nrrdDefWriteValsPerLine = 8;
+int nrrdDefCenter = nrrdCenterCell;
+double nrrdDefSpacing = 1.0;
+
+/* these aren't really "defaults" because there's no other channel for
+ specifying this information. It is just global state. Obviously,
+ like defaults, they are not thread-safe if different threads ever
+ set them differently. */
+int nrrdStateVerboseIO = 0;
+int nrrdStateAlwaysSetContent = AIR_TRUE;
+int nrrdStateDisableContent = AIR_FALSE;
+char *nrrdStateUnknownContent = NRRD_UNKNOWN;
+int nrrdStateGrayscaleImage3D = AIR_FALSE;
+/* there is no sane reason to change this default initialization */
+int nrrdStateKeyValueReturnInternalPointers = AIR_FALSE;
+/* Making the default for this be AIR_TRUE means that nrrd is not only
+ completely conservative about updating kind, but purposely stupid.
+ Nrrd is only going to implement the most converative kind of logic
+ anyway, based on existing sementics nailed down by the format spec. */
+int nrrdStateKindNoop = AIR_FALSE;
+
+/* should the acceptance (or not) of malformed NRRD header fields
+ embedded in PNM or text comments be controlled here? */
+
+/* Are there other assumptions currently built into nrrd which could
+ stand to be user-controllable? */
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/dio.c b/Utilities/ITK/Utilities/NrrdIO/dio.c
new file mode 100644
index 0000000000000000000000000000000000000000..1d530759359cf98ce0a1a07b73456c22224155d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/dio.c
@@ -0,0 +1,350 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+#include "teemDio.h"
+
+#if TEEM_DIO == 0
+#else
+/* HEY: these may be SGI-specific */
+#include <sys/types.h>
+#include <unistd.h>
+#include <fcntl.h>
+#endif
+
+#if TEEM_DIO == 0
+const int airMyDio = 0;
+#else
+const int airMyDio = 1;
+#endif
+
+int airDisableDio = AIR_FALSE;
+
+const char
+_airNoDioErr[AIR_NODIO_MAX+2][AIR_STRLEN_SMALL] = {
+ "(invalid noDio value)",
+ "CAN TOO do direct I/O!",
+ "direct I/O apparently not available on this architecture",
+ "direct I/O apparently not suitable for given file format",
+ "won't do direct I/O on std{in|out|err}",
+ "got -1 as file descriptor",
+ "fcntl(F_DIOINFO) to learn direct I/O specifics failed",
+ "requested transfer size is too small",
+ "requested transfer size not a multiple of d_miniosz",
+ "data memory address not multiple of d_mem",
+ "current file position not multiple of d_miniosz",
+ "fcntl(F_SETFL, FDIRECT) to turn on direct I/O failed",
+ "memalign() test (on a small chuck of memory) failed",
+ "direct I/O (in air library) has been disabled with airDisableDio"
+};
+
+const char *
+airNoDioErr(int noDio) {
+
+ if (AIR_IN_CL(0, noDio, AIR_NODIO_MAX)) {
+ return _airNoDioErr[noDio+1];
+ }
+ else {
+ return _airNoDioErr[0];
+ }
+}
+
+/*
+******** airDioTest
+**
+** does everything necessary to assess whether direct IO can be used
+** to read a data segment of a given size, from a given file
+** descriptor, into a given pointer. The given pointer ptr can be
+** NULL, and/or the size can be 0, in order to test the other aspects
+** of direct IO. The return value of this is from the airNoDio_* enum.
+** Note that airNoDio_okay means, "actually, direct IO *does* seem to
+** be possible here".
+*/
+#if TEEM_DIO == 0
+int
+airDioTest(int fd, const void *ptr, size_t size) {
+ AIR_UNUSED(fd);
+ AIR_UNUSED(ptr);
+ AIR_UNUSED(size);
+
+ /* Teem makefiles think no direct IO is possible on this architecture */
+ return airNoDio_arch;
+}
+#else
+int
+airDioTest(int fd, const void *ptr, size_t size) {
+ struct dioattr dioinfo;
+ void *tmp;
+ int flags;
+
+ if (airDisableDio) {
+ /* user turned direct I/O off */
+ return airNoDio_disable;
+ }
+ if (0 == fd || 1 == fd || 2 == fd) {
+ /* This was added because I was noticing a problem with piping
+ between unrrdu programs- sometimes the fread() of the receiving
+ data through a unix pipe ("|") failed to read all the data. If
+ the body of this function was bypassed (with "return
+ airNoDio_disable;", for instance), then the problem went away.
+ The problematic call seemed to be the fflush() below (Tue Feb 1
+ 06:47:33 EST 2005: which has since been removed with the change
+ of this function's argument from a FILE * to an integral file
+ descriptor). I don't think direct I/O is possible on stdin,
+ stdout, or stdout, since the fcntl() call below fails on stdin
+ and stdout. However, something about making that fcntl() call
+ changes something which means that about half the time, the
+ read() on a piped stdin fails (on an irix6.n32 O2, at
+ least). So, seems to be safest to just explicitly say that
+ direct I/O is unavailable, based solely on the file descriptor
+ number (0, 1, 2). */
+ return airNoDio_std;
+ }
+ if (-1 == fd) {
+ /* caller probably couldn't get the underlying file descriptor */
+ return airNoDio_fd;
+ }
+ if (0 != fcntl(fd, F_DIOINFO, &dioinfo)) {
+ /* couldn't learn direct I/O specifics */
+ return airNoDio_dioinfo;
+ }
+
+ if (size) {
+ /*
+ ** direct I/O requirements:
+ ** 1) xfer size between d_miniosz and d_maxiosz
+ ** 2) xfer size a multiple of d_miniosz
+ ** 3) memory buffer on d_mem-byte boundary
+ ** 4) file position on d_miniosz-byte boundary
+ **
+ ** As long as xfer size is >= d_miniosz and meets req. #2, then
+ ** we can break the xfer into d_maxiosz-size pieces of need be.
+ ** We can test #3 here if we're given non-NULL ptr
+ ** We can always test #4
+ */
+ if (size < dioinfo.d_miniosz) {
+ /* fails req. #1 above */
+ return airNoDio_small;
+ }
+ /* we don't actually check for being too large, since we can always
+ do IO on d_maxiosz-sized pieces */
+ if (size % dioinfo.d_miniosz) {
+ /* fails req. #2 above */
+ return airNoDio_size;
+ }
+ }
+ if (ptr) {
+ if ((unsigned long)(ptr) % dioinfo.d_mem) {
+ /* fails req. #3 above */
+ return airNoDio_ptr;
+ }
+ } else {
+ tmp = memalign(dioinfo.d_mem, dioinfo.d_miniosz);
+ if (!tmp) {
+ /* couldn't even alloc (via memalign) the minimum size */
+ return airNoDio_test;
+ }
+ free(tmp);
+ }
+ if (lseek(fd, 0, SEEK_CUR) % dioinfo.d_miniosz) {
+ /* fails req. #4 above */
+ return airNoDio_fpos;
+ }
+ flags = fcntl(fd, F_GETFL);
+ if (-1 == fcntl(fd, F_SETFL, flags | FDIRECT)) {
+ /* couln't turn on direct I/O */
+ return airNoDio_setfl;
+ }
+ /* put things back the way they were */
+ fcntl(fd, F_SETFL, flags);
+
+ /* as far as we know, direct I/O seems workable */
+ return airNoDio_okay;
+}
+#endif
+
+/*
+******** airDioInfo
+**
+** does the fcntl stuff to learn the direct IO parameters:
+** align: required alignment of memory (pointer must be multiple of this)
+** min: minimum size of dio transfer
+** max: maximum size of dio transfer
+**
+** NOTE: this does not try to do any error checking, because it assumes
+** that you've already called airDioTest without incident.
+*/
+#if TEEM_DIO == 0
+void
+airDioInfo(int *align, int *min, int *max, int fd) {
+ AIR_UNUSED(align);
+ AIR_UNUSED(min);
+ AIR_UNUSED(max);
+ AIR_UNUSED(fd);
+ return;
+}
+#else
+void
+airDioInfo(int *align, int *min, int *max, int fd) {
+ struct dioattr dioinfo;
+
+ if (align && min && max && !fcntl(fd, F_DIOINFO, &dioinfo)) {
+ *align = dioinfo.d_mem;
+ *min = dioinfo.d_miniosz;
+ *max = dioinfo.d_maxiosz;
+ }
+ return;
+}
+#endif
+
+/*
+******** airDioMalloc
+**
+** does direct IO compatible memory allocation.
+**
+** NOTE: like airDioInfo, this assumes that you've called airDioTest
+** without incident
+*/
+#if TEEM_DIO == 0
+void *
+airDioMalloc(size_t size, int fd) {
+ AIR_UNUSED(size);
+ AIR_UNUSED(fd);
+
+ return NULL;
+}
+#else
+void *
+airDioMalloc(size_t size, int fd) {
+ int align, min, max;
+
+ airDioInfo(&align, &min, &max, fd);
+ return memalign(align, size);
+}
+#endif
+
+/*
+******** airDioRead
+**
+** like read(), but for direct IO. The idea is that you call this on as
+** big a chunk of memory as possible.
+**
+** NOTE: like airDioInfo, this assumes that you've called airDioTest
+** without incident
+*/
+#if TEEM_DIO == 0
+size_t
+airDioRead(int fd, void *_ptr, size_t size) {
+ AIR_UNUSED(fd);
+ AIR_UNUSED(_ptr);
+ AIR_UNUSED(size);
+
+ return 0;
+}
+#else
+size_t
+airDioRead(int fd, void *_ptr, size_t size) {
+ size_t red, totalred;
+ int align, min, max, flags;
+ size_t remain, part;
+ char *ptr;
+
+ if (!( _ptr && airNoDio_okay == airDioTest(fd, _ptr, size) )) {
+ return 0;
+ }
+
+ flags = fcntl(fd, F_GETFL);
+ fcntl(fd, F_SETFL, flags | FDIRECT);
+ airDioInfo(&align, &min, &max, fd);
+ remain = size;
+ totalred = 0;
+ ptr = (char*)_ptr;
+ do {
+ part = AIR_MIN(remain, max);
+ red = read(fd, ptr, part);
+ totalred += red;
+ if (red != part) {
+ break;
+ }
+ ptr += red;
+ remain -= red;
+ } while (remain);
+ fcntl(fd, F_SETFL, flags);
+
+ return totalred;
+}
+#endif
+
+/*
+******** airDioWrite
+**
+** like write(), but for direct IO. The idea is that you call this on as
+** big a chunk of memory as possible.
+**
+** NOTE: like airDioInfo, this assumes that you've called airDioTest
+** without incident
+*/
+#if TEEM_DIO == 0
+size_t
+airDioWrite(int fd, const void *_ptr, size_t size) {
+ AIR_UNUSED(fd);
+ AIR_UNUSED(_ptr);
+ AIR_UNUSED(size);
+
+ return 0;
+}
+#else
+size_t
+airDioWrite(int fd, const void *_ptr, size_t size) {
+ size_t rit, totalrit;
+ int align, min, max, flags;
+ size_t remain, part;
+ char *ptr;
+
+ if (!( _ptr && (airNoDio_okay == airDioTest(fd, _ptr, size)) )) {
+ return 0;
+ }
+
+ flags = fcntl(fd, F_GETFL);
+ fcntl(fd, F_SETFL, flags | FDIRECT);
+ airDioInfo(&align, &min, &max, fd);
+ remain = size;
+ totalrit = 0;
+ ptr = (char*)_ptr;
+ do {
+ part = AIR_MIN(remain, max);
+ rit = write(fd, ptr, part);
+ totalrit += rit;
+ if (rit != part) {
+ break;
+ }
+ ptr += rit;
+ remain -= rit;
+ } while (remain);
+ fcntl(fd, F_SETFL, flags);
+
+ return totalrit;
+}
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/encoding.c b/Utilities/ITK/Utilities/NrrdIO/encoding.c
new file mode 100644
index 0000000000000000000000000000000000000000..a6ad768f5aa8918bf6efd8c2c21f72a6fe709047
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encoding.c
@@ -0,0 +1,113 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+** what a NrrdEncoding can assume:
+** -- the given nrrd struct has been filled out for the sake of knowing
+** nrrd->dim, nrrd->axis[0].size, nrrd->type, and nrrd->blockSize
+** AND NOTHING ELSE. See nrrd.h for why those fields, of all things
+** are needed for {en/de}coding
+**
+** what a NrrdEncoding has to do:
+** -- read data from file into the "data" argument (BUT NOT nrrd->data!!),
+** or vice versa.
+** -- respect nrrdStateVerboseIO with messages to stderr, if possible
+** -- in case of error, put text error messages into biff via
+** biffAdd(NRRD, <error char*>)
+**
+** The "unknown" encoding below is intended to serve as a template for
+** any new encodings being developed.
+*/
+
+int
+_nrrdEncodingUnknown_available(void) {
+
+ /* insert code here */
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdEncodingUnknown_read(FILE *file, void *data,
+ size_t elementNum, Nrrd *nrrd,
+ struct NrrdIoState_t *nio) {
+ char me[]="_nrrdEncodingUnknown_read", err[AIR_STRLEN_MED];
+
+ /* insert code here, and remove error handling below */
+ AIR_UNUSED(file);
+ AIR_UNUSED(data);
+ AIR_UNUSED(elementNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+
+ sprintf(err, "%s: ERROR!!! trying to read unknown encoding", me);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdEncodingUnknown_write(FILE *file, const void *data,
+ size_t elementNum, const Nrrd *nrrd,
+ struct NrrdIoState_t *nio) {
+ char me[]="_nrrdEncodingUnknown_write", err[AIR_STRLEN_MED];
+
+ /* insert code here, and remove error handling below */
+ AIR_UNUSED(file);
+ AIR_UNUSED(data);
+ AIR_UNUSED(elementNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+
+ sprintf(err, "%s: ERROR!!! trying to write unknown encoding", me);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdEncoding
+_nrrdEncodingUnknown = {
+ "unknown", /* name */
+ "unknown", /* suffix */
+ AIR_FALSE, /* endianMatters */
+ AIR_FALSE, /* isCompression */
+ _nrrdEncodingUnknown_available,
+ _nrrdEncodingUnknown_read,
+ _nrrdEncodingUnknown_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingUnknown = &_nrrdEncodingUnknown;
+
+const NrrdEncoding *const
+nrrdEncodingArray[NRRD_ENCODING_TYPE_MAX+1] = {
+ &_nrrdEncodingUnknown,
+ &_nrrdEncodingRaw,
+ &_nrrdEncodingAscii,
+ &_nrrdEncodingHex,
+ &_nrrdEncodingGzip,
+ &_nrrdEncodingBzip2
+};
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/encodingAscii.c b/Utilities/ITK/Utilities/NrrdIO/encodingAscii.c
new file mode 100644
index 0000000000000000000000000000000000000000..a74d4009d9be9a123cb8354192b0ed289c22d9a5
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encodingAscii.c
@@ -0,0 +1,137 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdEncodingAscii_available(void) {
+
+ return AIR_TRUE;
+}
+
+int
+_nrrdEncodingAscii_read(FILE *file, void *_data, size_t elNum,
+ Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingAscii_read", err[AIR_STRLEN_MED],
+ numbStr[AIR_STRLEN_HUGE]; /* HEY: fix this */
+ size_t I;
+ char *data;
+ int tmp;
+
+ AIR_UNUSED(nio);
+ if (nrrdTypeBlock == nrrd->type) {
+ sprintf(err, "%s: can't read nrrd type %s from %s", me,
+ airEnumStr(nrrdType, nrrdTypeBlock),
+ nrrdEncodingAscii->name);
+ biffAdd(NRRD, err); return 1;
+ }
+ data = (char*)_data;
+ for (I=0; I<elNum; I++) {
+ if (1 != fscanf(file, "%s", numbStr)) {
+ sprintf(err, "%s: couldn't parse element " _AIR_SIZE_T_CNV
+ " of " _AIR_SIZE_T_CNV, me, I+1, elNum);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrd->type >= nrrdTypeInt) {
+ /* sscanf supports putting value directly into this type */
+ if (1 != airSingleSscanf(numbStr, nrrdTypePrintfStr[nrrd->type],
+ (void*)(data + I*nrrdElementSize(nrrd)))) {
+ sprintf(err, "%s: couln't parse %s " _AIR_SIZE_T_CNV
+ " of " _AIR_SIZE_T_CNV " (\"%s\")", me,
+ airEnumStr(nrrdType, nrrd->type),
+ I+1, elNum, numbStr);
+ biffAdd(NRRD, err); return 1;
+ }
+ } else {
+ /* sscanf value into an int first */
+ if (1 != airSingleSscanf(numbStr, "%d", &tmp)) {
+ sprintf(err, "%s: couln't parse element " _AIR_SIZE_T_CNV
+ " of " _AIR_SIZE_T_CNV " (\"%s\")",
+ me, I+1, elNum, numbStr);
+ biffAdd(NRRD, err); return 1;
+ }
+ nrrdIInsert[nrrd->type](data, I, tmp);
+ }
+ }
+
+ return 0;
+}
+
+int
+_nrrdEncodingAscii_write(FILE *file, const void *_data, size_t elNum,
+ const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingAscii_write", err[AIR_STRLEN_MED],
+ buff[AIR_STRLEN_MED];
+ unsigned int bufflen, linelen;
+ const char *data;
+ size_t I;
+
+ if (nrrdTypeBlock == nrrd->type) {
+ sprintf(err, "%s: can't write nrrd type %s to %s", me,
+ airEnumStr(nrrdType, nrrdTypeBlock),
+ nrrdEncodingAscii->name);
+ biffAdd(NRRD, err); return 1;
+ }
+ data = (char*)_data;
+ linelen = 0;
+ for (I=0; I<elNum; I++) {
+ nrrdSprint[nrrd->type](buff, data);
+ if (1 == nrrd->dim) {
+ fprintf(file, "%s\n", buff);
+ } else if (nrrd->dim == 2
+ && nrrd->axis[0].size <= nio->valsPerLine) {
+ fprintf(file, "%s%c", buff,
+ (I+1)%(nrrd->axis[0].size) ? ' ' : '\n');
+ } else {
+ bufflen = strlen(buff);
+ if (linelen+bufflen+1 <= nio->charsPerLine) {
+ fprintf(file, "%s%s", I ? " " : "", buff);
+ linelen += (I ? 1 : 0) + bufflen;
+ } else {
+ fprintf(file, "\n%s", buff);
+ linelen = bufflen;
+ }
+ }
+ data += nrrdElementSize(nrrd);
+ }
+ /* just to be sure, we always end with a carraige return */
+ fprintf(file, "\n");
+
+ return 0;
+}
+
+const NrrdEncoding
+_nrrdEncodingAscii = {
+ "ASCII", /* name */
+ "ascii", /* suffix */
+ AIR_FALSE, /* endianMatters */
+ AIR_FALSE, /* isCompression */
+ _nrrdEncodingAscii_available,
+ _nrrdEncodingAscii_read,
+ _nrrdEncodingAscii_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingAscii = &_nrrdEncodingAscii;
diff --git a/Utilities/ITK/Utilities/NrrdIO/encodingBzip2.c b/Utilities/ITK/Utilities/NrrdIO/encodingBzip2.c
new file mode 100644
index 0000000000000000000000000000000000000000..c21bd5a288251ce7a60ecc4e0e41edb65f45726f
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encodingBzip2.c
@@ -0,0 +1,76 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdEncodingBzip2_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdEncodingBzip2_read(FILE *file, void *data, size_t elementNum,
+ Nrrd *nrrd, struct NrrdIoState_t *nio) {
+ char me[]="_nrrdEncodingBzip2_read", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(data);
+ AIR_UNUSED(elementNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s encoding not available in NrrdIO",
+ me, nrrdEncodingBzip2->name);
+ biffAdd(NRRD, err); return 1;
+}
+
+int
+_nrrdEncodingBzip2_write(FILE *file, const void *data, size_t elementNum,
+ const Nrrd *nrrd, struct NrrdIoState_t *nio) {
+ char me[]="_nrrdEncodingBzip2_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(data);
+ AIR_UNUSED(elementNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s encoding not available in NrrdIO",
+ me, nrrdEncodingBzip2->name);
+ biffAdd(NRRD, err); return 1;
+}
+
+const NrrdEncoding
+_nrrdEncodingBzip2 = {
+ "bzip2", /* name */
+ "raw.bz2", /* suffix */
+ AIR_TRUE, /* endianMatters */
+ AIR_TRUE, /* isCompression */
+ _nrrdEncodingBzip2_available,
+ _nrrdEncodingBzip2_read,
+ _nrrdEncodingBzip2_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingBzip2 = &_nrrdEncodingBzip2;
diff --git a/Utilities/ITK/Utilities/NrrdIO/encodingGzip.c b/Utilities/ITK/Utilities/NrrdIO/encodingGzip.c
new file mode 100644
index 0000000000000000000000000000000000000000..afc84eb9302fa29cda2fefc1ac4b83284c91d81b
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encodingGzip.c
@@ -0,0 +1,261 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdEncodingGzip_available(void) {
+
+#if TEEM_ZLIB
+ return AIR_TRUE;
+#else
+ return AIR_FALSE;
+#endif
+}
+
+int
+_nrrdEncodingGzip_read(FILE *file, void *_data, size_t elNum,
+ Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingGzip_read", err[AIR_STRLEN_MED];
+#if TEEM_ZLIB
+ size_t bsize, total_read, block_size;
+ int i, error;
+ unsigned int read;
+ char *data;
+ gzFile gzfin;
+
+ bsize = nrrdElementSize(nrrd)*elNum;
+
+ /* Create the gzFile for reading in the gzipped data. */
+ if ((gzfin = _nrrdGzOpen(file, "rb")) == Z_NULL) {
+ /* there was a problem */
+ sprintf(err, "%s: error opening gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* Here is where we do the byte skipping. */
+ for(i = 0; i < nio->byteSkip; i++) {
+ unsigned char b;
+ /* Check to see if a single byte was able to be read. */
+ if (_nrrdGzRead(gzfin, &b, 1, &read) != 0 || read != 1) {
+ sprintf(err, "%s: hit an error skipping byte %d of %d",
+ me, i, nio->byteSkip);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+ }
+
+ /* zlib can handle data sizes up to UINT_MAX, so we can't just
+ pass in the size, because it might be too large for an
+ unsigned int. Therefore it must be read in chunks
+ if the size is larger than UINT_MAX. */
+ if (bsize <= UINT_MAX) {
+ block_size = bsize;
+ } else {
+ block_size = UINT_MAX;
+ }
+
+ /* This counter will help us to make sure that we read as much data
+ as we think we should. */
+ total_read = 0;
+ /* Pointer to the blocks as we read them. */
+ data = (char *)_data;
+
+ /* Ok, now we can begin reading. */
+ while ((error = _nrrdGzRead(gzfin, data, block_size, &read)) == 0
+ && read > 0) {
+ /* Increment the data pointer to the next available spot. */
+ data += read;
+ total_read += read;
+ /* We only want to read as much data as we need, so we need to check
+ to make sure that we don't request data that might be there but that
+ we don't want. This will reduce block_size when we get to the last
+ block (which may be smaller than block_size).
+ */
+ if (bsize >= total_read
+ && bsize - total_read < block_size) {
+ block_size = bsize - total_read;
+ }
+ }
+
+ /* Check if we stopped because of an error. */
+ if (error != 0)
+ {
+ sprintf(err, "%s: error reading from gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* Close the gzFile. Since _nrrdGzClose does not close the FILE* we
+ will not encounter problems when dataFile is closed later. */
+ if (_nrrdGzClose(gzfin) != 0) {
+ sprintf(err, "%s: error closing gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* Check to see if we got out as much as we thought we should. */
+ if (total_read != bsize) {
+ sprintf(err, "%s: expected " _AIR_SIZE_T_CNV " bytes and received "
+ _AIR_SIZE_T_CNV " bytes",
+ me, bsize, total_read);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ return 0;
+#else
+ AIR_UNUSED(file);
+ AIR_UNUSED(_data);
+ AIR_UNUSED(elNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: sorry, this nrrd not compiled with gzip enabled", me);
+ biffAdd(NRRD, err); return 1;
+#endif
+}
+
+int
+_nrrdEncodingGzip_write(FILE *file, const void *_data, size_t elNum,
+ const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingGzip_write", err[AIR_STRLEN_MED];
+#if TEEM_ZLIB
+ size_t bsize, total_written, block_size;
+ int fmt_i=0, error;
+ char *data, fmt[4];
+ gzFile gzfout;
+ unsigned int wrote;
+
+ bsize = nrrdElementSize(nrrd)*elNum;
+
+ /* Set format string based on the NrrdIoState parameters. */
+ fmt[fmt_i++] = 'w';
+ if (0 <= nio->zlibLevel && nio->zlibLevel <= 9)
+ fmt[fmt_i++] = '0' + nio->zlibLevel;
+ switch (nio->zlibStrategy) {
+ case nrrdZlibStrategyHuffman:
+ fmt[fmt_i++] = 'h';
+ break;
+ case nrrdZlibStrategyFiltered:
+ fmt[fmt_i++] = 'f';
+ break;
+ case nrrdZlibStrategyDefault:
+ default:
+ break;
+ }
+ fmt[fmt_i] = 0;
+
+ /* Create the gzFile for writing in the gzipped data. */
+ if ((gzfout = _nrrdGzOpen(file, fmt)) == Z_NULL) {
+ /* there was a problem */
+ sprintf(err, "%s: error opening gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* zlib can handle data sizes up to UINT_MAX, so we can't just
+ pass in the bsize, because it might be too large for an
+ unsigned int. Therefore it must be read in chunks
+ if the bsize is larger than UINT_MAX. */
+ if (bsize <= UINT_MAX) {
+ block_size = bsize;
+ } else {
+ block_size = UINT_MAX;
+ }
+
+ /* This counter will help us to make sure that we write as much data
+ as we think we should. */
+ total_written = 0;
+ /* Pointer to the blocks as we write them. */
+ data = (char *)_data;
+
+ /* Ok, now we can begin writing. */
+ while ((error = _nrrdGzWrite(gzfout, data, block_size, &wrote)) == 0
+ && wrote > 0) {
+ /* Increment the data pointer to the next available spot. */
+ data += wrote;
+ total_written += wrote;
+ /* We only want to write as much data as we need, so we need to check
+ to make sure that we don't write more data than is there. This
+ will reduce block_size when we get to the last block (which may
+ be smaller than block_size).
+ */
+ if (bsize >= total_written
+ && (unsigned int)(bsize - total_written) < block_size)
+ block_size = bsize - total_written;
+ }
+
+ /* Check if we stopped because of an error. */
+ if (error != 0)
+ {
+ sprintf(err, "%s: error reading from gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* Close the gzFile. Since _nrrdGzClose does not close the FILE* we
+ will not encounter problems when dataFile is closed later. */
+ if (_nrrdGzClose(gzfout) != 0) {
+ sprintf(err, "%s: error closing gzFile", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ /* Check to see if we got out as much as we thought we should. */
+ if (total_written != bsize) {
+ sprintf(err, "%s: expected to write " _AIR_SIZE_T_CNV " bytes, but only "
+ "wrote " _AIR_SIZE_T_CNV,
+ me, bsize, total_written);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+
+ return 0;
+#else
+ AIR_UNUSED(file);
+ AIR_UNUSED(_data);
+ AIR_UNUSED(elNum);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: sorry, this nrrd not compiled with zlib "
+ "(needed for gzip) enabled", me);
+ biffAdd(NRRD, err); return 1;
+#endif
+}
+
+const NrrdEncoding
+_nrrdEncodingGzip = {
+ "gzip", /* name */
+ "raw.gz", /* suffix */
+ AIR_TRUE, /* endianMatters */
+ AIR_TRUE, /* isCompression */
+ _nrrdEncodingGzip_available,
+ _nrrdEncodingGzip_read,
+ _nrrdEncodingGzip_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingGzip = &_nrrdEncodingGzip;
diff --git a/Utilities/ITK/Utilities/NrrdIO/encodingHex.c b/Utilities/ITK/Utilities/NrrdIO/encodingHex.c
new file mode 100644
index 0000000000000000000000000000000000000000..bd942151b636d57dfee1ea7bd140483000ef2bfc
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encodingHex.c
@@ -0,0 +1,144 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+const int
+_nrrdWriteHexTable[16] = {
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'
+};
+
+/*
+** -2: not allowed, error
+** -1: whitespace
+** [0,15]: values
+*/
+const int
+_nrrdReadHexTable[128] = {
+/* 0 1 2 3 4 5 6 7 8 9 */
+ -2, -2, -2, -2, -2, -2, -2, -2, -2, -1, /* 0 */
+ -1, -1, -1, -1, -2, -2, -2, -2, -2, -2, /* 10 */
+ -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, /* 20 */
+ -2, -2, -1, -2, -2, -2, -2, -2, -2, -2, /* 30 */
+ -2, -2, -2, -2, -2, -2, -2, -2, 0, 1, /* 40 */
+ 2, 3, 4, 5, 6, 7, 8, 9, -2, -2, /* 50 */
+ -2, -2, -2, -2, -2, 10, 11, 12, 13, 14, /* 60 */
+ 15, -2, -2, -2, -2, -2, -2, -2, -2, -2, /* 70 */
+ -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, /* 80 */
+ -2, -2, -2, -2, -2, -2, -2, 10, 11, 12, /* 90 */
+ 13, 14, 15, -2, -2, -2, -2, -2, -2, -2, /* 100 */
+ -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, /* 110 */
+ -2, -2, -2, -2, -2, -2, -2, -2 /* 120 */
+};
+
+
+int
+_nrrdEncodingHex_available(void) {
+
+ return AIR_TRUE;
+}
+
+int
+_nrrdEncodingHex_read(FILE *file, void *_data, size_t elNum,
+ Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingHex_read", err[AIR_STRLEN_MED];
+ size_t nibIdx, nibNum;
+ unsigned char *data;
+ int car=0, nib;
+
+ AIR_UNUSED(nio);
+ data = (unsigned char *)_data;
+ nibIdx = 0;
+ nibNum = 2*elNum*nrrdElementSize(nrrd);
+ if (nibNum/elNum != 2*nrrdElementSize(nrrd)) {
+ sprintf(err, "%s: size_t can't hold 2*(#bytes in array)\n", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ while (nibIdx < nibNum) {
+ car = fgetc(file);
+ if (EOF == car) break;
+ nib = _nrrdReadHexTable[car & 127];
+ if (-2 == nib) {
+ /* not a valid hex character */
+ break;
+ }
+ if (-1 == nib) {
+ /* its white space */
+ continue;
+ }
+ *data += nib << (4*(1-(nibIdx & 1)));
+ data += nibIdx & 1;
+ nibIdx++;
+ }
+ if (nibIdx != nibNum) {
+ if (EOF == car) {
+ sprintf(err, "%s: hit EOF getting "
+ "byte " _AIR_SIZE_T_CNV " of " _AIR_SIZE_T_CNV,
+ me, nibIdx/2, nibNum/2);
+ } else {
+ sprintf(err, "%s: hit invalid character ('%c') getting "
+ "byte " _AIR_SIZE_T_CNV " of " _AIR_SIZE_T_CNV,
+ me, car, nibIdx/2, nibNum/2);
+ }
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdEncodingHex_write(FILE *file, const void *_data, size_t elNum,
+ const Nrrd *nrrd, NrrdIoState *nio) {
+ /* char me[]="_nrrdEncodingHex_write", err[AIR_STRLEN_MED]; */
+ unsigned char *data;
+ size_t byteIdx, byteNum;
+
+ AIR_UNUSED(nio);
+ data = (unsigned char*)_data;
+ byteNum = elNum*nrrdElementSize(nrrd);
+ for (byteIdx=0; byteIdx<byteNum; byteIdx++) {
+ fprintf(file, "%c%c",
+ _nrrdWriteHexTable[(*data)>>4],
+ _nrrdWriteHexTable[(*data)&15]);
+ if (34 == byteIdx%35)
+ fprintf(file, "\n");
+ data++;
+ }
+ return 0;
+}
+
+const NrrdEncoding
+_nrrdEncodingHex = {
+ "hex", /* name */
+ "hex", /* suffix */
+ AIR_TRUE, /* endianMatters */
+ AIR_FALSE, /* isCompression */
+ _nrrdEncodingHex_available,
+ _nrrdEncodingHex_read,
+ _nrrdEncodingHex_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingHex = &_nrrdEncodingHex;
diff --git a/Utilities/ITK/Utilities/NrrdIO/encodingRaw.c b/Utilities/ITK/Utilities/NrrdIO/encodingRaw.c
new file mode 100644
index 0000000000000000000000000000000000000000..50cfc0174f3498be6794a5bcc70cef5b91681574
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/encodingRaw.c
@@ -0,0 +1,161 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdEncodingRaw_available(void) {
+
+ return AIR_TRUE;
+}
+
+int
+_nrrdEncodingRaw_read(FILE *file, void *data, size_t elementNum,
+ Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingRaw_read", err[AIR_STRLEN_MED];
+ size_t ret, bsize;
+ int fd, dio, car;
+ long savePos;
+
+ bsize = nrrdElementSize(nrrd)*elementNum;
+ if (nio->format->usesDIO) {
+ fd = fileno(file);
+ dio = airDioTest(fd, data, bsize);
+ } else {
+ fd = -1;
+ dio = airNoDio_format;
+ }
+ if (airNoDio_okay == dio) {
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "with direct I/O ... ");
+ }
+ ret = airDioRead(fd, data, bsize);
+ if (ret != bsize) {
+ sprintf(err, "%s: airDioRead got read only "
+ _AIR_SIZE_T_CNV " of " _AIR_SIZE_T_CNV " bytes "
+ "(%g%% of expected)", me,
+ ret, bsize, 100.0*ret/bsize);
+ biffAdd(NRRD, err); return 1;
+ }
+ } else {
+ if (2 <= nrrdStateVerboseIO) {
+ if (AIR_DIO && nio->format->usesDIO) {
+ fprintf(stderr, "with fread(), not DIO: %s ...", airNoDioErr(dio));
+ }
+ }
+ ret = fread(data, nrrdElementSize(nrrd), elementNum, file);
+ if (ret != elementNum) {
+ sprintf(err, "%s: fread got read only "
+ _AIR_SIZE_T_CNV " " _AIR_SIZE_T_CNV "-sized things, not "
+ _AIR_SIZE_T_CNV " (%g%% of expected)", me,
+ ret, nrrdElementSize(nrrd), elementNum,
+ 100.0*ret/elementNum);
+ biffAdd(NRRD, err); return 1;
+ }
+ car = fgetc(file);
+ if (1 <= nrrdStateVerboseIO && EOF != car) {
+ fprintf(stderr, "%s: WARNING: finished reading raw data, "
+ "but file not at EOF\n", me);
+ ungetc(car, file);
+ }
+ if (2 <= nrrdStateVerboseIO && nio->byteSkip && stdin != file) {
+ savePos = ftell(file);
+ if (!fseek(file, 0, SEEK_END)) {
+ fprintf(stderr, "(%s: used %g%% of file for nrrd data)\n",
+ me, 100.0*bsize/(ftell(file) + 1));
+ fseek(file, savePos, SEEK_SET);
+ }
+ }
+ }
+
+ return 0;
+}
+
+int
+_nrrdEncodingRaw_write(FILE *file, const void *data, size_t elementNum,
+ const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdEncodingRaw_write", err[AIR_STRLEN_MED];
+ int fd, dio;
+ size_t ret, bsize;
+
+ bsize = nrrdElementSize(nrrd)*elementNum;
+ if (nio->format->usesDIO) {
+ fd = fileno(file);
+ dio = airDioTest(fd, data, bsize);
+ } else {
+ fd = -1;
+ dio = airNoDio_format;
+ }
+ if (airNoDio_okay == dio) {
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "with direct I/O ... ");
+ }
+ ret = airDioWrite(fd, data, bsize);
+ if (ret != bsize) {
+ sprintf(err, "%s: airDioWrite wrote only "
+ _AIR_SIZE_T_CNV " of " _AIR_SIZE_T_CNV " bytes "
+ "(%g%% of expected)", me,
+ ret, bsize, 100.0*ret/bsize);
+ biffAdd(NRRD, err); return 1;
+ }
+ } else {
+ if (2 <= nrrdStateVerboseIO) {
+ if (AIR_DIO && nio->format->usesDIO) {
+ fprintf(stderr, "with fread(), not DIO: %s ...", airNoDioErr(dio));
+ }
+ }
+ ret = fwrite(data, nrrdElementSize(nrrd), elementNum, file);
+ if (ret != elementNum) {
+ sprintf(err, "%s: fwrite wrote read only "
+ _AIR_SIZE_T_CNV " " _AIR_SIZE_T_CNV "-sized things, not "
+ _AIR_SIZE_T_CNV " (%g%% of expected)", me,
+ ret, nrrdElementSize(nrrd), elementNum,
+ 100.0*ret/elementNum);
+ biffAdd(NRRD, err); return 1;
+ }
+ fflush(file);
+ /*
+ if (ferror(file)) {
+ sprintf(err, "%s: ferror returned non-zero", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ */
+ }
+ return 0;
+}
+
+const NrrdEncoding
+_nrrdEncodingRaw = {
+ "raw", /* name */
+ "raw", /* suffix */
+ AIR_TRUE, /* endianMatters */
+ AIR_FALSE, /* isCompression */
+ _nrrdEncodingRaw_available,
+ _nrrdEncodingRaw_read,
+ _nrrdEncodingRaw_write
+};
+
+const NrrdEncoding *const
+nrrdEncodingRaw = &_nrrdEncodingRaw;
diff --git a/Utilities/ITK/Utilities/NrrdIO/endianAir.c b/Utilities/ITK/Utilities/NrrdIO/endianAir.c
new file mode 100644
index 0000000000000000000000000000000000000000..d8ccbcd8869b3df3b797676a3dba52e8782c8346
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/endianAir.c
@@ -0,0 +1,73 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+#include "teemEndian.h"
+
+/*
+******** int airMyEndian
+**
+** it gets set to 1234 or 4321
+*/
+#if TEEM_ENDIAN == 1234
+const int airMyEndian = 1234;
+#else
+const int airMyEndian = 4321;
+#endif
+
+char
+_airEndianStr[][AIR_STRLEN_SMALL] = {
+ "(unknown endian)",
+ "little",
+ "big"
+};
+
+char
+_airEndianDesc[][AIR_STRLEN_MED] = {
+ "unknown endianness",
+ "Intel and compatible",
+ "Everyone besides Intel and compatible"
+};
+
+int
+_airEndianVal[] = {
+ airEndianUnknown,
+ airEndianLittle,
+ airEndianBig,
+};
+
+airEnum
+_airEndian = {
+ "endian",
+ 2,
+ _airEndianStr, _airEndianVal,
+ _airEndianDesc,
+ NULL, NULL,
+ AIR_FALSE
+};
+
+airEnum *
+airEndian = &_airEndian;
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/endianNrrd.c b/Utilities/ITK/Utilities/NrrdIO/endianNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..4dacf3ef42fcaeedf891b0daffd8ac6174ae4b3a
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/endianNrrd.c
@@ -0,0 +1,125 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+void
+_nrrdSwap16Endian(void *_data, size_t N) {
+ short *data, s, fix;
+ size_t I;
+
+ if (_data) {
+ data = (short *)_data;
+ for (I=0; I<N; I++) {
+ s = data[I];
+ fix = (s & 0x00FF);
+ fix = ((s & 0xFF00) >> 0x08) | (fix << 0x08);
+ data[I] = fix;
+ }
+ }
+}
+
+void
+_nrrdSwap32Endian(void *_data, size_t N) {
+ int *data, w, fix;
+ size_t I;
+
+ if (_data) {
+ data = (int *)_data;
+ for (I=0; I<N; I++) {
+ w = data[I];
+ fix = (w & 0x000000FF);
+ fix = ((w & 0x0000FF00) >> 0x08) | (fix << 0x08);
+ fix = ((w & 0x00FF0000) >> 0x10) | (fix << 0x08);
+ fix = ((w & 0xFF000000) >> 0x18) | (fix << 0x08);
+ data[I] = fix;
+ }
+ }
+}
+
+void
+_nrrdSwap64Endian(void *_data, size_t N) {
+ airLLong *data, l, fix;
+ size_t I;
+
+ if (_data) {
+ data = (airLLong *)_data;
+ for (I=0; I<N; I++) {
+ l = data[I];
+ fix = (l & 0x00000000000000FF);
+ fix = ((l & 0x000000000000FF00) >> 0x08) | (fix << 0x08);
+ fix = ((l & 0x0000000000FF0000) >> 0x10) | (fix << 0x08);
+ fix = ((l & 0x00000000FF000000) >> 0x18) | (fix << 0x08);
+ fix = ((l & AIR_LLONG(0x000000FF00000000)) >> 0x20) | (fix << 0x08);
+ fix = ((l & AIR_LLONG(0x0000FF0000000000)) >> 0x28) | (fix << 0x08);
+ fix = ((l & AIR_LLONG(0x00FF000000000000)) >> 0x30) | (fix << 0x08);
+ fix = ((l & AIR_LLONG(0xFF00000000000000)) >> 0x38) | (fix << 0x08);
+ data[I] = fix;
+ }
+ }
+}
+
+void
+_nrrdNoopEndian(void *data, size_t N) {
+ AIR_UNUSED(data);
+ AIR_UNUSED(N);
+ return;
+}
+
+void
+_nrrdBlockEndian(void *data, size_t N) {
+ char me[]="_nrrdBlockEndian";
+
+ AIR_UNUSED(data);
+ AIR_UNUSED(N);
+ fprintf(stderr, "%s: WARNING: can't fix endiannes of nrrd type %s\n", me,
+ airEnumStr(nrrdType, nrrdTypeBlock));
+}
+
+void
+(*_nrrdSwapEndian[])(void *, size_t) = {
+ _nrrdNoopEndian, /* 0: nobody knows! */
+ _nrrdNoopEndian, /* 1: signed 1-byte integer */
+ _nrrdNoopEndian, /* 2: unsigned 1-byte integer */
+ _nrrdSwap16Endian, /* 3: signed 2-byte integer */
+ _nrrdSwap16Endian, /* 4: unsigned 2-byte integer */
+ _nrrdSwap32Endian, /* 5: signed 4-byte integer */
+ _nrrdSwap32Endian, /* 6: unsigned 4-byte integer */
+ _nrrdSwap64Endian, /* 7: signed 8-byte integer */
+ _nrrdSwap64Endian, /* 8: unsigned 8-byte integer */
+ _nrrdSwap32Endian, /* 9: 4-byte floating point */
+ _nrrdSwap64Endian, /* 10: 8-byte floating point */
+ _nrrdBlockEndian /* 11: size user defined at run time */
+};
+
+void
+nrrdSwapEndian(Nrrd *nrrd) {
+
+ if (nrrd
+ && nrrd->data
+ && !airEnumValCheck(nrrdType, nrrd->type)) {
+ _nrrdSwapEndian[nrrd->type](nrrd->data, nrrdElementNumber(nrrd));
+ }
+ return;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/enum.c b/Utilities/ITK/Utilities/NrrdIO/enum.c
new file mode 100644
index 0000000000000000000000000000000000000000..a51216ee7979b0d4870cbb8421b840369bf13c17
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/enum.c
@@ -0,0 +1,187 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+/*
+******** airEnumUnknown
+**
+** return the value representing "unknown" in an enum
+*/
+int
+airEnumUnknown(airEnum *enm) {
+
+ if (enm && enm->val) {
+ return enm->val[0];
+ } else {
+ return 0;
+ }
+}
+
+/*
+** _airEnumIndex()
+**
+** given an enum "enm" and value "val", return the index into enm->str[]
+** and enm->desc[] which correspond to that value. To be safe, when
+** given an invalid enum value, we return zero.
+*/
+unsigned int
+_airEnumIndex(airEnum *enm, int val) {
+ unsigned int ii, ret;
+
+ ret = 0;
+ if (enm->val) {
+ for (ii=1; ii<=enm->M; ii++) {
+ if (val == enm->val[ii]) {
+ ret = ii;
+ break;
+ }
+ }
+ } else {
+ ret = AIR_IN_CL(0, val, (int)(enm->M)) ? val : 0; /* HEY scrutinize cast */
+ }
+ return ret;
+}
+
+int
+airEnumValCheck(airEnum *enm, int val) {
+
+ return (0 == _airEnumIndex(enm, val));
+}
+
+const char *
+airEnumStr(airEnum *enm, int val) {
+ int idx;
+
+ idx = _airEnumIndex(enm, val);
+ return enm->str[idx];
+}
+
+const char *
+airEnumDesc(airEnum *enm, int val) {
+ int idx;
+
+ idx = _airEnumIndex(enm, val);
+ return enm->desc[idx];
+}
+
+int
+airEnumVal(airEnum *enm, const char *str) {
+ char *strCpy, test[AIR_STRLEN_SMALL];
+ unsigned int ii;
+
+ if (!str) {
+ return airEnumUnknown(enm);
+ }
+
+ strCpy = airStrdup(str);
+ if (!enm->sense) {
+ airToLower(strCpy);
+ }
+
+ if (enm->strEqv) {
+ for (ii=0; strlen(enm->strEqv[ii]); ii++) {
+ strncpy(test, enm->strEqv[ii], AIR_STRLEN_SMALL);
+ test[AIR_STRLEN_SMALL-1] = '\0';
+ if (!enm->sense) {
+ airToLower(test);
+ }
+ if (!strcmp(test, strCpy)) {
+ free(strCpy);
+ return enm->valEqv[ii];
+ }
+ }
+ } else {
+ /* enm->strEqv NULL */
+ for (ii=1; ii<=enm->M; ii++) {
+ strncpy(test, enm->str[ii], AIR_STRLEN_SMALL);
+ test[AIR_STRLEN_SMALL-1] = '\0';
+ if (!enm->sense) {
+ airToLower(test);
+ }
+ if (!strcmp(test, strCpy)) {
+ free(strCpy);
+ return enm->val ? enm->val[ii] : (int)ii; /* HEY scrutinize cast */
+ }
+ }
+ }
+
+ /* else we never matched a string */
+ free(strCpy);
+ return airEnumUnknown(enm);
+}
+
+/*
+******** airEnumFmtDesc()
+**
+** Formats a description line for one element "val" of airEnum "enm",
+** and puts the result in a NEWLY ALLOCATED string which is the return
+** of this function. The formatting is done via sprintf(), as governed
+** by "fmt", which should contain to "%s" conversion sequences, the
+** first for the string version "val", and the second for the
+** description If "canon", then the canonical string representation
+** will be used (the one in enm->str[]), otherwise the shortest string
+** representation will be used (which differs from the canonical one
+** when there is a strEqv[]/valEqv[] pair defining a shorter string)
+*/
+char *
+airEnumFmtDesc(airEnum *enm, int val, int canon, const char *fmt) {
+ char *buff, *desc, ident[AIR_STRLEN_SMALL];
+ const char *_ident;
+ int i;
+ size_t len;
+
+ if (!(enm && enm->desc && fmt)) {
+ return airStrdup("(airEnumDesc: invalid args)");
+ }
+ if (airEnumValCheck(enm, val)) {
+ val = airEnumUnknown(enm);
+ }
+ _ident = airEnumStr(enm, val);
+ if (!canon && enm->strEqv) {
+ len = strlen(_ident);
+ for (i=0; strlen(enm->strEqv[i]); i++) {
+ if (val != enm->valEqv[i]) {
+ /* this isn't a string representing the value we care about */
+ continue;
+ }
+ if (strlen(enm->strEqv[i]) < len) {
+ /* this one is shorter */
+ len = strlen(enm->strEqv[i]);
+ _ident = enm->strEqv[i];
+ }
+ }
+ }
+ strcpy(ident, _ident);
+ if (!enm->sense) {
+ airToLower(ident);
+ }
+ desc = enm->desc[_airEnumIndex(enm, val)];
+ buff = (char *)calloc(strlen(fmt) + strlen(ident) + strlen(desc) + 1,
+ sizeof(char));
+ if (buff) {
+ sprintf(buff, fmt, ident, desc);
+ }
+ return buff;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/enumsNrrd.c b/Utilities/ITK/Utilities/NrrdIO/enumsNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..679167b6ed557be61cdfeb543afe10d5fc8b8f86
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/enumsNrrd.c
@@ -0,0 +1,768 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+/*
+** Rules of thumb for editing these things. The airEnum definitions are
+** unfortunately EXTREMELY sensitive to small typo errors, and there is
+** no good way to detect the errors. So:
+**
+** 1) Be awake and undistracted. Turn down the music.
+** 2) When editing the char arrays, make sure that you put commas
+** where you mean them to be. C's automatic string concatenation
+** is not your friend here. In fact, EXPLOIT the fact that you can have
+** a comma after the last element of a list (of strings)- it decreases
+** the chances that adding a new element at the end will be thwarted by
+** the lack of a comma at the end of the previous (and previously last)
+** string.
+** 3) When editing the *StrEqv and *ValEqv arrays, make absolutely
+** sure that both are changed in parallel. Use only one enum value
+** per line; putting all equivalents on that line, and make sure that
+** there is one line in both *StrEqv and *ValEqv for all the possible
+** enum values, and that there are as many elements in each line.
+** 4) Make sure that additions here are reflected in nrrdEnums.h and
+** vice versa.
+*/
+
+/* ------------------------ nrrdFormat ------------------------- */
+
+char
+_nrrdFormatTypeStr[NRRD_FORMAT_TYPE_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_format)",
+ "nrrd",
+ "pnm",
+ "png",
+ "vtk",
+ "text",
+ "eps",
+};
+
+char
+_nrrdFormatTypeDesc[NRRD_FORMAT_TYPE_MAX+1][AIR_STRLEN_MED] = {
+ "unknown_format",
+ "native format for nearly raw raster data",
+ "Portable aNy Map: includes PGM for grayscale and PPM for color",
+ "Portable Network Graphics: lossless compression of 8- and 16-bit data",
+ "Visualization ToolKit STRUCTURED_POINTS data",
+ "white-space-delimited plain text encoding of 2-D float array",
+ "Encapsulated PostScript images",
+};
+
+char
+_nrrdFormatTypeStrEqv[][AIR_STRLEN_SMALL] = {
+ "nrrd",
+ "pnm",
+ "png",
+ "vtk",
+ "table", "text", "txt",
+ "eps",
+ ""
+};
+
+int
+_nrrdFormatTypeValEqv[] = {
+ nrrdFormatTypeNRRD,
+ nrrdFormatTypePNM,
+ nrrdFormatTypePNG,
+ nrrdFormatTypeVTK,
+ nrrdFormatTypeText, nrrdFormatTypeText, nrrdFormatTypeText,
+ nrrdFormatTypeEPS,
+};
+
+airEnum
+_nrrdFormatType = {
+ "format",
+ NRRD_FORMAT_TYPE_MAX,
+ _nrrdFormatTypeStr, NULL,
+ _nrrdFormatTypeDesc,
+ _nrrdFormatTypeStrEqv, _nrrdFormatTypeValEqv,
+ AIR_FALSE
+};
+airEnum *
+nrrdFormatType = &_nrrdFormatType;
+
+/* ------------------------ nrrdType ------------------------- */
+
+char
+_nrrdTypeStr[NRRD_TYPE_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_type)",
+ "signed char",
+ "unsigned char",
+ "short",
+ "unsigned short",
+ "int",
+ "unsigned int",
+ "long long int",
+ "unsigned long long int",
+ "float",
+ "double",
+ "block",
+};
+
+char
+_nrrdTypeDesc[NRRD_TYPE_MAX+1][AIR_STRLEN_MED] = {
+ "unknown type",
+ "signed 1-byte integer",
+ "unsigned 1-byte integer",
+ "signed 2-byte integer",
+ "unsigned 2-byte integer",
+ "signed 4-byte integer",
+ "unsigned 4-byte integer",
+ "signed 8-byte integer",
+ "unsigned 8-byte integer",
+ "4-byte floating point",
+ "8-byte floating point",
+ "size user-defined at run-time",
+};
+
+#define ntCH nrrdTypeChar
+#define ntUC nrrdTypeUChar
+#define ntSH nrrdTypeShort
+#define ntUS nrrdTypeUShort
+#define ntIN nrrdTypeInt
+#define ntUI nrrdTypeUInt
+#define ntLL nrrdTypeLLong
+#define ntUL nrrdTypeULLong
+#define ntFL nrrdTypeFloat
+#define ntDB nrrdTypeDouble
+#define ntBL nrrdTypeBlock
+
+char
+_nrrdTypeStrEqv[][AIR_STRLEN_SMALL] = {
+ "signed char", /* but NOT just "char" */ "int8", "int8_t",
+ "uchar", "unsigned char", "uint8", "uint8_t",
+ "short", "short int", "signed short", "signed short int", "int16", "int16_t",
+ "ushort", "unsigned short", "unsigned short int", "uint16", "uint16_t",
+ "int", "signed int", "int32", "int32_t",
+ "uint", "unsigned int", "uint32", "uint32_t",
+ "longlong", "long long", "long long int", "signed long long",
+ "signed long long int", "int64", "int64_t",
+ "ulonglong", "unsigned long long", "unsigned long long int",
+ "uint64", "uint64_t",
+ "float",
+ "double",
+ "block",
+ ""
+};
+
+int
+_nrrdTypeValEqv[] = {
+ ntCH, ntCH, ntCH,
+ ntUC, ntUC, ntUC, ntUC,
+ ntSH, ntSH, ntSH, ntSH, ntSH, ntSH,
+ ntUS, ntUS, ntUS, ntUS, ntUS,
+ ntIN, ntIN, ntIN, ntIN,
+ ntUI, ntUI, ntUI, ntUI,
+ ntLL, ntLL, ntLL, ntLL, ntLL, ntLL, ntLL,
+ ntUL, ntUL, ntUL, ntUL, ntUL,
+ ntFL,
+ ntDB,
+ ntBL,
+};
+
+airEnum
+_nrrdType = {
+ "type",
+ NRRD_TYPE_MAX,
+ _nrrdTypeStr, NULL,
+ _nrrdTypeDesc,
+ _nrrdTypeStrEqv, _nrrdTypeValEqv,
+ AIR_FALSE
+};
+airEnum *
+nrrdType = &_nrrdType;
+
+/* ------------------------ nrrdEncodingType ------------------------- */
+
+char
+_nrrdEncodingTypeStr[NRRD_ENCODING_TYPE_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_encoding)",
+ "raw",
+ "ascii",
+ "hex",
+ "gz",
+ "bz2",
+};
+
+char
+_nrrdEncodingTypeDesc[NRRD_ENCODING_TYPE_MAX+1][AIR_STRLEN_MED] = {
+ "unknown encoding",
+ "file is byte-for-byte same as memory representation",
+ "values written out in ASCII",
+ "case-insenstive hexadecimal encoding (2 chars / byte)",
+ "gzip compression of binary encoding",
+ "bzip2 compression of binary encoding",
+};
+
+char
+_nrrdEncodingTypeStrEqv[][AIR_STRLEN_SMALL] = {
+ "(unknown_encoding)",
+ "raw",
+ "txt", "text", "ascii",
+ "hex",
+ "gz", "gzip",
+ "bz2", "bzip2",
+ ""
+};
+
+int
+_nrrdEncodingTypeValEqv[] = {
+ nrrdEncodingTypeUnknown,
+ nrrdEncodingTypeRaw,
+ nrrdEncodingTypeAscii, nrrdEncodingTypeAscii, nrrdEncodingTypeAscii,
+ nrrdEncodingTypeHex,
+ nrrdEncodingTypeGzip, nrrdEncodingTypeGzip,
+ nrrdEncodingTypeBzip2, nrrdEncodingTypeBzip2,
+};
+
+airEnum
+_nrrdEncodingType = {
+ "encoding",
+ NRRD_ENCODING_TYPE_MAX,
+ _nrrdEncodingTypeStr, NULL,
+ _nrrdEncodingTypeDesc,
+ _nrrdEncodingTypeStrEqv, _nrrdEncodingTypeValEqv,
+ AIR_FALSE
+};
+airEnum *
+nrrdEncodingType = &_nrrdEncodingType;
+
+/* ------------------------ nrrdCenter ------------------------- */
+
+char
+_nrrdCenterStr[NRRD_CENTER_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_center)",
+ "node",
+ "cell",
+};
+
+char
+_nrrdCenterDesc[NRRD_CENTER_MAX+1][AIR_STRLEN_MED] = {
+ "unknown centering",
+ "samples are at boundaries between elements along axis",
+ "samples are at centers of elements along axis",
+};
+
+airEnum
+_nrrdCenter_enum = {
+ "centering",
+ NRRD_CENTER_MAX,
+ _nrrdCenterStr, NULL,
+ _nrrdCenterDesc,
+ NULL, NULL,
+ AIR_FALSE
+};
+airEnum *
+nrrdCenter = &_nrrdCenter_enum;
+
+/* ------------------------ nrrdKind ------------------------- */
+
+/*
+ nrrdKindUnknown,
+ nrrdKindDomain, * 1: any image domain *
+ nrrdKindSpace, * 2: a spatial domain *
+ nrrdKindTime, * 3: a temporal domain *
+ * -------------------------- end domain kinds *
+ * -------------------------- begin range kinds *
+ nrrdKindList, * 4: any list of values, non-resample-able *
+ nrrdKindPoint, * 5: coords of a point *
+ nrrdKindVector, * 6: coeffs of (contravariant) vector *
+ nrrdKindCovariantVector, * 7: coeffs of covariant vector (eg gradient) *
+ nrrdKindNormal, * 8: coeffs of unit-length covariant vector *
+ * -------------------------- end arbitrary size kinds *
+ * -------------------------- begin size-specific kinds *
+ nrrdKindStub, * 9: axis with one sample (a placeholder) *
+ nrrdKindScalar, * 10: effectively, same as a stub *
+ nrrdKindComplex, * 11: real and imaginary components *
+ nrrdKind2Vector, * 12: 2 component vector *
+ nrrdKind3Color, * 13: ANY 3-component color value *
+ nrrdKindRGBColor, * 14: RGB, no colorimetry *
+ nrrdKindHSVColor, * 15: HSV, no colorimetry *
+ nrrdKindXYZColor, * 16: perceptual primary colors *
+ nrrdKind4Color, * 17: ANY 4-component color value *
+ nrrdKindRGBAColor, * 18: RGBA, no colorimetry *
+ nrrdKind3Vector, * 19: 3-component vector *
+ nrrdKind3Gradient, * 20: 3-component covariant vector *
+ nrrdKind3Normal, * 21: 3-component covector, assumed normalized *
+ nrrdKind4Vector, * 22: 4-component vector *
+ nrrdKindQuaternion, * 23: (x,y,z,w), not necessarily normalized *
+ nrrdKind2DSymMatrix, * 24: Mxx Mxy Myy *
+ nrrdKind2DMaskedSymMatrix, * 25: mask Mxx Mxy Myy *
+ nrrdKind2DMatrix, * 26: Mxx Mxy Myx Myy *
+ nrrdKind2DMaskedMatrix, * 27: mask Mxx Mxy Myx Myy *
+ nrrdKind3DSymMatrix, * 28: Mxx Mxy Mxz Myy Myz Mzz *
+ nrrdKind3DMaskedSymMatrix, * 29: mask Mxx Mxy Mxz Myy Myz Mzz *
+ nrrdKind3DMatrix, * 30: Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz *
+ nrrdKind3DMaskedMatrix, * 31: mask Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz *
+*/
+
+char
+_nrrdKindStr[NRRD_KIND_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_kind)",
+ "domain",
+ "space",
+ "time",
+ "list",
+ "point",
+ "vector",
+ "covariant-vector",
+ "normal",
+ "stub",
+ "scalar",
+ "complex",
+ "2-vector",
+ "3-color",
+ "RGB-color",
+ "HSV-color",
+ "XYZ-color",
+ "4-color",
+ "RGBA-color",
+ "3-vector",
+ "3-gradient",
+ "3-normal",
+ "4-vector",
+ "quaternion",
+ "2D-symmetric-matrix",
+ "2D-masked-symmetric-matrix",
+ "2D-matrix",
+ "2D-masked-matrix",
+ "3D-symmetric-matrix",
+ "3D-masked-symmetric-matrix",
+ "3D-matrix",
+ "3D-masked-matrix",
+};
+
+char
+_nrrdKindDesc[NRRD_KIND_MAX+1][AIR_STRLEN_MED] = {
+ "unknown kind",
+ "a domain variable of the function which the nrrd samples",
+ "a spatial domain, like the axes of a measured volume image",
+ "a temporal domain, as from time-varying measurements",
+ "some list of attributes; it makes no sense to resample along these",
+ "coordinates of a point",
+ "coefficients of a (contravariant) vector",
+ "coefficients of a covariant vector, such as a gradient",
+ "coefficients of a normalized covariant vector",
+ "a place-holder axis with a single sample",
+ "axis used to indicate that the nrrd contains a scalar value",
+ "real and imaginary parts of a value",
+ "a 2-component vector",
+ "any 3-component color value",
+ "red-green-blue color",
+ "hue-saturation-value single hexcone color",
+ "perceptual primaries color",
+ "any 4-component color value",
+ "red-green-blue-alpha color",
+ "a 3-element (contravariant) vector",
+ "a 3-element gradient (covariant) vector",
+ "a 3-element (covariant) vector which is assumed normalized",
+ "a 4-element (contravariant) vector",
+ "quaternion: x y z w",
+ "3 elements of 2D symmetric matrix: Mxx Mxy Myy",
+ "mask plus 3 elements of 2D symmetric matrix: mask Mxx Mxy Myy",
+ "4 elements of general 2D matrix: Mxx Mxy Myx Myy",
+ "mask plus 4 elements of general 2D matrix: mask Mxx Mxy Myx Myy",
+ "6 elements of 3D symmetric matrix: Mxx Mxy Mxz Myy Myz Mzz",
+ "mask plus 6 elements of 3D symmetric matrix: mask Mxx Mxy Mxz Myy Myz Mzz",
+ "9 elements of general 3D matrix: Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz",
+ "mask plus 9 elements of general 3D matrix: mask Mxx Mxy Mxz Myx Myy Myz Mzx Mzy Mzz",
+};
+
+char
+_nrrdKindStr_Eqv[][AIR_STRLEN_SMALL] = {
+ "domain",
+ "space",
+ "time",
+ "list",
+ "point",
+ "vector", "contravariant-vector",
+ "covariant-vector",
+ "normal",
+ "stub",
+ "scalar",
+ "complex",
+ "2-vector",
+ "3-color",
+ "RGB-color", "RGBcolor", "RGB",
+ "HSV-color", "HSVcolor", "HSV",
+ "XYZ-color",
+ "4-color",
+ "RGBA-color", "RGBAcolor", "RGBA",
+ "3-vector",
+ "3-gradient",
+ "3-normal",
+ "4-vector",
+ "quaternion",
+ "2D-symmetric-matrix", "2D-sym-matrix",
+ "2D-symmetric-tensor", "2D-sym-tensor",
+ "2D-masked-symmetric-matrix", "2D-masked-sym-matrix",
+ "2D-masked-symmetric-tensor", "2D-masked-sym-tensor",
+ "2D-matrix",
+ "2D-tensor",
+ "2D-masked-matrix",
+ "2D-masked-tensor",
+ "3D-symmetric-matrix", "3D-sym-matrix",
+ "3D-symmetric-tensor", "3D-sym-tensor",
+ "3D-masked-symmetric-matrix", "3D-masked-sym-matrix",
+ "3D-masked-symmetric-tensor", "3D-masked-sym-tensor",
+ "3D-matrix",
+ "3D-tensor",
+ "3D-masked-matrix",
+ "3D-masked-tensor",
+ ""
+};
+
+int
+_nrrdKindVal_Eqv[] = {
+ nrrdKindDomain,
+ nrrdKindSpace,
+ nrrdKindTime,
+ nrrdKindList,
+ nrrdKindPoint,
+ nrrdKindVector, nrrdKindVector,
+ nrrdKindCovariantVector,
+ nrrdKindNormal,
+ nrrdKindStub,
+ nrrdKindScalar,
+ nrrdKindComplex,
+ nrrdKind2Vector,
+ nrrdKind3Color,
+ nrrdKindRGBColor, nrrdKindRGBColor, nrrdKindRGBColor,
+ nrrdKindHSVColor, nrrdKindHSVColor, nrrdKindHSVColor,
+ nrrdKindXYZColor,
+ nrrdKind4Color,
+ nrrdKindRGBAColor, nrrdKindRGBAColor, nrrdKindRGBAColor,
+ nrrdKind3Vector,
+ nrrdKind3Gradient,
+ nrrdKind3Normal,
+ nrrdKind4Vector,
+ nrrdKindQuaternion,
+ nrrdKind2DSymMatrix, nrrdKind2DSymMatrix,
+ nrrdKind2DSymMatrix, nrrdKind2DSymMatrix,
+ nrrdKind2DMaskedSymMatrix, nrrdKind2DMaskedSymMatrix,
+ nrrdKind2DMaskedSymMatrix, nrrdKind2DMaskedSymMatrix,
+ nrrdKind2DMatrix,
+ nrrdKind2DMatrix,
+ nrrdKind2DMaskedMatrix,
+ nrrdKind2DMaskedMatrix,
+ nrrdKind3DSymMatrix, nrrdKind3DSymMatrix,
+ nrrdKind3DSymMatrix, nrrdKind3DSymMatrix,
+ nrrdKind3DMaskedSymMatrix, nrrdKind3DMaskedSymMatrix,
+ nrrdKind3DMaskedSymMatrix, nrrdKind3DMaskedSymMatrix,
+ nrrdKind3DMatrix,
+ nrrdKind3DMatrix,
+ nrrdKind3DMaskedMatrix,
+ nrrdKind3DMaskedMatrix,
+};
+
+airEnum
+_nrrdKind_enum = {
+ "kind",
+ NRRD_KIND_MAX,
+ _nrrdKindStr, NULL,
+ _nrrdKindDesc,
+ _nrrdKindStr_Eqv, _nrrdKindVal_Eqv,
+ AIR_FALSE
+};
+airEnum *
+nrrdKind = &_nrrdKind_enum;
+
+/* ------------------------ nrrdField ------------------------- */
+
+char
+_nrrdFieldStr[NRRD_FIELD_MAX+1][AIR_STRLEN_SMALL] = {
+ "Ernesto \"Che\" Guevara",
+ "#",
+ "content",
+ "number",
+ "type",
+ "block size",
+ "dimension",
+ "space",
+ "space dimension",
+ "sizes",
+ "spacings",
+ "thicknesses",
+ "axis mins",
+ "axis maxs",
+ "space directions",
+ "centerings",
+ "kinds",
+ "labels",
+ "units",
+ "min",
+ "max",
+ "old min",
+ "old max",
+ "endian",
+ "encoding",
+ "line skip",
+ "byte skip",
+ "key/value",
+ "sample units",
+ "space units",
+ "space origin",
+ "measurement frame",
+ "data file",
+};
+
+char
+_nrrdFieldDesc[NRRD_FIELD_MAX+1][AIR_STRLEN_MED] = {
+ "unknown field identifier",
+ "comment",
+ "short description of whole array and/or its provenance",
+ "total number of samples in array",
+ "type of sample value",
+ "number of bytes in one block (for block-type)",
+ "number of axes in array",
+ "identifier for space in which array grid lies",
+ "dimension of space in which array grid lies",
+ "list of number of samples along each axis, aka \"dimensions\" of the array",
+ "list of sample spacings along each axis",
+ "list of sample thicknesses along each axis",
+ "list of minimum positions associated with each axis",
+ "list of maximum positions associated with each axis",
+ "list of direction inter-sample vectors for each axis",
+ "list of sample centerings for each axis",
+ "list of kinds for each axis",
+ "list of short descriptions for each axis",
+ "list of units in which each axes' spacing and thickness is measured",
+ "supposed minimum array value",
+ "supposed maximum array value",
+ "minimum array value prior to quantization",
+ "maximum array value prior to quantization",
+ "endiannes of data as written in file",
+ "encoding of data written in file",
+ "number of lines to skip prior to byte skip and reading data",
+ "number of bytes to skip after line skip and prior to reading data",
+ "string-based key/value pairs",
+ "units of measurement of (scalar) values inside array itself",
+ "list of units for measuring origin and direct vectors' coefficients",
+ "location in space of center of first (lowest memory address) sample",
+ "maps coords of (non-scalar) values to coords of surrounding space",
+ "with detached headers, where is data to be found",
+};
+
+char
+_nrrdFieldStrEqv[][AIR_STRLEN_SMALL] = {
+ "#",
+ "content",
+ "number",
+ "type",
+ "block size", "blocksize",
+ "dimension",
+ "space",
+ "space dimension", "spacedimension",
+ "sizes",
+ "spacings",
+ "thicknesses",
+ "axis mins", "axismins",
+ "axis maxs", "axismaxs",
+ "space directions", "spacedirections",
+ "centers", "centerings",
+ "kinds",
+ "labels",
+ "units",
+ "min",
+ "max",
+ "old min", "oldmin",
+ "old max", "oldmax",
+ "endian",
+ "encoding",
+ "line skip", "lineskip",
+ "byte skip", "byteskip",
+ /* nothing for keyvalue */
+ "sample units", "sampleunits",
+ "space units", "spaceunits",
+ "space origin", "spaceorigin",
+ "measurement frame", "measurementframe",
+ "data file", "datafile",
+ ""
+};
+
+int
+_nrrdFieldValEqv[] = {
+ nrrdField_comment,
+ nrrdField_content,
+ nrrdField_number,
+ nrrdField_type,
+ nrrdField_block_size, nrrdField_block_size,
+ nrrdField_dimension,
+ nrrdField_space,
+ nrrdField_space_dimension, nrrdField_space_dimension,
+ nrrdField_sizes,
+ nrrdField_spacings,
+ nrrdField_thicknesses,
+ nrrdField_axis_mins, nrrdField_axis_mins,
+ nrrdField_axis_maxs, nrrdField_axis_maxs,
+ nrrdField_space_directions, nrrdField_space_directions,
+ nrrdField_centers, nrrdField_centers,
+ nrrdField_kinds,
+ nrrdField_labels,
+ nrrdField_units,
+ nrrdField_min,
+ nrrdField_max,
+ nrrdField_old_min, nrrdField_old_min,
+ nrrdField_old_max, nrrdField_old_max,
+ nrrdField_endian,
+ nrrdField_encoding,
+ nrrdField_line_skip, nrrdField_line_skip,
+ nrrdField_byte_skip, nrrdField_byte_skip,
+ /* nothing for keyvalue */
+ nrrdField_sample_units, nrrdField_sample_units,
+ nrrdField_space_units, nrrdField_space_units,
+ nrrdField_space_origin, nrrdField_space_origin,
+ nrrdField_measurement_frame, nrrdField_measurement_frame,
+ nrrdField_data_file, nrrdField_data_file,
+};
+
+airEnum
+_nrrdField = {
+ "nrrd_field",
+ NRRD_FIELD_MAX,
+ _nrrdFieldStr, NULL,
+ _nrrdFieldDesc,
+ _nrrdFieldStrEqv, _nrrdFieldValEqv,
+ AIR_FALSE /* field identifiers not case sensitive */
+};
+airEnum *
+nrrdField = &_nrrdField;
+
+/* ------------------------ nrrdSpace ------------------------- */
+
+/*
+ nrrdSpaceUnknown,
+ nrrdSpaceRightAnteriorSuperior, * 1: NIFTI-1 (right-handed) *
+ nrrdSpaceLeftAnteriorSuperior, * 2: standard Analyze (left-handed) *
+ nrrdSpaceLeftPosteriorSuperior, * 3: DICOM 3.0 (right-handed) *
+ nrrdSpaceRightAnteriorSuperiorTime, * 4: *
+ nrrdSpaceLeftAnteriorSuperiorTime, * 5: *
+ nrrdSpaceLeftPosteriorSuperiorTime, * 6: *
+ nrrdSpaceScannerXYZ, * 7: ACR/NEMA 2.0 (pre-DICOM 3.0) *
+ nrrdSpaceScannerXYZTime, * 8: *
+ nrrdSpace3DRightHanded, * 9: *
+ nrrdSpace3DLeftHanded, * 10: *
+ nrrdSpace3DRightHandedTime, * 11: *
+ nrrdSpace3DLeftHandedTime, * 12: *
+ nrrdSpaceLast
+*/
+
+char
+_nrrdSpaceStr[NRRD_SPACE_MAX+1][AIR_STRLEN_SMALL] = {
+ "(unknown_space)",
+ "right-anterior-superior",
+ "left-anterior-superior",
+ "left-posterior-superior",
+ "right-anterior-superior-time",
+ "left-anterior-superior-time",
+ "left-posterior-superior-time",
+ "scanner-xyz",
+ "scanner-xyz-time",
+ "3D-right-handed",
+ "3D-left-handed",
+ "3D-right-handed-time",
+ "3D-left-handed-time",
+};
+
+char
+_nrrdSpaceDesc[NRRD_SPACE_MAX+1][AIR_STRLEN_MED] = {
+ "unknown space",
+ "right-anterior-superior (used in NIFTI-1 and SPL's 3D Slicer)",
+ "left-anterior-superior (used in Analyze 7.5)",
+ "left-posterior-superior (used in DICOM 3)",
+ "right-anterior-superior-time",
+ "left-anterior-superior-time",
+ "left-posterior-superior-time",
+ "scanner-xyz (used in ACR/NEMA 2.0)",
+ "scanner-xyz-time",
+ "3D-right-handed",
+ "3D-left-handed",
+ "3D-right-handed-time",
+ "3D-left-handed-time",
+};
+
+char
+_nrrdSpaceStrEqv[][AIR_STRLEN_SMALL] = {
+ "(unknown_space)",
+ "right-anterior-superior", "right anterior superior",
+ "rightanteriorsuperior", "RAS",
+ "left-anterior-superior", "left anterior superior",
+ "leftanteriorsuperior", "LAS",
+ "left-posterior-superior", "left posterior superior",
+ "leftposteriorsuperior", "LPS",
+ "right-anterior-superior-time", "right anterior superior time",
+ "rightanteriorsuperiortime", "RAST",
+ "left-anterior-superior-time", "left anterior superior time",
+ "leftanteriorsuperiortime", "LAST",
+ "left-posterior-superior-time", "left posterior superior time",
+ "leftposteriorsuperiortime", "LPST",
+ "scanner-xyz",
+ "scanner-xyz-time", "scanner-xyzt",
+ "3D-right-handed", "3D right handed", "3Drighthanded"
+ "3D-left-handed", "3D left handed", "3Dlefthanded",
+ "3D-right-handed-time", "3D right handed time",
+ "3Drighthandedtime",
+ "3D-left-handed-time", "3D left handed time",
+ "3Dlefthandedtime",
+ ""
+};
+
+int
+_nrrdSpaceValEqv[] = {
+ nrrdSpaceUnknown,
+ nrrdSpaceRightAnteriorSuperior, nrrdSpaceRightAnteriorSuperior,
+ nrrdSpaceRightAnteriorSuperior, nrrdSpaceRightAnteriorSuperior,
+ nrrdSpaceLeftAnteriorSuperior, nrrdSpaceLeftAnteriorSuperior,
+ nrrdSpaceLeftAnteriorSuperior, nrrdSpaceLeftAnteriorSuperior,
+ nrrdSpaceLeftPosteriorSuperior, nrrdSpaceLeftPosteriorSuperior,
+ nrrdSpaceLeftPosteriorSuperior, nrrdSpaceLeftPosteriorSuperior,
+ nrrdSpaceRightAnteriorSuperiorTime, nrrdSpaceRightAnteriorSuperiorTime,
+ nrrdSpaceRightAnteriorSuperiorTime, nrrdSpaceRightAnteriorSuperiorTime,
+ nrrdSpaceLeftAnteriorSuperiorTime, nrrdSpaceLeftAnteriorSuperiorTime,
+ nrrdSpaceLeftAnteriorSuperiorTime, nrrdSpaceLeftAnteriorSuperiorTime,
+ nrrdSpaceLeftPosteriorSuperiorTime, nrrdSpaceLeftPosteriorSuperiorTime,
+ nrrdSpaceLeftPosteriorSuperiorTime, nrrdSpaceLeftPosteriorSuperiorTime,
+ nrrdSpaceScannerXYZ,
+ nrrdSpaceScannerXYZTime, nrrdSpaceScannerXYZTime,
+ nrrdSpace3DRightHanded, nrrdSpace3DRightHanded, nrrdSpace3DRightHanded,
+ nrrdSpace3DLeftHanded, nrrdSpace3DLeftHanded, nrrdSpace3DLeftHanded,
+ nrrdSpace3DRightHandedTime, nrrdSpace3DRightHandedTime,
+ nrrdSpace3DRightHandedTime,
+ nrrdSpace3DLeftHandedTime, nrrdSpace3DLeftHandedTime,
+ nrrdSpace3DLeftHandedTime
+};
+
+airEnum
+_nrrdSpace = {
+ "space",
+ NRRD_SPACE_MAX,
+ _nrrdSpaceStr, NULL,
+ _nrrdSpaceDesc,
+ _nrrdSpaceStrEqv, _nrrdSpaceValEqv,
+ AIR_FALSE
+};
+airEnum *
+nrrdSpace = &_nrrdSpace;
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/format.c b/Utilities/ITK/Utilities/NrrdIO/format.c
new file mode 100644
index 0000000000000000000000000000000000000000..7db7e725f63dd203be8e1dada0c0ce00918dc09f
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/format.c
@@ -0,0 +1,146 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+** what a NrrdFormat can assume:
+** -- that nio->format has been set to you already
+** -- for read(): that nio->path has been set to the path of the file being
+** read in, if the information was ever available
+** -- for contentStartsLike() and read(): that nio->line contains the
+** first line of of the file, in order to determine the file type
+**
+** what a NrrdFormat has to do:
+** -- respect nio->skipData to whatever extent makes sense on top of how the
+** NrrdEncoding respects it (by making read and write no-ops).
+** nrrdFormatNRRD, for instance, won't create empty detached data files
+** if nio->skipData.
+** -- determine what NrrdEncoding to use, if there's a choice
+** -- respect nrrdStateVerboseIO with messages to stderr, if possible
+**
+** The "unknown" format is intended as a template for writing new formats.
+*/
+
+int
+_nrrdFormatUnknown_available(void) {
+
+ /* insert code here */
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatUnknown_nameLooksLike(const char *filename) {
+
+ /* insert code here */
+ AIR_UNUSED(filename);
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatUnknown_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatUnknown_fitsInto", err[AIR_STRLEN_MED];
+
+ if (!(nrrd && encoding)) {
+ sprintf(err, "%s: got NULL nrrd (%p) or encoding (%p)",
+ me, nrrd, encoding);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+ }
+
+ /* insert code here */
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatUnknown_contentStartsLike(NrrdIoState *nio) {
+
+ /* insert code here */
+ AIR_UNUSED(nio);
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatUnknown_read(FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio) {
+ char me[]="_nrrdFormatUnknown_read", err[AIR_STRLEN_MED];
+
+ /* insert code here, and remove error handling below */
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+
+ sprintf(err, "%s: ERROR!!! trying to read unknown format", me);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdFormatUnknown_write(FILE *file, const Nrrd *nrrd,
+ NrrdIoState *nio) {
+ char me[]="_nrrdFormatUnknown_write", err[AIR_STRLEN_MED];
+
+ /* insert code here, and remove error handling below */
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+
+ sprintf(err, "%s: ERROR!!! trying to write unknown format", me);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatUnknown = {
+ "unknown",
+ AIR_FALSE, /* isImage */
+ AIR_TRUE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatUnknown_available,
+ _nrrdFormatUnknown_nameLooksLike,
+ _nrrdFormatUnknown_fitsInto,
+ _nrrdFormatUnknown_contentStartsLike,
+ _nrrdFormatUnknown_read,
+ _nrrdFormatUnknown_write
+};
+
+const NrrdFormat *const
+nrrdFormatUnknown = &_nrrdFormatUnknown;
+
+const NrrdFormat *const
+nrrdFormatArray[NRRD_FORMAT_TYPE_MAX+1] = {
+ &_nrrdFormatUnknown,
+ &_nrrdFormatNRRD,
+ &_nrrdFormatPNM,
+ &_nrrdFormatPNG,
+ &_nrrdFormatVTK,
+ &_nrrdFormatText,
+ &_nrrdFormatEPS
+};
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatEPS.c b/Utilities/ITK/Utilities/NrrdIO/formatEPS.c
new file mode 100644
index 0000000000000000000000000000000000000000..92233c92a290edd7eb63a739de35043d717234af
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatEPS.c
@@ -0,0 +1,104 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdFormatEPS_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatEPS_nameLooksLike(const char *filename) {
+
+ return airEndsWith(filename, NRRD_EXT_EPS);
+}
+
+int
+_nrrdFormatEPS_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatEPS_fitsInto", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(encoding);
+ AIR_UNUSED(useBiff);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatEPS->name);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatEPS_contentStartsLike(NrrdIoState *nio) {
+
+ AIR_UNUSED(nio);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatEPS_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdReadEPS", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatEPS->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdFormatEPS_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatEPS_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatEPS->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatEPS = {
+ "EPS",
+ AIR_FALSE, /* isImage */
+ AIR_FALSE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatEPS_available,
+ _nrrdFormatEPS_nameLooksLike,
+ _nrrdFormatEPS_fitsInto,
+ _nrrdFormatEPS_contentStartsLike,
+ _nrrdFormatEPS_read,
+ _nrrdFormatEPS_write
+};
+
+const NrrdFormat *const
+nrrdFormatEPS = &_nrrdFormatEPS;
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatNRRD.c b/Utilities/ITK/Utilities/NrrdIO/formatNRRD.c
new file mode 100644
index 0000000000000000000000000000000000000000..8140457ba4d01773eb9f7b663497ea1ee67e91a1
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatNRRD.c
@@ -0,0 +1,650 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+#define MAGIC "NRRD"
+#define MAGIC0 "NRRD00.01"
+#define MAGIC1 "NRRD0001"
+#define MAGIC2 "NRRD0002"
+#define MAGIC3 "NRRD0003"
+#define MAGIC4 "NRRD0004"
+#define MAGIC5 "NRRD0005"
+
+const char *
+_nrrdFormatURLLine0 = "Complete NRRD file format specification at:";
+const char *
+_nrrdFormatURLLine1 = "http://teem.sourceforge.net/nrrd/format.html";
+
+void
+nrrdIoStateDataFileIterBegin(NrrdIoState *nio) {
+
+ nio->dataFNIndex = -1;
+ return;
+}
+
+#define _NEED_PATH(str) ('/' != (str)[0] && strcmp("-", (str)))
+
+/*
+** this is responsible for the header-relative path processing
+**
+** NOTE: if the filename is "-", then because it does not start with '/',
+** it would normally be prefixed by nio->path, so it needs special handling
+*/
+int
+nrrdIoStateDataFileIterNext(FILE **fileP, NrrdIoState *nio, int reading) {
+ char me[]="nrrdIoStateDataFileIterNext", *err;
+ char *fname=NULL;
+ int ii, needPath;
+ unsigned int num, fi;
+ size_t maxl;
+ airArray *mop;
+
+ mop = airMopNew();
+ airMopAdd(mop, (void*)fileP, (airMopper)airSetNull, airMopOnError);
+
+ if (!fileP) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ airMopError(mop); return 1;
+ }
+ if (!_nrrdDataFNNumber(nio)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: there appear to be zero datafiles!", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ airMopError(mop); return 1;
+ }
+
+ nio->dataFNIndex++;
+ if (nio->dataFNIndex >= (int)_nrrdDataFNNumber(nio)) {
+ /* there is no next data file, but we don't make that an error */
+ nio->dataFNIndex = _nrrdDataFNNumber(nio);
+ airMopOkay(mop);
+ *fileP = NULL;
+ return 0;
+ }
+
+ /* HEY: some of this error checking is done far more often than needed */
+ if (nio->dataFNFormat || nio->dataFNArr->len) {
+ needPath = AIR_FALSE;
+ maxl = 0;
+ if (nio->dataFNFormat) {
+ needPath = _NEED_PATH(nio->dataFNFormat);
+ /* assuming 10-digit integers is plenty big */
+ maxl = 10 + strlen(nio->dataFNFormat);
+ } else {
+ for (fi=0; fi<nio->dataFNArr->len; fi++) {
+ needPath |= _NEED_PATH(nio->dataFN[fi]);
+ maxl = AIR_MAX(maxl, strlen(nio->dataFN[fi]));
+ }
+ }
+ if (needPath && !airStrlen(nio->path)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: need nio->path for header-relative datafiles", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ airMopError(mop); return 1;
+ }
+ fname = (char*)malloc(airStrlen(nio->path) + strlen("/") + maxl + 1);
+ if (!fname) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't allocate filename buffer", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ airMopError(mop); return 1;
+ }
+ airMopAdd(mop, fname, airFree, airMopAlways);
+ }
+
+ if (nio->dataFNFormat) {
+ /* ---------------------------------------------------------- */
+ /* --------- base.%d <min> <max> <step> [<dim>] ------------- */
+ /* ---------------------------------------------------------- */
+ num = 0;
+ for (ii = nio->dataFNMin;
+ ((nio->dataFNStep > 0 && ii <= nio->dataFNMax)
+ || (nio->dataFNStep < 0 && ii >= nio->dataFNMax));
+ ii += nio->dataFNStep) {
+ if ((int)num == nio->dataFNIndex) { /* HEY scrutinize cast */
+ break;
+ }
+ num += 1;
+ }
+ if (_NEED_PATH(nio->dataFNFormat)) {
+ strcpy(fname, nio->path);
+ strcat(fname, "/");
+ sprintf(fname + strlen(nio->path) + strlen("/"), nio->dataFNFormat, ii);
+ } else {
+ sprintf(fname, nio->dataFNFormat, ii);
+ }
+ } else if (nio->dataFNArr->len) {
+ /* ---------------------------------------------------------- */
+ /* ------------------- LIST or single ----------------------- */
+ /* ---------------------------------------------------------- */
+ if (_NEED_PATH(nio->dataFN[nio->dataFNIndex])) {
+ sprintf(fname, "%s/%s", nio->path, nio->dataFN[nio->dataFNIndex]);
+ } else {
+ strcpy(fname, nio->dataFN[nio->dataFNIndex]);
+ }
+ }
+ /* else data file is attached */
+
+ if (nio->dataFNFormat || nio->dataFNArr->len) {
+ *fileP = airFopen(fname, reading ? stdin : stdout, reading ? "rb" : "wb");
+ if (!(*fileP)) {
+ if ((err = (char*)malloc(strlen(fname) + AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't open \"%s\" (data file %d of %d) for %s",
+ me, fname, nio->dataFNIndex+1, (int)_nrrdDataFNNumber(nio),
+ reading ? "reading" : "writing");
+ biffAdd(NRRD, err); free(err);
+ }
+ airMopError(mop); return 1;
+ }
+ } else {
+ /* data file is attached */
+ *fileP = nio->headerFile;
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
+
+/*
+** we try to use the oldest format that will hold the nrrd
+*/
+int
+_nrrdFormatNRRD_whichVersion(const Nrrd *nrrd, NrrdIoState *nio) {
+ int ret;
+
+ if (_nrrdFieldInteresting(nrrd, nio, nrrdField_measurement_frame)) {
+ ret = 5;
+ } else if (_nrrdFieldInteresting(nrrd, nio, nrrdField_thicknesses)
+ || _nrrdFieldInteresting(nrrd, nio, nrrdField_space)
+ || _nrrdFieldInteresting(nrrd, nio, nrrdField_space_dimension)
+ || _nrrdFieldInteresting(nrrd, nio, nrrdField_sample_units)
+ || airStrlen(nio->dataFNFormat) || nio->dataFNArr->len > 1) {
+ ret = 4;
+ } else if (_nrrdFieldInteresting(nrrd, nio, nrrdField_kinds)) {
+ ret = 3;
+ } else if (nrrdKeyValueSize(nrrd)) {
+ ret = 2;
+ } else {
+ ret = 1;
+ }
+ return ret;
+}
+
+int
+_nrrdFormatNRRD_available(void) {
+
+ return AIR_TRUE;
+}
+
+int
+_nrrdFormatNRRD_nameLooksLike(const char *filename) {
+
+ return (airEndsWith(filename, NRRD_EXT_NRRD)
+ || airEndsWith(filename, NRRD_EXT_NHDR));
+}
+
+int
+_nrrdFormatNRRD_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatNRRD_fitsInto", err[AIR_STRLEN_MED];
+
+ if (!( nrrd && encoding )) {
+ sprintf(err, "%s: got NULL nrrd (%p) or encoding (%p)",
+ me, nrrd, encoding);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+ }
+
+ /* everything fits in a nrrd */
+ return AIR_TRUE;
+}
+
+int
+_nrrdFormatNRRD_contentStartsLike(NrrdIoState *nio) {
+
+ return (!strcmp(MAGIC0, nio->line)
+ || !strcmp(MAGIC1, nio->line)
+ || !strcmp(MAGIC2, nio->line)
+ || !strcmp(MAGIC3, nio->line)
+ || !strcmp(MAGIC4, nio->line)
+ || !strcmp(MAGIC5, nio->line)
+ );
+}
+
+/*
+** _nrrdHeaderCheck()
+**
+** minimal consistency checks on relationship between fields of nrrd,
+** only to be used after the headers is parsed, and before the data is
+** read, to make sure that information required for reading data is in
+** fact known.
+**
+** NOTE: this is not the place to do the sort of checking done by
+** nrrdCheck(), because it includes I/O-specific stuff
+**
+*/
+int
+_nrrdHeaderCheck (Nrrd *nrrd, NrrdIoState *nio, int checkSeen) {
+ char me[]="_nrrdHeaderCheck", err[AIR_STRLEN_MED];
+ int i;
+
+ if (checkSeen) {
+ for (i=1; i<=NRRD_FIELD_MAX; i++) {
+ if (_nrrdFieldRequired[i] && !nio->seen[i]) {
+ sprintf(err, "%s: didn't see required field: %s",
+ me, airEnumStr(nrrdField, i));
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ }
+ if (nrrdTypeBlock == nrrd->type && !nrrd->blockSize) {
+ sprintf(err, "%s: type is %s, but missing field: %s", me,
+ airEnumStr(nrrdType, nrrdTypeBlock),
+ airEnumStr(nrrdField, nrrdField_block_size));
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!nrrdElementSize(nrrd)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* _nrrdReadNrrdParse_sizes() checks axis[i].size, which completely
+ determines the return of nrrdElementNumber() */
+ if (airEndianUnknown == nio->endian
+ && nio->encoding->endianMatters
+ && 1 != nrrdElementSize(nrrd)) {
+ sprintf(err, "%s: type (%s) and encoding (%s) require %s info", me,
+ airEnumStr(nrrdType, nrrd->type),
+ nio->encoding->name,
+ airEnumStr(nrrdField, nrrdField_endian));
+ biffAdd(NRRD, err); return 1;
+ }
+
+ /* we don't really try to enforce consistency with the
+ min/max/center/size information on each axis, other than the
+ value checking done by the _nrrdReadNrrdParse_* functions,
+ because we only really care that we know each axis size. Past
+ that, if the user messes it up, its not really our problem ... */
+
+ return 0;
+}
+
+/*
+** NOTE: currently, this will read advanced NRRD format features
+** from old NRRD files (with old magic), such as key/value pairs
+** from a NRRD0001 file, without any complaints even though strictly
+** speaking these are violations of the format.
+**
+** NOTE: by giving a NULL "file", you can make this function basically
+** do the work of reading in datafiles, without any header parsing
+*/
+int
+_nrrdFormatNRRD_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatNRRD_read",
+ *err; /* NOTE: err really does have to be dynamically
+ allocated because of the arbitrary-sized input lines
+ that it may have to copy */
+ int ret;
+ unsigned int llen;
+ size_t valsPerPiece;
+ char *data;
+ FILE *dataFile=NULL;
+
+ /* record where the header is being read from for the sake of
+ nrrdIoStateDataFileIterNext() */
+ nio->headerFile = file;
+
+ if (file) {
+ if (!_nrrdFormatNRRD_contentStartsLike(nio)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: this doesn't look like a %s file", me,
+ nrrdFormatNRRD->name);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ /* parse all the header lines */
+ do {
+ nio->pos = 0;
+ if (_nrrdOneLine(&llen, nio, file)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: trouble getting line of header", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ if (llen > 1) {
+ ret = _nrrdReadNrrdParseField(nio, AIR_TRUE);
+ if (!ret) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED + strlen(nio->line)))) {
+ sprintf(err, "%s: trouble parsing field in \"%s\"", me, nio->line);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ /* comments and key/values are allowed multiple times */
+ if (nio->seen[ret]
+ && !(ret == nrrdField_comment || ret == nrrdField_keyvalue)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: already set field %s", me,
+ airEnumStr(nrrdField, ret));
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ if (nrrdFieldInfoParse[ret](file, nrrd, nio, AIR_TRUE)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ /* HEY: this error message should be printing out all the
+ per-axis fields, not just the first
+ HEY: if your stupid parsing functions didn't modify
+ nio->line then you wouldn't have this problem ... */
+ sprintf(err, "%s: trouble parsing %s info \"%s\"", me,
+ airEnumStr(nrrdField, ret), nio->line + nio->pos);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ nio->seen[ret] = AIR_TRUE;
+ }
+ } while (llen > 1);
+ /* either
+ 0 == llen: we're at EOF, or
+ 1 == llen: we just read the empty line seperating header from data */
+ if (0 == llen
+ && !nio->dataFNFormat
+ && 0 == nio->dataFNArr->len) {
+ /* we're at EOF, but there's apparently no seperate data file */
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: hit end of header, but no \"%s\" given", me,
+ airEnumStr(nrrdField, nrrdField_data_file));
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ }
+ if (_nrrdHeaderCheck(nrrd, nio, !!file)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: %s", me,
+ (llen ? "finished reading header, but there were problems"
+ : "hit EOF before seeing a complete valid header"));
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+
+
+ /* we seemed to have read in a valid header; now allocate the memory */
+ /* for directIO-compatible allocation we need to get the first datafile */
+ nrrdIoStateDataFileIterBegin(nio);
+ if (nrrdIoStateDataFileIterNext(&dataFile, nio, AIR_TRUE)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't open the first datafile", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ if (nio->skipData) {
+ nrrd->data = NULL;
+ data = NULL;
+ } else {
+ if (_nrrdCalloc(nrrd, nio, dataFile)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't allocate memory for data", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ data = (char*)nrrd->data;
+ }
+
+ /* iterate through datafiles and read them in */
+ /* NOTE: you have to open dataFile even in the case of skipData, because
+ caller might have set keepNrrdDataFileOpen, in which case you need to
+ do any line or byte skipping if it is specified */
+ valsPerPiece = nrrdElementNumber(nrrd)/_nrrdDataFNNumber(nio);
+ do {
+ /* ---------------- skip, if need be */
+ if (nrrdLineSkip(dataFile, nio)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't skip lines", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ if (!nio->encoding->isCompression) {
+ /* bytes are skipped here for non-compression encodings, but are
+ skipped within the decompressed stream for compression encodings */
+ if (nrrdByteSkip(dataFile, nrrd, nio)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't skip bytes", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ }
+ /* ---------------- read the data itself */
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "(%s: reading %s data ... ", me, nio->encoding->name);
+ fflush(stderr);
+ }
+ if (!nio->skipData) {
+ if (nio->encoding->read(dataFile, data, valsPerPiece, nrrd, nio)) {
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "error!\n");
+ }
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ }
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "done)\n");
+ }
+ /* ---------------- go to next data file */
+ if (nio->keepNrrdDataFileOpen && _nrrdDataFNNumber(nio) == 1) {
+ nio->dataFile = dataFile;
+ } else {
+ if (dataFile != nio->headerFile) {
+ dataFile = airFclose(dataFile);
+ }
+ }
+ data += valsPerPiece*nrrdElementSize(nrrd);
+ if (nrrdIoStateDataFileIterNext(&dataFile, nio, AIR_TRUE)) {
+ if ((err = (char*)malloc(AIR_STRLEN_MED))) {
+ sprintf(err, "%s: couldn't get the next datafile", me);
+ biffAdd(NRRD, err); free(err);
+ }
+ return 1;
+ }
+ } while (dataFile);
+
+ if (airEndianUnknown != nio->endian) {
+ /* we positively know the endianness of data just read */
+ if (1 < nrrdElementSize(nrrd)
+ && nio->encoding->endianMatters
+ && nio->endian != AIR_ENDIAN) {
+ /* endianness exposed in encoding, and its wrong */
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "(%s: fixing endianness ... ", me);
+ fflush(stderr);
+ }
+ nrrdSwapEndian(nrrd);
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "done)");
+ fflush(stderr);
+ }
+ }
+ }
+
+ return 0;
+}
+
+int
+_nrrdFormatNRRD_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatNRRD_write", err[AIR_STRLEN_MED], *tmp;
+ int ii;
+ unsigned int jj;
+ airArray *mop;
+ FILE *dataFile=NULL;
+ size_t valsPerPiece;
+ char *data;
+
+ mop = airMopNew();
+
+ if (nrrdTypeBlock == nrrd->type && nrrdEncodingAscii == nio->encoding) {
+ sprintf(err, "%s: can't write nrrd type %s to %s", me,
+ airEnumStr(nrrdType, nrrdTypeBlock),
+ nrrdEncodingAscii->name);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ /* record where the header is being written to for the sake of
+ nrrdIoStateDataFileIterNext() */
+ nio->headerFile = file;
+
+ /* we have to make sure that the data filename information is set
+ (if needed), so that it can be printed by _nrrdFprintFieldInfo */
+ if (nio->detachedHeader
+ && !nio->dataFNFormat
+ && 0 == nio->dataFNArr->len) {
+ /* NOTE: this means someone requested a detached header, but we
+ don't already have implicit (via dataFNFormat) or explicit
+ (via dataFN[]) information about the data file */
+ /* NOTE: whether or not nio->skipData, we have to contrive a filename to
+ say in the "data file" field, which is stored in nio->dataFN[0],
+ because the data filename will be "interesting", according to
+ _nrrdFieldInteresting() */
+ /* NOTE: Fri Feb 4 01:42:20 EST 2005 the way this is now set up, having
+ a name in dataFN[0] will trump the name implied by nio->{path,base},
+ which is a useful way for the user to explicitly set the output
+ data filename (as with unu make -od) */
+ if (!( !!airStrlen(nio->path) && !!airStrlen(nio->base) )) {
+ sprintf(err, "%s: can't create data file name: nio's "
+ "path and base empty", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ tmp = (char*)malloc(strlen(nio->base)
+ + strlen(".")
+ + strlen(nio->encoding->suffix) + 1);
+ if (!tmp) {
+ sprintf(err, "%s: couldn't allocate data filename", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ airMopAdd(mop, tmp, airFree, airMopOnError);
+ sprintf(tmp, "%s.%s", nio->base, nio->encoding->suffix);
+ jj = airArrayLenIncr(nio->dataFNArr, 1); /* HEY error checking */
+ nio->dataFN[jj] = tmp;
+ }
+
+ fprintf(file, "%s%04d\n", MAGIC, _nrrdFormatNRRD_whichVersion(nrrd, nio));
+
+ /* print out the advertisement about where to get the file format */
+ fprintf(file, "# %s\n", _nrrdFormatURLLine0);
+ fprintf(file, "# %s\n", _nrrdFormatURLLine1);
+
+ /* this is where the majority of the header printing happens */
+ for (ii=1; ii<=NRRD_FIELD_MAX; ii++) {
+ if (_nrrdFieldInteresting(nrrd, nio, ii)) {
+ _nrrdFprintFieldInfo (file, "", nrrd, nio, ii);
+ }
+ }
+
+ /* comments and key/values handled differently */
+ for (jj=0; jj<nrrd->cmtArr->len; jj++) {
+ fprintf(file, "%c %s\n", NRRD_COMMENT_CHAR, nrrd->cmt[jj]);
+ }
+ for (jj=0; jj<nrrd->kvpArr->len; jj++) {
+ _nrrdKeyValueFwrite(file, NULL, nrrd->kvp[0 + 2*jj], nrrd->kvp[1 + 2*jj]);
+ }
+
+ if (!( nio->detachedHeader || _nrrdDataFNNumber(nio) > 1 )) {
+ fprintf(file, "\n");
+ }
+
+ if (!nio->skipData) {
+ nrrdIoStateDataFileIterBegin(nio);
+ if (nrrdIoStateDataFileIterNext(&dataFile, nio, AIR_FALSE)) {
+ sprintf(err, "%s: couldn't write the first datafile", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ valsPerPiece = nrrdElementNumber(nrrd)/_nrrdDataFNNumber(nio);
+ data = (char*)nrrd->data;
+ do {
+ /* ---------------- write data */
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "(%s: writing %s data ", me, nio->encoding->name);
+ fflush(stderr);
+ }
+ if (nio->encoding->write(dataFile, data, valsPerPiece, nrrd, nio)) {
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "error!\n");
+ }
+ sprintf(err, "%s: couldn't write %s data", me, nio->encoding->name);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ if (2 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "done)\n");
+ }
+ /* ---------------- go to next data file */
+ if (dataFile != nio->headerFile) {
+ dataFile = airFclose(dataFile);
+ }
+ data += valsPerPiece*nrrdElementSize(nrrd);
+ if (nrrdIoStateDataFileIterNext(&dataFile, nio, AIR_TRUE)) {
+ sprintf(err, "%s: couldn't get the next datafile", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ } while (dataFile);
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
+
+const NrrdFormat
+_nrrdFormatNRRD = {
+ "NRRD",
+ AIR_FALSE, /* isImage */
+ AIR_TRUE, /* readable */
+ AIR_TRUE, /* usesDIO */
+ _nrrdFormatNRRD_available,
+ _nrrdFormatNRRD_nameLooksLike,
+ _nrrdFormatNRRD_fitsInto,
+ _nrrdFormatNRRD_contentStartsLike,
+ _nrrdFormatNRRD_read,
+ _nrrdFormatNRRD_write
+};
+
+const NrrdFormat *const
+nrrdFormatNRRD = &_nrrdFormatNRRD;
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatPNG.c b/Utilities/ITK/Utilities/NrrdIO/formatPNG.c
new file mode 100644
index 0000000000000000000000000000000000000000..55045120f5ec63c3b20862772a574dbdf1ca890a
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatPNG.c
@@ -0,0 +1,104 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdFormatPNG_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatPNG_nameLooksLike(const char *filename) {
+
+ return airEndsWith(filename, NRRD_EXT_PNG);
+}
+
+int
+_nrrdFormatPNG_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatPNG_fitsInto", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(encoding);
+ AIR_UNUSED(useBiff);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNG->name);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatPNG_contentStartsLike(NrrdIoState *nio) {
+
+ AIR_UNUSED(nio);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatPNG_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdReadPNG", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNG->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdFormatPNG_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatPNG_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNG->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatPNG = {
+ "PNG",
+ AIR_FALSE, /* isImage */
+ AIR_FALSE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatPNG_available,
+ _nrrdFormatPNG_nameLooksLike,
+ _nrrdFormatPNG_fitsInto,
+ _nrrdFormatPNG_contentStartsLike,
+ _nrrdFormatPNG_read,
+ _nrrdFormatPNG_write
+};
+
+const NrrdFormat *const
+nrrdFormatPNG = &_nrrdFormatPNG;
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatPNM.c b/Utilities/ITK/Utilities/NrrdIO/formatPNM.c
new file mode 100644
index 0000000000000000000000000000000000000000..b646359d34da493dc2176d07a799c16c12a86d5a
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatPNM.c
@@ -0,0 +1,105 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdFormatPNM_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatPNM_nameLooksLike(const char *filename) {
+
+ return (airEndsWith(filename, NRRD_EXT_PGM)
+ || airEndsWith(filename, NRRD_EXT_PPM));
+}
+
+int
+_nrrdFormatPNM_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatPNM_fitsInto", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(encoding);
+ AIR_UNUSED(useBiff);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNM->name);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatPNM_contentStartsLike(NrrdIoState *nio) {
+
+ AIR_UNUSED(nio);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatPNM_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdReadPNM", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNM->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdFormatPNM_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatPNM_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatPNM->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatPNM = {
+ "PNM",
+ AIR_FALSE, /* isImage */
+ AIR_FALSE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatPNM_available,
+ _nrrdFormatPNM_nameLooksLike,
+ _nrrdFormatPNM_fitsInto,
+ _nrrdFormatPNM_contentStartsLike,
+ _nrrdFormatPNM_read,
+ _nrrdFormatPNM_write
+};
+
+const NrrdFormat *const
+nrrdFormatPNM = &_nrrdFormatPNM;
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatText.c b/Utilities/ITK/Utilities/NrrdIO/formatText.c
new file mode 100644
index 0000000000000000000000000000000000000000..d180efa504411406572e20a83a60ac2fdea34187
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatText.c
@@ -0,0 +1,106 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdFormatText_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatText_nameLooksLike(const char *fname) {
+
+ return (airEndsWith(fname, NRRD_EXT_TEXT)
+ || airEndsWith(fname, ".text")
+ || airEndsWith(fname, ".ascii"));
+}
+
+int
+_nrrdFormatText_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatText_fitsInto", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(encoding);
+ AIR_UNUSED(useBiff);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatText->name);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatText_contentStartsLike(NrrdIoState *nio) {
+
+ AIR_UNUSED(nio);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatText_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdReadText", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatText->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+int
+_nrrdFormatText_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatText_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatText->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatText = {
+ "text",
+ AIR_FALSE, /* isImage */
+ AIR_FALSE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatText_available,
+ _nrrdFormatText_nameLooksLike,
+ _nrrdFormatText_fitsInto,
+ _nrrdFormatText_contentStartsLike,
+ _nrrdFormatText_read,
+ _nrrdFormatText_write
+};
+
+const NrrdFormat *const
+nrrdFormatText = &_nrrdFormatText;
diff --git a/Utilities/ITK/Utilities/NrrdIO/formatVTK.c b/Utilities/ITK/Utilities/NrrdIO/formatVTK.c
new file mode 100644
index 0000000000000000000000000000000000000000..4cf6612a3fe00e3b06d606fccab3089f5c77ed79
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/formatVTK.c
@@ -0,0 +1,105 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+int
+_nrrdFormatVTK_available(void) {
+
+ return AIR_FALSE;
+}
+
+int
+_nrrdFormatVTK_nameLooksLike(const char *fname) {
+
+ return airEndsWith(fname, NRRD_EXT_VTK);
+}
+
+int
+_nrrdFormatVTK_fitsInto(const Nrrd *nrrd, const NrrdEncoding *encoding,
+ int useBiff) {
+ char me[]="_nrrdFormatVTK_fitsInto", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(encoding);
+ AIR_UNUSED(useBiff);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatVTK->name);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatVTK_contentStartsLike(NrrdIoState *nio) {
+
+ AIR_UNUSED(nio);
+ return AIR_FALSE;
+
+}
+
+int
+_nrrdFormatVTK_read(FILE *file, Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdReadVTK", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatVTK->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+/* this strongly assumes that nrrdFitsInFormat() was true */
+int
+_nrrdFormatVTK_write(FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="_nrrdFormatVTK_write", err[AIR_STRLEN_MED];
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ sprintf(err, "%s: Sorry, %s format not available in NrrdIO",
+ me, nrrdFormatVTK->name);
+ biffAdd(NRRD, err);
+ return 1;
+}
+
+const NrrdFormat
+_nrrdFormatVTK = {
+ "VTK",
+ AIR_FALSE, /* isImage */
+ AIR_FALSE, /* readable */
+ AIR_FALSE, /* usesDIO */
+ _nrrdFormatVTK_available,
+ _nrrdFormatVTK_nameLooksLike,
+ _nrrdFormatVTK_fitsInto,
+ _nrrdFormatVTK_contentStartsLike,
+ _nrrdFormatVTK_read,
+ _nrrdFormatVTK_write
+};
+
+const NrrdFormat *const
+nrrdFormatVTK = &_nrrdFormatVTK;
diff --git a/Utilities/ITK/Utilities/NrrdIO/gzio.c b/Utilities/ITK/Utilities/NrrdIO/gzio.c
new file mode 100644
index 0000000000000000000000000000000000000000..5809c50748d7c26989bed822a6ce8df7f9280076
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/gzio.c
@@ -0,0 +1,683 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+/*
+ This file is a modified version of the 'gzio.c' and 'zutil.h' source
+ files from the zlib 1.1.4 distribution.
+
+ zlib.h -- interface of the 'zlib' general purpose compression library
+ version 1.1.4, March 11th, 2002
+
+ Copyright (C) 1995-2002 Jean-loup Gailly and Mark Adler
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup@gzip.org madler@alumni.caltech.edu
+
+ The data format used by the zlib library is described by RFCs (Request for
+ Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt
+ (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
+*/
+
+#if TEEM_ZLIB
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+#ifdef _WIN32 /* Window 95 & Windows NT */
+# define _NRRD_OS_CODE 0x0b
+#endif
+
+#if defined(MACOS) || defined(TARGET_OS_MAC) || defined(__APPLE_CC__)
+# define _NRRD_OS_CODE 0x07
+#endif
+
+#ifndef _NRRD_OS_CODE
+# define _NRRD_OS_CODE 0x03 /* assume Unix */
+#endif
+
+/* default memLevel */
+#if MAX_MEM_LEVEL >= 8
+# define _NRRD_DEF_MEM_LEVEL 8
+#else
+# define _NRRD_DEF_MEM_LEVEL MAX_MEM_LEVEL
+#endif
+
+/* stream buffer size */
+#define _NRRD_Z_BUFSIZE 16 * 1024
+
+/* gzip flag byte */
+#define _NRRD_ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */
+#define _NRRD_HEAD_CRC 0x02 /* bit 1 set: header CRC present */
+#define _NRRD_EXTRA_FIELD 0x04 /* bit 2 set: extra field present */
+#define _NRRD_ORIG_NAME 0x08 /* bit 3 set: original file name present */
+#define _NRRD_COMMENT 0x10 /* bit 4 set: file comment present */
+#define _NRRD_RESERVED 0xE0 /* bits 5..7: reserved */
+
+typedef struct _NrrdGzStream {
+ z_stream stream;
+ int z_err; /* error code for last stream operation */
+ int z_eof; /* set if end of input file */
+ FILE *file; /* .gz file */
+ Byte *inbuf; /* input buffer */
+ Byte *outbuf; /* output buffer */
+ uLong crc; /* crc32 of uncompressed data */
+ char *msg; /* error message */
+ int transparent; /* 1 if input file is not a .gz file */
+ char mode; /* 'w' or 'r' */
+ long startpos; /* start of compressed data in file (header skipped) */
+} _NrrdGzStream;
+
+static int _nrrdGzMagic[2] = {0x1f, 0x8b}; /* gzip magic header */
+
+/* zlib error messages */
+static const char *_nrrdGzErrMsg[10] = {
+ "need dictionary", /* Z_NEED_DICT 2 */
+ "stream end", /* Z_STREAM_END 1 */
+ "", /* Z_OK 0 */
+ "file error", /* Z_ERRNO (-1) */
+ "stream error", /* Z_STREAM_ERROR (-2) */
+ "data error", /* Z_DATA_ERROR (-3) */
+ "insufficient memory", /* Z_MEM_ERROR (-4) */
+ "buffer error", /* Z_BUF_ERROR (-5) */
+ "incompatible version",/* Z_VERSION_ERROR (-6) */
+ ""};
+
+#define _NRRD_GZ_ERR_MSG(err) _nrrdGzErrMsg[Z_NEED_DICT-(err)]
+
+static int _nrrdGzGetByte (_NrrdGzStream *s);
+static void _nrrdGzCheckHeader (_NrrdGzStream *s);
+static int _nrrdGzDestroy (_NrrdGzStream *s);
+static int _nrrdGzDoFlush (gzFile file, int flush);
+static void _nrrdGzPutLong (FILE *file, uLong x);
+static uLong _nrrdGzGetLong (_NrrdGzStream *s);
+
+gzFile _nrrdGzOpen (FILE* fd, const char *mode);
+int _nrrdGzClose (gzFile file);
+int _nrrdGzRead (gzFile file, voidp buf, unsigned int len, unsigned int* read);
+int _nrrdGzWrite (gzFile file, const voidp buf, unsigned int len, unsigned int* written);
+
+/*
+** _nrrdGzOpen()
+**
+** Opens a gzip (.gz) file for reading or writing. The mode parameter
+** is like in fopen ("rb" or "wb"). The file represented by the FILE* pointer
+** should be open already with the same mode. The mode parameter can also be
+** used to specify the compression level "[0-9]" and strategy "[f|h]".
+**
+** The compression level must be between 0 and 9: 1 gives best speed,
+** 9 gives best compression, 0 gives no compression at all (the input data
+** is simply copied a block at a time). The default level is 6.
+**
+** The strategy parameter is used to tune the compression algorithm. Use
+** "f" for data produced by a filter (or predictor), or "h" to force Huffman
+** encoding only (no string match). Filtered data consists mostly of small
+** values with a somewhat random distribution. In this case, the compression
+** algorithm is tuned to compress them better. The effect of "f" is to force
+** more Huffman coding and less string matching; it is somewhat intermediate
+** between the default and Huffman. The strategy parameter only affects the
+** compression ratio but not the correctness of the compressed output even
+** if it is not set appropriately.
+**
+** The complete syntax for the mode parameter is: "(r|w[a])[0-9][f|h]".
+**
+** Returns Z_NULL if the file could not be opened or if there was
+** insufficient memory to allocate the (de)compression state; errno
+** can be checked to distinguish the two cases (if errno is zero, the
+** zlib error is Z_MEM_ERROR).
+*/
+gzFile
+_nrrdGzOpen(FILE* fd, const char* mode) {
+ char me[] = "_nrrdGzOpen", err[AIR_STRLEN_MED];
+ int error;
+ int level = Z_DEFAULT_COMPRESSION; /* compression level */
+ int strategy = Z_DEFAULT_STRATEGY; /* compression strategy */
+ char *p = (char*)mode;
+ _NrrdGzStream *s;
+ char fmode[AIR_STRLEN_MED]; /* copy of mode, without the compression level */
+ char *m = fmode;
+
+ if (!mode) {
+ sprintf(err, "%s: no file mode specified", me);
+ biffAdd(NRRD, err);
+ return Z_NULL;
+ }
+ /* allocate stream struct */
+ s = (_NrrdGzStream *)calloc(1, sizeof(_NrrdGzStream));
+ if (!s) {
+ sprintf(err, "%s: failed to allocate stream buffer", me);
+ biffAdd(NRRD, err);
+ return Z_NULL;
+ }
+ /* initialize stream struct */
+ s->stream.zalloc = (alloc_func)0;
+ s->stream.zfree = (free_func)0;
+ s->stream.opaque = (voidpf)0;
+ s->stream.next_in = s->inbuf = Z_NULL;
+ s->stream.next_out = s->outbuf = Z_NULL;
+ s->stream.avail_in = s->stream.avail_out = 0;
+ s->file = NULL;
+ s->z_err = Z_OK;
+ s->z_eof = 0;
+ s->crc = crc32(0L, Z_NULL, 0);
+ s->msg = NULL;
+ s->transparent = 0;
+ /* parse mode flag */
+ s->mode = '\0';
+ do {
+ if (*p == 'r') s->mode = 'r';
+ if (*p == 'w' || *p == 'a') s->mode = 'w';
+ if (*p >= '0' && *p <= '9') {
+ level = *p - '0';
+ } else if (*p == 'f') {
+ strategy = Z_FILTERED;
+ } else if (*p == 'h') {
+ strategy = Z_HUFFMAN_ONLY;
+ } else {
+ *m++ = *p; /* copy the mode */
+ }
+ } while (*p++ && m != fmode + sizeof(fmode));
+ if (s->mode == '\0') {
+ sprintf(err, "%s: invalid file mode", me);
+ biffAdd(NRRD, err);
+ return _nrrdGzDestroy(s), (gzFile)Z_NULL;
+ }
+
+ if (s->mode == 'w') {
+ error = deflateInit2(&(s->stream), level,
+ Z_DEFLATED, -MAX_WBITS, _NRRD_DEF_MEM_LEVEL,
+ strategy);
+ /* windowBits is passed < 0 to suppress zlib header */
+
+ s->stream.next_out = s->outbuf = (Byte*)calloc(1, _NRRD_Z_BUFSIZE);
+ if (error != Z_OK || s->outbuf == Z_NULL) {
+ sprintf(err, "%s: stream init failed", me);
+ biffAdd(NRRD, err);
+ return _nrrdGzDestroy(s), (gzFile)Z_NULL;
+ }
+ } else {
+ s->stream.next_in = s->inbuf = (Byte*)calloc(1, _NRRD_Z_BUFSIZE);
+
+ error = inflateInit2(&(s->stream), -MAX_WBITS);
+ /* windowBits is passed < 0 to tell that there is no zlib header.
+ * Note that in this case inflate *requires* an extra "dummy" byte
+ * after the compressed stream in order to complete decompression and
+ * return Z_STREAM_END. Here the gzip CRC32 ensures that 4 bytes are
+ * present after the compressed stream.
+ */
+ if (error != Z_OK || s->inbuf == Z_NULL) {
+ sprintf(err, "%s: stream init failed", me);
+ biffAdd(NRRD, err);
+ return _nrrdGzDestroy(s), (gzFile)Z_NULL;
+ }
+ }
+ s->stream.avail_out = _NRRD_Z_BUFSIZE;
+ errno = 0;
+ s->file = fd;
+ if (s->file == NULL) {
+ sprintf(err, "%s: null file pointer", me);
+ biffAdd(NRRD, err);
+ return _nrrdGzDestroy(s), (gzFile)Z_NULL;
+ }
+ if (s->mode == 'w') {
+ /* Write a very simple .gz header: */
+ fprintf(s->file, "%c%c%c%c%c%c%c%c%c%c", _nrrdGzMagic[0], _nrrdGzMagic[1],
+ Z_DEFLATED,
+ 0 /*flags*/,
+ 0,0,0,0 /*time*/,
+ 0 /*xflags*/,
+ _NRRD_OS_CODE);
+ s->startpos = 10L;
+ /* We use 10L instead of ftell(s->file) to because ftell causes an
+ * fflush on some systems. This version of the library doesn't use
+ * startpos anyway in write mode, so this initialization is not
+ * necessary.
+ */
+ } else {
+ _nrrdGzCheckHeader(s); /* skip the .gz header */
+ s->startpos = (ftell(s->file) - s->stream.avail_in);
+ }
+ return (gzFile)s;
+}
+
+/*
+** _nrrdGzClose()
+**
+** Flushes all pending output if necessary, closes the compressed file
+** and deallocates the (de)compression state.
+*/
+int
+_nrrdGzClose (gzFile file)
+{
+ char me[] = "_nrrdGzClose", err[AIR_STRLEN_MED];
+ int error;
+ _NrrdGzStream *s = (_NrrdGzStream*)file;
+
+ if (s == NULL) {
+ sprintf(err, "%s: invalid stream", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+ if (s->mode == 'w') {
+ error = _nrrdGzDoFlush(file, Z_FINISH);
+ if (error != Z_OK) {
+ sprintf(err, "%s: failed to flush pending data", me);
+ biffAdd(NRRD, err);
+ return _nrrdGzDestroy((_NrrdGzStream*)file);
+ }
+ _nrrdGzPutLong(s->file, s->crc);
+ _nrrdGzPutLong(s->file, s->stream.total_in);
+ }
+ return _nrrdGzDestroy((_NrrdGzStream*)file);
+}
+
+/*
+** _nrrdGzRead()
+**
+** Reads the given number of uncompressed bytes from the compressed file.
+** Returns the number of bytes actually read (0 for end of file).
+*/
+int
+_nrrdGzRead (gzFile file, voidp buf, unsigned int len, unsigned int* read) {
+ char me[] = "_nrrdGzRead", err[AIR_STRLEN_MED];
+ _NrrdGzStream *s = (_NrrdGzStream*)file;
+ Bytef *start = (Bytef*)buf; /* starting point for crc computation */
+ Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */
+
+ if (s == NULL || s->mode != 'r') {
+ sprintf(err, "%s: invalid stream or file mode", me);
+ biffAdd(NRRD, err);
+ *read = 0;
+ return 1;
+ }
+
+ if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) {
+ sprintf(err, "%s: data read error", me);
+ biffAdd(NRRD, err);
+ *read = 0;
+ return 1;
+ }
+
+ if (s->z_err == Z_STREAM_END) {
+ *read = 0;
+ return 0; /* EOF */
+ }
+
+ next_out = (Byte*)buf;
+ s->stream.next_out = (Bytef*)buf;
+ s->stream.avail_out = len;
+
+ while (s->stream.avail_out != 0) {
+
+ if (s->transparent) {
+ /* Copy first the lookahead bytes: */
+ uInt n = s->stream.avail_in;
+ if (n > s->stream.avail_out) n = s->stream.avail_out;
+ if (n > 0) {
+ memcpy(s->stream.next_out, s->stream.next_in, n);
+ next_out += n;
+ s->stream.next_out = next_out;
+ s->stream.next_in += n;
+ s->stream.avail_out -= n;
+ s->stream.avail_in -= n;
+ }
+ if (s->stream.avail_out > 0) {
+ s->stream.avail_out -= fread(next_out, 1, s->stream.avail_out,
+ s->file);
+ }
+ len -= s->stream.avail_out;
+ s->stream.total_in += len;
+ s->stream.total_out += len;
+ if (len == 0) s->z_eof = 1;
+ *read = len;
+ return 0;
+ }
+ if (s->stream.avail_in == 0 && !s->z_eof) {
+
+ errno = 0;
+ s->stream.avail_in = fread(s->inbuf, 1, _NRRD_Z_BUFSIZE, s->file);
+ if (s->stream.avail_in == 0) {
+ s->z_eof = 1;
+ if (ferror(s->file)) {
+ s->z_err = Z_ERRNO;
+ break;
+ }
+ }
+ s->stream.next_in = s->inbuf;
+ }
+ s->z_err = inflate(&(s->stream), Z_NO_FLUSH);
+
+ if (s->z_err == Z_STREAM_END) {
+ /* Check CRC and original size */
+ s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start));
+ start = s->stream.next_out;
+
+ if (_nrrdGzGetLong(s) != s->crc) {
+ s->z_err = Z_DATA_ERROR;
+ } else {
+ (void)_nrrdGzGetLong(s);
+ /* The uncompressed length returned by above getlong() may
+ * be different from s->stream.total_out) in case of
+ * concatenated .gz files. Check for such files:
+ */
+ _nrrdGzCheckHeader(s);
+ if (s->z_err == Z_OK) {
+ uLong total_in = s->stream.total_in;
+ uLong total_out = s->stream.total_out;
+
+ inflateReset(&(s->stream));
+ s->stream.total_in = total_in;
+ s->stream.total_out = total_out;
+ s->crc = crc32(0L, Z_NULL, 0);
+ }
+ }
+ }
+ if (s->z_err != Z_OK || s->z_eof) break;
+ }
+ s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start));
+
+ *read = len - s->stream.avail_out;
+ return 0;
+}
+
+/*
+** _nrrdGzWrite()
+**
+** Writes the given number of uncompressed bytes into the compressed file.
+** Returns the number of bytes actually written (0 in case of error).
+*/
+int
+_nrrdGzWrite (gzFile file, const voidp buf, unsigned int len,
+ unsigned int* written) {
+ char me[] = "_nrrdGzWrite", err[AIR_STRLEN_MED];
+ _NrrdGzStream *s = (_NrrdGzStream*)file;
+
+ if (s == NULL || s->mode != 'w') {
+ sprintf(err, "%s: invalid stream or file mode", me);
+ biffAdd(NRRD, err);
+ *written = 0;
+ return 1;
+ }
+
+ s->stream.next_in = (Bytef*)buf;
+ s->stream.avail_in = len;
+
+ while (s->stream.avail_in != 0) {
+ if (s->stream.avail_out == 0) {
+ s->stream.next_out = s->outbuf;
+ if (fwrite(s->outbuf, 1, _NRRD_Z_BUFSIZE, s->file) != _NRRD_Z_BUFSIZE) {
+ s->z_err = Z_ERRNO;
+ sprintf(err, "%s: failed to write to file", me);
+ biffAdd(NRRD, err);
+ break;
+ }
+ s->stream.avail_out = _NRRD_Z_BUFSIZE;
+ }
+ s->z_err = deflate(&(s->stream), Z_NO_FLUSH);
+ if (s->z_err != Z_OK) break;
+ }
+ s->crc = crc32(s->crc, (const Bytef *)buf, len);
+
+ *written = len - s->stream.avail_in;
+ return 0;
+}
+
+/*
+** _nrrdGzGetByte()
+**
+** Reads a byte from a _NrrdGzStream. Updates next_in and avail_in.
+** Returns EOF for end of file.
+** IN assertion: the stream s has been sucessfully opened for reading.
+*/
+static int
+_nrrdGzGetByte(_NrrdGzStream *s) {
+ char me[] = "_nrrdGzGetByte", err[AIR_STRLEN_MED];
+
+ if (s->z_eof) return EOF;
+ if (s->stream.avail_in == 0) {
+ errno = 0;
+ s->stream.avail_in = fread(s->inbuf, 1, _NRRD_Z_BUFSIZE, s->file);
+ if (s->stream.avail_in == 0) {
+ s->z_eof = 1;
+ if (ferror(s->file)) {
+ sprintf(err, "%s: failed to read from file", me);
+ biffAdd(NRRD, err);
+ s->z_err = Z_ERRNO;
+ }
+ return EOF;
+ }
+ s->stream.next_in = s->inbuf;
+ }
+ s->stream.avail_in--;
+ return *(s->stream.next_in)++;
+}
+
+/*
+******** _nrrdGzCheckHeader()
+**
+** Checks the gzip header of a _NrrdGzStream opened for reading. Sets
+** the stream mode to transparent if the gzip magic header is not
+** present; sets s->err to Z_DATA_ERROR if the magic header is present
+** but the rest of the header is incorrect.
+** IN assertion: the stream s has already been created sucessfully;
+** s->stream.avail_in is zero for the first time, but may be non-zero
+** for concatenated .gz files.
+*/
+static void
+_nrrdGzCheckHeader(_NrrdGzStream *s) {
+ char me[] = "_nrrdGzCheckHeader", err[AIR_STRLEN_MED];
+ int method; /* method byte */
+ int flags; /* flags byte */
+ uInt len;
+ int c;
+
+ /* Check the gzip magic header */
+ for (len = 0; len < 2; len++) {
+ c = _nrrdGzGetByte(s);
+ if (c != _nrrdGzMagic[len]) {
+ if (len != 0) s->stream.avail_in++, s->stream.next_in--;
+ if (c != EOF) {
+ s->stream.avail_in++, s->stream.next_in--;
+ s->transparent = 1;
+ }
+ s->z_err = s->stream.avail_in != 0 ? Z_OK : Z_STREAM_END;
+ return;
+ }
+ }
+ method = _nrrdGzGetByte(s);
+ flags = _nrrdGzGetByte(s);
+ if (method != Z_DEFLATED || (flags & _NRRD_RESERVED) != 0) {
+ sprintf(err, "%s: gzip compression method is not deflate", me);
+ biffAdd(NRRD, err);
+ s->z_err = Z_DATA_ERROR;
+ return;
+ }
+
+ /* Discard time, xflags and OS code: */
+ for (len = 0; len < 6; len++) (void)_nrrdGzGetByte(s);
+
+ if ((flags & _NRRD_EXTRA_FIELD) != 0) { /* skip the extra field */
+ len = (uInt)_nrrdGzGetByte(s);
+ len += ((uInt)_nrrdGzGetByte(s))<<8;
+ /* len is garbage if EOF but the loop below will quit anyway */
+ while (len-- != 0 && _nrrdGzGetByte(s) != EOF) ;
+ }
+ if ((flags & _NRRD_ORIG_NAME) != 0) { /* skip the original file name */
+ while ((c = _nrrdGzGetByte(s)) != 0 && c != EOF) ;
+ }
+ if ((flags & _NRRD_COMMENT) != 0) { /* skip the .gz file comment */
+ while ((c = _nrrdGzGetByte(s)) != 0 && c != EOF) ;
+ }
+ if ((flags & _NRRD_HEAD_CRC) != 0) { /* skip the header crc */
+ for (len = 0; len < 2; len++) (void)_nrrdGzGetByte(s);
+ }
+ s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK;
+}
+
+/*
+** _nrrdGzDestroy()
+**
+** Cleans up then free the given _NrrdGzStream. Returns a zlib error code.
+** Try freeing in the reverse order of allocations. FILE* s->file is not
+** closed. Because we didn't allocate it, we shouldn't delete it.
+*/
+static int
+_nrrdGzDestroy(_NrrdGzStream *s) {
+ char me[] = "_nrrdGzDestroy", err[AIR_STRLEN_MED];
+ int error = Z_OK;
+
+ if (s == NULL) {
+ sprintf(err, "%s: invalid stream", me);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+ s->msg = (char *)airFree(s->msg);
+ if (s->stream.state != NULL) {
+ if (s->mode == 'w') {
+ error = deflateEnd(&(s->stream));
+ } else if (s->mode == 'r') {
+ error = inflateEnd(&(s->stream));
+ }
+ }
+ if (error != Z_OK) {
+ sprintf(err, "%s: %s", me, _NRRD_GZ_ERR_MSG(error));
+ biffAdd(NRRD, err);
+ }
+ if (s->z_err < 0) error = s->z_err;
+ if (error != Z_OK) {
+ sprintf(err, "%s: %s", me, _NRRD_GZ_ERR_MSG(error));
+ biffAdd(NRRD, err);
+ }
+ s->inbuf = (Byte *)airFree(s->inbuf);
+ s->outbuf = (Byte *)airFree(s->outbuf);
+ airFree(s);
+ return error != Z_OK;
+}
+
+/*
+** _nrrdGzDoFlush()
+**
+** Flushes all pending output into the compressed file. The parameter
+** flush is the same as in the deflate() function.
+*/
+static int
+_nrrdGzDoFlush(gzFile file, int flush)
+{
+ char me[] = "_nrrdGzDoFlush", err[AIR_STRLEN_MED];
+ uInt len;
+ int done = 0;
+ _NrrdGzStream *s = (_NrrdGzStream*)file;
+
+ if (s == NULL || s->mode != 'w') {
+ sprintf(err, "%s: invalid stream or file mode", me);
+ biffAdd(NRRD, err);
+ return Z_STREAM_ERROR;
+ }
+
+ s->stream.avail_in = 0; /* should be zero already anyway */
+
+ for (;;) {
+ len = _NRRD_Z_BUFSIZE - s->stream.avail_out;
+
+ if (len != 0) {
+ if ((uInt)fwrite(s->outbuf, 1, len, s->file) != len) {
+ s->z_err = Z_ERRNO;
+ return Z_ERRNO;
+ }
+ s->stream.next_out = s->outbuf;
+ s->stream.avail_out = _NRRD_Z_BUFSIZE;
+ }
+ if (done) break;
+ s->z_err = deflate(&(s->stream), flush);
+
+ /* Ignore the second of two consecutive flushes: */
+ if (len == 0 && s->z_err == Z_BUF_ERROR) s->z_err = Z_OK;
+
+ /* deflate has finished flushing only when it hasn't used up
+ * all the available space in the output buffer:
+ */
+ done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END);
+
+ if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break;
+ }
+ return s->z_err == Z_STREAM_END ? Z_OK : s->z_err;
+}
+
+/*
+** _nrrdGzPutLong()
+**
+** Outputs a long in LSB order to the given file.
+*/
+static void
+_nrrdGzPutLong(FILE* file, uLong x) {
+ int n;
+ for (n = 0; n < 4; n++) {
+ fputc((int)(x & 0xff), file);
+ x >>= 8;
+ }
+}
+
+/*
+** _nrrdGzGetLong()
+**
+** Reads a long in LSB order from the given _NrrdGzStream.
+** Sets z_err in case of error.
+*/
+static uLong
+_nrrdGzGetLong(_NrrdGzStream *s) {
+ uLong x = (uLong)_nrrdGzGetByte(s);
+ int c;
+
+ x += ((uLong)_nrrdGzGetByte(s))<<8;
+ x += ((uLong)_nrrdGzGetByte(s))<<16;
+ c = _nrrdGzGetByte(s);
+ if (c == EOF) s->z_err = Z_DATA_ERROR;
+ x += ((uLong)c)<<24;
+ return x;
+}
+
+#endif /* TEEM_ZLIB */
+
+/*
+** random symbol to have in object file, even when Zlib not enabled
+*/
+int
+_nrrdGzDummySymbol(void) {
+ return 42;
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/itk_NrrdIO_mangle.h b/Utilities/ITK/Utilities/NrrdIO/itk_NrrdIO_mangle.h
new file mode 100644
index 0000000000000000000000000000000000000000..80e67b44987f7f69c2feeb07596703d5ebc493eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/itk_NrrdIO_mangle.h
@@ -0,0 +1,647 @@
+#ifndef __itk_NrrdIO_mangle_h
+#define __itk_NrrdIO_mangle_h
+
+/*
+
+This header file mangles all symbols exported from the
+NrrdIO library. It is included in all files while building
+the NrrdIO library. Due to namespace pollution, no NrrdIO
+headers should be included in .h files in ITK.
+
+This file was created via the mangle.pl script in the
+NrrdIO distribution:
+
+ perl mangle.pl itk > itk_NrrdIO_mangle.h
+
+This uses nm to list all text (T), data (D) symbols, as well
+read-only (R) things (seen on Linux) and "other" (S) things
+(seen on Mac). On Macs, the preceeding underscore is removed.
+*/
+
+#define airExists itk_airExists
+#define airFPClass_d itk_airFPClass_d
+#define airFPClass_f itk_airFPClass_f
+#define airFPFprintf_d itk_airFPFprintf_d
+#define airFPFprintf_f itk_airFPFprintf_f
+#define airFPGen_d itk_airFPGen_d
+#define airFPGen_f itk_airFPGen_f
+#define airFPPartsToVal_d itk_airFPPartsToVal_d
+#define airFPPartsToVal_f itk_airFPPartsToVal_f
+#define airFPValToParts_d itk_airFPValToParts_d
+#define airFPValToParts_f itk_airFPValToParts_f
+#define airFloatNegInf itk_airFloatNegInf
+#define airFloatPosInf itk_airFloatPosInf
+#define airFloatQNaN itk_airFloatQNaN
+#define airFloatSNaN itk_airFloatSNaN
+#define airIsInf_d itk_airIsInf_d
+#define airIsInf_f itk_airIsInf_f
+#define airIsNaN itk_airIsNaN
+#define airMyQNaNHiBit itk_airMyQNaNHiBit
+#define airNaN itk_airNaN
+#define _airMopPrint itk__airMopPrint
+#define _airMopWhenStr itk__airMopWhenStr
+#define airMopAdd itk_airMopAdd
+#define airMopDebug itk_airMopDebug
+#define airMopDone itk_airMopDone
+#define airMopError itk_airMopError
+#define airMopMem itk_airMopMem
+#define airMopNew itk_airMopNew
+#define airMopOkay itk_airMopOkay
+#define airMopPrint itk_airMopPrint
+#define airMopSub itk_airMopSub
+#define airMopUnMem itk_airMopUnMem
+#define _airLenSet itk__airLenSet
+#define _airSetData itk__airSetData
+#define airArrayLenIncr itk_airArrayLenIncr
+#define airArrayLenPreSet itk_airArrayLenPreSet
+#define airArrayLenSet itk_airArrayLenSet
+#define airArrayNew itk_airArrayNew
+#define airArrayNix itk_airArrayNix
+#define airArrayNuke itk_airArrayNuke
+#define airArrayPointerCB itk_airArrayPointerCB
+#define airArrayStructCB itk_airArrayStructCB
+#define _airBool itk__airBool
+#define _airBoolDesc itk__airBoolDesc
+#define _airBoolStr itk__airBoolStr
+#define _airBoolStrEqv itk__airBoolStrEqv
+#define _airBoolVal itk__airBoolVal
+#define _airBoolValEqv itk__airBoolValEqv
+#define airAtod itk_airAtod
+#define airBool itk_airBool
+#define airParseStr itk_airParseStr
+#define airParseStrB itk_airParseStrB
+#define airParseStrC itk_airParseStrC
+#define airParseStrD itk_airParseStrD
+#define airParseStrE itk_airParseStrE
+#define airParseStrF itk_airParseStrF
+#define airParseStrI itk_airParseStrI
+#define airParseStrS itk_airParseStrS
+#define airParseStrUI itk_airParseStrUI
+#define airParseStrZ itk_airParseStrZ
+#define airSingleSscanf itk_airSingleSscanf
+#define _airNoDioErr itk__airNoDioErr
+#define airDioInfo itk_airDioInfo
+#define airDioMalloc itk_airDioMalloc
+#define airDioRead itk_airDioRead
+#define airDioTest itk_airDioTest
+#define airDioWrite itk_airDioWrite
+#define airDisableDio itk_airDisableDio
+#define airMyDio itk_airMyDio
+#define airNoDioErr itk_airNoDioErr
+#define _airBadInsane itk__airBadInsane
+#define _airInsaneErr itk__airInsaneErr
+#define airInsaneErr itk_airInsaneErr
+#define airSanity itk_airSanity
+#define _airEndian itk__airEndian
+#define _airEndianDesc itk__airEndianDesc
+#define _airEndianStr itk__airEndianStr
+#define _airEndianVal itk__airEndianVal
+#define airEndian itk_airEndian
+#define airMyEndian itk_airMyEndian
+#define airEndsWith itk_airEndsWith
+#define airOneLine itk_airOneLine
+#define airOneLinify itk_airOneLinify
+#define airStrdup itk_airStrdup
+#define airStrlen itk_airStrlen
+#define airStrntok itk_airStrntok
+#define airStrtok itk_airStrtok
+#define airStrtokQuoting itk_airStrtokQuoting
+#define airStrtrans itk_airStrtrans
+#define airToLower itk_airToLower
+#define airToUpper itk_airToUpper
+#define airUnescape itk_airUnescape
+#define _airEnumIndex itk__airEnumIndex
+#define airEnumDesc itk_airEnumDesc
+#define airEnumFmtDesc itk_airEnumFmtDesc
+#define airEnumStr itk_airEnumStr
+#define airEnumUnknown itk_airEnumUnknown
+#define airEnumVal itk_airEnumVal
+#define airEnumValCheck itk_airEnumValCheck
+#define _airSanityHelper itk__airSanityHelper
+#define airFclose itk_airFclose
+#define airFopen itk_airFopen
+#define airFree itk_airFree
+#define airMy32Bit itk_airMy32Bit
+#define airNull itk_airNull
+#define airSetNull itk_airSetNull
+#define airSinglePrintf itk_airSinglePrintf
+#define airTeemReleaseDate itk_airTeemReleaseDate
+#define airTeemVersion itk_airTeemVersion
+#define _biffAA itk__biffAA
+#define _biffAddErr itk__biffAddErr
+#define _biffAddKey itk__biffAddKey
+#define _biffCheckKey itk__biffCheckKey
+#define _biffErr itk__biffErr
+#define _biffFindKey itk__biffFindKey
+#define _biffFindMaxAndSum itk__biffFindMaxAndSum
+#define _biffGetStr itk__biffGetStr
+#define _biffIdx itk__biffIdx
+#define _biffInit itk__biffInit
+#define _biffNewEntry itk__biffNewEntry
+#define _biffNuke itk__biffNuke
+#define _biffNukeEntry itk__biffNukeEntry
+#define _biffNum itk__biffNum
+#define biffAdd itk_biffAdd
+#define biffCheck itk_biffCheck
+#define biffDone itk_biffDone
+#define biffGet itk_biffGet
+#define biffGetDone itk_biffGetDone
+#define biffGetStrlen itk_biffGetStrlen
+#define biffMaybeAdd itk_biffMaybeAdd
+#define biffMove itk_biffMove
+#define biffSetStr itk_biffSetStr
+#define biffSetStrDone itk_biffSetStrDone
+#define _nrrdInsertDBCH itk__nrrdInsertDBCH
+#define _nrrdInsertDBDB itk__nrrdInsertDBDB
+#define _nrrdInsertDBFL itk__nrrdInsertDBFL
+#define _nrrdInsertDBJN itk__nrrdInsertDBJN
+#define _nrrdInsertDBLL itk__nrrdInsertDBLL
+#define _nrrdInsertDBSH itk__nrrdInsertDBSH
+#define _nrrdInsertDBUC itk__nrrdInsertDBUC
+#define _nrrdInsertDBUI itk__nrrdInsertDBUI
+#define _nrrdInsertDBUL itk__nrrdInsertDBUL
+#define _nrrdInsertDBUS itk__nrrdInsertDBUS
+#define _nrrdInsertFLCH itk__nrrdInsertFLCH
+#define _nrrdInsertFLDB itk__nrrdInsertFLDB
+#define _nrrdInsertFLFL itk__nrrdInsertFLFL
+#define _nrrdInsertFLJN itk__nrrdInsertFLJN
+#define _nrrdInsertFLLL itk__nrrdInsertFLLL
+#define _nrrdInsertFLSH itk__nrrdInsertFLSH
+#define _nrrdInsertFLUC itk__nrrdInsertFLUC
+#define _nrrdInsertFLUI itk__nrrdInsertFLUI
+#define _nrrdInsertFLUL itk__nrrdInsertFLUL
+#define _nrrdInsertFLUS itk__nrrdInsertFLUS
+#define _nrrdInsertJNCH itk__nrrdInsertJNCH
+#define _nrrdInsertJNDB itk__nrrdInsertJNDB
+#define _nrrdInsertJNFL itk__nrrdInsertJNFL
+#define _nrrdInsertJNJN itk__nrrdInsertJNJN
+#define _nrrdInsertJNLL itk__nrrdInsertJNLL
+#define _nrrdInsertJNSH itk__nrrdInsertJNSH
+#define _nrrdInsertJNUC itk__nrrdInsertJNUC
+#define _nrrdInsertJNUI itk__nrrdInsertJNUI
+#define _nrrdInsertJNUL itk__nrrdInsertJNUL
+#define _nrrdInsertJNUS itk__nrrdInsertJNUS
+#define _nrrdLoadDBCH itk__nrrdLoadDBCH
+#define _nrrdLoadDBDB itk__nrrdLoadDBDB
+#define _nrrdLoadDBFL itk__nrrdLoadDBFL
+#define _nrrdLoadDBJN itk__nrrdLoadDBJN
+#define _nrrdLoadDBLL itk__nrrdLoadDBLL
+#define _nrrdLoadDBSH itk__nrrdLoadDBSH
+#define _nrrdLoadDBUC itk__nrrdLoadDBUC
+#define _nrrdLoadDBUI itk__nrrdLoadDBUI
+#define _nrrdLoadDBUL itk__nrrdLoadDBUL
+#define _nrrdLoadDBUS itk__nrrdLoadDBUS
+#define _nrrdLoadFLCH itk__nrrdLoadFLCH
+#define _nrrdLoadFLDB itk__nrrdLoadFLDB
+#define _nrrdLoadFLFL itk__nrrdLoadFLFL
+#define _nrrdLoadFLJN itk__nrrdLoadFLJN
+#define _nrrdLoadFLLL itk__nrrdLoadFLLL
+#define _nrrdLoadFLSH itk__nrrdLoadFLSH
+#define _nrrdLoadFLUC itk__nrrdLoadFLUC
+#define _nrrdLoadFLUI itk__nrrdLoadFLUI
+#define _nrrdLoadFLUL itk__nrrdLoadFLUL
+#define _nrrdLoadFLUS itk__nrrdLoadFLUS
+#define _nrrdLoadJNCH itk__nrrdLoadJNCH
+#define _nrrdLoadJNDB itk__nrrdLoadJNDB
+#define _nrrdLoadJNFL itk__nrrdLoadJNFL
+#define _nrrdLoadJNJN itk__nrrdLoadJNJN
+#define _nrrdLoadJNLL itk__nrrdLoadJNLL
+#define _nrrdLoadJNSH itk__nrrdLoadJNSH
+#define _nrrdLoadJNUC itk__nrrdLoadJNUC
+#define _nrrdLoadJNUI itk__nrrdLoadJNUI
+#define _nrrdLoadJNUL itk__nrrdLoadJNUL
+#define _nrrdLoadJNUS itk__nrrdLoadJNUS
+#define _nrrdLookupDBCH itk__nrrdLookupDBCH
+#define _nrrdLookupDBDB itk__nrrdLookupDBDB
+#define _nrrdLookupDBFL itk__nrrdLookupDBFL
+#define _nrrdLookupDBJN itk__nrrdLookupDBJN
+#define _nrrdLookupDBLL itk__nrrdLookupDBLL
+#define _nrrdLookupDBSH itk__nrrdLookupDBSH
+#define _nrrdLookupDBUC itk__nrrdLookupDBUC
+#define _nrrdLookupDBUI itk__nrrdLookupDBUI
+#define _nrrdLookupDBUL itk__nrrdLookupDBUL
+#define _nrrdLookupDBUS itk__nrrdLookupDBUS
+#define _nrrdLookupFLCH itk__nrrdLookupFLCH
+#define _nrrdLookupFLDB itk__nrrdLookupFLDB
+#define _nrrdLookupFLFL itk__nrrdLookupFLFL
+#define _nrrdLookupFLJN itk__nrrdLookupFLJN
+#define _nrrdLookupFLLL itk__nrrdLookupFLLL
+#define _nrrdLookupFLSH itk__nrrdLookupFLSH
+#define _nrrdLookupFLUC itk__nrrdLookupFLUC
+#define _nrrdLookupFLUI itk__nrrdLookupFLUI
+#define _nrrdLookupFLUL itk__nrrdLookupFLUL
+#define _nrrdLookupFLUS itk__nrrdLookupFLUS
+#define _nrrdLookupJNCH itk__nrrdLookupJNCH
+#define _nrrdLookupJNDB itk__nrrdLookupJNDB
+#define _nrrdLookupJNFL itk__nrrdLookupJNFL
+#define _nrrdLookupJNJN itk__nrrdLookupJNJN
+#define _nrrdLookupJNLL itk__nrrdLookupJNLL
+#define _nrrdLookupJNSH itk__nrrdLookupJNSH
+#define _nrrdLookupJNUC itk__nrrdLookupJNUC
+#define _nrrdLookupJNUI itk__nrrdLookupJNUI
+#define _nrrdLookupJNUL itk__nrrdLookupJNUL
+#define _nrrdLookupJNUS itk__nrrdLookupJNUS
+#define _nrrdSprintCH itk__nrrdSprintCH
+#define _nrrdSprintDB itk__nrrdSprintDB
+#define _nrrdSprintFL itk__nrrdSprintFL
+#define _nrrdSprintIN itk__nrrdSprintIN
+#define _nrrdSprintLL itk__nrrdSprintLL
+#define _nrrdSprintSH itk__nrrdSprintSH
+#define _nrrdSprintUC itk__nrrdSprintUC
+#define _nrrdSprintUI itk__nrrdSprintUI
+#define _nrrdSprintUL itk__nrrdSprintUL
+#define _nrrdSprintUS itk__nrrdSprintUS
+#define _nrrdStoreDBCH itk__nrrdStoreDBCH
+#define _nrrdStoreDBDB itk__nrrdStoreDBDB
+#define _nrrdStoreDBFL itk__nrrdStoreDBFL
+#define _nrrdStoreDBJN itk__nrrdStoreDBJN
+#define _nrrdStoreDBLL itk__nrrdStoreDBLL
+#define _nrrdStoreDBSH itk__nrrdStoreDBSH
+#define _nrrdStoreDBUC itk__nrrdStoreDBUC
+#define _nrrdStoreDBUI itk__nrrdStoreDBUI
+#define _nrrdStoreDBUL itk__nrrdStoreDBUL
+#define _nrrdStoreDBUS itk__nrrdStoreDBUS
+#define _nrrdStoreFLCH itk__nrrdStoreFLCH
+#define _nrrdStoreFLDB itk__nrrdStoreFLDB
+#define _nrrdStoreFLFL itk__nrrdStoreFLFL
+#define _nrrdStoreFLJN itk__nrrdStoreFLJN
+#define _nrrdStoreFLLL itk__nrrdStoreFLLL
+#define _nrrdStoreFLSH itk__nrrdStoreFLSH
+#define _nrrdStoreFLUC itk__nrrdStoreFLUC
+#define _nrrdStoreFLUI itk__nrrdStoreFLUI
+#define _nrrdStoreFLUL itk__nrrdStoreFLUL
+#define _nrrdStoreFLUS itk__nrrdStoreFLUS
+#define _nrrdStoreJNCH itk__nrrdStoreJNCH
+#define _nrrdStoreJNDB itk__nrrdStoreJNDB
+#define _nrrdStoreJNFL itk__nrrdStoreJNFL
+#define _nrrdStoreJNJN itk__nrrdStoreJNJN
+#define _nrrdStoreJNLL itk__nrrdStoreJNLL
+#define _nrrdStoreJNSH itk__nrrdStoreJNSH
+#define _nrrdStoreJNUC itk__nrrdStoreJNUC
+#define _nrrdStoreJNUI itk__nrrdStoreJNUI
+#define _nrrdStoreJNUL itk__nrrdStoreJNUL
+#define _nrrdStoreJNUS itk__nrrdStoreJNUS
+#define nrrdDInsert itk_nrrdDInsert
+#define nrrdDLoad itk_nrrdDLoad
+#define nrrdDLookup itk_nrrdDLookup
+#define nrrdDStore itk_nrrdDStore
+#define nrrdFInsert itk_nrrdFInsert
+#define nrrdFLoad itk_nrrdFLoad
+#define nrrdFLookup itk_nrrdFLookup
+#define nrrdFStore itk_nrrdFStore
+#define nrrdIInsert itk_nrrdIInsert
+#define nrrdILoad itk_nrrdILoad
+#define nrrdILookup itk_nrrdILookup
+#define nrrdIStore itk_nrrdIStore
+#define nrrdSprint itk_nrrdSprint
+#define nrrdDefCenter itk_nrrdDefCenter
+#define nrrdDefSpacing itk_nrrdDefSpacing
+#define nrrdDefWriteBareText itk_nrrdDefWriteBareText
+#define nrrdDefWriteCharsPerLine itk_nrrdDefWriteCharsPerLine
+#define nrrdDefWriteEncoding itk_nrrdDefWriteEncoding
+#define nrrdDefWriteValsPerLine itk_nrrdDefWriteValsPerLine
+#define nrrdStateAlwaysSetContent itk_nrrdStateAlwaysSetContent
+#define nrrdStateDisableContent itk_nrrdStateDisableContent
+#define nrrdStateGrayscaleImage3D itk_nrrdStateGrayscaleImage3D
+#define nrrdStateKeyValueReturnInternalPointers itk_nrrdStateKeyValueReturnInternalPointers
+#define nrrdStateKindNoop itk_nrrdStateKindNoop
+#define nrrdStateUnknownContent itk_nrrdStateUnknownContent
+#define nrrdStateVerboseIO itk_nrrdStateVerboseIO
+#define _nrrdCenterDesc itk__nrrdCenterDesc
+#define _nrrdCenterStr itk__nrrdCenterStr
+#define _nrrdCenter_enum itk__nrrdCenter_enum
+#define _nrrdEncodingType itk__nrrdEncodingType
+#define _nrrdEncodingTypeDesc itk__nrrdEncodingTypeDesc
+#define _nrrdEncodingTypeStr itk__nrrdEncodingTypeStr
+#define _nrrdEncodingTypeStrEqv itk__nrrdEncodingTypeStrEqv
+#define _nrrdEncodingTypeValEqv itk__nrrdEncodingTypeValEqv
+#define _nrrdField itk__nrrdField
+#define _nrrdFieldDesc itk__nrrdFieldDesc
+#define _nrrdFieldStr itk__nrrdFieldStr
+#define _nrrdFieldStrEqv itk__nrrdFieldStrEqv
+#define _nrrdFieldValEqv itk__nrrdFieldValEqv
+#define _nrrdFormatType itk__nrrdFormatType
+#define _nrrdFormatTypeDesc itk__nrrdFormatTypeDesc
+#define _nrrdFormatTypeStr itk__nrrdFormatTypeStr
+#define _nrrdFormatTypeStrEqv itk__nrrdFormatTypeStrEqv
+#define _nrrdFormatTypeValEqv itk__nrrdFormatTypeValEqv
+#define _nrrdKindDesc itk__nrrdKindDesc
+#define _nrrdKindStr itk__nrrdKindStr
+#define _nrrdKindStr_Eqv itk__nrrdKindStr_Eqv
+#define _nrrdKindVal_Eqv itk__nrrdKindVal_Eqv
+#define _nrrdKind_enum itk__nrrdKind_enum
+#define _nrrdSpace itk__nrrdSpace
+#define _nrrdSpaceDesc itk__nrrdSpaceDesc
+#define _nrrdSpaceStr itk__nrrdSpaceStr
+#define _nrrdSpaceStrEqv itk__nrrdSpaceStrEqv
+#define _nrrdSpaceValEqv itk__nrrdSpaceValEqv
+#define _nrrdType itk__nrrdType
+#define _nrrdTypeDesc itk__nrrdTypeDesc
+#define _nrrdTypeStr itk__nrrdTypeStr
+#define _nrrdTypeStrEqv itk__nrrdTypeStrEqv
+#define _nrrdTypeValEqv itk__nrrdTypeValEqv
+#define nrrdCenter itk_nrrdCenter
+#define nrrdEncodingType itk_nrrdEncodingType
+#define nrrdField itk_nrrdField
+#define nrrdFormatType itk_nrrdFormatType
+#define nrrdKind itk_nrrdKind
+#define nrrdSpace itk_nrrdSpace
+#define nrrdType itk_nrrdType
+#define _nrrdFieldOnePerAxis itk__nrrdFieldOnePerAxis
+#define _nrrdFieldRequired itk__nrrdFieldRequired
+#define _nrrdFieldValidInImage itk__nrrdFieldValidInImage
+#define _nrrdFieldValidInText itk__nrrdFieldValidInText
+#define nrrdTypeIsIntegral itk_nrrdTypeIsIntegral
+#define nrrdTypeIsUnsigned itk_nrrdTypeIsUnsigned
+#define nrrdTypeMax itk_nrrdTypeMax
+#define nrrdTypeMin itk_nrrdTypeMin
+#define nrrdTypeNumberOfValues itk_nrrdTypeNumberOfValues
+#define nrrdTypePrintfStr itk_nrrdTypePrintfStr
+#define nrrdTypeSize itk_nrrdTypeSize
+#define _nrrdCopy itk__nrrdCopy
+#define _nrrdSizeCheck itk__nrrdSizeCheck
+#define nrrdAlloc itk_nrrdAlloc
+#define nrrdAlloc_nva itk_nrrdAlloc_nva
+#define nrrdBasicInfoCopy itk_nrrdBasicInfoCopy
+#define nrrdBasicInfoInit itk_nrrdBasicInfoInit
+#define nrrdCopy itk_nrrdCopy
+#define nrrdEmpty itk_nrrdEmpty
+#define nrrdInit itk_nrrdInit
+#define nrrdIoStateInit itk_nrrdIoStateInit
+#define nrrdIoStateNew itk_nrrdIoStateNew
+#define nrrdIoStateNix itk_nrrdIoStateNix
+#define nrrdMaybeAlloc itk_nrrdMaybeAlloc
+#define nrrdMaybeAlloc_nva itk_nrrdMaybeAlloc_nva
+#define nrrdNew itk_nrrdNew
+#define nrrdNix itk_nrrdNix
+#define nrrdNuke itk_nrrdNuke
+#define nrrdPGM itk_nrrdPGM
+#define nrrdPPM itk_nrrdPPM
+#define nrrdPeripheralCopy itk_nrrdPeripheralCopy
+#define nrrdPeripheralInit itk_nrrdPeripheralInit
+#define nrrdWrap itk_nrrdWrap
+#define nrrdWrap_nva itk_nrrdWrap_nva
+#define nrrdAxesInsert itk_nrrdAxesInsert
+#define nrrdAxesPermute itk_nrrdAxesPermute
+#define nrrdInvertPerm itk_nrrdInvertPerm
+#define nrrdShuffle itk_nrrdShuffle
+#define _nrrdAxisInfoCopy itk__nrrdAxisInfoCopy
+#define _nrrdAxisInfoInit itk__nrrdAxisInfoInit
+#define _nrrdAxisInfoNewInit itk__nrrdAxisInfoNewInit
+#define _nrrdCenter itk__nrrdCenter
+#define _nrrdCenter2 itk__nrrdCenter2
+#define _nrrdKindAltered itk__nrrdKindAltered
+#define nrrdAxisInfoCopy itk_nrrdAxisInfoCopy
+#define nrrdAxisInfoGet itk_nrrdAxisInfoGet
+#define nrrdAxisInfoGet_nva itk_nrrdAxisInfoGet_nva
+#define nrrdAxisInfoIdx itk_nrrdAxisInfoIdx
+#define nrrdAxisInfoIdxRange itk_nrrdAxisInfoIdxRange
+#define nrrdAxisInfoMinMaxSet itk_nrrdAxisInfoMinMaxSet
+#define nrrdAxisInfoPos itk_nrrdAxisInfoPos
+#define nrrdAxisInfoPosRange itk_nrrdAxisInfoPosRange
+#define nrrdAxisInfoSet itk_nrrdAxisInfoSet
+#define nrrdAxisInfoSet_nva itk_nrrdAxisInfoSet_nva
+#define nrrdAxisInfoSpacingSet itk_nrrdAxisInfoSpacingSet
+#define nrrdDomainAxesGet itk_nrrdDomainAxesGet
+#define nrrdKindIsDomain itk_nrrdKindIsDomain
+#define nrrdKindSize itk_nrrdKindSize
+#define nrrdRangeAxesGet itk_nrrdRangeAxesGet
+#define nrrdSpacingCalculate itk_nrrdSpacingCalculate
+#define _nrrdCheck itk__nrrdCheck
+#define _nrrdCheckEnums itk__nrrdCheckEnums
+#define _nrrdContentGet itk__nrrdContentGet
+#define _nrrdContentSet itk__nrrdContentSet
+#define _nrrdContentSet_nva itk__nrrdContentSet_nva
+#define _nrrdFieldCheck itk__nrrdFieldCheck
+#define _nrrdFieldCheckSpaceInfo itk__nrrdFieldCheckSpaceInfo
+#define _nrrdFieldCheck_axis_maxs itk__nrrdFieldCheck_axis_maxs
+#define _nrrdFieldCheck_axis_mins itk__nrrdFieldCheck_axis_mins
+#define _nrrdFieldCheck_block_size itk__nrrdFieldCheck_block_size
+#define _nrrdFieldCheck_centers itk__nrrdFieldCheck_centers
+#define _nrrdFieldCheck_dimension itk__nrrdFieldCheck_dimension
+#define _nrrdFieldCheck_keyvalue itk__nrrdFieldCheck_keyvalue
+#define _nrrdFieldCheck_kinds itk__nrrdFieldCheck_kinds
+#define _nrrdFieldCheck_labels itk__nrrdFieldCheck_labels
+#define _nrrdFieldCheck_measurement_frame itk__nrrdFieldCheck_measurement_frame
+#define _nrrdFieldCheck_noop itk__nrrdFieldCheck_noop
+#define _nrrdFieldCheck_old_max itk__nrrdFieldCheck_old_max
+#define _nrrdFieldCheck_old_min itk__nrrdFieldCheck_old_min
+#define _nrrdFieldCheck_sizes itk__nrrdFieldCheck_sizes
+#define _nrrdFieldCheck_space itk__nrrdFieldCheck_space
+#define _nrrdFieldCheck_space_dimension itk__nrrdFieldCheck_space_dimension
+#define _nrrdFieldCheck_space_directions itk__nrrdFieldCheck_space_directions
+#define _nrrdFieldCheck_space_origin itk__nrrdFieldCheck_space_origin
+#define _nrrdFieldCheck_space_units itk__nrrdFieldCheck_space_units
+#define _nrrdFieldCheck_spacings itk__nrrdFieldCheck_spacings
+#define _nrrdFieldCheck_thicknesses itk__nrrdFieldCheck_thicknesses
+#define _nrrdFieldCheck_type itk__nrrdFieldCheck_type
+#define _nrrdFieldCheck_units itk__nrrdFieldCheck_units
+#define _nrrdSpaceVecNorm itk__nrrdSpaceVecNorm
+#define _nrrdSpaceVecScale itk__nrrdSpaceVecScale
+#define _nrrdSpaceVecScaleAdd2 itk__nrrdSpaceVecScaleAdd2
+#define _nrrdSpaceVecSetNaN itk__nrrdSpaceVecSetNaN
+#define _nrrdSplitSizes itk__nrrdSplitSizes
+#define nrrdBiffKey itk_nrrdBiffKey
+#define nrrdCheck itk_nrrdCheck
+#define nrrdContentSet itk_nrrdContentSet
+#define nrrdDescribe itk_nrrdDescribe
+#define nrrdElementNumber itk_nrrdElementNumber
+#define nrrdElementSize itk_nrrdElementSize
+#define nrrdOriginCalculate itk_nrrdOriginCalculate
+#define nrrdSameSize itk_nrrdSameSize
+#define nrrdSanity itk_nrrdSanity
+#define nrrdSpaceDimension itk_nrrdSpaceDimension
+#define nrrdSpaceDimensionSet itk_nrrdSpaceDimensionSet
+#define nrrdSpaceOriginGet itk_nrrdSpaceOriginGet
+#define nrrdSpaceOriginSet itk_nrrdSpaceOriginSet
+#define nrrdSpaceSet itk_nrrdSpaceSet
+#define nrrdCommentAdd itk_nrrdCommentAdd
+#define nrrdCommentClear itk_nrrdCommentClear
+#define nrrdCommentCopy itk_nrrdCommentCopy
+#define _nrrdFwriteEscaped itk__nrrdFwriteEscaped
+#define _nrrdKeyValueFwrite itk__nrrdKeyValueFwrite
+#define _nrrdKeyValueIdxFind itk__nrrdKeyValueIdxFind
+#define nrrdKeyValueAdd itk_nrrdKeyValueAdd
+#define nrrdKeyValueClear itk_nrrdKeyValueClear
+#define nrrdKeyValueCopy itk_nrrdKeyValueCopy
+#define nrrdKeyValueErase itk_nrrdKeyValueErase
+#define nrrdKeyValueGet itk_nrrdKeyValueGet
+#define nrrdKeyValueIndex itk_nrrdKeyValueIndex
+#define nrrdKeyValueSize itk_nrrdKeyValueSize
+#define _nrrdBlockEndian itk__nrrdBlockEndian
+#define _nrrdNoopEndian itk__nrrdNoopEndian
+#define _nrrdSwap16Endian itk__nrrdSwap16Endian
+#define _nrrdSwap32Endian itk__nrrdSwap32Endian
+#define _nrrdSwap64Endian itk__nrrdSwap64Endian
+#define _nrrdSwapEndian itk__nrrdSwapEndian
+#define nrrdSwapEndian itk_nrrdSwapEndian
+#define _nrrdContainsPercentDAndMore itk__nrrdContainsPercentDAndMore
+#define _nrrdDataFNCheck itk__nrrdDataFNCheck
+#define _nrrdDataFNNumber itk__nrrdDataFNNumber
+#define _nrrdGetQuotedString itk__nrrdGetQuotedString
+#define _nrrdReadNrrdParseField itk__nrrdReadNrrdParseField
+#define _nrrdReadNrrdParse_axis_maxs itk__nrrdReadNrrdParse_axis_maxs
+#define _nrrdReadNrrdParse_axis_mins itk__nrrdReadNrrdParse_axis_mins
+#define _nrrdReadNrrdParse_block_size itk__nrrdReadNrrdParse_block_size
+#define _nrrdReadNrrdParse_byte_skip itk__nrrdReadNrrdParse_byte_skip
+#define _nrrdReadNrrdParse_centers itk__nrrdReadNrrdParse_centers
+#define _nrrdReadNrrdParse_comment itk__nrrdReadNrrdParse_comment
+#define _nrrdReadNrrdParse_content itk__nrrdReadNrrdParse_content
+#define _nrrdReadNrrdParse_data_file itk__nrrdReadNrrdParse_data_file
+#define _nrrdReadNrrdParse_dimension itk__nrrdReadNrrdParse_dimension
+#define _nrrdReadNrrdParse_encoding itk__nrrdReadNrrdParse_encoding
+#define _nrrdReadNrrdParse_endian itk__nrrdReadNrrdParse_endian
+#define _nrrdReadNrrdParse_keyvalue itk__nrrdReadNrrdParse_keyvalue
+#define _nrrdReadNrrdParse_kinds itk__nrrdReadNrrdParse_kinds
+#define _nrrdReadNrrdParse_labels itk__nrrdReadNrrdParse_labels
+#define _nrrdReadNrrdParse_line_skip itk__nrrdReadNrrdParse_line_skip
+#define _nrrdReadNrrdParse_max itk__nrrdReadNrrdParse_max
+#define _nrrdReadNrrdParse_measurement_frame itk__nrrdReadNrrdParse_measurement_frame
+#define _nrrdReadNrrdParse_min itk__nrrdReadNrrdParse_min
+#define _nrrdReadNrrdParse_nonfield itk__nrrdReadNrrdParse_nonfield
+#define _nrrdReadNrrdParse_number itk__nrrdReadNrrdParse_number
+#define _nrrdReadNrrdParse_old_max itk__nrrdReadNrrdParse_old_max
+#define _nrrdReadNrrdParse_old_min itk__nrrdReadNrrdParse_old_min
+#define _nrrdReadNrrdParse_sample_units itk__nrrdReadNrrdParse_sample_units
+#define _nrrdReadNrrdParse_sizes itk__nrrdReadNrrdParse_sizes
+#define _nrrdReadNrrdParse_space itk__nrrdReadNrrdParse_space
+#define _nrrdReadNrrdParse_space_dimension itk__nrrdReadNrrdParse_space_dimension
+#define _nrrdReadNrrdParse_space_directions itk__nrrdReadNrrdParse_space_directions
+#define _nrrdReadNrrdParse_space_origin itk__nrrdReadNrrdParse_space_origin
+#define _nrrdReadNrrdParse_space_units itk__nrrdReadNrrdParse_space_units
+#define _nrrdReadNrrdParse_spacings itk__nrrdReadNrrdParse_spacings
+#define _nrrdReadNrrdParse_thicknesses itk__nrrdReadNrrdParse_thicknesses
+#define _nrrdReadNrrdParse_type itk__nrrdReadNrrdParse_type
+#define _nrrdReadNrrdParse_units itk__nrrdReadNrrdParse_units
+#define _nrrdSpaceVectorParse itk__nrrdSpaceVectorParse
+#define nrrdFieldInfoParse itk_nrrdFieldInfoParse
+#define _nrrdGzClose itk__nrrdGzClose
+#define _nrrdGzDummySymbol itk__nrrdGzDummySymbol
+#define _nrrdGzOpen itk__nrrdGzOpen
+#define _nrrdGzRead itk__nrrdGzRead
+#define _nrrdGzWrite itk__nrrdGzWrite
+#define _nrrdCalloc itk__nrrdCalloc
+#define _nrrdFieldSep itk__nrrdFieldSep
+#define _nrrdNoSpaceVector itk__nrrdNoSpaceVector
+#define _nrrdOneLine itk__nrrdOneLine
+#define _nrrdRelativePathFlag itk__nrrdRelativePathFlag
+#define _nrrdSplitName itk__nrrdSplitName
+#define _nrrdTextSep itk__nrrdTextSep
+#define nrrdByteSkip itk_nrrdByteSkip
+#define nrrdLineSkip itk_nrrdLineSkip
+#define nrrdLoad itk_nrrdLoad
+#define nrrdRead itk_nrrdRead
+#define _nrrdEncodingMaybeSet itk__nrrdEncodingMaybeSet
+#define _nrrdFieldInteresting itk__nrrdFieldInteresting
+#define _nrrdFormatMaybeGuess itk__nrrdFormatMaybeGuess
+#define _nrrdFormatMaybeSet itk__nrrdFormatMaybeSet
+#define _nrrdFprintFieldInfo itk__nrrdFprintFieldInfo
+#define _nrrdSprintFieldInfo itk__nrrdSprintFieldInfo
+#define _nrrdStrcatSpaceVector itk__nrrdStrcatSpaceVector
+#define nrrdIoStateEncodingGet itk_nrrdIoStateEncodingGet
+#define nrrdIoStateEncodingSet itk_nrrdIoStateEncodingSet
+#define nrrdIoStateFormatGet itk_nrrdIoStateFormatGet
+#define nrrdIoStateFormatSet itk_nrrdIoStateFormatSet
+#define nrrdIoStateGet itk_nrrdIoStateGet
+#define nrrdIoStateSet itk_nrrdIoStateSet
+#define nrrdSave itk_nrrdSave
+#define nrrdWrite itk_nrrdWrite
+#define _nrrdFormatUnknown itk__nrrdFormatUnknown
+#define _nrrdFormatUnknown_available itk__nrrdFormatUnknown_available
+#define _nrrdFormatUnknown_contentStartsLike itk__nrrdFormatUnknown_contentStartsLike
+#define _nrrdFormatUnknown_fitsInto itk__nrrdFormatUnknown_fitsInto
+#define _nrrdFormatUnknown_nameLooksLike itk__nrrdFormatUnknown_nameLooksLike
+#define _nrrdFormatUnknown_read itk__nrrdFormatUnknown_read
+#define _nrrdFormatUnknown_write itk__nrrdFormatUnknown_write
+#define nrrdFormatArray itk_nrrdFormatArray
+#define nrrdFormatUnknown itk_nrrdFormatUnknown
+#define _nrrdFormatNRRD itk__nrrdFormatNRRD
+#define _nrrdFormatNRRD_available itk__nrrdFormatNRRD_available
+#define _nrrdFormatNRRD_contentStartsLike itk__nrrdFormatNRRD_contentStartsLike
+#define _nrrdFormatNRRD_fitsInto itk__nrrdFormatNRRD_fitsInto
+#define _nrrdFormatNRRD_nameLooksLike itk__nrrdFormatNRRD_nameLooksLike
+#define _nrrdFormatNRRD_read itk__nrrdFormatNRRD_read
+#define _nrrdFormatNRRD_whichVersion itk__nrrdFormatNRRD_whichVersion
+#define _nrrdFormatNRRD_write itk__nrrdFormatNRRD_write
+#define _nrrdFormatURLLine0 itk__nrrdFormatURLLine0
+#define _nrrdFormatURLLine1 itk__nrrdFormatURLLine1
+#define _nrrdHeaderCheck itk__nrrdHeaderCheck
+#define nrrdFormatNRRD itk_nrrdFormatNRRD
+#define nrrdIoStateDataFileIterBegin itk_nrrdIoStateDataFileIterBegin
+#define nrrdIoStateDataFileIterNext itk_nrrdIoStateDataFileIterNext
+#define _nrrdEncodingUnknown itk__nrrdEncodingUnknown
+#define _nrrdEncodingUnknown_available itk__nrrdEncodingUnknown_available
+#define _nrrdEncodingUnknown_read itk__nrrdEncodingUnknown_read
+#define _nrrdEncodingUnknown_write itk__nrrdEncodingUnknown_write
+#define nrrdEncodingArray itk_nrrdEncodingArray
+#define nrrdEncodingUnknown itk_nrrdEncodingUnknown
+#define _nrrdEncodingRaw itk__nrrdEncodingRaw
+#define _nrrdEncodingRaw_available itk__nrrdEncodingRaw_available
+#define _nrrdEncodingRaw_read itk__nrrdEncodingRaw_read
+#define _nrrdEncodingRaw_write itk__nrrdEncodingRaw_write
+#define nrrdEncodingRaw itk_nrrdEncodingRaw
+#define _nrrdEncodingAscii itk__nrrdEncodingAscii
+#define _nrrdEncodingAscii_available itk__nrrdEncodingAscii_available
+#define _nrrdEncodingAscii_read itk__nrrdEncodingAscii_read
+#define _nrrdEncodingAscii_write itk__nrrdEncodingAscii_write
+#define nrrdEncodingAscii itk_nrrdEncodingAscii
+#define _nrrdEncodingHex itk__nrrdEncodingHex
+#define _nrrdEncodingHex_available itk__nrrdEncodingHex_available
+#define _nrrdEncodingHex_read itk__nrrdEncodingHex_read
+#define _nrrdEncodingHex_write itk__nrrdEncodingHex_write
+#define _nrrdReadHexTable itk__nrrdReadHexTable
+#define _nrrdWriteHexTable itk__nrrdWriteHexTable
+#define nrrdEncodingHex itk_nrrdEncodingHex
+#define _nrrdEncodingGzip itk__nrrdEncodingGzip
+#define _nrrdEncodingGzip_available itk__nrrdEncodingGzip_available
+#define _nrrdEncodingGzip_read itk__nrrdEncodingGzip_read
+#define _nrrdEncodingGzip_write itk__nrrdEncodingGzip_write
+#define nrrdEncodingGzip itk_nrrdEncodingGzip
+#define nrrdCrop itk_nrrdCrop
+#define nrrdSlice itk_nrrdSlice
+#define _nrrdEncodingBzip2 itk__nrrdEncodingBzip2
+#define _nrrdEncodingBzip2_available itk__nrrdEncodingBzip2_available
+#define _nrrdEncodingBzip2_read itk__nrrdEncodingBzip2_read
+#define _nrrdEncodingBzip2_write itk__nrrdEncodingBzip2_write
+#define nrrdEncodingBzip2 itk_nrrdEncodingBzip2
+#define _nrrdFormatEPS itk__nrrdFormatEPS
+#define _nrrdFormatEPS_available itk__nrrdFormatEPS_available
+#define _nrrdFormatEPS_contentStartsLike itk__nrrdFormatEPS_contentStartsLike
+#define _nrrdFormatEPS_fitsInto itk__nrrdFormatEPS_fitsInto
+#define _nrrdFormatEPS_nameLooksLike itk__nrrdFormatEPS_nameLooksLike
+#define _nrrdFormatEPS_read itk__nrrdFormatEPS_read
+#define _nrrdFormatEPS_write itk__nrrdFormatEPS_write
+#define nrrdFormatEPS itk_nrrdFormatEPS
+#define _nrrdFormatPNG itk__nrrdFormatPNG
+#define _nrrdFormatPNG_available itk__nrrdFormatPNG_available
+#define _nrrdFormatPNG_contentStartsLike itk__nrrdFormatPNG_contentStartsLike
+#define _nrrdFormatPNG_fitsInto itk__nrrdFormatPNG_fitsInto
+#define _nrrdFormatPNG_nameLooksLike itk__nrrdFormatPNG_nameLooksLike
+#define _nrrdFormatPNG_read itk__nrrdFormatPNG_read
+#define _nrrdFormatPNG_write itk__nrrdFormatPNG_write
+#define nrrdFormatPNG itk_nrrdFormatPNG
+#define _nrrdFormatPNM itk__nrrdFormatPNM
+#define _nrrdFormatPNM_available itk__nrrdFormatPNM_available
+#define _nrrdFormatPNM_contentStartsLike itk__nrrdFormatPNM_contentStartsLike
+#define _nrrdFormatPNM_fitsInto itk__nrrdFormatPNM_fitsInto
+#define _nrrdFormatPNM_nameLooksLike itk__nrrdFormatPNM_nameLooksLike
+#define _nrrdFormatPNM_read itk__nrrdFormatPNM_read
+#define _nrrdFormatPNM_write itk__nrrdFormatPNM_write
+#define nrrdFormatPNM itk_nrrdFormatPNM
+#define _nrrdFormatText itk__nrrdFormatText
+#define _nrrdFormatText_available itk__nrrdFormatText_available
+#define _nrrdFormatText_contentStartsLike itk__nrrdFormatText_contentStartsLike
+#define _nrrdFormatText_fitsInto itk__nrrdFormatText_fitsInto
+#define _nrrdFormatText_nameLooksLike itk__nrrdFormatText_nameLooksLike
+#define _nrrdFormatText_read itk__nrrdFormatText_read
+#define _nrrdFormatText_write itk__nrrdFormatText_write
+#define nrrdFormatText itk_nrrdFormatText
+#define _nrrdFormatVTK itk__nrrdFormatVTK
+#define _nrrdFormatVTK_available itk__nrrdFormatVTK_available
+#define _nrrdFormatVTK_contentStartsLike itk__nrrdFormatVTK_contentStartsLike
+#define _nrrdFormatVTK_fitsInto itk__nrrdFormatVTK_fitsInto
+#define _nrrdFormatVTK_nameLooksLike itk__nrrdFormatVTK_nameLooksLike
+#define _nrrdFormatVTK_read itk__nrrdFormatVTK_read
+#define _nrrdFormatVTK_write itk__nrrdFormatVTK_write
+#define nrrdFormatVTK itk_nrrdFormatVTK
+#endif /* __itk_NrrdIO_mangle_h */
diff --git a/Utilities/ITK/Utilities/NrrdIO/keyvalue.c b/Utilities/ITK/Utilities/NrrdIO/keyvalue.c
new file mode 100644
index 0000000000000000000000000000000000000000..10bcfaa9ba281714b61e61d9fbe4cb6b727d193f
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/keyvalue.c
@@ -0,0 +1,270 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/***
+**** NONE of the nrrdKeyValue functions use biff.
+**** They don't use them now, and they never should.
+**** Unless I change my mind.
+***/
+
+/*
+******** nrrdKeyValueSize
+**
+** returns the number of key/value pairs in a nrrd
+*/
+unsigned int
+nrrdKeyValueSize(const Nrrd *nrrd) {
+
+ if (!nrrd) {
+ return 0;
+ }
+ return nrrd->kvpArr->len;
+}
+
+/*
+******** nrrdKeyValueIndex
+**
+** given an int in [0 .. #key/value pairs - 1], sets *keyP and *valueP
+** to put to the corresponding key and value.
+**
+** NOTE: whether or not *keyP and *valueP are set to pointers to memory
+** "inside" the nrrd struct (pointers which you had better not free()!)
+** is controlled by nrrdStateKeyValueReturnInternalPointers, which defaults
+** to AIR_FALSE
+*/
+void
+nrrdKeyValueIndex(const Nrrd *nrrd, char **keyP, char **valueP,
+ unsigned int ki) {
+
+ if (!( nrrd && keyP && valueP && ki < nrrd->kvpArr->len )) {
+ if (keyP) {
+ *keyP = NULL;
+ }
+ if (valueP) {
+ *valueP = NULL;
+ }
+ return;
+ }
+ if (nrrdStateKeyValueReturnInternalPointers) {
+ *keyP = nrrd->kvp[0 + 2*ki];
+ *valueP = nrrd->kvp[1 + 2*ki];
+ } else {
+ *keyP = airStrdup(nrrd->kvp[0 + 2*ki]);
+ *valueP = airStrdup(nrrd->kvp[1 + 2*ki]);
+ }
+ return;
+}
+
+int
+_nrrdKeyValueIdxFind(const Nrrd *nrrd, const char *key) {
+ unsigned int nk, ki;
+
+ nk = nrrd->kvpArr->len;
+ for (ki=0; ki<nk; ki++) {
+ if (!strcmp(nrrd->kvp[0 + 2*ki], key)) {
+ break;
+ }
+ }
+ return (ki<nk ? (int)ki : -1); /* HEY scrutinize cast */
+}
+
+void
+nrrdKeyValueClear(Nrrd *nrrd) {
+ unsigned int nk, ki;
+
+ if (!nrrd) {
+ return;
+ }
+
+ nk = nrrd->kvpArr->len;
+ for (ki=0; ki<nk; ki++) {
+ nrrd->kvp[0 + 2*ki] = (char *)airFree(nrrd->kvp[0 + 2*ki]);
+ nrrd->kvp[1 + 2*ki] = (char *)airFree(nrrd->kvp[1 + 2*ki]);
+ }
+ airArrayLenSet(nrrd->kvpArr, 0);
+
+ return;
+}
+
+int
+nrrdKeyValueErase(Nrrd *nrrd, const char *key) {
+ unsigned int nk;
+ int ki;
+
+ if (!( nrrd && key )) {
+ /* got NULL pointer */
+ return 1;
+ }
+ ki = _nrrdKeyValueIdxFind(nrrd, key);
+ if (-1 == ki) {
+ return 0;
+ }
+ nrrd->kvp[0 + 2*ki] = (char *)airFree(nrrd->kvp[0 + 2*ki]);
+ nrrd->kvp[1 + 2*ki] = (char *)airFree(nrrd->kvp[1 + 2*ki]);
+ nk = nrrd->kvpArr->len;
+ for (; ki<(int)nk-1; ki++) { /* HEY scrutize cast */
+ nrrd->kvp[0 + 2*ki] = nrrd->kvp[0 + 2*(ki+1)];
+ nrrd->kvp[1 + 2*ki] = nrrd->kvp[1 + 2*(ki+1)];
+ }
+ airArrayLenIncr(nrrd->kvpArr, -1);
+
+ return 0;
+}
+
+/*
+******** nrrdKeyValueAdd
+**
+** This will COPY the given strings, and so does not depend on
+** them existing past the return of this function
+*/
+int
+nrrdKeyValueAdd(Nrrd *nrrd, const char *key, const char *value) {
+ int ki;
+
+ if (!( nrrd && key && value )) {
+ /* got NULL pointer */
+ return 1;
+ }
+ if (!strlen(key)) {
+ /* reject empty keys */
+ return 1;
+ }
+ if (-1 != (ki = _nrrdKeyValueIdxFind(nrrd, key))) {
+ nrrd->kvp[1 + 2*ki] = (char *)airFree(nrrd->kvp[1 + 2*ki]);
+ nrrd->kvp[1 + 2*ki] = airStrdup(value);
+ } else {
+ ki = airArrayLenIncr(nrrd->kvpArr, 1);
+ nrrd->kvp[0 + 2*ki] = airStrdup(key);
+ nrrd->kvp[1 + 2*ki] = airStrdup(value);
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdKeyValueGet
+**
+** NOTE: whether or not *keyP and *valueP are set to pointers to memory
+** "inside" the nrrd struct (pointers which you had better not free()!)
+** is controlled by nrrdStateKeyValueReturnInternalPointers, which defaults
+** to AIR_FALSE
+*/
+char *
+nrrdKeyValueGet(const Nrrd *nrrd, const char *key) {
+ char *ret;
+ int ki;
+
+ if (!( nrrd && key )) {
+ /* got NULL pointer */
+ return NULL;
+ }
+ if (-1 != (ki = _nrrdKeyValueIdxFind(nrrd, key))) {
+ if (nrrdStateKeyValueReturnInternalPointers) {
+ ret = nrrd->kvp[1 + 2*ki];
+ } else {
+ ret = airStrdup(nrrd->kvp[1 + 2*ki]);
+ }
+ } else {
+ ret = NULL;
+ }
+ return ret;
+}
+
+void
+_nrrdFwriteEscaped(FILE *file, const char *str) {
+ size_t ci;
+
+ for (ci=0; ci<strlen(str); ci++) {
+ switch(str[ci]) {
+ case '\n':
+ fprintf(file, "\\n");
+ break;
+ case '\\':
+ fprintf(file, "\\\\");
+ break;
+ default:
+ fputc(str[ci], file);
+ break;
+ }
+ }
+ return;
+}
+
+/*
+** _nrrdKeyValueFwrite
+**
+** writes a given key and value to a file, starting with the given
+** prefix (if non-NULL), and ending with "\n"
+*/
+int
+_nrrdKeyValueFwrite(FILE *file, const char *prefix,
+ const char *key, const char *value) {
+
+ if (!( file && key && value )) {
+ return 1;
+ }
+ if (prefix) {
+ fprintf(file, "%s", prefix);
+ }
+ _nrrdFwriteEscaped(file, key);
+ fprintf(file, ":=");
+ _nrrdFwriteEscaped(file, value);
+ fprintf(file, "\n");
+ return 0;
+}
+
+/*
+******** nrrdKeyValueCopy()
+**
+** copies key/value pairs from one nrrd to another
+** Existing key/value pairs in nout are blown away
+*/
+int
+nrrdKeyValueCopy(Nrrd *nout, const Nrrd *nin) {
+ char *key, *value;
+ unsigned int ki;
+
+ if (!(nout && nin)) {
+ /* got NULL pointer */
+ return 1;
+ }
+ if (nout == nin) {
+ /* can't satisfy semantics of copying with nout==nin */
+ return 2;
+ }
+
+ nrrdKeyValueClear(nout);
+ for (ki=0; ki<nin->kvpArr->len; ki++) {
+ key = nin->kvp[0 + 2*ki];
+ value = nin->kvp[1 + 2*ki];
+ if (nrrdKeyValueAdd(nout, key, value)) {
+ return 3;
+ }
+ }
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/mangle.pl b/Utilities/ITK/Utilities/NrrdIO/mangle.pl
new file mode 100644
index 0000000000000000000000000000000000000000..ac83d939c4524151eb129fbb01bfea1764fb5eaa
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/mangle.pl
@@ -0,0 +1,77 @@
+#
+# NrrdIO: stand-alone code for basic nrrd functionality
+# Copyright (C) 2005 Gordon Kindlmann
+# Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+#
+# This software is provided 'as-is', without any express or implied
+# warranty. In no event will the authors be held liable for any
+# damages arising from the use of this software.
+#
+# Permission is granted to anyone to use this software for any
+# purpose, including commercial applications, and to alter it and
+# redistribute it freely, subject to the following restrictions:
+#
+# 1. The origin of this software must not be misrepresented; you must
+# not claim that you wrote the original software. If you use this
+# software in a product, an acknowledgment in the product
+# documentation would be appreciated but is not required.
+#
+# 2. Altered source versions must be plainly marked as such, and must
+# not be misrepresented as being the original software.
+#
+# 3. This notice may not be removed or altered from any source distribution.
+#
+#
+# generates (to stdout) a header file intended to be included into
+# source files where there is a concern of name-space collision induced
+# by linking to two different version of NrrdIO
+#
+
+if (0 != $#ARGV) {
+ die "usage: perl mangle.pl <prefix>\n";
+}
+$prefix = $ARGV[0];
+
+# there's probably a proper way to detect if the compiler is putting
+# an underscore in front of all the symbols, but this works to detect
+# what happens on macs
+if (exists $ENV{OSTYPE} and "darwin" eq $ENV{OSTYPE}) {
+ $mac = 1;
+} else {
+ $mac = 0;
+}
+
+print "#ifndef __${prefix}_NrrdIO_mangle_h\n";
+print "#define __${prefix}_NrrdIO_mangle_h\n";
+print "\n";
+print "/*\n";
+print "\n";
+print "This header file mangles all symbols exported from the\n";
+print "NrrdIO library. It is included in all files while building\n";
+print "the NrrdIO library. Due to namespace pollution, no NrrdIO\n";
+print "headers should be included in .h files in ITK.\n";
+print "\n";
+print "This file was created via the mangle.pl script in the\n";
+print "NrrdIO distribution:\n";
+print "\n";
+print " perl mangle.pl ${prefix} > ${prefix}_NrrdIO_mangle.h\n";
+print "\n";
+print "This uses nm to list all text (T), data (D) symbols, as well\n";
+print "read-only (R) things (seen on Linux) and \"other\" (S) things\n";
+print "(seen on Mac). On Macs, the preceeding underscore is removed.\n";
+print "*/\n";
+print "\n";
+open(NM, "nm libNrrdIO.a |");
+while (<NM>) {
+ if (m/ [TDRS] /) {
+ s|.* [TDRS] (.*)|$1|g;
+ if ($mac) {
+ s|^_||g;
+ }
+ chop;
+ $sym = $_;
+ print "#define ${sym} ${prefix}_${sym}\n";
+ }
+}
+close(NM);
+print "#endif /* __${prefix}_NrrdIO_mangle_h */ \n";
diff --git a/Utilities/ITK/Utilities/NrrdIO/methodsNrrd.c b/Utilities/ITK/Utilities/NrrdIO/methodsNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..972a5fce4e2d700f254fb5b7f21244969367c788
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/methodsNrrd.c
@@ -0,0 +1,877 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+#include "teem32bit.h"
+
+void
+nrrdPeripheralInit(Nrrd *nrrd) {
+
+ nrrdBasicInfoInit(nrrd,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT);
+ return;
+}
+
+int
+nrrdPeripheralCopy(Nrrd *nout, const Nrrd *nin) {
+
+ nrrdBasicInfoCopy(nout, nin,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT);
+ return 0;
+}
+
+/* ------------------------------------------------------------ */
+
+void
+nrrdIoStateInit (NrrdIoState *nio) {
+
+ if (nio) {
+ nio->path = (char *)airFree(nio->path);
+ nio->base = (char *)airFree(nio->base);
+ nio->line = (char *)airFree(nio->line);
+ nio->dataFNFormat = (char *)airFree(nio->dataFNFormat);
+ airArrayLenSet(nio->dataFNArr, 0);
+ /* closing this is always someone else's responsibility */
+ nio->headerFile = NULL;
+ nio->dataFile = NULL;
+ nio->dataFileDim = 0;
+ nio->dataFNMin = 0;
+ nio->dataFNMax = 0;
+ nio->dataFNStep = 0;
+ nio->dataFNIndex = -1;
+ nio->lineLen = 0;
+ nio->pos = 0;
+ nio->endian = airEndianUnknown;
+ nio->lineSkip = 0;
+ nio->byteSkip = 0;
+ memset(nio->seen, 0, (NRRD_FIELD_MAX+1)*sizeof(int));
+ nio->detachedHeader = AIR_FALSE;
+ nio->bareText = nrrdDefWriteBareText;
+ nio->charsPerLine = nrrdDefWriteCharsPerLine;
+ nio->valsPerLine = nrrdDefWriteValsPerLine;
+ nio->skipData = AIR_FALSE;
+ nio->keepNrrdDataFileOpen = AIR_FALSE;
+ nio->zlibLevel = -1;
+ nio->zlibStrategy = nrrdZlibStrategyDefault;
+ nio->bzip2BlockSize = -1;
+ nio->oldData = NULL;
+ nio->oldDataSize = 0;
+ nio->format = nrrdFormatUnknown;
+ nio->encoding = nrrdEncodingUnknown;
+ }
+ return;
+}
+
+NrrdIoState *
+nrrdIoStateNew (void) {
+ NrrdIoState *nio;
+
+ nio = (NrrdIoState *)calloc(1, sizeof(NrrdIoState));
+ if (nio) {
+ nio->path = NULL;
+ nio->base = NULL;
+ nio->line = NULL;
+ nio->dataFNFormat = NULL;
+ nio->dataFN = NULL;
+ nio->dataFNArr = airArrayNew((void**)(&(nio->dataFN)), NULL,
+ sizeof(char *), NRRD_FILENAME_INCR);
+ airArrayPointerCB(nio->dataFNArr, airNull, airFree);
+ nio->format = nrrdFormatUnknown;
+ nio->encoding = nrrdEncodingUnknown;
+ nrrdIoStateInit(nio);
+ }
+ return nio;
+}
+
+NrrdIoState *
+nrrdIoStateNix (NrrdIoState *nio) {
+
+ nio->path = (char *)airFree(nio->path);
+ nio->base = (char *)airFree(nio->base);
+ nio->line = (char *)airFree(nio->line);
+ nio->dataFNFormat = (char *)airFree(nio->dataFNFormat);
+ nio->dataFNArr = airArrayNuke(nio->dataFNArr);
+ /* the NrrdIoState never owned nio->oldData; we don't free it */
+ airFree(nio); /* no NULL assignment, else compile warnings */
+ return NULL;
+}
+
+
+/* ------------------------------------------------------------ */
+
+/* see axis.c for axis-specific "methods" */
+
+/* ------------------------------------------------------------ */
+
+/*
+******** nrrdBasicInfoInit
+**
+** resets "basic" (per-array) information
+** formerly nrrdPeripheralInit
+**
+** the bitflag communicates which fields should *not* be initialized
+*/
+void
+nrrdBasicInfoInit (Nrrd *nrrd, int bitflag) {
+ int dd, ee;
+
+ if (!nrrd) {
+ return;
+ }
+
+ if (!(NRRD_BASIC_INFO_DATA_BIT & bitflag)) {
+ nrrd->data = airFree(nrrd->data);
+ }
+ if (!(NRRD_BASIC_INFO_TYPE_BIT & bitflag)) {
+ nrrd->type = nrrdTypeUnknown;
+ }
+ if (!(NRRD_BASIC_INFO_BLOCKSIZE_BIT & bitflag)) {
+ nrrd->blockSize = 0;
+ }
+ if (!(NRRD_BASIC_INFO_DIMENSION_BIT & bitflag)) {
+ nrrd->dim = 0;
+ }
+ if (!(NRRD_BASIC_INFO_CONTENT_BIT & bitflag)) {
+ nrrd->content = (char *)airFree(nrrd->content);
+ }
+ if (!(NRRD_BASIC_INFO_SAMPLEUNITS_BIT & bitflag)) {
+ nrrd->sampleUnits = (char *)airFree(nrrd->sampleUnits);
+ }
+ if (!(NRRD_BASIC_INFO_SPACE_BIT & bitflag)) {
+ nrrd->space = nrrdSpaceUnknown;
+ nrrd->spaceDim = 0;
+ }
+ if (!(NRRD_BASIC_INFO_SPACEDIMENSION_BIT & bitflag)) {
+ nrrd->space = nrrdSpaceUnknown;
+ nrrd->spaceDim = 0;
+ }
+ if (!(NRRD_BASIC_INFO_SPACEUNITS_BIT & bitflag)) {
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ nrrd->spaceUnits[dd] = (char *)airFree(nrrd->spaceUnits[dd]);
+ }
+ }
+ if (!(NRRD_BASIC_INFO_SPACEORIGIN_BIT & bitflag)) {
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ nrrd->spaceOrigin[dd] = AIR_NAN;
+ }
+ }
+ if (!(NRRD_BASIC_INFO_MEASUREMENTFRAME_BIT & bitflag)) {
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ for (ee=0; ee<NRRD_SPACE_DIM_MAX; ee++) {
+ nrrd->measurementFrame[dd][ee] = AIR_NAN;
+ }
+ }
+ }
+ if (!(NRRD_BASIC_INFO_OLDMIN_BIT & bitflag)) {
+ nrrd->oldMin = AIR_NAN;
+ }
+ if (!(NRRD_BASIC_INFO_OLDMAX_BIT & bitflag)) {
+ nrrd->oldMax = AIR_NAN;
+ }
+ if (!(NRRD_BASIC_INFO_COMMENTS_BIT & bitflag)) {
+ nrrdCommentClear(nrrd);
+ }
+ if (!(NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT & bitflag)) {
+ nrrdKeyValueClear(nrrd);
+ }
+ return;
+}
+
+/*
+******** nrrdBasicInfoCopy
+**
+** copies "basic" (per-array) information
+** formerly known as nrrdPeripheralCopy, which was not used consistently
+**
+** the bitflag communicates which fields should *not* be copied
+*/
+int
+nrrdBasicInfoCopy (Nrrd *dest, const Nrrd *src, int bitflag) {
+ char me[]="nrrdBasicInfoCopy", err[AIR_STRLEN_MED];
+ unsigned int dd, ee;
+
+ if (!( dest && src ))
+ return 0;
+ if (dest == src) {
+ /* nothing to do */
+ return 0;
+ }
+
+ if (!(NRRD_BASIC_INFO_DATA_BIT & bitflag)) {
+ dest->data = src->data;
+ }
+ if (!(NRRD_BASIC_INFO_TYPE_BIT & bitflag)) {
+ dest->type = src->type;
+ }
+ if (!(NRRD_BASIC_INFO_BLOCKSIZE_BIT & bitflag)) {
+ dest->blockSize = src->blockSize;
+ }
+ if (!(NRRD_BASIC_INFO_DIMENSION_BIT & bitflag)) {
+ dest->dim = src->dim;
+ }
+ if (!(NRRD_BASIC_INFO_CONTENT_BIT & bitflag)) {
+ dest->content = (char *)airFree(dest->content);
+ dest->content = airStrdup(src->content);
+ if (src->content && !dest->content) {
+ sprintf(err, "%s: couldn't copy content", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ if (!(NRRD_BASIC_INFO_SAMPLEUNITS_BIT & bitflag)) {
+ dest->sampleUnits = (char *)airFree(dest->sampleUnits);
+ dest->sampleUnits = airStrdup(src->sampleUnits);
+ if (src->sampleUnits && !dest->sampleUnits) {
+ sprintf(err, "%s: couldn't copy sampleUnits", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ if (!(NRRD_BASIC_INFO_SPACE_BIT & bitflag)) {
+ dest->space = src->space;
+ }
+ if (!(NRRD_BASIC_INFO_SPACEDIMENSION_BIT & bitflag)) {
+ dest->spaceDim = src->spaceDim;
+ }
+ if (!(NRRD_BASIC_INFO_SPACEUNITS_BIT & bitflag)) {
+ for (dd=0; dd<src->spaceDim; dd++) {
+ dest->spaceUnits[dd] = (char *)airFree(dest->spaceUnits[dd]);
+ dest->spaceUnits[dd] = airStrdup(src->spaceUnits[dd]);
+ if (src->spaceUnits[dd] && !dest->spaceUnits[dd]) {
+ sprintf(err, "%s: couldn't copy spaceUnits[%d]", me, dd);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ for (dd=src->spaceDim; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ dest->spaceUnits[dd] = (char *)airFree(dest->spaceUnits[dd]);
+ }
+ }
+ if (!(NRRD_BASIC_INFO_SPACEORIGIN_BIT & bitflag)) {
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ if (dd <= src->spaceDim-1) {
+ dest->spaceOrigin[dd] = src->spaceOrigin[dd];
+ } else {
+ dest->spaceOrigin[dd] = AIR_NAN;
+ }
+ }
+ }
+ if (!(NRRD_BASIC_INFO_MEASUREMENTFRAME_BIT & bitflag)) {
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ for (ee=0; ee<NRRD_SPACE_DIM_MAX; ee++) {
+ if (dd <= src->spaceDim-1 && ee <= src->spaceDim-1) {
+ dest->measurementFrame[dd][ee] = src->measurementFrame[dd][ee];
+ } else {
+ dest->measurementFrame[dd][ee] = AIR_NAN;
+ }
+ }
+ }
+ for (dd=src->spaceDim; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ dest->spaceOrigin[dd] = AIR_NAN;
+ }
+ }
+ if (!(NRRD_BASIC_INFO_OLDMIN_BIT & bitflag)) {
+ dest->oldMin = src->oldMin;
+ }
+ if (!(NRRD_BASIC_INFO_OLDMAX_BIT & bitflag)) {
+ dest->oldMax = src->oldMax;
+ }
+ if (!(NRRD_BASIC_INFO_COMMENTS_BIT & bitflag)) {
+ if (nrrdCommentCopy(dest, src)) {
+ sprintf(err, "%s: trouble copying comments", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ if (!(NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT & bitflag)) {
+ if (nrrdKeyValueCopy(dest, src)) {
+ sprintf(err, "%s: trouble copying key/value pairs", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+******* nrrdInit
+**
+** initializes a nrrd to default state. All nrrd functions in the
+** business of initializing a nrrd struct use this function. Mostly
+** just sets values to 0, NaN, "", NULL, or Unknown
+*/
+void
+nrrdInit (Nrrd *nrrd) {
+ int ii;
+
+ if (nrrd) {
+ nrrdBasicInfoInit(nrrd, NRRD_BASIC_INFO_NONE);
+ for (ii=0; ii<NRRD_DIM_MAX; ii++) {
+ _nrrdAxisInfoInit(nrrd->axis + ii);
+ }
+ }
+ return;
+}
+
+/*
+******** nrrdNew()
+**
+** creates and initializes a Nrrd
+**
+** this does NOT use biff
+*/
+Nrrd *
+nrrdNew (void) {
+ int ii;
+ Nrrd *nrrd;
+
+ nrrd = (Nrrd*)(calloc(1, sizeof(Nrrd)));
+ if (!nrrd)
+ return NULL;
+
+ /* explicitly set pointers to NULL, since calloc isn't officially
+ guaranteed to do that. */
+ nrrd->data = NULL;
+ for (ii=0; ii<NRRD_DIM_MAX; ii++) {
+ _nrrdAxisInfoNewInit(nrrd->axis + ii);
+ }
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ nrrd->spaceUnits[ii] = NULL;
+ }
+ nrrd->content = NULL;
+ nrrd->sampleUnits = NULL;
+
+ /* create comment airArray (even though it starts empty) */
+ nrrd->cmt = NULL;
+ nrrd->cmtArr = airArrayNew((void**)(&(nrrd->cmt)), NULL,
+ sizeof(char *), NRRD_COMMENT_INCR);
+ if (!nrrd->cmtArr) {
+ return NULL;
+ }
+ airArrayPointerCB(nrrd->cmtArr, airNull, airFree);
+
+ /* create key/value airArray (even thought it starts empty) */
+ nrrd->kvp = NULL;
+ nrrd->kvpArr = airArrayNew((void**)(&(nrrd->kvp)), NULL,
+ 2*sizeof(char *), NRRD_KEYVALUE_INCR);
+ if (!nrrd->kvpArr) {
+ return NULL;
+ }
+ /* key/value airArray uses no callbacks for now */
+
+ /* finish initializations */
+ nrrdInit(nrrd);
+
+ return nrrd;
+}
+
+/*
+******** nrrdNix()
+**
+** does nothing with the array data inside, just does whatever is needed
+** to free the nrrd itself
+**
+** returns NULL
+**
+** this does NOT use biff
+*/
+Nrrd *
+nrrdNix (Nrrd *nrrd) {
+ int ii;
+
+ if (nrrd) {
+ for (ii=0; ii<NRRD_DIM_MAX; ii++) {
+ _nrrdAxisInfoInit(&(nrrd->axis[ii]));
+ }
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ nrrd->spaceUnits[ii] = (char *)airFree(nrrd->spaceUnits[ii]);
+ }
+ nrrd->content = (char *)airFree(nrrd->content);
+ nrrd->sampleUnits = (char *)airFree(nrrd->sampleUnits);
+ nrrdCommentClear(nrrd);
+ nrrd->cmtArr = airArrayNix(nrrd->cmtArr);
+ nrrdKeyValueClear(nrrd);
+ nrrd->kvpArr = airArrayNix(nrrd->kvpArr);
+ airFree(nrrd);
+ }
+ return NULL;
+}
+
+/*
+******** nrrdEmpty()
+**
+** frees data inside nrrd AND resets all its state, so its the
+** same as what comes from nrrdNew(). This includes free()ing
+** any comments.
+*/
+Nrrd *
+nrrdEmpty (Nrrd *nrrd) {
+
+ if (nrrd) {
+ nrrd->data = airFree(nrrd->data);
+ nrrdInit(nrrd);
+ }
+ return nrrd;
+}
+
+/*
+******** nrrdNuke()
+**
+** blows away the nrrd and everything inside
+**
+** always returns NULL
+*/
+Nrrd *
+nrrdNuke (Nrrd *nrrd) {
+
+ if (nrrd) {
+ nrrdEmpty(nrrd);
+ nrrdNix(nrrd);
+ }
+ return NULL;
+}
+
+/* ------------------------------------------------------------ */
+
+int
+_nrrdSizeCheck (const size_t *size, unsigned int dim, int useBiff) {
+ char me[]="_nrrdSizeCheck", err[AIR_STRLEN_MED];
+ size_t num, pre;
+ unsigned int ai;
+
+ pre = num = 1;
+ for (ai=0; ai<dim; ai++) {
+ if (!size[ai]) {
+ sprintf(err, "%s: axis %u size is zero!", me, ai);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ num *= size[ai];
+ if (num/size[ai] != pre) {
+ sprintf(err, "%s: total # of elements too large to be represented in "
+ "type size_t, so too large for current architecture", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ pre *= size[ai];
+ }
+ return 0;
+}
+
+/*
+******** nrrdWrap_nva()
+**
+** wraps a given Nrrd around a given array
+**
+** we don't touch any of the peripheral information (content, comments,
+** blocksize, min/max) because it is entirely reasonable to be setting
+** this before or after this call. "type" could be passed as
+** nrrdTypeBlock, in which case it is the user's responsibility to
+** set nrrd->blockSize at some other time.
+*/
+int
+nrrdWrap_nva (Nrrd *nrrd, void *data, int type,
+ unsigned int dim, const size_t *size) {
+ char me[]="nrrdWrap_nva", err[AIR_STRLEN_MED];
+
+ if (!(nrrd && size)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ nrrd->data = data;
+ nrrd->type = type;
+ nrrd->dim = dim;
+ if (_nrrdSizeCheck(size, dim, AIR_TRUE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoSize, size);
+ return 0;
+}
+
+/*
+******** nrrdWrap()
+**
+** Minimal var args wrapper around nrrdWrap_nva, with the advantage of
+** taking all the axes sizes as the var args.
+**
+** This is THE BEST WAY to wrap a nrrd around existing raster data,
+** assuming that the dimension is known at compile time.
+**
+** If successful, returns 0, otherwise, 1.
+** This does use biff.
+*/
+int
+nrrdWrap (Nrrd *nrrd, void *data, int type, unsigned int dim, ...) {
+ char me[] = "nrrdWrap", err[AIR_STRLEN_MED];
+ va_list ap;
+ size_t size[NRRD_DIM_MAX];
+ unsigned int ai;
+
+ if (!(nrrd && data)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ va_start(ap, dim);
+ for (ai=0; ai<dim; ai++) {
+ size[ai] = va_arg(ap, size_t);
+ }
+ va_end(ap);
+
+ return nrrdWrap_nva(nrrd, data, type, dim, size);
+}
+
+/*
+void
+_nrrdTraverse (Nrrd *nrrd) {
+ char *test, tval;
+ size_t I, N;
+ int S;
+
+ N = nrrdElementNumber(nrrd);
+ S = nrrdElementSize(nrrd);
+ tval = 0;
+ test = nrrd->data;
+ for (I=0; I<N*S; I++) {
+ tval += test[I];
+ }
+}
+*/
+
+int
+_nrrdCopy (Nrrd *nout, const Nrrd *nin, int bitflag) {
+ char me[]="_nrrdCopy", err[AIR_STRLEN_MED];
+ size_t size[NRRD_DIM_MAX];
+
+ if (!(nin && nout)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nout == nin) {
+ /* its not the case that we have nothing to do- the semantics of
+ copying cannot be achieved if the input and output nrrd are
+ the same; this is an error */
+ sprintf(err, "%s: nout==nin disallowed", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!nrrdElementSize(nin)) {
+ sprintf(err, "%s: input nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ nrrdAxisInfoGet_nva(nin, nrrdAxisInfoSize, size);
+ if (nin->data) {
+ if (nrrdMaybeAlloc_nva(nout, nin->type, nin->dim, size)) {
+ sprintf(err, "%s: couldn't allocate data", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ memcpy(nout->data, nin->data,
+ nrrdElementNumber(nin)*nrrdElementSize(nin));
+ } else {
+ /* someone is trying to copy structs without data, fine fine fine */
+ if (nrrdWrap_nva(nout, NULL, nin->type, nin->dim, size)) {
+ sprintf(err, "%s: couldn't allocate data", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ nrrdAxisInfoCopy(nout, nin, NULL, NRRD_AXIS_INFO_SIZE_BIT);
+ /* if nin->data non-NULL (second branch above), this will
+ harmlessly unset and set type and dim */
+ nrrdBasicInfoInit(nout, NRRD_BASIC_INFO_DATA_BIT | bitflag);
+ if (nrrdBasicInfoCopy(nout, nin, NRRD_BASIC_INFO_DATA_BIT | bitflag)) {
+ sprintf(err, "%s: trouble copying basic info", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdCopy
+**
+** copy method for nrrds. nout will end up as an "exact" copy of nin.
+** New space for data is allocated here, and output nrrd points to it.
+** Comments from old are added to comments for new, so these are also
+** newly allocated. nout->ptr is not set, nin->ptr is not read.
+*/
+int
+nrrdCopy(Nrrd *nout, const Nrrd *nin) {
+ char me[]="nrrdCopy", err[AIR_STRLEN_MED];
+
+ if (_nrrdCopy(nout, nin, NRRD_BASIC_INFO_NONE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+
+/*
+******** nrrdAlloc_nva()
+**
+** allocates data array and sets information. If this is a block type
+** nrrd, it is necessary to set nrrd->blockSize PRIOR to calling
+** this function.
+**
+** This function will always allocate more memory (via calloc), but
+** it will free() nrrd->data if it is non-NULL when passed in.
+**
+** This function takes the same "don't mess with peripheral information"
+** attitude as nrrdWrap().
+**
+** Note to Gordon: don't get clever and change ANY axis-specific
+** information here. It may be very convenient to set that before
+** nrrdAlloc() or nrrdMaybeAlloc()
+**
+** Note: This function DOES use biff
+*/
+int
+nrrdAlloc_nva (Nrrd *nrrd, int type, unsigned int dim, const size_t *size) {
+ char me[] = "nrrdAlloc_nva", err[AIR_STRLEN_MED];
+ size_t num;
+ int esize;
+
+ if (!(nrrd && size)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (airEnumValCheck(nrrdType, type)) {
+ sprintf(err, "%s: type (%d) is invalid", me, type);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdTypeBlock == type) {
+ if (!(0 < nrrd->blockSize)) {
+ sprintf(err, "%s: given nrrd->blockSize " _AIR_SIZE_T_CNV " invalid",
+ me, nrrd->blockSize);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ if (!AIR_IN_CL(1, dim, NRRD_DIM_MAX)) {
+ sprintf(err, "%s: dim (%d) not in valid range [1,%d]",
+ me, dim, NRRD_DIM_MAX);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ nrrd->data = airFree(nrrd->data);
+ if (nrrdWrap_nva(nrrd, NULL, type, dim, size)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1 ;
+ }
+ num = nrrdElementNumber(nrrd);
+ esize = nrrdElementSize(nrrd);
+ nrrd->data = calloc(num, esize);
+ if (!(nrrd->data)) {
+ sprintf(err, "%s: calloc(" _AIR_SIZE_T_CNV ",%d) failed",
+ me, num, esize);
+ biffAdd(NRRD, err); return 1 ;
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdAlloc()
+**
+** Handy wrapper around nrrdAlloc_nva, which takes, as its vararg list,
+** all the axes sizes.
+*/
+int
+nrrdAlloc (Nrrd *nrrd, int type, unsigned int dim, ...) {
+ char me[]="nrrdAlloc", err[AIR_STRLEN_MED];
+ size_t size[NRRD_DIM_MAX];
+ unsigned int ai;
+ va_list ap;
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ va_start(ap, dim);
+ for (ai=0; ai<dim; ai++) {
+ size[ai] = va_arg(ap, size_t);
+ }
+ va_end(ap);
+ if (nrrdAlloc_nva(nrrd, type, dim, size)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+
+/*
+******** nrrdMaybeAlloc_nva
+**
+** calls nrrdAlloc_nva if the requested space is different than
+** what is currently held
+**
+** also subscribes to the "don't mess with peripheral information" philosophy
+*/
+int
+nrrdMaybeAlloc_nva (Nrrd *nrrd, int type,
+ unsigned int dim, const size_t *size) {
+ char me[]="nrrdMaybeAlloc_nva", err[AIR_STRLEN_MED];
+ size_t sizeWant, sizeHave, numWant, elementSizeWant;
+ int need;
+ unsigned int ai;
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (airEnumValCheck(nrrdType, type)) {
+ sprintf(err, "%s: type (%d) is invalid", me, type);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdTypeBlock == type) {
+ if (nrrdTypeBlock == nrrd->type) {
+ sprintf(err, "%s: can't change from one block nrrd to another", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!(0 < nrrd->blockSize)) {
+ sprintf(err, "%s: given nrrd->blockSize " _AIR_SIZE_T_CNV " invalid",
+ me, nrrd->blockSize);
+ biffAdd(NRRD, err); return 1;
+ }
+ elementSizeWant = nrrd->blockSize;
+ } else {
+ elementSizeWant = nrrdTypeSize[type];
+ }
+ if (_nrrdSizeCheck(size, dim, AIR_TRUE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ if (!(nrrd->data)) {
+ need = 1;
+ } else {
+ numWant = 1;
+ for (ai=0; ai<dim; ai++) {
+ numWant *= size[ai];
+ }
+ if (!nrrdElementSize(nrrd)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ sizeHave = nrrdElementNumber(nrrd) * nrrdElementSize(nrrd);
+ /* fprintf(stderr, "##%s: sizeHave = %d * %d = %d\n", me,
+ (int)(nrrdElementNumber(nrrd)),
+ (int)(nrrdElementSize(nrrd)), (int)sizeHave); */
+ sizeWant = numWant * elementSizeWant;
+ /* fprintf(stderr, "##%s: sizeWant = %d * %d = %d\n", me,
+ (int)(numWant),
+ (int)(elementSizeWant), (int)sizeWant); */
+ need = sizeHave != sizeWant;
+ /* fprintf(stderr, "##%s: need = %d\n", me, need); */
+ }
+ if (need) {
+ if (nrrdAlloc_nva(nrrd, type, dim, size)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ } else {
+ if (nrrdWrap_nva(nrrd, nrrd->data, type, dim, size)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* but we do have to initialize memory! */
+ memset(nrrd->data, 0, nrrdElementNumber(nrrd)*nrrdElementSize(nrrd));
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdMaybeAlloc()
+**
+** Handy wrapper around nrrdAlloc, which takes, as its vararg list
+** all the axes sizes, thereby calculating the total number.
+*/
+int
+nrrdMaybeAlloc (Nrrd *nrrd, int type, unsigned int dim, ...) {
+ char me[]="nrrdMaybeAlloc", err[AIR_STRLEN_MED];
+ size_t size[NRRD_DIM_MAX];
+ unsigned int ai;
+ va_list ap;
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ va_start(ap, dim);
+ for (ai=0; ai<dim; ai++) {
+ size[ai] = va_arg(ap, size_t);
+ }
+ va_end(ap);
+ if (nrrdMaybeAlloc_nva(nrrd, type, dim, size)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+/*
+******** nrrdPPM()
+**
+** for making a nrrd suitable for holding PPM data
+**
+** "don't mess with peripheral information"
+*/
+int
+nrrdPPM (Nrrd *ppm, size_t sx, size_t sy) {
+ char me[]="nrrdPPM", err[AIR_STRLEN_MED];
+
+ if (nrrdMaybeAlloc(ppm, nrrdTypeUChar, 3, 3, sx, sy)) {
+ sprintf(err, "%s: couldn't allocate " _AIR_SIZE_T_CNV
+ " x " _AIR_SIZE_T_CNV " 24-bit image", me, sx, sy);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+/*
+******** nrrdPGM()
+**
+** for making a nrrd suitable for holding PGM data
+**
+** "don't mess with peripheral information"
+*/
+int
+nrrdPGM (Nrrd *pgm, size_t sx, size_t sy) {
+ char me[]="nrrdNewPGM", err[AIR_STRLEN_MED];
+
+ if (nrrdMaybeAlloc(pgm, nrrdTypeUChar, 2, sx, sy)) {
+ sprintf(err, "%s: couldn't allocate " _AIR_SIZE_T_CNV
+ " x " _AIR_SIZE_T_CNV " 8-bit image", me, sx, sy);
+ biffAdd(NRRD, err);
+ return 1;
+ }
+ return 0;
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/miscAir.c b/Utilities/ITK/Utilities/NrrdIO/miscAir.c
new file mode 100644
index 0000000000000000000000000000000000000000..92072608aee54cf29f6985d8e43de682aed75dc3
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/miscAir.c
@@ -0,0 +1,248 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+#include "teem32bit.h"
+/* timer functions */
+#ifdef _WIN32
+#include <io.h>
+#include <fcntl.h>
+#include <time.h>
+#else
+#include <sys/time.h>
+#endif
+
+/*
+******** airTeemVersion
+******** airTeemReleaseDate
+**
+** updated with each release to contain a string representation of
+** the teem version number and release date. Originated in version 1.5;
+** use of TEEM_VERSION #defines started in 1.9
+*/
+const char *
+airTeemVersion = TEEM_VERSION_STRING;
+const char *
+airTeemReleaseDate = "26 August 2005";
+
+double
+_airSanityHelper(double val) {
+ return val*val*val;
+}
+
+/*
+******** airNull()
+**
+** returns NULL
+*/
+void *
+airNull(void) {
+
+ return NULL;
+}
+
+/*
+******** airSetNull
+**
+** dereferences and sets to NULL, returns NULL
+*/
+void *
+airSetNull(void **ptrP) {
+
+ if (ptrP) {
+ *ptrP = NULL;
+ }
+ return NULL;
+}
+
+/*
+******** airFree()
+**
+** to facilitate setting a newly free()'d pointer; always returns NULL.
+** also makes sure that NULL is not passed to free().
+*/
+void *
+airFree(void *ptr) {
+
+ if (ptr) {
+ free(ptr);
+ }
+ return NULL;
+}
+
+/*
+******** airFopen()
+**
+** encapsulates that idea that "-" is either standard in or stardard
+** out, and does McRosopht stuff required to make piping work
+**
+** Does not error checking. If fopen fails, then C' errno and strerror are
+** left untouched for the caller to access.
+*/
+FILE *
+airFopen(const char *name, FILE *std, const char *mode) {
+ FILE *ret;
+
+ if (!strcmp(name, "-")) {
+ ret = std;
+#ifdef _MSC_VER
+ if (strchr(mode, 'b')) {
+ _setmode(_fileno(ret), _O_BINARY);
+ }
+#endif
+ } else {
+ ret = fopen(name, mode);
+ }
+ return ret;
+}
+
+
+/*
+******** airFclose()
+**
+** just to facilitate setting a newly fclose()'d file pointer to NULL
+** also makes sure that NULL is not passed to fclose(), and won't close
+** stdin, stdout, or stderr (its up to the user to open these correctly)
+*/
+FILE *
+airFclose(FILE *file) {
+
+ if (file) {
+ if (!( stdin == file || stdout == file || stderr == file )) {
+ fclose(file);
+ }
+ }
+ return NULL;
+}
+
+/*
+******** airSinglePrintf
+**
+** a complete stand-in for {f|s}printf(), as long as the given format
+** string contains exactly one conversion sequence. The utility of
+** this is to standardize the printing of IEEE 754 special values:
+** QNAN, SNAN -> "NaN"
+** POS_INF -> "+inf"
+** NEG_INF -> "-inf"
+** The format string can contain other things besides just the
+** conversion sequence: airSingleFprintf(f, " (%f)\n", AIR_NAN)
+** will be the same as fprintf(f, " (%s)\n", "NaN");
+**
+** To get fprintf behavior, pass "str" as NULL
+** to get sprintf bahavior, pass "file" as NULL
+**
+** Someday I'll find/write a complete {f|s|}printf replacement ...
+*/
+int
+airSinglePrintf(FILE *file, char *str, const char *_fmt, ...) {
+ char *fmt;
+ float valF=0;
+ double valD=0;
+ int ret, isF, isD, cls;
+ char *conv=NULL, *p0, *p1, *p2, *p3, *p4, *p5;
+ va_list ap;
+
+ va_start(ap, _fmt);
+ fmt = airStrdup(_fmt);
+
+ p0 = strstr(fmt, "%e");
+ p1 = strstr(fmt, "%f");
+ p2 = strstr(fmt, "%g");
+ p3 = strstr(fmt, "%le");
+ p4 = strstr(fmt, "%lf");
+ p5 = strstr(fmt, "%lg");
+ isF = p0 || p1 || p2;
+ isD = p3 || p4 || p5;
+ if (isF) {
+ conv = p0 ? p0 : (p1 ? p1 : p2);
+ }
+ if (isD) {
+ conv = p3 ? p3 : (p4 ? p4 : p5);
+ }
+ if (isF || isD) {
+ if (isF) {
+ /* use "double" instead of "float" because var args are _always_
+ subject to old-style C type promotions: float promotes to double */
+ valF = (float)(va_arg(ap, double));
+ cls = airFPClass_f(valF);
+ }
+ else {
+ valD = va_arg(ap, double);
+ cls = airFPClass_d(valD);
+ }
+ switch (cls) {
+ case airFP_SNAN:
+ case airFP_QNAN:
+ case airFP_POS_INF:
+ case airFP_NEG_INF:
+ if (isF) {
+ memcpy(conv, "%s", 2);
+ }
+ else {
+ /* this sneakiness allows us to replace a 3-character conversion
+ sequence for a double (such as %lg) with a 3-character conversion
+ for a string, which we know has at most 4 characters */
+ memcpy(conv, "%4s", 3);
+ }
+ break;
+ }
+#define PRINT(F, S, C, V) ((F) ? fprintf((F),(C),(V)) : sprintf((S),(C),(V)))
+ switch (cls) {
+ case airFP_SNAN:
+ case airFP_QNAN:
+ ret = PRINT(file, str, fmt, "NaN");
+ break;
+ case airFP_POS_INF:
+ ret = PRINT(file, str, fmt, "+inf");
+ break;
+ case airFP_NEG_INF:
+ ret = PRINT(file, str, fmt, "-inf");
+ break;
+ default:
+ if (isF) {
+ ret = PRINT(file, str, fmt, valF);
+ }
+ else {
+ ret = PRINT(file, str, fmt, valD);
+ }
+ break;
+ }
+ }
+ else {
+ ret = file ? vfprintf(file, fmt, ap) : vsprintf(str, fmt, ap);
+ }
+
+ va_end(ap);
+ free(fmt);
+ return ret;
+}
+
+#if TEEM_32BIT == 1
+const int airMy32Bit = 1;
+#else
+const int airMy32Bit = 0;
+#endif
+
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/mop.c b/Utilities/ITK/Utilities/NrrdIO/mop.c
new file mode 100644
index 0000000000000000000000000000000000000000..7bcc9804df7b9c2bf220b65dbb6ec98e713e49c6
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/mop.c
@@ -0,0 +1,264 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+/*
+learned: using these functions correctly to manage even simple
+memory usage can be very tricky.
+
+problem 0: even trying to write airMopPrint, I foolishly thought:
+"print the string, then free it". But the print callback clobbered
+the free callback, because of the semantics of airMopAdd(). So,
+I had to add _airMopAdd().
+
+problem 1: debugging hest with purify, on case of hitting error after
+parsing multiple variable parameter option of strings: so, I allocated
+an array of strings (arrays), and registered all the strings with
+airMopMem(), and registered the array itself also with airMopMem().
+Again, got clobbered. airSetNull(&((*vP)[0])) clobbered
+airFree(*vP). So, I gave up on using airMopMem() for the individual
+elements, and am using simply airMopAdd(airFree). The alternative
+was to change the airMopAdd()s in airMopMem() to _airMopAdd()s, but
+I didn't feel confident that this would be safe ...
+
+----------- SO: as a result of all that:
+
+airMopAdd() will no longer over-write a callback based on the pointer
+It will only over-write the "when" of a (pointer,callback) pair, so that
+you can't register multiple copies of a (pointer,callback) pair (regardless
+of differences, if any, in "when"). Therefore, there will be AT MOST ONE
+instance of a (pointer,callback) pair in a mop.
+
+_airMopAdd() was nixed.
+
+airMopSub() and airMopUnMem were created
+
+*/
+
+#define AIR_MOP_INCR 10
+
+airArray *
+airMopNew() {
+
+ return airArrayNew(NULL, NULL, sizeof(airMop), AIR_MOP_INCR);
+}
+
+void
+airMopAdd(airArray *arr, void *ptr, airMopper mop, int when) {
+ airMop *mops;
+ unsigned int ii;
+
+ if (!arr) {
+ return;
+ }
+
+ mops = (airMop *)arr->data;
+ /* first see if this is something we already set a callback for */
+ for (ii=0; ii<arr->len; ii++) {
+ if (mops[ii].ptr == ptr && mops[ii].mop == mop) {
+ mops[ii].when = when;
+ /* we're done */
+ return;
+ }
+ }
+ /* this is a new ptr */
+ ii = airArrayLenIncr(arr, 1); /* HEY no error checking */
+ mops = (airMop *)arr->data;
+ mops[ii].ptr = ptr;
+ mops[ii].mop = mop;
+ mops[ii].when = when;
+ return;
+}
+
+void
+airMopSub(airArray *arr, void *ptr, airMopper mop) {
+ airMop *mops;
+ unsigned int ii;
+
+ if (!arr) {
+ return;
+ }
+
+ mops = (airMop *)arr->data;
+ /* first see if this is something we already set a callback for */
+ for (ii=0; ii<arr->len; ii++) {
+ if (mops[ii].ptr == ptr && mops[ii].mop == mop) {
+ mops[ii].ptr = NULL;
+ mops[ii].mop = NULL;
+ mops[ii].when = airMopNever;
+ return;
+ }
+ }
+ /* else we've never seen this before, user is a moron */
+ return;
+}
+
+void
+airMopMem(airArray *arr, void *_ptrP, int when) {
+ void **ptrP;
+
+ if (!(arr && _ptrP)) {
+ return;
+ }
+
+ ptrP = (void **)_ptrP;
+ airMopAdd(arr, ptrP, (airMopper)airSetNull, when);
+ airMopAdd(arr, *ptrP, airFree, when);
+ /*
+ printf("airMopMem(0x%p): will free() 0x%p\n",
+ (void*)arr, (void*)(*ptrP));
+ printf("airMopMem(0x%p): will set 0x%p to NULL\n",
+ (void*)arr, (void*)ptrP);
+ */
+ return;
+}
+
+void
+airMopUnMem(airArray *arr, void *_ptrP) {
+ void **ptrP;
+
+ if (!(arr && _ptrP)) {
+ return;
+ }
+
+ ptrP = (void **)_ptrP;
+ airMopSub(arr, ptrP, (airMopper)airSetNull);
+ airMopSub(arr, *ptrP, airFree);
+ return;
+}
+
+void *
+_airMopPrint(void *_str) {
+ char *str;
+
+ str = (char *)_str;
+ if (str) {
+ printf("%s\n", str);
+ }
+ return NULL;
+}
+
+void
+airMopPrint(airArray *arr, const void *_str, int when) {
+ char *copy;
+
+ if (!(arr && _str))
+ return;
+
+ copy = airStrdup((char*)_str);
+ airMopAdd(arr, copy, airFree, airMopAlways);
+ airMopAdd(arr, copy, _airMopPrint, when);
+ return;
+}
+
+char
+_airMopWhenStr[4][128] = {
+ " never",
+ " error",
+ " okay",
+ "always",
+};
+
+void
+airMopDebug(airArray *arr) {
+ airMop *mops;
+ int i;
+
+ if (!arr)
+ return;
+
+ mops = (airMop *)arr->data;
+ printf("airMopDebug: _________________________ mop stack for 0x%p:\n",
+ (void*)arr);
+ for (i=arr->len-1; i>=0; i--) {
+ printf("% 4d: ", i);
+ if (NULL == mops[i].mop && NULL == mops[i].ptr
+ && airMopNever == mops[i].when) {
+ printf("no-op\n");
+ continue;
+ }
+ /* else */
+ printf("%s: ", _airMopWhenStr[mops[i].when]);
+ if (airFree == mops[i].mop) {
+ printf("airFree(0x%p)\n", (void*)(mops[i].ptr));
+ continue;
+ }
+ if ((airMopper)airSetNull == mops[i].mop) {
+ printf("airSetNull(0x%p)\n", (void*)(mops[i].ptr));
+ continue;
+ }
+ if (_airMopPrint == mops[i].mop) {
+ printf("_airMopPrint(\"%s\" == 0x%p)\n",
+ (char*)(mops[i].ptr), (void*)(mops[i].ptr));
+ continue;
+ }
+ if ((airMopper)airFclose == mops[i].mop) {
+ printf("airFclose(0x%p)\n", (void*)(mops[i].ptr));
+ continue;
+ }
+ /* else */
+ printf("0x%p(0x%p)\n", (void*)(mops[i].mop), (void*)(mops[i].ptr));
+ }
+ printf("airMopDebug: ^^^^^^^^^^^^^^^^^^^^^^^^^\n");
+}
+
+void
+airMopDone(airArray *arr, int error) {
+ airMop *mops;
+ int i;
+
+ /*
+ printf("airMopDone(%p): hello, %s\n", (void*)arr, error ? "error" : "okay");
+ */
+ if (arr) {
+ mops = (airMop *)arr->data;
+ for (i=arr->len-1; i>=0; i--) {
+ if (mops[i].ptr
+ && (airMopAlways == mops[i].when
+ || (airMopOnError == mops[i].when && error)
+ || (airMopOnOkay == mops[i].when && !error))) {
+ mops[i].mop(mops[i].ptr);
+ }
+ }
+ airArrayNuke(arr);
+ /*
+ printf("airMopDone(%p): done!\n", (void*)arr);
+ */
+ }
+ return;
+}
+
+void
+airMopError(airArray *arr) {
+
+ airMopDone(arr, AIR_TRUE);
+}
+
+void
+airMopOkay(airArray *arr) {
+
+ airMopDone(arr, AIR_FALSE);
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/parseAir.c b/Utilities/ITK/Utilities/NrrdIO/parseAir.c
new file mode 100644
index 0000000000000000000000000000000000000000..aa1886340757e755470ad2e8bfdc39e7efc2007f
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/parseAir.c
@@ -0,0 +1,369 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+
+char
+_airBoolStr[][AIR_STRLEN_SMALL] = {
+ "(unknown bool)",
+ "false",
+ "true"
+};
+
+char
+_airBoolDesc[][AIR_STRLEN_MED] = {
+ "unknown boolean",
+ "false",
+ "true"
+};
+
+int
+_airBoolVal[] = {
+ -1,
+ AIR_FALSE,
+ AIR_TRUE
+};
+
+char
+_airBoolStrEqv[][AIR_STRLEN_SMALL] = {
+ "0", "no", "n", "false", "f", "off", "nope",
+ "1", "yes", "y", "true", "t", "on", "yea",
+ ""
+};
+
+int
+_airBoolValEqv[] = {
+ AIR_FALSE, AIR_FALSE, AIR_FALSE, AIR_FALSE, AIR_FALSE, AIR_FALSE, AIR_FALSE,
+ AIR_TRUE, AIR_TRUE, AIR_TRUE, AIR_TRUE, AIR_TRUE, AIR_TRUE, AIR_TRUE
+};
+
+airEnum
+_airBool = {
+ "boolean",
+ 2,
+ _airBoolStr,
+ _airBoolVal,
+ _airBoolDesc,
+ _airBoolStrEqv,
+ _airBoolValEqv,
+ AIR_FALSE
+};
+
+airEnum *
+airBool = &_airBool;
+
+double
+airAtod(const char *str) {
+ double val = 0.0;
+
+ airSingleSscanf(str, "%lf", &val);
+ return val;
+}
+
+int
+airSingleSscanf(const char *str, const char *fmt, void *ptr) {
+ char *tmp;
+ double val;
+ int ret;
+
+ if (!strcmp(fmt, "%e") || !strcmp(fmt, "%f") || !strcmp(fmt, "%g")
+ || !strcmp(fmt, "%le") || !strcmp(fmt, "%lf") || !strcmp(fmt, "%lg")) {
+ tmp = airStrdup(str);
+ if (!tmp) {
+ return 0;
+ }
+ airToLower(tmp);
+ if (strstr(tmp, "nan")) {
+ val = AIR_NAN;
+ }
+ else if (strstr(tmp, "-inf")) {
+ val = AIR_NEG_INF;
+ }
+ else if (strstr(tmp, "inf")) {
+ val = AIR_POS_INF;
+ }
+ else {
+ /* nothing special matched; pass it off to sscanf() */
+ ret = sscanf(str, fmt, ptr);
+ free(tmp);
+ return ret;
+ }
+ /* else we matched "nan", "-inf", or "inf", and set val accordingly */
+ if (!strncmp(fmt, "%l", 2)) {
+ /* we were given a double pointer */
+ *((double *)(ptr)) = val;
+ }
+ else {
+ /* we were given a float pointer */
+ *((float *)(ptr)) = (float)val;
+ }
+ free(tmp);
+ return 1;
+ }
+ else {
+ /* this is neither a float nor double */
+ return sscanf(str, fmt, ptr);
+ }
+}
+
+#define _PARSE_STR_ARGS(type) type *out, const char *_s, \
+ const char *ct, unsigned int n, ...
+#define _PARSE_STR_BODY(format) \
+ unsigned int i; \
+ char *tmp, *s, *last; \
+ \
+ /* if we got NULL, there's nothing to do */ \
+ if (!(out && _s && ct)) \
+ return 0; \
+ \
+ /* copy the input so that we don't change it */ \
+ s = airStrdup(_s); \
+ \
+ /* keep calling airStrtok() until we have everything */ \
+ for (i=0; i<n; i++) { \
+ tmp = airStrtok(i ? NULL : s, ct, &last); \
+ if (!tmp) { \
+ free(s); \
+ return i; \
+ } \
+ if (1 != airSingleSscanf(tmp, format, out+i)) { \
+ free(s); \
+ return i; \
+ } \
+ } \
+ free(s); \
+ return n; \
+
+/*
+******* airParse*()
+**
+** parse ints, floats, doubles, or single characters, from some
+** given string "s"; try to parse "n" of them, as delimited by
+** characters in "ct", and put the results in "out".
+**
+** Returns the number of things succesfully parsed- should be n;
+** there's been an error if return is < n.
+**
+** The embarrassing reason for the var-args ("...") is that I want the
+** type signature of all these functions to be the same, and I have a function
+** for parsing airEnums, in case the airEnum must be supplied as a final
+** argument.
+**
+** This uses air's thread-safe strtok() replacement: airStrtok()
+*/
+unsigned int
+airParseStrI(_PARSE_STR_ARGS(int)) { _PARSE_STR_BODY("%d") }
+
+unsigned int
+airParseStrUI(_PARSE_STR_ARGS(unsigned int)) { _PARSE_STR_BODY("%u") }
+
+unsigned int
+airParseStrZ(_PARSE_STR_ARGS(size_t)) { _PARSE_STR_BODY(_AIR_SIZE_T_CNV) }
+
+unsigned int
+airParseStrF(_PARSE_STR_ARGS(float)) { _PARSE_STR_BODY("%f") }
+
+unsigned int
+airParseStrD(_PARSE_STR_ARGS(double)) { _PARSE_STR_BODY("%lf") }
+
+unsigned int
+airParseStrB(int *out, const char *_s, const char *ct, unsigned int n, ...) {
+ unsigned int i;
+ char *tmp, *s, *last;
+
+ /* if we got NULL, there's nothing to do */
+ if (!(out && _s && ct))
+ return 0;
+
+ /* copy the input so that we don't change it */
+ s = airStrdup(_s);
+
+ /* keep calling airStrtok() until we have everything */
+ for (i=0; i<n; i++) {
+ tmp = airStrtok(i ? NULL : s, ct, &last);
+ if (!tmp) {
+ free(s);
+ return i;
+ }
+ out[i] = airEnumVal(airBool, tmp);
+ if (airEnumUnknown(airBool) == out[i]) {
+ free(s);
+ return i;
+ }
+ }
+ free(s);
+ return n;
+}
+
+unsigned int
+airParseStrC(char *out, const char *_s, const char *ct, unsigned int n, ...) {
+ unsigned int i;
+ char *tmp, *s, *last;
+
+ /* if we got NULL, there's nothing to do */
+ if (!(out && _s && ct))
+ return 0;
+
+ /* copy the input so that we don't change it */
+ s = airStrdup(_s);
+
+ /* keep calling airStrtok() until we have everything */
+ for (i=0; i<n; i++) {
+ tmp = airStrtok(i ? NULL : s, ct, &last);
+ if (!tmp) {
+ free(s);
+ return i;
+ }
+ out[i] = tmp[0];
+ }
+ free(s);
+ return n;
+}
+
+unsigned int
+airParseStrS(char **out, const char *_s, const char *ct, unsigned int n, ...) {
+ unsigned int i;
+ int greedy;
+ char *tmp, *s, *last;
+ airArray *mop;
+ va_list ap;
+
+ /* grab "greedy" every time, prior to error checking */
+ va_start(ap, n);
+ greedy = va_arg(ap, int);
+ va_end(ap);
+
+ /* if we got NULL, there's nothing to do */
+ if (!(out && _s && ct))
+ return 0;
+
+ mop = airMopNew();
+ /* copy the input so that we don't change it */
+ s = airStrdup(_s);
+ airMopMem(mop, &s, airMopAlways);
+
+ /* keep calling airStrtok() until we have everything */
+ for (i=0; i<n; i++) {
+ /* if n == 1, then with greediness, the whole string is used,
+ and without greediness, we use airStrtok() to get only
+ the first part of it */
+ if (n > 1 || !greedy) {
+ tmp = airStrtok(i ? NULL : s, ct, &last);
+ }
+ else {
+ tmp = s;
+ }
+ if (!tmp) {
+ airMopError(mop);
+ return i;
+ }
+ out[i] = airStrdup(tmp);
+ if (!out[i]) {
+ airMopError(mop);
+ return i;
+ }
+ airMopMem(mop, out+i, airMopOnError);
+ }
+ airMopOkay(mop);
+ return n;
+}
+
+unsigned int
+airParseStrE(int *out, const char *_s, const char *ct, unsigned int n, ...) {
+ unsigned int i;
+ char *tmp, *s, *last;
+ airArray *mop;
+ va_list ap;
+ airEnum *enm;
+
+ /* grab the enum every time, prior to error checking */
+ va_start(ap, n);
+ enm = va_arg(ap, airEnum *);
+ va_end(ap);
+
+ /* if we got NULL, there's nothing to do */
+ if (!(out && _s && ct)) {
+ return 0;
+ }
+
+ mop = airMopNew();
+ /* copy the input so that we don't change it */
+ s = airStrdup(_s);
+ airMopMem(mop, &s, airMopAlways);
+
+ if (1 == n) {
+ /* Because it should be permissible to have spaces in what is
+ intended to be only a single string from an airEnum, we treat
+ 1==n differently, and do NOT use airStrtok to tokenize the
+ input string s into spaces. We check the whole s string */
+ out[0] = airEnumVal(enm, s);
+ if (airEnumUnknown(enm) == out[0]) {
+ airMopError(mop);
+ return 0;
+ }
+ } else {
+ /* keep calling airStrtok() until we have everything */
+ for (i=0; i<n; i++) {
+ tmp = airStrtok(i ? NULL : s, ct, &last);
+ if (!tmp) {
+ airMopError(mop);
+ return i;
+ }
+ out[i] = airEnumVal(enm, tmp);
+ if (airEnumUnknown(enm) == out[i]) {
+ airMopError(mop);
+ return i;
+ }
+ }
+ }
+ airMopOkay(mop);
+ return n;
+}
+
+unsigned int
+(*airParseStr[AIR_TYPE_MAX+1])(void *, const char *,
+ const char *, unsigned int, ...) = {
+ NULL,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrB,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrI,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrUI,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrZ,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrF,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrD,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrC,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrS,
+ (unsigned int (*)(void *, const char *, const char *,
+ unsigned int, ...))airParseStrE,
+ NULL /* no standard way of parsing type "other" */
+};
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/parseNrrd.c b/Utilities/ITK/Utilities/NrrdIO/parseNrrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..ca5cec91fb6e825c17685e8bf5ecbdfc4cdb8e38
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/parseNrrd.c
@@ -0,0 +1,1360 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+** _nrrdReadNrrdParseField()
+**
+** This is for parsing the stuff BEFORE the colon
+*/
+int
+_nrrdReadNrrdParseField (NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParseField", err[AIR_STRLEN_MED], *next,
+ *buff, *colon, *keysep;
+ int ret, fld=nrrdField_unknown, noField, badField=AIR_FALSE;
+
+ next = nio->line + nio->pos;
+
+ /* determining if the line is a comment is simple */
+ if (NRRD_COMMENT_CHAR == next[0]) {
+ return nrrdField_comment;
+ }
+
+ if (!( buff = airStrdup(next) )) {
+ sprintf(err, "%s: couldn't allocate buffer!", me);
+ biffMaybeAdd(NRRD, err, useBiff); return nrrdField_unknown;
+ }
+
+ /* #1: "...if you see a colon, then look for an equal sign..." */
+
+ /* Look for colon: if no colon, or failed to parse as a field, look for
+ * equal sign, if that failed then error */
+
+ /* Let the separator be := */
+ /* Escape \n */
+
+ colon = strstr(buff, ": ");
+ noField = !colon;
+ if (colon) {
+ *colon = '\0';
+ badField = ( nrrdField_unknown == (fld = airEnumVal(nrrdField, buff)) );
+ }
+ if (noField || badField) {
+ keysep = strstr(buff, ":=");
+ if (!keysep) {
+ if (noField) {
+ sprintf(err, "%s: didn't see \": \" or \":=\" in line", me);
+ } else {
+ sprintf(err, "%s: failed to parse \"%s\" as field identifier",
+ me, buff);
+ }
+ free(buff); biffMaybeAdd(NRRD, err, useBiff); return nrrdField_unknown;
+ }
+
+ free(buff);
+ ret = nrrdField_keyvalue;
+ } else {
+
+ /* *colon = '\0'; */
+ /* else we successfully parsed a field identifier */
+ next += strlen(buff) + 2;
+ free(buff);
+
+ /* skip whitespace prior to start of first field descriptor */
+ next += strspn(next, _nrrdFieldSep);
+ nio->pos = next - nio->line;
+
+ ret = fld;
+ }
+ return ret;
+}
+
+/*
+** NOTE: it is a common but unfortunate property of these parsers that
+** they set values in the nrrd first, and then check their validity
+** later. The reason for this is mostly the desire to centralize
+** validity checking in one place, and right now that's in the
+** _nrrdFieldCheck[] array of checkers
+*/
+
+int
+_nrrdReadNrrdParse_nonfield (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ AIR_UNUSED(useBiff);
+ /*
+ char c;
+
+ c= 10; write(2,&c,1); c= 69; write(2,&c,1); c=108; write(2,&c,1);
+ c= 32; write(2,&c,1); c= 67; write(2,&c,1); c=104; write(2,&c,1);
+ c=101; write(2,&c,1); c= 32; write(2,&c,1); c= 86; write(2,&c,1);
+ c=105; write(2,&c,1); c=118; write(2,&c,1); c=101; write(2,&c,1);
+ c= 33; write(2,&c,1); c= 10; write(2,&c,1); c= 10; write(2,&c,1);
+ */
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_comment (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_comment", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ /* this skips the '#' at nio->line[nio->pos] and any other ' ' and '#' */
+ if (nrrdCommentAdd(nrrd, info)) {
+ sprintf(err, "%s: trouble adding comment", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_content (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_content", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ if (strlen(info) && !(nrrd->content = airStrdup(info))) {
+ sprintf(err, "%s: couldn't strdup() content", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_number (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ /*
+ char me[]="_nrrdReadNrrdParse_number", err[AIR_STRLEN_MED];
+ char *info;
+
+ info = nio->line + nio->pos;
+ if (1 != sscanf(info, NRRD_BIG_INT_PRINTF, &(nrrd->num))) {
+ sprintf(err, "%s: couldn't parse number \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ */
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ AIR_UNUSED(useBiff);
+ /* It was decided to just completely ignore this field. "number" is
+ ** entirely redundant with the (required) sizes field, and there no
+ ** need to save it to, or learn it from, the header. In fact the "num"
+ ** field was eliminated from the Nrrd struct some time ago, in favor of
+ ** the nrrdElementNumber() function. It may seem odd or unfortunate that
+ **
+ ** number: Hank Hill sells propane and propane accessories
+ **
+ ** is a valid field specification, but at least Peggy is proud ...
+ */
+
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_type (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_type", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ if (!(nrrd->type = airEnumVal(nrrdType, info))) {
+ sprintf(err, "%s: couldn't parse type \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_type](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+#define _PARSE_ONE_VAL(FIELD, CONV, TYPE) \
+ if (1 != sscanf(info, CONV, &(FIELD))) { \
+ sprintf(err, "%s: couldn't parse " TYPE " from \"%s\"", me, info); \
+ biffMaybeAdd(NRRD, err, useBiff); return 1; \
+ }
+
+int
+_nrrdReadNrrdParse_block_size (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_block_size", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nrrd->blockSize, _AIR_SIZE_T_CNV, "size_t");
+ /* because blockSize and type fields may appear in any order,
+ we can't use _nrrdFieldCheck[] */
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_dimension (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_dimension", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nrrd->dim, "%u", "unsigned int");
+ if (_nrrdFieldCheck[nrrdField_dimension](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+/*
+** checking nrrd->dim against zero is valid because it is initialized
+** to zero, and, _nrrdReadNrrdParse_dimension() won't allow it to be
+** set to anything outside the range [1, NRRD_DIM_MAX]
+*/
+#define _CHECK_HAVE_DIM \
+ if (0 == nrrd->dim) { \
+ sprintf(err, "%s: don't yet have a valid dimension", me); \
+ biffMaybeAdd(NRRD, err, useBiff); return 1; \
+ }
+
+#define _CHECK_HAVE_SPACE_DIM \
+ if (0 == nrrd->spaceDim) { \
+ sprintf(err, "%s: don't yet have a valid space dimension", me); \
+ biffMaybeAdd(NRRD, err, useBiff); return 1; \
+ }
+
+#define _CHECK_GOT_ALL_VALUES \
+ if (nrrd->dim != ret) { \
+ sprintf(err, "%s: parsed %d values, but dimension is %d", \
+ me, ret, nrrd->dim); \
+ biffMaybeAdd(NRRD, err, useBiff); return 1; \
+ }
+
+int
+_nrrdReadNrrdParse_sizes (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_sizes", err[AIR_STRLEN_MED];
+ unsigned int ret;
+ size_t val[NRRD_DIM_MAX];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ ret = airParseStrZ(val, info, _nrrdFieldSep, nrrd->dim);
+ _CHECK_GOT_ALL_VALUES;
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoSize, val);
+ /* HEY: this is a very imperfect check of excess info */
+ if (nrrd->dim+1 == airParseStrZ(val, info, _nrrdFieldSep, nrrd->dim+1)) {
+ sprintf(err, "%s: seem to have more than expected %d sizes",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_sizes](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_spacings (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_spacings", err[AIR_STRLEN_MED];
+ unsigned int ret;
+ double val[NRRD_DIM_MAX];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ ret = airParseStrD(val, info, _nrrdFieldSep, nrrd->dim);
+ _CHECK_GOT_ALL_VALUES;
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoSpacing, val);
+ /* HEY: this is a very imperfect check of excess info */
+ if (nrrd->dim+1 == airParseStrD(val, info, _nrrdFieldSep, nrrd->dim+1)) {
+ sprintf(err, "%s: seem to have more than expected %d spacings",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_spacings](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_thicknesses (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_thicknesses", err[AIR_STRLEN_MED];
+ unsigned int ret;
+ double val[NRRD_DIM_MAX];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ ret = airParseStrD(val, info, _nrrdFieldSep, nrrd->dim);
+ _CHECK_GOT_ALL_VALUES;
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoThickness, val);
+ /* HEY: this is a very imperfect check of excess info */
+ if (nrrd->dim+1 == airParseStrD(val, info, _nrrdFieldSep, nrrd->dim+1)) {
+ sprintf(err, "%s: seem to have more than expected %d thicknesses",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_thicknesses](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_axis_mins (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_axis_mins", err[AIR_STRLEN_MED];
+ unsigned int ret;
+ double val[NRRD_DIM_MAX];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ ret = airParseStrD(val, info, _nrrdFieldSep, nrrd->dim);
+ _CHECK_GOT_ALL_VALUES;
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoMin, val);
+ /* HEY: this is a very imperfect check of excess info */
+ if (nrrd->dim+1 == airParseStrD(val, info, _nrrdFieldSep, nrrd->dim+1)) {
+ sprintf(err, "%s: seem to have more than expected %d axis mins",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_axis_mins](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_axis_maxs (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_axis_maxs", err[AIR_STRLEN_MED];
+ unsigned int ret;
+ double val[NRRD_DIM_MAX];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ ret = airParseStrD(val, info, _nrrdFieldSep, nrrd->dim);
+ _CHECK_GOT_ALL_VALUES;
+ nrrdAxisInfoSet_nva(nrrd, nrrdAxisInfoMax, val);
+ /* HEY: this is a very imperfect check of excess info */
+ if (nrrd->dim+1 == airParseStrD(val, info, _nrrdFieldSep, nrrd->dim+1)) {
+ sprintf(err, "%s: seem to have more than expected %d axis maxs",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_axis_maxs](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdSpaceVectorParse(double val[NRRD_SPACE_DIM_MAX],
+ char **hhP, unsigned int spaceDim, int useBiff) {
+ char me[]="_nrrdSpaceVectorParse", err[AIR_STRLEN_MED],
+ *hh, *buff, sep[]=",)";
+ airArray *mop;
+ unsigned int ret, dd, length;
+
+ mop = airMopNew();
+
+ hh = *hhP;
+ /* skip past space */
+ length = strspn(hh, _nrrdFieldSep);
+ hh += length;
+
+ /* make sure we have something */
+ if (!*hh) {
+ sprintf(err, "%s: hit end of string before seeing (", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ /* first, see if we're getting the non-vector */
+ if ( (strstr(hh, _nrrdNoSpaceVector) == hh) ) {
+ if (!hh[strlen(_nrrdNoSpaceVector)]
+ || strchr(_nrrdFieldSep, hh[strlen(_nrrdNoSpaceVector)])) {
+ /* yes, we got the non-vector */
+ for (dd=0; dd<spaceDim; dd++) {
+ val[dd] = AIR_NAN;
+ }
+ length += strlen(_nrrdNoSpaceVector);
+ } else {
+ /* we got something that started out looking like the non-vector */
+ sprintf(err, "%s: couldn't parse non-vector \"%s\"", me, hh);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ } else {
+ /* this isn't a non-vector */
+ /* make sure we have an open paren */
+ if ('(' != *hh) {
+ sprintf(err, "%s: first vector in \"%s\" didn't start with '('", me, hh);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ /* copy string (including open paren) for local fiddling */
+ if (!(buff = airStrdup(hh))) {
+ sprintf(err, "%s: couldn't allocate local buffer", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ airMopAdd(mop, buff, airFree, airMopAlways);
+ /* scan for close paren */
+ hh = buff+1;
+ while (*hh) {
+ if (')' == *hh) {
+ break;
+ } else {
+ hh++;
+ }
+ }
+ if (')' != *hh) {
+ sprintf(err, "%s: didn't see ')' at end of first vector in \"%s\"",
+ me, hh);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ /* terminate at end paren */
+ *(hh+1) = 0;
+ length += strlen(buff);
+ /* see if we have too many fields */
+ ret = airStrntok(buff+1, sep);
+ if (ret > spaceDim) {
+ sprintf(err, "%s: space dimension is %d, but seem to have %d "
+ "coefficients", me, spaceDim, ret);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ /* try to parse the values */
+ ret = airParseStrD(val, buff+1, ",", spaceDim);
+ if (spaceDim != ret) {
+ sprintf(err, "%s: parsed %d values, but space dimension is %d",
+ me, ret, spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ }
+ /* probably not useful */
+ for (dd=spaceDim; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ val[dd] = AIR_NAN;
+ }
+ /* make sure all coefficients exist or not together */
+ for (dd=1; dd<spaceDim; dd++) {
+ if (!!AIR_EXISTS(val[0]) ^ !!AIR_EXISTS(val[dd])) {
+ sprintf(err, "%s: existance of all space vector coefficients must "
+ "be consistent (val[0] not like val[%d])", me, dd);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ }
+ for (dd=0; dd<spaceDim; dd++) {
+ if (airIsInf_d(val[dd])) {
+ sprintf(err, "%s: vector coefficient %d can't be infinite", me, dd);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ }
+ *hhP += length;
+ airMopOkay(mop);
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_space_directions (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_space_directions", err[AIR_STRLEN_MED];
+ unsigned int dd;
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _CHECK_HAVE_DIM;
+ _CHECK_HAVE_SPACE_DIM;
+
+ for (dd=0; dd<nrrd->dim; dd++) {
+ if (_nrrdSpaceVectorParse(nrrd->axis[dd].spaceDirection,
+ &info, nrrd->spaceDim, useBiff)) {
+ sprintf(err, "%s: trouble getting space vector %d of %d",
+ me, dd+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (strlen(info) != strspn(info, _nrrdFieldSep)) {
+ sprintf(err, "%s: seem to have more than expected %d directions",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_space_directions](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_centers (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_centers", err[AIR_STRLEN_MED];
+ unsigned int ai;
+ char *tok, *info, *last;
+ airArray *mop;
+
+ AIR_UNUSED(file);
+ mop = airMopNew();
+ info = airStrdup(nio->line + nio->pos);
+ airMopAdd(mop, info, airFree, airMopAlways);
+ _CHECK_HAVE_DIM;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ tok = airStrtok(!ai ? info : NULL, _nrrdFieldSep, &last);
+ if (!tok) {
+ sprintf(err, "%s: couldn't extract string for center %d of %d",
+ me, ai+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if (!strcmp(tok, NRRD_UNKNOWN)) {
+ nrrd->axis[ai].center = nrrdCenterUnknown;
+ continue;
+ }
+ if (!strcmp(tok, NRRD_NONE)) {
+ nrrd->axis[ai].center = nrrdCenterUnknown;
+ continue;
+ }
+ if (!(nrrd->axis[ai].center = airEnumVal(nrrdCenter, tok))) {
+ sprintf(err, "%s: couldn't parse center \"%s\" for axis %d",
+ me, tok, ai);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ }
+ if (airStrtok(!ai ? info : NULL, _nrrdFieldSep, &last)) {
+ sprintf(err, "%s: seem to have more than expected %d centers",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_centers](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ airMopOkay(mop);
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_kinds (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_kinds", err[AIR_STRLEN_MED];
+ unsigned int ai;
+ char *info, *tok, *last;
+ airArray *mop;
+
+ AIR_UNUSED(file);
+ mop = airMopNew();
+ info = airStrdup(nio->line + nio->pos);
+ airMopAdd(mop, info, airFree, airMopAlways);
+ _CHECK_HAVE_DIM;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ tok = airStrtok(!ai ? info : NULL, _nrrdFieldSep, &last);
+ if (!tok) {
+ sprintf(err, "%s: couldn't extract string for kind %d of %d",
+ me, ai+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if (!strcmp(tok, NRRD_UNKNOWN)) {
+ nrrd->axis[ai].kind = nrrdKindUnknown;
+ continue;
+ }
+ if (!strcmp(tok, NRRD_NONE)) {
+ nrrd->axis[ai].center = nrrdKindUnknown;
+ continue;
+ }
+ if (!(nrrd->axis[ai].kind = airEnumVal(nrrdKind, tok))) {
+ sprintf(err, "%s: couldn't parse \"%s\" kind %d of %d",
+ me, tok, ai+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ }
+ if (airStrtok(!ai ? info : NULL, _nrrdFieldSep, &last)) {
+ sprintf(err, "%s: seem to have more than expected %d kinds",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ /* can't run this now because kinds can come before sizes, in which
+ case the kind/size check in _nrrdFieldCheck_kinds will incorrectly
+ flag an error ...
+ if (_nrrdFieldCheck[nrrdField_kinds](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ */
+ airMopOkay(mop);
+ return 0;
+}
+
+typedef union {
+ char **c;
+ void **v;
+} _chpu;
+
+char *
+_nrrdGetQuotedString(char **hP, int useBiff) {
+ char me[]="_nrrdGetQuotedString", err[AIR_STRLEN_MED], *h, *buff, *ret;
+ airArray *buffArr;
+ int pos;
+ _chpu uu;
+
+ h = *hP;
+ /* skip past space */
+ /* printf("!%s: h |%s|\n", me, h);*/
+ h += strspn(h, _nrrdFieldSep);
+ /* printf("!%s: h |%s|\n", me, h);*/
+
+ /* make sure we have something */
+ if (!*h) {
+ sprintf(err, "%s: hit end of string before seeing opening \"", me);
+ biffMaybeAdd(NRRD, err, useBiff); return NULL;
+ }
+ /* make sure we have a starting quote */
+ if ('"' != *h) {
+ sprintf(err, "%s: didn't start with \"", me);
+ biffMaybeAdd(NRRD, err, useBiff); return NULL;
+ }
+ h++;
+
+ /* parse string until end quote */
+ buff = NULL;
+ uu.c = &buff;
+ buffArr = airArrayNew(uu.v, NULL, sizeof(char), 2);
+ if (!buffArr) {
+ sprintf(err, "%s: couldn't create airArray", me);
+ biffMaybeAdd(NRRD, err, useBiff); return NULL;
+ }
+ pos = airArrayLenIncr(buffArr, 1); /* pos should get 0 */
+ while (h[pos]) {
+ /* printf("!%s: h+%d |%s|\n", me, pos, h+pos); */
+ if ('\"' == h[pos]) {
+ break;
+ }
+ if ('\\' == h[pos] && '\"' == h[pos+1]) {
+ h += 1;
+ }
+ buff[pos] = h[pos];
+ pos = airArrayLenIncr(buffArr, 1);
+ }
+ if ('\"' != h[pos]) {
+ sprintf(err, "%s: didn't see ending \" soon enough", me);
+ biffMaybeAdd(NRRD, err, useBiff); return NULL;
+ }
+ h += pos + 1;
+ buff[pos] = 0;
+
+ ret = airStrdup(buff);
+ airArrayNuke(buffArr);
+ *hP = h;
+
+ return ret;
+}
+
+int
+_nrrdReadNrrdParse_labels (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_labels", err[AIR_STRLEN_MED];
+ char *h; /* this is the "here" pointer which gradually progresses
+ through all the labels (for all axes) */
+ unsigned int ai;
+ char *info;
+
+ AIR_UNUSED(file);
+ /* because we have to correctly interpret quote marks, we
+ can't simply rely on airParseStrS */
+ info = nio->line + nio->pos;
+ /* printf("!%s: info |%s|\n", me, info); */
+ _CHECK_HAVE_DIM;
+ h = info;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (!( nrrd->axis[ai].label = _nrrdGetQuotedString(&h, useBiff) )) {
+ sprintf(err, "%s: couldn't get get label %d of %d\n",
+ me, ai+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (strlen(h) != strspn(h, _nrrdFieldSep)) {
+ sprintf(err, "%s: seem to have more than expected %d labels",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_labels](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_units (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_units", err[AIR_STRLEN_MED];
+ char *h; /* this is the "here" pointer which gradually progresses
+ through all the units (for all axes) */
+ unsigned int ai;
+ char *info;
+
+ AIR_UNUSED(file);
+ /* because we have to correctly interpret quote marks, we
+ can't simply rely on airParseStrS */
+ info = nio->line + nio->pos;
+ /* printf("!%s: info |%s|\n", me, info); */
+ _CHECK_HAVE_DIM;
+ h = info;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (!( nrrd->axis[ai].units = _nrrdGetQuotedString(&h, useBiff) )) {
+ sprintf(err, "%s: couldn't get get unit %d of %d\n",
+ me, ai+1, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (strlen(h) != strspn(h, _nrrdFieldSep)) {
+ sprintf(err, "%s: seem to have more than expected %d units",
+ me, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_units](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_min (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ AIR_UNUSED(useBiff);
+
+ /* This field is no longer assumed to be anything meaningful,
+ because nrrd->min no longer exists with the advent of NrrdRange.
+ But, having the field is not an error, to not trip on older
+ NRRD00.01 and NRRD0001 files which (legitimately) used it */
+
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_max (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(nio);
+ AIR_UNUSED(useBiff);
+
+ /* nrrd->max no longer exists, see above */
+
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_old_min (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_old_min", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nrrd->oldMin, "%lg", "double");
+ if (_nrrdFieldCheck[nrrdField_old_min](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_old_max (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_old_max", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nrrd->oldMax, "%lg", "double");
+ if (_nrrdFieldCheck[nrrdField_old_max](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_endian (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_endian", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ info = nio->line + nio->pos;
+ if (!(nio->endian = airEnumVal(airEndian, info))) {
+ sprintf(err, "%s: couldn't parse endian \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_encoding (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_encoding", err[AIR_STRLEN_MED];
+ char *info;
+ int etype;
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ info = nio->line + nio->pos;
+ if (!(etype = airEnumVal(nrrdEncodingType, info))) {
+ sprintf(err, "%s: couldn't parse encoding \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+
+ nio->encoding = nrrdEncodingArray[etype];
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_line_skip (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_line_skip", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nio->lineSkip, "%u", "unsigned int");
+ /* now that its unsigned, what error checking can I do?
+ if (!(0 <= nio->lineSkip)) {
+ sprintf(err, "%s: lineSkip value %d invalid", me, nio->lineSkip);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ */
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_byte_skip (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_byte_skip", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ AIR_UNUSED(nrrd);
+ info = nio->line + nio->pos;
+ _PARSE_ONE_VAL(nio->byteSkip, "%d", "int");
+ if (!(-1 <= nio->byteSkip)) {
+ sprintf(err, "%s: byteSkip value %d invalid", me, nio->byteSkip);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_keyvalue (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_keyvalue", err[AIR_STRLEN_MED];
+ char *keysep, *line, *key, *value;
+
+ AIR_UNUSED(file);
+ /* we know this will find something */
+ line = airStrdup(nio->line);
+ if (!line) {
+ sprintf(err, "%s: can't allocate parse line", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ keysep = strstr(line, ":=");
+ if (!keysep) {
+ sprintf(err, "%s: didn't see \":=\" key/value delimiter in \"%s\"",
+ me, line);
+ free(line); biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ keysep[0] = 0;
+ keysep[1] = 0;
+ key = line;
+ value = keysep+2;
+
+ /* convert escape sequences */
+ airUnescape(key);
+ airUnescape(value);
+
+ nrrdKeyValueAdd(nrrd, key, value);
+
+ free(line);
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_sample_units (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_sample_units", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+
+ if (strlen(info) && !(nrrd->sampleUnits = airStrdup(info))) {
+ sprintf(err, "%s: couldn't strdup() sampleUnits", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_sample_units](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_space (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_space", err[AIR_STRLEN_MED], *info;
+ int space;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ if (nio->seen[nrrdField_space_dimension]) {
+ sprintf(err, "%s: can't specify space after specifying "
+ "space dimension (%d)", me, nrrd->spaceDim);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!(space = airEnumVal(nrrdSpace, info))) {
+ sprintf(err, "%s: couldn't parse space \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (nrrdSpaceSet(nrrd, space)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_space](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_space_dimension (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_space_dimension", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+ if (nio->seen[nrrdField_space]) {
+ sprintf(err, "%s: can't specify space dimension after specifying "
+ "space (%s)", me, airEnumStr(nrrdSpace, nrrd->space));
+ biffAdd(NRRD, err); return 1;
+ }
+ _PARSE_ONE_VAL(nrrd->spaceDim, "%d", "int");
+ if (_nrrdFieldCheck[nrrdField_space_dimension](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_space_units (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_space_units", err[AIR_STRLEN_MED];
+ char *h; /* this is the "here" pointer which gradually progresses
+ through all the units (for all axes) */
+ unsigned int ai;
+ char *info;
+
+ AIR_UNUSED(file);
+ /* because we have to correctly interpret quote marks, we
+ can't simply rely on airParseStrS */
+ info = nio->line + nio->pos;
+ /* printf("!%s: info |%s|\n", me, info); */
+ _CHECK_HAVE_SPACE_DIM;
+ h = info;
+ for (ai=0; ai<nrrd->spaceDim; ai++) {
+ if (!( nrrd->spaceUnits[ai] = _nrrdGetQuotedString(&h, useBiff) )) {
+ sprintf(err, "%s: couldn't get get space unit %d of %d",
+ me, ai+1, nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (_nrrdGetQuotedString(&h, AIR_FALSE)) {
+ sprintf(err, "%s: seemed to have more than expected %d space units",
+ me, nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_space_units](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_space_origin (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_space_origin", err[AIR_STRLEN_MED];
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+
+ _CHECK_HAVE_SPACE_DIM;
+
+ if (_nrrdSpaceVectorParse(nrrd->spaceOrigin, &info,
+ nrrd->spaceDim, useBiff)) {
+ sprintf(err, "%s: couldn't parse origin \"%s\"", me, info);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (_nrrdFieldCheck[nrrdField_space_origin](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdReadNrrdParse_measurement_frame (FILE *file, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_measurement_frame", err[AIR_STRLEN_MED];
+ double colvec[NRRD_SPACE_DIM_MAX];
+ unsigned int dd, ii;
+ char *info;
+
+ AIR_UNUSED(file);
+ info = nio->line + nio->pos;
+
+ _CHECK_HAVE_SPACE_DIM;
+
+ for (dd=0; dd<nrrd->spaceDim; dd++) {
+ /* we are going through the *columns* of the mf matrix */
+ if (_nrrdSpaceVectorParse(colvec, &info, nrrd->spaceDim, useBiff)) {
+ sprintf(err, "%s: trouble getting space vector %d of %d",
+ me, dd+1, nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ nrrd->measurementFrame[dd][ii] = (ii < nrrd->spaceDim
+ ? colvec[ii]
+ : AIR_NAN);
+ }
+ }
+ if (strlen(info) != strspn(info, _nrrdFieldSep)) {
+ sprintf(err, "%s: seem to have more than expected %d directions",
+ me, nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ for (dd=nrrd->spaceDim; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ nrrd->measurementFrame[dd][ii] = AIR_NAN;
+ }
+ }
+ if (_nrrdFieldCheck[nrrdField_measurement_frame](nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdContainsPercentDAndMore(char *str) {
+ char *hh, *tmp;
+
+ tmp = str;
+ do {
+ hh = strchr(tmp, '%');
+ if (!( hh && hh[1] )) {
+ return 0;
+ }
+ if ('%' == hh[1]) {
+ /* its an escaped % */
+ tmp = hh + 2;
+ } else {
+ break;
+ }
+ } while (tmp[0]);
+ hh++;
+ hh += strspn(hh, "0123456789");
+ if (!( hh[0] == 'd' )) {
+ return 0;
+ }
+ hh += strcspn(hh, _nrrdFieldSep);
+ return !!hh;
+}
+
+unsigned int
+_nrrdDataFNNumber(NrrdIoState *nio) {
+ int ii, ret;
+
+ if (nio->dataFNFormat) {
+ /* datafiles given in iterator form; count number of values */
+ ret = 0;
+ for (ii = nio->dataFNMin;
+ ((nio->dataFNStep > 0 && ii <= nio->dataFNMax)
+ || (nio->dataFNStep < 0 && ii >= nio->dataFNMax));
+ ii += nio->dataFNStep) {
+ ret += 1;
+ }
+ } else if (nio->dataFNArr->len) {
+ /* datafiles given as an explicit list, or as a single file name,
+ and in either case, nrrdDataFNAdd() is used to add them to
+ the dataFNArr */
+ ret = nio->dataFNArr->len;
+ } else {
+ /* datafile is same as (attached) header file */
+ ret = 1;
+ }
+ return ret;
+}
+
+int
+_nrrdDataFNCheck(NrrdIoState *nio, Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdDataFNCheck", err[AIR_STRLEN_MED];
+ size_t pieceSize, pieceNum;
+
+ if (nio->dataFileDim < nrrd->dim) {
+ _nrrdSplitSizes(&pieceSize, &pieceNum, nrrd, nio->dataFileDim);
+ if (pieceNum != _nrrdDataFNNumber(nio)) {
+ sprintf(err, "%s: expected %d filenames (of %d-D pieces) but got %d",
+ me, (int)pieceNum, nio->dataFileDim,
+ (int)_nrrdDataFNNumber(nio));
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ } else {
+ /* we're getting data in "slabs" with the same dimension as the
+ nrrd, so for simplicity we assume that they're all equal size */
+ if (_nrrdDataFNNumber(nio) > nrrd->axis[nrrd->dim-1].size) {
+ sprintf(err, "%s: can't have more pieces (%d) than axis %d "
+ "slices (" _AIR_SIZE_T_CNV ") when nrrd dimension and "
+ "datafile dimension are both %d", me,
+ (int)_nrrdDataFNNumber(nio),
+ nrrd->dim-1, nrrd->axis[nrrd->dim-1].size,
+ nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if ((double)nrrd->axis[nrrd->dim-1].size/_nrrdDataFNNumber(nio)
+ != nrrd->axis[nrrd->dim-1].size/_nrrdDataFNNumber(nio)) {
+ sprintf(err, "%s: number of datafiles (%d) doesn't divide into "
+ "number of axis %d slices (" _AIR_SIZE_T_CNV ")", me,
+ (int)_nrrdDataFNNumber(nio),
+ nrrd->dim-1, nrrd->axis[nrrd->dim-1].size);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+** Sat Jan 29 16:44:50 EST 2005: this used to "open the seperate
+** datafile, and set the FILE* in nio->dataFile, which otherwise will
+** stay NULL", but now we support multiple detached data files. So.
+**
+** The job of this function is to map the "data file" specification to
+** one or more filenames that can be passed direction to fopen for
+** reading in the data. This involves parsing the various formats for
+** identifying multiple data files, and possibly prefixing them with
+** nio->path.
+*/
+int
+_nrrdReadNrrdParse_data_file (FILE *ffile, Nrrd *nrrd,
+ NrrdIoState *nio, int useBiff) {
+ char me[]="_nrrdReadNrrdParse_data_file", err[AIR_STRLEN_MED];
+ char *info, *nums;
+ unsigned int linelen;
+ int tmp;
+ airArray *mop;
+
+ mop = airMopNew();
+ info = airStrdup(nio->line + nio->pos);
+ if (!info) {
+ sprintf(err, "%s: couldn't copy line!", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ airMopAdd(mop, info, airFree, airMopAlways);
+
+ if (_nrrdContainsPercentDAndMore(info)) {
+ /* ---------------------------------------------------------- */
+ /* --------- format.%d <min> <max> <step> [<dim>] ----------- */
+ /* ---------------------------------------------------------- */
+ nums = info + strcspn(info, _nrrdFieldSep);
+ tmp = strspn(nums, _nrrdFieldSep);
+ nums[0] = 0; /* terminate so that format is now in info */
+ nums += tmp;
+ if (!( 3 == sscanf(nums, "%d %d %d",&(nio->dataFNMin),
+ &(nio->dataFNMax), &(nio->dataFNStep)) )) {
+ sprintf(err, "%s: couldn't parse three ints (min, max, step) after "
+ "data filename template", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if ( 4 == sscanf(nums, "%d %d %d %d", &(nio->dataFNMin),
+ &(nio->dataFNMax), &(nio->dataFNStep),
+ &(nio->dataFileDim)) ) {
+ if (!( nio->dataFileDim >= 1 && nio->dataFileDim <= nrrd->dim )) {
+ sprintf(err, "%s: datafile dimension %d outside valid range [1,%d]",
+ me, nio->dataFileDim, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ } else {
+ nio->dataFileDim = nrrd->dim-1;
+ }
+ if (0 == nio->dataFNStep) {
+ sprintf(err, "%s: file number step must be non-zero", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if ((nio->dataFNMax - nio->dataFNMin)*(nio->dataFNStep) < 0) {
+ sprintf(err, "%s: file number max %d not approached from min %d "
+ "by step %d", me,
+ nio->dataFNMax, nio->dataFNMin, nio->dataFNStep);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if (!( nio->dataFNFormat = airStrdup(info) )) {
+ sprintf(err, "%s: couldn't copy data filename format", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ } else if (!strncmp(info, NRRD_LIST_FLAG, strlen(NRRD_LIST_FLAG))) {
+ /* ---------------------------------------------------------- */
+ /* ------------------------- LIST --------------------------- */
+ /* ---------------------------------------------------------- */
+ if (_nrrdHeaderCheck(nrrd, nio, AIR_TRUE)) {
+ sprintf(err, "%s: NRRD header is incomplete. \"" NRRD_LIST_FLAG
+ "\" data file specification must be contiguous with "
+ "end of header!", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ info += strlen(NRRD_LIST_FLAG);
+ if (info[0]) {
+ if (1 == sscanf(info, "%d", &(nio->dataFileDim))) {
+ if (!( nio->dataFileDim >= 1 && nio->dataFileDim <= nrrd->dim )) {
+ sprintf(err, "%s: datafile dimension %d outside valid range [1,%d]",
+ me, nio->dataFileDim, nrrd->dim);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ } else {
+ sprintf(err, "%s: couldn't parse info after \""
+ NRRD_LIST_FLAG "\" as an int", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ } else {
+ /* nothing after NRRD_LIST_FLAG, so dataFileDim is implicit */
+ nio->dataFileDim = nrrd->dim-1;
+ }
+ /* read in all the datafile names */
+ do {
+ /* yes, nio->line is re-used/over-written here, but I don't
+ think that's a problem */
+ if (_nrrdOneLine(&linelen, nio, ffile)) {
+ sprintf(err, "%s: trouble getting file name line", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ if (linelen > 0) {
+ tmp = airArrayLenIncr(nio->dataFNArr, 1);
+ nio->dataFN[tmp] = airStrdup(nio->line);
+ }
+ } while (linelen > 0);
+
+ } else {
+ /* ---------------------------------------------------------- */
+ /* -------------------- (single filename) ------------------- */
+ /* ---------------------------------------------------------- */
+ /* there is apparently only a single detached data file */
+ tmp = airArrayLenIncr(nio->dataFNArr, 1);
+ nio->dataFN[tmp] = airStrdup(info);
+ nio->dataFileDim = nrrd->dim;
+ }
+ if (_nrrdDataFNCheck(nio, nrrd, useBiff)) {
+ sprintf(err, "%s: trouble with number of datafiles", me);
+ biffMaybeAdd(NRRD, err, useBiff); airMopError(mop); return 1;
+ }
+ airMopOkay(mop);
+ return 0;
+}
+
+/*
+******** nrrdFieldInfoParse[NRRD_FIELD_MAX+1]()
+**
+** These are all for parsing the stuff AFTER the colon
+*/
+int
+(*nrrdFieldInfoParse[NRRD_FIELD_MAX+1])(FILE *, Nrrd *,
+ NrrdIoState *, int) = {
+ _nrrdReadNrrdParse_nonfield,
+ _nrrdReadNrrdParse_comment,
+ _nrrdReadNrrdParse_content,
+ _nrrdReadNrrdParse_number,
+ _nrrdReadNrrdParse_type,
+ _nrrdReadNrrdParse_block_size,
+ _nrrdReadNrrdParse_dimension,
+ _nrrdReadNrrdParse_space,
+ _nrrdReadNrrdParse_space_dimension,
+ _nrrdReadNrrdParse_sizes,
+ _nrrdReadNrrdParse_spacings,
+ _nrrdReadNrrdParse_thicknesses,
+ _nrrdReadNrrdParse_axis_mins,
+ _nrrdReadNrrdParse_axis_maxs,
+ _nrrdReadNrrdParse_space_directions,
+ _nrrdReadNrrdParse_centers,
+ _nrrdReadNrrdParse_kinds,
+ _nrrdReadNrrdParse_labels,
+ _nrrdReadNrrdParse_units,
+ _nrrdReadNrrdParse_min,
+ _nrrdReadNrrdParse_max,
+ _nrrdReadNrrdParse_old_min,
+ _nrrdReadNrrdParse_old_max,
+ _nrrdReadNrrdParse_endian,
+ _nrrdReadNrrdParse_encoding,
+ _nrrdReadNrrdParse_line_skip,
+ _nrrdReadNrrdParse_byte_skip,
+ _nrrdReadNrrdParse_keyvalue,
+ _nrrdReadNrrdParse_sample_units,
+ _nrrdReadNrrdParse_space_units,
+ _nrrdReadNrrdParse_space_origin,
+ _nrrdReadNrrdParse_measurement_frame,
+ _nrrdReadNrrdParse_data_file
+};
+
+/* kernel parsing is all in kernel.c */
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/pre-GNUmakefile b/Utilities/ITK/Utilities/NrrdIO/pre-GNUmakefile
new file mode 100644
index 0000000000000000000000000000000000000000..1055e82e56cfea5b1c98b99989c966fea1665fd8
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/pre-GNUmakefile
@@ -0,0 +1,140 @@
+#
+# NrrdIO: stand-alone code for basic nrrd functionality
+# Copyright (C) 2005 Gordon Kindlmann
+# Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+#
+# This software is provided 'as-is', without any express or implied
+# warranty. In no event will the authors be held liable for any
+# damages arising from the use of this software.
+#
+# Permission is granted to anyone to use this software for any
+# purpose, including commercial applications, and to alter it and
+# redistribute it freely, subject to the following restrictions:
+#
+# 1. The origin of this software must not be misrepresented; you must
+# not claim that you wrote the original software. If you use this
+# software in a product, an acknowledgment in the product
+# documentation would be appreciated but is not required.
+#
+# 2. Altered source versions must be plainly marked as such, and must
+# not be misrepresented as being the original software.
+#
+# 3. This notice may not be removed or altered from any source distribution.
+#
+
+### The process of creating the NrrdIO source distribution from a Teem
+### source distribution is automated, and is controlled by this GNU
+### makefile:
+###
+### for the NrrdIO in ITK:
+###
+### cvs update
+### rm -f itk_NrrdIO_mangle.h
+### touch itk_NrrdIO_mangle.h
+### make -f pre-GNUmakefile clean
+### setenv ITK_NRRDIO
+### make -f pre-GNUmakefile
+### unsetenv ITK_NRRDIO
+### make -f sample-GNUmakefile
+### perl mangle.pl itk >! itk_NrrdIO_mangle.h
+### make -f sample-GNUmakefile clean
+###
+### for the NrrdIO in Teem:
+###
+### cvs update
+### make -f pre-GNUmakefile clean
+### make -f pre-GNUmakefile
+### make -f sample-GNUmakefile
+### make -f sample-GNUmakefile clean
+###
+### This file is the single place where the required Teem source files
+### are listed. Once the NrrdIO source distribution is created, this
+### GNU makefile is completely moot. TEEM_SRC_ROOT must be set in order
+### to locate the Teem source. We use this instead of TEEM_ROOT to avoid
+### conflict with Teem's own make system
+
+$(if $(TEEM_SRC_ROOT),,\
+$(warning *)\
+$(warning * Environment variable TEEM_SRC_ROOT not set. This)\
+$(warning * needs to be set to the directory containing the)\
+$(warning * src and include directories of the Teem source)\
+$(warning * distribution.)\
+$(warning *)\
+$(error Make quitting))
+
+### The following sources are pretty much stubs, to create the symbols,
+### but not the functionality of different formats and the bzip2 encoding.
+### As such, they are NOT copied from Teem but are made for NrrdIO.
+###
+NEED_NOT = encodingBzip2.c formatEPS.c formatPNG.c formatPNM.c \
+ formatText.c formatVTK.c
+
+### These are still needed for exact same functionality as in Teem
+###
+TEEM_HDRS = $(addprefix teem/, \
+ teem32bit.h teemDio.h teemEndian.h teemPng.h teemQnanhibit.h)
+
+### NEED_{AIR,BIFF,NRRD}: the source files from teem that we need
+### NEED_HDRS: the headers that we need
+###
+NEED_AIR = $(addprefix air/, \
+ 754.c mop.c array.c parseAir.c dio.c \
+ sane.c endianAir.c string.c enum.c miscAir.c)
+NEED_BIFF = biff/biffbiff.c
+NEED_NRRD = $(addprefix nrrd/, \
+ accessors.c defaultsNrrd.c enumsNrrd.c arraysNrrd.c methodsNrrd.c \
+ reorder.c axis.c simple.c comment.c keyvalue.c endianNrrd.c \
+ parseNrrd.c gzio.c read.c write.c format.c formatNRRD.c \
+ encoding.c encodingRaw.c encodingAscii.c encodingHex.c encodingGzip.c \
+ subset.c)
+NEED_SRCS = $(NEED_AIR) $(NEED_BIFF) $(NEED_NRRD)
+NEED_PUB_HDRS = air/air.h biff/biff.h \
+ $(addprefix nrrd/, nrrdDefines.h nrrdEnums.h nrrdMacros.h nrrd.h)
+NEED_PRIV_HDRS = air/privateAir.h nrrd/privateNrrd.h
+
+### Building NrrdIO requires the teem*.h headers, and the processed sources
+### from air, biff, and nrrd
+###
+.PHONY: all
+all: $(TEEM_HDRS) $(NEED_SRCS) $(NEED_PRIV_HDRS) NrrdIO.h NrrdIO_Srcs.txt
+
+### NrrdIO.h is basically the result of cat'ing together all the
+### teem headers in $(NEED_HDRS), but we do need to "unteem" them.
+###
+$(NEED_PUB_HDRS) $(NEED_PRIV_HDRS):
+ tail +20 $(TEEM_SRC_ROOT)/src/$@ \
+ | perl unteem.pl \
+ | grep -v HAS_BEEN_INCLUDED > $(notdir $@)
+NrrdIO.h: $(NEED_PUB_HDRS)
+ cat preamble.c $(notdir $(NEED_PUB_HDRS)) > NrrdIO.h
+ rm -f $(notdir $(NEED_PUB_HDRS))
+
+### NrrdIO_Srcs.txt is a list of all the source files that must be
+### compiled together to create libNrrdIO
+###
+NrrdIO_Srcs.txt:
+ echo $(notdir $(NEED_SRCS)) $(NEED_NOT) > $@
+
+### The teem*.h headers: we need only change the pre-amble here
+###
+teem/%.h:
+ tail +20 $(TEEM_SRC_ROOT)/include/$(notdir $@) \
+ | cat preamble.c - > $(notdir $@)
+
+### The rest: by design, these targets have the library names as part
+### of the name (e.g. nrrd/simple.c) and that allows us to locate the
+### source file without any VPATH games
+###
+%.h %.c:
+ tail +20 $(TEEM_SRC_ROOT)/src/$@ \
+ | cat preamble.c - \
+ | perl unteem.pl \
+ | grep -v HAS_BEEN_INCLUDED > $(notdir $@)
+
+### To start from scratch
+###
+clean:
+ rm -f $(notdir $(TEEM_HDRS) $(NEED_SRCS) \
+ $(NEED_PUB_HDRS) $(NEED_PRIV_HDRS)) \
+ NrrdIO.h NrrdIO_Srcs.txt \
+ *.o libNrrdIO.a sampleIO
diff --git a/Utilities/ITK/Utilities/NrrdIO/preamble.c b/Utilities/ITK/Utilities/NrrdIO/preamble.c
new file mode 100644
index 0000000000000000000000000000000000000000..451ecf0043460785f8e5a5047742aa243a5d92dd
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/preamble.c
@@ -0,0 +1,23 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
diff --git a/Utilities/ITK/Utilities/NrrdIO/privateAir.h b/Utilities/ITK/Utilities/NrrdIO/privateAir.h
new file mode 100644
index 0000000000000000000000000000000000000000..83b69dfad826ed1fd178857e8b951e38da8afad6
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/privateAir.h
@@ -0,0 +1,60 @@
+
+#include "teemEndian.h"
+#include "teemQnanhibit.h"
+
+/* miscAir.c */
+extern double _airSanityHelper(double val);
+
+/*
+** _airFloat, _airDouble
+**
+** these unions facilitate converting amonst
+** i: unsigned integral type
+** c: (sign,exp,frac) triples of unsigned integral components
+** v: the floating point numbers these bit-patterns represent
+*/
+typedef union {
+ unsigned int i;
+ struct {
+#if TEEM_ENDIAN == 1234 /* little endian */
+ unsigned int mant : 23;
+ unsigned int expo : 8;
+ unsigned int sign : 1;
+#else /* big endian */
+ unsigned int sign : 1;
+ unsigned int expo : 8;
+ unsigned int mant : 23;
+#endif
+ } c;
+ float v;
+} _airFloat;
+
+typedef union {
+ airULLong i;
+ /* these next two members are used for printing in airFPFprintf_d */
+ struct { /* access to whole double as two unsigned ints */
+#if TEEM_ENDIAN == 1234
+ unsigned int half0 : 32;
+ unsigned int half1 : 32;
+#else
+ unsigned int half1 : 32;
+ unsigned int half0 : 32;
+#endif
+ } h;
+ struct { /* access to fraction with two unsigned ints */
+#if TEEM_ENDIAN == 1234 /* little endian */
+ unsigned int mant1 : 32;
+ unsigned int mant0 : 20;
+ unsigned int expo : 11;
+ unsigned int sign : 1;
+#else /* big endian */
+ unsigned int sign : 1;
+ unsigned int expo : 11;
+ unsigned int mant0 : 20;
+ unsigned int mant1 : 32;
+#endif
+ } c;
+ double v;
+} _airDouble;
+
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/privateNrrd.h b/Utilities/ITK/Utilities/NrrdIO/privateNrrd.h
new file mode 100644
index 0000000000000000000000000000000000000000..79c6253ab13e685760f0037391138ef73cb05f76
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/privateNrrd.h
@@ -0,0 +1,161 @@
+
+
+#ifdef _WIN32
+#include <io.h>
+#include <fcntl.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define _NRRD_TEXT_INCR 1024
+
+
+/*
+** _NRRD_SPACING
+**
+** returns nrrdDefSpacing if the argument doesn't exist, otherwise
+** returns the argument
+*/
+#define _NRRD_SPACING(spc) (AIR_EXISTS(spc) ? spc: nrrdDefSpacing)
+
+typedef union {
+ char **CP;
+ int *I;
+ unsigned int *UI;
+ size_t *ST;
+ double *D;
+ const void *P;
+ double (*V)[NRRD_SPACE_DIM_MAX];
+} _nrrdAxisInfoSetPtrs;
+
+typedef union {
+ char **CP;
+ int *I;
+ unsigned int *UI;
+ size_t *ST;
+ double *D;
+ void *P;
+ double (*V)[NRRD_SPACE_DIM_MAX];
+} _nrrdAxisInfoGetPtrs;
+
+/* keyvalue.c */
+extern int _nrrdKeyValueFwrite(FILE *file, const char *prefix,
+ const char *key, const char *value);
+
+/* formatXXX.c */
+extern const char *_nrrdFormatURLLine0;
+extern const char *_nrrdFormatURLLine1;
+extern const NrrdFormat _nrrdFormatNRRD;
+extern const NrrdFormat _nrrdFormatPNM;
+extern const NrrdFormat _nrrdFormatPNG;
+extern const NrrdFormat _nrrdFormatVTK;
+extern const NrrdFormat _nrrdFormatText;
+extern const NrrdFormat _nrrdFormatEPS;
+extern int _nrrdHeaderCheck(Nrrd *nrrd, NrrdIoState *nio, int checkSeen);
+extern int _nrrdFormatNRRD_whichVersion(const Nrrd *nrrd, NrrdIoState *nio);
+
+/* encodingXXX.c */
+extern const NrrdEncoding _nrrdEncodingRaw;
+extern const NrrdEncoding _nrrdEncodingAscii;
+extern const NrrdEncoding _nrrdEncodingHex;
+extern const NrrdEncoding _nrrdEncodingGzip;
+extern const NrrdEncoding _nrrdEncodingBzip2;
+
+/* read.c */
+extern int _nrrdOneLine (unsigned int *lenP, NrrdIoState *nio, FILE *file);
+extern int _nrrdCalloc (Nrrd *nrrd, NrrdIoState *nio, FILE *file);
+extern char _nrrdFieldSep[];
+
+/* arrays.c */
+extern const int _nrrdFieldValidInImage[NRRD_FIELD_MAX+1];
+extern const int _nrrdFieldValidInText[NRRD_FIELD_MAX+1];
+extern const int _nrrdFieldOnePerAxis[NRRD_FIELD_MAX+1];
+extern const char _nrrdEnumFieldStr[NRRD_FIELD_MAX+1][AIR_STRLEN_SMALL];
+extern const int _nrrdFieldRequired[NRRD_FIELD_MAX+1];
+
+/* simple.c */
+extern char *_nrrdContentGet(const Nrrd *nin);
+extern int _nrrdContentSet_nva(Nrrd *nout, const char *func,
+ char *content, const char *format,
+ va_list arg);
+extern int _nrrdContentSet(Nrrd *nout, const char *func,
+ char *content, const char *format, ...);
+extern int _nrrdFieldCheckSpaceInfo(const Nrrd *nrrd, int useBiff);
+extern int (*_nrrdFieldCheck[NRRD_FIELD_MAX+1])(const Nrrd *nrrd, int useBiff);
+extern void _nrrdSplitSizes(size_t *pieceSize, size_t *pieceNum,
+ Nrrd *nrrd, unsigned int listDim);
+extern void _nrrdSpaceVecScaleAdd2(double sum[NRRD_SPACE_DIM_MAX],
+ double sclA,
+ const double vecA[NRRD_SPACE_DIM_MAX],
+ double sclB,
+ const double vecB[NRRD_SPACE_DIM_MAX]);
+extern void _nrrdSpaceVecScale(double out[NRRD_SPACE_DIM_MAX],
+ double scl,
+ const double vec[NRRD_SPACE_DIM_MAX]);
+extern double _nrrdSpaceVecNorm(int sdim,
+ const double vec[NRRD_SPACE_DIM_MAX]);
+extern void _nrrdSpaceVecSetNaN(double vec[NRRD_SPACE_DIM_MAX]);
+
+
+/* axis.c */
+extern int _nrrdKindAltered(int kindIn, int resampling);
+extern void _nrrdAxisInfoCopy(NrrdAxisInfo *dest, const NrrdAxisInfo *src,
+ int bitflag);
+extern void _nrrdAxisInfoInit(NrrdAxisInfo *axis);
+extern void _nrrdAxisInfoNewInit(NrrdAxisInfo *axis);
+extern int _nrrdCenter(int center);
+extern int _nrrdCenter2(int center, int def);
+
+/* convert.c */
+extern void (*_nrrdConv[][NRRD_TYPE_MAX+1])(void *, const void *, size_t);
+
+/* read.c */
+extern char _nrrdFieldStr[NRRD_FIELD_MAX+1][AIR_STRLEN_SMALL];
+extern char _nrrdRelativePathFlag[];
+extern char _nrrdFieldSep[];
+extern char _nrrdNoSpaceVector[];
+extern char _nrrdTextSep[];
+extern void _nrrdSplitName(char **dirP, char **baseP, const char *name);
+
+/* write.c */
+extern int _nrrdFieldInteresting (const Nrrd *nrrd, NrrdIoState *nio,
+ int field);
+extern void _nrrdSprintFieldInfo(char **strP, char *prefix,
+ const Nrrd *nrrd, NrrdIoState *nio,
+ int field);
+extern void _nrrdFprintFieldInfo(FILE *file, char *prefix,
+ const Nrrd *nrrd, NrrdIoState *nio,
+ int field);
+
+/* parseNrrd.c */
+extern int _nrrdDataFNCheck(NrrdIoState *nio, Nrrd *nrrd, int useBiff);
+extern int _nrrdContainsPercentDAndMore(char *str);
+extern int _nrrdReadNrrdParseField(NrrdIoState *nio, int useBiff);
+extern unsigned int _nrrdDataFNNumber(NrrdIoState *nio);
+
+/* methodsNrrd.c */
+extern void nrrdPeripheralInit(Nrrd *nrrd);
+extern int nrrdPeripheralCopy(Nrrd *nout, const Nrrd *nin);
+extern int _nrrdCopy(Nrrd *nout, const Nrrd *nin, int bitflag);
+extern int _nrrdSizeCheck(const size_t *size, unsigned int dim, int useBiff);
+extern void _nrrdTraverse(Nrrd *nrrd);
+
+#if TEEM_ZLIB
+#include <zlib.h>
+
+/* gzio.c */
+extern gzFile _nrrdGzOpen(FILE* fd, const char *mode);
+extern int _nrrdGzClose(gzFile file);
+extern int _nrrdGzRead(gzFile file, voidp buf, unsigned int len,
+ unsigned int* read);
+extern int _nrrdGzWrite(gzFile file, const voidp buf, unsigned int len,
+ unsigned int* written);
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/qnanhibit.c b/Utilities/ITK/Utilities/NrrdIO/qnanhibit.c
new file mode 100644
index 0000000000000000000000000000000000000000..bd4a080ab1f846cdc3fa5b8ad294a235ed250aeb
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/qnanhibit.c
@@ -0,0 +1,48 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include <stdio.h>
+#include <float.h>
+
+int
+main(int argc, char *argv[])
+{
+ char *me;
+ float pinf, qnan;
+ int i;
+
+ me = argv[0];
+ if (sizeof(float) != sizeof(int))
+ {
+ fprintf(stderr, "%s: MADNESS: sizeof(float)=%d != sizeof(int)=%d\n",
+ me, (int)sizeof(float), (int)sizeof(int));
+ return -1;
+ }
+ pinf = FLT_MAX;
+ pinf = pinf*pinf;
+ qnan = pinf/pinf;
+ i = *(int*)(&qnan);
+ printf("-DTEEM_QNANHIBIT=%d\n", (i >> 22) & 1);
+ return (int)((i >> 22) & 1);
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/read.c b/Utilities/ITK/Utilities/NrrdIO/read.c
new file mode 100644
index 0000000000000000000000000000000000000000..9b831483a07c9b2cabf5c5e0df6ce07051274494
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/read.c
@@ -0,0 +1,545 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+#if TEEM_BZIP2
+#include <bzlib.h>
+#endif
+
+#include "teem32bit.h"
+
+char _nrrdRelativePathFlag[] = "./";
+char _nrrdFieldSep[] = " \t";
+char _nrrdNoSpaceVector[] = "none";
+char _nrrdTextSep[] = " ,\t";
+
+typedef union {
+ char ***c;
+ void **v;
+} _cppu;
+
+/*
+** _nrrdOneLine
+**
+** wrapper around airOneLine; does re-allocation of line buffer
+** ("line") in the NrrdIoState if needed. The return value semantics
+** are similar, except that what airOneLine would return, we put
+** in *lenP. If there is an error (airOneLine returned 0,
+** something couldn't be allocated), *lenP is set to 0, and
+** we return 1. HITTING EOF IS NOT ACTUALLY AN ERROR, see code
+** below. Otherwise we return 0.
+**
+** Does use biff
+*/
+int
+_nrrdOneLine (unsigned int *lenP, NrrdIoState *nio, FILE *file) {
+ char me[]="_nrrdOneLine", err[AIR_STRLEN_MED], **line;
+ airArray *mop, *lineArr;
+ int lineIdx;
+ _cppu u;
+ unsigned int len;
+
+ if (!( lenP && nio && file)) {
+ sprintf(err, "%s: got NULL pointer (%p, %p, %p)", me,
+ lenP, nio, file);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (0 == nio->lineLen) {
+ /* nio->line hasn't been allocated for anything */
+ nio->line = (char*)calloc(3, sizeof(char));
+ nio->lineLen = 3;
+ }
+ len = airOneLine(file, nio->line, nio->lineLen);
+ if (len <= nio->lineLen) {
+ /* otherwise we hit EOF before a newline, or the line (possibly empty)
+ fit within the nio->line, neither of which is an error here */
+ *lenP = len;
+ } else {
+ /* line didn't fit in buffer, so we have to increase line
+ buffer size and put the line together in pieces */
+ u.c = &line;
+ lineArr = airArrayNew(u.v, NULL, sizeof(char *), 1);
+ if (!lineArr) {
+ sprintf(err, "%s: couldn't allocate airArray", me);
+ biffAdd(NRRD, err); *lenP = 0; return 1;
+ }
+ airArrayPointerCB(lineArr, airNull, airFree);
+ mop = airMopNew();
+ airMopAdd(mop, lineArr, (airMopper)airArrayNuke, airMopAlways);
+ while (len == nio->lineLen+1) {
+ lineIdx = airArrayLenIncr(lineArr, 1);
+ if (-1 == lineIdx) {
+ sprintf(err, "%s: couldn't increment line buffer array", me);
+ biffAdd(NRRD, err); *lenP = 0; airMopError(mop); return 1;
+ }
+ line[lineIdx] = nio->line;
+ nio->lineLen *= 2;
+ nio->line = (char*)malloc(nio->lineLen);
+ if (!nio->line) {
+ sprintf(err, "%s: couldn't alloc %d-char line\n", me, nio->lineLen);
+ biffAdd(NRRD, err); *lenP = 0; airMopError(mop); return 1;
+ }
+ len = airOneLine(file, nio->line, nio->lineLen);
+ }
+ /* last part did fit in nio->line buffer, also save this into line[] */
+ lineIdx = airArrayLenIncr(lineArr, 1);
+ if (!lineArr->data) {
+ sprintf(err, "%s: couldn't increment line buffer array", me);
+ biffAdd(NRRD, err); *lenP = 0; airMopError(mop); return 1;
+ }
+ line[lineIdx] = nio->line;
+ nio->lineLen *= 3; /* for good measure */
+ nio->line = (char*)malloc(nio->lineLen);
+ if (!nio->line) {
+ sprintf(err, "%s: couldn't alloc %d-char line\n", me, nio->lineLen);
+ biffAdd(NRRD, err); *lenP = 0; airMopError(mop); return 1;
+ }
+ /* now concatenate everything into a new nio->line */
+ strcpy(nio->line, "");
+ for (lineIdx=0; lineIdx<(int)lineArr->len; lineIdx++) {
+ strcat(nio->line, line[lineIdx]);
+ }
+ *lenP = strlen(nio->line) + 1;
+ airMopError(mop);
+ }
+ return 0;
+}
+
+/*
+** _nrrdCalloc()
+**
+** allocates the data for the array, but only if necessary (as informed by
+** nio->oldData and nio->oldDataSize).
+**
+** as a recent feature, this will handle the extra work of allocating
+** memory in the special way required for direct IO, if possible. For
+** this to work, though, the FILE *file has to be passed. Since file
+** is not otherwise needed, it can be passed as NULL for non-direct-IO
+** situations. In any case, if the directIO-compatible allocation fails
+** its not error, and we revert to regular allocation.
+**
+** NOTE: this assumes the checking that is done by _nrrdHeaderCheck
+*/
+int
+_nrrdCalloc (Nrrd *nrrd, NrrdIoState *nio, FILE *file) {
+ char me[]="_nrrdCalloc", err[AIR_STRLEN_MED];
+ size_t needDataSize;
+ int fd;
+
+ needDataSize = nrrdElementNumber(nrrd)*nrrdElementSize(nrrd);
+ if (nio->oldData && needDataSize == nio->oldDataSize) {
+ /* re-use old data */
+ nrrd->data = nio->oldData;
+ /* its not an error to have a directIO-incompatible pointer, so
+ there's no other error checking to do here */
+ } else {
+ nrrd->data = airFree(nrrd->data);
+ fd = file ? fileno(file) : -1;
+ if (nrrdEncodingRaw == nio->encoding
+ && -1 != fd
+ && airNoDio_okay == airDioTest(fd, NULL, needDataSize)) {
+ nrrd->data = airDioMalloc(needDataSize, fd);
+ }
+ if (!nrrd->data) {
+ /* directIO-compatible allocation wasn't tried, or it failed */
+ nrrd->data = malloc(needDataSize);
+ }
+ if (!nrrd->data) {
+ sprintf(err, "%s: couldn't allocate " _AIR_SIZE_T_CNV
+ " things of size " _AIR_SIZE_T_CNV,
+ me, nrrdElementNumber(nrrd), nrrdElementSize(nrrd));
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ /* make it look like it came from calloc(), as used by nrrdNew() */
+ memset(nrrd->data, 0, needDataSize);
+ return 0;
+}
+
+/*
+******** nrrdLineSkip
+**
+** public for the sake of things like "unu make"
+** uses the NrrdIoState for its line buffer (used by _nrrdOneLine)
+*/
+int
+nrrdLineSkip (FILE *dataFile, NrrdIoState *nio) {
+ unsigned int lsi, skipRet;
+ char me[]="nrrdLineSkip", err[AIR_STRLEN_MED];
+
+ /* For compressed data: If you don't actually have ascii headers on
+ top of your gzipped data then you will potentially huge lines
+ while _nrrdOneLine looks for line terminations. Quoting Gordon:
+ "Garbage in, Garbage out." */
+
+ if (!( dataFile && nio )) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ for (lsi=0; lsi<nio->lineSkip; lsi++) {
+ if (_nrrdOneLine(&skipRet, nio, dataFile)) {
+ sprintf(err, "%s: error skipping line %u of %u",
+ me, lsi+1, nio->lineSkip);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!skipRet) {
+ sprintf(err, "%s: hit EOF skipping line %u of %u",
+ me, lsi+1, nio->lineSkip);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+******** nrrdByteSkip
+**
+** public for the sake of things like "unu make"
+** uses nio for information about how much data should actually be skipped
+** with -1 == byteSkip
+*/
+int
+nrrdByteSkip (FILE *dataFile, Nrrd *nrrd, NrrdIoState *nio) {
+ int i, skipRet;
+ char me[]="nrrdByteSkip", err[AIR_STRLEN_MED];
+ size_t bsize;
+
+ if (!( dataFile && nrrd && nio )) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nio->byteSkip < -1) {
+ sprintf(err, "%s: byteSkip %d not valid", me, nio->byteSkip);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (-1 == nio->byteSkip) {
+ if (nrrdEncodingRaw != nio->encoding) {
+ sprintf(err, "%s: can do backwards byte skip only in %s "
+ "encoding, not %s", me,
+ nrrdEncodingRaw->name, nio->encoding->name);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (stdin == dataFile) {
+ sprintf(err, "%s: can't fseek on stdin", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ bsize = nrrdElementNumber(nrrd)/_nrrdDataFNNumber(nio);
+ bsize *= nrrdElementSize(nrrd);
+ if (fseek(dataFile, -((long)bsize), SEEK_END)) {
+ sprintf(err, "%s: failed to fseek(dataFile, " _AIR_SIZE_T_CNV
+ ", SEEK_END)", me, bsize);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdStateVerboseIO >= 2) {
+ fprintf(stderr, "(%s: actually skipped %d bytes)\n",
+ me, (int)ftell(dataFile));
+ }
+ } else {
+ for (i=1; i<=nio->byteSkip; i++) {
+ skipRet = fgetc(dataFile);
+ if (EOF == skipRet) {
+ sprintf(err, "%s: hit EOF skipping byte %d of %d",
+ me, i, nio->byteSkip);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+******** nrrdRead()
+**
+** read in nrrd from a given file. The main job of this function is to
+** start reading the file, to determine the format, and then call the
+** appropriate format's reader. This means that the various encoding
+** (data) readers can assume that nio->format is usefully set.
+**
+** The only input information that nio is used for is nio->path, so that
+** detached header-relative data files can be found.
+**
+*/
+int
+nrrdRead (Nrrd *nrrd, FILE *file, NrrdIoState *nio) {
+ char me[]="nrrdRead", err[AIR_STRLEN_MED];
+ unsigned int llen;
+ int nfi;
+ airArray *mop;
+
+ /* sanity check, for good measure */
+ if (!nrrdSanity()) {
+ sprintf(err, "%s: sanity check FAILED: have to fix and re-compile", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ if (!(file && nrrd)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ mop = airMopNew();
+ if (!nio) {
+ nio = nrrdIoStateNew();
+ if (!nio) {
+ sprintf(err, "%s: couldn't alloc I/O struct", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ airMopAdd(mop, nio, (airMopper)nrrdIoStateNix, airMopAlways);
+ }
+
+ /* remember old data pointer and allocated size. Whether or not to
+ free() this memory will be decided later */
+ nio->oldData = nrrd->data;
+ nio->oldDataSize = (nio->oldData
+ ? nrrdElementNumber(nrrd)*nrrdElementSize(nrrd)
+ : 0);
+ /*
+ fprintf(stderr, "!%s: nio->oldData = %p, oldDataSize = %d\n", me,
+ nio->oldData, (int)(nio->oldDataSize));
+ */
+ nrrd->data = NULL;
+
+ /* initialize given nrrd (but we have thwarted freeing existing memory) */
+ nrrdInit(nrrd);
+
+ if (_nrrdOneLine(&llen, nio, file)) {
+ sprintf(err, "%s: error getting first line (containing \"magic\")", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ if (!llen) {
+ sprintf(err, "%s: immediately hit EOF", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ nio->format = nrrdFormatUnknown;
+ for (nfi = nrrdFormatTypeUnknown+1;
+ nfi < nrrdFormatTypeLast;
+ nfi++) {
+ if (nrrdFormatArray[nfi]->contentStartsLike(nio)) {
+ nio->format = nrrdFormatArray[nfi];
+ break;
+ }
+ }
+ if (nrrdFormatUnknown == nio->format) {
+ sprintf(err, "%s: couldn't parse \"%s\" as magic or beginning of "
+ "any recognized format", me, nio->line);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ /* try to read the file */
+ if (nio->format->read(file, nrrd, nio)) {
+ sprintf(err, "%s: trouble reading %s file", me, nio->format->name);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ /* reshape up grayscale images, if desired */
+ if (nio->format->isImage && 2 == nrrd->dim && nrrdStateGrayscaleImage3D) {
+ if (nrrdAxesInsert(nrrd, nrrd, 0)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+
+ /* free prior memory if we didn't end up using it */
+ /* HEY: could actually do a check on the nio to refine this */
+ if (nio->oldData != nrrd->data) {
+ nio->oldData = airFree(nio->oldData);
+ nio->oldDataSize = 0;
+ }
+
+ /* finally, make sure that what we're returning isn't malformed somehow,
+ except that we (probably stupidly) allow nrrd->data to be NULL, given
+ the possibility of using nio->skipData */
+ if (_nrrdCheck(nrrd, AIR_FALSE, AIR_TRUE)) {
+ sprintf(err, "%s: problem with nrrd after reading", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
+
+/*
+** _nrrdSplitName()
+**
+** splits a file name into a path and a base filename. The directory
+** seperator is assumed to be '/'. The division between the path
+** and the base is the last '/' in the file name. The path is
+** everything prior to this, and base is everything after (so the
+** base does NOT start with '/'). If there is not a '/' in the name,
+** or if a '/' appears as the last character, then the path is set to
+** ".", and the name is copied into base.
+*/
+void
+_nrrdSplitName (char **dirP, char **baseP, const char *name) {
+ char *where;
+
+ if (dirP) {
+ *dirP = (char *)airFree(*dirP);
+ }
+ if (baseP) {
+ *baseP = (char *)airFree(*baseP);
+ }
+ where = strrchr(name, '/');
+ /* we found a valid break if the last directory character
+ is somewhere in the string except the last character */
+ if (where && airStrlen(where) > 1) {
+ if (dirP) {
+ *dirP = airStrdup(name);
+ (*dirP)[where - name] = 0;
+ }
+ if (baseP) {
+ *baseP = airStrdup(where + 1);
+ }
+ } else {
+ /* if the name had no slash, its in the current directory, which
+ means that we need to explicitly store "." as the header
+ directory in case we have header-relative data. */
+ if (dirP) {
+ *dirP = airStrdup(".");
+ }
+ if (baseP) {
+ *baseP = airStrdup(name);
+ }
+ }
+ return;
+}
+
+/*
+******** nrrdLoad()
+**
+**
+**
+** call tree for this, to help figure out what's going on
+**
+** read.c/nrrdLoad
+** | read.c/_nrrdSplitName
+** | read.c/nrrdRead
+** | nio->format->read
+** = formatNRRD.c/_nrrdFormatNRRD_read:
+** | read.c/_nrrdOneLine
+** | parseNrrd.c/_nrrdReadNrrdParseField
+** | parseNrrd.c/nrrdFieldInfoParse[]
+** = parseNrrd.c/_nrrdReadNrrdParse_data_file
+** | fopen(dataName)
+** | formatNRRD.c/_nrrdHeaderCheck
+** | read.c/nrrdLineSkip
+** | read.c/nrrdByteSkip
+** | nio->encoding->read
+** = encodingRaw.c/_nrrdEncodingRaw_read
+** | read.c/_nrrdCalloc
+** | formatNRRD.c/nrrdSwapEndian
+** | miscAir.c/airFclose
+
+1) its in the same file. ElementDataFile is "LOCAL"
+
+2) its in a list of files. ElementDataFile is "LIST", and what follows
+in the header is a list of files, one filename per line. By default,
+there is one slice per sample on the slowest axis, but you can do
+otherwise with, for example, "LIST 3", which means that there will be
+a 3D slab per file.
+
+3) slices in numbered files. ElementDataFile is, for example,
+"file%03d.blah <min> <max> <step>", where the first part is a
+printf-style string containing a format sequence for an integer value,
+and <min>, <max>, and <step> are integer values that specify the min,
+max, and increment value for naming the numbered slices. Note that if
+you use something like "file%d.blah", you automatically get the
+correct ordering between "file2.blah" and "file10.blah".
+
+I plan on shamelessly copying this, just like I shamelessly copied the
+"byte skip: -1" feature from MetaIO. The minor differences are:
+
+- the datafile is "LOCAL" by default, as in, no "data file: " field is
+ given in the NRRD. This is the current behavior for attached
+ headers.
+
+- When using the pattern for numbered files, the final <step> value
+ will be optional, and by default 1.
+
+- This will work for multiple compressed files.
+
+
+**
+** (more documentation here)
+**
+** sneakiness: returns 2 if the reason for problem was a failed fopen().
+**
+*/
+int
+nrrdLoad (Nrrd *nrrd, const char *filename, NrrdIoState *nio) {
+ char me[]="nrrdLoad", err[AIR_STRLEN_MED];
+ FILE *file;
+ airArray *mop;
+
+ if (!(nrrd && filename)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ mop = airMopNew();
+ if (!nio) {
+ nio = nrrdIoStateNew();
+ if (!nio) {
+ sprintf(err, "%s: couldn't alloc I/O struct", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ airMopAdd(mop, nio, (airMopper)nrrdIoStateNix, airMopAlways);
+ }
+
+ /* we save the directory of the filename given to us so that if it turns
+ out that this is a detached header with a header-relative data file,
+ then we will know how to find the data file */
+ _nrrdSplitName(&(nio->path), NULL, filename);
+ /* printf("!%s: |%s|%s|\n", me, nio->dir, nio->base); */
+
+ if (!( file = airFopen(filename, stdin, "rb") )) {
+ sprintf(err, "%s: fopen(\"%s\",\"rb\") failed: %s",
+ me, filename, strerror(errno));
+ biffAdd(NRRD, err); airMopError(mop); return 2;
+ }
+ airMopAdd(mop, file, (airMopper)airFclose, airMopOnError);
+ /* non-error exiting is handled below */
+
+ if (nrrdRead(nrrd, file, nio)) {
+ sprintf(err, "%s: trouble reading \"%s\"", me, filename);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ if (nrrdFormatNRRD == nio->format
+ && nio->keepNrrdDataFileOpen
+ && file == nio->dataFile ) {
+ /* we have to keep the datafile open. If was attached, we can't
+ close file, because that is the datafile. If was detached,
+ file != nio->dataFile, so we can close file. */
+ } else {
+ /* always close non-NRRD files */
+ airFclose(file);
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/reorder.c b/Utilities/ITK/Utilities/NrrdIO/reorder.c
new file mode 100644
index 0000000000000000000000000000000000000000..94744ae277bbe35a858e664e8ee1278eec597fe1
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/reorder.c
@@ -0,0 +1,414 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+#include "teem32bit.h"
+
+/*
+******** nrrdInvertPerm()
+**
+** given an array (p) which represents a permutation of n elements,
+** compute the inverse permutation ip. The value of this function
+** is not its core functionality, but all the error checking it
+** provides.
+*/
+int
+nrrdInvertPerm(unsigned int *invp, const unsigned int *pp, unsigned int nn) {
+ char me[]="nrrdInvertPerm", err[AIR_STRLEN_MED];
+ int problem;
+ unsigned int ii;
+
+ if (!(invp && pp && nn > 0)) {
+ sprintf(err, "%s: got NULL pointer or non-positive nn (%d)", me, nn);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ /* use the given array "invp" as a temp buffer for validity checking */
+ memset(invp, 0, nn*sizeof(int));
+ for (ii=0; ii<nn; ii++) {
+ if (!( pp[ii] <= nn-1)) {
+ sprintf(err, "%s: permutation element #%d == %d out of bounds [0,%d]",
+ me, ii, pp[ii], nn-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ invp[pp[ii]]++;
+ }
+ problem = AIR_FALSE;
+ for (ii=0; ii<nn; ii++) {
+ if (1 != invp[ii]) {
+ sprintf(err, "%s: element #%d mapped to %d times (should be once)",
+ me, ii, invp[ii]);
+ biffAdd(NRRD, err); problem = AIR_TRUE;
+ }
+ }
+ if (problem) {
+ return 1;
+ }
+
+ /* the skinny */
+ for (ii=0; ii<nn; ii++) {
+ invp[pp[ii]] = ii;
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdAxesInsert
+**
+** like reshape, but preserves axis information on old axes, and
+** this is only for adding a "stub" axis with length 1. All other
+** axis attributes are initialized as usual.
+*/
+int
+nrrdAxesInsert(Nrrd *nout, const Nrrd *nin, unsigned int axis) {
+ char me[]="nrrdAxesInsert", func[]="axinsert", err[AIR_STRLEN_MED];
+ unsigned int ai;
+
+ if (!(nout && nin)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( axis <= nin->dim )) {
+ sprintf(err, "%s: given axis (%d) outside valid range [0, %d]",
+ me, axis, nin->dim);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (NRRD_DIM_MAX == nin->dim) {
+ sprintf(err, "%s: given nrrd already at NRRD_DIM_MAX (%d)",
+ me, NRRD_DIM_MAX);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nout != nin) {
+ if (_nrrdCopy(nout, nin, (NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT))) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ nout->dim = 1 + nin->dim;
+ for (ai=nin->dim; ai>axis; ai--) {
+ _nrrdAxisInfoCopy(&(nout->axis[ai]), &(nin->axis[ai-1]),
+ NRRD_AXIS_INFO_NONE);
+ }
+ /* the ONLY thing we can say about the new axis is its size */
+ _nrrdAxisInfoInit(&(nout->axis[axis]));
+ if (!nrrdStateKindNoop) {
+ /* except maybe the kind */
+ nout->axis[axis].kind = nrrdKindStub;
+ }
+ nout->axis[axis].size = 1;
+ if (nrrdContentSet(nout, func, nin, "%d", axis)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* all basic info has already been copied by nrrdCopy() above */
+ return 0;
+}
+
+/*
+******** nrrdAxesPermute
+**
+** changes the scanline ordering of the data in a nrrd
+**
+** The basic means by which data is moved around is with memcpy().
+** The goal is to call memcpy() as few times as possible, on memory
+** segments as large as possible. Currently, this is done by
+** detecting how many of the low-index axes are left untouched by
+** the permutation- this constitutes a "scanline" which can be
+** copied around as a unit. For permuting the y and z axes of a
+** matrix-x-y-z order matrix volume, this optimization produced a
+** factor of 5 speed up (exhaustive multi-platform tests, of course).
+**
+** The axes[] array determines the permutation of the axes.
+** axis[i] = j means: axis i in the output will be the input's axis j
+** (axis[i] answers: "what do I put here", from the standpoint of the output,
+** not "where do I put this", from the standpoint of the input)
+*/
+int
+nrrdAxesPermute(Nrrd *nout, const Nrrd *nin, const unsigned int *axes) {
+ char me[]="nrrdAxesPermute", func[]="permute", err[AIR_STRLEN_MED],
+ buff1[NRRD_DIM_MAX*30], buff2[AIR_STRLEN_SMALL];
+ size_t idxOut, idxIn, /* indices for input and output scanlines */
+ lineSize, /* size of block of memory which can be
+ moved contiguously from input to output,
+ thought of as a "scanline" */
+ numLines, /* how many "scanlines" there are to permute */
+ szIn[NRRD_DIM_MAX], *lszIn,
+ szOut[NRRD_DIM_MAX], *lszOut;
+ char *dataIn, *dataOut;
+ int axmap[NRRD_DIM_MAX];
+ unsigned int
+ cIn[NRRD_DIM_MAX],
+ cOut[NRRD_DIM_MAX];
+ unsigned int
+ ai, /* running index along dimensions */
+ lowPax, /* lowest axis which is "p"ermutated */
+ ldim, /* nin->dim - lowPax */
+ ip[NRRD_DIM_MAX+1], /* inverse of permutation in "axes" */
+ laxes[NRRD_DIM_MAX+1]; /* copy of axes[], but shifted down by lowPax
+ elements, to remove i such that i == axes[i] */
+ airArray *mop;
+
+ mop = airMopNew();
+ if (!(nin && nout && axes)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ /* we don't actually need ip[], computing it is for error checking */
+ if (nrrdInvertPerm(ip, axes, nin->dim)) {
+ sprintf(err, "%s: couldn't compute axis permutation inverse", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ /* this shouldn't actually be necessary ... */
+ if (!nrrdElementSize(nin)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ for (ai=0; ai<nin->dim && axes[ai] == ai; ai++)
+ ;
+ lowPax = ai;
+
+ /* allocate output by initial copy */
+ if (nout != nin) {
+ if (nrrdCopy(nout, nin)) {
+ sprintf(err, "%s: trouble copying input", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ dataIn = (char*)nin->data;
+ } else {
+ dataIn = (char*)calloc(nrrdElementNumber(nin), nrrdElementSize(nin));
+ if (!dataIn) {
+ sprintf(err, "%s: couldn't create local copy of data", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ airMopAdd(mop, dataIn, airFree, airMopAlways);
+ memcpy(dataIn, nin->data, nrrdElementNumber(nin)*nrrdElementSize(nin));
+ }
+ if (lowPax < nin->dim) {
+ /* if lowPax == nin->dim, then we were given the identity permutation, so
+ there's nothing to do other than the copy already done. Otherwise,
+ here we are (actually, lowPax < nin->dim-1) */
+ for (ai=0; ai<nin->dim; ai++) {
+ axmap[ai] = axes[ai];
+ }
+ nrrdAxisInfoGet_nva(nin, nrrdAxisInfoSize, szIn);
+ if (nrrdAxisInfoCopy(nout, nin, axmap, NRRD_AXIS_INFO_NONE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ nrrdAxisInfoGet_nva(nout, nrrdAxisInfoSize, szOut);
+ /* the skinny */
+ lineSize = 1;
+ for (ai=0; ai<lowPax; ai++) {
+ lineSize *= szIn[ai];
+ }
+ numLines = nrrdElementNumber(nin)/lineSize;
+ lineSize *= nrrdElementSize(nin);
+ lszIn = szIn + lowPax;
+ lszOut = szOut + lowPax;
+ ldim = nin->dim - lowPax;
+ memset(laxes, 0, NRRD_DIM_MAX*sizeof(int));
+ for (ai=0; ai<ldim; ai++) {
+ laxes[ai] = axes[ai+lowPax]-lowPax;
+ }
+ dataOut = (char *)nout->data;
+ memset(cIn, 0, NRRD_DIM_MAX*sizeof(int));
+ memset(cOut, 0, NRRD_DIM_MAX*sizeof(int));
+ for (idxOut=0; idxOut<numLines; idxOut++) {
+ /* in our representation of the coordinates of the start of the
+ scanlines that we're copying, we are not even storing all the
+ zeros in the coordinates prior to lowPax, and when we go to
+ a linear index for the memcpy(), we multiply by lineSize */
+ for (ai=0; ai<ldim; ai++) {
+ cIn[laxes[ai]] = cOut[ai];
+ }
+ NRRD_INDEX_GEN(idxIn, cIn, lszIn, ldim);
+ memcpy(dataOut + idxOut*lineSize, dataIn + idxIn*lineSize, lineSize);
+ NRRD_COORD_INCR(cOut, lszOut, ldim, 0);
+ }
+ /* set content */
+ strcpy(buff1, "");
+ for (ai=0; ai<nin->dim; ai++) {
+ sprintf(buff2, "%s%d", (ai ? "," : ""), axes[ai]);
+ strcat(buff1, buff2);
+ }
+ if (nrrdContentSet(nout, func, nin, "%s", buff1)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ if (nout != nin) {
+ if (nrrdBasicInfoCopy(nout, nin,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ }
+ }
+ airMopOkay(mop);
+ return 0;
+}
+
+/*
+******** nrrdShuffle
+**
+** rearranges hyperslices of a nrrd along a given axis according to
+** given permutation. This could be used to on a 4D array,
+** representing a 3D volume of vectors, to re-order the vector
+** components.
+**
+** the given permutation array must allocated for at least as long as
+** the input nrrd along the chosen axis. perm[j] = i means that the
+** value at position j in the _new_ array should come from position i
+** in the _old_array. The standpoint is from the new, looking at
+** where to find the values amid the old array (perm answers "what do
+** I put here", not "where do I put this"). This allows multiple
+** positions in the new array to copy from the same old position, and
+** insures that there is an source for all positions along the new
+** array.
+*/
+int
+nrrdShuffle(Nrrd *nout, const Nrrd *nin, unsigned int axis,
+ const size_t *perm) {
+ char me[]="nrrdShuffle", func[]="shuffle", err[AIR_STRLEN_MED],
+ buff1[NRRD_DIM_MAX*30], buff2[AIR_STRLEN_SMALL];
+ unsigned int
+ ai, ldim, len,
+ cIn[NRRD_DIM_MAX+1],
+ cOut[NRRD_DIM_MAX+1];
+ size_t idxIn, idxOut, lineSize, numLines, size[NRRD_DIM_MAX], *lsize;
+ char *dataIn, *dataOut;
+
+ if (!(nin && nout && perm)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nout == nin) {
+ sprintf(err, "%s: nout==nin disallowed", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( axis < nin->dim )) {
+ sprintf(err, "%s: axis %d outside valid range [0,%d]",
+ me, axis, nin->dim-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ len = nin->axis[axis].size;
+ for (ai=0; ai<len; ai++) {
+ if (!( perm[ai] < len )) {
+ sprintf(err, "%s: perm[%d] (" _AIR_SIZE_T_CNV
+ ") outside valid range [0,%d]", me, ai, perm[ai], len-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ /* this shouldn't actually be necessary ... */
+ if (!nrrdElementSize(nin)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* set information in new volume */
+ nout->blockSize = nin->blockSize;
+ nrrdAxisInfoGet_nva(nin, nrrdAxisInfoSize, size);
+ if (nrrdMaybeAlloc_nva(nout, nin->type, nin->dim, size)) {
+ sprintf(err, "%s: failed to allocate output", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdAxisInfoCopy(nout, nin, NULL, NRRD_AXIS_INFO_NONE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* the min and max along the shuffled axis are now meaningless */
+ nout->axis[axis].min = nout->axis[axis].max = AIR_NAN;
+ /* do the safe thing first */
+ nout->axis[axis].kind = _nrrdKindAltered(nin->axis[axis].kind, AIR_FALSE);
+ /* try cleverness */
+ if (!nrrdStateKindNoop) {
+ if (0 == nrrdKindSize(nin->axis[axis].kind)
+ || nrrdKindStub == nin->axis[axis].kind
+ || nrrdKindScalar == nin->axis[axis].kind
+ || nrrdKind2Vector == nin->axis[axis].kind
+ || nrrdKind3Color == nin->axis[axis].kind
+ || nrrdKind4Color == nin->axis[axis].kind
+ || nrrdKind3Vector == nin->axis[axis].kind
+ || nrrdKind3Gradient == nin->axis[axis].kind
+ || nrrdKind3Normal == nin->axis[axis].kind
+ || nrrdKind4Vector == nin->axis[axis].kind) {
+ /* these kinds have no intrinsic ordering */
+ nout->axis[axis].kind = nin->axis[axis].kind;
+ }
+ }
+ /* the skinny */
+ lineSize = 1;
+ for (ai=0; ai<axis; ai++) {
+ lineSize *= nin->axis[ai].size;
+ }
+ numLines = nrrdElementNumber(nin)/lineSize;
+ lineSize *= nrrdElementSize(nin);
+ lsize = size + axis;
+ ldim = nin->dim - axis;
+ dataIn = (char *)nin->data;
+ dataOut = (char *)nout->data;
+ memset(cIn, 0, (NRRD_DIM_MAX+1)*sizeof(int));
+ memset(cOut, 0, (NRRD_DIM_MAX+1)*sizeof(int));
+ for (idxOut=0; idxOut<numLines; idxOut++) {
+ memcpy(cIn, cOut, ldim*sizeof(int));
+ cIn[0] = perm[cOut[0]];
+ NRRD_INDEX_GEN(idxIn, cIn, lsize, ldim);
+ NRRD_INDEX_GEN(idxOut, cOut, lsize, ldim);
+ memcpy(dataOut + idxOut*lineSize, dataIn + idxIn*lineSize, lineSize);
+ NRRD_COORD_INCR(cOut, lsize, ldim, 0);
+ }
+ /* content */
+ strcpy(buff1, "");
+ for (ai=0; ai<nin->dim; ai++) {
+ sprintf(buff2, "%s" _AIR_SIZE_T_CNV, (ai ? "," : ""), perm[ai]);
+ strcat(buff1, buff2);
+ }
+ if (nrrdContentSet(nout, func, nin, "%s", buff1)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdBasicInfoCopy(nout, nin,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ return 0;
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/sample-GNUmakefile b/Utilities/ITK/Utilities/NrrdIO/sample-GNUmakefile
new file mode 100644
index 0000000000000000000000000000000000000000..3ca8eeccd0187229e27725f9fdc6bbfd7d7a0258
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/sample-GNUmakefile
@@ -0,0 +1,94 @@
+#
+# NrrdIO: stand-alone code for basic nrrd functionality
+# Copyright (C) 2005 Gordon Kindlmann
+# Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+#
+# This software is provided 'as-is', without any express or implied
+# warranty. In no event will the authors be held liable for any
+# damages arising from the use of this software.
+#
+# Permission is granted to anyone to use this software for any
+# purpose, including commercial applications, and to alter it and
+# redistribute it freely, subject to the following restrictions:
+#
+# 1. The origin of this software must not be misrepresented; you must
+# not claim that you wrote the original software. If you use this
+# software in a product, an acknowledgment in the product
+# documentation would be appreciated but is not required.
+#
+# 2. Altered source versions must be plainly marked as such, and must
+# not be misrepresented as being the original software.
+#
+# 3. This notice may not be removed or altered from any source distribution.
+#
+
+### For the time being, this will have to do as a makefile for NrrdIO
+
+### These have to be set to reflect the current platform:
+###
+### -DTEEM_DIO=0, -DTEEM_DIO=1: This platform can (1) or cannot (0) do
+### DirectIO, which is the fast way to do multi-gigabyte I/O.
+### Currently, only available on SGIs.
+###
+### -DTEEM_32BIT=0, -DTEEM_32BIT=1: This platform is a 32-bit (1) or a
+### 64-bit machine (0)
+###
+### -DTEEM_ENDIAN=4321, -DTEEM_ENDIAN=1234: The platform is big-endian
+### (4321) or little-endian (1234)
+###
+### -DTEEM_QNANHIBIT=1, -DTEEM_QNANHIBIT=0: The 23nd bit of a 32-bit
+### quiet-NaN is either 1 (1) or 0 (0). This is needed as part of
+### handling IEEE floating point special values. This quantity is
+### independent of endianness.
+###
+###
+PLATFORM_DEFS = \
+ -DTEEM_DIO=0 \
+ -DTEEM_32BIT=1 \
+ -DTEEM_ENDIAN=4321 \
+ -DTEEM_QNANHIBIT=1
+
+### Any architecture-specific flags to cc
+###
+CCFLAGS = -O3 -ffloat-store -W -Wall
+
+### This also has to be set per-architecture- whether or not we need to
+### run ranlib on libraries created via ar
+###
+RANLIB = ranlib
+
+### Assuming NrrdIO will be built with zlib enabled (due to "-DTEEM_ZLIB=1"
+### on the source compilation, below), these (may) need to be set to help
+### find the zlib includes and libraries
+###
+ZLIB_IPATH =
+ZLIB_LPATH =
+
+### We'll build the static libNrrdIO library, and one test program
+###
+ALL = libNrrdIO.a sampleIO
+all: $(ALL)
+
+### The libNrrdIO library is built from the objects from the source files
+### named in NrrdIO_Srcs.txt
+###
+libNrrdIO.a : $(patsubst %.c,%.o,$(shell cat NrrdIO_Srcs.txt))
+ ar ru $@ $^
+ $(if $(RANLIB),$(RANLIB) $@,)
+
+### Compiling the source files will also have some platform-specific stuff
+###
+%.o : %.c
+ cc $(CCFLAGS) $(PLATFORM_DEFS) \
+ -DTEEM_ZLIB=1 $(ZLIB_IPATH) -c $^ -o $@
+
+### this creates the sampleIO program
+###
+sampleIO : sampleIO.c
+ cc $(CCFLAGS) $(PLATFORM_DEFS) -DTEEM_ZLIB=1 $(ZLIB_IPATH) \
+ $^ -o $@ -L. -lNrrdIO $(ZLIB_LPATH) -lz -lm
+
+### how to clean up
+###
+clean :
+ rm -f *.o $(ALL)
diff --git a/Utilities/ITK/Utilities/NrrdIO/sampleIO.c b/Utilities/ITK/Utilities/NrrdIO/sampleIO.c
new file mode 100644
index 0000000000000000000000000000000000000000..39a8f8c041f3b4ee3abe6d4a22aef8f0b8a23583
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/sampleIO.c
@@ -0,0 +1,106 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+void
+demoIO(char *filename) {
+ char me[]="demoIO", newname[]="foo.nrrd", *err, *key, *val;
+ int kvn, kvi;
+ Nrrd *nin;
+
+ /* create a nrrd; at this point this is just an empty container */
+ nin = nrrdNew();
+
+ /* read in the nrrd from file */
+ if (nrrdLoad(nin, filename, NULL)) {
+ err = biffGetDone(NRRD);
+ fprintf(stderr, "%s: trouble reading \"%s\":\n%s", me, filename, err);
+ free(err);
+ return;
+ }
+
+ /* say something about the array */
+ printf("%s: \"%s\" is a %d-dimensional nrrd of type %d (%s)\n",
+ me, filename, nin->dim, nin->type,
+ airEnumStr(nrrdType, nin->type));
+ printf("%s: the array contains %d elements, each %d bytes in size\n",
+ me, (int)nrrdElementNumber(nin), (int)nrrdElementSize(nin));
+
+ /* print out the key/value pairs present */
+ kvn = nrrdKeyValueSize(nin);
+ if (kvn) {
+ for (kvi=0; kvi<kvn; kvi++) {
+ nrrdKeyValueIndex(nin, &key, &val, kvi);
+ printf("%s: key:value %d = %s:%s\n", me, kvi, key, val);
+ free(key); free(val);
+ key = val = NULL;
+ }
+ }
+
+ /* modify key/value pairs, and write out the nrrd to a different file */
+ nrrdKeyValueClear(nin);
+ nrrdKeyValueAdd(nin, "new key", "precious value");
+ if (nrrdSave(newname, nin, NULL)) {
+ err = biffGetDone(NRRD);
+ fprintf(stderr, "%s: trouble writing \"%s\":\n%s", me, newname, err);
+ free(err);
+ return;
+ }
+
+ /* blow away both the Nrrd struct *and* the memory at nin->data
+ (nrrdNix() frees the struct but not the data,
+ nrrdEmpty() frees the data but not the struct) */
+ nrrdNuke(nin);
+
+ return;
+}
+
+int
+main(int argc, char **argv) {
+ char *err;
+
+ fprintf(stderr, "(from Teem %s, %s)\n",
+ airTeemVersion, airTeemReleaseDate);
+
+ if (!nrrdSanity()) {
+ fprintf(stderr, "\n");
+ fprintf(stderr, "!!! nrrd sanity check FAILED: fix and re-compile\n");
+ err = biffGet(NRRD);
+ fprintf(stderr, "%s\n", err);
+ free(err);
+ return 1;
+ } else {
+ fprintf(stderr, "(nrrdSanity check passed)\n\n");
+ }
+
+ if (2 != argc) {
+ fprintf(stderr, "usage: demoIO <filename>\n");
+ return 1;
+ }
+
+ demoIO(argv[1]);
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/sane.c b/Utilities/ITK/Utilities/NrrdIO/sane.c
new file mode 100644
index 0000000000000000000000000000000000000000..d3b925dd65d5daa3d56e550edf5ce7444ef3dc45
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/sane.c
@@ -0,0 +1,162 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateAir.h"
+
+/*
+******** airSanity()
+**
+** Does run-time checks to see if the compile-time constants are correct.
+** Returns a value from the airInsane* enum; airInsane_not means all
+** the checks came back without detecting any problems.
+*/
+int
+airSanity(void) {
+ double nan, pinf, ninf;
+ float nanF, pinfF, ninfF;
+ unsigned int sign, exp, mant;
+ int tmpI, size;
+ char endian;
+ unsigned char uc0, uc1;
+ static int _airSanity=0;
+
+ if (_airSanity) {
+ return airInsane_not;
+ }
+
+ /* run-time endian check */
+ tmpI = 1;
+ endian = !(*((char*)(&tmpI)));
+ if (endian) {
+ /* big endian */
+ if (4321 != AIR_ENDIAN) {
+ return airInsane_endian;
+ }
+ }
+ else {
+ if (1234 != AIR_ENDIAN) {
+ return airInsane_endian;
+ }
+ }
+
+ /* checks on sizes of uchar, float, int, double, airLLong */
+ uc0 = 255;
+ uc1 = uc0 + 1; /* to avoid compiler warnings */
+ if (!( 255 == uc0 && 0 == uc1 )) {
+ return airInsane_UCSize;
+ }
+ /* these justify the AIR_EXISTS_F and AIR_EXISTS_D macros */
+ if (!( (sizeof(float) == sizeof(int)) && (4 == sizeof(int)) )) {
+ return airInsane_FISize;
+ }
+ if (!( (sizeof(double) == sizeof(airLLong)) && (8 == sizeof(airLLong)) )) {
+ return airInsane_DLSize;
+ }
+
+ /* run-time NaN checks */
+ pinf = DBL_MAX;
+ pinf = _airSanityHelper(pinf);
+ pinf = _airSanityHelper(pinf);
+ pinf = _airSanityHelper(pinf);
+ if (AIR_EXISTS(pinf)) {
+ return airInsane_pInfExists;
+ }
+ ninf = -pinf;
+ if (AIR_EXISTS(ninf)) {
+ return airInsane_nInfExists;
+ }
+ nan = pinf / pinf;
+ if (AIR_EXISTS(nan)) {
+ return airInsane_NaNExists;
+ }
+ nanF = (float)nan;
+ pinfF = (float)pinf;
+ ninfF = (float)ninf;
+ airFPValToParts_f(&sign, &exp, &mant, nanF);
+ mant >>= 22;
+ if (AIR_QNANHIBIT != (int)mant) {
+ return airInsane_QNaNHiBit;
+ }
+ if (!(airFP_QNAN == airFPClass_f(nanF)
+ && airFP_POS_INF == airFPClass_f(pinfF)
+ && airFP_NEG_INF == airFPClass_f(ninfF))) {
+ /* really, this is verifying that assigning from a double to a
+ float maintains the FPClass for non-existant values */
+ return airInsane_FltDblFPClass;
+ }
+
+ /* just make sure AIR_DIO is reasonably set
+ (actually, this should be done by include/teem/need/dio.h) */
+ switch (AIR_DIO) {
+ case 0: break;
+ case 1: break;
+ default:
+ return airInsane_dio;
+ }
+
+ /* run-time 32/64-bit check */
+ size = 0;
+ switch (AIR_32BIT) {
+ case 1: size = 4; break;
+ case 0: size = 8; break;
+ default: break;
+ }
+ if (size != sizeof(size_t)) {
+ return airInsane_32Bit;
+ }
+
+ _airSanity = 1;
+ return airInsane_not;
+}
+
+const char
+_airInsaneErr[AIR_INSANE_MAX+1][AIR_STRLEN_MED] = {
+ "sanity checked PASSED!",
+ "TEEM_ENDIAN is wrong",
+ "AIR_EXISTS(+inf) was true",
+ "AIR_EXISTS(-inf) was true",
+ "AIR_EXISTS(NaN) was true",
+ "air_FPClass_f() wrong after double->float assignment",
+ "TEEM_QNANHIBIT is wrong",
+ "TEEM_DIO has invalid value",
+ "TEEM_32BIT is wrong",
+ "unsigned char isn't 8 bits",
+ "sizeof(float), sizeof(int) not both == 4",
+ "sizeof(double), sizeof(airLLong) not both == 8",
+};
+
+char _airBadInsane[] = "(invalid insane value)";
+
+const char *
+airInsaneErr(int insane) {
+
+ if (AIR_IN_CL(0, insane, AIR_INSANE_MAX)) {
+ return _airInsaneErr[insane];
+ }
+ else {
+ return _airBadInsane;
+ }
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/simple.c b/Utilities/ITK/Utilities/NrrdIO/simple.c
new file mode 100644
index 0000000000000000000000000000000000000000..fa44fcc2270d4760619caa13b9a9a81bccf9dcba
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/simple.c
@@ -0,0 +1,1412 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+#include "teem32bit.h"
+#include <limits.h>
+
+const char *
+nrrdBiffKey = "nrrd";
+
+/*
+******** nrrdSpaceDimension
+**
+** returns expected dimension of given space (from nrrdSpace* enum), or,
+** 0 if there is no expected dimension.
+**
+** The expected behavior here is to return 0 for nrrdSpaceUnknown, because
+** that is the right answer, not because its an error of any kind.
+*/
+unsigned int
+nrrdSpaceDimension(int space) {
+ char me[]="nrrdSpaceDimension";
+ int ret;
+
+ if (!( AIR_IN_OP(nrrdSpaceUnknown, space, nrrdSpaceLast) )) {
+ /* they gave us invalid or unknown space */
+ return 0;
+ }
+ switch (space) {
+ case nrrdSpaceRightAnteriorSuperior:
+ case nrrdSpaceLeftAnteriorSuperior:
+ case nrrdSpaceLeftPosteriorSuperior:
+ case nrrdSpaceScannerXYZ:
+ case nrrdSpace3DRightHanded:
+ case nrrdSpace3DLeftHanded:
+ ret = 3;
+ break;
+ case nrrdSpaceRightAnteriorSuperiorTime:
+ case nrrdSpaceLeftAnteriorSuperiorTime:
+ case nrrdSpaceLeftPosteriorSuperiorTime:
+ case nrrdSpaceScannerXYZTime:
+ case nrrdSpace3DRightHandedTime:
+ case nrrdSpace3DLeftHandedTime:
+ ret = 4;
+ break;
+ default:
+ fprintf(stderr, "%s: PANIC: nrrdSpace %d not implemented!\n", me, space);
+ exit(1);
+ break;
+ }
+ return ret;
+}
+
+/*
+******** nrrdSpaceSet
+**
+** What to use to set space, when a value from nrrdSpace enum is known
+*/
+int
+nrrdSpaceSet(Nrrd *nrrd, int space) {
+ char me[]="nrrdSpaceSet", err[AIR_STRLEN_MED];
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdSpaceUnknown != space) {
+ if (airEnumValCheck(nrrdSpace, space)) {
+ sprintf(err, "%s: given space (%d) not valid", me, space);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ nrrd->space = space;
+ nrrd->spaceDim = nrrdSpaceDimension(space);
+ return 0;
+}
+
+/*
+******** nrrdSpaceDimensionSet
+**
+** What to use to set space, based on spaceDim alone (nrrd->space set to
+** nrrdSpaceUnknown)
+*/
+int
+nrrdSpaceDimensionSet(Nrrd *nrrd, unsigned int spaceDim) {
+ char me[]="nrrdSpaceDimensionSet", err[AIR_STRLEN_MED];
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( spaceDim <= NRRD_SPACE_DIM_MAX )) {
+ sprintf(err, "%s: given spaceDim (%u) not valid", me, spaceDim);
+ biffAdd(NRRD, err); return 1;
+ }
+ nrrd->space = nrrdSpaceUnknown;
+ nrrd->spaceDim = spaceDim;
+ return 0;
+}
+
+/*
+******** nrrdSpaceOriginGet
+**
+** retrieves the spaceOrigin from given nrrd, and returns spaceDim
+** Indices 0 through spaceDim-1 are set in given vector[] to coords
+** of space origin, and all further indices are set to NaN
+*/
+unsigned int
+nrrdSpaceOriginGet(const Nrrd *nrrd,
+ double vector[NRRD_SPACE_DIM_MAX]) {
+ unsigned int sdi, ret;
+
+ if (nrrd && vector) {
+ for (sdi=0; sdi<nrrd->spaceDim; sdi++) {
+ vector[sdi] = nrrd->spaceOrigin[sdi];
+ }
+ for (sdi=nrrd->spaceDim; sdi<NRRD_SPACE_DIM_MAX; sdi++) {
+ vector[sdi] = AIR_NAN;
+ }
+ ret = nrrd->spaceDim;
+ } else {
+ ret = 0;
+ }
+ return ret;
+}
+
+/*
+******** nrrdSpaceOriginSet
+**
+** convenience function for setting spaceOrigin.
+** Note: space (or spaceDim) must be already set
+**
+** returns 1 if there were problems, 0 otherwise
+*/
+int
+nrrdSpaceOriginSet(Nrrd *nrrd,
+ double vector[NRRD_SPACE_DIM_MAX]) {
+ char me[]="nrrdSpaceOriginSet", err[AIR_STRLEN_MED];
+ unsigned int sdi;
+
+ if (!( nrrd && vector )) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( 0 < nrrd->spaceDim && nrrd->spaceDim <= NRRD_SPACE_DIM_MAX )) {
+ sprintf(err, "%s: set spaceDim %d not valid", me, nrrd->spaceDim);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ for (sdi=0; sdi<nrrd->spaceDim; sdi++) {
+ nrrd->spaceOrigin[sdi] = vector[sdi];
+ }
+ for (sdi=nrrd->spaceDim; sdi<NRRD_SPACE_DIM_MAX; sdi++) {
+ nrrd->spaceOrigin[sdi] = AIR_NAN;
+ }
+ return 0;
+}
+
+/*
+******** nrrdOriginCalculate
+**
+** makes an effort to calculate something like an "origin" (as in
+** nrrd->spaceOrigin) from the per-axis min, max, or spacing, when
+** there is no real space information. Like the spaceOrigin, this
+** location is supposed to be THE CENTER of the first sample. To
+** avoid making assumptions about the nrrd or the caller, a default
+** sample centering (defaultCenter) has to be provided (use either
+** nrrdCenterNode or nrrdCenterCell). The axes that are used
+** for the origin calculation have to be given explicitly- but they
+** are likely the return of nrrdDomainAxesGet
+**
+** The computed origin is put into the given vector (origin). The return
+** value takes on values from the nrrdOriginStatus* enum:
+**
+** nrrdOriginStatusUnknown: invalid arguments (e.g. NULL pointer, or
+** axis values out of range)
+**
+** nrrdOriginStatusDirection: the chosen axes have spaceDirection set,
+** which means caller should instead be using
+** nrrdSpaceOriginGet
+**
+** nrrdOriginStatusNoMin: can't compute "origin" without axis->min
+**
+** nrrdOriginStatusNoMaxOrSpacing: can't compute origin without either
+** axis->max or axis->spacing
+**
+** nrrdOriginStatusOkay: all is well
+*/
+int
+nrrdOriginCalculate(const Nrrd *nrrd,
+ unsigned int *axisIdx, unsigned int axisIdxNum,
+ int defaultCenter, double *origin) {
+ const NrrdAxisInfo *axis[NRRD_SPACE_DIM_MAX];
+ int center, size, okay, gotSpace, gotMin, gotMaxOrSpacing;
+ unsigned int ai;
+ double min, spacing;
+
+#define ERROR \
+ if (origin) { \
+ for (ai=0; ai<axisIdxNum; ai++) { \
+ origin[ai] = AIR_NAN; \
+ } \
+ }
+
+ if (!( nrrd
+ && (nrrdCenterCell == defaultCenter
+ || nrrdCenterNode == defaultCenter)
+ && origin )) {
+ ERROR;
+ return nrrdOriginStatusUnknown;
+ }
+
+ okay = AIR_TRUE;
+ for (ai=0; ai<axisIdxNum; ai++) {
+ okay &= axisIdx[ai] < nrrd->dim;
+ }
+ if (!okay) {
+ ERROR;
+ return nrrdOriginStatusUnknown;
+ }
+
+ /* learn axisInfo pointers */
+ for (ai=0; ai<axisIdxNum; ai++) {
+ axis[ai] = nrrd->axis + axisIdx[ai];
+ }
+
+ gotSpace = AIR_FALSE;
+ for (ai=0; ai<axisIdxNum; ai++) {
+ gotSpace |= AIR_EXISTS(axis[ai]->spaceDirection[0]);
+ }
+ if (nrrd->spaceDim > 0 && gotSpace) {
+ ERROR;
+ return nrrdOriginStatusDirection;
+ }
+
+ gotMin = AIR_TRUE;
+ for (ai=0; ai<axisIdxNum; ai++) {
+ gotMin &= AIR_EXISTS(axis[0]->min);
+ }
+ if (!gotMin) {
+ ERROR;
+ return nrrdOriginStatusNoMin;
+ }
+
+ gotMaxOrSpacing = AIR_TRUE;
+ for (ai=0; ai<axisIdxNum; ai++) {
+ gotMaxOrSpacing &= (AIR_EXISTS(axis[ai]->max)
+ || AIR_EXISTS(axis[ai]->spacing));
+ }
+ if (!gotMaxOrSpacing) {
+ ERROR;
+ return nrrdOriginStatusNoMaxOrSpacing;
+ }
+
+ for (ai=0; ai<axisIdxNum; ai++) {
+ size = axis[ai]->size;
+ min = axis[ai]->min;
+ center = (nrrdCenterUnknown != axis[ai]->center
+ ? axis[ai]->center
+ : defaultCenter);
+ spacing = (AIR_EXISTS(axis[ai]->spacing)
+ ? axis[ai]->spacing
+ : ((axis[ai]->max - min)
+ /(nrrdCenterCell == center ? size : size-1)));
+ origin[ai] = min + (nrrdCenterCell == center ? spacing/2 : 0);
+ }
+ return nrrdOriginStatusOkay;
+}
+
+void
+_nrrdSpaceVecScaleAdd2(double sum[NRRD_SPACE_DIM_MAX],
+ double sclA, const double vecA[NRRD_SPACE_DIM_MAX],
+ double sclB, const double vecB[NRRD_SPACE_DIM_MAX]) {
+ int ii;
+ double A, B;
+
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ A = AIR_EXISTS(vecA[ii]) ? vecA[ii] : 0;
+ B = AIR_EXISTS(vecB[ii]) ? vecB[ii] : 0;
+ sum[ii] = sclA*A + sclB*B;
+ }
+}
+
+void
+_nrrdSpaceVecScale(double out[NRRD_SPACE_DIM_MAX],
+ double scl, const double vec[NRRD_SPACE_DIM_MAX]) {
+ int ii;
+ double v;
+
+ for (ii=0; ii<NRRD_SPACE_DIM_MAX; ii++) {
+ v = AIR_EXISTS(vec[ii]) ? vec[ii] : 0;
+ out[ii] = scl*v;
+ }
+}
+
+double
+_nrrdSpaceVecNorm(int sdim, const double vec[NRRD_SPACE_DIM_MAX]) {
+ int di;
+ double nn;
+
+ nn = 0;
+ for (di=0; di<sdim; di++) {
+ nn += vec[di]*vec[di];
+ }
+ return sqrt(nn);
+}
+
+void
+_nrrdSpaceVecSetNaN(double vec[NRRD_SPACE_DIM_MAX]) {
+ int di;
+
+ for (di=0; di<NRRD_SPACE_DIM_MAX; di++) {
+ vec[di] = AIR_NAN;
+ }
+ return;
+}
+
+/*
+** _nrrdContentGet
+**
+** ALLOCATES a string for the content of a given nrrd
+** panics and exits if allocation failed
+*/
+char *
+_nrrdContentGet(const Nrrd *nin) {
+ char me[]="_nrrdContentGet";
+ char *ret;
+
+ ret = ((nin && nin->content) ?
+ airStrdup(nin->content) :
+ airStrdup(nrrdStateUnknownContent));
+ if (!ret) {
+ fprintf(stderr, "%s: PANIC: content strdup failed!\n", me);
+ exit(1);
+ }
+ return ret;
+}
+
+int
+_nrrdContentSet_nva (Nrrd *nout, const char *func,
+ char *content, const char *format, va_list arg) {
+ char me[]="_nrrdContentSet_nva", err[AIR_STRLEN_MED], *buff;
+
+ buff = (char *)malloc(128*AIR_STRLEN_HUGE);
+ if (!buff) {
+ sprintf(err, "%s: couln't alloc buffer!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ nout->content = (char *)airFree(nout->content);
+
+ /* we are currently praying that this won't overflow the "buff" array */
+ /* HEY: replace with vsnprintf or whatever when its available */
+ vsprintf(buff, format, arg);
+
+ nout->content = (char *)calloc(strlen("(,)")
+ + airStrlen(func)
+ + 1 /* '(' */
+ + airStrlen(content)
+ + 1 /* ',' */
+ + airStrlen(buff)
+ + 1 /* ')' */
+ + 1, sizeof(char)); /* '\0' */
+ if (!nout->content) {
+ sprintf(err, "%s: couln't alloc output content!", me);
+ biffAdd(NRRD, err); airFree(buff); return 1;
+ }
+ sprintf(nout->content, "%s(%s%s%s)", func, content,
+ airStrlen(buff) ? "," : "", buff);
+ airFree(buff); /* no NULL assignment, else compile warnings */
+ return 0;
+}
+
+int
+_nrrdContentSet (Nrrd *nout, const char *func,
+ char *content, const char *format, ...) {
+ char me[]="_nrrdContentSet", err[AIR_STRLEN_MED];
+ va_list ap;
+
+ va_start(ap, format);
+ if (_nrrdContentSet_nva(nout, func, content, format, ap)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); free(content); return 1;
+ }
+ va_end(ap);
+
+ /* free(content); */
+ return 0;
+}
+
+/*
+******** nrrdContentSet
+**
+** Kind of like sprintf, but for the content string of the nrrd.
+**
+** Whether or not we write a new content for an old nrrd ("nin") with
+** NULL content is decided here, according to
+** nrrdStateAlwaysSetContent.
+**
+** Does the string allocation and some attempts at error detection.
+** Does allow nout==nin, which requires some care.
+*/
+int
+nrrdContentSet (Nrrd *nout, const char *func,
+ const Nrrd *nin, const char *format, ...) {
+ char me[]="nrrdContentSet", err[AIR_STRLEN_MED];
+ va_list ap;
+ char *content;
+
+ if (!(nout && func && nin && format)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdStateDisableContent) {
+ /* we kill content always */
+ nout->content = (char *)airFree(nout->content);
+ return 0;
+ }
+ if (!nin->content && !nrrdStateAlwaysSetContent) {
+ /* there's no input content, and we're not supposed to invent any
+ content, so after freeing nout's content we're done */
+ nout->content = (char *)airFree(nout->content);
+ return 0;
+ }
+ /* we copy the input nrrd content first, before blowing away the
+ output content, in case nout == nin */
+ content = _nrrdContentGet(nin);
+ va_start(ap, format);
+ if (_nrrdContentSet_nva(nout, func, content, format, ap)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); va_end(ap); free(content); return 1;
+ }
+ va_end(ap);
+ free(content);
+
+ return 0;
+}
+
+/*
+******** nrrdDescribe
+**
+** writes verbose description of nrrd to given file
+*/
+void
+nrrdDescribe (FILE *file, const Nrrd *nrrd) {
+ unsigned int ai;
+
+ if (file && nrrd) {
+ fprintf(file, "Nrrd at 0x%p:\n", (void*)nrrd);
+ fprintf(file, "Data at 0x%p is " _AIR_SIZE_T_CNV
+ " elements of type %s.\n",
+ nrrd->data, nrrdElementNumber(nrrd),
+ airEnumStr(nrrdType, nrrd->type));
+ if (nrrdTypeBlock == nrrd->type) {
+ fprintf(file, "The blocks have size " _AIR_SIZE_T_CNV "\n",
+ nrrd->blockSize);
+ }
+ if (airStrlen(nrrd->content)) {
+ fprintf(file, "Content = \"%s\"\n", nrrd->content);
+ }
+ fprintf(file, "%d-dimensional array, with axes:\n", nrrd->dim);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (airStrlen(nrrd->axis[ai].label)) {
+ fprintf(file, "%d: (\"%s\") ", ai, nrrd->axis[ai].label);
+ } else {
+ fprintf(file, "%d: ", ai);
+ }
+ fprintf(file, "%s-centered, size=" _AIR_SIZE_T_CNV ", ",
+ airEnumStr(nrrdCenter, nrrd->axis[ai].center),
+ nrrd->axis[ai].size);
+ airSinglePrintf(file, NULL, "spacing=%lg, \n", nrrd->axis[ai].spacing);
+ airSinglePrintf(file, NULL, "thickness=%lg, \n",
+ nrrd->axis[ai].thickness);
+ airSinglePrintf(file, NULL, " axis(Min,Max) = (%lg,",
+ nrrd->axis[ai].min);
+ airSinglePrintf(file, NULL, "%lg)\n", nrrd->axis[ai].max);
+ if (airStrlen(nrrd->axis[ai].units)) {
+ fprintf(file, "units=%s, \n", nrrd->axis[ai].units);
+ }
+ }
+ /*
+ airSinglePrintf(file, NULL, "The min, max values are %lg",
+ nrrd->min);
+ airSinglePrintf(file, NULL, ", %lg\n", nrrd->max);
+ */
+ airSinglePrintf(file, NULL, "The old min, old max values are %lg",
+ nrrd->oldMin);
+ airSinglePrintf(file, NULL, ", %lg\n", nrrd->oldMax);
+ /* fprintf(file, "hasNonExist = %d\n", nrrd->hasNonExist); */
+ if (nrrd->cmtArr->len) {
+ fprintf(file, "Comments:\n");
+ for (ai=0; ai<nrrd->cmtArr->len; ai++) {
+ fprintf(file, "%s\n", nrrd->cmt[ai]);
+ }
+ }
+ fprintf(file, "\n");
+ }
+}
+
+/*
+** asserts all the properties associated with orientation information
+**
+** The most important part of this is asserting the per-axis mutual
+** exclusion of min/max/spacing/units versus using spaceDirection.
+*/
+int
+_nrrdFieldCheckSpaceInfo(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheckSpaceInfo", err[AIR_STRLEN_MED];
+ unsigned int dd, ii;
+ int exists;
+
+ if (!( !nrrd->space || !airEnumValCheck(nrrdSpace, nrrd->space) )) {
+ sprintf(err, "%s: space %d invalid", me, nrrd->space);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (!( nrrd->spaceDim <= NRRD_SPACE_DIM_MAX )) {
+ sprintf(err, "%s: space dimension %d is outside valid range "
+ "[0,NRRD_SPACE_DIM_MAX] = [0,%d]",
+ me, nrrd->dim, NRRD_SPACE_DIM_MAX);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (nrrd->spaceDim) {
+ if (nrrd->space) {
+ if (nrrdSpaceDimension(nrrd->space) != nrrd->spaceDim) {
+ sprintf(err, "%s: space %s has dimension %d but spaceDim is %d",
+ me, airEnumStr(nrrdSpace, nrrd->space),
+ nrrdSpaceDimension(nrrd->space), nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ /* check that all coeffs of spaceOrigin have consistent existance */
+ exists = AIR_EXISTS(nrrd->spaceOrigin[0]);
+ for (ii=0; ii<nrrd->spaceDim; ii++) {
+ if (exists ^ AIR_EXISTS(nrrd->spaceOrigin[ii])) {
+ sprintf(err, "%s: existance of space origin coefficients must "
+ "be consistent (val[0] not like val[%d])", me, ii);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ /* check that all coeffs of measurementFrame have consistent existance */
+ exists = AIR_EXISTS(nrrd->measurementFrame[0][0]);
+ for (dd=0; dd<nrrd->spaceDim; dd++) {
+ for (ii=0; ii<nrrd->spaceDim; ii++) {
+ if (exists ^ AIR_EXISTS(nrrd->measurementFrame[dd][ii])) {
+ sprintf(err, "%s: existance of measurement frame coefficients must "
+ "be consistent: [col][row] [%d][%d] not like [0][0])",
+ me, dd, ii);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ }
+ /* check on space directions */
+ for (dd=0; dd<nrrd->dim; dd++) {
+ exists = AIR_EXISTS(nrrd->axis[dd].spaceDirection[0]);
+ for (ii=1; ii<nrrd->spaceDim; ii++) {
+ if (exists ^ AIR_EXISTS(nrrd->axis[dd].spaceDirection[ii])) {
+ sprintf(err, "%s: existance of space direction %d coefficients "
+ "must be consistent (val[0] not like val[%d])", me,
+ dd, ii);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (exists) {
+ if (AIR_EXISTS(nrrd->axis[dd].min)
+ || AIR_EXISTS(nrrd->axis[dd].max)
+ || AIR_EXISTS(nrrd->axis[dd].spacing)
+ || airStrlen(nrrd->axis[dd].units)) {
+ sprintf(err, "%s: axis[%d] has a direction vector, and so can't "
+ "have min, max, spacing, or units set", me, dd);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ }
+ } else {
+ /* else there's not supposed to be anything in "space" */
+ if (nrrd->space) {
+ sprintf(err, "%s: space %s can't be set with spaceDim %d",
+ me, airEnumStr(nrrdSpace, nrrd->space), nrrd->spaceDim);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* -------- */
+ exists = AIR_FALSE;
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ exists |= airStrlen(nrrd->spaceUnits[dd]);
+ }
+ if (exists) {
+ sprintf(err, "%s: spaceDim is 0, but space units is set", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* -------- */
+ exists = AIR_FALSE;
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ exists |= AIR_EXISTS(nrrd->spaceOrigin[dd]);
+ }
+ if (exists) {
+ sprintf(err, "%s: spaceDim is 0, but space origin is set", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* -------- */
+ exists = AIR_FALSE;
+ for (dd=0; dd<NRRD_SPACE_DIM_MAX; dd++) {
+ for (ii=0; ii<NRRD_DIM_MAX; ii++) {
+ exists |= AIR_EXISTS(nrrd->axis[ii].spaceDirection[dd]);
+ }
+ }
+ if (exists) {
+ sprintf(err, "%s: spaceDim is 0, but space directions are set", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+/* --------------------- per-field checks ----------------
+**
+** Strictly speacking, these checks only apply to the nrrd itself, not
+** to a potentially incomplete nrrd in the process of being read, so
+** the NrrdIoState stuff is not an issue. This limits the utility of
+** these to the field parsers for handling the more complex state
+** involved in parsing some of the NRRD fields (like units).
+**
+** return 0 if it is valid, and 1 if there is an error
+*/
+
+int
+_nrrdFieldCheck_noop(const Nrrd *nrrd, int useBiff) {
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(useBiff);
+ return 0;
+}
+
+int
+_nrrdFieldCheck_type(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_type", err[AIR_STRLEN_MED];
+
+ if (airEnumValCheck(nrrdType, nrrd->type)) {
+ sprintf(err, "%s: type (%d) is not valid", me, nrrd->type);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_block_size(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_block_size", err[AIR_STRLEN_MED];
+
+ if (nrrdTypeBlock == nrrd->type && (!(0 < nrrd->blockSize)) ) {
+ sprintf(err, "%s: type is %s but nrrd->blockSize ("
+ _AIR_SIZE_T_CNV ") invalid", me,
+ airEnumStr(nrrdType, nrrdTypeBlock),
+ nrrd->blockSize);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (nrrdTypeBlock != nrrd->type && (0 < nrrd->blockSize)) {
+ sprintf(err, "%s: type is %s (not block) but blockSize is "
+ _AIR_SIZE_T_CNV, me,
+ airEnumStr(nrrdType, nrrd->type), nrrd->blockSize);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_dimension(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_dimension", err[AIR_STRLEN_MED];
+
+ if (!AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)) {
+ sprintf(err, "%s: dimension %u is outside valid range [1,%d]",
+ me, nrrd->dim, NRRD_DIM_MAX);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_space(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_space", err[AIR_STRLEN_MED];
+
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_space_dimension(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_space_dimension", err[AIR_STRLEN_MED];
+
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_sizes(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_sizes", err[AIR_STRLEN_MED];
+ size_t size[NRRD_DIM_MAX];
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoSize, size);
+ if (_nrrdSizeCheck(size, nrrd->dim, useBiff)) {
+ sprintf(err, "%s: trouble with array sizes", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_spacings(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_spacings", err[AIR_STRLEN_MED];
+ double val[NRRD_DIM_MAX];
+ unsigned int ai;
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoSpacing, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (!( !airIsInf_d(val[ai]) && (airIsNaN(val[ai]) || (0 != val[ai])) )) {
+ sprintf(err, "%s: axis %d spacing (%g) invalid", me, ai, val[ai]);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_thicknesses(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_thicknesses", err[AIR_STRLEN_MED];
+ double val[NRRD_DIM_MAX];
+ unsigned int ai;
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoThickness, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ /* note that unlike spacing, we allow zero thickness,
+ but it makes no sense to be negative */
+ if (!( !airIsInf_d(val[ai]) && (airIsNaN(val[ai]) || (0 <= val[ai])) )) {
+ sprintf(err, "%s: axis %d thickness (%g) invalid", me, ai, val[ai]);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_axis_mins(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_axis_mins", err[AIR_STRLEN_MED];
+ double val[NRRD_DIM_MAX];
+ unsigned int ai;
+ int ret;
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoMin, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if ((ret=airIsInf_d(val[ai]))) {
+ sprintf(err, "%s: axis %d min %sinf invalid",
+ me, ai, 1==ret ? "+" : "-");
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* HEY: contemplate checking min != max, but what about stub axes ... */
+ return 0;
+}
+
+int
+_nrrdFieldCheck_axis_maxs(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_axis_maxs", err[AIR_STRLEN_MED];
+ double val[NRRD_DIM_MAX];
+ unsigned int ai;
+ int ret;
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoMax, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if ((ret=airIsInf_d(val[ai]))) {
+ sprintf(err, "%s: axis %d max %sinf invalid",
+ me, ai, 1==ret ? "+" : "-");
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: trouble", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* HEY: contemplate checking min != max, but what about stub axes ... */
+ return 0;
+}
+
+int
+_nrrdFieldCheck_space_directions(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_space_directions", err[AIR_STRLEN_MED];
+
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: space info problem", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_centers(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_centers", err[AIR_STRLEN_MED];
+ unsigned int ai;
+ int val[NRRD_DIM_MAX];
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoCenter, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (!( nrrdCenterUnknown == val[ai]
+ || !airEnumValCheck(nrrdCenter, val[ai]) )) {
+ sprintf(err, "%s: axis %d center %d invalid", me, ai, val[ai]);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_kinds(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_kinds", err[AIR_STRLEN_MED];
+ int val[NRRD_DIM_MAX];
+ unsigned int wantLen, ai;
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoKind, val);
+ for (ai=0; ai<nrrd->dim; ai++) {
+ if (!( nrrdKindUnknown == val[ai]
+ || !airEnumValCheck(nrrdKind, val[ai]) )) {
+ sprintf(err, "%s: axis %d kind %d invalid", me, ai, val[ai]);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ wantLen = nrrdKindSize(val[ai]);
+ if (wantLen && wantLen != nrrd->axis[ai].size) {
+ sprintf(err, "%s: axis %d kind %s requires size %d, but have "
+ _AIR_SIZE_T_CNV, me,
+ ai, airEnumStr(nrrdKind, val[ai]), wantLen, nrrd->axis[ai].size);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_labels(const Nrrd *nrrd, int useBiff) {
+ /* char me[]="_nrrdFieldCheck_labels", err[AIR_STRLEN_MED]; */
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(useBiff);
+
+ /* don't think there's anything to do here: the label strings are
+ either NULL (which is okay) or non-NULL, but we have no restrictions
+ on the validity of the strings */
+
+ return 0;
+}
+
+int
+_nrrdFieldCheck_units(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_units", err[AIR_STRLEN_MED];
+
+ /* as with labels- the strings themselves don't need checking themselves */
+ /* but per-axis units cannot be set for axes with space directions ... */
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: space info problem", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_old_min(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_old_min", err[AIR_STRLEN_MED];
+ int ret;
+
+ if ((ret=airIsInf_d(nrrd->oldMin))) {
+ sprintf(err, "%s: old min %sinf invalid", me, 1==ret ? "+" : "-");
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* oldMin == oldMax is perfectly valid */
+ return 0;
+}
+
+int
+_nrrdFieldCheck_old_max(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_old_max", err[AIR_STRLEN_MED];
+ int ret;
+
+ if ((ret=airIsInf_d(nrrd->oldMax))) {
+ sprintf(err, "%s: old max %sinf invalid", me, 1==ret ? "+" : "-");
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ /* oldMin == oldMax is perfectly valid */
+ return 0;
+}
+
+int
+_nrrdFieldCheck_keyvalue(const Nrrd *nrrd, int useBiff) {
+ /* char me[]="_nrrdFieldCheck_keyvalue", err[AIR_STRLEN_MED]; */
+
+ AIR_UNUSED(nrrd);
+ AIR_UNUSED(useBiff);
+
+ /* nrrdKeyValueAdd() ensures that keys aren't repeated,
+ not sure what other kind of checking can be done */
+
+ return 0;
+}
+
+int
+_nrrdFieldCheck_space_units(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_space_units", err[AIR_STRLEN_MED];
+
+ /* not sure if there's anything to specifically check for the
+ space units themselves ... */
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: space info problem", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_space_origin(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_space_origin", err[AIR_STRLEN_MED];
+
+ /* pre-Fri Feb 11 04:25:36 EST 2005, I thought that
+ the spaceOrigin must be known to describe the
+ space/orientation stuff, but that's too restrictive,
+ which is why below says AIR_FALSE instead of AIR_TRUE */
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: space info problem", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+_nrrdFieldCheck_measurement_frame(const Nrrd *nrrd, int useBiff) {
+ char me[]="_nrrdFieldCheck_measurement_frame", err[AIR_STRLEN_MED];
+
+ if (_nrrdFieldCheckSpaceInfo(nrrd, useBiff)) {
+ sprintf(err, "%s: space info problem", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ return 0;
+}
+
+int
+(*_nrrdFieldCheck[NRRD_FIELD_MAX+1])(const Nrrd *, int useBiff) = {
+ _nrrdFieldCheck_noop, /* nonfield */
+ _nrrdFieldCheck_noop, /* comment */
+ _nrrdFieldCheck_noop, /* content */
+ _nrrdFieldCheck_noop, /* number */
+ _nrrdFieldCheck_type,
+ _nrrdFieldCheck_block_size,
+ _nrrdFieldCheck_dimension,
+ _nrrdFieldCheck_space,
+ _nrrdFieldCheck_space_dimension,
+ _nrrdFieldCheck_sizes,
+ _nrrdFieldCheck_spacings,
+ _nrrdFieldCheck_thicknesses,
+ _nrrdFieldCheck_axis_mins,
+ _nrrdFieldCheck_axis_maxs,
+ _nrrdFieldCheck_space_directions,
+ _nrrdFieldCheck_centers,
+ _nrrdFieldCheck_kinds,
+ _nrrdFieldCheck_labels,
+ _nrrdFieldCheck_units,
+ _nrrdFieldCheck_noop, /* min */
+ _nrrdFieldCheck_noop, /* max */
+ _nrrdFieldCheck_old_min,
+ _nrrdFieldCheck_old_max,
+ _nrrdFieldCheck_noop, /* endian */
+ _nrrdFieldCheck_noop, /* encoding */
+ _nrrdFieldCheck_noop, /* line_skip */
+ _nrrdFieldCheck_noop, /* byte_skip */
+ _nrrdFieldCheck_keyvalue,
+ _nrrdFieldCheck_noop, /* sample units */
+ _nrrdFieldCheck_space_units,
+ _nrrdFieldCheck_space_origin,
+ _nrrdFieldCheck_measurement_frame,
+ _nrrdFieldCheck_noop, /* data_file */
+};
+
+int
+_nrrdCheck (const Nrrd *nrrd, int checkData, int useBiff) {
+ char me[]="_nrrdCheck", err[AIR_STRLEN_MED];
+ int fi;
+
+ if (!nrrd) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ if (checkData) {
+ if (!(nrrd->data)) {
+ sprintf(err, "%s: nrrd has NULL data pointer", me);
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ for (fi=nrrdField_unknown+1; fi<nrrdField_last; fi++) {
+ /* yes, this will call _nrrdFieldCheckSpaceInfo() many many times */
+ if (_nrrdFieldCheck[fi](nrrd, AIR_TRUE)) {
+ sprintf(err, "%s: trouble with %s field", me,
+ airEnumStr(nrrdField, fi));
+ biffMaybeAdd(NRRD, err, useBiff); return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+******** nrrdCheck()
+**
+** does some consistency checks for things that can go wrong in a nrrd
+** returns non-zero if there is a problem, zero if no problem.
+**
+** You might think that this should be merged with _nrrdHeaderCheck(),
+** but that is really only for testing sufficiency of information
+** required to do the data reading.
+*/
+int
+nrrdCheck (const Nrrd *nrrd) {
+ char me[]="nrrdCheck", err[AIR_STRLEN_MED];
+
+ if (_nrrdCheck(nrrd, AIR_TRUE, AIR_TRUE)) {
+ sprintf(err, "%s: trouble", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+/*
+******** nrrdSameSize()
+**
+** returns 1 iff given two nrrds have same dimension and axes sizes.
+** This does NOT look at the type of the elements.
+**
+** The intended user of this is someone who really wants the nrrds to be
+** the same size, so that if they aren't, some descriptive (error) message
+** can be generated according to useBiff
+*/
+int
+nrrdSameSize (const Nrrd *n1, const Nrrd *n2, int useBiff) {
+ char me[]="nrrdSameSize", err[AIR_STRLEN_MED];
+ unsigned int ai;
+
+ if (!(n1 && n2)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return 0;
+ }
+ if (n1->dim != n2->dim) {
+ sprintf(err, "%s: n1->dim (%d) != n2->dim (%d)", me, n1->dim, n2->dim);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return 0;
+ }
+ for (ai=0; ai<n1->dim; ai++) {
+ if (n1->axis[ai].size != n2->axis[ai].size) {
+ sprintf(err, "%s: n1->axis[%d].size (" _AIR_SIZE_T_CNV
+ ") != n2->axis[%d].size (" _AIR_SIZE_T_CNV ")",
+ me, ai, n1->axis[ai].size, ai, n2->axis[ai].size);
+ biffMaybeAdd(NRRD, err, useBiff);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+/*
+******** nrrdElementSize()
+**
+** So just how many bytes long is one element in this nrrd? This is
+** needed (over the simple nrrdTypeSize[] array) because some nrrds
+** may be of "block" type, and because it does bounds checking on
+** nrrd->type. Returns 0 if given a bogus nrrd->type, or if the block
+** size isn't greater than zero (in which case it sets nrrd->blockSize
+** to 0, just out of spite). This function never returns a negative
+** value; using (!nrrdElementSize(nrrd)) is a sufficient check for
+** invalidity.
+**
+** Besides learning how many bytes long one element is, this function
+** is useful as a way of detecting an invalid blocksize on a block nrrd.
+*/
+size_t
+nrrdElementSize (const Nrrd *nrrd) {
+
+ if (!( nrrd && !airEnumValCheck(nrrdType, nrrd->type) )) {
+ return 0;
+ }
+ if (nrrdTypeBlock != nrrd->type) {
+ return nrrdTypeSize[nrrd->type];
+ }
+ /* else its block type */
+ if (nrrd->blockSize > 0) {
+ return nrrd->blockSize;
+ }
+ /* else we got an invalid block size */
+ /* nrrd->blockSize = 0; */
+ return 0;
+}
+
+/*
+******** nrrdElementNumber()
+**
+** takes the place of old "nrrd->num": the number of elements in the
+** nrrd, which is just the product of the axis sizes. A return of 0
+** means there's a problem. Negative numbers are never returned.
+**
+** does NOT use biff
+*/
+size_t
+nrrdElementNumber (const Nrrd *nrrd) {
+ size_t num, size[NRRD_DIM_MAX];
+ unsigned int ai;
+
+ if (!nrrd) {
+ return 0;
+ }
+ /* else */
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoSize, size);
+ if (_nrrdSizeCheck(size, nrrd->dim, AIR_FALSE)) {
+ /* the nrrd's size information is invalid, can't proceed */
+ return 0;
+ }
+ num = 1;
+ for (ai=0; ai<nrrd->dim; ai++) {
+ /* negative numbers and overflow were caught by _nrrdSizeCheck() */
+ num *= size[ai];
+ }
+ return num;
+}
+
+void
+_nrrdSplitSizes(size_t *pieceSize, size_t *pieceNum, Nrrd *nrrd,
+ unsigned int split) {
+ unsigned int ai;
+ size_t size[NRRD_DIM_MAX];
+
+ nrrdAxisInfoGet_nva(nrrd, nrrdAxisInfoSize, size);
+ *pieceSize = 1;
+ for (ai=0; ai<split; ai++) {
+ *pieceSize *= size[ai];
+ }
+ *pieceNum = 1;
+ for (ai=split; ai<nrrd->dim; ai++) {
+ *pieceNum *= size[ai];
+ }
+ return;
+}
+
+/*
+******** nrrdHasNonExistSet()
+**
+** This function will always (assuming type is valid) set the value of
+** nrrd->hasNonExist to either nrrdNonExistTrue or nrrdNonExistFalse,
+** and it will return that value. For lack of a more sophisticated
+** policy, blocks are currently always considered to be existant
+** values (because nrrdTypeIsIntegral[nrrdTypeBlock] is currently true).
+** This function will ALWAYS determine the correct answer and set the
+** value of nrrd->hasNonExist: it ignores the value of
+** nrrd->hasNonExist on the input nrrd. Exception: if nrrd is null or
+** type is bogus, no action is taken and nrrdNonExistUnknown is
+** returned.
+**
+** Because this will return either nrrdNonExistTrue or nrrdNonExistFalse,
+** and because the C boolean value of these are true and false (respectively),
+** it is possible (and encouraged) to use the return of this function
+** as the expression of a conditional:
+**
+** if (nrrdHasNonExistSet(nrrd)) {
+** ... handle existance of non-existant values ...
+** }
+*/
+/*
+int
+nrrdHasNonExistSet (Nrrd *nrrd) {
+ size_t I, N;
+ float val;
+
+ if (!( nrrd && !airEnumValCheck(nrrdType, nrrd->type) ))
+ return nrrdNonExistUnknown;
+
+ if (nrrdTypeIsIntegral[nrrd->type]) {
+ nrrd->hasNonExist = nrrdNonExistFalse;
+ } else {
+ nrrd->hasNonExist = nrrdNonExistFalse;
+ N = nrrdElementNumber(nrrd);
+ for (I=0; I<N; I++) {
+ val = nrrdFLookup[nrrd->type](nrrd->data, I);
+ if (!AIR_EXISTS(val)) {
+ nrrd->hasNonExist = nrrdNonExistTrue;
+ break;
+ }
+ }
+ }
+ return nrrd->hasNonExist;
+}
+*/
+
+int
+_nrrdCheckEnums (void) {
+ char me[]="_nrrdCheckEnums", err[AIR_STRLEN_MED],
+ which[AIR_STRLEN_SMALL];
+
+ if (nrrdFormatTypeLast-1 != NRRD_FORMAT_TYPE_MAX) {
+ strcpy(which, "nrrdFormat"); goto err;
+ }
+ if (nrrdTypeLast-1 != NRRD_TYPE_MAX) {
+ strcpy(which, "nrrdType"); goto err;
+ }
+ if (nrrdEncodingTypeLast-1 != NRRD_ENCODING_TYPE_MAX) {
+ strcpy(which, "nrrdEncodingType"); goto err;
+ }
+ if (nrrdCenterLast-1 != NRRD_CENTER_MAX) {
+ strcpy(which, "nrrdCenter"); goto err;
+ }
+ if (nrrdAxisInfoLast-1 != NRRD_AXIS_INFO_MAX) {
+ strcpy(which, "nrrdAxisInfo"); goto err;
+ }
+ /* can't really check on endian enum */
+ if (nrrdField_last-1 != NRRD_FIELD_MAX) {
+ strcpy(which, "nrrdField"); goto err;
+ }
+ if (nrrdHasNonExistLast-1 != NRRD_HAS_NON_EXIST_MAX) {
+ strcpy(which, "nrrdHasNonExist"); goto err;
+ }
+
+ /* no errors so far */
+ return 0;
+
+ err:
+ sprintf(err, "%s: Last vs. MAX incompatibility for %s enum", me, which);
+ biffAdd(NRRD, err); return 1;
+}
+
+/*
+******** nrrdSanity()
+**
+** makes sure that all the basic assumptions of nrrd hold for
+** the architecture/etc which we're currently running on.
+**
+** returns 1 if all is okay, 0 if there is a problem
+*/
+int
+nrrdSanity (void) {
+ char me[]="nrrdSanity", err[AIR_STRLEN_MED];
+ int aret, type;
+ size_t maxsize;
+ airLLong tmpLLI;
+ airULLong tmpULLI;
+ static int _nrrdSanity = 0;
+
+ if (_nrrdSanity) {
+ /* we've been through this once before and things looked okay ... */
+ /* Is this thread-safe? I think so. If we assume that any two
+ threads are going to compute the same value, isn't it the case
+ that, at worse, both of them will go through all the tests and
+ then set _nrrdSanity to the same thing? */
+ return 1;
+ }
+
+ aret = airSanity();
+ if (aret != airInsane_not) {
+ sprintf(err, "%s: airSanity() failed: %s", me, airInsaneErr(aret));
+ biffAdd(NRRD, err); return 0;
+ }
+
+ if (!nrrdDefWriteEncoding) {
+ sprintf(err, "%s: nrrdDefWriteEncoding is NULL", me);
+ biffAdd(NRRD, err); return 0;
+ }
+ if (airEnumValCheck(nrrdCenter, nrrdDefCenter)) {
+ sprintf(err, "%s: nrrdDefCenter (%d) not in valid range [%d,%d]",
+ me, nrrdDefCenter,
+ nrrdCenterUnknown+1, nrrdCenterLast-1);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ if (!( nrrdTypeSize[nrrdTypeChar] == sizeof(char)
+ && nrrdTypeSize[nrrdTypeUChar] == sizeof(unsigned char)
+ && nrrdTypeSize[nrrdTypeShort] == sizeof(short)
+ && nrrdTypeSize[nrrdTypeUShort] == sizeof(unsigned short)
+ && nrrdTypeSize[nrrdTypeInt] == sizeof(int)
+ && nrrdTypeSize[nrrdTypeUInt] == sizeof(unsigned int)
+ && nrrdTypeSize[nrrdTypeLLong] == sizeof(airLLong)
+ && nrrdTypeSize[nrrdTypeULLong] == sizeof(airULLong)
+ && nrrdTypeSize[nrrdTypeFloat] == sizeof(float)
+ && nrrdTypeSize[nrrdTypeDouble] == sizeof(double) )) {
+ sprintf(err, "%s: sizeof() for nrrd types has problem: "
+ "expected (%d,%d,%d,%d,%d,%d,%d,%d,%d,%d) "
+ "but got (%d,%d,%d,%d,%d,%d,%d,%d,%d,%d)", me,
+ (int)nrrdTypeSize[nrrdTypeChar],
+ (int)nrrdTypeSize[nrrdTypeUChar],
+ (int)nrrdTypeSize[nrrdTypeShort],
+ (int)nrrdTypeSize[nrrdTypeUShort],
+ (int)nrrdTypeSize[nrrdTypeInt],
+ (int)nrrdTypeSize[nrrdTypeUInt],
+ (int)nrrdTypeSize[nrrdTypeLLong],
+ (int)nrrdTypeSize[nrrdTypeULLong],
+ (int)nrrdTypeSize[nrrdTypeFloat],
+ (int)nrrdTypeSize[nrrdTypeDouble],
+ (int)sizeof(char),
+ (int)sizeof(unsigned char),
+ (int)sizeof(short),
+ (int)sizeof(unsigned short),
+ (int)sizeof(int),
+ (int)sizeof(unsigned int),
+ (int)sizeof(airLLong),
+ (int)sizeof(airULLong),
+ (int)sizeof(float),
+ (int)sizeof(double));
+ biffAdd(NRRD, err); return 0;
+ }
+
+ /* check on NRRD_TYPE_SIZE_MAX */
+ maxsize = 0;
+ for (type=nrrdTypeUnknown+1; type<=nrrdTypeLast-2; type++) {
+ maxsize = AIR_MAX(maxsize, nrrdTypeSize[type]);
+ }
+ if (maxsize != NRRD_TYPE_SIZE_MAX) {
+ sprintf(err, "%s: actual max type size is %d != %d == NRRD_TYPE_SIZE_MAX",
+ me, (int)maxsize, NRRD_TYPE_SIZE_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ /* check on NRRD_TYPE_BIGGEST */
+ if (maxsize != sizeof(NRRD_TYPE_BIGGEST)) {
+ sprintf(err, "%s: actual max type size is %d != "
+ "%d == sizeof(NRRD_TYPE_BIGGEST)",
+ me, (int)maxsize, (int)sizeof(NRRD_TYPE_BIGGEST));
+ biffAdd(NRRD, err); return 0;
+ }
+
+ /* nrrd-defined type min/max values */
+ tmpLLI = NRRD_LLONG_MAX;
+ if (tmpLLI != NRRD_LLONG_MAX) {
+ sprintf(err, "%s: long long int can't hold NRRD_LLONG_MAX ("
+ AIR_ULLONG_FMT ")", me,
+ NRRD_LLONG_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+ tmpLLI += 1;
+ if (NRRD_LLONG_MIN != tmpLLI) {
+ sprintf(err, "%s: long long int min (" AIR_LLONG_FMT ") or max ("
+ AIR_LLONG_FMT ") incorrect", me,
+ NRRD_LLONG_MIN, NRRD_LLONG_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+ tmpULLI = NRRD_ULLONG_MAX;
+ if (tmpULLI != NRRD_ULLONG_MAX) {
+ sprintf(err,
+ "%s: unsigned long long int can't hold NRRD_ULLONG_MAX ("
+ AIR_ULLONG_FMT ")",
+ me, NRRD_ULLONG_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+ tmpULLI += 1;
+ if (tmpULLI != 0) {
+ sprintf(err, "%s: unsigned long long int max (" AIR_ULLONG_FMT
+ ") incorrect", me,
+ NRRD_ULLONG_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ if (_nrrdCheckEnums()) {
+ sprintf(err, "%s: problem with enum definition", me);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ if (!( NRRD_DIM_MAX >= 3 )) {
+ sprintf(err, "%s: NRRD_DIM_MAX == %d seems awfully small, doesn't it?",
+ me, NRRD_DIM_MAX);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ if (!nrrdTypeIsIntegral[nrrdTypeBlock]) {
+ sprintf(err, "%s: nrrdTypeInteger[nrrdTypeBlock] is not true, things "
+ "could get wacky", me);
+ biffAdd(NRRD, err); return 0;
+ }
+
+ /* HEY: any other assumptions built into teem? */
+
+ _nrrdSanity = 1;
+ return 1;
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/string.c b/Utilities/ITK/Utilities/NrrdIO/string.c
new file mode 100644
index 0000000000000000000000000000000000000000..7935e075f66a09615f0748cfbe52b24221f9a7e4
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/string.c
@@ -0,0 +1,373 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+
+/* this has to default to false in order for airStrtok to be a
+ functional substitute for strtok() */
+int airStrtokQuoting = AIR_FALSE;
+
+/*
+******** airStrdup()
+**
+** because they didn't put strdup() in ANSI ...
+** This will return NULL if given NULL.
+*/
+char *
+airStrdup(const char *s) {
+ char *ret;
+
+ if (!s) {
+ ret = NULL;
+ }
+ else {
+ ret = (char *)malloc(strlen(s)+1);
+ if (ret) {
+ strcpy(ret, s);
+ }
+ }
+ return ret;
+}
+
+/*
+******** airStrlen()
+**
+** just like strlen, but safe to call on NULL (for which return is 0)
+*/
+size_t
+airStrlen(const char *s) {
+ size_t ret;
+
+ if (!s) {
+ ret = 0;
+ }
+ else {
+ ret = strlen(s);
+ }
+ return ret;
+}
+
+/*
+******** airStrtok()
+**
+** thread-safe strtok() replacement. Use just like strtok(), but on
+** each call to parse a given string, pass as the last argument the
+** address of a char*, to be used for saving state while the string is
+** traversed. Like strtok(), this will alter the "s" array passed to
+** it on the first call, and like strtok(), this returns pointers into
+** this string (rather than allocating new strings for each token).
+*/
+char *
+airStrtok(char *s, const char *ct, char **last) {
+ char *h, *e, *q;
+
+ if (!(ct && last)) {
+ /* can't do any work, bail */
+ return NULL;
+ }
+ h = s ? s : *last;
+ if (!airStrlen(h))
+ return NULL;
+ h += strspn(h, ct);
+ if ('\"' == *h && airStrtokQuoting) {
+ /* something is trying to be quoted, and, we'll respect that */
+ /* have to find the next un-escaped '\"' */
+ h++;
+ q = h;
+ while (*q && !('\"' == *q && '\\' != q[-1])) {
+ q++;
+ }
+ if (*q) {
+ /* we found an unescaped '\"' */
+ e = q;
+ } else {
+ /* give up; pretend we never tried to do this quoting stuff */
+ e = h + strcspn(h, ct);
+ }
+ } else {
+ e = h + strcspn(h, ct);
+ }
+ if ('\0' == *e) {
+ *last = e;
+ }
+ else {
+ *e = '\0';
+ *last = e + 1;
+ }
+ return h;
+}
+
+/*
+******** airStrntok()
+**
+** returns the number of tokens parsable by airStrtok(), but does
+** NOT alter the given string
+*/
+unsigned int
+airStrntok(const char *_s, const char *ct) {
+ char *s, *t, *l=NULL;
+ unsigned int n = 0;
+
+ if (_s && ct) {
+ s = airStrdup(_s);
+ t = airStrtok(s, ct, &l);
+ while (t) {
+ n++;
+ t = airStrtok(NULL, ct, &l);
+ }
+ airFree(s); /* no NULL assignment to s, else compile warnings */
+ }
+ return n;
+}
+
+char *
+airStrtrans(char *s, char from, char to) {
+ int i, l;
+
+ if (s) {
+ l = strlen(s);
+ for (i=0; i<l; i++) {
+ s[i] = (s[i] == from ? to : s[i]);
+ }
+ }
+ return s;
+}
+
+/*
+******** airEndsWith
+**
+** if "s" ends with "suff", then returns 1, 0 otherwise
+*/
+int
+airEndsWith(const char *s, const char *suff) {
+
+ if (!(s && suff))
+ return 0;
+ if (!(strlen(s) >= strlen(suff)))
+ return 0;
+ if (!strncmp(s + strlen(s) - strlen(suff), suff, strlen(suff)))
+ return 1;
+ else
+ return 0;
+}
+
+/*
+******** airUnescape()
+**
+** unescapes \\ and \n in place in a given string.
+**
+*/
+char *
+airUnescape(char *s) {
+ int i, j, len, found=0;
+
+ len = airStrlen(s);
+ if (!len)
+ return s;
+
+ for (i=1, j=0; i<len; i++, j++) {
+ if (s[i-1] == '\\' && s[i] == '\\') {
+ s[j] = '\\'; i++; found = 1;
+ } else if (s[i-1] == '\\' && s[i] == 'n') {
+ s[j] = '\n'; i++; found = 1;
+ } else {
+ s[j] = s[i-1]; found = 0;
+ }
+ }
+ if (i == len || !found) s[j++] = s[len-1];
+ s[j] = 0;
+
+ return s;
+}
+
+/*
+******** airOneLinify()
+**
+** converts all contiguous white space (as determined by isspace()) to
+** a single ' ', entirely removes non-printable (as determined by
+** isprint()) characters, and entirely removes white space contiguous
+** with the end of the string, even if that means shrinking the string
+** to "".
+**
+** Useful for cleaning up lines of text to be saved as strings in
+** fields of other structs
+*/
+char *
+airOneLinify(char *s) {
+ int i, j, len;
+
+ len = airStrlen(s);
+ if (!len)
+ return s;
+
+ /* convert white space to space (' '), and delete unprintables */
+ for (i=0; i<len; i++) {
+ if (isspace(s[i])) {
+ s[i] = ' ';
+ continue;
+ }
+ if (!isprint(s[i])) {
+ for (j=i; j<len; j++) {
+ /* this will copy the '\0' at the end */
+ s[j] = s[j+1];
+ }
+ i--;
+ continue;
+ }
+ }
+
+ /* compress all contiguous spaces into one */
+ for (i=0; i<len; i++) {
+ while (' ' == s[i] && ' ' == s[i+1]) {
+ for (j=i+1; j<len; j++) {
+ s[j] = s[j+1];
+ }
+ }
+ }
+
+ /* lose trailing white space */
+ len = airStrlen(s);
+ for (i=len-1; i>=0 && ' ' == s[i]; i--) {
+ s[i] = '\0';
+ }
+
+ return s;
+}
+
+/*
+******** airToLower()
+**
+** calls tolower() on all characters in a string, and returns the same
+** pointer that it was given
+*/
+char *
+airToLower(char *str) {
+ char *c;
+
+ if (str) {
+ c = str;
+ while (*c) {
+ *c = tolower(*c);
+ c++;
+ }
+ }
+ return str;
+}
+
+/*
+******** airToUpper()
+**
+** calls toupper() on all characters in a string, and returns the same
+** pointer that it was given
+*/
+char *
+airToUpper(char *str) {
+ char *c;
+
+ if (str) {
+ c = str;
+ while (*c) {
+ *c = toupper(*c);
+ c++;
+ }
+ }
+ return str;
+}
+
+/*
+******** airOneLine()
+**
+** gets one line from "file", putting it into an array if given size.
+** "size" must be the size of line buffer "line": the size which
+** "line" was allocated for, not the number of non-null characters it
+** was meant to hold. "size" must be at least 3. Always
+** null-terminates the contents of the array (except if the arguments
+** are invalid). The idea is that the null-termination replaces the
+** line termination.
+**
+** 0: if saw EOF before seeing a newline, or arguments are invalid
+** 1: if line was a single newline
+** n; n <= size: if line was n-1 characters followed by newline
+** size+1: if didn't see a newline within size-1 characters
+**
+** So except for returns of -1 and size+1, the return is the number of
+** characters comprising the line, including the newline character.
+**
+** For all you DOS\Windows\Cygwin users, this will quietly pretend that
+** a "\r\n" pair is really just "\n", including the way that characters
+** comprising the line are counted. However, there is no pretension
+** that on those platforms, "\n" by itself does not actually count as
+** a newline.
+*/
+unsigned int
+airOneLine(FILE *file, char *line, int size) {
+ int c=0, i;
+
+ if (!(size >= 3 /* need room for a character and a Windows newline */
+ && line && file)) {
+ return 0;
+ }
+ /* c is always set at least once, but not so for any char in line[] */
+ for (i=0;
+ (i <= size-2 /* room for line[i] and \0 after that */
+ && EOF != (c=getc(file)) /* didn't hit EOF trying to read char */
+ && c != '\n'); /* char isn't newline */
+ ++i) {
+ line[i] = c;
+ }
+
+ if (EOF == c) {
+ /* for-loop terminated because we hit EOF */
+ line[0] = '\0';
+ return 0;
+ } else if ('\n' == c) {
+ /* for-loop terminated because we hit '\n' */
+ if (i >= 1 && '\r' == line[i-1]) {
+ /* newline was "\r\n" */
+ i--;
+ }
+ line[i] = '\0';
+ return i+1;
+ } else {
+ /* for-loop terminated because we got to end of buffer (i == size-1) */
+ c = getc(file);
+ /* but see if we were about to get a "\n" */
+ if ('\n' == c) {
+ if ('\r' == line[i-1]) {
+ /* newline was "\r\n" */
+ i--;
+ }
+ line[i] = '\0';
+ return i+1;
+ } else {
+ /* weren't about to get a "\n", we really did run out of buffer */
+ if (EOF != c) {
+ ungetc(c, file); /* we're allowed one ungetc on ANY stream */
+ }
+ line[size-1] = '\0';
+ return size+1;
+ }
+ }
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/subset.c b/Utilities/ITK/Utilities/NrrdIO/subset.c
new file mode 100644
index 0000000000000000000000000000000000000000..5663d20c5a82143e5b52330c1b1e3fdfef83ec0f
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/subset.c
@@ -0,0 +1,329 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+
+/*
+******** nrrdSlice()
+**
+** slices a nrrd along a given axis, at a given position.
+**
+** This is a newer version of the procedure, which is simpler, faster,
+** and requires less memory overhead than the first one. It is based
+** on the observation that any slice is a periodic square-wave pattern
+** in the original data (viewed as a one- dimensional array). The
+** characteristics of that periodic pattern are how far from the
+** beginning it starts (offset), the length of the "on" part (length),
+** the period (period), and the number of periods (numper).
+*/
+int
+nrrdSlice(Nrrd *nout, const Nrrd *nin, unsigned int saxi, size_t pos) {
+ char me[]="nrrdSlice", func[]="slice", err[AIR_STRLEN_MED];
+ size_t
+ I,
+ rowLen, /* length of segment */
+ colStep, /* distance between start of each segment */
+ colLen, /* number of periods */
+ szOut[NRRD_DIM_MAX];
+ unsigned int ai, outdim;
+ int map[NRRD_DIM_MAX];
+ char *src, *dest;
+
+ if (!(nin && nout)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nout == nin) {
+ sprintf(err, "%s: nout==nin disallowed", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (1 == nin->dim) {
+ sprintf(err, "%s: can't slice a 1-D nrrd; use nrrd{I,F,D}Lookup[]", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( saxi < nin->dim )) {
+ sprintf(err, "%s: slice axis %d out of bounds (0 to %d)",
+ me, saxi, nin->dim-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( pos < nin->axis[saxi].size )) {
+ sprintf(err, "%s: position " _AIR_SIZE_T_CNV
+ " out of bounds (0 to " _AIR_SIZE_T_CNV ")",
+ me, pos, nin->axis[saxi].size-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* this shouldn't actually be necessary ... */
+ if (!nrrdElementSize(nin)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ /* set up control variables */
+ rowLen = colLen = 1;
+ for (ai=0; ai<nin->dim; ai++) {
+ if (ai < saxi) {
+ rowLen *= nin->axis[ai].size;
+ } else if (ai > saxi) {
+ colLen *= nin->axis[ai].size;
+ }
+ }
+ rowLen *= nrrdElementSize(nin);
+ colStep = rowLen*nin->axis[saxi].size;
+
+ outdim = nin->dim-1;
+ for (ai=0; ai<outdim; ai++) {
+ map[ai] = ai + (ai >= saxi);
+ szOut[ai] = nin->axis[map[ai]].size;
+ }
+ nout->blockSize = nin->blockSize;
+ if (nrrdMaybeAlloc_nva(nout, nin->type, outdim, szOut)) {
+ sprintf(err, "%s: failed to create slice", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ /* the skinny */
+ src = (char *)nin->data;
+ dest = (char *)nout->data;
+ src += rowLen*pos;
+ for (I=0; I<colLen; I++) {
+ /* HEY: replace with AIR_MEMCPY() or similar, when applicable */
+ memcpy(dest, src, rowLen);
+ src += colStep;
+ dest += rowLen;
+ }
+
+ /* copy the peripheral information */
+ if (nrrdAxisInfoCopy(nout, nin, map, NRRD_AXIS_INFO_NONE)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdContentSet(nout, func, nin, "%d,%d", saxi, pos)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdBasicInfoCopy(nout, nin,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* but we can set the origin more accurately */
+ if (AIR_EXISTS(nout->spaceOrigin[0])) {
+ _nrrdSpaceVecScaleAdd2(nout->spaceOrigin,
+ 1.0, nin->spaceOrigin,
+ pos, nin->axis[saxi].spaceDirection);
+ }
+
+ return 0;
+}
+
+/*
+******** nrrdCrop()
+**
+** select some sub-volume inside a given nrrd, producing an output
+** nrrd with the same dimensions, but with equal or smaller sizes
+** along each axis.
+*/
+int
+nrrdCrop(Nrrd *nout, const Nrrd *nin, size_t *min, size_t *max) {
+ char me[]="nrrdCrop", func[] = "crop", err[AIR_STRLEN_MED],
+ buff1[NRRD_DIM_MAX*30], buff2[AIR_STRLEN_SMALL];
+ unsigned int ai;
+ size_t I,
+ lineSize, /* #bytes in one scanline to be copied */
+ typeSize, /* size of data type */
+ cIn[NRRD_DIM_MAX], /* coords for line start, in input */
+ cOut[NRRD_DIM_MAX], /* coords for line start, in output */
+ szIn[NRRD_DIM_MAX],
+ szOut[NRRD_DIM_MAX],
+ idxIn, idxOut, /* linear indices for input and output */
+ numLines; /* number of scanlines in output nrrd */
+ char *dataIn, *dataOut;
+
+ /* errors */
+ if (!(nout && nin && min && max)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nout == nin) {
+ sprintf(err, "%s: nout==nin disallowed", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ for (ai=0; ai<nin->dim; ai++) {
+ if (!(min[ai] <= max[ai])) {
+ sprintf(err, "%s: axis %d min (" _AIR_SIZE_T_CNV
+ ") not <= max (" _AIR_SIZE_T_CNV ")",
+ me, ai, min[ai], max[ai]);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( min[ai] < nin->axis[ai].size && max[ai] < nin->axis[ai].size )) {
+ sprintf(err, "%s: axis %d min (" _AIR_SIZE_T_CNV
+ ") or max (" _AIR_SIZE_T_CNV ") out of bounds [0,"
+ _AIR_SIZE_T_CNV "]",
+ me, ai, min[ai], max[ai], nin->axis[ai].size-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+ /* this shouldn't actually be necessary ... */
+ if (!nrrdElementSize(nin)) {
+ sprintf(err, "%s: nrrd reports zero element size!", me);
+ biffAdd(NRRD, err); return 1;
+ }
+
+ /* allocate */
+ nrrdAxisInfoGet_nva(nin, nrrdAxisInfoSize, szIn);
+ numLines = 1;
+ for (ai=0; ai<nin->dim; ai++) {
+ szOut[ai] = max[ai] - min[ai] + 1;
+ if (ai) {
+ numLines *= szOut[ai];
+ }
+ }
+ nout->blockSize = nin->blockSize;
+ if (nrrdMaybeAlloc_nva(nout, nin->type, nin->dim, szOut)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ lineSize = szOut[0]*nrrdElementSize(nin);
+
+ /* the skinny */
+ typeSize = nrrdElementSize(nin);
+ dataIn = (char *)nin->data;
+ dataOut = (char *)nout->data;
+ memset(cOut, 0, NRRD_DIM_MAX*sizeof(unsigned int));
+ /*
+ printf("!%s: nin->dim = %d\n", me, nin->dim);
+ printf("!%s: min = %d %d %d\n", me, min[0], min[1], min[2]);
+ printf("!%s: szIn = %d %d %d\n", me, szIn[0], szIn[1], szIn[2]);
+ printf("!%s: szOut = %d %d %d\n", me, szOut[0], szOut[1], szOut[2]);
+ printf("!%s: lineSize = %d\n", me, lineSize);
+ printf("!%s: typeSize = %d\n", me, typeSize);
+ printf("!%s: numLines = %d\n", me, (int)numLines);
+ */
+ for (I=0; I<numLines; I++) {
+ for (ai=0; ai<nin->dim; ai++) {
+ cIn[ai] = cOut[ai] + min[ai];
+ }
+ NRRD_INDEX_GEN(idxOut, cOut, szOut, nin->dim);
+ NRRD_INDEX_GEN(idxIn, cIn, szIn, nin->dim);
+ /*
+ printf("!%s: %5d: cOut=(%3d,%3d,%3d) --> idxOut = %5d\n",
+ me, (int)I, cOut[0], cOut[1], cOut[2], (int)idxOut);
+ printf("!%s: %5d: cIn=(%3d,%3d,%3d) --> idxIn = %5d\n",
+ me, (int)I, cIn[0], cIn[1], cIn[2], (int)idxIn);
+ */
+ memcpy(dataOut + idxOut*typeSize, dataIn + idxIn*typeSize, lineSize);
+ /* the lowest coordinate in cOut[] will stay zero, since we are
+ copying one (1-D) scanline at a time */
+ NRRD_COORD_INCR(cOut, szOut, nin->dim, 1);
+ }
+ if (nrrdAxisInfoCopy(nout, nin, NULL, (NRRD_AXIS_INFO_SIZE_BIT |
+ NRRD_AXIS_INFO_MIN_BIT |
+ NRRD_AXIS_INFO_MAX_BIT ))) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ for (ai=0; ai<nin->dim; ai++) {
+ nrrdAxisInfoPosRange(&(nout->axis[ai].min), &(nout->axis[ai].max),
+ nin, ai, min[ai], max[ai]);
+ /* do the safe thing first */
+ nout->axis[ai].kind = _nrrdKindAltered(nin->axis[ai].kind, AIR_FALSE);
+ /* try cleverness */
+ if (!nrrdStateKindNoop) {
+ if (nout->axis[ai].size == nin->axis[ai].size) {
+ /* we can safely copy kind; the samples didn't change */
+ nout->axis[ai].kind = nin->axis[ai].kind;
+ } else if (nrrdKind4Color == nin->axis[ai].kind
+ && 3 == szOut[ai]) {
+ nout->axis[ai].kind = nrrdKind3Color;
+ } else if (nrrdKind4Vector == nin->axis[ai].kind
+ && 3 == szOut[ai]) {
+ nout->axis[ai].kind = nrrdKind3Vector;
+ } else if ((nrrdKind4Vector == nin->axis[ai].kind
+ || nrrdKind3Vector == nin->axis[ai].kind)
+ && 2 == szOut[ai]) {
+ nout->axis[ai].kind = nrrdKind2Vector;
+ } else if (nrrdKindRGBAColor == nin->axis[ai].kind
+ && 0 == min[ai]
+ && 2 == max[ai]) {
+ nout->axis[ai].kind = nrrdKindRGBColor;
+ } else if (nrrdKind2DMaskedSymMatrix == nin->axis[ai].kind
+ && 1 == min[ai]
+ && max[ai] == szIn[ai]-1) {
+ nout->axis[ai].kind = nrrdKind2DSymMatrix;
+ } else if (nrrdKind2DMaskedMatrix == nin->axis[ai].kind
+ && 1 == min[ai]
+ && max[ai] == szIn[ai]-1) {
+ nout->axis[ai].kind = nrrdKind2DMatrix;
+ } else if (nrrdKind3DMaskedSymMatrix == nin->axis[ai].kind
+ && 1 == min[ai]
+ && max[ai] == szIn[ai]-1) {
+ nout->axis[ai].kind = nrrdKind3DSymMatrix;
+ } else if (nrrdKind3DMaskedMatrix == nin->axis[ai].kind
+ && 1 == min[ai]
+ && max[ai] == szIn[ai]-1) {
+ nout->axis[ai].kind = nrrdKind3DMatrix;
+ }
+ }
+ }
+ strcpy(buff1, "");
+ for (ai=0; ai<nin->dim; ai++) {
+ sprintf(buff2, "%s[" _AIR_SIZE_T_CNV "," _AIR_SIZE_T_CNV "]",
+ (ai ? "x" : ""), min[ai], max[ai]);
+ strcat(buff1, buff2);
+ }
+ if (nrrdContentSet(nout, func, nin, "%s", buff1)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdBasicInfoCopy(nout, nin,
+ NRRD_BASIC_INFO_DATA_BIT
+ | NRRD_BASIC_INFO_TYPE_BIT
+ | NRRD_BASIC_INFO_BLOCKSIZE_BIT
+ | NRRD_BASIC_INFO_DIMENSION_BIT
+ | NRRD_BASIC_INFO_CONTENT_BIT
+ | NRRD_BASIC_INFO_COMMENTS_BIT
+ | NRRD_BASIC_INFO_KEYVALUEPAIRS_BIT)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ /* but we can set the origin more accurately */
+ if (AIR_EXISTS(nout->spaceOrigin[0])) {
+ for (ai=0; ai<nin->dim; ai++) {
+ _nrrdSpaceVecScaleAdd2(nout->spaceOrigin,
+ 1.0, nout->spaceOrigin,
+ min[ai], nin->axis[ai].spaceDirection);
+ }
+ }
+
+
+ return 0;
+}
+
diff --git a/Utilities/ITK/Utilities/NrrdIO/teem32bit.h b/Utilities/ITK/Utilities/NrrdIO/teem32bit.h
new file mode 100644
index 0000000000000000000000000000000000000000..99c0a24b0d0d415c7d99b13d6c5d1fb115fea808
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/teem32bit.h
@@ -0,0 +1,39 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+/*
+** the end result of this is that the source file which includes
+** this can be sure that TEEM_32BIT is set, and can be sure that
+** it is set to either 0 or 1
+*/
+
+#ifndef TEEM_32BIT
+# error TEEM_32BIT not defined, see architecture-specific .mk file or check compilation options
+#elif TEEM_32BIT == 1
+# /* okay, its 1 */
+#elif TEEM_32BIT == 0
+# /* okay, its 0 */
+#else
+# error TEEM_32BIT not set to 0 or 1, see architecture-specific .mk file or check compilation options
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/teemDio.h b/Utilities/ITK/Utilities/NrrdIO/teemDio.h
new file mode 100644
index 0000000000000000000000000000000000000000..a693e1b46c681bc508a57c5606a0e6b3a016bdd2
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/teemDio.h
@@ -0,0 +1,39 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+/*
+** the end result of this is that the source file which includes
+** this can be sure that TEEM_DIO is set, and can be sure that
+** it is set to either 0 or 1
+*/
+
+#ifndef TEEM_DIO
+# error TEEM_DIO not defined, see architecture-specific .mk file or check compilation options
+#elif TEEM_DIO == 1
+# /* okay, its 1 */
+#elif TEEM_DIO == 0
+# /* okay, its 0 */
+#else
+# error TEEM_DIO not set to 1 or 0, see architecture-specific .mk file or check compilation options
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/teemEndian.h b/Utilities/ITK/Utilities/NrrdIO/teemEndian.h
new file mode 100644
index 0000000000000000000000000000000000000000..22125847323bf65964658ef64c0531f462a0e887
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/teemEndian.h
@@ -0,0 +1,39 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+/*
+** the end result of this is that the source file which includes
+** this can be sure that TEEM_ENDIAN is set, and can be sure that
+** it is set to either 1234 or 4321
+*/
+
+#ifndef TEEM_ENDIAN
+# error TEEM_ENDIAN not defined, see architecture-specific .mk file or check compilation options
+#elif TEEM_ENDIAN == 1234
+# /* okay, its little endian */
+#elif TEEM_ENDIAN == 4321
+# /* okay, its big endian */
+#else
+# error TEEM_ENDIAN not set to 1234 (little endian) or 4321 (big endian), see architecture-specific .mk file or check compilation options
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/teemPng.h b/Utilities/ITK/Utilities/NrrdIO/teemPng.h
new file mode 100644
index 0000000000000000000000000000000000000000..128d527031bb4f930f73391779af50aebe3501ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/teemPng.h
@@ -0,0 +1,35 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+/*
+** the end result of this is that the source file which includes
+** this can be sure that TEEM_ZLIB is set, so that the required
+** compression library is always built in when PNG support is requested
+*/
+
+#ifdef TEEM_PNG
+# ifndef TEEM_ZLIB
+# error TEEM_PNG set, but TEEM_ZLIB not set
+# endif
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/teemQnanhibit.h b/Utilities/ITK/Utilities/NrrdIO/teemQnanhibit.h
new file mode 100644
index 0000000000000000000000000000000000000000..ef0b461bff101d283bbedf206b4ee5c931f9d443
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/teemQnanhibit.h
@@ -0,0 +1,39 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+/*
+** the end result of this is that the source file which includes
+** this can be sure that TEEM_QNANHIBIT is set, and can be sure that
+** it is set to either 0 or 1
+*/
+
+#ifndef TEEM_QNANHIBIT
+# error TEEM_QNANHIBIT not defined, see architecture-specific .mk file or check compilation options
+#elif TEEM_QNANHIBIT == 1
+# /* okay, its 1 */
+#elif TEEM_QNANHIBIT == 0
+# /* okay, its 0 */
+#else
+# error TEEM_QNANHIBIT not set to 0 or 1, see architecture-specific .mk file or check compilation options
+#endif
diff --git a/Utilities/ITK/Utilities/NrrdIO/unteem.pl b/Utilities/ITK/Utilities/NrrdIO/unteem.pl
new file mode 100644
index 0000000000000000000000000000000000000000..3a9a3899dd7a597d35dfdfc0ef9342758aaca5aa
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/unteem.pl
@@ -0,0 +1,56 @@
+#
+# NrrdIO: stand-alone code for basic nrrd functionality
+# Copyright (C) 2005 Gordon Kindlmann
+# Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+#
+# This software is provided 'as-is', without any express or implied
+# warranty. In no event will the authors be held liable for any
+# damages arising from the use of this software.
+#
+# Permission is granted to anyone to use this software for any
+# purpose, including commercial applications, and to alter it and
+# redistribute it freely, subject to the following restrictions:
+#
+# 1. The origin of this software must not be misrepresented; you must
+# not claim that you wrote the original software. If you use this
+# software in a product, an acknowledgment in the product
+# documentation would be appreciated but is not required.
+#
+# 2. Altered source versions must be plainly marked as such, and must
+# not be misrepresented as being the original software.
+#
+# 3. This notice may not be removed or altered from any source distribution.
+#
+
+#
+# This helps in converting teem source files into NrrdIO source files,
+# by changing the way #includes are done, and by excluding the lines
+# delimited by "BEGIN non-NrrdIO" and "END non-NrrdIO", as well as doing
+# some other hacks
+#
+
+if (exists $ENV{"ITK_NRRDIO"}) {
+ $ITK = 1;
+} else {
+ $ITK = 0;
+}
+
+$printing = 1;
+while (<>) {
+ $printing = 0 if (m/BEGIN non-NrrdIO/);
+ s|#include "air.h"|#include "NrrdIO.h"|g;
+ s|#include "biff.h"|#include "NrrdIO.h"|g;
+ s|#include "nrrd.h"|#include "NrrdIO.h"|g;
+ s|#include <teem(.*)>|#include "teem$1"|g;
+ if ($ITK) {
+ s|\/\* NrrdIO-hack-000 \*\/|\/\* THE FOLLOWING INCLUDE IS ONLY FOR THE ITK DISTRIBUTION.\n This header mangles the symbols in the NrrdIO library, preventing\n conflicts in applications linked against two versions of NrrdIO. \*\/\n#include "itk_NrrdIO_mangle.h"|g;
+ } else {
+ s|\/\* NrrdIO-hack-000 \*\/||g;
+ }
+ s|\/\* NrrdIO-hack-001 \*\/|#define TEEM_BUILD 1|g;
+ s|.* \/\* NrrdIO-hack-002 \*\/|#if 1|g;
+ s|.* \/\* NrrdIO-hack-003 \*\/|int nrrdStateVerboseIO = 0;|g;
+
+ print if $printing;
+ $printing = 1 if (m/END non-NrrdIO/);
+}
diff --git a/Utilities/ITK/Utilities/NrrdIO/write.c b/Utilities/ITK/Utilities/NrrdIO/write.c
new file mode 100644
index 0000000000000000000000000000000000000000..3c50e47206b6dc04f27f3b92353c7867c7971313
--- /dev/null
+++ b/Utilities/ITK/Utilities/NrrdIO/write.c
@@ -0,0 +1,959 @@
+/*
+ NrrdIO: stand-alone code for basic nrrd functionality
+ Copyright (C) 2005 Gordon Kindlmann
+ Copyright (C) 2004, 2003, 2002, 2001, 2000, 1999, 1998 University of Utah
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any
+ damages arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any
+ purpose, including commercial applications, and to alter it and
+ redistribute it freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must
+ not claim that you wrote the original software. If you use this
+ software in a product, an acknowledgment in the product
+ documentation would be appreciated but is not required.
+
+ 2. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+ 3. This notice may not be removed or altered from any source distribution.
+*/
+
+#include "NrrdIO.h"
+#include "privateNrrd.h"
+#include "teem32bit.h"
+
+/*
+ #include <sys/types.h>
+ #include <unistd.h>
+*/
+
+int
+nrrdIoStateSet (NrrdIoState *nio, int parm, int value) {
+ char me[]="nrrdIoStateSet", err[AIR_STRLEN_MED];
+
+ if (!nio) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!( AIR_IN_OP(nrrdIoStateUnknown, parm, nrrdIoStateLast) )) {
+ sprintf(err, "%s: identifier %d not in valid range [%d,%d]", me,
+ parm, nrrdIoStateUnknown+1, nrrdIoStateLast-1);
+ biffAdd(NRRD, err); return 1;
+ }
+ switch (parm) {
+ case nrrdIoStateDetachedHeader:
+ nio->detachedHeader = !!value;
+ break;
+ case nrrdIoStateBareText:
+ nio->bareText = !!value;
+ break;
+ case nrrdIoStateCharsPerLine:
+ if (value < 40) {
+ sprintf(err, "%s: %d charsPerLine is awfully small", me, value);
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->charsPerLine = value;
+ break;
+ case nrrdIoStateValsPerLine:
+ if (value < 4) {
+ sprintf(err, "%s: %d valsPerLine is awfully small", me, value);
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->valsPerLine = value;
+ break;
+ case nrrdIoStateSkipData:
+ nio->skipData = !!value;
+ break;
+ case nrrdIoStateKeepNrrdDataFileOpen:
+ nio->keepNrrdDataFileOpen = !!value;
+ break;
+ case nrrdIoStateZlibLevel:
+ if (!( AIR_IN_CL(-1, value, 9) )) {
+ sprintf(err, "%s: zlibLevel %d invalid", me, value);
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->zlibLevel = value;
+ break;
+ case nrrdIoStateZlibStrategy:
+ if (!( AIR_IN_OP(nrrdZlibStrategyUnknown, value, nrrdZlibStrategyLast) )) {
+ sprintf(err, "%s: zlibStrategy %d invalid", me, value);
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->zlibStrategy = value;
+ break;
+ case nrrdIoStateBzip2BlockSize:
+ if (!( AIR_IN_CL(-1, value, 9) )) {
+ sprintf(err, "%s: bzip2BlockSize %d invalid", me, value);
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->bzip2BlockSize = value;
+ break;
+ default:
+ fprintf(stderr, "!%s: PANIC: didn't recognize parm %d\n", me, parm);
+ exit(1);
+ }
+ return 0;
+}
+
+int
+nrrdIoStateEncodingSet (NrrdIoState *nio, const NrrdEncoding *encoding) {
+ char me[]="nrrdIoStateEncodingSet", err[AIR_STRLEN_MED];
+
+ if (!( nio && encoding )) {
+ sprintf(err, "%s: got NULL pointer", me);
+ if (nio) {
+ nio->encoding = nrrdEncodingUnknown;
+ }
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!encoding->available()) {
+ sprintf(err, "%s: %s encoding isn't actually available", me,
+ encoding->name);
+ nio->encoding = nrrdEncodingUnknown;
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->encoding = encoding;
+ return 0;
+}
+
+int
+nrrdIoStateFormatSet (NrrdIoState *nio, const NrrdFormat *format) {
+ char me[]="nrrdIoStateFormatSet", err[AIR_STRLEN_MED];
+
+ if (!( nio && format )) {
+ sprintf(err, "%s: got NULL pointer", me);
+ if (nio) {
+ nio->format = nrrdFormatUnknown;
+ }
+ biffAdd(NRRD, err); return 1;
+ }
+ if (!format->available()) {
+ sprintf(err, "%s: %s format isn't actually available", me, format->name);
+ nio->format = nrrdFormatUnknown;
+ biffAdd(NRRD, err); return 1;
+ }
+ nio->format = format;
+ return 0;
+}
+
+/*
+** no biff
+*/
+int
+nrrdIoStateGet (NrrdIoState *nio, int parm) {
+ char me[]="nrrdIoStateGet";
+ int value;
+
+ if (!nio) {
+ /* got NULL pointer */
+ return -1;
+ }
+ if (!( AIR_IN_OP(nrrdIoStateUnknown, parm, nrrdIoStateLast) )) {
+ /* got bogus parameter identifier */
+ return -1;
+ }
+ switch (parm) {
+ case nrrdIoStateDetachedHeader:
+ value = !!nio->detachedHeader;
+ break;
+ case nrrdIoStateBareText:
+ value = !!nio->bareText;
+ break;
+ case nrrdIoStateCharsPerLine:
+ value = nio->charsPerLine;
+ break;
+ case nrrdIoStateValsPerLine:
+ value = nio->valsPerLine;
+ break;
+ case nrrdIoStateSkipData:
+ value = !!nio->skipData;
+ break;
+ case nrrdIoStateKeepNrrdDataFileOpen:
+ value = !!nio->keepNrrdDataFileOpen;
+ break;
+ case nrrdIoStateZlibLevel:
+ value = nio->zlibLevel;
+ break;
+ case nrrdIoStateZlibStrategy:
+ value = nio->zlibStrategy;
+ break;
+ case nrrdIoStateBzip2BlockSize:
+ value = nio->bzip2BlockSize;
+ break;
+ default:
+ fprintf(stderr, "!%s: PANIC: didn't recognize parm %d\n", me, parm);
+ exit(1);
+ }
+ return value;
+}
+
+/*
+** no biff
+*/
+const NrrdEncoding *
+nrrdIoStateEncodingGet (NrrdIoState *nio) {
+
+ return nio ? nio->encoding : nrrdEncodingUnknown;
+}
+
+/*
+** no biff
+*/
+const NrrdFormat *
+nrrdIoStateFormatGet (NrrdIoState *nio) {
+
+ return nio ? nio->format : nrrdFormatUnknown;
+}
+
+void
+_nrrdStrcatSpaceVector(char *str, int spaceDim,
+ const double val[NRRD_SPACE_DIM_MAX]) {
+ char buff[AIR_STRLEN_MED]; /* bad Gordon */
+ int dd;
+
+ if (AIR_EXISTS(val[0])) {
+ strcat(str, "(");
+ for (dd=0; dd<spaceDim; dd++) {
+ strcpy(buff, "");
+ airSinglePrintf(NULL, buff, "%lg", val[dd]);
+ strcat(str, buff);
+ sprintf(buff, "%s", dd < spaceDim-1 ? "," : ")");
+ strcat(str, buff);
+ }
+ } else {
+ strcat(str, _nrrdNoSpaceVector);
+ }
+ return;
+}
+
+int
+_nrrdFieldInteresting (const Nrrd *nrrd, NrrdIoState *nio, int field) {
+ int ret;
+ unsigned int ai;
+
+ if (!( nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && nio
+ && nio->encoding
+ && AIR_IN_OP(nrrdField_unknown, field, nrrdField_last) )) {
+ return 0;
+ }
+
+ ret = 0;
+ switch (field) {
+ case nrrdField_comment:
+ /* comments and key/value pairs are always handled differently (by
+ being printed explicity), so they are never "interesting" */
+ break;
+ case nrrdField_content:
+ ret = !!(airStrlen(nrrd->content));
+ break;
+ case nrrdField_number:
+ /* "number" is entirely redundant with "sizes", which is a
+ required field. Absolutely nothing is lost in eliding "number"
+ from the header, so "number" is NEVER interesting. Should this
+ judgement later be found in error, this is the one place where
+ the policy change can be implemented */
+ break;
+ case nrrdField_type:
+ /* this is vital */
+ ret = 1;
+ break;
+ case nrrdField_block_size:
+ ret = (nrrdTypeBlock == nrrd->type);
+ break;
+ case nrrdField_dimension:
+ /* this is vital */
+ ret = 1;
+ break;
+ case nrrdField_space:
+ /* its interesting if its known */
+ ret = (nrrdSpaceUnknown != nrrd->space);
+ break;
+ case nrrdField_space_dimension:
+ /* its interesting if its non-zero and if space is not known */
+ ret = (nrrd->spaceDim > 0 && nrrdSpaceUnknown == nrrd->space);
+ break;
+ case nrrdField_sizes:
+ /* this is vital */
+ ret = 1;
+ break;
+ case nrrdField_spacings:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= AIR_EXISTS(nrrd->axis[ai].spacing);
+ }
+ break;
+ case nrrdField_thicknesses:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= AIR_EXISTS(nrrd->axis[ai].thickness);
+ }
+ break;
+ case nrrdField_axis_mins:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= AIR_EXISTS(nrrd->axis[ai].min);
+ }
+ break;
+ case nrrdField_axis_maxs:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= AIR_EXISTS(nrrd->axis[ai].max);
+ }
+ break;
+ case nrrdField_space_directions:
+ ret = nrrd->spaceDim > 0;
+ break;
+ case nrrdField_centers:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= (nrrdCenterUnknown != nrrd->axis[ai].center);
+ }
+ break;
+ case nrrdField_kinds:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= (nrrdKindUnknown != nrrd->axis[ai].kind);
+ }
+ break;
+ case nrrdField_labels:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= !!(airStrlen(nrrd->axis[ai].label));
+ }
+ break;
+ case nrrdField_units:
+ for (ai=0; ai<nrrd->dim; ai++) {
+ ret |= !!(airStrlen(nrrd->axis[ai].units));
+ }
+ break;
+ case nrrdField_min:
+ case nrrdField_max:
+ /* these no longer exist in the Nrrd struct; we never write them */
+ ret = AIR_FALSE;
+ break;
+ case nrrdField_old_min:
+ ret = AIR_EXISTS(nrrd->oldMin);
+ break;
+ case nrrdField_old_max:
+ ret = AIR_EXISTS(nrrd->oldMax);
+ break;
+ case nrrdField_endian:
+ ret = nio->encoding->endianMatters && 1 < nrrdElementSize(nrrd);
+ break;
+ case nrrdField_encoding:
+ /* this is vital */
+ ret = 1;
+ break;
+ case nrrdField_line_skip:
+ ret = nio->lineSkip > 0;
+ break;
+ case nrrdField_byte_skip:
+ ret = nio->byteSkip != 0;
+ break;
+ case nrrdField_keyvalue:
+ /* comments and key/value pairs are always handled differently (by
+ being printed explicity), so they are never "interesting" */
+ break;
+ case nrrdField_sample_units:
+ ret = airStrlen(nrrd->sampleUnits);
+ break;
+ case nrrdField_space_units:
+ for (ai=0; ai<nrrd->spaceDim; ai++) {
+ ret |= !!(airStrlen(nrrd->spaceUnits[ai]));
+ }
+ break;
+ case nrrdField_space_origin:
+ /* we're trusting other validity checks to ensure that
+ all the coeffs exist or not, together */
+ ret = (nrrd->spaceDim > 0
+ && AIR_EXISTS(nrrd->spaceOrigin[0]));
+ break;
+ case nrrdField_measurement_frame:
+ /* we're trusting other validity checks to ensure that
+ all the coeffs exist or not, together */
+ ret = (nrrd->spaceDim > 0
+ && AIR_EXISTS(nrrd->measurementFrame[0][0]));
+ break;
+ case nrrdField_data_file:
+ /* detached header was either requested or is required */
+ ret = (nio->detachedHeader
+ || nio->dataFNFormat
+ || nio->dataFNArr->len > 1);
+ break;
+ }
+
+ return ret;
+}
+
+/*
+** _nrrdSprintFieldInfo
+**
+** this prints "<prefix><field>: <info>" into *strP (after allocating it for
+** big enough, usually with a stupidly big margin of error), in a form
+** suitable to be written to NRRD or other image headers. This will always
+** print something (for valid inputs), even stupid <info>s like
+** "(unknown endian)". It is up to the caller to decide which fields
+** are worth writing, via _nrrdFieldInteresting().
+**
+** NOTE: some of these fields make sense in non-NRRD files (e.g. all
+** the per-axis information), but many only make sense in NRRD files.
+** This is just one example of NRRD-format-specific stuff that is not
+** in formatNRRD.c
+**
+** HEY: the use of "10", "20", and "30" as stand-ins for "maximum
+** number of characters that might be used for printing this integral
+** value" is getting pretty tiresome...
+*/
+void
+_nrrdSprintFieldInfo (char **strP, char *prefix,
+ const Nrrd *nrrd, NrrdIoState *nio, int field) {
+ char me[]="_nrrdSprintFieldInfo", buff[AIR_STRLEN_MED], *fnb;
+ double colvec[NRRD_SPACE_DIM_MAX];
+ const char *fs;
+ unsigned int ii, dd;
+ int fslen, fdlen, endi, maxl;
+
+ if (!( strP && prefix
+ && nrrd
+ && AIR_IN_CL(1, nrrd->dim, NRRD_DIM_MAX)
+ && AIR_IN_OP(nrrdField_unknown, field, nrrdField_last) )) {
+ return;
+ }
+ if (!_nrrdFieldInteresting(nrrd, nio, field)) {
+ *strP = airStrdup("");
+ }
+
+ fs = airEnumStr(nrrdField, field);
+ fslen = strlen(prefix) + strlen(fs) + strlen(": ") + 1;
+ switch (field) {
+ case nrrdField_comment:
+ case nrrdField_keyvalue:
+ fprintf(stderr, "%s: CONFUSION: why are you calling me on \"%s\"?\n", me,
+ airEnumStr(nrrdField, nrrdField_comment));
+ *strP = airStrdup("");
+ break;
+ case nrrdField_content:
+ airOneLinify(nrrd->content);
+ *strP = (char *)calloc(fslen + strlen(nrrd->content), sizeof(char));
+ sprintf(*strP, "%s%s: %s", prefix, fs, nrrd->content);
+ break;
+ case nrrdField_number:
+ *strP = (char *)calloc(fslen + 30, sizeof(char));
+ sprintf(*strP, "%s%s: " _AIR_SIZE_T_CNV, prefix, fs,
+ nrrdElementNumber(nrrd));
+ break;
+ case nrrdField_type:
+ *strP = (char *)calloc(fslen + strlen(airEnumStr(nrrdType, nrrd->type)),
+ sizeof(char));
+ sprintf(*strP, "%s%s: %s", prefix, fs, airEnumStr(nrrdType, nrrd->type));
+ break;
+ case nrrdField_block_size:
+ *strP = (char *)calloc(fslen + 20, sizeof(char));
+ sprintf(*strP, "%s%s: " _AIR_SIZE_T_CNV, prefix, fs, nrrd->blockSize);
+ break;
+ case nrrdField_dimension:
+ *strP = (char *)calloc(fslen + 10, sizeof(char));
+ sprintf(*strP, "%s%s: %d", prefix, fs, nrrd->dim);
+ break;
+ case nrrdField_space:
+ *strP = (char *)calloc(fslen + strlen(airEnumStr(nrrdSpace, nrrd->space)),
+ sizeof(char));
+ sprintf(*strP, "%s%s: %s", prefix, fs, airEnumStr(nrrdSpace, nrrd->space));
+ break;
+ case nrrdField_space_dimension:
+ *strP = (char *)calloc(fslen + 10, sizeof(char));
+ sprintf(*strP, "%s%s: %d", prefix, fs, nrrd->spaceDim);
+ break;
+ /* ---- begin per-axis fields ---- */
+ case nrrdField_sizes:
+ *strP = (char *)calloc(fslen + nrrd->dim*10, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ sprintf(buff, " " _AIR_SIZE_T_CNV, nrrd->axis[ii].size);
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_spacings:
+ *strP = (char *)calloc(fslen + nrrd->dim*30, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ airSinglePrintf(NULL, buff, " %lg", nrrd->axis[ii].spacing);
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_thicknesses:
+ *strP = (char *)calloc(fslen + nrrd->dim*30, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ airSinglePrintf(NULL, buff, " %lg", nrrd->axis[ii].thickness);
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_axis_mins:
+ *strP = (char *)calloc(fslen + nrrd->dim*30, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ airSinglePrintf(NULL, buff, " %lg", nrrd->axis[ii].min);
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_axis_maxs:
+ *strP = (char *)calloc(fslen + nrrd->dim*30, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ airSinglePrintf(NULL, buff, " %lg", nrrd->axis[ii].max);
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_space_directions:
+ *strP = (char *)calloc(fslen +
+ nrrd->dim*nrrd->spaceDim*(30 + strlen("(,) ")),
+ sizeof(char));
+ sprintf(*strP, "%s%s: ", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ _nrrdStrcatSpaceVector(*strP, nrrd->spaceDim,
+ nrrd->axis[ii].spaceDirection);
+ if (ii < nrrd->dim-1) {
+ strcat(*strP, " ");
+ }
+ }
+ break;
+ case nrrdField_centers:
+ fdlen = 0;
+ for (ii=0; ii<nrrd->dim; ii++) {
+ fdlen += 1 + airStrlen(nrrd->axis[ii].center
+ ? airEnumStr(nrrdCenter, nrrd->axis[ii].center)
+ : NRRD_UNKNOWN);
+ }
+ *strP = (char *)calloc(fslen + fdlen, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ sprintf(buff, " %s",
+ (nrrd->axis[ii].center
+ ? airEnumStr(nrrdCenter, nrrd->axis[ii].center)
+ : NRRD_UNKNOWN));
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_kinds:
+ fdlen = 0;
+ for (ii=0; ii<nrrd->dim; ii++) {
+ fdlen += 1 + airStrlen(nrrd->axis[ii].kind
+ ? airEnumStr(nrrdKind, nrrd->axis[ii].kind)
+ : NRRD_UNKNOWN);
+ }
+ *strP = (char *)calloc(fslen + fdlen, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ sprintf(buff, " %s",
+ (nrrd->axis[ii].kind
+ ? airEnumStr(nrrdKind, nrrd->axis[ii].kind)
+ : NRRD_UNKNOWN));
+ strcat(*strP, buff);
+ }
+ break;
+ case nrrdField_labels:
+ fdlen = 0;
+ for (ii=0; ii<nrrd->dim; ii++) {
+ fdlen += airStrlen(nrrd->axis[ii].label) + 4;
+ }
+ *strP = (char *)calloc(fslen + fdlen, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ strcat(*strP, " \"");
+ if (airStrlen(nrrd->axis[ii].label)) {
+ strcat(*strP, nrrd->axis[ii].label);
+ }
+ strcat(*strP, "\"");
+ }
+ break;
+ case nrrdField_units:
+ fdlen = 0;
+ for (ii=0; ii<nrrd->dim; ii++) {
+ fdlen += airStrlen(nrrd->axis[ii].units) + 4;
+ }
+ *strP = (char *)calloc(fslen + fdlen, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->dim; ii++) {
+ strcat(*strP, " \"");
+ if (airStrlen(nrrd->axis[ii].units)) {
+ strcat(*strP, nrrd->axis[ii].units);
+ }
+ strcat(*strP, "\"");
+ }
+ break;
+ /* ---- end per-axis fields ---- */
+ case nrrdField_min:
+ case nrrdField_max:
+ /* we're basically a no-op, now that these fields became meaningless */
+ *strP = (char *)calloc(fslen + 30, sizeof(char));
+ sprintf(*strP, "%s%s: 0.0", prefix, fs);
+ strcat(*strP, buff);
+ break;
+ case nrrdField_old_min:
+ *strP = (char *)calloc(fslen + 30, sizeof(char));
+ sprintf(*strP, "%s%s: ", prefix, fs);
+ airSinglePrintf(NULL, buff, "%lg", nrrd->oldMin);
+ strcat(*strP, buff);
+ break;
+ case nrrdField_old_max:
+ *strP = (char *)calloc(fslen + 30, sizeof(char));
+ sprintf(*strP, "%s%s: ", prefix, fs);
+ airSinglePrintf(NULL, buff, "%lg", nrrd->oldMax);
+ strcat(*strP, buff);
+ break;
+ case nrrdField_endian:
+ if (airEndianUnknown != nio->endian) {
+ /* we know a specific endianness because either it was recorded as
+ part of "unu make -h", or it was set (and data was possibly
+ altered) as part of "unu save" */
+ endi = nio->endian;
+ } else {
+ /* we record our current architecture's endian because we're
+ going to writing out data */
+ endi = AIR_ENDIAN;
+ }
+ *strP = (char *)calloc(fslen + strlen(airEnumStr(airEndian, endi)),
+ sizeof(char));
+ sprintf(*strP, "%s%s: %s", prefix, fs, airEnumStr(airEndian, endi));
+ break;
+ case nrrdField_encoding:
+ *strP = (char *)calloc(fslen + strlen(nio->encoding->name),
+ sizeof(char));
+ sprintf(*strP, "%s%s: %s", prefix, fs, nio->encoding->name);
+ break;
+ case nrrdField_line_skip:
+ *strP = (char *)calloc(fslen + 20, sizeof(char));
+ sprintf(*strP, "%s%s: %d", prefix, fs, nio->lineSkip);
+ break;
+ case nrrdField_byte_skip:
+ *strP = (char *)calloc(fslen + 20, sizeof(char));
+ sprintf(*strP, "%s%s: %d", prefix, fs, nio->byteSkip);
+ break;
+ case nrrdField_sample_units:
+ airOneLinify(nrrd->sampleUnits);
+ *strP = (char *)calloc(fslen + strlen(nrrd->sampleUnits), sizeof(char));
+ sprintf(*strP, "%s%s: \"%s\"", prefix, fs, nrrd->sampleUnits);
+ break;
+ case nrrdField_space_units:
+ fdlen = 0;
+ for (ii=0; ii<nrrd->spaceDim; ii++) {
+ fdlen += airStrlen(nrrd->spaceUnits[ii]) + 4;
+ }
+ *strP = (char *)calloc(fslen + fdlen, sizeof(char));
+ sprintf(*strP, "%s%s:", prefix, fs);
+ for (ii=0; ii<nrrd->spaceDim; ii++) {
+ strcat(*strP, " \"");
+ if (airStrlen(nrrd->spaceUnits[ii])) {
+ strcat(*strP, nrrd->spaceUnits[ii]);
+ }
+ strcat(*strP, "\"");
+ }
+ break;
+ case nrrdField_space_origin:
+ *strP = (char *)calloc(fslen + nrrd->spaceDim*(30 + strlen("(,) ")),
+ sizeof(char));
+ sprintf(*strP, "%s%s: ", prefix, fs);
+ _nrrdStrcatSpaceVector(*strP, nrrd->spaceDim, nrrd->spaceOrigin);
+ break;
+ case nrrdField_measurement_frame:
+ *strP = (char *)calloc(fslen + (nrrd->spaceDim*
+ nrrd->spaceDim*(30 + strlen("(,) "))),
+ sizeof(char));
+ sprintf(*strP, "%s%s: ", prefix, fs);
+ for (dd=0; dd<nrrd->spaceDim; dd++) {
+ for (ii=0; ii<nrrd->spaceDim; ii++) {
+ colvec[ii] = nrrd->measurementFrame[dd][ii];
+ }
+ _nrrdStrcatSpaceVector(*strP, nrrd->spaceDim, colvec);
+ if (dd < nrrd->spaceDim-1) {
+ strcat(*strP, " ");
+ }
+ }
+ break;
+ case nrrdField_data_file:
+ /* NOTE: this comes last (nrrdField_data_file is the highest-valued
+ member of the nrrdField* enum) because the "LIST" form of the
+ data file specification requires that the following lines be
+ the filenames */
+ /* error checking elsewhere: assumes there is data file info */
+ if (nio->dataFNFormat) {
+ *strP = (char *)calloc(fslen + strlen(nio->dataFNFormat)
+ + 10 + 10 + 10 + 10,
+ sizeof(char));
+ if (nio->dataFileDim == nrrd->dim-1) {
+ sprintf(*strP, "%s%s: %s %d %d %d", prefix, fs, nio->dataFNFormat,
+ nio->dataFNMin, nio->dataFNMax, nio->dataFNStep);
+ } else {
+ sprintf(*strP, "%s%s: %s %d %d %d %d", prefix, fs, nio->dataFNFormat,
+ nio->dataFNMin, nio->dataFNMax, nio->dataFNStep,
+ nio->dataFileDim);
+ }
+ } else if (nio->dataFNArr->len > 1) {
+ maxl = 0;
+ for (ii=0; ii<nio->dataFNArr->len; ii++) {
+ maxl = AIR_MAX(maxl, (int)strlen(nio->dataFN[ii]));
+ }
+ *strP = (char *)calloc(fslen + strlen(NRRD_LIST_FLAG) + 10
+ + nio->dataFNArr->len * (maxl + 1),
+ sizeof(char));
+ fnb = (char *)calloc(fslen + strlen(NRRD_LIST_FLAG) + 10 + maxl + 1,
+ sizeof(char));
+ if (nio->dataFileDim == nrrd->dim-1) {
+ sprintf(*strP, "%s%s: LIST\n", prefix, fs);
+ } else {
+ sprintf(*strP, "%s%s: LIST %d\n", prefix, fs, nio->dataFileDim);
+ }
+ for (ii=0; ii<nio->dataFNArr->len; ii++) {
+ sprintf(fnb, "%s%s", nio->dataFN[ii],
+ ii<nio->dataFNArr->len-1 ? "\n" : "");
+ strcat(*strP, fnb);
+ }
+ free(fnb);
+ } else {
+ /* there is some ambiguity between a "LIST" of length one,
+ and a single explicit data filename, but that's harmless */
+ *strP = (char *)calloc(fslen + strlen("./")
+ + strlen(nio->dataFN[0]) + 1,
+ sizeof(char));
+ sprintf(*strP, "%s%s: %s%s", prefix, fs,
+ /* this is a favor to older readers that can deal with
+ this NRRD file because its being saved in a NRRD0003
+ (or below) version, so we don't want to confuse them
+ by not having the old explicit header-relative flag */
+ (_nrrdFormatNRRD_whichVersion(nrrd, nio) < 4 ? "./" : ""),
+ nio->dataFN[0]);
+ }
+ break;
+ default:
+ fprintf(stderr, "%s: CONFUSION: field %d unrecognized\n", me, field);
+ break;
+ }
+
+ return;
+}
+
+/*
+** _nrrdFprintFieldInfo
+**
+** convenience wrapper around _nrrdSprintFieldInfo, for writing into
+** a file. Same caveats here: use _nrrdFieldInteresting
+*/
+void
+_nrrdFprintFieldInfo (FILE *file, char *prefix,
+ const Nrrd *nrrd, NrrdIoState *nio, int field) {
+ char *line=NULL;
+
+ _nrrdSprintFieldInfo(&line, prefix, nrrd, nio, field);
+ if (line) {
+ fprintf(file, "%s\n", line);
+ free(line);
+ }
+ return;
+}
+
+int
+_nrrdEncodingMaybeSet(NrrdIoState *nio) {
+ char me[]="_nrrdEncodingMaybeSet", err[AIR_STRLEN_MED];
+
+ if (!nio->encoding) {
+ sprintf(err, "%s: invalid (NULL) encoding", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdEncodingUnknown == nio->encoding) {
+ nio->encoding = nrrdDefWriteEncoding;
+ }
+ if (!nio->encoding->available()) {
+ sprintf(err, "%s: %s encoding not available in this teem build",
+ me, nio->encoding->name);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+/*
+** we can assume (via action of caller nrrdSave) that nio->encoding
+** has been set
+**
+** we must set nio->format to something useful/non-trivial
+*/
+int
+_nrrdFormatMaybeGuess (const Nrrd *nrrd, NrrdIoState *nio,
+ const char *filename) {
+ char me[]="_nrrdFormatMaybeGuess", err[AIR_STRLEN_MED], mesg[AIR_STRLEN_MED];
+ int fi, guessed, available, fits;
+
+ if (!nio->format) {
+ sprintf(err, "%s: got invalid (NULL) format", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdFormatUnknown == nio->format) {
+ for (fi = nrrdFormatTypeUnknown+1;
+ fi < nrrdFormatTypeLast;
+ fi++) {
+ if (nrrdFormatArray[fi]->nameLooksLike(filename)) {
+ nio->format = nrrdFormatArray[fi];
+ break;
+ }
+ }
+ if (nrrdFormatUnknown == nio->format) {
+ /* no nameLooksLike() returned non-zero, punt */
+ nio->format = nrrdFormatNRRD;
+ }
+ guessed = AIR_TRUE;
+ } else {
+ guessed = AIR_FALSE;
+ }
+ available = nio->format->available();
+ fits = nio->format->fitsInto(nrrd, nio->encoding, AIR_FALSE);
+ /* !available ==> !fits, by the nature of fitsInto() */
+ if (!( available && fits )) {
+ sprintf(mesg, "can not use %s format: %s", nio->format->name,
+ (!available
+ ? "not available in this teem build"
+ : "array doesn\'t fit"));
+ if (guessed) {
+ if (1 <= nrrdStateVerboseIO) {
+ fprintf(stderr, "(%s: %s --> saving to NRRD format)\n", me, mesg);
+ }
+ nio->format = nrrdFormatNRRD;
+ } else {
+ /* problem: this was the format someone explicitly requested */
+ sprintf(err, "%s: %s", me, mesg);
+ biffAdd(NRRD, err); return 1;
+ }
+ }
+
+ return 0;
+}
+
+int
+_nrrdFormatMaybeSet(NrrdIoState *nio) {
+ char me[]="_nrrdFormatMaybeSet", err[AIR_STRLEN_MED];
+
+ if (!nio->format) {
+ sprintf(err, "%s: invalid (NULL) format", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdFormatUnknown == nio->format) {
+ nio->format = nrrdFormatNRRD;
+ }
+ if (!nio->format->available()) {
+ sprintf(err, "%s: %s format not available in this teem build",
+ me, nio->format->name);
+ biffAdd(NRRD, err); return 1;
+ }
+ return 0;
+}
+
+/*
+******** nrrdWrite
+**
+** Write a nrrd to given file, using the format and and encoding indicated
+** in nio. There is no cleverness from this point on: all writing parameters
+** must be given explicitly, and their appropriateness is explicitly tested
+*/
+int
+nrrdWrite (FILE *file, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="nrrdWrite", err[AIR_STRLEN_MED];
+ airArray *mop;
+
+ if (!(file && nrrd)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ if (nrrdCheck(nrrd)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ mop = airMopNew();
+ if (!nio) {
+ nio = nrrdIoStateNew();
+ if (!nio) {
+ sprintf(err, "%s: couldn't alloc local NrrdIoState", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ airMopAdd(mop, nio, (airMopper)nrrdIoStateNix, airMopAlways);
+ }
+ if (_nrrdEncodingMaybeSet(nio)
+ || _nrrdFormatMaybeSet(nio)) {
+ sprintf(err, "%s: ", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ if (nio->byteSkip || nio->lineSkip) {
+ /* NOTE: unu make bypasses this by calling nrrdFormatNRRD->write()
+ directly */
+ sprintf(err, "%s: can't generate line or byte skips on data write", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ /* call the writer appropriate for the format */
+ if (nio->format->write(file, nrrd, nio)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
+
+/*
+******** nrrdSave
+**
+** save a given nrrd to a given filename, with cleverness to guess
+** format if not specified by the caller
+**
+** currently, for NRRD format files, we play the detached header game
+** whenever the filename ends in NRRD_EXT_NHDR, and when we play this
+** game, the data file is ALWAYS header relative.
+*/
+int
+nrrdSave (const char *filename, const Nrrd *nrrd, NrrdIoState *nio) {
+ char me[]="nrrdSave", err[AIR_STRLEN_MED];
+ FILE *file;
+ airArray *mop;
+
+ if (!(nrrd && filename)) {
+ sprintf(err, "%s: got NULL pointer", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ mop = airMopNew();
+ if (!nio) {
+ nio = nrrdIoStateNew();
+ if (!nio) {
+ sprintf(err, "%s: couldn't alloc local NrrdIoState", me);
+ biffAdd(NRRD, err); return 1;
+ }
+ airMopAdd(mop, nio, (airMopper)nrrdIoStateNix, airMopAlways);
+ }
+ if (_nrrdEncodingMaybeSet(nio)
+ || _nrrdFormatMaybeGuess(nrrd, nio, filename)) {
+ sprintf(err, "%s: ", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ if (nrrdFormatNRRD == nio->format
+ && airEndsWith(filename, NRRD_EXT_NHDR)) {
+ nio->detachedHeader = AIR_TRUE;
+ _nrrdSplitName(&(nio->path), &(nio->base), filename);
+ /* nix the ".nhdr" suffix */
+ nio->base[strlen(nio->base) - strlen(NRRD_EXT_NHDR)] = 0;
+ /* nrrdFormatNRRD->write will do the rest */
+ } else {
+ nio->detachedHeader = AIR_FALSE;
+ }
+
+ if (!( file = airFopen(filename, stdout, "wb") )) {
+ sprintf(err, "%s: couldn't fopen(\"%s\",\"wb\"): %s",
+ me, filename, strerror(errno));
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+ airMopAdd(mop, file, (airMopper)airFclose, airMopAlways);
+
+ if (nrrdWrite(file, nrrd, nio)) {
+ sprintf(err, "%s:", me);
+ biffAdd(NRRD, err); airMopError(mop); return 1;
+ }
+
+ airMopOkay(mop);
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/README.kwsys b/Utilities/ITK/Utilities/README.kwsys
new file mode 100644
index 0000000000000000000000000000000000000000..3d6b6b2b8db9b4c2d4f100490e04cbaf1325535f
--- /dev/null
+++ b/Utilities/ITK/Utilities/README.kwsys
@@ -0,0 +1,24 @@
+KWSys provides a platform-independent API to many common system
+features that are implemented differently on every platform. The
+library is intended to be shared among many projects.
+
+How to use KWSys from ITK:
+
+#include <itksys/SystemTools.hxx>
+
+bool MyIsDirectory(const char* fname)
+{
+ return itksys::SystemTools::FileIsDirectory(fname);
+}
+
+How to modify KWSys:
+
+When adding a method to an existing class or fixing an error/warning,
+make no mention of ITK. KWSys has no knowledge of ITK headers or
+libraries. Please also keep in mind that KWSys must be able to build
+on more platforms and compilers than ITK. Refer to existing code for
+conventions to ease this task.
+
+If you want to add a class, please contact the ITK mailing list for
+discussion. Please do not add a class without permission from
+Kitware.
diff --git a/Utilities/ITK/Utilities/itkThirdParty.cmake b/Utilities/ITK/Utilities/itkThirdParty.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..5343617f4e682f3c043a9c12f15ff599ef48a29e
--- /dev/null
+++ b/Utilities/ITK/Utilities/itkThirdParty.cmake
@@ -0,0 +1,49 @@
+#-----------------------------------------------------------------------------
+MACRO(ITK_THIRD_PARTY_OPTION upper lower)
+ OPTION(ITK_USE_SYSTEM_${upper} "Use the system's ${lower} library." OFF)
+ MARK_AS_ADVANCED(ITK_USE_SYSTEM_${upper})
+ IF(ITK_USE_SYSTEM_${upper})
+ IF(EXISTS ${CMAKE_ROOT}/Modules/Find${upper}.cmake)
+ INCLUDE(${CMAKE_ROOT}/Modules/Find${upper}.cmake)
+ ELSE(EXISTS ${CMAKE_ROOT}/Modules/Find${upper}.cmake)
+ INCLUDE(${ITK_SOURCE_DIR}/Utilities/Find${upper}.cmake)
+ ENDIF(EXISTS ${CMAKE_ROOT}/Modules/Find${upper}.cmake)
+ MARK_AS_ADVANCED(${upper}_INCLUDE_DIR ${upper}_LIBRARY)
+ IF(${upper}_FOUND)
+ SET(ITK_${upper}_LIBRARIES ${${upper}_LIBRARIES})
+ IF("${upper}" MATCHES "^PNG$")
+ SET(PNG_INCLUDE_DIR ${PNG_PNG_INCLUDE_DIR})
+ MARK_AS_ADVANCED(PNG_PNG_INCLUDE_DIR)
+ ENDIF("${upper}" MATCHES "^PNG$")
+ ELSE(${upper}_FOUND)
+ MESSAGE(SEND_ERROR "ITK_USE_SYSTEM_${upper} is ON, but ${upper}_LIBRARY is NOTFOUND.")
+ ENDIF(${upper}_FOUND)
+ ELSE(ITK_USE_SYSTEM_${upper})
+ SET(ITK_${upper}_LIBRARIES itk${lower})
+ ENDIF(ITK_USE_SYSTEM_${upper})
+ENDMACRO(ITK_THIRD_PARTY_OPTION)
+
+#-----------------------------------------------------------------------------
+# The in-tree third-party libraries are not exported. We only need
+# the include directory inside the tree. If using a third-party
+# library from the system, though, make sure the system include
+# directory is consistent inside and outside the tree.
+MACRO(ITK_THIRD_PARTY_INCLUDE upper lower)
+ IF(ITK_USE_SYSTEM_${upper})
+ IF(${upper}_INCLUDE_DIR)
+ SET(ITK_INCLUDE_DIRS_SYSTEM ${ITK_INCLUDE_DIRS_SYSTEM} ${${upper}_INCLUDE_DIR})
+ ENDIF(${upper}_INCLUDE_DIR)
+ ELSE(ITK_USE_SYSTEM_${upper})
+ SET(ITK_INCLUDE_DIRS_BUILD_TREE_CXX ${ITK_INCLUDE_DIRS_BUILD_TREE_CXX}
+ ${ITK_SOURCE_DIR}/Utilities/${lower}
+ ${ITK_BINARY_DIR}/Utilities/${lower}
+ )
+ ENDIF(ITK_USE_SYSTEM_${upper})
+ENDMACRO(ITK_THIRD_PARTY_INCLUDE)
+
+#-----------------------------------------------------------------------------
+MACRO(ITK_THIRD_PARTY_SUBDIR upper lower)
+ IF(NOT ITK_USE_SYSTEM_${upper})
+ SUBDIRS(${lower})
+ ENDIF(NOT ITK_USE_SYSTEM_${upper})
+ENDMACRO(ITK_THIRD_PARTY_SUBDIR)
diff --git a/Utilities/ITK/Utilities/kwsys/Base64.c b/Utilities/ITK/Utilities/kwsys/Base64.c
new file mode 100644
index 0000000000000000000000000000000000000000..7af6d8cd9327fe59ee2a44143b0f06cd002c0898
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Base64.c
@@ -0,0 +1,281 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Base64.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Base64.h)
+
+/* Work-around CMake dependency scanning limitation. This must
+ duplicate the above list of headers. */
+#if 0
+# include "Base64.h.in"
+#endif
+
+/*--------------------------------------------------------------------------*/
+static const unsigned char kwsysBase64EncodeTable[65] =
+"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+"abcdefghijklmnopqrstuvwxyz"
+"0123456789+/";
+
+/*--------------------------------------------------------------------------*/
+static const unsigned char kwsysBase64DecodeTable[256] =
+{
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0x3E,0xFF,0xFF,0xFF,0x3F,
+ 0x34,0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,
+ 0x3C,0x3D,0xFF,0xFF,0xFF,0x00,0xFF,0xFF,
+ 0xFF,0x00,0x01,0x02,0x03,0x04,0x05,0x06,
+ 0x07,0x08,0x09,0x0A,0x0B,0x0C,0x0D,0x0E,
+ 0x0F,0x10,0x11,0x12,0x13,0x14,0x15,0x16,
+ 0x17,0x18,0x19,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0x1A,0x1B,0x1C,0x1D,0x1E,0x1F,0x20,
+ 0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,
+ 0x29,0x2A,0x2B,0x2C,0x2D,0x2E,0x2F,0x30,
+ 0x31,0x32,0x33,0xFF,0xFF,0xFF,0xFF,0xFF,
+ /*------------------------------------*/
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+ 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF
+};
+
+/*--------------------------------------------------------------------------*/
+static unsigned char kwsysBase64EncodeChar(int c)
+{
+ return kwsysBase64EncodeTable[(unsigned char)c];
+}
+
+/*--------------------------------------------------------------------------*/
+static unsigned char kwsysBase64DecodeChar(unsigned char c)
+{
+ return kwsysBase64DecodeTable[c];
+}
+
+/*--------------------------------------------------------------------------*/
+/* Encode 3 bytes into a 4 byte string. */
+void kwsysBase64_Encode3(const unsigned char *src, unsigned char *dest)
+{
+ dest[0] = kwsysBase64EncodeChar((src[0] >> 2) & 0x3F);
+ dest[1] = kwsysBase64EncodeChar(((src[0] << 4) & 0x30)|((src[1] >> 4) & 0x0F));
+ dest[2] = kwsysBase64EncodeChar(((src[1] << 2) & 0x3C)|((src[2] >> 6) & 0x03));
+ dest[3] = kwsysBase64EncodeChar(src[2] & 0x3F);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Encode 2 bytes into a 4 byte string. */
+void kwsysBase64_Encode2(const unsigned char *src, unsigned char *dest)
+{
+ dest[0] = kwsysBase64EncodeChar((src[0] >> 2) & 0x3F);
+ dest[1] = kwsysBase64EncodeChar(((src[0] << 4) & 0x30)|((src[1] >> 4) & 0x0F));
+ dest[2] = kwsysBase64EncodeChar(((src[1] << 2) & 0x3C));
+ dest[3] = '=';
+}
+
+/*--------------------------------------------------------------------------*/
+/* Encode 1 bytes into a 4 byte string. */
+void kwsysBase64_Encode1(const unsigned char *src, unsigned char *dest)
+{
+ dest[0] = kwsysBase64EncodeChar((src[0] >> 2) & 0x3F);
+ dest[1] = kwsysBase64EncodeChar(((src[0] << 4) & 0x30));
+ dest[2] = '=';
+ dest[3] = '=';
+}
+
+/*--------------------------------------------------------------------------*/
+/* Encode 'length' bytes from the input buffer and store the
+ encoded stream into the output buffer. Return the length of the encoded
+ buffer (output). Note that the output buffer must be allocated by the caller
+ (length * 1.5 should be a safe estimate). If 'mark_end' is true than an
+ extra set of 4 bytes is added to the end of the stream if the input is a
+ multiple of 3 bytes. These bytes are invalid chars and therefore they will
+ stop the decoder thus enabling the caller to decode a stream without
+ actually knowing how much data to expect (if the input is not a multiple of
+ 3 bytes then the extra padding needed to complete the encode 4 bytes will
+ stop the decoding anyway). */
+unsigned long kwsysBase64_Encode(const unsigned char *input,
+ unsigned long length,
+ unsigned char *output,
+ int mark_end)
+{
+ const unsigned char *ptr = input;
+ const unsigned char *end = input + length;
+ unsigned char *optr = output;
+
+ /* Encode complete triplet */
+
+ while ((end - ptr) >= 3)
+ {
+ kwsysBase64_Encode3(ptr, optr);
+ ptr += 3;
+ optr += 4;
+ }
+
+ /* Encodes a 2-byte ending into 3 bytes and 1 pad byte and writes. */
+
+ if (end - ptr == 2)
+ {
+ kwsysBase64_Encode2(ptr, optr);
+ optr += 4;
+ }
+
+ /* Encodes a 1-byte ending into 2 bytes and 2 pad bytes */
+
+ else if (end - ptr == 1)
+ {
+ kwsysBase64_Encode1(ptr, optr);
+ optr += 4;
+ }
+
+ /* Do we need to mark the end */
+
+ else if (mark_end)
+ {
+ optr[0] = optr[1] = optr[2] = optr[3] = '=';
+ optr += 4;
+ }
+
+ return (unsigned long)(optr - output);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Decode 4 bytes into a 3 byte string. */
+int kwsysBase64_Decode3(const unsigned char *src, unsigned char *dest)
+{
+ unsigned char d0, d1, d2, d3;
+
+ d0 = kwsysBase64DecodeChar(src[0]);
+ d1 = kwsysBase64DecodeChar(src[1]);
+ d2 = kwsysBase64DecodeChar(src[2]);
+ d3 = kwsysBase64DecodeChar(src[3]);
+
+ /* Make sure all characters were valid */
+
+ if (d0 == 0xFF || d1 == 0xFF || d2 == 0xFF || d3 == 0xFF)
+ {
+ return 0;
+ }
+
+ /* Decode the 3 bytes */
+
+ dest[0] = (unsigned char)(((d0 << 2) & 0xFC) | ((d1 >> 4) & 0x03));
+ dest[1] = (unsigned char)(((d1 << 4) & 0xF0) | ((d2 >> 2) & 0x0F));
+ dest[2] = (unsigned char)(((d2 << 6) & 0xC0) | ((d3 >> 0) & 0x3F));
+
+ /* Return the number of bytes actually decoded */
+
+ if (src[2] == '=')
+ {
+ return 1;
+ }
+ if (src[3] == '=')
+ {
+ return 2;
+ }
+ return 3;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Decode bytes from the input buffer and store the decoded stream
+ into the output buffer until 'length' bytes have been decoded. Return the
+ real length of the decoded stream (which should be equal to 'length'). Note
+ that the output buffer must be allocated by the caller. If
+ 'max_input_length' is not null, then it specifies the number of encoded
+ bytes that should be at most read from the input buffer. In that case the
+ 'length' parameter is ignored. This enables the caller to decode a stream
+ without actually knowing how much decoded data to expect (of course, the
+ buffer must be large enough). */
+unsigned long kwsysBase64_Decode(const unsigned char *input,
+ unsigned long length,
+ unsigned char *output,
+ unsigned long max_input_length)
+{
+ const unsigned char *ptr = input;
+ unsigned char *optr = output;
+
+ /* Decode complete triplet */
+
+ if (max_input_length)
+ {
+ const unsigned char *end = input + max_input_length;
+ while (ptr < end)
+ {
+ int len = kwsysBase64_Decode3(ptr, optr);
+ optr += len;
+ if(len < 3)
+ {
+ return (unsigned long)(optr - output);
+ }
+ ptr += 4;
+ }
+ }
+ else
+ {
+ unsigned char *oend = output + length;
+ while ((oend - optr) >= 3)
+ {
+ int len = kwsysBase64_Decode3(ptr, optr);
+ optr += len;
+ if(len < 3)
+ {
+ return (unsigned long)(optr - output);
+ }
+ ptr += 4;
+ }
+
+ /* Decode the last triplet */
+
+ if (oend - optr == 2)
+ {
+ unsigned char temp[3];
+ int len = kwsysBase64_Decode3(ptr, temp);
+ if(len >= 2)
+ {
+ optr[0] = temp[0];
+ optr[1] = temp[1];
+ optr += 2;
+ }
+ else if(len > 0)
+ {
+ optr[0] = temp[0];
+ optr += 1;
+ }
+ }
+ else if (oend - optr == 1)
+ {
+ unsigned char temp[3];
+ int len = kwsysBase64_Decode3(ptr, temp);
+ if(len > 0)
+ {
+ optr[0] = temp[0];
+ optr += 1;
+ }
+ }
+ }
+
+ return (unsigned long)(optr - output);
+}
diff --git a/Utilities/ITK/Utilities/kwsys/Base64.h.in b/Utilities/ITK/Utilities/kwsys/Base64.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..66329a253bcbc5f300586cee65ea19938fe9771c
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Base64.h.in
@@ -0,0 +1,118 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Base64.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Base64_h
+#define @KWSYS_NAMESPACE@_Base64_h
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+/* Redefine all public interface symbol names to be in the proper
+ namespace. These macros are used internally to kwsys only, and are
+ not visible to user code. Use kwsysHeaderDump.pl to reproduce
+ these macros after making changes to the interface. */
+#if !defined(KWSYS_NAMESPACE)
+# define kwsys_ns(x) @KWSYS_NAMESPACE@##x
+# define kwsysEXPORT @KWSYS_NAMESPACE@_EXPORT
+#endif
+#define kwsysBase64 kwsys_ns(Base64)
+#define kwsysBase64_Decode kwsys_ns(Base64_Decode)
+#define kwsysBase64_Decode3 kwsys_ns(Base64_Decode3)
+#define kwsysBase64_Encode kwsys_ns(Base64_Encode)
+#define kwsysBase64_Encode1 kwsys_ns(Base64_Encode1)
+#define kwsysBase64_Encode2 kwsys_ns(Base64_Encode2)
+#define kwsysBase64_Encode3 kwsys_ns(Base64_Encode3)
+
+#if defined(__cplusplus)
+extern "C"
+{
+#endif
+
+/**
+ * Encode 3 bytes into a 4 byte string.
+ */
+kwsysEXPORT void kwsysBase64_Encode3(const unsigned char *src,
+ unsigned char *dest);
+
+/**
+ * Encode 2 bytes into a 4 byte string.
+ */
+kwsysEXPORT void kwsysBase64_Encode2(const unsigned char *src,
+ unsigned char *dest);
+
+/**
+ * Encode 1 bytes into a 4 byte string.
+ */
+kwsysEXPORT void kwsysBase64_Encode1(const unsigned char *src,
+ unsigned char *dest);
+
+/**
+ * Encode 'length' bytes from the input buffer and store the encoded
+ * stream into the output buffer. Return the length of the encoded
+ * buffer (output). Note that the output buffer must be allocated by
+ * the caller (length * 1.5 should be a safe estimate). If 'mark_end'
+ * is true than an extra set of 4 bytes is added to the end of the
+ * stream if the input is a multiple of 3 bytes. These bytes are
+ * invalid chars and therefore they will stop the decoder thus
+ * enabling the caller to decode a stream without actually knowing how
+ * much data to expect (if the input is not a multiple of 3 bytes then
+ * the extra padding needed to complete the encode 4 bytes will stop
+ * the decoding anyway).
+ */
+kwsysEXPORT unsigned long kwsysBase64_Encode(const unsigned char *input,
+ unsigned long length,
+ unsigned char *output,
+ int mark_end);
+
+/**
+ * Decode 4 bytes into a 3 byte string. Returns the number of bytes
+ * actually decoded.
+ */
+kwsysEXPORT int kwsysBase64_Decode3(const unsigned char *src,
+ unsigned char *dest);
+
+/**
+ * Decode bytes from the input buffer and store the decoded stream
+ * into the output buffer until 'length' bytes have been decoded.
+ * Return the real length of the decoded stream (which should be equal
+ * to 'length'). Note that the output buffer must be allocated by the
+ * caller. If 'max_input_length' is not null, then it specifies the
+ * number of encoded bytes that should be at most read from the input
+ * buffer. In that case the 'length' parameter is ignored. This
+ * enables the caller to decode a stream without actually knowing how
+ * much decoded data to expect (of course, the buffer must be large
+ * enough).
+ */
+kwsysEXPORT unsigned long kwsysBase64_Decode(const unsigned char *input,
+ unsigned long length,
+ unsigned char *output,
+ unsigned long max_input_length);
+
+#if defined(__cplusplus)
+} /* extern "C" */
+#endif
+
+/* If we are building a kwsys .c or .cxx file, let it use these macros.
+ Otherwise, undefine them to keep the namespace clean. */
+#if !defined(KWSYS_NAMESPACE)
+# undef kwsys_ns
+# undef kwsysEXPORT
+# undef kwsysBase64
+# undef kwsysBase64_Decode
+# undef kwsysBase64_Decode3
+# undef kwsysBase64_Encode
+# undef kwsysBase64_Encode1
+# undef kwsysBase64_Encode2
+# undef kwsysBase64_Encode3
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/CMakeLists.txt b/Utilities/ITK/Utilities/kwsys/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..180ec5de44704b09d47b07085d3a69979c4a612b
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/CMakeLists.txt
@@ -0,0 +1,680 @@
+#=============================================================================
+#
+# Program: KWSys - Kitware System Library
+# Module: $RCSfile: CMakeLists.txt,v $
+#
+# Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+# See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+#
+# This software is distributed WITHOUT ANY WARRANTY; without even
+# the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+# PURPOSE. See the above copyright notices for more information.
+#
+#=============================================================================
+
+# The Kitware System Library is intended to be included in other
+# projects. It is completely configurable in that the library's
+# namespace can be configured and the components that are included can
+# be selected invididually.
+
+# Typical usage is to import the kwsys directory tree into a
+# subdirectory under a parent project and enable the classes that will
+# be used. All classes are disabled by default. The CMake listfile
+# above this one configures the library as follows:
+#
+# SET(KWSYS_NAMESPACE foosys)
+# SET(KWSYS_USE_Directory 1) # Enable Directory class.
+# SUBDIRS(kwsys)
+#
+# Optional settings are as follows:
+#
+# KWSYS_HEADER_ROOT = The directory into which to generate the kwsys headers.
+# A directory called "${KWSYS_NAMESPACE}" will be
+# created under this root directory to hold the files.
+#
+# Example:
+#
+# SET(KWSYS_HEADER_ROOT ${PROJECT_BINARY_DIR})
+# INCLUDE_DIRECTORIES(${PROJECT_BINARY_DIR})
+#
+# KWSYS_LIBRARY_INSTALL_DIR = The installation target directories into
+# KWSYS_HEADER_INSTALL_DIR which the libraries and headers from
+# kwsys should be installed by a "make install".
+# The values should be specified relative to
+# the installation prefix and start with a '/'.
+# Example:
+#
+# SET(KWSYS_LIBRARY_INSTALL_DIR /lib)
+# SET(KWSYS_HEADER_INSTALL_DIR /include)
+#
+# KWSYS_IOS_FORCE_OLD = Force use of old non-ANSI C++ streams even if
+# new streams are available. This may be used
+# by projects that cannot configure their
+# streams library.
+# Example:
+#
+# SET(KWSYS_IOS_FORCE_OLD 1)
+#
+
+# Once configured, kwsys should be used as follows from C or C++ code:
+#
+# #include <foosys/Directory.hxx>
+# ...
+# foosys::Directory directory;
+#
+
+# NOTE: This library is intended for internal use by Kitware-driven
+# projects. In order to keep it simple no attempt will be made to
+# maintain backward compatibility when changes are made to KWSys.
+# When an incompatible change is made Kitware's projects that use
+# KWSys will be fixed, but no notification will necessarily be sent to
+# any outside mailing list and no documentation of the change will be
+# written.
+
+#-----------------------------------------------------------------------------
+# If a namespace is not specified, use "kwsys" and enable testing.
+# This should be the case only when kwsys is not included inside
+# another project and is being tested.
+IF(NOT KWSYS_NAMESPACE)
+ SET(KWSYS_NAMESPACE "kwsys")
+ SET(KWSYS_STANDALONE 1)
+ENDIF(NOT KWSYS_NAMESPACE)
+
+IF(KWSYS_STANDALONE OR CMake_SOURCE_DIR)
+ SET(KWSYS_ENABLE_C 1)
+
+ # Enable all components.
+ SET(KWSYS_USE_Base64 1)
+ SET(KWSYS_USE_Directory 1)
+ SET(KWSYS_USE_DynamicLoader 1)
+ SET(KWSYS_USE_Glob 1)
+ SET(KWSYS_USE_Process 1)
+ SET(KWSYS_USE_RegularExpression 1)
+ SET(KWSYS_USE_Registry 1)
+ SET(KWSYS_USE_SystemTools 1)
+ SET(KWSYS_USE_CommandLineArguments 1)
+ SET(KWSYS_USE_FundamentalType 1)
+ENDIF(KWSYS_STANDALONE OR CMake_SOURCE_DIR)
+
+#-----------------------------------------------------------------------------
+# The project name is that of the specified namespace.
+PROJECT(${KWSYS_NAMESPACE})
+
+# Enable testing if building standalone.
+IF(KWSYS_STANDALONE)
+ INCLUDE(Dart)
+ MARK_AS_ADVANCED(BUILD_TESTING DART_ROOT TCL_TCLSH)
+ IF(BUILD_TESTING)
+ ENABLE_TESTING()
+ ENDIF(BUILD_TESTING)
+ENDIF(KWSYS_STANDALONE)
+
+# Do full dependency headers.
+INCLUDE_REGULAR_EXPRESSION("^.*$")
+
+# Work-around for CMake 1.6.7 bug in custom command dependencies when
+# there is no executable output path.
+IF(NOT EXECUTABLE_OUTPUT_PATH)
+ SET(EXECUTABLE_OUTPUT_PATH "${PROJECT_BINARY_DIR}" CACHE PATH
+ "Output directory for executables.")
+ENDIF(NOT EXECUTABLE_OUTPUT_PATH)
+
+# Generated source files will need this header.
+STRING(COMPARE EQUAL "${PROJECT_SOURCE_DIR}" "${PROJECT_BINARY_DIR}"
+ KWSYS_IN_SOURCE_BUILD)
+IF(NOT KWSYS_IN_SOURCE_BUILD)
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/kwsysPrivate.h
+ ${PROJECT_BINARY_DIR}/kwsysPrivate.h COPY_ONLY IMMEDIATE)
+ENDIF(NOT KWSYS_IN_SOURCE_BUILD)
+
+#-----------------------------------------------------------------------------
+# We require ANSI support from the C compiler. Add any needed flags.
+IF(CMAKE_ANSI_CFLAGS)
+ SET(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} ${CMAKE_ANSI_CFLAGS}")
+ENDIF(CMAKE_ANSI_CFLAGS)
+
+#-----------------------------------------------------------------------------
+# Adjust compiler flags for some platforms.
+IF(NOT CMAKE_COMPILER_IS_GNUCXX)
+ IF(CMAKE_SYSTEM MATCHES "OSF1-V.*")
+ STRING(REGEX MATCH "-timplicit_local"
+ KWSYS_CXX_FLAGS_HAVE_IMPLICIT_LOCAL "${CMAKE_CXX_FLAGS}")
+ STRING(REGEX MATCH "-no_implicit_include"
+ KWSYS_CXX_FLAGS_HAVE_NO_IMPLICIT_INCLUDE "${CMAKE_CXX_FLAGS}")
+ IF(NOT KWSYS_CXX_FLAGS_HAVE_IMPLICIT_LOCAL)
+ SET(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -timplicit_local")
+ ENDIF(NOT KWSYS_CXX_FLAGS_HAVE_IMPLICIT_LOCAL)
+ IF(NOT KWSYS_CXX_FLAGS_HAVE_NO_IMPLICIT_INCLUDE)
+ SET(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -no_implicit_include")
+ ENDIF(NOT KWSYS_CXX_FLAGS_HAVE_NO_IMPLICIT_INCLUDE)
+ ENDIF(CMAKE_SYSTEM MATCHES "OSF1-V.*")
+ENDIF(NOT CMAKE_COMPILER_IS_GNUCXX)
+
+#-----------------------------------------------------------------------------
+# Configure the standard library header wrappers based on compiler's
+# capabilities and parent project's request. Enforce 0/1 as only
+# possible values for configuration into Configure.hxx.
+INCLUDE(${CMAKE_CURRENT_SOURCE_DIR}/kwsysPlatformCxxTests.cmake)
+
+KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAVE_STD
+ "Checking whether STL classes are in std namespace" DIRECT)
+
+IF(KWSYS_IOS_FORCE_OLD)
+ SET(KWSYS_IOS_USE_ANSI 0)
+ELSE(KWSYS_IOS_FORCE_OLD)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_IOS_USE_ANSI
+ "Checking whether ANSI stream headers are available" DIRECT)
+ENDIF(KWSYS_IOS_FORCE_OLD)
+
+IF(KWSYS_IOS_USE_ANSI)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_IOS_HAVE_STD
+ "Checking whether ANSI streams are in std namespace" DIRECT)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_IOS_USE_SSTREAM
+ "Checking whether ANSI string stream is available" DIRECT)
+ELSE(KWSYS_IOS_USE_ANSI)
+ SET(KWSYS_IOS_HAVE_STD 0)
+ SET(KWSYS_IOS_USE_SSTREAM 0)
+ENDIF(KWSYS_IOS_USE_ANSI)
+
+IF(KWSYS_IOS_USE_SSTREAM)
+ SET(KWSYS_IOS_USE_STRSTREAM_H 0)
+ SET(KWSYS_IOS_USE_STRSTREA_H 0)
+ELSE(KWSYS_IOS_USE_SSTREAM)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_IOS_USE_STRSTREAM_H
+ "Checking whether strstream.h is available" DIRECT)
+ IF(KWSYS_IOS_USE_STRSTREAM_H)
+ SET(KWSYS_IOS_USE_STRSTREA_H 0)
+ ELSE(KWSYS_IOS_USE_STRSTREAM_H)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_IOS_USE_STRSTREA_H
+ "Checking whether strstrea.h is available" DIRECT)
+ ENDIF(KWSYS_IOS_USE_STRSTREAM_H)
+ENDIF(KWSYS_IOS_USE_SSTREAM)
+
+KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_HAS_CSTDDEF
+ "Checking whether header cstddef is available" DIRECT)
+
+SET(KWSYS_PLATFORM_CXX_TEST_DEFINES
+ -DKWSYS_STL_HAVE_STD=${KWSYS_STL_HAVE_STD})
+KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_STRING_HAVE_NEQ_CHAR
+ "Checking whether stl string has operator!= for char*" DIRECT)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ITERATOR_TRAITS
+ "Checking whether stl has iterator_traits" DIRECT)
+IF(KWSYS_STL_HAS_ITERATOR_TRAITS)
+ SET(KWSYS_STL_HAS_ITERATOR_CATEGORY 0)
+ SET(KWSYS_STL_HAS___ITERATOR_CATEGORY 0)
+ELSE(KWSYS_STL_HAS_ITERATOR_TRAITS)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ITERATOR_CATEGORY
+ "Checking whether stl has old iterator_category" DIRECT)
+ IF(KWSYS_STL_HAS_ITERATOR_CATEGORY)
+ SET(KWSYS_STL_HAS___ITERATOR_CATEGORY 0)
+ ELSE(KWSYS_STL_HAS_ITERATOR_CATEGORY)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS___ITERATOR_CATEGORY
+ "Checking whether stl has internal __iterator_category" DIRECT)
+ ENDIF(KWSYS_STL_HAS_ITERATOR_CATEGORY)
+ENDIF(KWSYS_STL_HAS_ITERATOR_TRAITS)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ALLOCATOR_TEMPLATE
+ "Checking whether stl has standard template allocator" DIRECT)
+IF(KWSYS_STL_HAS_ALLOCATOR_TEMPLATE)
+ SET(KWSYS_STL_HAS_ALLOCATOR_NONTEMPLATE 0)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ALLOCATOR_REBIND
+ "Checking for rebind member of stl allocator" DIRECT)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT
+ "Checking for non-standard argument to stl allocator<>::max_size" DIRECT)
+ELSE(KWSYS_STL_HAS_ALLOCATOR_TEMPLATE)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ALLOCATOR_NONTEMPLATE
+ "Checking whether stl has old non-template allocator" DIRECT)
+ SET(KWSYS_STL_HAS_ALLOCATOR_REBIND 0)
+ SET(KWSYS_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT 0)
+ENDIF(KWSYS_STL_HAS_ALLOCATOR_TEMPLATE)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_HAS_ALLOCATOR_OBJECTS
+ "Checking whether stl containers support allocator objects." DIRECT)
+IF(KWSYS_IOS_USE_ANSI)
+ # ANSI streams always have string operators.
+ SET(KWSYS_STL_STRING_HAVE_OSTREAM 1)
+ SET(KWSYS_STL_STRING_HAVE_ISTREAM 1)
+ELSE(KWSYS_IOS_USE_ANSI)
+ # There may not be string operators for old streams.
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_STRING_HAVE_OSTREAM
+ "Checking whether stl string has ostream operator<<" DIRECT)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STL_STRING_HAVE_ISTREAM
+ "Checking whether stl string has istream operator>>" DIRECT)
+ENDIF(KWSYS_IOS_USE_ANSI)
+SET(KWSYS_PLATFORM_CXX_TEST_DEFINES)
+
+KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_HAS_NULL_TEMPLATE_ARGS
+ "Checking whether \"<>\" is needed for template friends" INVERT)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_HAS_MEMBER_TEMPLATES
+ "Checking for member template support" DIRECT)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_HAS_FULL_SPECIALIZATION
+ "Checking for standard template specialization syntax" DIRECT)
+KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP
+ "Checking whether argument dependent lookup is supported" DIRECT)
+
+IF(UNIX)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_STAT_HAS_ST_MTIM
+ "Checking whether struct stat has st_mtim member" DIRECT)
+ENDIF(UNIX)
+
+IF(KWSYS_USE_FundamentalType)
+ # Determine type sizes.
+ INCLUDE(CheckTypeSize)
+ CHECK_TYPE_SIZE("char" KWSYS_SIZEOF_CHAR)
+ CHECK_TYPE_SIZE("short" KWSYS_SIZEOF_SHORT)
+ CHECK_TYPE_SIZE("int" KWSYS_SIZEOF_INT)
+ CHECK_TYPE_SIZE("long" KWSYS_SIZEOF_LONG)
+ CHECK_TYPE_SIZE("long long" KWSYS_SIZEOF_LONG_LONG)
+ CHECK_TYPE_SIZE("__int64" KWSYS_SIZEOF___INT64)
+ IF(NOT KWSYS_SIZEOF_LONG_LONG)
+ SET(KWSYS_SIZEOF_LONG_LONG 0)
+ ENDIF(NOT KWSYS_SIZEOF_LONG_LONG)
+ IF(NOT KWSYS_SIZEOF___INT64)
+ SET(KWSYS_SIZEOF___INT64 0)
+ ENDIF(NOT KWSYS_SIZEOF___INT64)
+
+ # Check uniqueness of types.
+ IF(KWSYS_SIZEOF___INT64)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_SAME_LONG_AND___INT64
+ "Checking whether long and __int64 are the same type" DIRECT)
+ IF(KWSYS_SIZEOF_LONG_LONG)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_CXX_SAME_LONG_LONG_AND___INT64
+ "Checking whether long long and __int64 are the same type" DIRECT)
+ ENDIF(KWSYS_SIZEOF_LONG_LONG)
+ ENDIF(KWSYS_SIZEOF___INT64)
+
+ # Enable the "long long" type if it is available. It is standard in
+ # C99 and C++03 but not in earlier standards.
+ IF(KWSYS_SIZEOF_LONG_LONG)
+ SET(KWSYS_USE_LONG_LONG 1)
+ ELSE(KWSYS_SIZEOF_LONG_LONG)
+ SET(KWSYS_USE_LONG_LONG 0)
+ ENDIF(KWSYS_SIZEOF_LONG_LONG)
+
+ # Enable the "__int64" type if it is available and unique. It is not
+ # standard.
+ SET(KWSYS_USE___INT64 0)
+ IF(KWSYS_SIZEOF___INT64)
+ IF(NOT KWSYS_CXX_SAME_LONG_AND___INT64)
+ IF(NOT KWSYS_CXX_SAME_LONG_LONG_AND___INT64)
+ SET(KWSYS_USE___INT64 1)
+ ENDIF(NOT KWSYS_CXX_SAME_LONG_LONG_AND___INT64)
+ ENDIF(NOT KWSYS_CXX_SAME_LONG_AND___INT64)
+ ENDIF(KWSYS_SIZEOF___INT64)
+ IF(KWSYS_USE___INT64)
+ KWSYS_PLATFORM_CXX_TEST(KWSYS_CAN_CONVERT_UI64_TO_DOUBLE
+ "Checking whether unsigned __int64 can convert to double" DIRECT)
+ ELSE(KWSYS_USE___INT64)
+ SET(KWSYS_CAN_CONVERT_UI64_TO_DOUBLE 1)
+ ENDIF(KWSYS_USE___INT64)
+
+ # Check signedness of "char" type.
+ IF("KWSYS_CHAR_IS_SIGNED" MATCHES "^KWSYS_CHAR_IS_SIGNED$")
+ MESSAGE(STATUS "Checking signedness of char")
+ TRY_RUN(KWSYS_CHAR_IS_SIGNED KWSYS_CHAR_IS_SIGNED_COMPILED
+ ${CMAKE_CURRENT_BINARY_DIR}
+ ${CMAKE_CURRENT_SOURCE_DIR}/kwsysPlatformCxxTests.cxx
+ COMPILE_DEFINITIONS -DTEST_KWSYS_CHAR_IS_SIGNED)
+ IF(KWSYS_CHAR_IS_SIGNED_COMPILED)
+ IF(KWSYS_CHAR_IS_SIGNED)
+ MESSAGE(STATUS "Checking signedness of char -- signed")
+ SET(KWSYS_CHAR_IS_SIGNED 1 CACHE INTERNAL "Whether char is signed.")
+ ELSE(KWSYS_CHAR_IS_SIGNED)
+ MESSAGE(STATUS "Checking signedness of char -- unsigned")
+ SET(KWSYS_CHAR_IS_SIGNED 0 CACHE INTERNAL "Whether char is signed.")
+ ENDIF(KWSYS_CHAR_IS_SIGNED)
+ ELSE(KWSYS_CHAR_IS_SIGNED_COMPILED)
+ MESSAGE(FATAL_ERROR "Checking signedness of char -- failed")
+ ENDIF(KWSYS_CHAR_IS_SIGNED_COMPILED)
+ ENDIF("KWSYS_CHAR_IS_SIGNED" MATCHES "^KWSYS_CHAR_IS_SIGNED$")
+ENDIF(KWSYS_USE_FundamentalType)
+
+IF(KWSYS_NAMESPACE MATCHES "^kwsys$")
+ SET(KWSYS_NAME_IS_KWSYS 1)
+ELSE(KWSYS_NAMESPACE MATCHES "^kwsys$")
+ SET(KWSYS_NAME_IS_KWSYS 0)
+ENDIF(KWSYS_NAMESPACE MATCHES "^kwsys$")
+
+# Choose default shared/static build if not specified.
+IF(KWSYS_BUILD_SHARED MATCHES "^KWSYS_BUILD_SHARED$")
+ SET(KWSYS_BUILD_SHARED ${BUILD_SHARED_LIBS})
+ENDIF(KWSYS_BUILD_SHARED MATCHES "^KWSYS_BUILD_SHARED$")
+
+IF(KWSYS_BUILD_SHARED)
+ SET(KWSYS_BUILD_SHARED 1)
+ SET(KWSYS_LIBRARY_TYPE SHARED)
+ELSE(KWSYS_BUILD_SHARED)
+ SET(KWSYS_BUILD_SHARED 0)
+ SET(KWSYS_LIBRARY_TYPE STATIC)
+ENDIF(KWSYS_BUILD_SHARED)
+
+#-----------------------------------------------------------------------------
+# Choose a directory for the generated headers.
+IF(NOT KWSYS_HEADER_ROOT)
+ SET(KWSYS_HEADER_ROOT "${PROJECT_BINARY_DIR}")
+ENDIF(NOT KWSYS_HEADER_ROOT)
+SET(KWSYS_HEADER_DIR "${KWSYS_HEADER_ROOT}/${KWSYS_NAMESPACE}")
+INCLUDE_DIRECTORIES(${KWSYS_HEADER_ROOT})
+
+#-----------------------------------------------------------------------------
+# Create STL header wrappers to block warnings in the STL headers and
+# give standard names by which they may be included.
+SET(KWSYS_STL_HEADER_EXTRA_string 1)
+FOREACH(header algorithm deque iterator list map numeric queue set stack string
+ utility vector memory functional)
+ # Configure the header wrapper.
+ SET(KWSYS_STL_HEADER "${header}")
+ IF(KWSYS_STL_HEADER_EXTRA_${header})
+ SET(KWSYS_STL_HEADER_EXTRA
+ "#define ${KWSYS_NAMESPACE}_stl_${header}_including_hxx\n# include <${KWSYS_NAMESPACE}/stl/${header}.hxx>\n#undef ${KWSYS_NAMESPACE}_stl_${header}_including_hxx\n")
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/kwsys_stl_${header}.hxx.in
+ ${KWSYS_HEADER_DIR}/stl/${header}.hxx
+ @ONLY IMMEDIATE)
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}/stl
+ FILES ${KWSYS_HEADER_DIR}/stl/${header}.hxx)
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ ELSE(KWSYS_STL_HEADER_EXTRA_${header})
+ SET(KWSYS_STL_HEADER_EXTRA "")
+ ENDIF(KWSYS_STL_HEADER_EXTRA_${header})
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/kwsys_stl.hxx.in
+ ${KWSYS_HEADER_DIR}/stl/${header}
+ @ONLY IMMEDIATE)
+
+ # Create an install target for the header wrapper.
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}/stl
+ FILES ${KWSYS_HEADER_DIR}/stl/${header})
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ENDFOREACH(header)
+
+# Provide cstddef header.
+CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/kwsys_cstddef.hxx.in
+ ${KWSYS_HEADER_DIR}/cstddef
+ @ONLY IMMEDIATE)
+
+#-----------------------------------------------------------------------------
+# Create streams header wrappers to give standard names by which they
+# may be included.
+FOREACH(header iostream fstream sstream iosfwd)
+ # Configure the header wrapper.
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/kwsys_ios_${header}.h.in
+ ${KWSYS_HEADER_DIR}/ios/${header}
+ @ONLY IMMEDIATE)
+
+ # Create an install target for the header wrapper.
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}/ios
+ FILES ${KWSYS_HEADER_DIR}/ios/${header})
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ENDFOREACH(header)
+
+#-----------------------------------------------------------------------------
+# Build a list of classes and headers we need to implement the
+# selected components. Initialize with required components.
+SET(KWSYS_CLASSES)
+SET(KWSYS_H_FILES Configure SharedForward)
+SET(KWSYS_HXX_FILES Configure String hashtable hash_fun hash_map hash_set)
+
+# Enforce component dependencies.
+IF(KWSYS_USE_SystemTools)
+ SET(KWSYS_USE_Directory 1)
+ENDIF(KWSYS_USE_SystemTools)
+IF(KWSYS_USE_Glob)
+ SET(KWSYS_USE_Directory 1)
+ SET(KWSYS_USE_SystemTools 1)
+ SET(KWSYS_USE_RegularExpression 1)
+ENDIF(KWSYS_USE_Glob)
+
+# Add selected C++ classes.
+SET(cppclasses Directory DynamicLoader Glob RegularExpression SystemTools CommandLineArguments Registry)
+FOREACH(cpp ${cppclasses})
+ IF(KWSYS_USE_${cpp})
+ SET(KWSYS_CLASSES ${KWSYS_CLASSES} ${cpp})
+ ENDIF(KWSYS_USE_${cpp})
+ENDFOREACH(cpp)
+
+# Add selected C components.
+FOREACH(c Process Base64 FundamentalType)
+ IF(KWSYS_USE_${c})
+ SET(KWSYS_H_FILES ${KWSYS_H_FILES} ${c})
+ ENDIF(KWSYS_USE_${c})
+ENDFOREACH(c)
+
+#-----------------------------------------------------------------------------
+# Build a list of sources for the library based on components that are
+# included.
+SET(KWSYS_C_SRCS)
+SET(KWSYS_CXX_SRCS)
+
+# Add the proper sources for this platform's Process implementation.
+IF(KWSYS_USE_Process)
+ IF(NOT UNIX)
+ # Use the Windows implementation. We need the encoded forwarding executable.
+ SET(KWSYS_C_SRCS ${KWSYS_C_SRCS} ProcessWin32.c
+ ${PROJECT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c)
+ SET_SOURCE_FILES_PROPERTIES(
+ ${PROJECT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c
+ PROPERTIES GENERATED 1)
+ ELSE(NOT UNIX)
+ # Use the UNIX implementation.
+ SET(KWSYS_C_SRCS ${KWSYS_C_SRCS} ProcessUNIX.c)
+ ENDIF(NOT UNIX)
+ENDIF(KWSYS_USE_Process)
+
+# Add sources for Base64 encoding.
+IF(KWSYS_USE_Base64)
+ SET(KWSYS_C_SRCS ${KWSYS_C_SRCS} Base64.c)
+ENDIF(KWSYS_USE_Base64)
+
+# Configure headers of C++ classes and construct the list of sources.
+FOREACH(c ${KWSYS_CLASSES})
+ # Add this source to the list of source files for the library.
+ SET(KWSYS_CXX_SRCS ${KWSYS_CXX_SRCS} ${c}.cxx)
+
+ # Configure the header for this class.
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/${c}.hxx.in ${KWSYS_HEADER_DIR}/${c}.hxx
+ @ONLY IMMEDIATE)
+
+ # Create an install target for the header.
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}
+ FILES ${KWSYS_HEADER_DIR}/${c}.hxx)
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ENDFOREACH(c)
+
+# Configure C headers.
+FOREACH(h ${KWSYS_H_FILES})
+ # Configure the header into the given directory.
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/${h}.h.in ${KWSYS_HEADER_DIR}/${h}.h
+ @ONLY IMMEDIATE)
+
+ # Create an install target for the header.
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}
+ FILES ${KWSYS_HEADER_DIR}/${h}.h)
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ENDFOREACH(h)
+
+# Configure other C++ headers.
+FOREACH(h ${KWSYS_HXX_FILES})
+ # Configure the header into the given directory.
+ CONFIGURE_FILE(${PROJECT_SOURCE_DIR}/${h}.hxx.in ${KWSYS_HEADER_DIR}/${h}.hxx
+ @ONLY IMMEDIATE)
+
+ # Create an install target for the header.
+ IF(KWSYS_HEADER_INSTALL_DIR)
+ INSTALL_FILES(${KWSYS_HEADER_INSTALL_DIR}/${KWSYS_NAMESPACE}
+ FILES ${KWSYS_HEADER_DIR}/${h}.hxx)
+ ENDIF(KWSYS_HEADER_INSTALL_DIR)
+ENDFOREACH(h)
+
+#-----------------------------------------------------------------------------
+# Add the library with the configured name and list of sources.
+IF(KWSYS_C_SRCS OR KWSYS_CXX_SRCS)
+ ADD_LIBRARY(${KWSYS_NAMESPACE} ${KWSYS_LIBRARY_TYPE}
+ ${KWSYS_C_SRCS} ${KWSYS_CXX_SRCS})
+
+ # If kwsys contains the DynamicLoader, need extra library
+ IF(KWSYS_USE_DynamicLoader)
+ ADD_LIBRARY(testDynload MODULE testDynload.c)
+ IF(UNIX)
+ TARGET_LINK_LIBRARIES(${KWSYS_NAMESPACE} ${CMAKE_DL_LIBS})
+ ENDIF(UNIX)
+ ENDIF(KWSYS_USE_DynamicLoader)
+
+ # Apply user-defined target properties to the library.
+ IF(KWSYS_PROPERTIES_CXX)
+ SET_TARGET_PROPERTIES(${KWSYS_NAMESPACE} PROPERTIES
+ ${KWSYS_PROPERTIES_CXX}
+ )
+ ENDIF(KWSYS_PROPERTIES_CXX)
+
+ # Create an install target for the library.
+ IF(KWSYS_LIBRARY_INSTALL_DIR)
+ INSTALL_TARGETS(${KWSYS_LIBRARY_INSTALL_DIR} ${KWSYS_NAMESPACE})
+ ENDIF(KWSYS_LIBRARY_INSTALL_DIR)
+ENDIF(KWSYS_C_SRCS OR KWSYS_CXX_SRCS)
+
+# Add a C-only library if requested.
+IF(KWSYS_ENABLE_C AND KWSYS_C_SRCS)
+ ADD_LIBRARY(${KWSYS_NAMESPACE}_c ${KWSYS_LIBRARY_TYPE} ${KWSYS_C_SRCS})
+
+ # Apply user-defined target properties to the library.
+ IF(KWSYS_PROPERTIES_C)
+ SET_TARGET_PROPERTIES(${KWSYS_NAMESPACE} PROPERTIES
+ ${KWSYS_PROPERTIES_C}
+ )
+ ENDIF(KWSYS_PROPERTIES_C)
+
+ # Create an install target for the library.
+ IF(KWSYS_LIBRARY_INSTALL_DIR)
+ INSTALL_TARGETS(${KWSYS_LIBRARY_INSTALL_DIR} ${KWSYS_NAMESPACE}_c)
+ ENDIF(KWSYS_LIBRARY_INSTALL_DIR)
+ENDIF(KWSYS_ENABLE_C AND KWSYS_C_SRCS)
+
+# For building kwsys itself, we use a macro defined on the command
+# line to configure the namespace in the C and C++ source files.
+ADD_DEFINITIONS("-DKWSYS_NAMESPACE=${KWSYS_NAMESPACE}")
+
+#-----------------------------------------------------------------------------
+# Process execution on windows needs to build a forwarding executable
+# that works around a Win9x bug. We encode the executable into a C
+# file and build it into the library. Win9x platforms reproduce the
+# executable into a temporary directory when it is needed.
+IF(KWSYS_USE_Process)
+ IF(NOT UNIX)
+ # Build the forwarding executable itself and a program that will
+ # encode it into a C file.
+ ADD_EXECUTABLE(${KWSYS_NAMESPACE}ProcessFwd9x ProcessFwd9x.c)
+ ADD_EXECUTABLE(${KWSYS_NAMESPACE}EncodeExecutable EncodeExecutable.c)
+
+ # Construct the location of the executable to be encoded.
+ SET(BIN_DIR ${CMAKE_CURRENT_BINARY_DIR})
+ IF(EXECUTABLE_OUTPUT_PATH)
+ SET(BIN_DIR ${EXECUTABLE_OUTPUT_PATH})
+ ENDIF(EXECUTABLE_OUTPUT_PATH)
+
+ SET(CFG_INTDIR "/${CMAKE_CFG_INTDIR}")
+ IF(CMAKE_BUILD_TOOL MATCHES "make")
+ SET(CFG_INTDIR "")
+ ENDIF(CMAKE_BUILD_TOOL MATCHES "make")
+
+ # Take advantage of a better custom command syntax if possible.
+ SET(CMD ${BIN_DIR}${CFG_INTDIR}/${KWSYS_NAMESPACE}EncodeExecutable.exe)
+ SET(FWD ${BIN_DIR}${CFG_INTDIR}/${KWSYS_NAMESPACE}ProcessFwd9x.exe)
+ IF("${CMAKE_MAJOR_VERSION}.${CMAKE_MINOR_VERSION}" GREATER 1.6)
+ ADD_CUSTOM_COMMAND(
+ OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c
+ COMMAND ${CMD}
+ ARGS ${FWD} ${CMAKE_CURRENT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c
+ ${KWSYS_NAMESPACE} ProcessFwd9x
+ DEPENDS ${CMD} ${FWD})
+ ELSE("${CMAKE_MAJOR_VERSION}.${CMAKE_MINOR_VERSION}" GREATER 1.6)
+ ADD_CUSTOM_COMMAND(
+ TARGET ${KWSYS_NAMESPACE}
+ SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/ProcessFwd9x.c
+ COMMAND ${CMD}
+ ARGS ${FWD} ${CMAKE_CURRENT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c
+ ${KWSYS_NAMESPACE} ProcessFwd9x
+ OUTPUTS ${CMAKE_CURRENT_BINARY_DIR}/${KWSYS_NAMESPACE}ProcessFwd9xEnc.c
+ DEPENDS ${CMD} ${FWD})
+ ENDIF("${CMAKE_MAJOR_VERSION}.${CMAKE_MINOR_VERSION}" GREATER 1.6)
+
+ # Make sure build occurs in proper order.
+ ADD_DEPENDENCIES(${KWSYS_NAMESPACE} ${KWSYS_NAMESPACE}ProcessFwd9x
+ ${KWSYS_NAMESPACE}EncodeExecutable)
+ ENDIF(NOT UNIX)
+ENDIF(KWSYS_USE_Process)
+
+#-----------------------------------------------------------------------------
+# Setup testing if not being built as part of another project.
+IF(KWSYS_STANDALONE OR CMake_SOURCE_DIR)
+ IF(BUILD_TESTING)
+ # C++ tests
+ IF(KWSYS_USE_DynamicLoader)
+ SET(EXTRA_TESTS
+ testDynamicLoader
+ )
+ ENDIF(KWSYS_USE_DynamicLoader)
+ FOREACH(test
+ testSystemTools
+ testIOS
+ testHashSTL
+ testCommandLineArguments
+ testRegistry
+ ${EXTRA_TESTS}
+ )
+ ADD_EXECUTABLE(${test} ${test}.cxx)
+ TARGET_LINK_LIBRARIES(${test} ${KWSYS_NAMESPACE})
+ ENDFOREACH(test)
+ # C tests
+ FOREACH(test
+ testProcess
+ testFail
+ )
+ ADD_EXECUTABLE(${test} ${test}.c)
+ TARGET_LINK_LIBRARIES(${test} ${KWSYS_NAMESPACE}_c)
+ ENDFOREACH(test)
+
+ SET(EXEC_DIR "${CMAKE_CURRENT_BINARY_DIR}")
+ IF(EXECUTABLE_OUTPUT_PATH)
+ SET(EXEC_DIR "${EXECUTABLE_OUTPUT_PATH}")
+ ENDIF(EXECUTABLE_OUTPUT_PATH)
+
+
+ SET(TEST_SYSTEMTOOLS_BIN_FILE
+ "${CMAKE_CURRENT_SOURCE_DIR}/testSystemTools.bin")
+ SET(TEST_SYSTEMTOOLS_SRC_FILE
+ "${CMAKE_CURRENT_SOURCE_DIR}/testSystemTools.cxx")
+ CONFIGURE_FILE(
+ ${PROJECT_SOURCE_DIR}/testSystemTools.h.in
+ ${PROJECT_BINARY_DIR}/testSystemTools.h)
+ INCLUDE_DIRECTORIES(${PROJECT_BINARY_DIR})
+
+ IF(CTEST_TEST_KWSYS)
+ CONFIGURE_FILE("${CMAKE_CURRENT_SOURCE_DIR}/ExtraTest.cmake.in"
+ "${CMAKE_CURRENT_BINARY_DIR}/ExtraTest.cmake")
+ SET_DIRECTORY_PROPERTIES(PROPERTIES TEST_INCLUDE_FILE "${CMAKE_CURRENT_BINARY_DIR}/ExtraTest.cmake")
+ ENDIF(CTEST_TEST_KWSYS)
+ ADD_TEST(kwsys.testSystemTools ${EXEC_DIR}/testSystemTools)
+ IF(KWSYS_USE_DynamicLoader)
+ ADD_TEST(kwsys.testDynamicLoader ${EXEC_DIR}/testDynamicLoader)
+ ENDIF(KWSYS_USE_DynamicLoader)
+ ADD_TEST(kwsys.testProcess-1 ${EXEC_DIR}/testProcess 1)
+ ADD_TEST(kwsys.testProcess-2 ${EXEC_DIR}/testProcess 2)
+ ADD_TEST(kwsys.testProcess-3 ${EXEC_DIR}/testProcess 3)
+ ADD_TEST(kwsys.testProcess-4 ${EXEC_DIR}/testProcess 4)
+ ADD_TEST(kwsys.testProcess-5 ${EXEC_DIR}/testProcess 5)
+ ADD_TEST(kwsys.testProcess-6 ${EXEC_DIR}/testProcess 6)
+ ADD_TEST(kwsys.testProcess-7 ${EXEC_DIR}/testProcess 7)
+ ADD_TEST(kwsys.testHashSTL ${EXEC_DIR}/testHashSTL)
+ ADD_TEST(kwsys.testRegistry ${EXEC_DIR}/testRegistry)
+ IF(COMMAND SET_TESTS_PROPERTIES AND COMMAND GET_TEST_PROPERTY AND KWSYS_STANDALONE)
+ ADD_TEST(kwsys.testFail ${EXEC_DIR}/testFail)
+ SET_TESTS_PROPERTIES(kwsys.testFail PROPERTIES WILL_FAIL ON)
+ GET_TEST_PROPERTY(kwsys.testFail WILL_FAIL wfv)
+ SET_TESTS_PROPERTIES(kwsys.testRegistry PROPERTIES FAIL_REGULAR_EXPRESSION "ERROR;FAIL;Test failed")
+ SET_TESTS_PROPERTIES(kwsys.testRegistry PROPERTIES PASS_REGULAR_EXPRESSION "Test passed")
+ MESSAGE(STATUS "GET_TEST_PROPERTY returned: ${wfv}")
+ ENDIF(COMMAND SET_TESTS_PROPERTIES AND COMMAND GET_TEST_PROPERTY AND KWSYS_STANDALONE)
+ ENDIF(BUILD_TESTING)
+ENDIF(KWSYS_STANDALONE OR CMake_SOURCE_DIR)
diff --git a/Utilities/ITK/Utilities/kwsys/CTestConfig.cmake b/Utilities/ITK/Utilities/kwsys/CTestConfig.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..23a5bd1725aca2608a1226902f13d6f54abdcbdf
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/CTestConfig.cmake
@@ -0,0 +1,3 @@
+SET (CTEST_PROJECT_NAME "kwsys")
+SET (CTEST_NIGHTLY_START_TIME "21:00:00 EDT")
+SET (CTEST_DART_SERVER_VERSION "2")
diff --git a/Utilities/ITK/Utilities/kwsys/CommandLineArguments.cxx b/Utilities/ITK/Utilities/kwsys/CommandLineArguments.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e340fdc062f3a5ec4a1ad5df327e60ba1b9e8fbc
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/CommandLineArguments.cxx
@@ -0,0 +1,681 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: CommandLineArguments.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(CommandLineArguments.hxx)
+
+#include KWSYS_HEADER(Configure.hxx)
+
+#include KWSYS_HEADER(stl/vector)
+#include KWSYS_HEADER(stl/map)
+#include KWSYS_HEADER(stl/set)
+#include KWSYS_HEADER(ios/sstream)
+#include KWSYS_HEADER(ios/iostream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "CommandLineArguments.hxx.in"
+# include "Configure.hxx.in"
+# include "kwsys_stl.hxx.in"
+# include "kwsys_ios_sstream.h.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef _MSC_VER
+# pragma warning (disable: 4786)
+#endif
+
+#if defined(__sgi) && !defined(__GNUC__)
+# pragma set woff 1375 /* base class destructor not virtual */
+#endif
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+//============================================================================
+class CommandLineArgumentsString : public kwsys_stl::string
+{
+public:
+ typedef kwsys_stl::string StdString;
+ CommandLineArgumentsString(): StdString() {}
+ CommandLineArgumentsString(const value_type* s): StdString(s) {}
+ CommandLineArgumentsString(const value_type* s, size_type n): StdString(s, n) {}
+ CommandLineArgumentsString(const StdString& s, size_type pos=0, size_type n=npos):
+ StdString(s, pos, n) {}
+};
+
+struct CommandLineArgumentsCallbackStructure
+{
+ const char* Argument;
+ int ArgumentType;
+ CommandLineArguments::CallbackType Callback;
+ void* CallData;
+ void* Variable;
+ int VariableType;
+ const char* Help;
+};
+
+class CommandLineArgumentsVectorOfStrings :
+ public kwsys_stl::vector<CommandLineArgumentsString> {};
+class CommandLineArgumentsSetOfStrings :
+ public kwsys_stl::set<CommandLineArgumentsString> {};
+class CommandLineArgumentsMapOfStrucs :
+ public kwsys_stl::map<CommandLineArgumentsString,
+ CommandLineArgumentsCallbackStructure> {};
+
+class CommandLineArgumentsInternal
+{
+public:
+ CommandLineArgumentsInternal()
+ {
+ this->UnknownArgumentCallback = 0;
+ this->ClientData = 0;
+ this->LastArgument = 0;
+ }
+
+ typedef CommandLineArgumentsVectorOfStrings VectorOfStrings;
+ typedef CommandLineArgumentsMapOfStrucs CallbacksMap;
+ typedef CommandLineArgumentsString String;
+ typedef CommandLineArgumentsSetOfStrings SetOfStrings;
+
+ VectorOfStrings Argv;
+ String Argv0;
+ CallbacksMap Callbacks;
+
+ CommandLineArguments::ErrorCallbackType UnknownArgumentCallback;
+ void* ClientData;
+
+ VectorOfStrings::size_type LastArgument;
+};
+//============================================================================
+//----------------------------------------------------------------------------
+
+//----------------------------------------------------------------------------
+CommandLineArguments::CommandLineArguments()
+{
+ this->Internals = new CommandLineArguments::Internal;
+ this->Help = "";
+ this->LineLength = 80;
+}
+
+//----------------------------------------------------------------------------
+CommandLineArguments::~CommandLineArguments()
+{
+ delete this->Internals;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::Initialize(int argc, const char* const argv[])
+{
+ int cc;
+
+ this->Initialize();
+ this->Internals->Argv0 = argv[0];
+ for ( cc = 1; cc < argc; cc ++ )
+ {
+ this->ProcessArgument(argv[cc]);
+ }
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::Initialize(int argc, char* argv[])
+{
+ this->Initialize(argc, static_cast<const char* const*>(argv));
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::Initialize()
+{
+ this->Internals->Argv.clear();
+ this->Internals->LastArgument = 0;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::ProcessArgument(const char* arg)
+{
+ this->Internals->Argv.push_back(arg);
+}
+
+//----------------------------------------------------------------------------
+int CommandLineArguments::Parse()
+{
+ CommandLineArguments::Internal::VectorOfStrings::size_type cc;
+ CommandLineArguments::Internal::VectorOfStrings matches;
+ for ( cc = 0; cc < this->Internals->Argv.size(); cc ++ )
+ {
+ this->Internals->LastArgument = cc;
+ matches.clear();
+ CommandLineArguments::Internal::String& arg = this->Internals->Argv[cc];
+ CommandLineArguments::Internal::CallbacksMap::iterator it;
+
+ // Does the argument match to any we know about?
+ for ( it = this->Internals->Callbacks.begin();
+ it != this->Internals->Callbacks.end();
+ it ++ )
+ {
+ const CommandLineArguments::Internal::String& parg = it->first;
+ CommandLineArgumentsCallbackStructure *cs = &it->second;
+ if (cs->ArgumentType == CommandLineArguments::NO_ARGUMENT ||
+ cs->ArgumentType == CommandLineArguments::SPACE_ARGUMENT)
+ {
+ if ( arg == parg )
+ {
+ matches.push_back(parg);
+ }
+ }
+ else if ( arg.find( parg ) == 0 )
+ {
+ matches.push_back(parg);
+ }
+ }
+ if ( matches.size() > 0 )
+ {
+ // Ok, we found one or more arguments that match what user specified.
+ // Let's find the longest one.
+ CommandLineArguments::Internal::VectorOfStrings::size_type kk;
+ CommandLineArguments::Internal::VectorOfStrings::size_type maxidx = 0;
+ CommandLineArguments::Internal::String::size_type maxlen = 0;
+ for ( kk = 0; kk < matches.size(); kk ++ )
+ {
+ if ( matches[kk].size() > maxlen )
+ {
+ maxlen = matches[kk].size();
+ maxidx = kk;
+ }
+ }
+ // So, the longest one is probably the right one. Now see if it has any
+ // additional value
+ const char* value = 0;
+ CommandLineArgumentsCallbackStructure *cs
+ = &this->Internals->Callbacks[matches[maxidx]];
+ const CommandLineArguments::Internal::String& sarg = matches[maxidx];
+ if ( cs->ArgumentType == NO_ARGUMENT )
+ {
+ // No value
+ }
+ else if ( cs->ArgumentType == SPACE_ARGUMENT )
+ {
+ if ( cc == this->Internals->Argv.size()-1 )
+ {
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ // Value is the next argument
+ value = this->Internals->Argv[cc+1].c_str();
+ cc ++;
+ }
+ else if ( cs->ArgumentType == EQUAL_ARGUMENT )
+ {
+ if ( arg.size() == sarg.size() || *(arg.c_str() + sarg.size()) != '=' )
+ {
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ // Value is everythng followed the '=' sign
+ value = arg.c_str() + sarg.size()+1;
+ }
+ else if ( cs->ArgumentType == CONCAT_ARGUMENT )
+ {
+ // Value is whatever follows the argument
+ value = arg.c_str() + sarg.size();
+ }
+
+ // Call the callback
+ if ( cs->Callback )
+ {
+ if ( !cs->Callback(sarg.c_str(), value, cs->CallData) )
+ {
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ }
+ if ( cs->Variable )
+ {
+ kwsys_stl::string var = "1";
+ if ( value )
+ {
+ var = value;
+ }
+ if ( cs->VariableType == CommandLineArguments::INT_TYPE )
+ {
+ int* variable = static_cast<int*>(cs->Variable);
+ char* res = 0;
+ *variable = strtol(var.c_str(), &res, 10);
+ //if ( res && *res )
+ // {
+ // Can handle non-int
+ // }
+ }
+ else if ( cs->VariableType == CommandLineArguments::DOUBLE_TYPE )
+ {
+ double* variable = static_cast<double*>(cs->Variable);
+ char* res = 0;
+ *variable = strtod(var.c_str(), &res);
+ //if ( res && *res )
+ // {
+ // Can handle non-int
+ // }
+ }
+ else if ( cs->VariableType == CommandLineArguments::STRING_TYPE )
+ {
+ char** variable = static_cast<char**>(cs->Variable);
+ if ( *variable )
+ {
+ delete [] *variable;
+ *variable = 0;
+ }
+ *variable = new char[ strlen(var.c_str()) + 1 ];
+ strcpy(*variable, var.c_str());
+ }
+ else if ( cs->VariableType == CommandLineArguments::STL_STRING_TYPE )
+ {
+ kwsys_stl::string* variable = static_cast<kwsys_stl::string*>(cs->Variable);
+ *variable = var;
+ }
+ else if ( cs->VariableType == CommandLineArguments::BOOL_TYPE )
+ {
+ bool* variable = static_cast<bool*>(cs->Variable);
+ if ( var == "1" || var == "ON" || var == "TRUE" || var == "true" || var == "on" ||
+ var == "True" || var == "yes" || var == "Yes" || var == "YES" )
+ {
+ *variable = true;
+ }
+ else
+ {
+ *variable = false;
+ }
+ }
+ else
+ {
+ kwsys_ios::cerr << "Got unknown argument type: \"" << cs->VariableType << "\"" << kwsys_ios::endl;
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ }
+ }
+ else
+ {
+ // Handle unknown arguments
+ if ( this->Internals->UnknownArgumentCallback )
+ {
+ if ( !this->Internals->UnknownArgumentCallback(arg.c_str(),
+ this->Internals->ClientData) )
+ {
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ return 1;
+ }
+ else
+ {
+ kwsys_ios::cerr << "Got unknown argument: \"" << arg.c_str() << "\"" << kwsys_ios::endl;
+ this->Internals->LastArgument --;
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::GetRemainingArguments(int* argc, char*** argv)
+{
+ CommandLineArguments::Internal::VectorOfStrings::size_type size
+ = this->Internals->Argv.size() - this->Internals->LastArgument + 1;
+ CommandLineArguments::Internal::VectorOfStrings::size_type cc;
+
+ // Copy Argv0 as the first argument
+ char** args = new char*[ size ];
+ args[0] = new char[ this->Internals->Argv0.size() + 1 ];
+ strcpy(args[0], this->Internals->Argv0.c_str());
+ int cnt = 1;
+
+ // Copy everything after the LastArgument, since that was not parsed.
+ for ( cc = this->Internals->LastArgument+1;
+ cc < this->Internals->Argv.size(); cc ++ )
+ {
+ args[cnt] = new char[ this->Internals->Argv[cc].size() + 1];
+ strcpy(args[cnt], this->Internals->Argv[cc].c_str());
+ cnt ++;
+ }
+ *argc = cnt;
+ *argv = args;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::DeleteRemainingArguments(int argc, char*** argv)
+{
+ int cc;
+ for ( cc = 0; cc < argc; ++ cc )
+ {
+ delete [] *argv[cc];
+ }
+ delete [] *argv;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddCallback(const char* argument, ArgumentTypeEnum type,
+ CallbackType callback, void* call_data, const char* help)
+{
+ CommandLineArgumentsCallbackStructure s;
+ s.Argument = argument;
+ s.ArgumentType = type;
+ s.Callback = callback;
+ s.CallData = call_data;
+ s.VariableType = CommandLineArguments::NO_VARIABLE_TYPE;
+ s.Variable = 0;
+ s.Help = help;
+
+ this->Internals->Callbacks[argument] = s;
+ this->GenerateHelp();
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ VariableTypeEnum vtype, void* variable, const char* help)
+{
+ CommandLineArgumentsCallbackStructure s;
+ s.Argument = argument;
+ s.ArgumentType = type;
+ s.Callback = 0;
+ s.CallData = 0;
+ s.VariableType = vtype;
+ s.Variable = variable;
+ s.Help = help;
+
+ this->Internals->Callbacks[argument] = s;
+ this->GenerateHelp();
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ int* variable, const char* help)
+{
+ this->AddArgument(argument, type, CommandLineArguments::INT_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ double* variable, const char* help)
+{
+ this->AddArgument(argument, type, CommandLineArguments::DOUBLE_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ char** variable, const char* help)
+{
+ this->AddArgument(argument, type, CommandLineArguments::STRING_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ kwsys_stl::string* variable, const char* help)
+{
+ this->AddArgument(argument, type, CommandLineArguments::STL_STRING_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddArgument(const char* argument, ArgumentTypeEnum type,
+ bool* variable, const char* help)
+{
+ this->AddArgument(argument, type, CommandLineArguments::BOOL_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddBooleanArgument(const char* argument, bool*
+ variable, const char* help)
+{
+ this->AddArgument(argument, CommandLineArguments::NO_ARGUMENT,
+ CommandLineArguments::BOOL_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::AddBooleanArgument(const char* argument, int*
+ variable, const char* help)
+{
+ this->AddArgument(argument, CommandLineArguments::NO_ARGUMENT,
+ CommandLineArguments::INT_TYPE, variable, help);
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::SetClientData(void* client_data)
+{
+ this->Internals->ClientData = client_data;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::SetUnknownArgumentCallback(
+ CommandLineArguments::ErrorCallbackType callback)
+{
+ this->Internals->UnknownArgumentCallback = callback;
+}
+
+//----------------------------------------------------------------------------
+const char* CommandLineArguments::GetHelp(const char* arg)
+{
+ CommandLineArguments::Internal::CallbacksMap::iterator it
+ = this->Internals->Callbacks.find(arg);
+ if ( it == this->Internals->Callbacks.end() )
+ {
+ return 0;
+ }
+
+ // Since several arguments may point to the same argument, find the one this
+ // one point to if this one is pointing to another argument.
+ CommandLineArgumentsCallbackStructure *cs = &(it->second);
+ for(;;)
+ {
+ CommandLineArguments::Internal::CallbacksMap::iterator hit
+ = this->Internals->Callbacks.find(cs->Help);
+ if ( hit == this->Internals->Callbacks.end() )
+ {
+ break;
+ }
+ cs = &(hit->second);
+ }
+ return cs->Help;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::SetLineLength(unsigned int ll)
+{
+ if ( ll < 9 || ll > 1000 )
+ {
+ return;
+ }
+ this->LineLength = ll;
+ this->GenerateHelp();
+}
+
+//----------------------------------------------------------------------------
+const char* CommandLineArguments::GetArgv0()
+{
+ return this->Internals->Argv0.c_str();
+}
+
+//----------------------------------------------------------------------------
+unsigned int CommandLineArguments::GetLastArgument()
+{
+ return this->Internals->LastArgument + 1;
+}
+
+//----------------------------------------------------------------------------
+void CommandLineArguments::GenerateHelp()
+{
+ kwsys_ios::ostringstream str;
+
+ // Collapse all arguments into the map of vectors of all arguments that do
+ // the same thing.
+ CommandLineArguments::Internal::CallbacksMap::iterator it;
+ typedef kwsys_stl::map<CommandLineArguments::Internal::String,
+ CommandLineArguments::Internal::SetOfStrings > MapArgs;
+ MapArgs mp;
+ MapArgs::iterator mpit, smpit;
+ for ( it = this->Internals->Callbacks.begin();
+ it != this->Internals->Callbacks.end();
+ it ++ )
+ {
+ CommandLineArgumentsCallbackStructure *cs = &(it->second);
+ mpit = mp.find(cs->Help);
+ if ( mpit != mp.end() )
+ {
+ mpit->second.insert(it->first);
+ mp[it->first].insert(it->first);
+ }
+ else
+ {
+ mp[it->first].insert(it->first);
+ }
+ }
+ for ( it = this->Internals->Callbacks.begin();
+ it != this->Internals->Callbacks.end();
+ it ++ )
+ {
+ CommandLineArgumentsCallbackStructure *cs = &(it->second);
+ mpit = mp.find(cs->Help);
+ if ( mpit != mp.end() )
+ {
+ mpit->second.insert(it->first);
+ smpit = mp.find(it->first);
+ CommandLineArguments::Internal::SetOfStrings::iterator sit;
+ for ( sit = smpit->second.begin(); sit != smpit->second.end(); sit++ )
+ {
+ mpit->second.insert(*sit);
+ }
+ mp.erase(smpit);
+ }
+ else
+ {
+ mp[it->first].insert(it->first);
+ }
+ }
+
+ // Find the length of the longest string
+ CommandLineArguments::Internal::String::size_type maxlen = 0;
+ for ( mpit = mp.begin();
+ mpit != mp.end();
+ mpit ++ )
+ {
+ CommandLineArguments::Internal::SetOfStrings::iterator sit;
+ for ( sit = mpit->second.begin(); sit != mpit->second.end(); sit++ )
+ {
+ CommandLineArguments::Internal::String::size_type clen = sit->size();
+ switch ( this->Internals->Callbacks[*sit].ArgumentType )
+ {
+ case CommandLineArguments::NO_ARGUMENT: clen += 0; break;
+ case CommandLineArguments::CONCAT_ARGUMENT: clen += 3; break;
+ case CommandLineArguments::SPACE_ARGUMENT: clen += 4; break;
+ case CommandLineArguments::EQUAL_ARGUMENT: clen += 4; break;
+ }
+ if ( clen > maxlen )
+ {
+ maxlen = clen;
+ }
+ }
+ }
+
+ // Create format for that string
+ char format[80];
+ sprintf(format, " %%-%ds ", static_cast<unsigned int>(maxlen));
+
+ maxlen += 4; // For the space before and after the option
+
+ // Print help for each option
+ for ( mpit = mp.begin();
+ mpit != mp.end();
+ mpit ++ )
+ {
+ CommandLineArguments::Internal::SetOfStrings::iterator sit;
+ for ( sit = mpit->second.begin(); sit != mpit->second.end(); sit++ )
+ {
+ str << kwsys_ios::endl;
+ char argument[100];
+ sprintf(argument, sit->c_str());
+ switch ( this->Internals->Callbacks[*sit].ArgumentType )
+ {
+ case CommandLineArguments::NO_ARGUMENT: break;
+ case CommandLineArguments::CONCAT_ARGUMENT: strcat(argument, "opt"); break;
+ case CommandLineArguments::SPACE_ARGUMENT: strcat(argument, " opt"); break;
+ case CommandLineArguments::EQUAL_ARGUMENT: strcat(argument, "=opt"); break;
+ }
+ char buffer[80];
+ sprintf(buffer, format, argument);
+ str << buffer;
+ }
+ const char* ptr = this->Internals->Callbacks[mpit->first].Help;
+ int len = strlen(ptr);
+ int cnt = 0;
+ while ( len > 0)
+ {
+ // If argument with help is longer than line length, split it on previous
+ // space (or tab) and continue on the next line
+ CommandLineArguments::Internal::String::size_type cc;
+ for ( cc = 0; ptr[cc]; cc ++ )
+ {
+ if ( *ptr == ' ' || *ptr == '\t' )
+ {
+ ptr ++;
+ len --;
+ }
+ }
+ if ( cnt > 0 )
+ {
+ for ( cc = 0; cc < maxlen; cc ++ )
+ {
+ str << " ";
+ }
+ }
+ CommandLineArguments::Internal::String::size_type skip = len;
+ if ( skip > this->LineLength - maxlen )
+ {
+ skip = this->LineLength - maxlen;
+ for ( cc = skip-1; cc > 0; cc -- )
+ {
+ if ( ptr[cc] == ' ' || ptr[cc] == '\t' )
+ {
+ break;
+ }
+ }
+ if ( cc != 0 )
+ {
+ skip = cc;
+ }
+ }
+ str.write(ptr, skip);
+ str << kwsys_ios::endl;
+ ptr += skip;
+ len -= skip;
+ cnt ++;
+ }
+ }
+ /*
+ // This can help debugging help string
+ str << endl;
+ unsigned int cc;
+ for ( cc = 0; cc < this->LineLength; cc ++ )
+ {
+ str << cc % 10;
+ }
+ str << endl;
+ */
+ this->Help = str.str();
+}
+
+} // namespace KWSYS_NAMESPACE
diff --git a/Utilities/ITK/Utilities/kwsys/CommandLineArguments.hxx.in b/Utilities/ITK/Utilities/kwsys/CommandLineArguments.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..9ce93e9a0f13f5e470fef867af55638c471e9ed1
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/CommandLineArguments.hxx.in
@@ -0,0 +1,227 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: CommandLineArguments.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_CommandLineArguments_hxx
+#define @KWSYS_NAMESPACE@_CommandLineArguments_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#include <@KWSYS_NAMESPACE@/stl/string>
+
+/* Define this macro temporarily to keep the code readable. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+class CommandLineArgumentsInternal;
+
+/** \class CommandLineArguments
+ * \brief Command line arguments processing code.
+ *
+ * Find specified arguments with optional options and execute specified methods
+ * or set given variables.
+ *
+ * The two interfaces it knows are callback based and variable based. For
+ * callback based, you have to register callback for particular argument using
+ * AddCallback method. When that argument is passed, the callback will be
+ * called with argument, value, and call data. For boolean (NO_ARGUMENT)
+ * arguments, the value is "1". If the callback returns 0 the argument parsing
+ * will stop with an error.
+ *
+ * For the variable interface you associate variable with each argument. When
+ * the argument is specified, the variable is set to the specified value casted
+ * to the apropriate type. For boolean (NO_ARGUMENT), the value is "1".
+ *
+ * Both interfaces can be used at the same time.
+ *
+ * Possible argument types are:
+ * NO_ARGUMENT - The argument takes no value : --A
+ * CONCAT_ARGUMENT - The argument takes value after no space : --Aval
+ * SPACE_ARGUMENT - The argument takes value after space : --A val
+ * EQUAL_ARGUMENT - The argument takes value after equal : --A=val
+ *
+ * Example use:
+ *
+ * kwsys::CommandLineArguments arg;
+ * arg.Initialize(argc, argv);
+ * typedef kwsys::CommandLineArguments argT;
+ * arg.AddArgument("--something", argT::EQUAL_ARGUMENT, &some_variable,
+ * "This is help string for --something");
+ * if ( !arg.Parse() )
+ * {
+ * kwsys_ios::cerr << "Problem parsing arguments" << kwsys_ios::endl;
+ * res = 1;
+ * }
+ *
+ */
+
+class @KWSYS_NAMESPACE@_EXPORT CommandLineArguments
+{
+public:
+ CommandLineArguments();
+ ~CommandLineArguments();
+
+ /**
+ * Various argument types.
+ */
+ enum ArgumentTypeEnum {
+ NO_ARGUMENT,
+ CONCAT_ARGUMENT,
+ SPACE_ARGUMENT,
+ EQUAL_ARGUMENT
+ };
+
+ /**
+ * Various variable types. When using the variable interface, this specifies
+ * what type the variable is.
+ */
+ enum VariableTypeEnum {
+ NO_VARIABLE_TYPE = 0, // The variable is not specified
+ INT_TYPE, // The variable is integer (int)
+ BOOL_TYPE, // The vairable is boolean (bool)
+ DOUBLE_TYPE, // The variable is float (double)
+ STRING_TYPE, // The variable is string (char*)
+ STL_STRING_TYPE // The variable is string (char*)
+ };
+
+ /**
+ * Prototypes for callbacks for callback interface.
+ */
+ typedef int(*CallbackType)(const char* argument, const char* value,
+ void* call_data);
+ typedef int(*ErrorCallbackType)(const char* argument, void* client_data);
+
+ /**
+ * Initialize internal data structures. This should be called before parsing.
+ */
+ void Initialize(int argc, const char* const argv[]);
+ void Initialize(int argc, char* argv[]);
+
+ /**
+ * Initialize internal data structure and pass arguments one by one. This is
+ * convenience method for use from scripting languages where argc and argv
+ * are not available.
+ */
+ void Initialize();
+ void ProcessArgument(const char* arg);
+
+ /**
+ * This method will parse arguments and call apropriate methods.
+ */
+ int Parse();
+
+ /**
+ * This method will add a callback for a specific argument. The arguments to
+ * it are argument, argument type, callback method, and call data. The
+ * argument help specifies the help string used with this option. The
+ * callback and call_data can be skipped.
+ */
+ void AddCallback(const char* argument, ArgumentTypeEnum type,
+ CallbackType callback, void* call_data, const char* help);
+
+ /**
+ * Add handler for argument which is going to set the variable to the
+ * specified value. If the argument is specified, the option is casted to the
+ * apropriate type.
+ */
+ void AddArgument(const char* argument, ArgumentTypeEnum type, bool* variable,
+ const char* help);
+ void AddArgument(const char* argument, ArgumentTypeEnum type, int* variable,
+ const char* help);
+ void AddArgument(const char* argument, ArgumentTypeEnum type,
+ double* variable, const char* help);
+ void AddArgument(const char* argument, ArgumentTypeEnum type,
+ char** variable, const char* help);
+ void AddArgument(const char* argument, ArgumentTypeEnum type,
+ kwsys_stl::string* variable, const char* help);
+
+ /**
+ * Add handler for boolean argument. The argument does not take any option
+ * and if it is specified, the value of the variable is true/1, otherwise it
+ * is false/0.
+ */
+ void AddBooleanArgument(const char* argument, bool* variable, const char*
+ help);
+ void AddBooleanArgument(const char* argument, int* variable, const char*
+ help);
+
+ /**
+ * Set the callbacks for error handling.
+ */
+ void SetClientData(void* client_data);
+ void SetUnknownArgumentCallback(ErrorCallbackType callback);
+
+ /**
+ * Get remaining arguments. It allocates space for argv, so you have to call
+ * delete[] on it.
+ */
+ void GetRemainingArguments(int* argc, char*** argv);
+ void DeleteRemainingArguments(int argc, char*** argv);
+
+ /**
+ * Return string containing help. If the argument is specified, only return
+ * help for that argument.
+ */
+ const char* GetHelp() { return this->Help.c_str(); }
+ const char* GetHelp(const char* arg);
+
+ /**
+ * Get / Set the help line length. This length is used when generating the
+ * help page. Default length is 80.
+ */
+ void SetLineLength(unsigned int);
+ unsigned int GetLineLength();
+
+ /**
+ * Get the executable name (argv0). This is only available when using
+ * Initialize with argc/argv.
+ */
+ const char* GetArgv0();
+
+ /**
+ * Get index of the last argument parsed. This is the last argument that was
+ * parsed ok in the original argc/argv list.
+ */
+ unsigned int GetLastArgument();
+
+protected:
+ void GenerateHelp();
+
+ //! This is internal method that registers variable with argument
+ void AddArgument(const char* argument, ArgumentTypeEnum type,
+ VariableTypeEnum vtype, void* variable, const char* help);
+
+ typedef CommandLineArgumentsInternal Internal;
+ Internal* Internals;
+ kwsys_stl::string Help;
+
+ unsigned int LineLength;
+};
+
+} // namespace @KWSYS_NAMESPACE@
+
+/* Undefine temporary macro. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# undef kwsys_stl
+#endif
+
+#endif
+
+
+
+
+
diff --git a/Utilities/ITK/Utilities/kwsys/Configure.h.in b/Utilities/ITK/Utilities/kwsys/Configure.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..1dace1b77b9edc55e9aa6cf7a89e0f256e6d622b
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Configure.h.in
@@ -0,0 +1,70 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Configure.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Configure_h
+#define @KWSYS_NAMESPACE@_Configure_h
+
+/* If we are building a kwsys .c or .cxx file, let it use the kwsys
+ namespace. When not building a kwsys source file these macros are
+ temporarily defined inside the headers that use them. */
+#if defined(KWSYS_NAMESPACE)
+# define kwsys_ns(x) @KWSYS_NAMESPACE@##x
+# define kwsysEXPORT @KWSYS_NAMESPACE@_EXPORT
+#endif
+
+/* Setup the export macro. */
+#if defined(_WIN32) && @KWSYS_BUILD_SHARED@
+# if defined(@KWSYS_NAMESPACE@_EXPORTS)
+# define @KWSYS_NAMESPACE@_EXPORT __declspec(dllexport)
+# else
+# define @KWSYS_NAMESPACE@_EXPORT __declspec(dllimport)
+# endif
+#else
+# define @KWSYS_NAMESPACE@_EXPORT
+#endif
+
+/* Enable warnings that are off by default but are useful. */
+#if !defined(@KWSYS_NAMESPACE@_NO_WARNING_ENABLE)
+# if defined(_MSC_VER)
+# pragma warning ( default : 4263 ) /* no override, call convention differs */
+# endif
+#endif
+
+/* Disable warnings that are on by default but occur in valid code. */
+#if !defined(@KWSYS_NAMESPACE@_NO_WARNING_DISABLE)
+# if defined(_MSC_VER)
+# pragma warning (disable: 4097) /* typedef is synonym for class */
+# pragma warning (disable: 4127) /* conditional expression is constant */
+# pragma warning (disable: 4244) /* possible loss in conversion */
+# pragma warning (disable: 4251) /* missing DLL-interface */
+# pragma warning (disable: 4305) /* truncation from type1 to type2 */
+# pragma warning (disable: 4309) /* truncation of constant value */
+# pragma warning (disable: 4514) /* unreferenced inline function */
+# pragma warning (disable: 4706) /* assignment in conditional expression */
+# pragma warning (disable: 4710) /* function not inlined */
+# pragma warning (disable: 4786) /* identifier truncated in debug info */
+# endif
+#endif
+
+/* MSVC 6.0 in release mode will warn about code it produces with its
+ optimizer. Disable the warnings specifically for this
+ configuration. Real warnings will be revealed by a debug build or
+ by other compilers. */
+#if !defined(@KWSYS_NAMESPACE@_NO_WARNING_DISABLE_BOGUS)
+# if defined(_MSC_VER) && (_MSC_VER < 1300) && defined(NDEBUG)
+# pragma warning ( disable : 4701 ) /* Variable may be used uninitialized. */
+# pragma warning ( disable : 4702 ) /* Unreachable code. */
+# endif
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/Configure.hxx.in b/Utilities/ITK/Utilities/kwsys/Configure.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..cb7817fa6a1527407288f24c42ccaff50d61d79f
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Configure.hxx.in
@@ -0,0 +1,168 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Configure.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Configure_hxx
+#define @KWSYS_NAMESPACE@_Configure_hxx
+
+/* Include C configuration. */
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+/* Whether kwsys namespace is "kwsys". */
+#define @KWSYS_NAMESPACE@_NAME_IS_KWSYS @KWSYS_NAME_IS_KWSYS@
+
+/* Whether ANSI C++ stream headers are to be used. */
+#define @KWSYS_NAMESPACE@_IOS_USE_ANSI @KWSYS_IOS_USE_ANSI@
+
+/* Whether ANSI C++ streams are in std namespace. */
+#define @KWSYS_NAMESPACE@_IOS_HAVE_STD @KWSYS_IOS_HAVE_STD@
+
+/* Whether ANSI C++ <sstream> header is to be used. */
+#define @KWSYS_NAMESPACE@_IOS_USE_SSTREAM @KWSYS_IOS_USE_SSTREAM@
+
+/* Whether old C++ <strstream.h> header is to be used. */
+#define @KWSYS_NAMESPACE@_IOS_USE_STRSTREAM_H @KWSYS_IOS_USE_STRSTREAM_H@
+
+/* Whether old C++ <strstrea.h> header is to be used. */
+#define @KWSYS_NAMESPACE@_IOS_USE_STRSTREA_H @KWSYS_IOS_USE_STRSTREA_H@
+
+/* Whether STL is in std namespace. */
+#define @KWSYS_NAMESPACE@_STL_HAVE_STD @KWSYS_STL_HAVE_STD@
+
+/* Whether the STL string has operator<< for ostream. */
+#define @KWSYS_NAMESPACE@_STL_STRING_HAVE_OSTREAM @KWSYS_STL_STRING_HAVE_OSTREAM@
+
+/* Whether the STL string has operator>> for istream. */
+#define @KWSYS_NAMESPACE@_STL_STRING_HAVE_ISTREAM @KWSYS_STL_STRING_HAVE_ISTREAM@
+
+/* Whether the STL string has operator!= for char*. */
+#define @KWSYS_NAMESPACE@_STL_STRING_HAVE_NEQ_CHAR @KWSYS_STL_STRING_HAVE_NEQ_CHAR@
+
+/* Define the stl namespace macro. */
+#if @KWSYS_NAMESPACE@_STL_HAVE_STD
+# define @KWSYS_NAMESPACE@_stl std
+#else
+# define @KWSYS_NAMESPACE@_stl
+#endif
+
+/* Define the ios namespace macro. */
+#if @KWSYS_NAMESPACE@_IOS_HAVE_STD
+# define @KWSYS_NAMESPACE@_ios_namespace std
+#else
+# define @KWSYS_NAMESPACE@_ios_namespace
+#endif
+#if @KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+# define @KWSYS_NAMESPACE@_ios @KWSYS_NAMESPACE@_ios_namespace
+#else
+# define @KWSYS_NAMESPACE@_ios @KWSYS_NAMESPACE@_ios
+#endif
+
+/* Whether the cstddef header is available. */
+#define @KWSYS_NAMESPACE@_CXX_HAS_CSTDDEF @KWSYS_CXX_HAS_CSTDDEF@
+
+/* Whether the compiler supports null template arguments. */
+#define @KWSYS_NAMESPACE@_CXX_HAS_NULL_TEMPLATE_ARGS @KWSYS_CXX_HAS_NULL_TEMPLATE_ARGS@
+
+/* Define the null template arguments macro. */
+#if @KWSYS_NAMESPACE@_CXX_HAS_NULL_TEMPLATE_ARGS
+# define @KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS <>
+#else
+# define @KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS
+#endif
+
+/* Whether the compiler supports member templates. */
+#define @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES @KWSYS_CXX_HAS_MEMBER_TEMPLATES@
+
+/* Whether the compiler supports argument dependent lookup. */
+#define @KWSYS_NAMESPACE@_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP @KWSYS_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP@
+
+/* Whether the compiler supports standard full specialization syntax. */
+#define @KWSYS_NAMESPACE@_CXX_HAS_FULL_SPECIALIZATION @KWSYS_CXX_HAS_FULL_SPECIALIZATION@
+
+/* Define the specialization definition macro. */
+#if @KWSYS_NAMESPACE@_CXX_HAS_FULL_SPECIALIZATION
+# define @KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION template <>
+#else
+# define @KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+#endif
+
+/* Define typename keyword macro for use in declarations. */
+#if defined(_MSC_VER) && _MSC_VER < 1300
+# define @KWSYS_NAMESPACE@_CXX_DECL_TYPENAME
+#else
+# define @KWSYS_NAMESPACE@_CXX_DECL_TYPENAME typename
+#endif
+
+/* Whether the stl has iterator_traits. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_TRAITS @KWSYS_STL_HAS_ITERATOR_TRAITS@
+
+/* Whether the stl has iterator_category. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_CATEGORY @KWSYS_STL_HAS_ITERATOR_CATEGORY@
+
+/* Whether the stl has __iterator_category. */
+#define @KWSYS_NAMESPACE@_STL_HAS___ITERATOR_CATEGORY @KWSYS_STL_HAS___ITERATOR_CATEGORY@
+
+/* Whether the stl allocator is the standard template. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_TEMPLATE @KWSYS_STL_HAS_ALLOCATOR_TEMPLATE@
+
+/* Whether the stl allocator is not a template. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_NONTEMPLATE @KWSYS_STL_HAS_ALLOCATOR_NONTEMPLATE@
+
+/* Whether the stl allocator has rebind. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_REBIND @KWSYS_STL_HAS_ALLOCATOR_REBIND@
+
+/* Whether the stl allocator has a size argument for max_size. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT @KWSYS_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT@
+
+/* Whether the stl containers support allocator objects. */
+#define @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_OBJECTS @KWSYS_STL_HAS_ALLOCATOR_OBJECTS@
+
+/* Whether struct stat has the st_mtim member for high resolution times. */
+#define @KWSYS_NAMESPACE@_STAT_HAS_ST_MTIM @KWSYS_STAT_HAS_ST_MTIM@
+
+/* If building a C++ file in kwsys itself, give the source file
+ access to the macros without a configured namespace. */
+#if defined(KWSYS_NAMESPACE)
+# if !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+# define kwsys_ios @KWSYS_NAMESPACE@_ios
+# define kwsys @KWSYS_NAMESPACE@
+# endif
+# define KWSYS_NAME_IS_KWSYS @KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define KWSYS_STL_HAVE_STD @KWSYS_NAMESPACE@_STL_HAVE_STD
+# define KWSYS_IOS_HAVE_STD @KWSYS_NAMESPACE@_IOS_HAVE_STD
+# define KWSYS_IOS_USE_ANSI @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# define KWSYS_IOS_USE_SSTREAM @KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+# define KWSYS_IOS_USE_STRSTREAM_H @KWSYS_NAMESPACE@_IOS_USE_STRSTREAM_H
+# define KWSYS_IOS_USE_STRSTREA_H @KWSYS_NAMESPACE@_IOS_USE_STRSTREA_H
+# define KWSYS_STAT_HAS_ST_MTIM @KWSYS_NAMESPACE@_STAT_HAS_ST_MTIM
+# define KWSYS_CXX_HAS_CSTDDEF @KWSYS_NAMESPACE@_CXX_HAS_CSTDDEF
+# define KWSYS_STL_STRING_HAVE_OSTREAM @KWSYS_NAMESPACE@_STL_STRING_HAVE_OSTREAM
+# define KWSYS_STL_STRING_HAVE_ISTREAM @KWSYS_NAMESPACE@_STL_STRING_HAVE_ISTREAM
+# define KWSYS_STL_STRING_HAVE_NEQ_CHAR @KWSYS_NAMESPACE@_STL_STRING_HAVE_NEQ_CHAR
+# define KWSYS_CXX_NULL_TEMPLATE_ARGS @KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS
+# define KWSYS_CXX_HAS_MEMBER_TEMPLATES @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+# define KWSYS_CXX_HAS_FULL_SPECIALIZATION @KWSYS_NAMESPACE@_CXX_HAS_FULL_SPECIALIZATION
+# define KWSYS_CXX_DEFINE_SPECIALIZATION @KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+# define KWSYS_CXX_DECL_TYPENAME @KWSYS_NAMESPACE@_CXX_DECL_TYPENAME
+# define KWSYS_STL_HAS_ALLOCATOR_REBIND @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_REBIND
+# define KWSYS_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT
+# define KWSYS_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP @KWSYS_NAMESPACE@_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP
+# define KWSYS_STL_HAS_ITERATOR_TRAITS @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_TRAITS
+# define KWSYS_STL_HAS_ITERATOR_CATEGORY @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_CATEGORY
+# define KWSYS_STL_HAS___ITERATOR_CATEGORY @KWSYS_NAMESPACE@_STL_HAS___ITERATOR_CATEGORY
+# define KWSYS_STL_HAS_ALLOCATOR_TEMPLATE @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_TEMPLATE
+# define KWSYS_STL_HAS_ALLOCATOR_NONTEMPLATE @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_NONTEMPLATE
+# define KWSYS_STL_HAS_ALLOCATOR_OBJECTS @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_OBJECTS
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/Copyright.txt b/Utilities/ITK/Utilities/kwsys/Copyright.txt
new file mode 100644
index 0000000000000000000000000000000000000000..86e0e7375fe42bdcb8a896bcbffa11fb48cb415e
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Copyright.txt
@@ -0,0 +1,33 @@
+Copyright (c) 2000-2003 Kitware, Inc., Insight Consortium.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the
+ distribution.
+
+ * Neither the name of Kitware nor the names of any contributors may
+ be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ * Modified source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Utilities/ITK/Utilities/kwsys/Directory.cxx b/Utilities/ITK/Utilities/kwsys/Directory.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6dafb8fbd5126b423c4cd2dbb13d78504bef0fff
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Directory.cxx
@@ -0,0 +1,180 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Directory.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Directory.hxx)
+
+#include KWSYS_HEADER(Configure.hxx)
+
+#include KWSYS_HEADER(stl/string)
+#include KWSYS_HEADER(stl/vector)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "Directory.hxx.in"
+# include "Configure.hxx.in"
+# include "kwsys_stl.hxx.in"
+# include "kwsys_stl_string.hxx.in"
+# include "kwsys_stl_vector.hxx.in"
+#endif
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+class DirectoryInternals
+{
+public:
+ // Array of Files
+ kwsys_stl::vector<kwsys_stl::string> Files;
+
+ // Path to Open'ed directory
+ kwsys_stl::string Path;
+};
+
+//----------------------------------------------------------------------------
+Directory::Directory()
+{
+ this->Internal = new DirectoryInternals;
+}
+
+//----------------------------------------------------------------------------
+Directory::~Directory()
+{
+ delete this->Internal;
+}
+
+//----------------------------------------------------------------------------
+unsigned long Directory::GetNumberOfFiles() const
+{
+ return static_cast<unsigned long>(this->Internal->Files.size());
+}
+
+//----------------------------------------------------------------------------
+const char* Directory::GetFile(unsigned long dindex) const
+{
+ if ( dindex >= this->Internal->Files.size() )
+ {
+ return 0;
+ }
+ return this->Internal->Files[dindex].c_str();
+}
+
+//----------------------------------------------------------------------------
+const char* Directory::GetPath() const
+{
+ return this->Internal->Path.c_str();
+}
+
+//----------------------------------------------------------------------------
+void Directory::Clear()
+{
+ //this->Internal->Path.clear();
+ this->Internal->Path = "";
+ this->Internal->Files.clear();
+}
+
+} // namespace KWSYS_NAMESPACE
+
+// First microsoft compilers
+
+#if defined(_MSC_VER) || defined(__WATCOMC__)
+#include <windows.h>
+#include <io.h>
+#include <ctype.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+
+namespace KWSYS_NAMESPACE
+{
+
+bool Directory::Load(const char* name)
+{
+ this->Clear();
+#if _MSC_VER < 1300
+ long srchHandle;
+#else
+ intptr_t srchHandle;
+#endif
+ char* buf;
+ size_t n = strlen(name);
+ if ( name[n - 1] == '/' )
+ {
+ buf = new char[n + 1 + 1];
+ sprintf(buf, "%s*", name);
+ }
+ else
+ {
+ buf = new char[n + 2 + 1];
+ sprintf(buf, "%s/*", name);
+ }
+ struct _finddata_t data; // data of current file
+
+ // Now put them into the file array
+ srchHandle = _findfirst(buf, &data);
+ delete [] buf;
+
+ if ( srchHandle == -1 )
+ {
+ return 0;
+ }
+
+ // Loop through names
+ do
+ {
+ this->Internal->Files.push_back(data.name);
+ }
+ while ( _findnext(srchHandle, &data) != -1 );
+ this->Internal->Path = name;
+ return _findclose(srchHandle) != -1;
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#else
+
+// Now the POSIX style directory access
+
+#include <sys/types.h>
+#include <dirent.h>
+
+namespace KWSYS_NAMESPACE
+{
+
+bool Directory::Load(const char* name)
+{
+ this->Clear();
+ DIR* dir = opendir(name);
+
+ if (!dir)
+ {
+ return 0;
+ }
+
+ for (dirent* d = readdir(dir); d; d = readdir(dir) )
+ {
+ this->Internal->Files.push_back(d->d_name);
+ }
+ this->Internal->Path = name;
+ closedir(dir);
+ return 1;
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/Directory.hxx.in b/Utilities/ITK/Utilities/kwsys/Directory.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..bb83cee61ddbec309712a9dd447da008b2c20384
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Directory.hxx.in
@@ -0,0 +1,74 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Directory.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Directory_hxx
+#define @KWSYS_NAMESPACE@_Directory_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+namespace @KWSYS_NAMESPACE@
+{
+
+class DirectoryInternals;
+
+/** \class Directory
+ * \brief Portable directory/filename traversal.
+ *
+ * Directory provides a portable way of finding the names of the files
+ * in a system directory.
+ *
+ * Directory currently works with Windows and Unix operating systems.
+ */
+class @KWSYS_NAMESPACE@_EXPORT Directory
+{
+public:
+ Directory();
+ ~Directory();
+
+ /**
+ * Load the specified directory and load the names of the files
+ * in that directory. 0 is returned if the directory can not be
+ * opened, 1 if it is opened.
+ */
+ bool Load(const char*);
+
+ /**
+ * Return the number of files in the current directory.
+ */
+ unsigned long GetNumberOfFiles() const;
+
+ /**
+ * Return the file at the given index, the indexing is 0 based
+ */
+ const char* GetFile(unsigned long) const;
+
+ /**
+ * Return the path to Open'ed directory
+ */
+ const char* GetPath() const;
+
+protected:
+ /**
+ * Clear the internal structure. Used internally at beginning of Load(...) to clear
+ * the cache.
+ */
+ void Clear();
+
+private:
+ // Private implementation details.
+ DirectoryInternals* Internal;
+}; // End Class: Directory
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/DynamicLoader.cxx b/Utilities/ITK/Utilities/kwsys/DynamicLoader.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2d8db09bf9d433fcba310e9a0e4de65f7ac92070
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/DynamicLoader.cxx
@@ -0,0 +1,382 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: DynamicLoader.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(DynamicLoader.hxx)
+
+#include KWSYS_HEADER(Configure.hxx)
+
+#ifdef __APPLE__
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+#include <string.h> // for strlen
+#endif //MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+#endif // __APPLE__
+
+#ifdef __hpux
+#include <errno.h>
+#endif //__hpux
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "DynamicLoader.hxx.in"
+# include "Configure.hxx.in"
+#endif
+
+// This file is actually 3 different implementations.
+// 1. HP machines which uses shl_load
+// 2. Mac OS X 10.2.x and earlier which uses NSLinkModule
+// 3. Windows which uses LoadLibrary
+// 4. Most unix systems (including Mac OS X 10.3 and later) which use dlopen (default)
+// Each part of the ifdef contains a complete implementation for
+// the static methods of DynamicLoader.
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+DynamicLoader::DynamicLoader()
+{
+}
+
+//----------------------------------------------------------------------------
+DynamicLoader::~DynamicLoader()
+{
+}
+
+}
+
+// ---------------------------------------------------------------
+// 1. Implementation for HPUX machines
+#ifdef __hpux
+#include <dl.h>
+#define DYNAMICLOADER_DEFINED 1
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+LibHandle DynamicLoader::OpenLibrary(const char* libname )
+{
+ return shl_load(libname, BIND_DEFERRED | DYNAMIC_PATH, 0L);
+}
+
+//----------------------------------------------------------------------------
+int DynamicLoader::CloseLibrary(LibHandle lib)
+{
+ return !shl_unload(lib);
+}
+
+//----------------------------------------------------------------------------
+DynamicLoaderFunction
+DynamicLoader::GetSymbolAddress(LibHandle lib, const char* sym)
+{
+ void* addr;
+ int status;
+
+ /* TYPE_PROCEDURE Look for a function or procedure.
+ * TYPE_DATA Look for a symbol in the data segment (for example, variables).
+ * TYPE_UNDEFINED Look for any symbol.
+ */
+ status = shl_findsym (&lib, sym, TYPE_UNDEFINED, &addr);
+ void* result = (status < 0) ? (void*)0 : addr;
+
+ // Hack to cast pointer-to-data to pointer-to-function.
+ return *reinterpret_cast<DynamicLoaderFunction*>(&result);
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibPrefix()
+{
+ return "lib";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibExtension()
+{
+ return ".sl";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LastError()
+{
+ // TODO: Need implementation with errno/strerror
+ /* If successful, shl_findsym returns an integer (int) value zero. If
+ * shl_findsym cannot find sym, it returns -1 and sets errno to zero.
+ * If any other errors occur, shl_findsym returns -1 and sets errno to one
+ * of these values (defined in <errno.h>):
+ * ENOEXEC
+ * A format error was detected in the specified library.
+ * ENOSYM
+ * A symbol on which sym depends could not be found.
+ * EINVAL
+ * The specified handle is invalid.
+ */
+
+ if( errno == ENOEXEC
+ || errno == ENOSYM
+ || errno == EINVAL )
+ {
+ return strerror(errno);
+ }
+ // else
+ return 0;
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#endif //__hpux
+
+
+// ---------------------------------------------------------------
+// 2. Implementation for Mac OS X 10.2.x and earlier
+#ifdef __APPLE__
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+#include <mach-o/dyld.h>
+#define DYNAMICLOADER_DEFINED 1
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+LibHandle DynamicLoader::OpenLibrary(const char* libname )
+{
+ NSObjectFileImageReturnCode rc;
+ NSObjectFileImage image = 0;
+
+ rc = NSCreateObjectFileImageFromFile(libname, &image);
+ // rc == NSObjectFileImageInappropriateFile when trying to load a dylib file
+ if( rc != NSObjectFileImageSuccess )
+ {
+ return 0;
+ }
+ return NSLinkModule(image, libname,
+ NSLINKMODULE_OPTION_PRIVATE|NSLINKMODULE_OPTION_BINDNOW);
+}
+
+//----------------------------------------------------------------------------
+int DynamicLoader::CloseLibrary( LibHandle lib)
+{
+ bool success = NSUnLinkModule(lib, NSUNLINKMODULE_OPTION_NONE);
+ return success;
+}
+
+//----------------------------------------------------------------------------
+DynamicLoaderFunction DynamicLoader::GetSymbolAddress(LibHandle lib, const char* sym)
+{
+ void *result=0;
+ // Need to prepend symbols with '_' on Apple-gcc compilers
+ size_t len = strlen(sym);
+ char *rsym = new char[len + 1 + 1];
+ strcpy(rsym, "_");
+ strcat(rsym+1, sym);
+
+ NSSymbol symbol = NSLookupSymbolInModule(lib, rsym);
+ if(symbol)
+ {
+ result = NSAddressOfSymbol(symbol);
+ }
+
+ delete[] rsym;
+ // Hack to cast pointer-to-data to pointer-to-function.
+ return *reinterpret_cast<DynamicLoaderFunction*>(&result);
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibPrefix()
+{
+ return "lib";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibExtension()
+{
+ // NSCreateObjectFileImageFromFile fail when dealing with dylib image
+ // it returns NSObjectFileImageInappropriateFile
+ //return ".dylib";
+ return ".so";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LastError()
+{
+ return 0;
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#endif //MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+#endif // __APPLE__
+
+// ---------------------------------------------------------------
+// 3. Implementation for Windows win32 code
+#ifdef _WIN32
+#include <windows.h>
+#define DYNAMICLOADER_DEFINED 1
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+LibHandle DynamicLoader::OpenLibrary(const char* libname)
+{
+ LibHandle lh;
+#ifdef UNICODE
+ wchar_t libn[MB_CUR_MAX];
+ mbstowcs(libn, libname, MB_CUR_MAX);
+ lh = LoadLibrary(libn);
+#else
+ lh = LoadLibrary(libname);
+#endif
+ return lh;
+}
+
+//----------------------------------------------------------------------------
+int DynamicLoader::CloseLibrary(LibHandle lib)
+{
+ return (int)FreeLibrary(lib);
+}
+
+//----------------------------------------------------------------------------
+DynamicLoaderFunction DynamicLoader::GetSymbolAddress(LibHandle lib, const char* sym)
+{
+ void *result;
+#ifdef __BORLANDC__
+ // Need to prepend symbols with '_' on borland compilers
+ size_t len = strlen(sym);
+ char *rsym = new char[len + 1 + 1];
+ strcpy(rsym, "_");
+ strcat(rsym+1, sym);
+#else
+ const char *rsym = sym;
+#endif
+#ifdef UNICODE
+ wchar_t wsym[MB_CUR_MAX];
+ mbstowcs(wsym, rsym, MB_CUR_MAX);
+ result = GetProcAddress(lib, wsym);
+#else
+ result = (void*)GetProcAddress(lib, rsym);
+#endif
+#ifdef __BORLANDC__
+ delete[] rsym;
+#endif
+ // Hack to cast pointer-to-data to pointer-to-function.
+ return *reinterpret_cast<DynamicLoaderFunction*>(&result);
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibPrefix()
+{
+#ifdef __MINGW32__
+ return "lib";
+#else
+ return "";
+#endif
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibExtension()
+{
+ return ".dll";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LastError()
+{
+ LPVOID lpMsgBuf;
+
+ FormatMessage(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL,
+ GetLastError(),
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
+ (LPTSTR) &lpMsgBuf,
+ 0,
+ NULL
+ );
+
+ static char* str = 0;
+ delete [] str;
+ str = strcpy(new char[strlen((char*)lpMsgBuf)+1], (char*)lpMsgBuf);
+ // Free the buffer.
+ LocalFree( lpMsgBuf );
+ return str;
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#endif //_WIN32
+
+// ---------------------------------------------------------------
+// 4. Implementation for default UNIX machines.
+// if nothing has been defined then use this
+#ifndef DYNAMICLOADER_DEFINED
+#define DYNAMICLOADER_DEFINED 1
+// Setup for most unix machines
+#include <dlfcn.h>
+
+namespace KWSYS_NAMESPACE
+{
+
+//----------------------------------------------------------------------------
+LibHandle DynamicLoader::OpenLibrary(const char* libname )
+{
+ return dlopen(libname, RTLD_LAZY);
+}
+
+//----------------------------------------------------------------------------
+int DynamicLoader::CloseLibrary(LibHandle lib)
+{
+ if (lib)
+ {
+ // The function dlclose() returns 0 on success, and non-zero on error.
+ return !dlclose(lib);
+ }
+ // else
+ return 0;
+}
+
+//----------------------------------------------------------------------------
+DynamicLoaderFunction DynamicLoader::GetSymbolAddress(LibHandle lib, const char* sym)
+{
+ void* result = dlsym(lib, sym);
+
+ // Hack to cast pointer-to-data to pointer-to-function.
+ return *reinterpret_cast<DynamicLoaderFunction*>(&result);
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibPrefix()
+{
+ return "lib";
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LibExtension()
+{
+#ifdef __CYGWIN__
+ return ".dll";
+#else
+ return ".so";
+#endif
+}
+
+//----------------------------------------------------------------------------
+const char* DynamicLoader::LastError()
+{
+ return dlerror();
+}
+
+} // namespace KWSYS_NAMESPACE
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/DynamicLoader.hxx.in b/Utilities/ITK/Utilities/kwsys/DynamicLoader.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..7bd290bda3d5e5814062a52be529f99c37660667
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/DynamicLoader.hxx.in
@@ -0,0 +1,107 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: DynamicLoader.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_DynamicLoader_hxx
+#define @KWSYS_NAMESPACE@_DynamicLoader_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+// Ugly stuff for library handles
+// They are different on several different OS's
+#if defined(__hpux)
+ #include <dl.h>
+namespace @KWSYS_NAMESPACE@
+{
+ typedef shl_t LibHandle;
+} // namespace @KWSYS_NAMESPACE@
+#elif defined(_WIN32)
+ #include <windows.h>
+namespace @KWSYS_NAMESPACE@
+{
+ typedef HMODULE LibHandle;
+} // namespace @KWSYS_NAMESPACE@
+#elif defined(__APPLE__)
+ #include <AvailabilityMacros.h>
+ #if MAC_OS_X_VERSION_MIN_REQUIRED < 1030
+ #include <mach-o/dyld.h>
+namespace @KWSYS_NAMESPACE@
+{
+ typedef NSModule LibHandle;
+} // namespace @KWSYS_NAMESPACE@
+ #else
+namespace @KWSYS_NAMESPACE@
+{
+ typedef void* LibHandle;
+} // namespace @KWSYS_NAMESPACE@
+ #endif
+#else
+namespace @KWSYS_NAMESPACE@
+{
+ typedef void* LibHandle;
+} // namespace @KWSYS_NAMESPACE@
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+// Return type from DynamicLoader::GetSymbolAddress.
+typedef void (*DynamicLoaderFunction)();
+
+/** \class DynamicLoader
+ * \brief Portable loading of dynamic libraries or dll's.
+ *
+ * DynamicLoader provides a portable interface to loading dynamic
+ * libraries or dll's into a process.
+ *
+ * Directory currently works with Windows, Apple, HP-UX and Unix (POSIX)
+ * operating systems
+ *
+ * \warning dlopen on *nix system works the following way:
+ * If filename contains a slash ("/"), then it is interpreted as a (relative or absolute)
+ * pathname. Otherwise, the dynamic linker searches for the library as follows :
+ * see ld.so(8) for further details):
+ * Whereas this distinction does not exist on Win32. Therefore ideally you should be doing
+ * full path to garantee to have a consistent way of dealing with dynamic loading of shared
+ * library.
+ */
+
+class @KWSYS_NAMESPACE@_EXPORT DynamicLoader
+{
+public:
+ DynamicLoader();
+ ~DynamicLoader();
+
+ /** Load a dynamic library into the current process.
+ * The returned LibHandle can be used to access the symbols in the
+ * library. */
+ static LibHandle OpenLibrary(const char*);
+
+ /** Attempt to detach a dynamic library from the
+ * process. A value of true is returned if it is sucessful. */
+ static int CloseLibrary(LibHandle);
+
+ /** Find the address of the symbol in the given library. */
+ static DynamicLoaderFunction GetSymbolAddress(LibHandle, const char*);
+
+ /** Return the library prefix for the given architecture */
+ static const char* LibPrefix();
+
+ /** Return the library extension for the given architecture. */
+ static const char* LibExtension();
+
+ /** Return the last error produced from a calls made on this class. */
+ static const char* LastError();
+}; // End Class: DynamicLoader
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/EncodeExecutable.c b/Utilities/ITK/Utilities/kwsys/EncodeExecutable.c
new file mode 100644
index 0000000000000000000000000000000000000000..def14d2d6997db51592ffa61f1df344656915de7
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/EncodeExecutable.c
@@ -0,0 +1,103 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: EncodeExecutable.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include <stdio.h>
+#ifdef __WATCOMC__
+#define _unlink unlink
+#endif
+int main(int argc, char* argv[])
+{
+ FILE* ifp;
+ FILE* ofp;
+ int i;
+ int n;
+ int count = 0;
+ unsigned char buffer[1024];
+
+ /* Check arguments. */
+ if(argc != 5)
+ {
+ fprintf(stderr, "Usage: %s <input> <output> <kwsys-name> <array>\n",
+ argv[0]);
+ return 1;
+ }
+
+ /* Open the input file. */
+ ifp = fopen(argv[1], "rb");
+ if(!ifp)
+ {
+ fprintf(stderr, "Cannot open input file: \"%s\"\n", argv[1]);
+ return 2;
+ }
+ ofp = fopen(argv[2], "w");
+ if(!ofp)
+ {
+ fprintf(stderr, "Cannot open output file: \"%s\"\n", argv[2]);
+ return 2;
+ }
+
+ /* Prepend header comment. */
+ fprintf(ofp, "/*\n * DO NOT EDIT\n * This file is generated by:\n");
+ fprintf(ofp, " * %s\n */\n\n", argv[0]);
+ fprintf(ofp, "#include \"kwsysPrivate.h\"\n");
+ fprintf(ofp, "#include KWSYS_HEADER(Configure.h)\n\n");
+ fprintf(ofp, "#include <stdio.h>\n\n");
+
+ /* Split file up in 1024-byte chunks. */
+ while((n = (int)fread(buffer, 1, 1024, ifp)) > 0)
+ {
+ fprintf(ofp, "static unsigned char kwsysEncodedArray%s_%d[%d] = {\n",
+ argv[4], count++, n);
+ for(i=0; i < n-1; ++i)
+ {
+ fprintf(ofp, "0x%02X", buffer[i]);
+ if(i%10 == 9)
+ {
+ fprintf(ofp, ",\n");
+ }
+ else
+ {
+ fprintf(ofp, ", ");
+ }
+ }
+ fprintf(ofp, "0x%02X};\n\n", buffer[n-1]);
+ }
+ fclose(ifp);
+
+ /* Provide a function to write the data to a file. */
+ fprintf(ofp, "extern %s_EXPORT int %sEncodedWriteArray%s(const char* fname)\n",
+ argv[3], argv[3], argv[4]);
+ fprintf(ofp, "{\n");
+ fprintf(ofp, "#ifdef __WATCOMC__\n");
+ fprintf(ofp, "#define _unlink unlink\n");
+ fprintf(ofp, "#endif\n");
+ fprintf(ofp, " FILE* ofp = fopen(fname, \"wb\");\n");
+ fprintf(ofp, " if(!ofp) { return 0; }\n");
+ for(i=0; i < count; ++i)
+ {
+ fprintf(ofp, " if(fwrite(kwsysEncodedArray%s_%d, 1,\n"
+ " sizeof(kwsysEncodedArray%s_%d), ofp) !=\n"
+ " sizeof(kwsysEncodedArray%s_%d))\n",
+ argv[4], i, argv[4], i, argv[4], i);
+ fprintf(ofp, " {\n");
+ fprintf(ofp, " fclose(ofp);\n");
+ fprintf(ofp, " _unlink(fname);\n");
+ fprintf(ofp, " return 0;\n");
+ fprintf(ofp, " }\n");
+ }
+ fprintf(ofp, " fclose(ofp);\n");
+ fprintf(ofp, " return 1;\n");
+ fprintf(ofp, "}\n");
+ fclose(ofp);
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/ExtraTest.cmake.in b/Utilities/ITK/Utilities/kwsys/ExtraTest.cmake.in
new file mode 100644
index 0000000000000000000000000000000000000000..e8c0a1cdb192a6ce1dfa1540b8e42364932b32c3
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/ExtraTest.cmake.in
@@ -0,0 +1 @@
+MESSAGE("*** This message is generated by message inside a file that is included in DartTestfile.txt ***")
diff --git a/Utilities/ITK/Utilities/kwsys/FundamentalType.h.in b/Utilities/ITK/Utilities/kwsys/FundamentalType.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..648270f88ab878b7fe8724be64903583ee554f77
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/FundamentalType.h.in
@@ -0,0 +1,143 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: FundamentalType.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_FundamentalType_h
+#define @KWSYS_NAMESPACE@_FundamentalType_h
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+/* Redefine all public interface symbol names to be in the proper
+ namespace. These macros are used internally to kwsys only, and are
+ not visible to user code. Use kwsysHeaderDump.pl to reproduce
+ these macros after making changes to the interface. */
+#if !defined(KWSYS_NAMESPACE)
+# define kwsys_ns(x) @KWSYS_NAMESPACE@##x
+# define kwsysEXPORT @KWSYS_NAMESPACE@_EXPORT
+#endif
+#define kwsysFundamentalType kwsys_ns(FundamentalType)
+#define kwsysFundamentalType_Int8 kwsys_ns(FundamentalType_Int8)
+#define kwsysFundamentalType_UInt8 kwsys_ns(FundamentalType_UInt8)
+#define kwsysFundamentalType_Int16 kwsys_ns(FundamentalType_Int16)
+#define kwsysFundamentalType_UInt16 kwsys_ns(FundamentalType_UInt16)
+#define kwsysFundamentalType_Int32 kwsys_ns(FundamentalType_Int32)
+#define kwsysFundamentalType_UInt32 kwsys_ns(FundamentalType_UInt32)
+#define kwsysFundamentalType_Int64 kwsys_ns(FundamentalType_Int64)
+#define kwsysFundamentalType_UInt64 kwsys_ns(FundamentalType_UInt64)
+
+/* The size of fundamental types. Types that do not exist have size 0. */
+#define @KWSYS_NAMESPACE@_SIZEOF_CHAR @KWSYS_SIZEOF_CHAR@
+#define @KWSYS_NAMESPACE@_SIZEOF_SHORT @KWSYS_SIZEOF_SHORT@
+#define @KWSYS_NAMESPACE@_SIZEOF_INT @KWSYS_SIZEOF_INT@
+#define @KWSYS_NAMESPACE@_SIZEOF_LONG @KWSYS_SIZEOF_LONG@
+#define @KWSYS_NAMESPACE@_SIZEOF_LONG_LONG @KWSYS_SIZEOF_LONG_LONG@
+#define @KWSYS_NAMESPACE@_SIZEOF___INT64 @KWSYS_SIZEOF___INT64@
+
+/* Whether types "long long" and "__int64" are enabled. If a type is
+ enabled then it is a unique fundamental type. */
+#define @KWSYS_NAMESPACE@_USE_LONG_LONG @KWSYS_USE_LONG_LONG@
+#define @KWSYS_NAMESPACE@_USE___INT64 @KWSYS_USE___INT64@
+
+/* Whether type "char" is signed (it may be signed or unsigned). */
+#define @KWSYS_NAMESPACE@_CHAR_IS_SIGNED @KWSYS_CHAR_IS_SIGNED@
+
+#if defined(__cplusplus)
+extern "C"
+{
+#endif
+
+/* Select an 8-bit integer type. */
+#if @KWSYS_NAMESPACE@_SIZEOF_CHAR == 1
+typedef signed char kwsysFundamentalType_Int8;
+typedef unsigned char kwsysFundamentalType_UInt8;
+#else
+# error "No native data type can represent an 8-bit integer."
+#endif
+
+/* Select a 16-bit integer type. */
+#if @KWSYS_NAMESPACE@_SIZEOF_SHORT == 2
+typedef short kwsysFundamentalType_Int16;
+typedef unsigned short kwsysFundamentalType_UInt16;
+#elif @KWSYS_NAMESPACE@_SIZEOF_INT == 2
+typedef int kwsysFundamentalType_Int16;
+typedef unsigned int kwsysFundamentalType_UInt16;
+#else
+# error "No native data type can represent a 16-bit integer."
+#endif
+
+/* Select a 32-bit integer type. */
+#if @KWSYS_NAMESPACE@_SIZEOF_INT == 4
+typedef int kwsysFundamentalType_Int32;
+typedef unsigned int kwsysFundamentalType_UInt32;
+#elif @KWSYS_NAMESPACE@_SIZEOF_LONG == 4
+typedef long kwsysFundamentalType_Int32;
+typedef unsigned long kwsysFundamentalType_UInt32;
+#else
+# error "No native data type can represent a 32-bit integer."
+#endif
+
+/* Select a 64-bit integer type. */
+#if @KWSYS_NAMESPACE@_SIZEOF_LONG == 8
+typedef signed long kwsysFundamentalType_Int64;
+typedef unsigned long kwsysFundamentalType_UInt64;
+/* Whether UInt64 can be converted to double. */
+# define @KWSYS_NAMESPACE@_CAN_CONVERT_UI64_TO_DOUBLE 1
+#elif @KWSYS_NAMESPACE@_USE_LONG_LONG && @KWSYS_NAMESPACE@_SIZEOF_LONG_LONG == 8
+typedef signed long long kwsysFundamentalType_Int64;
+typedef unsigned long long kwsysFundamentalType_UInt64;
+/* Whether UInt64 can be converted to double. */
+# define @KWSYS_NAMESPACE@_CAN_CONVERT_UI64_TO_DOUBLE 1
+#elif @KWSYS_NAMESPACE@_USE___INT64 && @KWSYS_NAMESPACE@_SIZEOF___INT64 == 8
+typedef signed __int64 kwsysFundamentalType_Int64;
+typedef unsigned __int64 kwsysFundamentalType_UInt64;
+/* Whether UInt64 can be converted to double. */
+# define @KWSYS_NAMESPACE@_CAN_CONVERT_UI64_TO_DOUBLE @KWSYS_CAN_CONVERT_UI64_TO_DOUBLE@
+#else
+# error "No native data type can represent a 64-bit integer."
+#endif
+
+#if defined(__cplusplus)
+} /* extern "C" */
+#endif
+
+/* If we are building a kwsys .c or .cxx file, let it use these macros.
+ Otherwise, undefine them to keep the namespace clean. */
+#if !defined(KWSYS_NAMESPACE)
+# undef kwsys_ns
+# undef kwsysEXPORT
+# undef kwsysFundamentalType
+# undef kwsysFundamentalType_Int8
+# undef kwsysFundamentalType_UInt8
+# undef kwsysFundamentalType_Int16
+# undef kwsysFundamentalType_UInt16
+# undef kwsysFundamentalType_Int32
+# undef kwsysFundamentalType_UInt32
+# undef kwsysFundamentalType_Int64
+# undef kwsysFundamentalType_UInt64
+#endif
+
+/* If building a C or C++ file in kwsys itself, give the source file
+ access to the configured macros without a configured namespace. */
+#if defined(KWSYS_NAMESPACE)
+# define KWSYS_SIZEOF_CHAR @KWSYS_NAMESPACE@_SIZEOF_CHAR
+# define KWSYS_SIZEOF_SHORT @KWSYS_NAMESPACE@_SIZEOF_SHORT
+# define KWSYS_SIZEOF_INT @KWSYS_NAMESPACE@_SIZEOF_INT
+# define KWSYS_SIZEOF_LONG @KWSYS_NAMESPACE@_SIZEOF_LONG
+# define KWSYS_SIZEOF_LONG_LONG @KWSYS_NAMESPACE@_SIZEOF_LONG_LONG
+# define KWSYS_SIZEOF___INT64 @KWSYS_NAMESPACE@_SIZEOF___INT64
+# define KWSYS_USE_LONG_LONG @KWSYS_NAMESPACE@_USE_LONG_LONG
+# define KWSYS_USE___INT64 @KWSYS_NAMESPACE@_USE___INT64
+# define KWSYS_CHAR_IS_SIGNED @KWSYS_NAMESPACE@_CHAR_IS_SIGNED
+# define KWSYS_CAN_CONVERT_UI64_TO_DOUBLE @KWSYS_NAMESPACE@_CAN_CONVERT_UI64_TO_DOUBLE
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/Glob.cxx b/Utilities/ITK/Utilities/kwsys/Glob.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4700a2c0d03cd9b9d7b38ae551ac81aa8374d1ac
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Glob.cxx
@@ -0,0 +1,429 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Glob.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Glob.hxx)
+
+#include KWSYS_HEADER(Configure.hxx)
+
+#include KWSYS_HEADER(RegularExpression.hxx)
+#include KWSYS_HEADER(SystemTools.hxx)
+#include KWSYS_HEADER(Directory.hxx)
+#include KWSYS_HEADER(stl/string)
+#include KWSYS_HEADER(stl/vector)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "Glob.hxx.in"
+# include "Directory.hxx.in"
+# include "Configure.hxx.in"
+# include "RegularExpression.hxx.in"
+# include "SystemTools.hxx.in"
+# include "kwsys_stl.hxx.in"
+# include "kwsys_stl_string.hxx.in"
+#endif
+
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+namespace KWSYS_NAMESPACE
+{
+#if defined( _WIN32 ) || defined( APPLE ) || defined( __CYGWIN__ )
+ // On Windows and apple, no difference between lower and upper case
+ #define KWSYS_GLOB_CASE_INDEPENDENT
+#endif
+
+#if defined( _WIN32 ) || defined( __CYGWIN__ )
+ // Handle network paths
+ #define KWSYS_GLOB_SUPPORT_NETWORK_PATHS
+#endif
+
+//----------------------------------------------------------------------------
+class GlobInternals
+{
+public:
+ kwsys_stl::vector<kwsys_stl::string> Files;
+ kwsys_stl::vector<kwsys::RegularExpression> Expressions;
+ kwsys_stl::vector<kwsys_stl::string> TextExpressions;
+};
+
+//----------------------------------------------------------------------------
+Glob::Glob()
+{
+ m_Internals = new GlobInternals;
+ m_Recurse = false;
+}
+
+//----------------------------------------------------------------------------
+Glob::~Glob()
+{
+ delete m_Internals;
+}
+
+//----------------------------------------------------------------------------
+void Glob::Escape(int ch, char* buffer)
+{
+ if (! (
+ 'a' <= ch && ch <= 'z' ||
+ 'A' <= ch && ch <= 'Z' ||
+ '0' <= ch && ch <= '9') )
+ {
+ sprintf(buffer, "\\%c", ch);
+ }
+ else
+ {
+#if defined( KWSYS_GLOB_CASE_INDEPENDENT )
+ // On Windows and apple, no difference between lower and upper case
+ sprintf(buffer, "%c", tolower(ch));
+#else
+ sprintf(buffer, "%c", ch);
+#endif
+ }
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::vector<kwsys_stl::string>& Glob::GetFiles()
+{
+ return m_Internals->Files;
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string Glob::ConvertExpression(const kwsys_stl::string& expr)
+{
+
+ kwsys_stl::string::size_type i = 0;
+ kwsys_stl::string::size_type n = expr.size();
+
+ kwsys_stl::string res = "^";
+ kwsys_stl::string stuff = "";
+
+ while ( i < n )
+ {
+ int c = expr[i];
+ i = i+1;
+ if ( c == '*' )
+ {
+ res = res + ".*";
+ }
+ else if ( c == '?' )
+ {
+ res = res + ".";
+ }
+ else if ( c == '[' )
+ {
+ kwsys_stl::string::size_type j = i;
+ if ( j < n && ( expr[j] == '!' || expr[j] == '^' ) )
+ {
+ j = j+1;
+ }
+ if ( j < n && expr[j] == ']' )
+ {
+ j = j+1;
+ }
+ while ( j < n && expr[j] != ']' )
+ {
+ j = j+1;
+ }
+ if ( j >= n )
+ {
+ res = res + "\\[";
+ }
+ else
+ {
+ stuff = "";
+ kwsys_stl::string::size_type cc;
+ for ( cc = i; cc < j; cc ++ )
+ {
+ if ( expr[cc] == '\\' )
+ {
+ stuff += "\\\\";
+ }
+ else
+ {
+ stuff += expr[cc];
+ }
+ }
+ i = j+1;
+ if ( stuff[0] == '!' || stuff[0] == '^' )
+ {
+ stuff = '^' + stuff.substr(1);
+ }
+ else if ( stuff[0] == '^' )
+ {
+ stuff = '\\' + stuff;
+ }
+ res = res + "[" + stuff + "]";
+ }
+ }
+ else
+ {
+ char buffer[100];
+ buffer[0] = 0;
+ this->Escape(c, buffer);
+ res = res + buffer;
+ }
+ }
+ return res + "$";
+}
+
+//----------------------------------------------------------------------------
+void Glob::RecurseDirectory(kwsys_stl::string::size_type start,
+ const kwsys_stl::string& dir, bool dir_only)
+{
+ kwsys::Directory d;
+ if ( !d.Load(dir.c_str()) )
+ {
+ return;
+ }
+ unsigned long cc;
+ kwsys_stl::string fullname;
+ kwsys_stl::string realname;
+ kwsys_stl::string fname;
+ for ( cc = 0; cc < d.GetNumberOfFiles(); cc ++ )
+ {
+ fname = d.GetFile(cc);
+ if ( strcmp(fname.c_str(), ".") == 0 ||
+ strcmp(fname.c_str(), "..") == 0 )
+ {
+ continue;
+ }
+
+ if ( start == 0 )
+ {
+ realname = dir + fname;
+ }
+ else
+ {
+ realname = dir + "/" + fname;
+ }
+
+#if defined( KWSYS_GLOB_CASE_INDEPENDENT )
+ // On Windows and apple, no difference between lower and upper case
+ fname = kwsys::SystemTools::LowerCase(fname);
+#endif
+
+ if ( start == 0 )
+ {
+ fullname = dir + fname;
+ }
+ else
+ {
+ fullname = dir + "/" + fname;
+ }
+
+ if ( !dir_only || !kwsys::SystemTools::FileIsDirectory(realname.c_str()) )
+ {
+ if ( m_Internals->Expressions[m_Internals->Expressions.size()-1].find(fname.c_str()) )
+ {
+ m_Internals->Files.push_back(realname);
+ }
+ }
+ if ( kwsys::SystemTools::FileIsDirectory(realname.c_str()) )
+ {
+ this->RecurseDirectory(start+1, realname, dir_only);
+ }
+ }
+}
+
+//----------------------------------------------------------------------------
+void Glob::ProcessDirectory(kwsys_stl::string::size_type start,
+ const kwsys_stl::string& dir, bool dir_only)
+{
+ //kwsys_ios::cout << "ProcessDirectory: " << dir << kwsys_ios::endl;
+ bool last = ( start == m_Internals->Expressions.size()-1 );
+ if ( last && m_Recurse )
+ {
+ this->RecurseDirectory(start, dir, dir_only);
+ return;
+ }
+ kwsys::Directory d;
+ if ( !d.Load(dir.c_str()) )
+ {
+ return;
+ }
+ unsigned long cc;
+ kwsys_stl::string fullname;
+ kwsys_stl::string realname;
+ kwsys_stl::string fname;
+ for ( cc = 0; cc < d.GetNumberOfFiles(); cc ++ )
+ {
+ fname = d.GetFile(cc);
+ if ( strcmp(fname.c_str(), ".") == 0 ||
+ strcmp(fname.c_str(), "..") == 0 )
+ {
+ continue;
+ }
+
+ if ( start == 0 )
+ {
+ realname = dir + fname;
+ }
+ else
+ {
+ realname = dir + "/" + fname;
+ }
+
+#if defined( KWSYS_GLOB_CASE_INDEPENDENT )
+ // On Windows and apple, no difference between lower and upper case
+ fname = kwsys::SystemTools::LowerCase(fname);
+#endif
+
+ if ( start == 0 )
+ {
+ fullname = dir + fname;
+ }
+ else
+ {
+ fullname = dir + "/" + fname;
+ }
+
+ //kwsys_ios::cout << "Look at file: " << fname << kwsys_ios::endl;
+ //kwsys_ios::cout << "Match: " << m_Internals->TextExpressions[start].c_str() << kwsys_ios::endl;
+ //kwsys_ios::cout << "Full name: " << fullname << kwsys_ios::endl;
+
+ if ( (!dir_only || !last) && !kwsys::SystemTools::FileIsDirectory(realname.c_str()) )
+ {
+ continue;
+ }
+
+ if ( m_Internals->Expressions[start].find(fname.c_str()) )
+ {
+ if ( last )
+ {
+ m_Internals->Files.push_back(realname);
+ }
+ else
+ {
+ this->ProcessDirectory(start+1, realname + "/", dir_only);
+ }
+ }
+ }
+}
+
+//----------------------------------------------------------------------------
+bool Glob::FindFiles(const kwsys_stl::string& inexpr)
+{
+ kwsys_stl::string cexpr;
+ kwsys_stl::string::size_type cc;
+ kwsys_stl::string expr = inexpr;
+
+ m_Internals->Expressions.clear();
+ m_Internals->Files.clear();
+
+ if ( !kwsys::SystemTools::FileIsFullPath(expr.c_str()) )
+ {
+ expr = kwsys::SystemTools::GetCurrentWorkingDirectory();
+ expr += "/" + inexpr;
+ }
+ kwsys_stl::string fexpr = expr;
+
+ int skip = 0;
+ int last_slash = 0;
+ for ( cc = 0; cc < expr.size(); cc ++ )
+ {
+ if ( cc > 0 && expr[cc] == '/' && expr[cc-1] != '\\' )
+ {
+ last_slash = cc;
+ }
+ if ( cc > 0 &&
+ (expr[cc] == '[' || expr[cc] == '?' || expr[cc] == '*') &&
+ expr[cc-1] != '\\' )
+ {
+ break;
+ }
+ }
+ if ( last_slash > 0 )
+ {
+ //kwsys_ios::cout << "I can skip: " << fexpr.substr(0, last_slash) << kwsys_ios::endl;
+ skip = last_slash;
+ }
+ if ( skip == 0 )
+ {
+#if defined( KWSYS_GLOB_SUPPORT_NETWORK_PATHS )
+ // Handle network paths
+ if ( expr[0] == '/' && expr[1] == '/' )
+ {
+ int cnt = 0;
+ for ( cc = 2; cc < expr.size(); cc ++ )
+ {
+ if ( expr[cc] == '/' )
+ {
+ cnt ++;
+ if ( cnt == 2 )
+ {
+ break;
+ }
+ }
+ }
+ skip = cc + 1;
+ }
+ else
+#endif
+ // Handle drive letters on Windows
+ if ( expr[1] == ':' && expr[0] != '/' )
+ {
+ skip = 2;
+ }
+ }
+
+ if ( skip > 0 )
+ {
+ expr = expr.substr(skip);
+ }
+
+ cexpr = "";
+ for ( cc = 0; cc < expr.size(); cc ++ )
+ {
+ int ch = expr[cc];
+ if ( ch == '/' )
+ {
+ if ( cexpr.size() > 0 )
+ {
+ this->AddExpression(cexpr.c_str());
+ }
+ cexpr = "";
+ }
+ else
+ {
+ cexpr.append(1, static_cast<char>(ch));
+ }
+ }
+ if ( cexpr.size() > 0 )
+ {
+ this->AddExpression(cexpr.c_str());
+ }
+
+ // Handle network paths
+ if ( skip > 0 )
+ {
+ this->ProcessDirectory(0, fexpr.substr(0, skip) + "/",
+ true);
+ }
+ else
+ {
+ this->ProcessDirectory(0, "/", true);
+ }
+ return true;
+}
+
+void Glob::AddExpression(const char* expr)
+{
+ m_Internals->Expressions.push_back(
+ kwsys::RegularExpression(
+ this->ConvertExpression(expr).c_str()));
+ m_Internals->TextExpressions.push_back(this->ConvertExpression(expr));
+}
+
+} // namespace KWSYS_NAMESPACE
+
diff --git a/Utilities/ITK/Utilities/kwsys/Glob.hxx.in b/Utilities/ITK/Utilities/kwsys/Glob.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..39bc5ceb6afb589c3893438f1ced3ba69577d2e9
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Glob.hxx.in
@@ -0,0 +1,87 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Glob.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Glob_hxx
+#define @KWSYS_NAMESPACE@_Glob_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#include <@KWSYS_NAMESPACE@/stl/string>
+#include <@KWSYS_NAMESPACE@/stl/vector>
+
+/* Define this macro temporarily to keep the code readable. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+class GlobInternals;
+
+/** \class Glob
+ * \brief Portable globbing searches.
+ *
+ * Globbing expressions are much simpler than regular
+ * expressions. This class will search for files using
+ * globbing expressions.
+ *
+ * Finds all files that match a given globbing expression.
+ */
+class @KWSYS_NAMESPACE@_EXPORT Glob
+{
+public:
+ Glob();
+ ~Glob();
+
+ //! Find all files that match the pattern.
+ bool FindFiles(const kwsys_stl::string& inexpr);
+
+ //! Return the list of files that matched.
+ kwsys_stl::vector<kwsys_stl::string>& GetFiles();
+
+ //! Set recurse to true to match subdirectories.
+ void RecurseOn() { this->SetRecurse(true); }
+ void RecurseOff() { this->SetRecurse(false); }
+ void SetRecurse(bool i) { m_Recurse = i; }
+ bool GetRecurse() { return m_Recurse; }
+
+protected:
+ //! Process directory
+ void ProcessDirectory(kwsys_stl::string::size_type start,
+ const kwsys_stl::string& dir, bool dir_only);
+
+ //! Process last directory, but only when recurse flags is on. That is
+ // effectively like saying: /path/to/file/**/file
+ void RecurseDirectory(kwsys_stl::string::size_type start,
+ const kwsys_stl::string& dir, bool dir_only);
+
+ //! Escape all non-alphanumeric characters in pattern.
+ void Escape(int ch, char* buffer);
+
+ //!
+ // Translate a shell PATTERN to a regular expression.
+ // There is no way to quote meta-characters.
+ kwsys_stl::string ConvertExpression(const kwsys_stl::string& expr);
+
+ //! Add regular expression
+ void AddExpression(const char* expr);
+
+ GlobInternals* m_Internals;
+ bool m_Recurse;
+};
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/Process.h.in b/Utilities/ITK/Utilities/kwsys/Process.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..b5ccefa3f78c7110ab2c8d138bf5aad8eafd034c
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Process.h.in
@@ -0,0 +1,384 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Process.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Process_h
+#define @KWSYS_NAMESPACE@_Process_h
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+/* Redefine all public interface symbol names to be in the proper
+ namespace. These macros are used internally to kwsys only, and are
+ not visible to user code. Use kwsysHeaderDump.pl to reproduce
+ these macros after making changes to the interface. */
+#if !defined(KWSYS_NAMESPACE)
+# define kwsys_ns(x) @KWSYS_NAMESPACE@##x
+# define kwsysEXPORT @KWSYS_NAMESPACE@_EXPORT
+#endif
+#define kwsysProcess kwsys_ns(Process)
+#define kwsysProcess_s kwsys_ns(Process_s)
+#define kwsysProcess_New kwsys_ns(Process_New)
+#define kwsysProcess_Delete kwsys_ns(Process_Delete)
+#define kwsysProcess_SetCommand kwsys_ns(Process_SetCommand)
+#define kwsysProcess_AddCommand kwsys_ns(Process_AddCommand)
+#define kwsysProcess_SetTimeout kwsys_ns(Process_SetTimeout)
+#define kwsysProcess_SetWorkingDirectory kwsys_ns(Process_SetWorkingDirectory)
+#define kwsysProcess_SetPipeFile kwsys_ns(Process_SetPipeFile)
+#define kwsysProcess_SetPipeShared kwsys_ns(Process_SetPipeShared)
+#define kwsysProcess_Option_Detach kwsys_ns(Process_Option_Detach)
+#define kwsysProcess_Option_HideWindow kwsys_ns(Process_Option_HideWindow)
+#define kwsysProcess_GetOption kwsys_ns(Process_GetOption)
+#define kwsysProcess_SetOption kwsys_ns(Process_SetOption)
+#define kwsysProcess_Option_e kwsys_ns(Process_Option_e)
+#define kwsysProcess_State_Starting kwsys_ns(Process_State_Starting)
+#define kwsysProcess_State_Error kwsys_ns(Process_State_Error)
+#define kwsysProcess_State_Exception kwsys_ns(Process_State_Exception)
+#define kwsysProcess_State_Executing kwsys_ns(Process_State_Executing)
+#define kwsysProcess_State_Exited kwsys_ns(Process_State_Exited)
+#define kwsysProcess_State_Expired kwsys_ns(Process_State_Expired)
+#define kwsysProcess_State_Killed kwsys_ns(Process_State_Killed)
+#define kwsysProcess_State_Disowned kwsys_ns(Process_State_Disowned)
+#define kwsysProcess_GetState kwsys_ns(Process_GetState)
+#define kwsysProcess_State_e kwsys_ns(Process_State_e)
+#define kwsysProcess_Exception_None kwsys_ns(Process_Exception_None)
+#define kwsysProcess_Exception_Fault kwsys_ns(Process_Exception_Fault)
+#define kwsysProcess_Exception_Illegal kwsys_ns(Process_Exception_Illegal)
+#define kwsysProcess_Exception_Interrupt kwsys_ns(Process_Exception_Interrupt)
+#define kwsysProcess_Exception_Numerical kwsys_ns(Process_Exception_Numerical)
+#define kwsysProcess_Exception_Other kwsys_ns(Process_Exception_Other)
+#define kwsysProcess_GetExitException kwsys_ns(Process_GetExitException)
+#define kwsysProcess_Exception_e kwsys_ns(Process_Exception_e)
+#define kwsysProcess_GetExitCode kwsys_ns(Process_GetExitCode)
+#define kwsysProcess_GetExitValue kwsys_ns(Process_GetExitValue)
+#define kwsysProcess_GetErrorString kwsys_ns(Process_GetErrorString)
+#define kwsysProcess_GetExceptionString kwsys_ns(Process_GetExceptionString)
+#define kwsysProcess_Execute kwsys_ns(Process_Execute)
+#define kwsysProcess_Disown kwsys_ns(Process_Disown)
+#define kwsysProcess_WaitForData kwsys_ns(Process_WaitForData)
+#define kwsysProcess_Pipes_e kwsys_ns(Process_Pipes_e)
+#define kwsysProcess_Pipe_None kwsys_ns(Process_Pipe_None)
+#define kwsysProcess_Pipe_STDIN kwsys_ns(Process_Pipe_STDIN)
+#define kwsysProcess_Pipe_STDOUT kwsys_ns(Process_Pipe_STDOUT)
+#define kwsysProcess_Pipe_STDERR kwsys_ns(Process_Pipe_STDERR)
+#define kwsysProcess_Pipe_Timeout kwsys_ns(Process_Pipe_Timeout)
+#define kwsysProcess_WaitForExit kwsys_ns(Process_WaitForExit)
+#define kwsysProcess_Kill kwsys_ns(Process_Kill)
+
+#if defined(__cplusplus)
+extern "C"
+{
+#endif
+
+/**
+ * Process control data structure.
+ */
+typedef struct kwsysProcess_s kwsysProcess;
+
+/**
+ * Create a new Process instance.
+ */
+kwsysEXPORT kwsysProcess* kwsysProcess_New(void);
+
+/**
+ * Delete an existing Process instance. If the instance is currently
+ * executing a process, this blocks until the process terminates.
+ */
+kwsysEXPORT void kwsysProcess_Delete(kwsysProcess* cp);
+
+/**
+ * Set the command line to be executed. Argument is an array of
+ * pointers to the command and each argument. Ths array must end with
+ * a NULL pointer. Any previous command lines are removed. Returns
+ * 1 for success and 0 otherwise.
+ */
+kwsysEXPORT int kwsysProcess_SetCommand(kwsysProcess* cp,
+ char const* const* command);
+
+/**
+ * Add a command line to be executed. Argument is an array of
+ * pointers to the command and each argument. Ths array must end with
+ * a NULL pointer. If this is not the first command added, its
+ * standard input will be connected to the standard output of the
+ * previous command. Returns 1 for success and 0 otherwise.
+ */
+kwsysEXPORT int kwsysProcess_AddCommand(kwsysProcess* cp,
+ char const* const* command);
+
+/**
+ * Set the timeout in seconds for the child process. The timeout
+ * period begins when the child is executed. If the child has not
+ * terminated when the timeout expires, it will be killed. A
+ * non-positive (<= 0) value will disable the timeout.
+ */
+kwsysEXPORT void kwsysProcess_SetTimeout(kwsysProcess* cp, double timeout);
+
+/**
+ * Set the working directory for the child process. The working
+ * directory can be absolute or relative to the current directory.
+ * Returns 1 for success and 0 for failure.
+ */
+kwsysEXPORT int kwsysProcess_SetWorkingDirectory(kwsysProcess* cp,
+ const char* dir);
+
+/**
+ * Set the name of a file to be attached to the given pipe. Returns 1
+ * for success and 0 for failure.
+ */
+kwsysEXPORT int kwsysProcess_SetPipeFile(kwsysProcess* cp, int pipe,
+ const char* file);
+
+/**
+ * Set whether the given pipe in the child is shared with the parent
+ * process. The default is no for Pipe_STDOUT and Pipe_STDERR and yes
+ * for Pipe_STDIN.
+ */
+kwsysEXPORT void kwsysProcess_SetPipeShared(kwsysProcess* cp, int pipe,
+ int shared);
+
+/**
+ * Get/Set a possibly platform-specific option. Possible options are:
+ *
+ * kwsysProcess_Option_Detach = Whether to detach the process.
+ * 0 = No (default)
+ * 1 = Yes
+ *
+ * kwsysProcess_Option_HideWindow = Whether to hide window on Windows.
+ * 0 = No (default)
+ * 1 = Yes
+ */
+kwsysEXPORT int kwsysProcess_GetOption(kwsysProcess* cp, int optionId);
+kwsysEXPORT void kwsysProcess_SetOption(kwsysProcess* cp, int optionId,
+ int value);
+enum kwsysProcess_Option_e
+{
+ kwsysProcess_Option_HideWindow,
+ kwsysProcess_Option_Detach
+};
+
+/**
+ * Get the current state of the Process instance. Possible states are:
+ *
+ * kwsysProcess_State_Starting = Execute has not yet been called.
+ * kwsysProcess_State_Error = Error administrating the child process.
+ * kwsysProcess_State_Exception = Child process exited abnormally.
+ * kwsysProcess_State_Executing = Child process is currently running.
+ * kwsysProcess_State_Exited = Child process exited normally.
+ * kwsysProcess_State_Expired = Child process's timeout expired.
+ * kwsysProcess_State_Killed = Child process terminated by Kill method.
+ * kwsysProcess_State_Disowned = Child is no longer managed by this object.
+ */
+kwsysEXPORT int kwsysProcess_GetState(kwsysProcess* cp);
+enum kwsysProcess_State_e
+{
+ kwsysProcess_State_Starting,
+ kwsysProcess_State_Error,
+ kwsysProcess_State_Exception,
+ kwsysProcess_State_Executing,
+ kwsysProcess_State_Exited,
+ kwsysProcess_State_Expired,
+ kwsysProcess_State_Killed,
+ kwsysProcess_State_Disowned
+};
+
+/**
+ * When GetState returns "Exception", this method returns a
+ * platform-independent description of the exceptional behavior that
+ * caused the child to terminate abnormally. Possible exceptions are:
+ *
+ * kwsysProcess_Exception_None = No exceptional behavior occurred.
+ * kwsysProcess_Exception_Fault = Child crashed with a memory fault.
+ * kwsysProcess_Exception_Illegal = Child crashed with an illegal instruction.
+ * kwsysProcess_Exception_Interrupt = Child was interrupted by user (Cntl-C/Break).
+ * kwsysProcess_Exception_Numerical = Child crashed with a numerical exception.
+ * kwsysProcess_Exception_Other = Child terminated for another reason.
+ */
+kwsysEXPORT int kwsysProcess_GetExitException(kwsysProcess* cp);
+enum kwsysProcess_Exception_e
+{
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_Fault,
+ kwsysProcess_Exception_Illegal,
+ kwsysProcess_Exception_Interrupt,
+ kwsysProcess_Exception_Numerical,
+ kwsysProcess_Exception_Other
+};
+
+/**
+ * When GetState returns "Exited" or "Exception", this method returns
+ * the platform-specific raw exit code of the process. UNIX platforms
+ * should use WIFEXITED/WEXITSTATUS and WIFSIGNALED/WTERMSIG to access
+ * this value. Windows users should compare the value to the various
+ * EXCEPTION_* values.
+ *
+ * If GetState returns "Exited", use GetExitValue to get the
+ * platform-independent child return value.
+ */
+kwsysEXPORT int kwsysProcess_GetExitCode(kwsysProcess* cp);
+
+/**
+ * When GetState returns "Exited", this method returns the child's
+ * platform-independent exit code (such as the value returned by the
+ * child's main).
+ */
+kwsysEXPORT int kwsysProcess_GetExitValue(kwsysProcess* cp);
+
+/**
+ * When GetState returns "Error", this method returns a string
+ * describing the problem. Otherwise, it returns NULL.
+ */
+kwsysEXPORT const char* kwsysProcess_GetErrorString(kwsysProcess* cp);
+
+/**
+ * When GetState returns "Exception", this method returns a string
+ * describing the problem. Otherwise, it returns NULL.
+ */
+kwsysEXPORT const char* kwsysProcess_GetExceptionString(kwsysProcess* cp);
+
+/**
+ * Start executing the child process.
+ */
+kwsysEXPORT void kwsysProcess_Execute(kwsysProcess* cp);
+
+/**
+ * Stop management of a detached child process. This closes any pipes
+ * being read. If the child was not created with the
+ * kwsysProcess_Option_Detach option, this method does nothing. This
+ * is because disowning a non-detached process will cause the child
+ * exit signal to be left unhandled until this process exits.
+ */
+kwsysEXPORT void kwsysProcess_Disown(kwsysProcess* cp);
+
+/**
+ * Block until data are available on a pipe, a timeout expires, or the
+ * child process terminates. Arguments are as follows:
+ *
+ * data = If data are read, the pointer to which this points is
+ * set to point to the data.
+ * length = If data are read, the integer to which this points is
+ * set to the length of the data read.
+ * timeout = Specifies the maximum time this call may block. Upon
+ * return after reading data, the time elapsed is subtracted
+ * from the timeout value. If this timeout expires, the
+ * value is set to 0. A NULL pointer passed for this argument
+ * indicates no timeout for the call. A negative or zero
+ * value passed for this argument may be used for polling
+ * and will always return immediately.
+ *
+ * Return value will be one of:
+ *
+ * Pipe_None = No more data will be available from the child process,
+ * ( == 0) or no process has been executed. WaitForExit should
+ * be called to wait for the process to terminate.
+ * Pipe_STDOUT = Data have been read from the child's stdout pipe.
+ * Pipe_STDERR = Data have been read from the child's stderr pipe.
+ * Pipe_Timeout = No data available within timeout specified for the
+ * call. Time elapsed has been subtracted from timeout
+ * argument.
+ */
+kwsysEXPORT int kwsysProcess_WaitForData(kwsysProcess* cp, char** data,
+ int* length, double* timeout);
+enum kwsysProcess_Pipes_e
+{
+ kwsysProcess_Pipe_None,
+ kwsysProcess_Pipe_STDIN,
+ kwsysProcess_Pipe_STDOUT,
+ kwsysProcess_Pipe_STDERR,
+ kwsysProcess_Pipe_Timeout=255
+};
+
+/**
+ * Block until the child process terminates or the given timeout
+ * expires. If no process is running, returns immediatly. The
+ * argument is:
+ *
+ * timeout = Specifies the maximum time this call may block. Upon
+ * returning due to child termination, the elapsed time
+ * is subtracted from the given value. A NULL pointer
+ * passed for this argument indicates no timeout for the
+ * call.
+ *
+ * Return value will be one of:
+ *
+ * 0 = Child did not terminate within timeout specified for
+ * the call. Time elapsed has been subtracted from timeout
+ * argument.
+ * 1 = Child has terminated or was not running.
+ */
+kwsysEXPORT int kwsysProcess_WaitForExit(kwsysProcess* cp, double* timeout);
+
+/**
+ * Forcefully terminate the child process that is currently running.
+ * The caller should call WaitForExit after this returns to wait for
+ * the child to terminate.
+ */
+kwsysEXPORT void kwsysProcess_Kill(kwsysProcess* cp);
+
+#if defined(__cplusplus)
+} /* extern "C" */
+#endif
+
+/* If we are building a kwsys .c or .cxx file, let it use these macros.
+ Otherwise, undefine them to keep the namespace clean. */
+#if !defined(KWSYS_NAMESPACE)
+# undef kwsys_ns
+# undef kwsysEXPORT
+# undef kwsysProcess
+# undef kwsysProcess_s
+# undef kwsysProcess_New
+# undef kwsysProcess_Delete
+# undef kwsysProcess_SetCommand
+# undef kwsysProcess_AddCommand
+# undef kwsysProcess_SetTimeout
+# undef kwsysProcess_SetWorkingDirectory
+# undef kwsysProcess_SetPipeFile
+# undef kwsysProcess_SetPipeShared
+# undef kwsysProcess_Option_Detach
+# undef kwsysProcess_Option_HideWindow
+# undef kwsysProcess_GetOption
+# undef kwsysProcess_SetOption
+# undef kwsysProcess_Option_e
+# undef kwsysProcess_State_Starting
+# undef kwsysProcess_State_Error
+# undef kwsysProcess_State_Exception
+# undef kwsysProcess_State_Executing
+# undef kwsysProcess_State_Exited
+# undef kwsysProcess_State_Expired
+# undef kwsysProcess_State_Killed
+# undef kwsysProcess_State_Disowned
+# undef kwsysProcess_GetState
+# undef kwsysProcess_State_e
+# undef kwsysProcess_Exception_None
+# undef kwsysProcess_Exception_Fault
+# undef kwsysProcess_Exception_Illegal
+# undef kwsysProcess_Exception_Interrupt
+# undef kwsysProcess_Exception_Numerical
+# undef kwsysProcess_Exception_Other
+# undef kwsysProcess_GetExitException
+# undef kwsysProcess_Exception_e
+# undef kwsysProcess_GetExitCode
+# undef kwsysProcess_GetExitValue
+# undef kwsysProcess_GetErrorString
+# undef kwsysProcess_GetExceptionString
+# undef kwsysProcess_Execute
+# undef kwsysProcess_Disown
+# undef kwsysProcess_WaitForData
+# undef kwsysProcess_Pipes_e
+# undef kwsysProcess_Pipe_None
+# undef kwsysProcess_Pipe_STDIN
+# undef kwsysProcess_Pipe_STDOUT
+# undef kwsysProcess_Pipe_STDERR
+# undef kwsysProcess_Pipe_Timeout
+# undef kwsysProcess_WaitForExit
+# undef kwsysProcess_Kill
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/ProcessFwd9x.c b/Utilities/ITK/Utilities/kwsys/ProcessFwd9x.c
new file mode 100644
index 0000000000000000000000000000000000000000..17494241b62f9b2f77c720adbbd89279cbb8e726
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/ProcessFwd9x.c
@@ -0,0 +1,213 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: ProcessFwd9x.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+
+/*
+ On Windows9x platforms, this executable is spawned between a parent
+ process and the child it is invoking to work around a bug. See the
+ Win32 implementation file for details.
+
+ Future Work: This executable must be linked statically against the C
+ runtime library before being encoded into the library. Building it
+ in this way may be hard because CMake has limited abilities to build
+ different targets with different configurations in the same
+ directory. We may just have to create and encode the executable
+ once instead of generating it during the build. This would be an
+ acceptable solution because the forwarding executable should not
+ change very often and is pretty simple.
+*/
+
+#ifdef _MSC_VER
+#pragma warning (push, 1)
+#endif
+#include <windows.h>
+#include <stdio.h>
+
+void ReportLastError(HANDLE errorPipe);
+
+int main()
+{
+ /* Process startup information for the real child. */
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+
+ /* The result of waiting for the child to exit. */
+ DWORD waitResult;
+
+ /* The child's process return code. */
+ DWORD retVal;
+
+ /* The command line used to invoke this process. */
+ LPSTR commandLine = GetCommandLine();
+
+ /* Pointer that will be advanced to the beginning of the command
+ line of the real child process. */
+ LPSTR cmdLine = commandLine;
+
+ /* Handle to the error reporting pipe provided by the parent. This
+ is parsed off the command line. */
+ HANDLE errorPipe = 0;
+ HANDLE errorPipeOrig = 0;
+
+ /* Handle to the event the parent uses to tell us to resume the child.
+ This is parsed off the command line. */
+ HANDLE resumeEvent = 0;
+
+ /* Handle to the event the parent uses to tell us to kill the child.
+ This is parsed off the command line. */
+ HANDLE killEvent = 0;
+
+ /* Flag for whether to hide window of child process. */
+ int hideWindow = 0;
+
+ /* An array of the handles on which we wait when the child is
+ running. */
+ HANDLE waitHandles[2] = {0, 0};
+
+ /* Move the pointer past the name of this executable. */
+ if(*cmdLine == '"')
+ {
+ ++cmdLine;
+ while(*cmdLine && *cmdLine != '"') { ++cmdLine; }
+ if(*cmdLine) { ++cmdLine; }
+ }
+ else
+ {
+ while(*cmdLine && *cmdLine != ' ') { ++cmdLine; }
+ }
+
+ /* Parse the error pipe handle. */
+ while(*cmdLine && *cmdLine == ' ') { ++cmdLine; }
+ sscanf(cmdLine, "%p", &errorPipeOrig);
+
+ /* Parse the resume event handle. */
+ while(*cmdLine && *cmdLine != ' ') { ++cmdLine; }
+ while(*cmdLine && *cmdLine == ' ') { ++cmdLine; }
+ sscanf(cmdLine, "%p", &resumeEvent);
+
+ /* Parse the kill event handle. */
+ while(*cmdLine && *cmdLine != ' ') { ++cmdLine; }
+ while(*cmdLine && *cmdLine == ' ') { ++cmdLine; }
+ sscanf(cmdLine, "%p", &killEvent);
+
+ /* Parse the hide window flag. */
+ while(*cmdLine && *cmdLine != ' ') { ++cmdLine; }
+ while(*cmdLine && *cmdLine == ' ') { ++cmdLine; }
+ sscanf(cmdLine, "%d", &hideWindow);
+
+ /* Skip to the beginning of the command line of the real child. */
+ while(*cmdLine && *cmdLine != ' ') { ++cmdLine; }
+ while(*cmdLine && *cmdLine == ' ') { ++cmdLine; }
+
+ /* Create a non-inherited copy of the error pipe. We do not want
+ the child to get it. */
+ if(DuplicateHandle(GetCurrentProcess(), errorPipeOrig,
+ GetCurrentProcess(), &errorPipe,
+ 0, FALSE, DUPLICATE_SAME_ACCESS))
+ {
+ /* Have a non-inherited duplicate. Close the inherited one. */
+ CloseHandle(errorPipeOrig);
+ }
+ else
+ {
+ /* Could not duplicate handle. Report the error. */
+ ReportLastError(errorPipeOrig);
+ return 1;
+ }
+
+ /* Create the subprocess. */
+ ZeroMemory(&si, sizeof(si));
+ ZeroMemory(&pi, sizeof(pi));
+ si.cb = sizeof(si);
+ si.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW;
+ si.wShowWindow = hideWindow?SW_HIDE:SW_SHOWDEFAULT;
+ si.hStdInput = GetStdHandle(STD_INPUT_HANDLE);
+ si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
+ si.hStdError = GetStdHandle(STD_ERROR_HANDLE);
+ if(CreateProcess(0, cmdLine, 0, 0, TRUE, CREATE_SUSPENDED, 0, 0, &si, &pi))
+ {
+ /* Process created successfully. Close the error reporting pipe
+ to notify the parent of success. */
+ CloseHandle(errorPipe);
+ }
+ else
+ {
+ /* Error creating the process. Report the error to the parent
+ process through the special error reporting pipe. */
+ ReportLastError(errorPipe);
+ return 1;
+ }
+
+ /* Wait for resume or kill event from parent. */
+ waitHandles[0] = killEvent;
+ waitHandles[1] = resumeEvent;
+ waitResult = WaitForMultipleObjects(2, waitHandles, 0, INFINITE);
+
+ /* Check what happened. */
+ if(waitResult == WAIT_OBJECT_0)
+ {
+ /* We were asked to kill the child. */
+ TerminateProcess(pi.hProcess, 255);
+ WaitForSingleObject(pi.hProcess, INFINITE);
+ CloseHandle(pi.hProcess);
+ CloseHandle(pi.hThread);
+ return 1;
+ }
+ else
+ {
+ /* We were asked to resume the child. */
+ ResumeThread(pi.hThread);
+ CloseHandle(pi.hThread);
+ }
+
+ /* Wait for subprocess to exit or for kill event from parent. */
+ waitHandles[0] = killEvent;
+ waitHandles[1] = pi.hProcess;
+ waitResult = WaitForMultipleObjects(2, waitHandles, 0, INFINITE);
+
+ /* Check what happened. */
+ if(waitResult == WAIT_OBJECT_0)
+ {
+ /* We were asked to kill the child. */
+ TerminateProcess(pi.hProcess, 255);
+ WaitForSingleObject(pi.hProcess, INFINITE);
+ CloseHandle(pi.hProcess);
+ return 1;
+ }
+ else
+ {
+ /* The child exited. Get the return code. */
+ GetExitCodeProcess(pi.hProcess, &retVal);
+ CloseHandle(pi.hProcess);
+ return retVal;
+ }
+}
+
+void ReportLastError(HANDLE errorPipe)
+{
+ LPVOID lpMsgBuf;
+ DWORD n;
+ FormatMessage(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER |
+ FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_IGNORE_INSERTS,
+ NULL,
+ GetLastError(),
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
+ (LPTSTR) &lpMsgBuf,
+ 0,
+ NULL
+ );
+ WriteFile(errorPipe, lpMsgBuf, strlen(lpMsgBuf)+1, &n, 0);
+ LocalFree( lpMsgBuf );
+}
diff --git a/Utilities/ITK/Utilities/kwsys/ProcessUNIX.c b/Utilities/ITK/Utilities/kwsys/ProcessUNIX.c
new file mode 100644
index 0000000000000000000000000000000000000000..189be17d06493998273cff59cd553769b7967ab4
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/ProcessUNIX.c
@@ -0,0 +1,2013 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: ProcessUNIX.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Process.h)
+
+/* Work-around CMake dependency scanning limitation. This must
+ duplicate the above list of headers. */
+#if 0
+# include "Process.h.in"
+#endif
+
+/*
+
+Implementation for UNIX
+
+On UNIX, a child process is forked to exec the program. Three
+output pipes from the child are read by the parent process using a
+select call to block until data are ready. Two of the pipes are
+stdout and stderr for the child. The third is a special error pipe
+that has two purposes. First, if the child cannot exec the program,
+the error is reported through the error pipe. Second, the error
+pipe is left open until the child exits. This is used in
+conjunction with the timeout on the select call to implement a
+timeout for program even when it closes stdout and stderr.
+*/
+
+/*
+
+TODO:
+
+We cannot create the pipeline of processes in suspended states. How
+do we cleanup processes already started when one fails to load? Right
+now we are just killing them, which is probably not the right thing to
+do.
+
+*/
+
+#include <stdio.h> /* snprintf */
+#include <stdlib.h> /* malloc, free */
+#include <string.h> /* strdup, strerror, memset */
+#include <sys/time.h> /* struct timeval */
+#include <sys/types.h> /* pid_t, fd_set */
+#include <sys/wait.h> /* waitpid */
+#include <sys/stat.h> /* open mode */
+#include <unistd.h> /* pipe, close, fork, execvp, select, _exit */
+#include <fcntl.h> /* fcntl */
+#include <errno.h> /* errno */
+#include <time.h> /* gettimeofday */
+#include <signal.h> /* sigaction */
+#include <dirent.h> /* DIR, dirent */
+
+/* The number of pipes for the child's output. The standard stdout
+ and stderr pipes are the first two. One more pipe is used to
+ detect when the child process has terminated. The third pipe is
+ not given to the child process, so it cannot close it until it
+ terminates. */
+#define KWSYSPE_PIPE_COUNT 3
+#define KWSYSPE_PIPE_STDOUT 0
+#define KWSYSPE_PIPE_STDERR 1
+#define KWSYSPE_PIPE_TERM 2
+
+/* The maximum amount to read from a pipe at a time. */
+#define KWSYSPE_PIPE_BUFFER_SIZE 1024
+
+/* Keep track of times using a signed representation. Switch to the
+ native (possibly unsigned) representation only when calling native
+ functions. */
+typedef struct timeval kwsysProcessTimeNative;
+typedef struct kwsysProcessTime_s kwsysProcessTime;
+struct kwsysProcessTime_s
+{
+ long tv_sec;
+ long tv_usec;
+};
+
+typedef struct kwsysProcessCreateInformation_s
+{
+ int StdIn;
+ int StdOut;
+ int StdErr;
+ int TermPipe;
+ int ErrorPipe[2];
+} kwsysProcessCreateInformation;
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcessInitialize(kwsysProcess* cp);
+static void kwsysProcessCleanup(kwsysProcess* cp, int error);
+static void kwsysProcessCleanupDescriptor(int* pfd);
+static int kwsysProcessCreate(kwsysProcess* cp, int prIndex,
+ kwsysProcessCreateInformation* si, int* readEnd);
+static int kwsysProcessSetupOutputPipeFile(int* p, const char* name);
+static int kwsysProcessGetTimeoutTime(kwsysProcess* cp, double* userTimeout,
+ kwsysProcessTime* timeoutTime);
+static int kwsysProcessGetTimeoutLeft(kwsysProcessTime* timeoutTime,
+ double* userTimeout,
+ kwsysProcessTimeNative* timeoutLength);
+static kwsysProcessTime kwsysProcessTimeGetCurrent(void);
+static double kwsysProcessTimeToDouble(kwsysProcessTime t);
+static kwsysProcessTime kwsysProcessTimeFromDouble(double d);
+static int kwsysProcessTimeLess(kwsysProcessTime in1, kwsysProcessTime in2);
+static kwsysProcessTime kwsysProcessTimeAdd(kwsysProcessTime in1, kwsysProcessTime in2);
+static kwsysProcessTime kwsysProcessTimeSubtract(kwsysProcessTime in1, kwsysProcessTime in2);
+static void kwsysProcessSetExitException(kwsysProcess* cp, int sig);
+static void kwsysProcessChildErrorExit(int errorPipe);
+static void kwsysProcessRestoreDefaultSignalHandlers(void);
+static pid_t kwsysProcessFork(kwsysProcess* cp,
+ kwsysProcessCreateInformation* si);
+static void kwsysProcessKill(pid_t process_id);
+
+/*--------------------------------------------------------------------------*/
+/* Structure containing data used to implement the child's execution. */
+struct kwsysProcess_s
+{
+ /* The command lines to execute. */
+ char*** Commands;
+ int NumberOfCommands;
+
+ /* Descriptors for the read ends of the child's output pipes. */
+ int PipeReadEnds[KWSYSPE_PIPE_COUNT];
+
+ /* Buffer for pipe data. */
+ char PipeBuffer[KWSYSPE_PIPE_BUFFER_SIZE];
+
+ /* Process IDs returned by the calls to fork. */
+ pid_t* ForkPIDs;
+
+ /* Flag for whether the children were terminated by a faild select. */
+ int SelectError;
+
+ /* The timeout length. */
+ double Timeout;
+
+ /* The working directory for the process. */
+ char* WorkingDirectory;
+
+ /* Whether to create the child as a detached process. */
+ int OptionDetach;
+
+ /* Whether the child was created as a detached process. */
+ int Detached;
+
+ /* Time at which the child started. Negative for no timeout. */
+ kwsysProcessTime StartTime;
+
+ /* Time at which the child will timeout. Negative for no timeout. */
+ kwsysProcessTime TimeoutTime;
+
+ /* Flag for whether the timeout expired. */
+ int TimeoutExpired;
+
+ /* The old SIGCHLD handler. */
+ struct sigaction OldSigChldAction;
+
+ /* The number of pipes left open during execution. */
+ int PipesLeft;
+
+ /* File descriptor set for call to select. */
+ fd_set PipeSet;
+
+ /* The current status of the child process. */
+ int State;
+
+ /* The exceptional behavior that terminated the child process, if
+ * any. */
+ int ExitException;
+
+ /* The exit code of the child process. */
+ int ExitCode;
+
+ /* The exit value of the child process, if any. */
+ int ExitValue;
+
+ /* Whether the process was killed. */
+ int Killed;
+
+ /* Buffer for error message in case of failure. */
+ char ErrorMessage[KWSYSPE_PIPE_BUFFER_SIZE+1];
+
+ /* Description for the ExitException. */
+ char ExitExceptionString[KWSYSPE_PIPE_BUFFER_SIZE+1];
+
+ /* The exit codes of each child process in the pipeline. */
+ int* CommandExitCodes;
+
+ /* Name of files to which stdin and stdout pipes are attached. */
+ char* PipeFileSTDIN;
+ char* PipeFileSTDOUT;
+ char* PipeFileSTDERR;
+
+ /* Whether each pipe is shared with the parent process. */
+ int PipeSharedSTDIN;
+ int PipeSharedSTDOUT;
+ int PipeSharedSTDERR;
+
+ /* The real working directory of this process. */
+ int RealWorkingDirectoryLength;
+ char* RealWorkingDirectory;
+};
+
+/*--------------------------------------------------------------------------*/
+kwsysProcess* kwsysProcess_New(void)
+{
+ /* Allocate a process control structure. */
+ kwsysProcess* cp = (kwsysProcess*)malloc(sizeof(kwsysProcess));
+ if(!cp)
+ {
+ return 0;
+ }
+ memset(cp, 0, sizeof(kwsysProcess));
+
+ /* Share stdin with the parent process by default. */
+ cp->PipeSharedSTDIN = 1;
+
+ /* Set initial status. */
+ cp->State = kwsysProcess_State_Starting;
+
+ return cp;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Delete(kwsysProcess* cp)
+{
+ /* Make sure we have an instance. */
+ if(!cp)
+ {
+ return;
+ }
+
+ /* If the process is executing, wait for it to finish. */
+ if(cp->State == kwsysProcess_State_Executing)
+ {
+ if(cp->Detached)
+ {
+ kwsysProcess_Disown(cp);
+ }
+ else
+ {
+ kwsysProcess_WaitForExit(cp, 0);
+ }
+ }
+
+ /* Free memory. */
+ kwsysProcess_SetCommand(cp, 0);
+ kwsysProcess_SetWorkingDirectory(cp, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDIN, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDOUT, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDERR, 0);
+ if(cp->CommandExitCodes)
+ {
+ free(cp->CommandExitCodes);
+ }
+ free(cp);
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetCommand(kwsysProcess* cp, char const* const* command)
+{
+ int i;
+ if(!cp)
+ {
+ return 0;
+ }
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ char** c = cp->Commands[i];
+ while(*c)
+ {
+ free(*c++);
+ }
+ free(cp->Commands[i]);
+ }
+ cp->NumberOfCommands = 0;
+ if(cp->Commands)
+ {
+ free(cp->Commands);
+ cp->Commands = 0;
+ }
+ if(command)
+ {
+ return kwsysProcess_AddCommand(cp, command);
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_AddCommand(kwsysProcess* cp, char const* const* command)
+{
+ int newNumberOfCommands;
+ char*** newCommands;
+
+ /* Make sure we have a command to add. */
+ if(!cp || !command)
+ {
+ return 0;
+ }
+
+ /* Allocate a new array for command pointers. */
+ newNumberOfCommands = cp->NumberOfCommands + 1;
+ if(!(newCommands = (char***)malloc(sizeof(char**) * newNumberOfCommands)))
+ {
+ /* Out of memory. */
+ return 0;
+ }
+
+ /* Copy any existing commands into the new array. */
+ {
+ int i;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ newCommands[i] = cp->Commands[i];
+ }
+ }
+
+ /* Add the new command. */
+ {
+ char const* const* c = command;
+ int n = 0;
+ int i = 0;
+ while(*c++);
+ n = c - command - 1;
+ newCommands[cp->NumberOfCommands] = (char**)malloc((n+1)*sizeof(char*));
+ if(!newCommands[cp->NumberOfCommands])
+ {
+ /* Out of memory. */
+ free(newCommands);
+ return 0;
+ }
+ for(i=0; i < n; ++i)
+ {
+ newCommands[cp->NumberOfCommands][i] = strdup(command[i]);
+ if(!newCommands[cp->NumberOfCommands][i])
+ {
+ break;
+ }
+ }
+ if(i < n)
+ {
+ /* Out of memory. */
+ for(;i > 0; --i)
+ {
+ free(newCommands[cp->NumberOfCommands][i-1]);
+ }
+ free(newCommands);
+ return 0;
+ }
+ newCommands[cp->NumberOfCommands][n] = 0;
+ }
+
+ /* Successfully allocated new command array. Free the old array. */
+ free(cp->Commands);
+ cp->Commands = newCommands;
+ cp->NumberOfCommands = newNumberOfCommands;
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetTimeout(kwsysProcess* cp, double timeout)
+{
+ if(!cp)
+ {
+ return;
+ }
+ cp->Timeout = timeout;
+ if(cp->Timeout < 0)
+ {
+ cp->Timeout = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetWorkingDirectory(kwsysProcess* cp, const char* dir)
+{
+ if(!cp)
+ {
+ return 0;
+ }
+ if(cp->WorkingDirectory == dir)
+ {
+ return 1;
+ }
+ if(cp->WorkingDirectory && dir && strcmp(cp->WorkingDirectory, dir) == 0)
+ {
+ return 1;
+ }
+ if(cp->WorkingDirectory)
+ {
+ free(cp->WorkingDirectory);
+ cp->WorkingDirectory = 0;
+ }
+ if(dir)
+ {
+ cp->WorkingDirectory = (char*)malloc(strlen(dir) + 1);
+ if(!cp->WorkingDirectory)
+ {
+ return 0;
+ }
+ strcpy(cp->WorkingDirectory, dir);
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetPipeFile(kwsysProcess* cp, int prPipe, const char* file)
+{
+ char** pfile;
+ if(!cp)
+ {
+ return 0;
+ }
+ switch(prPipe)
+ {
+ case kwsysProcess_Pipe_STDIN: pfile = &cp->PipeFileSTDIN; break;
+ case kwsysProcess_Pipe_STDOUT: pfile = &cp->PipeFileSTDOUT; break;
+ case kwsysProcess_Pipe_STDERR: pfile = &cp->PipeFileSTDERR; break;
+ default: return 0;
+ }
+ if(*pfile)
+ {
+ free(*pfile);
+ *pfile = 0;
+ }
+ if(file)
+ {
+ *pfile = malloc(strlen(file)+1);
+ if(!*pfile)
+ {
+ return 0;
+ }
+ strcpy(*pfile, file);
+ }
+
+ /* If we are redirecting the pipe, do not share it. */
+ if(*pfile)
+ {
+ kwsysProcess_SetPipeShared(cp, prPipe, 0);
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetPipeShared(kwsysProcess* cp, int prPipe, int shared)
+{
+ if(!cp)
+ {
+ return;
+ }
+
+ switch(prPipe)
+ {
+ case kwsysProcess_Pipe_STDIN: cp->PipeSharedSTDIN = shared?1:0; break;
+ case kwsysProcess_Pipe_STDOUT: cp->PipeSharedSTDOUT = shared?1:0; break;
+ case kwsysProcess_Pipe_STDERR: cp->PipeSharedSTDERR = shared?1:0; break;
+ default: return;
+ }
+
+ /* If we are sharing the pipe, do not redirect it to a file. */
+ if(shared)
+ {
+ kwsysProcess_SetPipeFile(cp, prPipe, 0);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetOption(kwsysProcess* cp, int optionId)
+{
+ if(!cp)
+ {
+ return 0;
+ }
+
+ switch(optionId)
+ {
+ case kwsysProcess_Option_Detach: return cp->OptionDetach;
+ default: return 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetOption(kwsysProcess* cp, int optionId, int value)
+{
+ if(!cp)
+ {
+ return;
+ }
+
+ switch(optionId)
+ {
+ case kwsysProcess_Option_Detach: cp->OptionDetach = value; break;
+ default: break;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetState(kwsysProcess* cp)
+{
+ return cp? cp->State : kwsysProcess_State_Error;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitException(kwsysProcess* cp)
+{
+ return cp? cp->ExitException : kwsysProcess_Exception_Other;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitCode(kwsysProcess* cp)
+{
+ return cp? cp->ExitCode : 0;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitValue(kwsysProcess* cp)
+{
+ return cp? cp->ExitValue : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+const char* kwsysProcess_GetErrorString(kwsysProcess* cp)
+{
+ if(!cp)
+ {
+ return "Process management structure could not be allocated";
+ }
+ else if(cp->State == kwsysProcess_State_Error)
+ {
+ return cp->ErrorMessage;
+ }
+ return "Success";
+}
+
+/*--------------------------------------------------------------------------*/
+const char* kwsysProcess_GetExceptionString(kwsysProcess* cp)
+{
+ if(!cp)
+ {
+ return "GetExceptionString called with NULL process management structure";
+ }
+ else if(cp->State == kwsysProcess_State_Exception)
+ {
+ return cp->ExitExceptionString;
+ }
+ return "No exception";
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Execute(kwsysProcess* cp)
+{
+ int i;
+ struct sigaction newSigChldAction;
+ kwsysProcessCreateInformation si = {-1, -1, -1, -1, {-1, -1}};
+
+ /* Do not execute a second copy simultaneously. */
+ if(!cp || cp->State == kwsysProcess_State_Executing)
+ {
+ return;
+ }
+
+ /* Initialize the control structure for a new process. */
+ if(!kwsysProcessInitialize(cp))
+ {
+ strcpy(cp->ErrorMessage, "Out of memory");
+ cp->State = kwsysProcess_State_Error;
+ return;
+ }
+
+ /* Save the real working directory of this process and change to
+ the working directory for the child processes. This is needed
+ to make pipe file paths evaluate correctly. */
+ if(cp->WorkingDirectory)
+ {
+ int r;
+ if(!getcwd(cp->RealWorkingDirectory, cp->RealWorkingDirectoryLength))
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+
+ /* Some platforms specify that the chdir call may be
+ interrupted. Repeat the call until it finishes. */
+ while(((r = chdir(cp->WorkingDirectory)) < 0) && (errno == EINTR));
+ if(r < 0)
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+ }
+
+ /* We want no special handling of SIGCHLD. Repeat call until it is
+ not interrupted. */
+ memset(&newSigChldAction, 0, sizeof(struct sigaction));
+ newSigChldAction.sa_handler = SIG_DFL;
+ while((sigaction(SIGCHLD, &newSigChldAction, &cp->OldSigChldAction) < 0) &&
+ (errno == EINTR));
+
+ /* Setup the stderr and termination pipes to be shared by all processes. */
+ for(i=KWSYSPE_PIPE_STDERR; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ /* Create the pipe. */
+ int p[2];
+ if(pipe(p) < 0)
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+
+ /* Store the pipe. */
+ cp->PipeReadEnds[i] = p[0];
+ if(i == KWSYSPE_PIPE_STDERR)
+ {
+ si.StdErr = p[1];
+ }
+ else
+ {
+ si.TermPipe = p[1];
+ }
+
+ /* Set close-on-exec flag on the pipe's ends. */
+ if((fcntl(p[0], F_SETFD, FD_CLOEXEC) < 0) ||
+ (fcntl(p[1], F_SETFD, FD_CLOEXEC) < 0))
+ {
+ kwsysProcessCleanup(cp, 1);
+ kwsysProcessCleanupDescriptor(&si.StdErr);
+ kwsysProcessCleanupDescriptor(&si.TermPipe);
+ return;
+ }
+ }
+
+ /* Replace the stderr pipe with a file if requested. In this case
+ the select call will report that stderr is closed immediately. */
+ if(cp->PipeFileSTDERR)
+ {
+ if(!kwsysProcessSetupOutputPipeFile(&si.StdErr, cp->PipeFileSTDERR))
+ {
+ kwsysProcessCleanup(cp, 1);
+ kwsysProcessCleanupDescriptor(&si.StdErr);
+ kwsysProcessCleanupDescriptor(&si.TermPipe);
+ return;
+ }
+ }
+
+ /* Replace the stderr pipe with the parent's if requested. In this
+ case the select call will report that stderr is closed
+ immediately. */
+ if(cp->PipeSharedSTDERR)
+ {
+ kwsysProcessCleanupDescriptor(&si.StdErr);
+ si.StdErr = 2;
+ }
+
+ /* The timeout period starts now. */
+ cp->StartTime = kwsysProcessTimeGetCurrent();
+ cp->TimeoutTime.tv_sec = -1;
+ cp->TimeoutTime.tv_usec = -1;
+
+ /* Create the pipeline of processes. */
+ {
+ int readEnd = -1;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ if(!kwsysProcessCreate(cp, i, &si, &readEnd))
+ {
+ kwsysProcessCleanup(cp, 1);
+
+ /* Release resources that may have been allocated for this
+ process before an error occurred. */
+ kwsysProcessCleanupDescriptor(&readEnd);
+ if(si.StdIn != 0)
+ {
+ kwsysProcessCleanupDescriptor(&si.StdIn);
+ }
+ if(si.StdOut != 1)
+ {
+ kwsysProcessCleanupDescriptor(&si.StdOut);
+ }
+ if(si.StdErr != 2)
+ {
+ kwsysProcessCleanupDescriptor(&si.StdErr);
+ }
+ kwsysProcessCleanupDescriptor(&si.TermPipe);
+ kwsysProcessCleanupDescriptor(&si.ErrorPipe[0]);
+ kwsysProcessCleanupDescriptor(&si.ErrorPipe[1]);
+ return;
+ }
+ }
+ /* Save a handle to the output pipe for the last process. */
+ cp->PipeReadEnds[KWSYSPE_PIPE_STDOUT] = readEnd;
+ }
+
+ /* The parent process does not need the output pipe write ends. */
+ if(si.StdErr != 2)
+ {
+ kwsysProcessCleanupDescriptor(&si.StdErr);
+ }
+ kwsysProcessCleanupDescriptor(&si.TermPipe);
+
+ /* Restore the working directory. */
+ if(cp->RealWorkingDirectory)
+ {
+ /* Some platforms specify that the chdir call may be
+ interrupted. Repeat the call until it finishes. */
+ while((chdir(cp->RealWorkingDirectory) < 0) && (errno == EINTR));
+ free(cp->RealWorkingDirectory);
+ cp->RealWorkingDirectory = 0;
+ }
+
+ /* All the pipes are now open. */
+ cp->PipesLeft = KWSYSPE_PIPE_COUNT;
+
+ /* The process has now started. */
+ cp->State = kwsysProcess_State_Executing;
+ cp->Detached = cp->OptionDetach;
+}
+
+/*--------------------------------------------------------------------------*/
+kwsysEXPORT void kwsysProcess_Disown(kwsysProcess* cp)
+{
+ int i;
+
+ /* Make sure a detached child process is running. */
+ if(!cp || !cp->Detached || cp->State != kwsysProcess_State_Executing ||
+ cp->TimeoutExpired || cp->Killed)
+ {
+ return;
+ }
+
+ /* Close any pipes that are still open. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ if(cp->PipeReadEnds[i] >= 0)
+ {
+ /* If the pipe was reported by the last call to select, we must
+ read from it. Ignore the data. */
+ if(FD_ISSET(cp->PipeReadEnds[i], &cp->PipeSet))
+ {
+ /* We are handling this pipe now. Remove it from the set. */
+ FD_CLR(cp->PipeReadEnds[i], &cp->PipeSet);
+
+ /* The pipe is ready to read without blocking. Keep trying to
+ read until the operation is not interrupted. */
+ while((read(cp->PipeReadEnds[i], cp->PipeBuffer,
+ KWSYSPE_PIPE_BUFFER_SIZE) < 0) && (errno == EINTR));
+ }
+
+ /* We are done reading from this pipe. */
+ kwsysProcessCleanupDescriptor(&cp->PipeReadEnds[i]);
+ --cp->PipesLeft;
+ }
+ }
+
+ /* We will not wait for exit, so cleanup now. */
+ kwsysProcessCleanup(cp, 0);
+
+ /* The process has been disowned. */
+ cp->State = kwsysProcess_State_Disowned;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_WaitForData(kwsysProcess* cp, char** data, int* length,
+ double* userTimeout)
+{
+ int i;
+ int max = -1;
+ kwsysProcessTimeNative* timeout = 0;
+ kwsysProcessTimeNative timeoutLength;
+ kwsysProcessTime timeoutTime;
+ kwsysProcessTime userStartTime = {0, 0};
+ int user = 0;
+ int expired = 0;
+ int pipeId = kwsysProcess_Pipe_None;
+ int numReady = 0;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing || cp->Killed ||
+ cp->TimeoutExpired)
+ {
+ return kwsysProcess_Pipe_None;
+ }
+
+ /* Record the time at which user timeout period starts. */
+ if(userTimeout)
+ {
+ userStartTime = kwsysProcessTimeGetCurrent();
+ }
+
+ /* Calculate the time at which a timeout will expire, and whether it
+ is the user or process timeout. */
+ user = kwsysProcessGetTimeoutTime(cp, userTimeout, &timeoutTime);
+
+ /* Data can only be available when pipes are open. If the process
+ is not running, cp->PipesLeft will be 0. */
+ while(cp->PipesLeft > 0)
+ {
+ /* Check for any open pipes with data reported ready by the last
+ call to select. According to "man select_tut" we must deal
+ with all descriptors reported by a call to select before
+ passing them to another select call. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ if(cp->PipeReadEnds[i] >= 0 &&
+ FD_ISSET(cp->PipeReadEnds[i], &cp->PipeSet))
+ {
+ int n;
+
+ /* We are handling this pipe now. Remove it from the set. */
+ FD_CLR(cp->PipeReadEnds[i], &cp->PipeSet);
+
+ /* The pipe is ready to read without blocking. Keep trying to
+ read until the operation is not interrupted. */
+ while(((n = read(cp->PipeReadEnds[i], cp->PipeBuffer,
+ KWSYSPE_PIPE_BUFFER_SIZE)) < 0) && (errno == EINTR));
+ if(n > 0)
+ {
+ /* We have data on this pipe. */
+ if(i == KWSYSPE_PIPE_TERM)
+ {
+ /* This is data on the special termination pipe. Ignore it. */
+ }
+ else if(data && length)
+ {
+ /* Report this data. */
+ *data = cp->PipeBuffer;
+ *length = n;
+ switch(i)
+ {
+ case KWSYSPE_PIPE_STDOUT:
+ pipeId = kwsysProcess_Pipe_STDOUT; break;
+ case KWSYSPE_PIPE_STDERR:
+ pipeId = kwsysProcess_Pipe_STDERR; break;
+ };
+ break;
+ }
+ }
+ else
+ {
+ /* We are done reading from this pipe. */
+ kwsysProcessCleanupDescriptor(&cp->PipeReadEnds[i]);
+ --cp->PipesLeft;
+ }
+ }
+ }
+
+ /* If we have data, break early. */
+ if(pipeId)
+ {
+ break;
+ }
+
+ /* Make sure the set is empty (it should always be empty here
+ anyway). */
+ FD_ZERO(&cp->PipeSet);
+
+ /* Setup a timeout if required. */
+ if(timeoutTime.tv_sec < 0)
+ {
+ timeout = 0;
+ }
+ else
+ {
+ timeout = &timeoutLength;
+ }
+ if(kwsysProcessGetTimeoutLeft(&timeoutTime, user?userTimeout:0, &timeoutLength))
+ {
+ /* Timeout has already expired. */
+ expired = 1;
+ break;
+ }
+
+ /* Add the pipe reading ends that are still open. */
+ max = -1;
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ if(cp->PipeReadEnds[i] >= 0)
+ {
+ FD_SET(cp->PipeReadEnds[i], &cp->PipeSet);
+ if(cp->PipeReadEnds[i] > max)
+ {
+ max = cp->PipeReadEnds[i];
+ }
+ }
+ }
+
+ /* Make sure we have a non-empty set. */
+ if(max < 0)
+ {
+ /* All pipes have closed. Child has terminated. */
+ break;
+ }
+
+ /* Run select to block until data are available. Repeat call
+ until it is not interrupted. */
+ while(((numReady = select(max+1, &cp->PipeSet, 0, 0, timeout)) < 0) &&
+ (errno == EINTR));
+
+ /* Check result of select. */
+ if(numReady == 0)
+ {
+ /* Select's timeout expired. */
+ expired = 1;
+ break;
+ }
+ else if(numReady < 0)
+ {
+ /* Select returned an error. Leave the error description in the
+ pipe buffer. */
+ strncpy(cp->ErrorMessage, strerror(errno), KWSYSPE_PIPE_BUFFER_SIZE);
+
+ /* Kill the children now. */
+ kwsysProcess_Kill(cp);
+ cp->Killed = 0;
+ cp->SelectError = 1;
+ }
+ }
+
+ /* Update the user timeout. */
+ if(userTimeout)
+ {
+ kwsysProcessTime userEndTime = kwsysProcessTimeGetCurrent();
+ kwsysProcessTime difference = kwsysProcessTimeSubtract(userEndTime,
+ userStartTime);
+ double d = kwsysProcessTimeToDouble(difference);
+ *userTimeout -= d;
+ if(*userTimeout < 0)
+ {
+ *userTimeout = 0;
+ }
+ }
+
+ /* Check what happened. */
+ if(pipeId)
+ {
+ /* Data are ready on a pipe. */
+ return pipeId;
+ }
+ else if(expired)
+ {
+ /* A timeout has expired. */
+ if(user)
+ {
+ /* The user timeout has expired. It has no time left. */
+ return kwsysProcess_Pipe_Timeout;
+ }
+ else
+ {
+ /* The process timeout has expired. Kill the children now. */
+ kwsysProcess_Kill(cp);
+ cp->Killed = 0;
+ cp->TimeoutExpired = 1;
+ return kwsysProcess_Pipe_None;
+ }
+ }
+ else
+ {
+ /* No pipes are left open. */
+ return kwsysProcess_Pipe_None;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_WaitForExit(kwsysProcess* cp, double* userTimeout)
+{
+ int result = 0;
+ int status = 0;
+ int prPipe = 0;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing)
+ {
+ return 1;
+ }
+
+ /* Wait for all the pipes to close. Ignore all data. */
+ while((prPipe = kwsysProcess_WaitForData(cp, 0, 0, userTimeout)) > 0)
+ {
+ if(prPipe == kwsysProcess_Pipe_Timeout)
+ {
+ return 0;
+ }
+ }
+
+ /* Wait for each child to terminate. The process should have
+ already exited because KWSYSPE_PIPE_TERM has been closed by this
+ point. Repeat the call until it is not interrupted. */
+ if(!cp->Detached)
+ {
+ int i;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ while(((result = waitpid(cp->ForkPIDs[i],
+ &cp->CommandExitCodes[i], 0)) < 0) &&
+ (errno == EINTR));
+ if(result <= 0 && cp->State != kwsysProcess_State_Error)
+ {
+ /* Unexpected error. Report the first time this happens. */
+ strncpy(cp->ErrorMessage, strerror(errno), KWSYSPE_PIPE_BUFFER_SIZE);
+ cp->State = kwsysProcess_State_Error;
+ }
+ }
+ }
+
+ /* Check if there was an error in one of the waitpid calls. */
+ if(cp->State == kwsysProcess_State_Error)
+ {
+ /* The error message is already in its buffer. Tell
+ kwsysProcessCleanup to not create it. */
+ kwsysProcessCleanup(cp, 0);
+ return 1;
+ }
+
+ /* Check whether the child reported an error invoking the process. */
+ if(cp->SelectError)
+ {
+ /* The error message is already in its buffer. Tell
+ kwsysProcessCleanup to not create it. */
+ kwsysProcessCleanup(cp, 0);
+ cp->State = kwsysProcess_State_Error;
+ return 1;
+ }
+
+ /* Use the status of the last process in the pipeline. */
+ status = cp->CommandExitCodes[cp->NumberOfCommands-1];
+
+ /* Determine the outcome. */
+ if(cp->Killed)
+ {
+ /* We killed the child. */
+ cp->State = kwsysProcess_State_Killed;
+ }
+ else if(cp->TimeoutExpired)
+ {
+ /* The timeout expired. */
+ cp->State = kwsysProcess_State_Expired;
+ }
+ else if(WIFEXITED(status))
+ {
+ /* The child exited normally. */
+ cp->State = kwsysProcess_State_Exited;
+ cp->ExitException = kwsysProcess_Exception_None;
+ cp->ExitCode = status;
+ cp->ExitValue = (int)WEXITSTATUS(status);
+ }
+ else if(WIFSIGNALED(status))
+ {
+ /* The child received an unhandled signal. */
+ cp->State = kwsysProcess_State_Exception;
+ cp->ExitCode = status;
+ kwsysProcessSetExitException(cp, (int)WTERMSIG(status));
+ }
+ else
+ {
+ /* Error getting the child return code. */
+ strcpy(cp->ErrorMessage, "Error getting child return code.");
+ cp->State = kwsysProcess_State_Error;
+ }
+
+ /* Normal cleanup. */
+ kwsysProcessCleanup(cp, 0);
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Kill(kwsysProcess* cp)
+{
+ int i;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing)
+ {
+ return;
+ }
+
+ /* Kill the children. */
+ cp->Killed = 1;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ if(cp->ForkPIDs[i])
+ {
+ kwsysProcessKill(cp->ForkPIDs[i]);
+ }
+ }
+
+ /* Close all the pipe read ends. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ kwsysProcessCleanupDescriptor(&cp->PipeReadEnds[i]);
+ }
+ cp->PipesLeft = 0;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Initialize a process control structure for kwsysProcess_Execute. */
+static int kwsysProcessInitialize(kwsysProcess* cp)
+{
+ int i;
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ cp->PipeReadEnds[i] = -1;
+ }
+ cp->SelectError = 0;
+ cp->StartTime.tv_sec = -1;
+ cp->StartTime.tv_usec = -1;
+ cp->TimeoutTime.tv_sec = -1;
+ cp->TimeoutTime.tv_usec = -1;
+ cp->TimeoutExpired = 0;
+ cp->PipesLeft = 0;
+ FD_ZERO(&cp->PipeSet);
+ cp->State = kwsysProcess_State_Starting;
+ cp->Killed = 0;
+ cp->ExitException = kwsysProcess_Exception_None;
+ cp->ExitCode = 1;
+ cp->ExitValue = 1;
+ cp->ErrorMessage[0] = 0;
+ strcpy(cp->ExitExceptionString, "No exception");
+
+ if(cp->ForkPIDs)
+ {
+ free(cp->ForkPIDs);
+ }
+ cp->ForkPIDs = (pid_t*)malloc(sizeof(pid_t)*cp->NumberOfCommands);
+ if(!cp->ForkPIDs)
+ {
+ return 0;
+ }
+ memset(cp->ForkPIDs, 0, sizeof(pid_t)*cp->NumberOfCommands);
+
+ if(cp->CommandExitCodes)
+ {
+ free(cp->CommandExitCodes);
+ }
+ cp->CommandExitCodes = (int*)malloc(sizeof(int)*cp->NumberOfCommands);
+ if(!cp->CommandExitCodes)
+ {
+ return 0;
+ }
+ memset(cp->CommandExitCodes, 0, sizeof(int)*cp->NumberOfCommands);
+
+ /* Allocate memory to save the real working directory. */
+ if ( cp->WorkingDirectory )
+ {
+#if defined(MAXPATHLEN)
+ cp->RealWorkingDirectoryLength = MAXPATHLEN;
+#elif defined(PATH_MAX)
+ cp->RealWorkingDirectoryLength = PATH_MAX;
+#else
+ cp->RealWorkingDirectoryLength = 4096;
+#endif
+ cp->RealWorkingDirectory = malloc(cp->RealWorkingDirectoryLength);
+ if(!cp->RealWorkingDirectory)
+ {
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Free all resources used by the given kwsysProcess instance that were
+ allocated by kwsysProcess_Execute. */
+static void kwsysProcessCleanup(kwsysProcess* cp, int error)
+{
+ int i;
+
+ if(error)
+ {
+ /* We are cleaning up due to an error. Report the error message
+ if one has not been provided already. */
+ if(cp->ErrorMessage[0] == 0)
+ {
+ strncpy(cp->ErrorMessage, strerror(errno), KWSYSPE_PIPE_BUFFER_SIZE);
+ }
+
+ /* Set the error state. */
+ cp->State = kwsysProcess_State_Error;
+
+ /* Kill any children already started. */
+ if(cp->ForkPIDs)
+ {
+ int status;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ if(cp->ForkPIDs[i])
+ {
+ /* Kill the child. */
+ kwsysProcessKill(cp->ForkPIDs[i]);
+ /* Reap the child. Keep trying until the call is not
+ interrupted. */
+ while((waitpid(cp->ForkPIDs[i], &status, 0) < 0) &&
+ (errno == EINTR));
+ }
+ }
+ }
+
+ /* Restore the working directory. */
+ if(cp->RealWorkingDirectory)
+ {
+ while((chdir(cp->RealWorkingDirectory) < 0) && (errno == EINTR));
+ }
+ }
+
+ /* Restore the SIGCHLD handler. */
+ while((sigaction(SIGCHLD, &cp->OldSigChldAction, 0) < 0) &&
+ (errno == EINTR));
+
+ /* Free memory. */
+ if(cp->ForkPIDs)
+ {
+ free(cp->ForkPIDs);
+ cp->ForkPIDs = 0;
+ }
+ if(cp->RealWorkingDirectory)
+ {
+ free(cp->RealWorkingDirectory);
+ cp->RealWorkingDirectory = 0;
+ }
+
+ /* Close pipe handles. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ kwsysProcessCleanupDescriptor(&cp->PipeReadEnds[i]);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* Close the given file descriptor if it is open. Reset its value to -1. */
+static void kwsysProcessCleanupDescriptor(int* pfd)
+{
+ if(pfd && *pfd >= 0)
+ {
+ /* Keep trying to close until it is not interrupted by a
+ * signal. */
+ while((close(*pfd) < 0) && (errno == EINTR));
+ *pfd = -1;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcessCreate(kwsysProcess* cp, int prIndex,
+ kwsysProcessCreateInformation* si, int* readEnd)
+{
+ /* Setup the process's stdin. */
+ if(prIndex > 0)
+ {
+ si->StdIn = *readEnd;
+ *readEnd = 0;
+ }
+ else if(cp->PipeFileSTDIN)
+ {
+ /* Open a file for the child's stdin to read. */
+ si->StdIn = open(cp->PipeFileSTDIN, O_RDONLY);
+ if(si->StdIn < 0)
+ {
+ return 0;
+ }
+
+ /* Set close-on-exec flag on the pipe's end. */
+ if(fcntl(si->StdIn, F_SETFD, FD_CLOEXEC) < 0)
+ {
+ return 0;
+ }
+ }
+ else if(cp->PipeSharedSTDIN)
+ {
+ si->StdIn = 0;
+ }
+ else
+ {
+ si->StdIn = -1;
+ }
+
+ /* Setup the process's stdout. */
+ {
+ /* Create the pipe. */
+ int p[2];
+ if(pipe(p) < 0)
+ {
+ return 0;
+ }
+ *readEnd = p[0];
+ si->StdOut = p[1];
+
+ /* Set close-on-exec flag on the pipe's ends. */
+ if((fcntl(p[0], F_SETFD, FD_CLOEXEC) < 0) ||
+ (fcntl(p[1], F_SETFD, FD_CLOEXEC) < 0))
+ {
+ return 0;
+ }
+ }
+
+ /* Replace the stdout pipe with a file if requested. In this case
+ the select call will report that stdout is closed immediately. */
+ if(prIndex == cp->NumberOfCommands-1 && cp->PipeFileSTDOUT)
+ {
+ if(!kwsysProcessSetupOutputPipeFile(&si->StdOut, cp->PipeFileSTDOUT))
+ {
+ return 0;
+ }
+ }
+
+ /* Replace the stdout pipe with the parent's if requested. In this
+ case the select call will report that stderr is closed
+ immediately. */
+ if(prIndex == cp->NumberOfCommands-1 && cp->PipeSharedSTDOUT)
+ {
+ kwsysProcessCleanupDescriptor(&si->StdOut);
+ si->StdOut = 1;
+ }
+
+ /* Create the error reporting pipe. */
+ if(pipe(si->ErrorPipe) < 0)
+ {
+ return 0;
+ }
+
+ /* Set close-on-exec flag on the error pipe's write end. */
+ if(fcntl(si->ErrorPipe[1], F_SETFD, FD_CLOEXEC) < 0)
+ {
+ return 0;
+ }
+
+ /* Fork off a child process. */
+ cp->ForkPIDs[prIndex] = kwsysProcessFork(cp, si);
+ if(cp->ForkPIDs[prIndex] < 0)
+ {
+ return 0;
+ }
+
+ if(cp->ForkPIDs[prIndex] == 0)
+ {
+ /* Close the read end of the error reporting pipe. */
+ close(si->ErrorPipe[0]);
+
+ /* Setup the stdin, stdout, and stderr pipes. */
+ if(si->StdIn > 0)
+ {
+ dup2(si->StdIn, 0);
+ }
+ else if(si->StdIn < 0)
+ {
+ close(0);
+ }
+ if(si->StdOut != 1)
+ {
+ dup2(si->StdOut, 1);
+ }
+ if(si->StdErr != 2)
+ {
+ dup2(si->StdErr, 2);
+ }
+
+ /* Clear the close-on-exec flag for stdin, stdout, and stderr.
+ Also clear it for the termination pipe. All other pipe handles
+ will be closed when exec succeeds. */
+ fcntl(0, F_SETFD, 0);
+ fcntl(1, F_SETFD, 0);
+ fcntl(2, F_SETFD, 0);
+ fcntl(si->TermPipe, F_SETFD, 0);
+
+ /* Restore all default signal handlers. */
+ kwsysProcessRestoreDefaultSignalHandlers();
+
+ /* Execute the real process. If successful, this does not return. */
+ execvp(cp->Commands[prIndex][0], cp->Commands[prIndex]);
+
+ /* Failure. Report error to parent and terminate. */
+ kwsysProcessChildErrorExit(si->ErrorPipe[1]);
+ }
+
+ /* We are done with the error reporting pipe write end. */
+ kwsysProcessCleanupDescriptor(&si->ErrorPipe[1]);
+
+ /* Block until the child's exec call succeeds and closes the error
+ pipe or writes data to the pipe to report an error. */
+ {
+ int total = 0;
+ int n = 1;
+ /* Read the entire error message up to the length of our buffer. */
+ while(total < KWSYSPE_PIPE_BUFFER_SIZE && n > 0)
+ {
+ /* Keep trying to read until the operation is not interrupted. */
+ while(((n = read(si->ErrorPipe[0], cp->ErrorMessage+total,
+ KWSYSPE_PIPE_BUFFER_SIZE-total)) < 0) &&
+ (errno == EINTR));
+ if(n > 0)
+ {
+ total += n;
+ }
+ }
+
+ /* We are done with the error reporting pipe read end. */
+ kwsysProcessCleanupDescriptor(&si->ErrorPipe[0]);
+
+ if(total > 0)
+ {
+ /* The child failed to execute the process. */
+ return 0;
+ }
+ }
+
+ /* Successfully created this child process. */
+ if(prIndex > 0 || si->StdIn > 0)
+ {
+ /* The parent process does not need the input pipe read end. */
+ kwsysProcessCleanupDescriptor(&si->StdIn);
+ }
+
+ /* The parent process does not need the output pipe write ends. */
+ if(si->StdOut != 1)
+ {
+ kwsysProcessCleanupDescriptor(&si->StdOut);
+ }
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcessSetupOutputPipeFile(int* p, const char* name)
+{
+ int fout;
+ if(!name)
+ {
+ return 1;
+ }
+
+ /* Close the existing descriptor. */
+ kwsysProcessCleanupDescriptor(p);
+
+ /* Open a file for the pipe to write (permissions 644). */
+ if((fout = open(name, O_WRONLY | O_CREAT | O_TRUNC,
+ S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH)) < 0)
+ {
+ return 0;
+ }
+
+ /* Set close-on-exec flag on the pipe's end. */
+ if(fcntl(fout, F_SETFD, FD_CLOEXEC) < 0)
+ {
+ return 0;
+ }
+
+ /* Assign the replacement descriptor. */
+ *p = fout;
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Get the time at which either the process or user timeout will
+ expire. Returns 1 if the user timeout is first, and 0 otherwise. */
+static int kwsysProcessGetTimeoutTime(kwsysProcess* cp, double* userTimeout,
+ kwsysProcessTime* timeoutTime)
+{
+ /* The first time this is called, we need to calculate the time at
+ which the child will timeout. */
+ if(cp->Timeout && cp->TimeoutTime.tv_sec < 0)
+ {
+ kwsysProcessTime length = kwsysProcessTimeFromDouble(cp->Timeout);
+ cp->TimeoutTime = kwsysProcessTimeAdd(cp->StartTime, length);
+ }
+
+ /* Start with process timeout. */
+ *timeoutTime = cp->TimeoutTime;
+
+ /* Check if the user timeout is earlier. */
+ if(userTimeout)
+ {
+ kwsysProcessTime currentTime = kwsysProcessTimeGetCurrent();
+ kwsysProcessTime userTimeoutLength = kwsysProcessTimeFromDouble(*userTimeout);
+ kwsysProcessTime userTimeoutTime = kwsysProcessTimeAdd(currentTime,
+ userTimeoutLength);
+ if(timeoutTime->tv_sec < 0 ||
+ kwsysProcessTimeLess(userTimeoutTime, *timeoutTime))
+ {
+ *timeoutTime = userTimeoutTime;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Get the length of time before the given timeout time arrives.
+ Returns 1 if the time has already arrived, and 0 otherwise. */
+static int kwsysProcessGetTimeoutLeft(kwsysProcessTime* timeoutTime,
+ double* userTimeout,
+ kwsysProcessTimeNative* timeoutLength)
+{
+ if(timeoutTime->tv_sec < 0)
+ {
+ /* No timeout time has been requested. */
+ return 0;
+ }
+ else
+ {
+ /* Calculate the remaining time. */
+ kwsysProcessTime currentTime = kwsysProcessTimeGetCurrent();
+ kwsysProcessTime timeLeft = kwsysProcessTimeSubtract(*timeoutTime,
+ currentTime);
+ if(timeLeft.tv_sec < 0 && userTimeout && *userTimeout <= 0)
+ {
+ /* Caller has explicitly requested a zero timeout. */
+ timeLeft.tv_sec = 0;
+ timeLeft.tv_usec = 0;
+ }
+
+ if(timeLeft.tv_sec < 0)
+ {
+ /* Timeout has already expired. */
+ return 1;
+ }
+ else
+ {
+ /* There is some time left. */
+ timeoutLength->tv_sec = timeLeft.tv_sec;
+ timeoutLength->tv_usec = timeLeft.tv_usec;
+ return 0;
+ }
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static kwsysProcessTime kwsysProcessTimeGetCurrent(void)
+{
+ kwsysProcessTime current;
+ kwsysProcessTimeNative current_native;
+ gettimeofday(¤t_native, 0);
+ current.tv_sec = (long)current_native.tv_sec;
+ current.tv_usec = (long)current_native.tv_usec;
+ return current;
+}
+
+/*--------------------------------------------------------------------------*/
+static double kwsysProcessTimeToDouble(kwsysProcessTime t)
+{
+ return (double)t.tv_sec + t.tv_usec*0.000001;
+}
+
+/*--------------------------------------------------------------------------*/
+static kwsysProcessTime kwsysProcessTimeFromDouble(double d)
+{
+ kwsysProcessTime t;
+ t.tv_sec = (long)d;
+ t.tv_usec = (long)((d-t.tv_sec)*1000000);
+ return t;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcessTimeLess(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ return ((in1.tv_sec < in2.tv_sec) ||
+ ((in1.tv_sec == in2.tv_sec) && (in1.tv_usec < in2.tv_usec)));
+}
+
+/*--------------------------------------------------------------------------*/
+static kwsysProcessTime kwsysProcessTimeAdd(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ kwsysProcessTime out;
+ out.tv_sec = in1.tv_sec + in2.tv_sec;
+ out.tv_usec = in1.tv_usec + in2.tv_usec;
+ if(out.tv_usec > 1000000)
+ {
+ out.tv_usec -= 1000000;
+ out.tv_sec += 1;
+ }
+ return out;
+}
+
+/*--------------------------------------------------------------------------*/
+static kwsysProcessTime kwsysProcessTimeSubtract(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ kwsysProcessTime out;
+ out.tv_sec = in1.tv_sec - in2.tv_sec;
+ out.tv_usec = in1.tv_usec - in2.tv_usec;
+ if(out.tv_usec < 0)
+ {
+ out.tv_usec += 1000000;
+ out.tv_sec -= 1;
+ }
+ return out;
+}
+
+/*--------------------------------------------------------------------------*/
+#define KWSYSPE_CASE(type, str) \
+ cp->ExitException = kwsysProcess_Exception_##type; \
+ strcpy(cp->ExitExceptionString, str)
+static void kwsysProcessSetExitException(kwsysProcess* cp, int sig)
+{
+ switch (sig)
+ {
+#ifdef SIGSEGV
+ case SIGSEGV: KWSYSPE_CASE(Fault, "Segmentation fault"); break;
+#endif
+#ifdef SIGBUS
+# if !defined(SIGSEGV) || SIGBUS != SIGSEGV
+ case SIGBUS: KWSYSPE_CASE(Fault, "Bus error"); break;
+# endif
+#endif
+#ifdef SIGFPE
+ case SIGFPE: KWSYSPE_CASE(Numerical, "Floating-point exception"); break;
+#endif
+#ifdef SIGILL
+ case SIGILL: KWSYSPE_CASE(Illegal, "Illegal instruction"); break;
+#endif
+#ifdef SIGINT
+ case SIGINT: KWSYSPE_CASE(Interrupt, "User interrupt"); break;
+#endif
+#ifdef SIGABRT
+ case SIGABRT: KWSYSPE_CASE(Other, "Child aborted"); break;
+#endif
+#ifdef SIGKILL
+ case SIGKILL: KWSYSPE_CASE(Other, "Child killed"); break;
+#endif
+#ifdef SIGTERM
+ case SIGTERM: KWSYSPE_CASE(Other, "Child terminated"); break;
+#endif
+#ifdef SIGHUP
+ case SIGHUP: KWSYSPE_CASE(Other, "SIGHUP"); break;
+#endif
+#ifdef SIGQUIT
+ case SIGQUIT: KWSYSPE_CASE(Other, "SIGQUIT"); break;
+#endif
+#ifdef SIGTRAP
+ case SIGTRAP: KWSYSPE_CASE(Other, "SIGTRAP"); break;
+#endif
+#ifdef SIGIOT
+# if !defined(SIGABRT) || SIGIOT != SIGABRT
+ case SIGIOT: KWSYSPE_CASE(Other, "SIGIOT"); break;
+# endif
+#endif
+#ifdef SIGUSR1
+ case SIGUSR1: KWSYSPE_CASE(Other, "SIGUSR1"); break;
+#endif
+#ifdef SIGUSR2
+ case SIGUSR2: KWSYSPE_CASE(Other, "SIGUSR2"); break;
+#endif
+#ifdef SIGPIPE
+ case SIGPIPE: KWSYSPE_CASE(Other, "SIGPIPE"); break;
+#endif
+#ifdef SIGALRM
+ case SIGALRM: KWSYSPE_CASE(Other, "SIGALRM"); break;
+#endif
+#ifdef SIGSTKFLT
+ case SIGSTKFLT: KWSYSPE_CASE(Other, "SIGSTKFLT"); break;
+#endif
+#ifdef SIGCHLD
+ case SIGCHLD: KWSYSPE_CASE(Other, "SIGCHLD"); break;
+#elif defined(SIGCLD)
+ case SIGCLD: KWSYSPE_CASE(Other, "SIGCLD"); break;
+#endif
+#ifdef SIGCONT
+ case SIGCONT: KWSYSPE_CASE(Other, "SIGCONT"); break;
+#endif
+#ifdef SIGSTOP
+ case SIGSTOP: KWSYSPE_CASE(Other, "SIGSTOP"); break;
+#endif
+#ifdef SIGTSTP
+ case SIGTSTP: KWSYSPE_CASE(Other, "SIGTSTP"); break;
+#endif
+#ifdef SIGTTIN
+ case SIGTTIN: KWSYSPE_CASE(Other, "SIGTTIN"); break;
+#endif
+#ifdef SIGTTOU
+ case SIGTTOU: KWSYSPE_CASE(Other, "SIGTTOU"); break;
+#endif
+#ifdef SIGURG
+ case SIGURG: KWSYSPE_CASE(Other, "SIGURG"); break;
+#endif
+#ifdef SIGXCPU
+ case SIGXCPU: KWSYSPE_CASE(Other, "SIGXCPU"); break;
+#endif
+#ifdef SIGXFSZ
+ case SIGXFSZ: KWSYSPE_CASE(Other, "SIGXFSZ"); break;
+#endif
+#ifdef SIGVTALRM
+ case SIGVTALRM: KWSYSPE_CASE(Other, "SIGVTALRM"); break;
+#endif
+#ifdef SIGPROF
+ case SIGPROF: KWSYSPE_CASE(Other, "SIGPROF"); break;
+#endif
+#ifdef SIGWINCH
+ case SIGWINCH: KWSYSPE_CASE(Other, "SIGWINCH"); break;
+#endif
+#ifdef SIGPOLL
+ case SIGPOLL: KWSYSPE_CASE(Other, "SIGPOLL"); break;
+#endif
+#ifdef SIGIO
+# if !defined(SIGPOLL) || SIGIO != SIGPOLL
+ case SIGIO: KWSYSPE_CASE(Other, "SIGIO"); break;
+# endif
+#endif
+#ifdef SIGPWR
+ case SIGPWR: KWSYSPE_CASE(Other, "SIGPWR"); break;
+#endif
+#ifdef SIGSYS
+ case SIGSYS: KWSYSPE_CASE(Other, "SIGSYS"); break;
+#endif
+#ifdef SIGUNUSED
+# if !defined(SIGSYS) || SIGUNUSED != SIGSYS
+ case SIGUNUSED: KWSYSPE_CASE(Other, "SIGUNUSED"); break;
+# endif
+#endif
+ default:
+ cp->ExitException = kwsysProcess_Exception_Other;
+ sprintf(cp->ExitExceptionString, "Signal %d", sig);
+ break;
+ }
+}
+#undef KWSYSPE_CASE
+
+/*--------------------------------------------------------------------------*/
+/* When the child process encounters an error before its program is
+ invoked, this is called to report the error to the parent and
+ exit. */
+static void kwsysProcessChildErrorExit(int errorPipe)
+{
+ /* Construct the error message. */
+ char buffer[KWSYSPE_PIPE_BUFFER_SIZE];
+ strncpy(buffer, strerror(errno), KWSYSPE_PIPE_BUFFER_SIZE);
+
+ /* Report the error to the parent through the special pipe. */
+ write(errorPipe, buffer, strlen(buffer));
+
+ /* Terminate without cleanup. */
+ _exit(1);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Restores all signal handlers to their default values. */
+static void kwsysProcessRestoreDefaultSignalHandlers(void)
+{
+ struct sigaction act;
+ memset(&act, 0, sizeof(struct sigaction));
+ act.sa_handler = SIG_DFL;
+#ifdef SIGHUP
+ sigaction(SIGHUP, &act, 0);
+#endif
+#ifdef SIGINT
+ sigaction(SIGINT, &act, 0);
+#endif
+#ifdef SIGQUIT
+ sigaction(SIGQUIT, &act, 0);
+#endif
+#ifdef SIGILL
+ sigaction(SIGILL, &act, 0);
+#endif
+#ifdef SIGTRAP
+ sigaction(SIGTRAP, &act, 0);
+#endif
+#ifdef SIGABRT
+ sigaction(SIGABRT, &act, 0);
+#endif
+#ifdef SIGIOT
+ sigaction(SIGIOT, &act, 0);
+#endif
+#ifdef SIGBUS
+ sigaction(SIGBUS, &act, 0);
+#endif
+#ifdef SIGFPE
+ sigaction(SIGFPE, &act, 0);
+#endif
+#ifdef SIGUSR1
+ sigaction(SIGUSR1, &act, 0);
+#endif
+#ifdef SIGSEGV
+ sigaction(SIGSEGV, &act, 0);
+#endif
+#ifdef SIGUSR2
+ sigaction(SIGUSR2, &act, 0);
+#endif
+#ifdef SIGPIPE
+ sigaction(SIGPIPE, &act, 0);
+#endif
+#ifdef SIGALRM
+ sigaction(SIGALRM, &act, 0);
+#endif
+#ifdef SIGTERM
+ sigaction(SIGTERM, &act, 0);
+#endif
+#ifdef SIGSTKFLT
+ sigaction(SIGSTKFLT, &act, 0);
+#endif
+#ifdef SIGCLD
+ sigaction(SIGCLD, &act, 0);
+#endif
+#ifdef SIGCHLD
+ sigaction(SIGCHLD, &act, 0);
+#endif
+#ifdef SIGCONT
+ sigaction(SIGCONT, &act, 0);
+#endif
+#ifdef SIGTSTP
+ sigaction(SIGTSTP, &act, 0);
+#endif
+#ifdef SIGTTIN
+ sigaction(SIGTTIN, &act, 0);
+#endif
+#ifdef SIGTTOU
+ sigaction(SIGTTOU, &act, 0);
+#endif
+#ifdef SIGURG
+ sigaction(SIGURG, &act, 0);
+#endif
+#ifdef SIGXCPU
+ sigaction(SIGXCPU, &act, 0);
+#endif
+#ifdef SIGXFSZ
+ sigaction(SIGXFSZ, &act, 0);
+#endif
+#ifdef SIGVTALRM
+ sigaction(SIGVTALRM, &act, 0);
+#endif
+#ifdef SIGPROF
+ sigaction(SIGPROF, &act, 0);
+#endif
+#ifdef SIGWINCH
+ sigaction(SIGWINCH, &act, 0);
+#endif
+#ifdef SIGPOLL
+ sigaction(SIGPOLL, &act, 0);
+#endif
+#ifdef SIGIO
+ sigaction(SIGIO, &act, 0);
+#endif
+#ifdef SIGPWR
+ sigaction(SIGPWR, &act, 0);
+#endif
+#ifdef SIGSYS
+ sigaction(SIGSYS, &act, 0);
+#endif
+#ifdef SIGUNUSED
+ sigaction(SIGUNUSED, &act, 0);
+#endif
+}
+
+/*--------------------------------------------------------------------------*/
+static pid_t kwsysProcessFork(kwsysProcess* cp,
+ kwsysProcessCreateInformation* si)
+{
+ /* Create a detached process if requested. */
+ if(cp->OptionDetach)
+ {
+ /* Create an intermediate process. */
+ pid_t middle_pid = fork();
+ if(middle_pid < 0)
+ {
+ /* Fork failed. Return as if we were not detaching. */
+ return middle_pid;
+ }
+ else if(middle_pid == 0)
+ {
+ /* This is the intermediate process. Create the real child. */
+ pid_t child_pid = fork();
+ if(child_pid == 0)
+ {
+ /* This is the real child process. There is nothing to do here. */
+ return 0;
+ }
+ else
+ {
+ /* Use the error pipe to report the pid to the real parent. */
+ while((write(si->ErrorPipe[1], &child_pid, sizeof(child_pid)) < 0) &&
+ (errno == EINTR));
+
+ /* Exit without cleanup. The parent holds all resources. */
+ _exit(0);
+ return 0; /* Never reached, but avoids SunCC warning. */
+ }
+ }
+ else
+ {
+ /* This is the original parent process. The intermediate
+ process will use the error pipe to report the pid of the
+ detached child. */
+ pid_t child_pid;
+ int status;
+ while((read(si->ErrorPipe[0], &child_pid, sizeof(child_pid)) < 0) &&
+ (errno == EINTR));
+
+ /* Wait for the intermediate process to exit and clean it up. */
+ while((waitpid(middle_pid, &status, 0) < 0) && (errno == EINTR));
+ return child_pid;
+ }
+ }
+ else
+ {
+ /* Not creating a detached process. Use normal fork. */
+ return fork();
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* We try to obtain process information by invoking the ps command.
+ Here we define the command to call on each platform and the
+ corresponding parsing format string. The parsing format should
+ have two integers to store: the pid and then the ppid. */
+#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__)
+# define KWSYSPE_PS_COMMAND "ps axo pid,ppid"
+# define KWSYSPE_PS_FORMAT "%d %d\n"
+#elif defined(__hpux) || defined(__sparc) || defined(__sgi) || defined(_AIX)
+# define KWSYSPE_PS_COMMAND "ps -ef"
+# define KWSYSPE_PS_FORMAT "%*s %d %d %*[^\n]\n"
+#endif
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcessKill(pid_t process_id)
+{
+#if defined(__linux__)
+ DIR* procdir;
+#endif
+
+ /* Suspend the process to be sure it will not create more children. */
+ kill(process_id, SIGSTOP);
+
+ /* Kill all children if we can find them. */
+#if defined(__linux__)
+ /* First try using the /proc filesystem. */
+ if((procdir = opendir("/proc")) != NULL)
+ {
+#if defined(MAXPATHLEN)
+ char fname[MAXPATHLEN];
+#elif defined(PATH_MAX)
+ char fname[PATH_MAX];
+#else
+ char fname[4096];
+#endif
+ char buffer[KWSYSPE_PIPE_BUFFER_SIZE+1];
+ struct dirent* d;
+
+ /* Each process has a directory in /proc whose name is the pid.
+ Within this directory is a file called stat that has the
+ following format:
+
+ pid (command line) status ppid ...
+
+ We want to get the ppid for all processes. Those that have
+ process_id as their parent should be recursively killed. */
+ for(d = readdir(procdir); d; d = readdir(procdir))
+ {
+ int pid;
+ if(sscanf(d->d_name, "%d", &pid) == 1 && pid != 0)
+ {
+ struct stat finfo;
+ sprintf(fname, "/proc/%d/stat", pid);
+ if(stat(fname, &finfo) == 0)
+ {
+ FILE* f = fopen(fname, "r");
+ if(f)
+ {
+ int nread = fread(buffer, 1, KWSYSPE_PIPE_BUFFER_SIZE, f);
+ buffer[nread] = '\0';
+ if(nread > 0)
+ {
+ const char* rparen = strrchr(buffer, ')');
+ int ppid;
+ if(rparen && (sscanf(rparen+1, "%*s %d", &ppid) == 1))
+ {
+ if(ppid == process_id)
+ {
+ /* Recursively kill this child and its children. */
+ kwsysProcessKill(pid);
+ }
+ }
+ }
+ fclose(f);
+ }
+ }
+ }
+ }
+ closedir(procdir);
+ }
+ else
+#endif
+#if defined(KWSYSPE_PS_COMMAND)
+ {
+ /* Try running "ps" to get the process information. */
+ FILE* ps = popen(KWSYSPE_PS_COMMAND, "r");
+
+ /* Make sure the process started and provided a valid header. */
+ if(ps && fscanf(ps, "%*[^\n]\n") != EOF)
+ {
+ /* Look for processes whose parent is the process being killed. */
+ int pid, ppid;
+ while(fscanf(ps, KWSYSPE_PS_FORMAT, &pid, &ppid) == 2)
+ {
+ if(ppid == process_id)
+ {
+ /* Recursively kill this child aned its children. */
+ kwsysProcessKill(pid);
+ }
+ }
+ }
+
+ /* We are done with the ps process. */
+ if(ps)
+ {
+ pclose(ps);
+ }
+ }
+#endif
+
+ /* Kill the process. */
+ kill(process_id, SIGKILL);
+}
diff --git a/Utilities/ITK/Utilities/kwsys/ProcessWin32.c b/Utilities/ITK/Utilities/kwsys/ProcessWin32.c
new file mode 100644
index 0000000000000000000000000000000000000000..196057101839662f84a66ef44dd9c273b2bc53d8
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/ProcessWin32.c
@@ -0,0 +1,2812 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: ProcessWin32.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Process.h)
+
+/* Work-around CMake dependency scanning limitation. This must
+ duplicate the above list of headers. */
+#if 0
+# include "Process.h.in"
+#endif
+
+/*
+
+Implementation for Windows
+
+On windows, a thread is created to wait for data on each pipe. The
+threads are synchronized with the main thread to simulate the use of
+a UNIX-style select system call.
+
+On Windows9x platforms, a small WIN32 console application is spawned
+in-between the calling process and the actual child to be executed.
+This is to work-around a problem with connecting pipes from WIN16
+console applications to WIN32 applications.
+
+For more information, please check Microsoft Knowledge Base Articles
+Q190351 and Q150956.
+
+*/
+
+#ifdef _MSC_VER
+#pragma warning (push, 1)
+#endif
+#include <windows.h> /* Windows API */
+#include <string.h> /* strlen, strdup */
+#include <stdio.h> /* sprintf */
+#include <io.h> /* _unlink */
+#ifdef __WATCOMC__
+#define _unlink unlink
+#endif
+
+#ifndef _MAX_FNAME
+#define _MAX_FNAME 4096
+#endif
+#ifndef _MAX_PATH
+#define _MAX_PATH 4096
+#endif
+
+#ifdef _MSC_VER
+#pragma warning (pop)
+#pragma warning (disable: 4514)
+#pragma warning (disable: 4706)
+#endif
+
+#if defined(__BORLANDC__)
+# pragma warn -8060 /* Assignment inside if() condition. */
+#endif
+
+/* There are pipes for the process pipeline's stdout and stderr. */
+#define KWSYSPE_PIPE_COUNT 2
+#define KWSYSPE_PIPE_STDOUT 0
+#define KWSYSPE_PIPE_STDERR 1
+
+/* The maximum amount to read from a pipe at a time. */
+#define KWSYSPE_PIPE_BUFFER_SIZE 1024
+
+#define kwsysEncodedWriteArrayProcessFwd9x kwsys_ns(EncodedWriteArrayProcessFwd9x)
+
+typedef LARGE_INTEGER kwsysProcessTime;
+
+typedef struct kwsysProcessCreateInformation_s
+{
+ /* Windows child startup control data. */
+ STARTUPINFO StartupInfo;
+
+ /* Special error reporting pipe for Win9x forwarding executable. */
+ HANDLE ErrorPipeRead;
+ HANDLE ErrorPipeWrite;
+} kwsysProcessCreateInformation;
+
+/*--------------------------------------------------------------------------*/
+typedef struct kwsysProcessPipeData_s kwsysProcessPipeData;
+static DWORD WINAPI kwsysProcessPipeThreadRead(LPVOID ptd);
+static void kwsysProcessPipeThreadReadPipe(kwsysProcess* cp,
+ kwsysProcessPipeData* td);
+static DWORD WINAPI kwsysProcessPipeThreadWake(LPVOID ptd);
+static void kwsysProcessPipeThreadWakePipe(kwsysProcess* cp,
+ kwsysProcessPipeData* td);
+static int kwsysProcessInitialize(kwsysProcess* cp);
+static int kwsysProcessCreate(kwsysProcess* cp, int index,
+ kwsysProcessCreateInformation* si,
+ PHANDLE readEnd);
+static void kwsysProcessDestroy(kwsysProcess* cp, int event);
+static int kwsysProcessSetupOutputPipeFile(PHANDLE handle, const char* name);
+static int kwsysProcessSetupSharedPipe(DWORD nStdHandle, PHANDLE handle);
+static void kwsysProcessCleanupHandle(PHANDLE h);
+static void kwsysProcessCleanup(kwsysProcess* cp, int error);
+static void kwsysProcessCleanErrorMessage(kwsysProcess* cp);
+static int kwsysProcessGetTimeoutTime(kwsysProcess* cp, double* userTimeout,
+ kwsysProcessTime* timeoutTime);
+static int kwsysProcessGetTimeoutLeft(kwsysProcessTime* timeoutTime,
+ double* userTimeout,
+ kwsysProcessTime* timeoutLength);
+static kwsysProcessTime kwsysProcessTimeGetCurrent(void);
+static DWORD kwsysProcessTimeToDWORD(kwsysProcessTime t);
+static double kwsysProcessTimeToDouble(kwsysProcessTime t);
+static kwsysProcessTime kwsysProcessTimeFromDouble(double d);
+static int kwsysProcessTimeLess(kwsysProcessTime in1, kwsysProcessTime in2);
+static kwsysProcessTime kwsysProcessTimeAdd(kwsysProcessTime in1, kwsysProcessTime in2);
+static kwsysProcessTime kwsysProcessTimeSubtract(kwsysProcessTime in1, kwsysProcessTime in2);
+static void kwsysProcessSetExitException(kwsysProcess* cp, int code);
+static void kwsysProcessKillTree(int pid);
+static void kwsysProcessDisablePipeThreads(kwsysProcess* cp);
+extern kwsysEXPORT int kwsysEncodedWriteArrayProcessFwd9x(const char* fname);
+
+/*--------------------------------------------------------------------------*/
+/* A structure containing synchronization data for each thread. */
+typedef struct kwsysProcessPipeSync_s kwsysProcessPipeSync;
+struct kwsysProcessPipeSync_s
+{
+ /* Handle to the thread. */
+ HANDLE Thread;
+
+ /* Semaphore indicating to the thread that a process has started. */
+ HANDLE Ready;
+
+ /* Semaphore indicating to the thread that it should begin work. */
+ HANDLE Go;
+
+ /* Semaphore indicating thread has reset for another process. */
+ HANDLE Reset;
+};
+
+/*--------------------------------------------------------------------------*/
+/* A structure containing data for each pipe's threads. */
+struct kwsysProcessPipeData_s
+{
+ /* ------------- Data managed per instance of kwsysProcess ------------- */
+
+ /* Synchronization data for reading thread. */
+ kwsysProcessPipeSync Reader;
+
+ /* Synchronization data for waking thread. */
+ kwsysProcessPipeSync Waker;
+
+ /* Index of this pipe. */
+ int Index;
+
+ /* The kwsysProcess instance owning this pipe. */
+ kwsysProcess* Process;
+
+ /* ------------- Data managed per call to Execute ------------- */
+
+ /* Buffer for data read in this pipe's thread. */
+ char DataBuffer[KWSYSPE_PIPE_BUFFER_SIZE];
+
+ /* The length of the data stored in the buffer. */
+ DWORD DataLength;
+
+ /* Whether the pipe has been closed. */
+ int Closed;
+
+ /* Handle for the read end of this pipe. */
+ HANDLE Read;
+
+ /* Handle for the write end of this pipe. */
+ HANDLE Write;
+};
+
+/*--------------------------------------------------------------------------*/
+/* Structure containing data used to implement the child's execution. */
+struct kwsysProcess_s
+{
+ /* ------------- Data managed per instance of kwsysProcess ------------- */
+
+ /* The status of the process structure. */
+ int State;
+
+ /* The command lines to execute. */
+ char** Commands;
+ int NumberOfCommands;
+
+ /* The exit code of each command. */
+ DWORD* CommandExitCodes;
+
+ /* The working directory for the child process. */
+ char* WorkingDirectory;
+
+ /* Whether to create the child as a detached process. */
+ int OptionDetach;
+
+ /* Whether the child was created as a detached process. */
+ int Detached;
+
+ /* Whether to hide the child process's window. */
+ int HideWindow;
+
+ /* On Win9x platforms, the path to the forwarding executable. */
+ char* Win9x;
+
+ /* On Win9x platforms, the resume event for the forwarding executable. */
+ HANDLE Win9xResumeEvent;
+
+ /* On Win9x platforms, the kill event for the forwarding executable. */
+ HANDLE Win9xKillEvent;
+
+ /* Mutex to protect the shared index used by threads to report data. */
+ HANDLE SharedIndexMutex;
+
+ /* Semaphore used by threads to signal data ready. */
+ HANDLE Full;
+
+ /* Whether we are currently deleting this kwsysProcess instance. */
+ int Deleting;
+
+ /* Data specific to each pipe and its thread. */
+ kwsysProcessPipeData Pipe[KWSYSPE_PIPE_COUNT];
+
+ /* Name of files to which stdin and stdout pipes are attached. */
+ char* PipeFileSTDIN;
+ char* PipeFileSTDOUT;
+ char* PipeFileSTDERR;
+
+ /* Whether each pipe is shared with the parent process. */
+ int PipeSharedSTDIN;
+ int PipeSharedSTDOUT;
+ int PipeSharedSTDERR;
+
+ /* Handle to automatically delete the Win9x forwarding executable. */
+ HANDLE Win9xHandle;
+
+ /* ------------- Data managed per call to Execute ------------- */
+
+ /* The exceptional behavior that terminated the process, if any. */
+ int ExitException;
+
+ /* The process exit code. */
+ DWORD ExitCode;
+
+ /* The process return code, if any. */
+ int ExitValue;
+
+ /* Index of last pipe to report data, if any. */
+ int CurrentIndex;
+
+ /* Index shared by threads to report data. */
+ int SharedIndex;
+
+ /* The timeout length. */
+ double Timeout;
+
+ /* Time at which the child started. */
+ kwsysProcessTime StartTime;
+
+ /* Time at which the child will timeout. Negative for no timeout. */
+ kwsysProcessTime TimeoutTime;
+
+ /* Flag for whether the process was killed. */
+ int Killed;
+
+ /* Flag for whether the timeout expired. */
+ int TimeoutExpired;
+
+ /* Flag for whether the process has terminated. */
+ int Terminated;
+
+ /* The number of pipes still open during execution and while waiting
+ for pipes to close after process termination. */
+ int PipesLeft;
+
+ /* Buffer for error messages (possibly from Win9x child). */
+ char ErrorMessage[KWSYSPE_PIPE_BUFFER_SIZE+1];
+
+ /* Description for the ExitException. */
+ char ExitExceptionString[KWSYSPE_PIPE_BUFFER_SIZE+1];
+
+ /* Windows process information data. */
+ PROCESS_INFORMATION* ProcessInformation;
+
+ /* Data and process termination events for which to wait. */
+ PHANDLE ProcessEvents;
+ int ProcessEventsLength;
+
+ /* Real working directory of our own process. */
+ DWORD RealWorkingDirectoryLength;
+ char* RealWorkingDirectory;
+};
+
+/*--------------------------------------------------------------------------*/
+kwsysProcess* kwsysProcess_New(void)
+{
+ int i;
+
+ /* Process control structure. */
+ kwsysProcess* cp;
+
+ /* Path to Win9x forwarding executable. */
+ char* win9x = 0;
+
+ /* Windows version number data. */
+ OSVERSIONINFO osv;
+
+ /* Allocate a process control structure. */
+ cp = (kwsysProcess*)malloc(sizeof(kwsysProcess));
+ if(!cp)
+ {
+ /* Could not allocate memory for the control structure. */
+ return 0;
+ }
+ ZeroMemory(cp, sizeof(*cp));
+
+ /* Share stdin with the parent process by default. */
+ cp->PipeSharedSTDIN = 1;
+
+ /* Set initial status. */
+ cp->State = kwsysProcess_State_Starting;
+
+ /* Choose a method of running the child based on version of
+ windows. */
+ ZeroMemory(&osv, sizeof(osv));
+ osv.dwOSVersionInfoSize = sizeof(osv);
+ GetVersionEx(&osv);
+ if(osv.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS)
+ {
+ /* This is Win9x. We need the console forwarding executable to
+ work-around a Windows 9x bug. */
+ char fwdName[_MAX_FNAME+1] = "";
+ char tempDir[_MAX_PATH+1] = "";
+
+ /* We will try putting the executable in the system temp
+ directory. Note that the returned path already has a trailing
+ slash. */
+ DWORD length = GetTempPath(_MAX_PATH+1, tempDir);
+
+ /* Construct the executable name from the process id and kwsysProcess
+ instance. This should be unique. */
+ sprintf(fwdName, KWSYS_NAMESPACE_STRING "pew9xfwd_%u_%p.exe",
+ GetCurrentProcessId(), cp);
+
+ /* If we have a temp directory, use it. */
+ if(length > 0 && length <= _MAX_PATH)
+ {
+ /* Allocate a buffer to hold the forwarding executable path. */
+ size_t tdlen = strlen(tempDir);
+ win9x = (char*)malloc(tdlen + strlen(fwdName) + 2);
+ if(!win9x)
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Construct the full path to the forwarding executable. */
+ sprintf(win9x, "%s%s", tempDir, fwdName);
+ }
+
+ /* If we found a place to put the forwarding executable, try to
+ write it. */
+ if(win9x)
+ {
+ if(!kwsysEncodedWriteArrayProcessFwd9x(win9x))
+ {
+ /* Failed to create forwarding executable. Give up. */
+ free(win9x);
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Get a handle to the file that will delete it when closed. */
+ cp->Win9xHandle = CreateFile(win9x, GENERIC_READ, FILE_SHARE_READ, 0,
+ OPEN_EXISTING, FILE_FLAG_DELETE_ON_CLOSE, 0);
+ if(cp->Win9xHandle == INVALID_HANDLE_VALUE)
+ {
+ /* We were not able to get a read handle for the forwarding
+ executable. It will not be deleted properly. Give up. */
+ _unlink(win9x);
+ free(win9x);
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+ }
+ else
+ {
+ /* Failed to find a place to put forwarding executable. */
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+ }
+
+ /* Save the path to the forwarding executable. */
+ cp->Win9x = win9x;
+
+ /* Initially no thread owns the mutex. Initialize semaphore to 1. */
+ if(!(cp->SharedIndexMutex = CreateSemaphore(0, 1, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Initially no data are available. Initialize semaphore to 0. */
+ if(!(cp->Full = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ if(cp->Win9x)
+ {
+ SECURITY_ATTRIBUTES sa;
+ ZeroMemory(&sa, sizeof(sa));
+ sa.nLength = sizeof(sa);
+ sa.bInheritHandle = TRUE;
+
+ /* Create an event to tell the forwarding executable to resume the
+ child. */
+ if(!(cp->Win9xResumeEvent = CreateEvent(&sa, TRUE, 0, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Create an event to tell the forwarding executable to kill the
+ child. */
+ if(!(cp->Win9xKillEvent = CreateEvent(&sa, TRUE, 0, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+ }
+
+ /* Create the thread to read each pipe. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ DWORD dummy=0;
+
+ /* Assign the thread its index. */
+ cp->Pipe[i].Index = i;
+
+ /* Give the thread a pointer back to the kwsysProcess instance. */
+ cp->Pipe[i].Process = cp;
+
+ /* No process is yet running. Initialize semaphore to 0. */
+ if(!(cp->Pipe[i].Reader.Ready = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* The pipe is not yet reset. Initialize semaphore to 0. */
+ if(!(cp->Pipe[i].Reader.Reset = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* The thread's buffer is initially empty. Initialize semaphore to 1. */
+ if(!(cp->Pipe[i].Reader.Go = CreateSemaphore(0, 1, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Create the reading thread. It will block immediately. The
+ thread will not make deeply nested calls, so we need only a
+ small stack. */
+ if(!(cp->Pipe[i].Reader.Thread = CreateThread(0, 1024,
+ kwsysProcessPipeThreadRead,
+ &cp->Pipe[i], 0, &dummy)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* No process is yet running. Initialize semaphore to 0. */
+ if(!(cp->Pipe[i].Waker.Ready = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* The pipe is not yet reset. Initialize semaphore to 0. */
+ if(!(cp->Pipe[i].Waker.Reset = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* The waker should not wake immediately. Initialize semaphore to 0. */
+ if(!(cp->Pipe[i].Waker.Go = CreateSemaphore(0, 0, 1, 0)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+
+ /* Create the waking thread. It will block immediately. The
+ thread will not make deeply nested calls, so we need only a
+ small stack. */
+ if(!(cp->Pipe[i].Waker.Thread = CreateThread(0, 1024,
+ kwsysProcessPipeThreadWake,
+ &cp->Pipe[i], 0, &dummy)))
+ {
+ kwsysProcess_Delete(cp);
+ return 0;
+ }
+ }
+
+ return cp;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Delete(kwsysProcess* cp)
+{
+ int i;
+
+ /* Make sure we have an instance. */
+ if(!cp)
+ {
+ return;
+ }
+
+ /* If the process is executing, wait for it to finish. */
+ if(cp->State == kwsysProcess_State_Executing)
+ {
+ if(cp->Detached)
+ {
+ kwsysProcess_Disown(cp);
+ }
+ else
+ {
+ kwsysProcess_WaitForExit(cp, 0);
+ }
+ }
+
+ /* We are deleting the kwsysProcess instance. */
+ cp->Deleting = 1;
+
+ /* Terminate each of the threads. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ /* Terminate this reading thread. */
+ if(cp->Pipe[i].Reader.Thread)
+ {
+ /* Signal the thread we are ready for it. It will terminate
+ immediately since Deleting is set. */
+ ReleaseSemaphore(cp->Pipe[i].Reader.Ready, 1, 0);
+
+ /* Wait for the thread to exit. */
+ WaitForSingleObject(cp->Pipe[i].Reader.Thread, INFINITE);
+
+ /* Close the handle to the thread. */
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Reader.Thread);
+ }
+
+ /* Terminate this waking thread. */
+ if(cp->Pipe[i].Waker.Thread)
+ {
+ /* Signal the thread we are ready for it. It will terminate
+ immediately since Deleting is set. */
+ ReleaseSemaphore(cp->Pipe[i].Waker.Ready, 1, 0);
+
+ /* Wait for the thread to exit. */
+ WaitForSingleObject(cp->Pipe[i].Waker.Thread, INFINITE);
+
+ /* Close the handle to the thread. */
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Waker.Thread);
+ }
+
+ /* Cleanup the pipe's semaphores. */
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Reader.Ready);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Reader.Go);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Reader.Reset);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Waker.Ready);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Waker.Go);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Waker.Reset);
+ }
+
+ /* Close the shared semaphores. */
+ kwsysProcessCleanupHandle(&cp->SharedIndexMutex);
+ kwsysProcessCleanupHandle(&cp->Full);
+
+ /* Close the Win9x resume and kill event handles. */
+ if(cp->Win9x)
+ {
+ kwsysProcessCleanupHandle(&cp->Win9xResumeEvent);
+ kwsysProcessCleanupHandle(&cp->Win9xKillEvent);
+ }
+
+ /* Free memory. */
+ kwsysProcess_SetCommand(cp, 0);
+ kwsysProcess_SetWorkingDirectory(cp, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDIN, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDOUT, 0);
+ kwsysProcess_SetPipeFile(cp, kwsysProcess_Pipe_STDERR, 0);
+ if(cp->CommandExitCodes)
+ {
+ free(cp->CommandExitCodes);
+ }
+ if(cp->Win9x)
+ {
+ /* Close our handle to the forwarding executable file. This will
+ cause it to be deleted. */
+ kwsysProcessCleanupHandle(&cp->Win9xHandle);
+ }
+ free(cp);
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetCommand(kwsysProcess* cp, char const* const* command)
+{
+ int i;
+ if(!cp)
+ {
+ return 0;
+ }
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ free(cp->Commands[i]);
+ }
+ cp->NumberOfCommands = 0;
+ if(cp->Commands)
+ {
+ free(cp->Commands);
+ cp->Commands = 0;
+ }
+ if(command)
+ {
+ return kwsysProcess_AddCommand(cp, command);
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_AddCommand(kwsysProcess* cp, char const* const* command)
+{
+ int newNumberOfCommands;
+ char** newCommands;
+
+ /* Make sure we have a command to add. */
+ if(!cp || !command)
+ {
+ return 0;
+ }
+
+ /* Allocate a new array for command pointers. */
+ newNumberOfCommands = cp->NumberOfCommands + 1;
+ if(!(newCommands = (char**)malloc(sizeof(char*) * newNumberOfCommands)))
+ {
+ /* Out of memory. */
+ return 0;
+ }
+
+ /* Copy any existing commands into the new array. */
+ {
+ int i;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ newCommands[i] = cp->Commands[i];
+ }
+ }
+
+ /* We need to construct a single string representing the command
+ and its arguments. We will surround each argument containing
+ spaces with double-quotes. Inside a double-quoted argument, we
+ need to escape double-quotes and all backslashes before them.
+ We also need to escape backslashes at the end of an argument
+ because they come before the closing double-quote for the
+ argument. */
+ {
+ char* cmd;
+ char const* const* arg;
+ int length = 0;
+ /* First determine the length of the final string. */
+ for(arg = command; *arg; ++arg)
+ {
+ /* Keep track of how many backslashes have been encountered in a
+ row in this argument. */
+ int backslashes = 0;
+ int spaces = 0;
+ const char* c;
+
+ /* Scan the string for spaces. If there are no spaces, we can
+ pass the argument verbatim. */
+ for(c=*arg; *c; ++c)
+ {
+ if(*c == ' ' || *c == '\t')
+ {
+ spaces = 1;
+ break;
+ }
+ }
+
+ /* Add the length of the argument, plus 1 for the space
+ separating the arguments. */
+ length += (int)strlen(*arg) + 1;
+
+ if(spaces)
+ {
+ /* Add 2 for double quotes since spaces are present. */
+ length += 2;
+
+ /* Scan the string to find characters that need escaping. */
+ for(c=*arg; *c; ++c)
+ {
+ if(*c == '\\')
+ {
+ /* Found a backslash. It may need to be escaped later. */
+ ++backslashes;
+ }
+ else if(*c == '"')
+ {
+ /* Found a double-quote. We need to escape it and all
+ immediately preceding backslashes. */
+ length += backslashes + 1;
+ backslashes = 0;
+ }
+ else
+ {
+ /* Found another character. This eliminates the possibility
+ that any immediately preceding backslashes will be
+ escaped. */
+ backslashes = 0;
+ }
+ }
+
+ /* We need to escape all ending backslashes. */
+ length += backslashes;
+ }
+ }
+
+ /* Allocate enough space for the command. We do not need an extra
+ byte for the terminating null because we allocated a space for
+ the first argument that we will not use. */
+ newCommands[cp->NumberOfCommands] = (char*)malloc(length);
+ if(!newCommands[cp->NumberOfCommands])
+ {
+ /* Out of memory. */
+ free(newCommands);
+ return 0;
+ }
+
+ /* Construct the command line in the allocated buffer. */
+ cmd = newCommands[cp->NumberOfCommands];
+ for(arg = command; *arg; ++arg)
+ {
+ /* Keep track of how many backslashes have been encountered in a
+ row in an argument. */
+ int backslashes = 0;
+ int spaces = 0;
+ const char* c;
+
+ /* Scan the string for spaces. If there are no spaces, we can
+ pass the argument verbatim. */
+ for(c=*arg; *c; ++c)
+ {
+ if(*c == ' ' || *c == '\t')
+ {
+ spaces = 1;
+ break;
+ }
+ }
+
+ /* Add the separating space if this is not the first argument. */
+ if(arg != command)
+ {
+ *cmd++ = ' ';
+ }
+
+ if(spaces)
+ {
+ /* Add the opening double-quote for this argument. */
+ *cmd++ = '"';
+
+ /* Add the characters of the argument, possibly escaping them. */
+ for(c=*arg; *c; ++c)
+ {
+ if(*c == '\\')
+ {
+ /* Found a backslash. It may need to be escaped later. */
+ ++backslashes;
+ *cmd++ = '\\';
+ }
+ else if(*c == '"')
+ {
+ /* Add enough backslashes to escape any that preceded the
+ double-quote. */
+ while(backslashes > 0)
+ {
+ --backslashes;
+ *cmd++ = '\\';
+ }
+
+ /* Add the backslash to escape the double-quote. */
+ *cmd++ = '\\';
+
+ /* Add the double-quote itself. */
+ *cmd++ = '"';
+ }
+ else
+ {
+ /* We encountered a normal character. This eliminates any
+ escaping needed for preceding backslashes. Add the
+ character. */
+ backslashes = 0;
+ *cmd++ = *c;
+ }
+ }
+
+ /* Add enough backslashes to escape any trailing ones. */
+ while(backslashes > 0)
+ {
+ --backslashes;
+ *cmd++ = '\\';
+ }
+
+ /* Add the closing double-quote for this argument. */
+ *cmd++ = '"';
+ }
+ else
+ {
+ /* No spaces. Add the argument verbatim. */
+ for(c=*arg; *c; ++c)
+ {
+ *cmd++ = *c;
+ }
+ }
+ }
+
+ /* Add the terminating null character to the command line. */
+ *cmd = 0;
+ }
+
+ /* Save the new array of commands. */
+ free(cp->Commands);
+ cp->Commands = newCommands;
+ cp->NumberOfCommands = newNumberOfCommands;
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetTimeout(kwsysProcess* cp, double timeout)
+{
+ if(!cp)
+ {
+ return;
+ }
+ cp->Timeout = timeout;
+ if(cp->Timeout < 0)
+ {
+ cp->Timeout = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetWorkingDirectory(kwsysProcess* cp, const char* dir)
+{
+ if(!cp)
+ {
+ return 0;
+ }
+ if(cp->WorkingDirectory)
+ {
+ free(cp->WorkingDirectory);
+ cp->WorkingDirectory = 0;
+ }
+ if(dir && dir[0])
+ {
+ /* We must convert the working directory to a full path. */
+ DWORD length = GetFullPathName(dir, 0, 0, 0);
+ if(length > 0)
+ {
+ cp->WorkingDirectory = (char*)malloc(length);
+ if(!cp->WorkingDirectory)
+ {
+ return 0;
+ }
+ if(!GetFullPathName(dir, length, cp->WorkingDirectory, 0))
+ {
+ free(cp->WorkingDirectory);
+ cp->WorkingDirectory = 0;
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_SetPipeFile(kwsysProcess* cp, int pipe, const char* file)
+{
+ char** pfile;
+ if(!cp)
+ {
+ return 0;
+ }
+ switch(pipe)
+ {
+ case kwsysProcess_Pipe_STDIN: pfile = &cp->PipeFileSTDIN; break;
+ case kwsysProcess_Pipe_STDOUT: pfile = &cp->PipeFileSTDOUT; break;
+ case kwsysProcess_Pipe_STDERR: pfile = &cp->PipeFileSTDERR; break;
+ default: return 0;
+ }
+ if(*pfile)
+ {
+ free(*pfile);
+ *pfile = 0;
+ }
+ if(file)
+ {
+ *pfile = malloc(strlen(file)+1);
+ if(!*pfile)
+ {
+ return 0;
+ }
+ strcpy(*pfile, file);
+ }
+
+ /* If we are redirecting the pipe, do not share it. */
+ if(*pfile)
+ {
+ kwsysProcess_SetPipeShared(cp, pipe, 0);
+ }
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetPipeShared(kwsysProcess* cp, int pipe, int shared)
+{
+ if(!cp)
+ {
+ return;
+ }
+
+ switch(pipe)
+ {
+ case kwsysProcess_Pipe_STDIN: cp->PipeSharedSTDIN = shared?1:0; break;
+ case kwsysProcess_Pipe_STDOUT: cp->PipeSharedSTDOUT = shared?1:0; break;
+ case kwsysProcess_Pipe_STDERR: cp->PipeSharedSTDERR = shared?1:0; break;
+ default: return;
+ }
+
+ /* If we are sharing the pipe, do not redirect it to a file. */
+ if(shared)
+ {
+ kwsysProcess_SetPipeFile(cp, pipe, 0);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetOption(kwsysProcess* cp, int optionId)
+{
+ if(!cp)
+ {
+ return 0;
+ }
+
+ switch(optionId)
+ {
+ case kwsysProcess_Option_Detach: return cp->OptionDetach;
+ case kwsysProcess_Option_HideWindow: return cp->HideWindow;
+ default: return 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_SetOption(kwsysProcess* cp, int optionId, int value)
+{
+ if(!cp)
+ {
+ return;
+ }
+
+ switch(optionId)
+ {
+ case kwsysProcess_Option_Detach: cp->OptionDetach = value; break;
+ case kwsysProcess_Option_HideWindow: cp->HideWindow = value; break;
+ default: break;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetState(kwsysProcess* cp)
+{
+ return cp? cp->State : kwsysProcess_State_Error;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitException(kwsysProcess* cp)
+{
+ return cp? cp->ExitException : kwsysProcess_Exception_Other;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitValue(kwsysProcess* cp)
+{
+ return cp? cp->ExitValue : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_GetExitCode(kwsysProcess* cp)
+{
+ return cp? cp->ExitCode : 0;
+}
+
+/*--------------------------------------------------------------------------*/
+const char* kwsysProcess_GetErrorString(kwsysProcess* cp)
+{
+ if(!cp)
+ {
+ return "Process management structure could not be allocated";
+ }
+ else if(cp->State == kwsysProcess_State_Error)
+ {
+ return cp->ErrorMessage;
+ }
+ return "Success";
+}
+
+/*--------------------------------------------------------------------------*/
+const char* kwsysProcess_GetExceptionString(kwsysProcess* cp)
+{
+ if(!cp)
+ {
+ return "GetExceptionString called with NULL process management structure";
+ }
+ else if(cp->State == kwsysProcess_State_Exception)
+ {
+ return cp->ExitExceptionString;
+ }
+ return "No exception";
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Execute(kwsysProcess* cp)
+{
+ int i;
+
+ /* Child startup control data. */
+ kwsysProcessCreateInformation si;
+
+ /* Do not execute a second time. */
+ if(!cp || cp->State == kwsysProcess_State_Executing)
+ {
+ return;
+ }
+
+ /* Initialize the control structure for a new process. */
+ if(!kwsysProcessInitialize(cp))
+ {
+ strcpy(cp->ErrorMessage, "Out of memory");
+ cp->State = kwsysProcess_State_Error;
+ return;
+ }
+
+ /* Save the real working directory of this process and change to
+ the working directory for the child processes. This is needed
+ to make pipe file paths evaluate correctly. */
+ if(cp->WorkingDirectory)
+ {
+ if(!GetCurrentDirectory(cp->RealWorkingDirectoryLength,
+ cp->RealWorkingDirectory))
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+ SetCurrentDirectory(cp->WorkingDirectory);
+ }
+
+ /* Reset the Win9x resume and kill events. */
+ if(cp->Win9x)
+ {
+ if(!ResetEvent(cp->Win9xResumeEvent))
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+ if(!ResetEvent(cp->Win9xKillEvent))
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+ }
+
+ /* Initialize startup info data. */
+ ZeroMemory(&si, sizeof(si));
+ si.StartupInfo.cb = sizeof(si.StartupInfo);
+
+ /* Decide whether a child window should be shown. */
+ si.StartupInfo.dwFlags |= STARTF_USESHOWWINDOW;
+ si.StartupInfo.wShowWindow =
+ (unsigned short)(cp->HideWindow?SW_HIDE:SW_SHOWDEFAULT);
+
+ /* Connect the child's output pipes to the threads. */
+ si.StartupInfo.dwFlags |= STARTF_USESTDHANDLES;
+
+ /* Create stderr pipe to be shared by all processes in the pipeline.
+ Neither end is directly inherited. */
+ if(!CreatePipe(&cp->Pipe[KWSYSPE_PIPE_STDERR].Read,
+ &cp->Pipe[KWSYSPE_PIPE_STDERR].Write, 0, 0))
+ {
+ kwsysProcessCleanup(cp, 1);
+ return;
+ }
+
+ /* Create an inherited duplicate of the write end, but do not
+ close the non-inherited version. We need to keep it open
+ to use in waking up the pipe threads. */
+ if(!DuplicateHandle(GetCurrentProcess(), cp->Pipe[KWSYSPE_PIPE_STDERR].Write,
+ GetCurrentProcess(), &si.StartupInfo.hStdError,
+ 0, TRUE, DUPLICATE_SAME_ACCESS))
+ {
+ kwsysProcessCleanup(cp, 1);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdError);
+ return;
+ }
+
+ /* Replace the stderr pipe with a file if requested. In this case
+ the pipe thread will still run but never report data. */
+ if(cp->PipeFileSTDERR)
+ {
+ if(!kwsysProcessSetupOutputPipeFile(&si.StartupInfo.hStdError,
+ cp->PipeFileSTDERR))
+ {
+ kwsysProcessCleanup(cp, 1);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdError);
+ return;
+ }
+ }
+
+ /* Replace the stderr pipe with the parent process's if requested.
+ In this case the pipe thread will still run but never report
+ data. */
+ if(cp->PipeSharedSTDERR)
+ {
+ if(!kwsysProcessSetupSharedPipe(STD_ERROR_HANDLE,
+ &si.StartupInfo.hStdError))
+ {
+ kwsysProcessCleanup(cp, 1);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdError);
+ return;
+ }
+ }
+
+ /* Create the pipeline of processes. */
+ {
+ HANDLE readEnd = 0;
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ if(kwsysProcessCreate(cp, i, &si, &readEnd))
+ {
+ cp->ProcessEvents[i+1] = cp->ProcessInformation[i].hProcess;
+ }
+ else
+ {
+ kwsysProcessCleanup(cp, 1);
+
+ /* Release resources that may have been allocated for this
+ process before an error occurred. */
+ kwsysProcessCleanupHandle(&readEnd);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdInput);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdOutput);
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdError);
+ kwsysProcessCleanupHandle(&si.ErrorPipeRead);
+ kwsysProcessCleanupHandle(&si.ErrorPipeWrite);
+ return;
+ }
+ }
+
+ /* Save a handle to the output pipe for the last process. */
+ cp->Pipe[KWSYSPE_PIPE_STDOUT].Read = readEnd;
+ }
+
+ /* Close the inherited handles to the stderr pipe shared by all
+ processes in the pipeline. The stdout and stdin pipes are not
+ shared among all children and are therefore closed by
+ kwsysProcessCreate after each child is created. */
+ kwsysProcessCleanupHandle(&si.StartupInfo.hStdError);
+
+ /* Restore the working directory. */
+ if(cp->RealWorkingDirectory)
+ {
+ SetCurrentDirectory(cp->RealWorkingDirectory);
+ free(cp->RealWorkingDirectory);
+ cp->RealWorkingDirectory = 0;
+ }
+
+ /* The timeout period starts now. */
+ cp->StartTime = kwsysProcessTimeGetCurrent();
+ cp->TimeoutTime = kwsysProcessTimeFromDouble(-1);
+
+ /* All processes in the pipeline have been started in suspended
+ mode. Resume them all now. */
+ if(cp->Win9x)
+ {
+ SetEvent(cp->Win9xResumeEvent);
+ }
+ else
+ {
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ ResumeThread(cp->ProcessInformation[i].hThread);
+ }
+ }
+
+ /* ---- It is no longer safe to call kwsysProcessCleanup. ----- */
+ /* Tell the pipe threads that a process has started. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ ReleaseSemaphore(cp->Pipe[i].Reader.Ready, 1, 0);
+ ReleaseSemaphore(cp->Pipe[i].Waker.Ready, 1, 0);
+ }
+
+ /* We don't care about the children's main threads. */
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[i].hThread);
+ }
+
+ /* No pipe has reported data. */
+ cp->CurrentIndex = KWSYSPE_PIPE_COUNT;
+ cp->PipesLeft = KWSYSPE_PIPE_COUNT;
+
+ /* The process has now started. */
+ cp->State = kwsysProcess_State_Executing;
+ cp->Detached = cp->OptionDetach;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Disown(kwsysProcess* cp)
+{
+ int i;
+
+ /* Make sure we are executing a detached process. */
+ if(!cp || !cp->Detached || cp->State != kwsysProcess_State_Executing ||
+ cp->TimeoutExpired || cp->Killed || cp->Terminated)
+ {
+ return;
+ }
+
+ /* Disable the reading threads. */
+ kwsysProcessDisablePipeThreads(cp);
+
+ /* Wait for all pipe threads to reset. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ WaitForSingleObject(cp->Pipe[i].Reader.Reset, INFINITE);
+ WaitForSingleObject(cp->Pipe[i].Waker.Reset, INFINITE);
+ }
+
+ /* We will not wait for exit, so cleanup now. */
+ kwsysProcessCleanup(cp, 0);
+
+ /* The process has been disowned. */
+ cp->State = kwsysProcess_State_Disowned;
+}
+
+/*--------------------------------------------------------------------------*/
+
+int kwsysProcess_WaitForData(kwsysProcess* cp, char** data, int* length,
+ double* userTimeout)
+{
+ kwsysProcessTime userStartTime;
+ kwsysProcessTime timeoutLength;
+ kwsysProcessTime timeoutTime;
+ DWORD timeout;
+ int user;
+ int done = 0;
+ int expired = 0;
+ int pipeId = kwsysProcess_Pipe_None;
+ DWORD w;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing || cp->Killed ||
+ cp->TimeoutExpired)
+ {
+ return kwsysProcess_Pipe_None;
+ }
+
+ /* Record the time at which user timeout period starts. */
+ userStartTime = kwsysProcessTimeGetCurrent();
+
+ /* Calculate the time at which a timeout will expire, and whether it
+ is the user or process timeout. */
+ user = kwsysProcessGetTimeoutTime(cp, userTimeout, &timeoutTime);
+
+ /* Loop until we have a reason to return. */
+ while(!done && cp->PipesLeft > 0)
+ {
+ /* If we previously got data from a thread, let it know we are
+ done with the data. */
+ if(cp->CurrentIndex < KWSYSPE_PIPE_COUNT)
+ {
+ ReleaseSemaphore(cp->Pipe[cp->CurrentIndex].Reader.Go, 1, 0);
+ cp->CurrentIndex = KWSYSPE_PIPE_COUNT;
+ }
+
+ /* Setup a timeout if required. */
+ if(kwsysProcessGetTimeoutLeft(&timeoutTime, user?userTimeout:0,
+ &timeoutLength))
+ {
+ /* Timeout has already expired. */
+ expired = 1;
+ break;
+ }
+ if(timeoutTime.QuadPart < 0)
+ {
+ timeout = INFINITE;
+ }
+ else
+ {
+ timeout = kwsysProcessTimeToDWORD(timeoutLength);
+ }
+
+ /* Wait for a pipe's thread to signal or a process to terminate. */
+ w = WaitForMultipleObjects(cp->ProcessEventsLength, cp->ProcessEvents,
+ 0, timeout);
+ if(w == WAIT_TIMEOUT)
+ {
+ /* Timeout has expired. */
+ expired = 1;
+ done = 1;
+ }
+ else if(w == WAIT_OBJECT_0)
+ {
+ /* Save the index of the reporting thread and release the mutex.
+ The thread will block until we signal its Empty mutex. */
+ cp->CurrentIndex = cp->SharedIndex;
+ ReleaseSemaphore(cp->SharedIndexMutex, 1, 0);
+
+ /* Data are available or a pipe closed. */
+ if(cp->Pipe[cp->CurrentIndex].Closed)
+ {
+ /* The pipe closed at the write end. Close the read end and
+ inform the wakeup thread it is done with this process. */
+ kwsysProcessCleanupHandle(&cp->Pipe[cp->CurrentIndex].Read);
+ ReleaseSemaphore(cp->Pipe[cp->CurrentIndex].Waker.Go, 1, 0);
+ --cp->PipesLeft;
+ }
+ else if(data && length)
+ {
+ /* Report this data. */
+ *data = cp->Pipe[cp->CurrentIndex].DataBuffer;
+ *length = cp->Pipe[cp->CurrentIndex].DataLength;
+ switch(cp->CurrentIndex)
+ {
+ case KWSYSPE_PIPE_STDOUT:
+ pipeId = kwsysProcess_Pipe_STDOUT; break;
+ case KWSYSPE_PIPE_STDERR:
+ pipeId = kwsysProcess_Pipe_STDERR; break;
+ }
+ done = 1;
+ }
+ }
+ else
+ {
+ /* A process has terminated. */
+ kwsysProcessDestroy(cp, w-WAIT_OBJECT_0);
+ }
+ }
+
+ /* Update the user timeout. */
+ if(userTimeout)
+ {
+ kwsysProcessTime userEndTime = kwsysProcessTimeGetCurrent();
+ kwsysProcessTime difference = kwsysProcessTimeSubtract(userEndTime,
+ userStartTime);
+ double d = kwsysProcessTimeToDouble(difference);
+ *userTimeout -= d;
+ if(*userTimeout < 0)
+ {
+ *userTimeout = 0;
+ }
+ }
+
+ /* Check what happened. */
+ if(pipeId)
+ {
+ /* Data are ready on a pipe. */
+ return pipeId;
+ }
+ else if(expired)
+ {
+ /* A timeout has expired. */
+ if(user)
+ {
+ /* The user timeout has expired. It has no time left. */
+ return kwsysProcess_Pipe_Timeout;
+ }
+ else
+ {
+ /* The process timeout has expired. Kill the child now. */
+ kwsysProcess_Kill(cp);
+ cp->TimeoutExpired = 1;
+ cp->Killed = 0;
+ return kwsysProcess_Pipe_None;
+ }
+ }
+ else
+ {
+ /* The children have terminated and no more data are available. */
+ return kwsysProcess_Pipe_None;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcess_WaitForExit(kwsysProcess* cp, double* userTimeout)
+{
+ int i;
+ int pipe;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing)
+ {
+ return 1;
+ }
+
+ /* Wait for the process to terminate. Ignore all data. */
+ while((pipe = kwsysProcess_WaitForData(cp, 0, 0, userTimeout)) > 0)
+ {
+ if(pipe == kwsysProcess_Pipe_Timeout)
+ {
+ /* The user timeout has expired. */
+ return 0;
+ }
+ }
+
+ /* When the last pipe closes in WaitForData, the loop terminates
+ without releasing the pipe's thread. Release it now. */
+ if(cp->CurrentIndex < KWSYSPE_PIPE_COUNT)
+ {
+ ReleaseSemaphore(cp->Pipe[cp->CurrentIndex].Reader.Go, 1, 0);
+ cp->CurrentIndex = KWSYSPE_PIPE_COUNT;
+ }
+
+ /* Wait for all pipe threads to reset. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ WaitForSingleObject(cp->Pipe[i].Reader.Reset, INFINITE);
+ WaitForSingleObject(cp->Pipe[i].Waker.Reset, INFINITE);
+ }
+
+ /* ---- It is now safe again to call kwsysProcessCleanup. ----- */
+ /* Close all the pipes. */
+ kwsysProcessCleanup(cp, 0);
+
+ /* Determine the outcome. */
+ if(cp->Killed)
+ {
+ /* We killed the child. */
+ cp->State = kwsysProcess_State_Killed;
+ }
+ else if(cp->TimeoutExpired)
+ {
+ /* The timeout expired. */
+ cp->State = kwsysProcess_State_Expired;
+ }
+ else
+ {
+ /* The children exited. Report the outcome of the last process. */
+ cp->ExitCode = cp->CommandExitCodes[cp->NumberOfCommands-1];
+ if((cp->ExitCode & 0xF0000000) == 0xC0000000)
+ {
+ /* Child terminated due to exceptional behavior. */
+ cp->State = kwsysProcess_State_Exception;
+ cp->ExitValue = 1;
+ kwsysProcessSetExitException(cp, cp->ExitCode);
+ }
+ else
+ {
+ /* Child exited without exception. */
+ cp->State = kwsysProcess_State_Exited;
+ cp->ExitException = kwsysProcess_Exception_None;
+ cp->ExitValue = cp->ExitCode;
+ }
+ }
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcess_Kill(kwsysProcess* cp)
+{
+ int i;
+
+ /* Make sure we are executing a process. */
+ if(!cp || cp->State != kwsysProcess_State_Executing || cp->TimeoutExpired ||
+ cp->Killed || cp->Terminated)
+ {
+ return;
+ }
+
+ /* Disable the reading threads. */
+ kwsysProcessDisablePipeThreads(cp);
+
+ /* Kill the children. */
+ cp->Killed = 1;
+ if(cp->Win9x)
+ {
+ /* Windows 9x. Tell the forwarding executable to kill the child. */
+ SetEvent(cp->Win9xKillEvent);
+ }
+ else
+ {
+ /* Not Windows 9x. Just terminate the children. */
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ kwsysProcessKillTree(cp->ProcessInformation[i].dwProcessId);
+ }
+ }
+
+ /* We are killing the children and ignoring all data. Do not wait
+ for them to exit. */
+}
+
+/*--------------------------------------------------------------------------*/
+
+/*
+ Function executed for each pipe's thread. Argument is a pointer to
+ the kwsysProcessPipeData instance for this thread.
+*/
+DWORD WINAPI kwsysProcessPipeThreadRead(LPVOID ptd)
+{
+ kwsysProcessPipeData* td = (kwsysProcessPipeData*)ptd;
+ kwsysProcess* cp = td->Process;
+
+ /* Wait for a process to be ready. */
+ while((WaitForSingleObject(td->Reader.Ready, INFINITE), !cp->Deleting))
+ {
+ /* Read output from the process for this thread's pipe. */
+ kwsysProcessPipeThreadReadPipe(cp, td);
+
+ /* Signal the main thread we have reset for a new process. */
+ ReleaseSemaphore(td->Reader.Reset, 1, 0);
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+
+/*
+ Function called in each pipe's thread to handle data for one
+ execution of a subprocess.
+*/
+void kwsysProcessPipeThreadReadPipe(kwsysProcess* cp, kwsysProcessPipeData* td)
+{
+ /* Wait for space in the thread's buffer. */
+ while((WaitForSingleObject(td->Reader.Go, INFINITE), !td->Closed))
+ {
+ /* Read data from the pipe. This may block until data are available. */
+ if(!ReadFile(td->Read, td->DataBuffer, KWSYSPE_PIPE_BUFFER_SIZE,
+ &td->DataLength, 0))
+ {
+ if(GetLastError() != ERROR_BROKEN_PIPE)
+ {
+ /* UNEXPECTED failure to read the pipe. */
+ }
+
+ /* The pipe closed. There are no more data to read. */
+ td->Closed = 1;
+ }
+
+ /* Wait for our turn to be handled by the main thread. */
+ WaitForSingleObject(cp->SharedIndexMutex, INFINITE);
+
+ /* Tell the main thread we have something to report. */
+ cp->SharedIndex = td->Index;
+ ReleaseSemaphore(cp->Full, 1, 0);
+ }
+
+ /* We were signalled to exit with our buffer empty. Reset the
+ mutex for a new process. */
+ ReleaseSemaphore(td->Reader.Go, 1, 0);
+}
+
+/*--------------------------------------------------------------------------*/
+
+/*
+ Function executed for each pipe's thread. Argument is a pointer to
+ the kwsysProcessPipeData instance for this thread.
+*/
+DWORD WINAPI kwsysProcessPipeThreadWake(LPVOID ptd)
+{
+ kwsysProcessPipeData* td = (kwsysProcessPipeData*)ptd;
+ kwsysProcess* cp = td->Process;
+
+ /* Wait for a process to be ready. */
+ while((WaitForSingleObject(td->Waker.Ready, INFINITE), !cp->Deleting))
+ {
+ /* Wait for a possible wakeup. */
+ kwsysProcessPipeThreadWakePipe(cp, td);
+
+ /* Signal the main thread we have reset for a new process. */
+ ReleaseSemaphore(td->Waker.Reset, 1, 0);
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+
+/*
+ Function called in each pipe's thread to handle reading thread
+ wakeup for one execution of a subprocess.
+*/
+void kwsysProcessPipeThreadWakePipe(kwsysProcess* cp, kwsysProcessPipeData* td)
+{
+ (void)cp;
+
+ /* Wait for a possible wake command. */
+ WaitForSingleObject(td->Waker.Go, INFINITE);
+
+ /* If the pipe is not closed, we need to wake up the reading thread. */
+ if(!td->Closed)
+ {
+ DWORD dummy;
+ WriteFile(td->Write, "", 1, &dummy, 0);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* Initialize a process control structure for kwsysProcess_Execute. */
+int kwsysProcessInitialize(kwsysProcess* cp)
+{
+ /* Reset internal status flags. */
+ cp->TimeoutExpired = 0;
+ cp->Terminated = 0;
+ cp->Killed = 0;
+ cp->ExitException = kwsysProcess_Exception_None;
+ cp->ExitCode = 1;
+ cp->ExitValue = 1;
+
+ /* Reset error data. */
+ cp->ErrorMessage[0] = 0;
+ strcpy(cp->ExitExceptionString, "No exception");
+
+ /* Allocate process information for each process. */
+ cp->ProcessInformation =
+ (PROCESS_INFORMATION*)malloc(sizeof(PROCESS_INFORMATION) *
+ cp->NumberOfCommands);
+ if(!cp->ProcessInformation)
+ {
+ return 0;
+ }
+ ZeroMemory(cp->ProcessInformation,
+ sizeof(PROCESS_INFORMATION) * cp->NumberOfCommands);
+ if(cp->CommandExitCodes)
+ {
+ free(cp->CommandExitCodes);
+ }
+ cp->CommandExitCodes = (DWORD*)malloc(sizeof(DWORD)*cp->NumberOfCommands);
+ if(!cp->CommandExitCodes)
+ {
+ return 0;
+ }
+ ZeroMemory(cp->CommandExitCodes, sizeof(DWORD)*cp->NumberOfCommands);
+
+ /* Allocate event wait array. The first event is cp->Full, the rest
+ are the process termination events. */
+ cp->ProcessEvents = (PHANDLE)malloc(sizeof(HANDLE)*(cp->NumberOfCommands+1));
+ if(!cp->ProcessEvents)
+ {
+ return 0;
+ }
+ ZeroMemory(cp->ProcessEvents, sizeof(HANDLE) * (cp->NumberOfCommands+1));
+ cp->ProcessEvents[0] = cp->Full;
+ cp->ProcessEventsLength = cp->NumberOfCommands+1;
+
+ /* Allocate space to save the real working directory of this process. */
+ if(cp->WorkingDirectory)
+ {
+ cp->RealWorkingDirectoryLength = GetCurrentDirectory(0, 0);
+ if(cp->RealWorkingDirectoryLength > 0)
+ {
+ cp->RealWorkingDirectory = malloc(cp->RealWorkingDirectoryLength);
+ if(!cp->RealWorkingDirectory)
+ {
+ return 0;
+ }
+ }
+ }
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcessCreate(kwsysProcess* cp, int index,
+ kwsysProcessCreateInformation* si,
+ PHANDLE readEnd)
+{
+ /* Setup the process's stdin. */
+ if(*readEnd)
+ {
+ /* Create an inherited duplicate of the read end from the output
+ pipe of the previous process. This also closes the
+ non-inherited version. */
+ if(!DuplicateHandle(GetCurrentProcess(), *readEnd,
+ GetCurrentProcess(), readEnd,
+ 0, TRUE, (DUPLICATE_CLOSE_SOURCE |
+ DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+ si->StartupInfo.hStdInput = *readEnd;
+
+ /* This function is done with this handle. */
+ *readEnd = 0;
+ }
+ else if(cp->PipeFileSTDIN)
+ {
+ /* Create a handle to read a file for stdin. */
+ HANDLE fin = CreateFile(cp->PipeFileSTDIN, GENERIC_READ,
+ FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0);
+ if(fin == INVALID_HANDLE_VALUE)
+ {
+ return 0;
+ }
+ /* Create an inherited duplicate of the handle. This also closes
+ the non-inherited version. */
+ if(!DuplicateHandle(GetCurrentProcess(), fin,
+ GetCurrentProcess(), &fin,
+ 0, TRUE, (DUPLICATE_CLOSE_SOURCE |
+ DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+ si->StartupInfo.hStdInput = fin;
+ }
+ else if(cp->PipeSharedSTDIN)
+ {
+ /* Share this process's stdin with the child. */
+ if(!kwsysProcessSetupSharedPipe(STD_INPUT_HANDLE,
+ &si->StartupInfo.hStdInput))
+ {
+ return 0;
+ }
+ }
+ else
+ {
+ /* Explicitly give the child no stdin. */
+ si->StartupInfo.hStdInput = INVALID_HANDLE_VALUE;
+ }
+
+ /* Setup the process's stdout. */
+ {
+ DWORD maybeClose = DUPLICATE_CLOSE_SOURCE;
+ HANDLE writeEnd;
+
+ /* Create the output pipe for this process. Neither end is directly
+ inherited. */
+ if(!CreatePipe(readEnd, &writeEnd, 0, 0))
+ {
+ return 0;
+ }
+
+ /* Create an inherited duplicate of the write end. Close the
+ non-inherited version unless this is the last process. Save the
+ non-inherited write end of the last process. */
+ if(index == cp->NumberOfCommands-1)
+ {
+ cp->Pipe[KWSYSPE_PIPE_STDOUT].Write = writeEnd;
+ maybeClose = 0;
+ }
+ if(!DuplicateHandle(GetCurrentProcess(), writeEnd,
+ GetCurrentProcess(), &writeEnd,
+ 0, TRUE, (maybeClose | DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+ si->StartupInfo.hStdOutput = writeEnd;
+ }
+
+ /* Replace the stdout pipe with a file if requested. In this case
+ the pipe thread will still run but never report data. */
+ if(index == cp->NumberOfCommands-1 && cp->PipeFileSTDOUT)
+ {
+ if(!kwsysProcessSetupOutputPipeFile(&si->StartupInfo.hStdOutput,
+ cp->PipeFileSTDOUT))
+ {
+ return 0;
+ }
+ }
+
+ /* Replace the stdout pipe of the last child with the parent
+ process's if requested. In this case the pipe thread will still
+ run but never report data. */
+ if(index == cp->NumberOfCommands-1 && cp->PipeSharedSTDOUT)
+ {
+ if(!kwsysProcessSetupSharedPipe(STD_OUTPUT_HANDLE,
+ &si->StartupInfo.hStdOutput))
+ {
+ return 0;
+ }
+ }
+
+ /* Create the child process. */
+ {
+ BOOL r;
+ char* realCommand;
+ if(cp->Win9x)
+ {
+ /* Create an error reporting pipe for the forwarding executable.
+ Neither end is directly inherited. */
+ if(!CreatePipe(&si->ErrorPipeRead, &si->ErrorPipeWrite, 0, 0))
+ {
+ return 0;
+ }
+
+ /* Create an inherited duplicate of the write end. This also closes
+ the non-inherited version. */
+ if(!DuplicateHandle(GetCurrentProcess(), si->ErrorPipeWrite,
+ GetCurrentProcess(), &si->ErrorPipeWrite,
+ 0, TRUE, (DUPLICATE_CLOSE_SOURCE |
+ DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+
+ /* The forwarding executable is given a handle to the error pipe
+ and resume and kill events. */
+ realCommand = malloc(strlen(cp->Win9x)+strlen(cp->Commands[index])+100);
+ if(!realCommand)
+ {
+ return 0;
+ }
+ sprintf(realCommand, "%s %p %p %p %d %s", cp->Win9x,
+ si->ErrorPipeWrite, cp->Win9xResumeEvent, cp->Win9xKillEvent,
+ cp->HideWindow, cp->Commands[index]);
+ }
+ else
+ {
+ realCommand = cp->Commands[index];
+ }
+
+ /* Create the child in a suspended state so we can wait until all
+ children have been created before running any one. */
+ r = CreateProcess(0, realCommand, 0, 0, TRUE,
+ cp->Win9x? 0 : CREATE_SUSPENDED, 0, 0,
+ &si->StartupInfo, &cp->ProcessInformation[index]);
+
+ if(cp->Win9x)
+ {
+ /* Free memory. */
+ free(realCommand);
+
+ /* Close the error pipe write end so we can detect when the
+ forwarding executable closes it. */
+ kwsysProcessCleanupHandle(&si->ErrorPipeWrite);
+ if(r)
+ {
+ /* Wait for the forwarding executable to report an error or
+ close the error pipe to report success. */
+ DWORD total = 0;
+ DWORD n = 1;
+ while(total < KWSYSPE_PIPE_BUFFER_SIZE && n > 0)
+ {
+ if(ReadFile(si->ErrorPipeRead, cp->ErrorMessage+total,
+ KWSYSPE_PIPE_BUFFER_SIZE-total, &n, 0))
+ {
+ total += n;
+ }
+ else
+ {
+ n = 0;
+ }
+ }
+ if(total > 0 || GetLastError() != ERROR_BROKEN_PIPE)
+ {
+ /* The forwarding executable could not run the process, or
+ there was an error reading from its error pipe. Preserve
+ the last error while cleaning up the forwarding executable
+ so the cleanup our caller does reports the proper error. */
+ DWORD error = GetLastError();
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[index].hThread);
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[index].hProcess);
+ SetLastError(error);
+ return 0;
+ }
+ }
+ kwsysProcessCleanupHandle(&si->ErrorPipeRead);
+ }
+
+ if(!r)
+ {
+ return 0;
+ }
+ }
+
+ /* Successfully created this child process. Close the current
+ process's copies of the inherited stdout and stdin handles. The
+ stderr handle is shared among all children and is closed by
+ kwsysProcess_Execute after all children have been created. */
+ kwsysProcessCleanupHandle(&si->StartupInfo.hStdInput);
+ kwsysProcessCleanupHandle(&si->StartupInfo.hStdOutput);
+
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcessDestroy(kwsysProcess* cp, int event)
+{
+ int i;
+ int index;
+
+ /* Find the process index for the termination event. */
+ for(index=0; index < cp->NumberOfCommands; ++index)
+ {
+ if(cp->ProcessInformation[index].hProcess == cp->ProcessEvents[event])
+ {
+ break;
+ }
+ }
+
+ /* Check the exit code of the process. */
+ GetExitCodeProcess(cp->ProcessInformation[index].hProcess,
+ &cp->CommandExitCodes[index]);
+
+ /* Close the process handle for the terminated process. */
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[index].hProcess);
+
+ /* Remove the process from the available events. */
+ cp->ProcessEventsLength -= 1;
+ for(i=event; i < cp->ProcessEventsLength; ++i)
+ {
+ cp->ProcessEvents[i] = cp->ProcessEvents[i+1];
+ }
+
+ /* Check if all processes have terminated. */
+ if(cp->ProcessEventsLength == 1)
+ {
+ cp->Terminated = 1;
+
+ /* Close our copies of the pipe write handles so the pipe threads
+ can detect end-of-data. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Write);
+ }
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcessSetupOutputPipeFile(PHANDLE phandle, const char* name)
+{
+ HANDLE fout;
+ if(!name)
+ {
+ return 1;
+ }
+
+ /* Close the existing inherited handle. */
+ kwsysProcessCleanupHandle(phandle);
+
+ /* Create a handle to write a file for the pipe. */
+ fout = CreateFile(name, GENERIC_WRITE, FILE_SHARE_READ, 0,
+ CREATE_ALWAYS, 0, 0);
+ if(fout == INVALID_HANDLE_VALUE)
+ {
+ return 0;
+ }
+
+ /* Create an inherited duplicate of the handle. This also closes
+ the non-inherited version. */
+ if(!DuplicateHandle(GetCurrentProcess(), fout,
+ GetCurrentProcess(), &fout,
+ 0, TRUE, (DUPLICATE_CLOSE_SOURCE |
+ DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+
+ /* Assign the replacement handle. */
+ *phandle = fout;
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcessSetupSharedPipe(DWORD nStdHandle, PHANDLE handle)
+{
+ /* Cleanup the previous handle. */
+ kwsysProcessCleanupHandle(handle);
+
+ /* Duplicate the standard handle to be sure it is inherited and can
+ be closed later. Do not close the original handle when
+ duplicating! */
+ if(DuplicateHandle(GetCurrentProcess(), GetStdHandle(nStdHandle),
+ GetCurrentProcess(), handle,
+ 0, TRUE, DUPLICATE_SAME_ACCESS))
+ {
+ return 1;
+ }
+ else
+ {
+ /* The given standard handle is not valid for this process. Some
+ child processes may break if they do not have a valid standard
+ pipe, so give the child an empty pipe. For the stdin pipe we
+ want to close the write end and give the read end to the child.
+ For stdout and stderr we want to close the read end and give
+ the write end to the child. */
+ int child_end = (nStdHandle == STD_INPUT_HANDLE)? 0:1;
+ int parent_end = (nStdHandle == STD_INPUT_HANDLE)? 1:0;
+ HANDLE emptyPipe[2];
+ if(!CreatePipe(&emptyPipe[0], &emptyPipe[1], 0, 0))
+ {
+ return 0;
+ }
+
+ /* Close the non-inherited end so the pipe will be broken
+ immediately. */
+ CloseHandle(emptyPipe[parent_end]);
+
+ /* Create an inherited duplicate of the handle. This also
+ closes the non-inherited version. */
+ if(!DuplicateHandle(GetCurrentProcess(), emptyPipe[child_end],
+ GetCurrentProcess(), &emptyPipe[child_end],
+ 0, TRUE, (DUPLICATE_CLOSE_SOURCE |
+ DUPLICATE_SAME_ACCESS)))
+ {
+ return 0;
+ }
+
+ /* Give the inherited handle to the child. */
+ *handle = emptyPipe[child_end];
+ return 1;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+
+/* Close the given handle if it is open. Reset its value to 0. */
+void kwsysProcessCleanupHandle(PHANDLE h)
+{
+ if(h && *h)
+ {
+ CloseHandle(*h);
+ *h = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+
+/* Close all handles created by kwsysProcess_Execute. */
+void kwsysProcessCleanup(kwsysProcess* cp, int error)
+{
+ int i;
+
+ /* If this is an error case, report the error. */
+ if(error)
+ {
+ /* Construct an error message if one has not been provided already. */
+ if(cp->ErrorMessage[0] == 0)
+ {
+ /* Format the error message. */
+ DWORD original = GetLastError();
+ DWORD length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_IGNORE_INSERTS, 0, original,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+ cp->ErrorMessage, KWSYSPE_PIPE_BUFFER_SIZE, 0);
+ if(length < 1)
+ {
+ /* FormatMessage failed. Use a default message. */
+ _snprintf(cp->ErrorMessage, KWSYSPE_PIPE_BUFFER_SIZE,
+ "Process execution failed with error 0x%X. "
+ "FormatMessage failed with error 0x%X",
+ original, GetLastError());
+ }
+ }
+
+ /* Remove trailing period and newline, if any. */
+ kwsysProcessCleanErrorMessage(cp);
+
+ /* Set the error state. */
+ cp->State = kwsysProcess_State_Error;
+
+ /* Cleanup any processes already started in a suspended state. */
+ if(cp->ProcessInformation)
+ {
+ if(cp->Win9x)
+ {
+ SetEvent(cp->Win9xKillEvent);
+ }
+ else
+ {
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ if(cp->ProcessInformation[i].hProcess)
+ {
+ TerminateProcess(cp->ProcessInformation[i].hProcess, 255);
+ WaitForSingleObject(cp->ProcessInformation[i].hProcess, INFINITE);
+ }
+ }
+ }
+ for(i=0; i < cp->NumberOfCommands; ++i)
+ {
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[i].hThread);
+ kwsysProcessCleanupHandle(&cp->ProcessInformation[i].hProcess);
+ }
+ }
+
+ /* Restore the working directory. */
+ if(cp->RealWorkingDirectory)
+ {
+ SetCurrentDirectory(cp->RealWorkingDirectory);
+ }
+ }
+
+ /* Free memory. */
+ if(cp->ProcessInformation)
+ {
+ free(cp->ProcessInformation);
+ cp->ProcessInformation = 0;
+ }
+ if(cp->ProcessEvents)
+ {
+ free(cp->ProcessEvents);
+ cp->ProcessEvents = 0;
+ }
+ if(cp->RealWorkingDirectory)
+ {
+ free(cp->RealWorkingDirectory);
+ cp->RealWorkingDirectory = 0;
+ }
+
+ /* Close each pipe. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Write);
+ kwsysProcessCleanupHandle(&cp->Pipe[i].Read);
+ cp->Pipe[i].Closed = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+void kwsysProcessCleanErrorMessage(kwsysProcess* cp)
+{
+ /* Remove trailing period and newline, if any. */
+ int length = strlen(cp->ErrorMessage);
+ if(cp->ErrorMessage[length-1] == '\n')
+ {
+ cp->ErrorMessage[length-1] = 0;
+ --length;
+ if(length > 0 && cp->ErrorMessage[length-1] == '\r')
+ {
+ cp->ErrorMessage[length-1] = 0;
+ --length;
+ }
+ }
+ if(length > 0 && cp->ErrorMessage[length-1] == '.')
+ {
+ cp->ErrorMessage[length-1] = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* Get the time at which either the process or user timeout will
+ expire. Returns 1 if the user timeout is first, and 0 otherwise. */
+int kwsysProcessGetTimeoutTime(kwsysProcess* cp, double* userTimeout,
+ kwsysProcessTime* timeoutTime)
+{
+ /* The first time this is called, we need to calculate the time at
+ which the child will timeout. */
+ if(cp->Timeout && cp->TimeoutTime.QuadPart < 0)
+ {
+ kwsysProcessTime length = kwsysProcessTimeFromDouble(cp->Timeout);
+ cp->TimeoutTime = kwsysProcessTimeAdd(cp->StartTime, length);
+ }
+
+ /* Start with process timeout. */
+ *timeoutTime = cp->TimeoutTime;
+
+ /* Check if the user timeout is earlier. */
+ if(userTimeout)
+ {
+ kwsysProcessTime currentTime = kwsysProcessTimeGetCurrent();
+ kwsysProcessTime userTimeoutLength = kwsysProcessTimeFromDouble(*userTimeout);
+ kwsysProcessTime userTimeoutTime = kwsysProcessTimeAdd(currentTime,
+ userTimeoutLength);
+ if(timeoutTime->QuadPart < 0 ||
+ kwsysProcessTimeLess(userTimeoutTime, *timeoutTime))
+ {
+ *timeoutTime = userTimeoutTime;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Get the length of time before the given timeout time arrives.
+ Returns 1 if the time has already arrived, and 0 otherwise. */
+int kwsysProcessGetTimeoutLeft(kwsysProcessTime* timeoutTime,
+ double* userTimeout,
+ kwsysProcessTime* timeoutLength)
+{
+ if(timeoutTime->QuadPart < 0)
+ {
+ /* No timeout time has been requested. */
+ return 0;
+ }
+ else
+ {
+ /* Calculate the remaining time. */
+ kwsysProcessTime currentTime = kwsysProcessTimeGetCurrent();
+ *timeoutLength = kwsysProcessTimeSubtract(*timeoutTime, currentTime);
+
+ if(timeoutLength->QuadPart < 0 && userTimeout && *userTimeout <= 0)
+ {
+ /* Caller has explicitly requested a zero timeout. */
+ timeoutLength->QuadPart = 0;
+ }
+
+ if(timeoutLength->QuadPart < 0)
+ {
+ /* Timeout has already expired. */
+ return 1;
+ }
+ else
+ {
+ /* There is some time left. */
+ return 0;
+ }
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+kwsysProcessTime kwsysProcessTimeGetCurrent()
+{
+ kwsysProcessTime current;
+ FILETIME ft;
+ GetSystemTimeAsFileTime(&ft);
+ current.LowPart = ft.dwLowDateTime;
+ current.HighPart = ft.dwHighDateTime;
+ return current;
+}
+
+/*--------------------------------------------------------------------------*/
+DWORD kwsysProcessTimeToDWORD(kwsysProcessTime t)
+{
+ return (DWORD)(t.QuadPart * 0.0001);
+}
+
+/*--------------------------------------------------------------------------*/
+double kwsysProcessTimeToDouble(kwsysProcessTime t)
+{
+ return t.QuadPart * 0.0000001;
+}
+
+/*--------------------------------------------------------------------------*/
+kwsysProcessTime kwsysProcessTimeFromDouble(double d)
+{
+ kwsysProcessTime t;
+ t.QuadPart = (LONGLONG)(d*10000000);
+ return t;
+}
+
+/*--------------------------------------------------------------------------*/
+int kwsysProcessTimeLess(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ return in1.QuadPart < in2.QuadPart;
+}
+
+/*--------------------------------------------------------------------------*/
+kwsysProcessTime kwsysProcessTimeAdd(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ kwsysProcessTime out;
+ out.QuadPart = in1.QuadPart + in2.QuadPart;
+ return out;
+}
+
+/*--------------------------------------------------------------------------*/
+kwsysProcessTime kwsysProcessTimeSubtract(kwsysProcessTime in1, kwsysProcessTime in2)
+{
+ kwsysProcessTime out;
+ out.QuadPart = in1.QuadPart - in2.QuadPart;
+ return out;
+}
+
+/*--------------------------------------------------------------------------*/
+#define KWSYSPE_CASE(type, str) \
+ cp->ExitException = kwsysProcess_Exception_##type; \
+ strcpy(cp->ExitExceptionString, str)
+static void kwsysProcessSetExitException(kwsysProcess* cp, int code)
+{
+ switch (code)
+ {
+ case STATUS_CONTROL_C_EXIT:
+ KWSYSPE_CASE(Interrupt, "User interrupt"); break;
+
+ case STATUS_FLOAT_DENORMAL_OPERAND:
+ KWSYSPE_CASE(Numerical, "Floating-point exception (denormal operand)"); break;
+ case STATUS_FLOAT_DIVIDE_BY_ZERO:
+ KWSYSPE_CASE(Numerical, "Divide-by-zero"); break;
+ case STATUS_FLOAT_INEXACT_RESULT:
+ KWSYSPE_CASE(Numerical, "Floating-point exception (inexact result)"); break;
+ case STATUS_FLOAT_INVALID_OPERATION:
+ KWSYSPE_CASE(Numerical, "Invalid floating-point operation"); break;
+ case STATUS_FLOAT_OVERFLOW:
+ KWSYSPE_CASE(Numerical, "Floating-point overflow"); break;
+ case STATUS_FLOAT_STACK_CHECK:
+ KWSYSPE_CASE(Numerical, "Floating-point stack check failed"); break;
+ case STATUS_FLOAT_UNDERFLOW:
+ KWSYSPE_CASE(Numerical, "Floating-point underflow"); break;
+#ifdef STATUS_FLOAT_MULTIPLE_FAULTS
+ case STATUS_FLOAT_MULTIPLE_FAULTS:
+ KWSYSPE_CASE(Numerical, "Floating-point exception (multiple faults)"); break;
+#endif
+#ifdef STATUS_FLOAT_MULTIPLE_TRAPS
+ case STATUS_FLOAT_MULTIPLE_TRAPS:
+ KWSYSPE_CASE(Numerical, "Floating-point exception (multiple traps)"); break;
+#endif
+ case STATUS_INTEGER_DIVIDE_BY_ZERO:
+ KWSYSPE_CASE(Numerical, "Integer divide-by-zero"); break;
+ case STATUS_INTEGER_OVERFLOW:
+ KWSYSPE_CASE(Numerical, "Integer overflow"); break;
+
+ case STATUS_DATATYPE_MISALIGNMENT:
+ KWSYSPE_CASE(Fault, "Datatype misalignment"); break;
+ case STATUS_ACCESS_VIOLATION:
+ KWSYSPE_CASE(Fault, "Access violation"); break;
+ case STATUS_IN_PAGE_ERROR:
+ KWSYSPE_CASE(Fault, "In-page error"); break;
+ case STATUS_INVALID_HANDLE:
+ KWSYSPE_CASE(Fault, "Invalid hanlde"); break;
+ case STATUS_NONCONTINUABLE_EXCEPTION:
+ KWSYSPE_CASE(Fault, "Noncontinuable exception"); break;
+ case STATUS_INVALID_DISPOSITION:
+ KWSYSPE_CASE(Fault, "Invalid disposition"); break;
+ case STATUS_ARRAY_BOUNDS_EXCEEDED:
+ KWSYSPE_CASE(Fault, "Array bounds exceeded"); break;
+ case STATUS_STACK_OVERFLOW:
+ KWSYSPE_CASE(Fault, "Stack overflow"); break;
+
+ case STATUS_ILLEGAL_INSTRUCTION:
+ KWSYSPE_CASE(Illegal, "Illegal instruction"); break;
+ case STATUS_PRIVILEGED_INSTRUCTION:
+ KWSYSPE_CASE(Illegal, "Privileged instruction"); break;
+
+ case STATUS_NO_MEMORY:
+ default:
+ cp->ExitException = kwsysProcess_Exception_Other;
+ sprintf(cp->ExitExceptionString, "Exit code 0x%x\n", code);
+ break;
+ }
+}
+#undef KWSYSPE_CASE
+
+typedef struct kwsysProcess_List_s kwsysProcess_List;
+static kwsysProcess_List* kwsysProcess_List_New(void);
+static void kwsysProcess_List_Delete(kwsysProcess_List* self);
+static int kwsysProcess_List_Update(kwsysProcess_List* self);
+static int kwsysProcess_List_NextProcess(kwsysProcess_List* self);
+static int kwsysProcess_List_GetCurrentProcessId(kwsysProcess_List* self);
+static int kwsysProcess_List_GetCurrentParentId(kwsysProcess_List* self);
+
+/*--------------------------------------------------------------------------*/
+/* Windows NT 4 API definitions. */
+#define STATUS_INFO_LENGTH_MISMATCH ((NTSTATUS)0xC0000004L)
+typedef LONG NTSTATUS;
+typedef LONG KPRIORITY;
+typedef struct _UNICODE_STRING UNICODE_STRING;
+struct _UNICODE_STRING
+{
+ USHORT Length;
+ USHORT MaximumLength;
+ PWSTR Buffer;
+};
+
+/* The process information structure. Declare only enough to get
+ process identifiers. The rest may be ignored because we use the
+ NextEntryDelta to move through an array of instances. */
+typedef struct _SYSTEM_PROCESS_INFORMATION SYSTEM_PROCESS_INFORMATION;
+typedef SYSTEM_PROCESS_INFORMATION* PSYSTEM_PROCESS_INFORMATION;
+struct _SYSTEM_PROCESS_INFORMATION
+{
+ ULONG NextEntryDelta;
+ ULONG ThreadCount;
+ ULONG Reserved1[6];
+ LARGE_INTEGER CreateTime;
+ LARGE_INTEGER UserTime;
+ LARGE_INTEGER KernelTime;
+ UNICODE_STRING ProcessName;
+ KPRIORITY BasePriority;
+ ULONG ProcessId;
+ ULONG InheritedFromProcessId;
+};
+
+/*--------------------------------------------------------------------------*/
+/* Toolhelp32 API definitions. */
+#define TH32CS_SNAPPROCESS 0x00000002
+typedef struct tagPROCESSENTRY32 PROCESSENTRY32;
+typedef PROCESSENTRY32* LPPROCESSENTRY32;
+struct tagPROCESSENTRY32
+{
+ DWORD dwSize;
+ DWORD cntUsage;
+ DWORD th32ProcessID;
+ DWORD th32DefaultHeapID;
+ DWORD th32ModuleID;
+ DWORD cntThreads;
+ DWORD th32ParentProcessID;
+ LONG pcPriClassBase;
+ DWORD dwFlags;
+ char szExeFile[MAX_PATH];
+};
+
+/*--------------------------------------------------------------------------*/
+/* Windows API function types. */
+typedef HANDLE (WINAPI* CreateToolhelp32SnapshotType)(DWORD, DWORD);
+typedef BOOL (WINAPI* Process32FirstType)(HANDLE, LPPROCESSENTRY32);
+typedef BOOL (WINAPI* Process32NextType)(HANDLE, LPPROCESSENTRY32);
+typedef NTSTATUS (WINAPI* ZwQuerySystemInformationType)(ULONG, PVOID,
+ ULONG, PULONG);
+
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__New_NT4(kwsysProcess_List* self);
+static int kwsysProcess_List__New_Snapshot(kwsysProcess_List* self);
+static void kwsysProcess_List__Delete_NT4(kwsysProcess_List* self);
+static void kwsysProcess_List__Delete_Snapshot(kwsysProcess_List* self);
+static int kwsysProcess_List__Update_NT4(kwsysProcess_List* self);
+static int kwsysProcess_List__Update_Snapshot(kwsysProcess_List* self);
+static int kwsysProcess_List__Next_NT4(kwsysProcess_List* self);
+static int kwsysProcess_List__Next_Snapshot(kwsysProcess_List* self);
+static int kwsysProcess_List__GetProcessId_NT4(kwsysProcess_List* self);
+static int kwsysProcess_List__GetProcessId_Snapshot(kwsysProcess_List* self);
+static int kwsysProcess_List__GetParentId_NT4(kwsysProcess_List* self);
+static int kwsysProcess_List__GetParentId_Snapshot(kwsysProcess_List* self);
+
+struct kwsysProcess_List_s
+{
+ /* Implementation switches at runtime based on version of Windows. */
+ int NT4;
+
+ /* Implementation functions and data for NT 4. */
+ ZwQuerySystemInformationType P_ZwQuerySystemInformation;
+ char* Buffer;
+ int BufferSize;
+ PSYSTEM_PROCESS_INFORMATION CurrentInfo;
+
+ /* Implementation functions and data for other Windows versions. */
+ CreateToolhelp32SnapshotType P_CreateToolhelp32Snapshot;
+ Process32FirstType P_Process32First;
+ Process32NextType P_Process32Next;
+ HANDLE Snapshot;
+ PROCESSENTRY32 CurrentEntry;
+};
+
+/*--------------------------------------------------------------------------*/
+static kwsysProcess_List* kwsysProcess_List_New(void)
+{
+ OSVERSIONINFO osv;
+ kwsysProcess_List* self;
+
+ /* Allocate and initialize the list object. */
+ if(!(self = (kwsysProcess_List*)malloc(sizeof(kwsysProcess_List))))
+ {
+ return 0;
+ }
+ memset(self, 0, sizeof(*self));
+
+ /* Select an implementation. */
+ ZeroMemory(&osv, sizeof(osv));
+ osv.dwOSVersionInfoSize = sizeof(osv);
+ GetVersionEx(&osv);
+ self->NT4 = (osv.dwPlatformId == VER_PLATFORM_WIN32_NT &&
+ osv.dwMajorVersion < 5)? 1:0;
+
+ /* Initialize the selected implementation. */
+ if(!(self->NT4?
+ kwsysProcess_List__New_NT4(self) :
+ kwsysProcess_List__New_Snapshot(self)))
+ {
+ kwsysProcess_List_Delete(self);
+ return 0;
+ }
+
+ /* Update to the current set of processes. */
+ if(!kwsysProcess_List_Update(self))
+ {
+ kwsysProcess_List_Delete(self);
+ return 0;
+ }
+ return self;
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcess_List_Delete(kwsysProcess_List* self)
+{
+ if(self)
+ {
+ if(self->NT4)
+ {
+ kwsysProcess_List__Delete_NT4(self);
+ }
+ else
+ {
+ kwsysProcess_List__Delete_Snapshot(self);
+ }
+ free(self);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List_Update(kwsysProcess_List* self)
+{
+ return self? (self->NT4?
+ kwsysProcess_List__Update_NT4(self) :
+ kwsysProcess_List__Update_Snapshot(self)) : 0;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List_GetCurrentProcessId(kwsysProcess_List* self)
+{
+ return self? (self->NT4?
+ kwsysProcess_List__GetProcessId_NT4(self) :
+ kwsysProcess_List__GetProcessId_Snapshot(self)) : -1;
+
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List_GetCurrentParentId(kwsysProcess_List* self)
+{
+ return self? (self->NT4?
+ kwsysProcess_List__GetParentId_NT4(self) :
+ kwsysProcess_List__GetParentId_Snapshot(self)) : -1;
+
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List_NextProcess(kwsysProcess_List* self)
+{
+ return (self? (self->NT4?
+ kwsysProcess_List__Next_NT4(self) :
+ kwsysProcess_List__Next_Snapshot(self)) : 0);
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__New_NT4(kwsysProcess_List* self)
+{
+ /* Get a handle to the NT runtime module that should already be
+ loaded in this program. This does not actually increment the
+ reference count to the module so we do not need to close the
+ handle. */
+ HANDLE hNT = GetModuleHandle("ntdll.dll");
+ if(hNT)
+ {
+ /* Get pointers to the needed API functions. */
+ self->P_ZwQuerySystemInformation =
+ ((ZwQuerySystemInformationType)
+ GetProcAddress(hNT, "ZwQuerySystemInformation"));
+ }
+ if(!self->P_ZwQuerySystemInformation)
+ {
+ return 0;
+ }
+
+ /* Allocate an initial process information buffer. */
+ self->BufferSize = 32768;
+ self->Buffer = (char*)malloc(self->BufferSize);
+ return self->Buffer? 1:0;
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcess_List__Delete_NT4(kwsysProcess_List* self)
+{
+ /* Free the process information buffer. */
+ if(self->Buffer)
+ {
+ free(self->Buffer);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__Update_NT4(kwsysProcess_List* self)
+{
+ self->CurrentInfo = 0;
+ for(;;)
+ {
+ /* Query number 5 is for system process list. */
+ NTSTATUS status =
+ self->P_ZwQuerySystemInformation(5, self->Buffer, self->BufferSize, 0);
+ if(status == STATUS_INFO_LENGTH_MISMATCH)
+ {
+ /* The query requires a bigger buffer. */
+ int newBufferSize = self->BufferSize * 2;
+ char* newBuffer = (char*)malloc(newBufferSize);
+ if(newBuffer)
+ {
+ free(self->Buffer);
+ self->Buffer = newBuffer;
+ self->BufferSize = newBufferSize;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ else if(status >= 0)
+ {
+ /* The query succeeded. Initialize traversal of the process list. */
+ self->CurrentInfo = (PSYSTEM_PROCESS_INFORMATION)self->Buffer;
+ return 1;
+ }
+ else
+ {
+ /* The query failed. */
+ return 0;
+ }
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__Next_NT4(kwsysProcess_List* self)
+{
+ if(self->CurrentInfo)
+ {
+ if(self->CurrentInfo->NextEntryDelta > 0)
+ {
+ self->CurrentInfo = ((PSYSTEM_PROCESS_INFORMATION)
+ ((char*)self->CurrentInfo +
+ self->CurrentInfo->NextEntryDelta));
+ return 1;
+ }
+ self->CurrentInfo = 0;
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__GetProcessId_NT4(kwsysProcess_List* self)
+{
+ return self->CurrentInfo? self->CurrentInfo->ProcessId : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__GetParentId_NT4(kwsysProcess_List* self)
+{
+ return self->CurrentInfo? self->CurrentInfo->InheritedFromProcessId : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__New_Snapshot(kwsysProcess_List* self)
+{
+ /* Get a handle to the Windows runtime module that should already be
+ loaded in this program. This does not actually increment the
+ reference count to the module so we do not need to close the
+ handle. */
+ HANDLE hKernel = GetModuleHandle("kernel32.dll");
+ if(hKernel)
+ {
+ self->P_CreateToolhelp32Snapshot =
+ ((CreateToolhelp32SnapshotType)
+ GetProcAddress(hKernel, "CreateToolhelp32Snapshot"));
+ self->P_Process32First =
+ ((Process32FirstType)
+ GetProcAddress(hKernel, "Process32First"));
+ self->P_Process32Next =
+ ((Process32NextType)
+ GetProcAddress(hKernel, "Process32Next"));
+ }
+ return (self->P_CreateToolhelp32Snapshot &&
+ self->P_Process32First &&
+ self->P_Process32Next)? 1:0;
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcess_List__Delete_Snapshot(kwsysProcess_List* self)
+{
+ if(self->Snapshot)
+ {
+ CloseHandle(self->Snapshot);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__Update_Snapshot(kwsysProcess_List* self)
+{
+ if(self->Snapshot)
+ {
+ CloseHandle(self->Snapshot);
+ }
+ if(!(self->Snapshot =
+ self->P_CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)))
+ {
+ return 0;
+ }
+ ZeroMemory(&self->CurrentEntry, sizeof(self->CurrentEntry));
+ self->CurrentEntry.dwSize = sizeof(self->CurrentEntry);
+ if(!self->P_Process32First(self->Snapshot, &self->CurrentEntry))
+ {
+ CloseHandle(self->Snapshot);
+ self->Snapshot = 0;
+ return 0;
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__Next_Snapshot(kwsysProcess_List* self)
+{
+ if(self->Snapshot)
+ {
+ if(self->P_Process32Next(self->Snapshot, &self->CurrentEntry))
+ {
+ return 1;
+ }
+ CloseHandle(self->Snapshot);
+ self->Snapshot = 0;
+ }
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__GetProcessId_Snapshot(kwsysProcess_List* self)
+{
+ return self->Snapshot? self->CurrentEntry.th32ProcessID : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+static int kwsysProcess_List__GetParentId_Snapshot(kwsysProcess_List* self)
+{
+ return self->Snapshot? self->CurrentEntry.th32ParentProcessID : -1;
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcessKill(DWORD pid)
+{
+ HANDLE h = OpenProcess(PROCESS_TERMINATE, 0, pid);
+ if(h)
+ {
+ TerminateProcess(h, 255);
+ WaitForSingleObject(h, INFINITE);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcessKillTree(int pid)
+{
+ kwsysProcess_List* plist = kwsysProcess_List_New();
+ kwsysProcessKill(pid);
+ if(plist)
+ {
+ do
+ {
+ if(kwsysProcess_List_GetCurrentParentId(plist) == pid)
+ {
+ int ppid = kwsysProcess_List_GetCurrentProcessId(plist);
+ kwsysProcessKillTree(ppid);
+ }
+ } while(kwsysProcess_List_NextProcess(plist));
+ kwsysProcess_List_Delete(plist);
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+static void kwsysProcessDisablePipeThreads(kwsysProcess* cp)
+{
+ int i;
+
+ /* If data were just reported data, release the pipe's thread. */
+ if(cp->CurrentIndex < KWSYSPE_PIPE_COUNT)
+ {
+ ReleaseSemaphore(cp->Pipe[cp->CurrentIndex].Reader.Go, 1, 0);
+ cp->CurrentIndex = KWSYSPE_PIPE_COUNT;
+ }
+
+ /* Wakeup all reading threads that are not on closed pipes. */
+ for(i=0; i < KWSYSPE_PIPE_COUNT; ++i)
+ {
+ /* The wakeup threads will write one byte to the pipe write ends.
+ If there are no data in the pipe then this is enough to wakeup
+ the reading threads. If there are already data in the pipe
+ this may block. We cannot use PeekNamedPipe to check whether
+ there are data because an outside process might still be
+ writing data if we are disowning it. Also, PeekNamedPipe will
+ block if checking a pipe on which the reading thread is
+ currently calling ReadPipe. Therefore we need a separate
+ thread to call WriteFile. If it blocks, that is okay because
+ it will unblock when we close the read end and break the pipe
+ below. */
+ if(cp->Pipe[i].Read)
+ {
+ ReleaseSemaphore(cp->Pipe[i].Waker.Go, 1, 0);
+ }
+ }
+
+ /* Tell pipe threads to reset until we run another process. */
+ while(cp->PipesLeft > 0)
+ {
+ /* The waking threads will cause all reading threads to report.
+ Wait for the next one and save its index. */
+ WaitForSingleObject(cp->Full, INFINITE);
+ cp->CurrentIndex = cp->SharedIndex;
+ ReleaseSemaphore(cp->SharedIndexMutex, 1, 0);
+
+ /* We are done reading this pipe. Close its read handle. */
+ cp->Pipe[cp->CurrentIndex].Closed = 1;
+ kwsysProcessCleanupHandle(&cp->Pipe[cp->CurrentIndex].Read);
+ --cp->PipesLeft;
+
+ /* Tell the reading thread we are done with the data. It will
+ reset immediately because the pipe is closed. */
+ ReleaseSemaphore(cp->Pipe[cp->CurrentIndex].Reader.Go, 1, 0);
+ }
+}
diff --git a/Utilities/ITK/Utilities/kwsys/README.txt b/Utilities/ITK/Utilities/kwsys/README.txt
new file mode 100644
index 0000000000000000000000000000000000000000..ba03f8ddee2a235f1c18c25a1970df28a4435bfe
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/README.txt
@@ -0,0 +1,10 @@
+KWSys provides a platform-independent API to many common system
+features that are implemented differently on every platform. This
+library is intended to be shared among many projects, so it has a
+configurable namespace. Each project should configure KWSys to use a
+namespace unique to itself. See comments in CMakeLists.txt for
+details.
+
+You are probably reading this file in the source tree of a surrounding
+project. In that case, see "../README.kwsys" for details of using
+KWSys in your project.
diff --git a/Utilities/ITK/Utilities/kwsys/Registry.cxx b/Utilities/ITK/Utilities/kwsys/Registry.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..10eb5dd4df09a1949585fa214563b3925ff89bd2
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Registry.cxx
@@ -0,0 +1,817 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Registry.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Registry.hxx)
+
+#include KWSYS_HEADER(Configure.hxx)
+#include KWSYS_HEADER(ios/iostream)
+#include KWSYS_HEADER(stl/string)
+#include KWSYS_HEADER(stl/map)
+#include KWSYS_HEADER(ios/iostream)
+#include KWSYS_HEADER(ios/fstream)
+#include KWSYS_HEADER(ios/sstream)
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "Registry.hxx.in"
+# include "Configure.hxx.in"
+# include "kwsys_stl.hxx.in"
+# include "kwsys_stl_string.hxx.in"
+# include "kwsys_stl_map.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+# include "kwsys_ios_fstream.h.in"
+# include "kwsys_ios_sstream.h.in"
+#endif
+
+#include <ctype.h> // for isspace
+#include <stdio.h>
+
+#ifdef _WIN32
+# include <windows.h>
+#endif
+
+
+namespace KWSYS_NAMESPACE
+{
+class RegistryHelper {
+public:
+ RegistryHelper(Registry::RegistryType registryType);
+ virtual ~RegistryHelper();
+
+ // Read a value from the registry.
+ virtual bool ReadValue(const char *key, const char **value);
+
+ // Delete a key from the registry.
+ virtual bool DeleteKey(const char *key);
+
+ // Delete a value from a given key.
+ virtual bool DeleteValue(const char *key);
+
+ // Set value in a given key.
+ virtual bool SetValue(const char *key, const char *value);
+
+ // Open the registry at toplevel/subkey.
+ virtual bool Open(const char *toplevel, const char *subkey,
+ int readonly);
+
+ // Close the registry.
+ virtual bool Close();
+
+ // Set the value of changed
+ void SetChanged(bool b) { m_Changed = b; }
+ void SetTopLevel(const char* tl);
+ const char* GetTopLevel() { return m_TopLevel.c_str(); }
+
+ //! Read from local or global scope. On Windows this mean from local machine
+ // or local user. On unix this will read from $HOME/.Projectrc or
+ // /etc/Project
+ void SetGlobalScope(bool b);
+ bool GetGlobalScope();
+
+ kwsys_stl::string EncodeKey(const char* str);
+ kwsys_stl::string EncodeValue(const char* str);
+ kwsys_stl::string DecodeValue(const char* str);
+
+protected:
+ bool m_Changed;
+ kwsys_stl::string m_TopLevel;
+ bool m_GlobalScope;
+
+#ifdef _WIN32
+ HKEY HKey;
+#endif
+ // Strip trailing and ending spaces.
+ char *Strip(char *str);
+ void SetSubKey(const char* sk);
+ kwsys_stl::string CreateKey(const char *key);
+
+ typedef kwsys_stl::map<kwsys_stl::string, kwsys_stl::string> StringToStringMap;
+ StringToStringMap EntriesMap;
+ kwsys_stl::string m_SubKey;
+ bool m_Empty;
+ bool m_SubKeySpecified;
+ kwsys_stl::string m_HomeDirectory;
+
+ Registry::RegistryType m_RegistryType;
+};
+
+//----------------------------------------------------------------------------
+#define Registry_BUFFER_SIZE 8192
+
+//----------------------------------------------------------------------------
+Registry::Registry(Registry::RegistryType registryType)
+{
+ m_Opened = false;
+ m_Locked = false;
+ this->Helper = 0;
+ this->Helper = new RegistryHelper(registryType);
+}
+
+//----------------------------------------------------------------------------
+Registry::~Registry()
+{
+ if ( m_Opened )
+ {
+ kwsys_ios::cerr << "Registry::Close should be "
+ "called here. The registry is not closed."
+ << kwsys_ios::endl;
+ }
+ delete this->Helper;
+}
+
+//----------------------------------------------------------------------------
+void Registry::SetGlobalScope(bool b)
+{
+ this->Helper->SetGlobalScope(b);
+}
+
+//----------------------------------------------------------------------------
+bool Registry::GetGlobalScope()
+{
+ return this->Helper->GetGlobalScope();
+}
+
+//----------------------------------------------------------------------------
+bool Registry::Open(const char *toplevel,
+ const char *subkey, int readonly)
+{
+ bool res = false;
+ if ( m_Locked )
+ {
+ return res;
+ }
+ if ( m_Opened )
+ {
+ if ( !this->Close() )
+ {
+ return res;
+ }
+ }
+ if ( !toplevel || !*toplevel )
+ {
+ kwsys_ios::cerr << "Registry::Opened() Toplevel not defined"
+ << kwsys_ios::endl;
+ return res;
+ }
+
+ if ( isspace(toplevel[0]) ||
+ isspace(toplevel[strlen(toplevel)-1]) )
+ {
+ kwsys_ios::cerr << "Toplevel has to start with letter or number and end"
+ " with one" << kwsys_ios::endl;
+ return res;
+ }
+
+ res = this->Helper->Open(toplevel, subkey, readonly);
+ if ( readonly != Registry::READONLY )
+ {
+ m_Locked = true;
+ }
+
+ if ( res )
+ {
+ m_Opened = true;
+ this->Helper->SetTopLevel(toplevel);
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+bool Registry::Close()
+{
+ bool res = false;
+ if ( m_Opened )
+ {
+ res = this->Helper->Close();
+ }
+
+ if ( res )
+ {
+ m_Opened = false;
+ m_Locked = false;
+ this->Helper->SetChanged(false);
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+bool Registry::ReadValue(const char *subkey,
+ const char *key,
+ const char **value)
+{
+ *value = 0;
+ bool res = true;
+ bool open = false;
+ if ( ! value )
+ {
+ return res;
+ }
+ if ( !m_Opened )
+ {
+ if ( !this->Open(this->GetTopLevel(), subkey,
+ Registry::READONLY) )
+ {
+ return res;
+ }
+ open = true;
+ }
+ res = this->Helper->ReadValue(key, value);
+
+ if ( open )
+ {
+ if ( !this->Close() )
+ {
+ res = false;
+ }
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+bool Registry::DeleteKey(const char *subkey, const char *key)
+{
+ bool res = true;
+ bool open = false;
+ if ( !m_Opened )
+ {
+ if ( !this->Open(this->GetTopLevel(), subkey,
+ Registry::READWRITE) )
+ {
+ return res;
+ }
+ open = true;
+ }
+
+ res = this->Helper->DeleteKey(key);
+ if ( res )
+ {
+ this->Helper->SetChanged(true);
+ }
+
+ if ( open )
+ {
+ if ( !this->Close() )
+ {
+ res = false;
+ }
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+bool Registry::DeleteValue(const char *subkey, const char *key)
+{
+ bool res = true;
+ bool open = false;
+ if ( !m_Opened )
+ {
+ if ( !this->Open(this->GetTopLevel(), subkey,
+ Registry::READWRITE) )
+ {
+ return res;
+ }
+ open = true;
+ }
+
+ res = this->Helper->DeleteValue(key);
+ if ( res )
+ {
+ this->Helper->SetChanged(true);
+ }
+
+ if ( open )
+ {
+ if ( !this->Close() )
+ {
+ res = false;
+ }
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+bool Registry::SetValue(const char *subkey, const char *key,
+ const char *value)
+{
+ bool res = false;
+ bool open = false;
+ if ( !m_Opened )
+ {
+ if ( !this->Open(this->GetTopLevel(), subkey,
+ Registry::READWRITE) )
+ {
+ return res;
+ }
+ open = true;
+ }
+
+ res = this->Helper->SetValue( key, value );
+ if ( res )
+ {
+ this->Helper->SetChanged(true);
+ }
+
+ if ( open )
+ {
+ if ( !this->Close() )
+ {
+ res = false;
+ }
+ }
+ return res;
+}
+
+//----------------------------------------------------------------------------
+const char* Registry::GetTopLevel()
+{
+ return this->Helper->GetTopLevel();
+}
+
+//----------------------------------------------------------------------------
+void Registry::SetTopLevel(const char* tl)
+{
+ this->Helper->SetTopLevel(tl);
+}
+
+//----------------------------------------------------------------------------
+void RegistryHelper::SetTopLevel(const char* tl)
+{
+ if ( tl )
+ {
+ m_TopLevel = tl;
+ }
+ else
+ {
+ m_TopLevel = "";
+ }
+}
+
+//----------------------------------------------------------------------------
+RegistryHelper::RegistryHelper(Registry::RegistryType registryType)
+{
+ m_Changed = false;
+ m_TopLevel = "";
+ m_SubKey = "";
+ m_SubKeySpecified = false;
+ m_Empty = true;
+ m_GlobalScope = false;
+ m_RegistryType = registryType;
+}
+
+//----------------------------------------------------------------------------
+RegistryHelper::~RegistryHelper()
+{
+}
+
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::Open(const char *toplevel, const char *subkey,
+ int readonly)
+{
+ this->EntriesMap.clear();
+ m_Empty = 1;
+
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ HKEY scope = HKEY_CURRENT_USER;
+ if ( this->GetGlobalScope() )
+ {
+ scope = HKEY_LOCAL_MACHINE;
+ }
+ int res = 0;
+ kwsys_ios::ostringstream str;
+ DWORD dwDummy;
+ str << "Software\\Kitware\\" << toplevel << "\\" << subkey;
+ if ( readonly == Registry::READONLY )
+ {
+ res = ( RegOpenKeyEx(scope, str.str().c_str(),
+ 0, KEY_READ, &this->HKey) == ERROR_SUCCESS );
+ }
+ else
+ {
+ res = ( RegCreateKeyEx(scope, str.str().c_str(),
+ 0, "", REG_OPTION_NON_VOLATILE, KEY_READ|KEY_WRITE,
+ NULL, &this->HKey, &dwDummy) == ERROR_SUCCESS );
+ }
+ if ( res != 0 )
+ {
+ this->SetSubKey( subkey );
+ }
+ return (res != 0);
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ bool res = false;
+ int cc;
+ kwsys_ios::ostringstream str;
+ const char* homeDirectory;
+ if ( (homeDirectory = getenv("HOME")) == 0 )
+ {
+ if ( (homeDirectory = getenv("USERPROFILE")) == 0 )
+ {
+ return false;
+ }
+ }
+ m_HomeDirectory = homeDirectory;
+ str << m_HomeDirectory.c_str() << "/." << toplevel << "rc";
+ if ( readonly == Registry::READWRITE )
+ {
+ kwsys_ios::ofstream ofs( str.str().c_str(), kwsys_ios::ios::out|kwsys_ios::ios::app );
+ if ( ofs.fail() )
+ {
+ return false;
+ }
+ ofs.close();
+ }
+
+ kwsys_ios::ifstream *ifs = new kwsys_ios::ifstream(str.str().c_str(), kwsys_ios::ios::in
+#ifndef KWSYS_IOS_USE_ANSI
+ | kwsys_ios::ios::nocreate
+#endif
+ );
+ if ( !ifs )
+ {
+ return false;
+ }
+ if ( ifs->fail())
+ {
+ delete ifs;
+ return false;
+ }
+
+ res = true;
+ char buffer[Registry_BUFFER_SIZE];
+ while( !ifs->fail() )
+ {
+ ifs->getline(buffer, Registry_BUFFER_SIZE);
+ if ( ifs->fail() || ifs->eof() )
+ {
+ break;
+ }
+ char *line = this->Strip(buffer);
+ if ( *line == '#' || *line == 0 )
+ {
+ // Comment
+ continue;
+ }
+ int linelen = static_cast<int>(strlen(line));
+ for ( cc = 0; cc < linelen; cc++ )
+ {
+ if ( line[cc] == '=' )
+ {
+ char *key = new char[ cc+1 ];
+ strncpy( key, line, cc );
+ key[cc] = 0;
+ char *value = line + cc + 1;
+ char *nkey = this->Strip(key);
+ char *nvalue = this->Strip(value);
+ this->EntriesMap[nkey] = this->DecodeValue(nvalue);
+ m_Empty = 0;
+ delete [] key;
+ break;
+ }
+ }
+ }
+ ifs->close();
+ this->SetSubKey( subkey );
+ delete ifs;
+ return res;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::Close()
+{
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ int res;
+ res = ( RegCloseKey(this->HKey) == ERROR_SUCCESS );
+ return (res != 0);
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ if ( !m_Changed )
+ {
+ this->SetSubKey(0);
+ return true;
+ }
+
+ kwsys_ios::ostringstream str;
+ str << m_HomeDirectory.c_str() << "/." << this->GetTopLevel() << "rc";
+ kwsys_ios::ofstream *ofs = new kwsys_ios::ofstream(str.str().c_str(), kwsys_ios::ios::out);
+ if ( !ofs )
+ {
+ return false;
+ }
+ if ( ofs->fail())
+ {
+ delete ofs;
+ return false;
+ }
+ *ofs << "# This file is automatically generated by the application" << kwsys_ios::endl
+ << "# If you change any lines or add new lines, note that all" << kwsys_ios::endl
+ << "# comments and empty lines will be deleted. Every line has" << kwsys_ios::endl
+ << "# to be in format: " << kwsys_ios::endl
+ << "# key = value" << kwsys_ios::endl
+ << "#" << kwsys_ios::endl;
+
+ if ( !this->EntriesMap.empty() )
+ {
+ RegistryHelper::StringToStringMap::iterator it;
+ for ( it = this->EntriesMap.begin();
+ it != this->EntriesMap.end();
+ ++ it )
+ {
+ *ofs << it->first.c_str() << " = " << this->EncodeValue(it->second.c_str()).c_str() << kwsys_ios::endl;
+ }
+ }
+ this->EntriesMap.clear();
+ ofs->close();
+ delete ofs;
+ this->SetSubKey(0);
+ m_Empty = 1;
+ return true;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::ReadValue(const char *skey, const char **value)
+
+{
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ kwsys_stl::string key = this->CreateKey( skey );
+ if ( key.empty() )
+ {
+ return false;
+ }
+ DWORD dwType, dwSize;
+ dwType = REG_SZ;
+ char buffer[1024]; // Replace with RegQueryInfoKey
+ dwSize = sizeof(buffer);
+ int res = ( RegQueryValueEx(this->HKey, skey, NULL, &dwType,
+ (BYTE *)buffer, &dwSize) == ERROR_SUCCESS );
+ if ( !res )
+ {
+ return false;
+ }
+ this->EntriesMap[key] = buffer;
+ RegistryHelper::StringToStringMap::iterator it
+ = this->EntriesMap.find(key);
+ *value = it->second.c_str();
+ return true;
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ bool res = false;
+ kwsys_stl::string key = this->CreateKey( skey );
+ if ( key.empty() )
+ {
+ return false;
+ }
+
+ RegistryHelper::StringToStringMap::iterator it
+ = this->EntriesMap.find(key);
+ if ( it != this->EntriesMap.end() )
+ {
+ *value = it->second.c_str();
+ res = true;
+ }
+ return res;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::DeleteKey(const char* skey)
+{
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ int res = ( RegDeleteKey( this->HKey, skey ) == ERROR_SUCCESS );
+ return (res != 0);
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ kwsys_stl::string key = this->CreateKey( skey );
+ if ( key.empty() )
+ {
+ return false;
+ }
+ this->EntriesMap.erase(key);
+ return true;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::DeleteValue(const char *skey)
+{
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ int res = ( RegDeleteValue( this->HKey, skey ) == ERROR_SUCCESS );
+ return (res != 0);
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ kwsys_stl::string key = this->CreateKey( skey );
+ if ( key.empty() )
+ {
+ return false;
+ }
+ this->EntriesMap.erase(key);
+ return true;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::SetValue(const char *skey, const char *value)
+{
+#ifdef _WIN32
+ if ( m_RegistryType == Registry::WIN32_REGISTRY)
+ {
+ DWORD len = (DWORD)(value ? strlen(value) : 0);
+ int res = ( RegSetValueEx(this->HKey, skey, 0, REG_SZ,
+ (CONST BYTE *)(const char *)value,
+ len+1) == ERROR_SUCCESS );
+ return (res != 0);
+ }
+#endif
+ if ( m_RegistryType == Registry::FILE_REGISTRY )
+ {
+ kwsys_stl::string key = this->CreateKey( skey );
+ if ( key.empty() )
+ {
+ return 0;
+ }
+ this->EntriesMap[key] = value;
+ return 1;
+ }
+ return false;
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string RegistryHelper::CreateKey( const char *key )
+{
+ if ( !m_SubKeySpecified || m_SubKey.empty() || !key )
+ {
+ return "";
+ }
+ kwsys_ios::ostringstream ostr;
+ ostr << this->EncodeKey(this->m_SubKey.c_str()).c_str()
+ << "\\" << this->EncodeKey(key).c_str();
+ return ostr.str();
+}
+
+//----------------------------------------------------------------------------
+void RegistryHelper::SetSubKey(const char* sk)
+{
+ if ( !sk )
+ {
+ m_SubKey = "";
+ m_SubKeySpecified = false;
+ }
+ else
+ {
+ m_SubKey = sk;
+ m_SubKeySpecified = true;
+ }
+}
+
+//----------------------------------------------------------------------------
+char *RegistryHelper::Strip(char *str)
+{
+ int cc;
+ int len;
+ char *nstr;
+ if ( !str )
+ {
+ return NULL;
+ }
+ len = strlen(str);
+ nstr = str;
+ for( cc=0; cc<len; cc++ )
+ {
+ if ( !isspace( *nstr ) )
+ {
+ break;
+ }
+ nstr ++;
+ }
+ for( cc=(strlen(nstr)-1); cc>=0; cc-- )
+ {
+ if ( !isspace( nstr[cc] ) )
+ {
+ nstr[cc+1] = 0;
+ break;
+ }
+ }
+ return nstr;
+}
+
+//----------------------------------------------------------------------------
+void RegistryHelper::SetGlobalScope(bool b)
+{
+ m_GlobalScope = b;
+}
+
+//----------------------------------------------------------------------------
+bool RegistryHelper::GetGlobalScope()
+{
+ return m_GlobalScope;
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string RegistryHelper::EncodeKey(const char* str)
+{
+ kwsys_ios::ostringstream ostr;
+ while ( *str )
+ {
+ switch ( *str )
+ {
+ case '%': case '=': case '\n': case '\r': case '\t':
+ char buffer[4];
+ sprintf(buffer, "%%%02X", *str);
+ ostr << buffer;
+ break;
+ default:
+ ostr << *str;
+ }
+ str ++;
+ }
+ return ostr.str();
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string RegistryHelper::EncodeValue(const char* str)
+{
+ kwsys_ios::ostringstream ostr;
+ while ( *str )
+ {
+ switch ( *str )
+ {
+ case '%': case '=': case '\n': case '\r': case '\t':
+ char buffer[4];
+ sprintf(buffer, "%%%02X", *str);
+ ostr << buffer;
+ break;
+ default:
+ ostr << *str;
+ }
+ str ++;
+ }
+ return ostr.str();
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string RegistryHelper::DecodeValue(const char* str)
+{
+ kwsys_ios::ostringstream ostr;
+ while ( *str )
+ {
+ unsigned int val;
+ switch ( *str )
+ {
+ case '%':
+ if ( *(str+1) && *(str+2) && sscanf(str+1, "%x", &val) == 1 )
+ {
+ ostr << static_cast<char>(val);
+ str += 2;
+ }
+ else
+ {
+ ostr << *str;
+ }
+ break;
+ default:
+ ostr << *str;
+ }
+ str ++;
+ }
+ return ostr.str();
+}
+
+} // namespace KWSYS_NAMESPACE
diff --git a/Utilities/ITK/Utilities/kwsys/Registry.hxx.in b/Utilities/ITK/Utilities/kwsys/Registry.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..c7f29bb5ec75d007055b6fd3df7eebf8be49a5b8
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/Registry.hxx.in
@@ -0,0 +1,109 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: Registry.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_Registry_hxx
+#define @KWSYS_NAMESPACE@_Registry_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+
+#include <@KWSYS_NAMESPACE@/stl/string>
+
+namespace @KWSYS_NAMESPACE@
+{
+
+class RegistryHelper;
+
+/** \class Registry
+ * \brief Portable registry class
+ *
+ * This class abstracts the storing of data that can be restored
+ * when the program executes again. On Win32 platform it is
+ * implemented using the registry and on unix as a file in
+ * the user's home directory.
+ */
+class @KWSYS_NAMESPACE@_EXPORT Registry
+{
+public:
+ enum RegistryType
+ {
+#ifdef _WIN32
+ WIN32_REGISTRY,
+#endif
+ FILE_REGISTRY
+ };
+
+#ifdef _WIN32
+ Registry(RegistryType registryType = WIN32_REGISTRY);
+#else
+ Registry(RegistryType registryType = FILE_REGISTRY);
+#endif
+
+ virtual ~Registry();
+
+ //! Read a value from the registry.
+ bool ReadValue(const char *subkey, const char *key, const char **value);
+
+ //! Delete a key from the registry.
+ bool DeleteKey(const char *subkey, const char *key);
+
+ //! Delete a value from a given key.
+ bool DeleteValue(const char *subkey, const char *key);
+
+ //! Set value in a given key.
+ bool SetValue(const char *subkey, const char *key,
+ const char *value);
+
+ //! Open the registry at toplevel/subkey.
+ bool Open(const char *toplevel, const char *subkey,
+ int readonly);
+
+ //! Close the registry.
+ bool Close();
+
+ //! Read from local or global scope. On Windows this mean from local machine
+ // or local user. On unix this will read from $HOME/.Projectrc or
+ // /etc/Project
+ void GlobalScopeOn() { this->SetGlobalScope(1); }
+ void GlobalScopeOff() { this->SetGlobalScope(0); }
+ void SetGlobalScope(bool b);
+ bool GetGlobalScope();
+
+ // Set or get the toplevel registry key.
+ void SetTopLevel(const char* tl);
+ const char* GetTopLevel();
+
+ // Return true if registry opened
+ bool GetOpened() { return m_Opened; }
+
+ // Should the registry be locked?
+ bool GetLocked() { return m_Locked; }
+
+ enum {
+ READONLY,
+ READWRITE
+ };
+
+ // Return true if the character is space.
+ int IsSpace(char c);
+
+private:
+ RegistryHelper* Helper;
+
+ bool m_Opened;
+
+ bool m_Locked;
+}; // End Class: Registry
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/RegularExpression.cxx b/Utilities/ITK/Utilities/kwsys/RegularExpression.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b66bb73b24fc357578a2ea3fb2df32abe60dff01
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/RegularExpression.cxx
@@ -0,0 +1,1217 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: RegularExpression.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+//
+// Copyright (C) 1991 Texas Instruments Incorporated.
+//
+// Permission is granted to any individual or institution to use, copy, modify
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated provides this software "as is" without
+// express or implied warranty.
+//
+//
+// Created: MNF 06/13/89 Initial Design and Implementation
+// Updated: LGO 08/09/89 Inherit from Generic
+// Updated: MBN 09/07/89 Added conditional exception handling
+// Updated: MBN 12/15/89 Sprinkled "const" qualifiers all over the place!
+// Updated: DLS 03/22/91 New lite version
+//
+
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(RegularExpression.hxx)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "RegularExpression.hxx.in"
+#endif
+
+#include <stdio.h>
+#include <string.h>
+
+namespace KWSYS_NAMESPACE
+{
+
+// RegularExpression -- Copies the given regular expression.
+RegularExpression::RegularExpression (const RegularExpression& rxp) {
+ if ( !rxp.program )
+ {
+ this->program = 0;
+ return;
+ }
+ int ind;
+ this->progsize = rxp.progsize; // Copy regular expression size
+ this->program = new char[this->progsize]; // Allocate storage
+ for(ind=this->progsize; ind-- != 0;) // Copy regular expresion
+ this->program[ind] = rxp.program[ind];
+ this->startp[0] = rxp.startp[0]; // Copy pointers into last
+ this->endp[0] = rxp.endp[0]; // Successful "find" operation
+ this->regmust = rxp.regmust; // Copy field
+ if (rxp.regmust != 0) {
+ char* dum = rxp.program;
+ ind = 0;
+ while (dum != rxp.regmust) {
+ ++dum;
+ ++ind;
+ }
+ this->regmust = this->program + ind;
+ }
+ this->regstart = rxp.regstart; // Copy starting index
+ this->reganch = rxp.reganch; // Copy remaining private data
+ this->regmlen = rxp.regmlen; // Copy remaining private data
+}
+
+// operator== -- Returns true if two regular expressions have the same
+// compiled program for pattern matching.
+bool RegularExpression::operator== (const RegularExpression& rxp) const {
+ if (this != &rxp) { // Same address?
+ int ind = this->progsize; // Get regular expression size
+ if (ind != rxp.progsize) // If different size regexp
+ return false; // Return failure
+ while(ind-- != 0) // Else while still characters
+ if(this->program[ind] != rxp.program[ind]) // If regexp are different
+ return false; // Return failure
+ }
+ return true; // Else same, return success
+}
+
+
+// deep_equal -- Returns true if have the same compiled regular expressions
+// and the same start and end pointers.
+
+bool RegularExpression::deep_equal (const RegularExpression& rxp) const {
+ int ind = this->progsize; // Get regular expression size
+ if (ind != rxp.progsize) // If different size regexp
+ return false; // Return failure
+ while(ind-- != 0) // Else while still characters
+ if(this->program[ind] != rxp.program[ind]) // If regexp are different
+ return false; // Return failure
+ return (this->startp[0] == rxp.startp[0] && // Else if same start/end ptrs,
+ this->endp[0] == rxp.endp[0]); // Return true
+}
+
+// The remaining code in this file is derived from the regular expression code
+// whose copyright statement appears below. It has been changed to work
+// with the class concepts of C++ and COOL.
+
+/*
+ * compile and find
+ *
+ * Copyright (c) 1986 by University of Toronto.
+ * Written by Henry Spencer. Not derived from licensed software.
+ *
+ * Permission is granted to anyone to use this software for any
+ * purpose on any computer system, and to redistribute it freely,
+ * subject to the following restrictions:
+ *
+ * 1. The author is not responsible for the consequences of use of
+ * this software, no matter how awful, even if they arise
+ * from defects in it.
+ *
+ * 2. The origin of this software must not be misrepresented, either
+ * by explicit claim or by omission.
+ *
+ * 3. Altered versions must be plainly marked as such, and must not
+ * be misrepresented as being the original software.
+ *
+ * Beware that some of this code is subtly aware of the way operator
+ * precedence is structured in regular expressions. Serious changes in
+ * regular-expression syntax might require a total rethink.
+ */
+
+/*
+ * The "internal use only" fields in regexp.h are present to pass info from
+ * compile to execute that permits the execute phase to run lots faster on
+ * simple cases. They are:
+ *
+ * regstart char that must begin a match; '\0' if none obvious
+ * reganch is the match anchored (at beginning-of-line only)?
+ * regmust string (pointer into program) that match must include, or NULL
+ * regmlen length of regmust string
+ *
+ * Regstart and reganch permit very fast decisions on suitable starting points
+ * for a match, cutting down the work a lot. Regmust permits fast rejection
+ * of lines that cannot possibly match. The regmust tests are costly enough
+ * that compile() supplies a regmust only if the r.e. contains something
+ * potentially expensive (at present, the only such thing detected is * or +
+ * at the start of the r.e., which can involve a lot of backup). Regmlen is
+ * supplied because the test in find() needs it and compile() is computing
+ * it anyway.
+ */
+
+/*
+ * Structure for regexp "program". This is essentially a linear encoding
+ * of a nondeterministic finite-state machine (aka syntax charts or
+ * "railroad normal form" in parsing technology). Each node is an opcode
+ * plus a "next" pointer, possibly plus an operand. "Next" pointers of
+ * all nodes except BRANCH implement concatenation; a "next" pointer with
+ * a BRANCH on both ends of it is connecting two alternatives. (Here we
+ * have one of the subtle syntax dependencies: an individual BRANCH (as
+ * opposed to a collection of them) is never concatenated with anything
+ * because of operator precedence.) The operand of some types of node is
+ * a literal string; for others, it is a node leading into a sub-FSM. In
+ * particular, the operand of a BRANCH node is the first node of the branch.
+ * (NB this is *not* a tree structure: the tail of the branch connects
+ * to the thing following the set of BRANCHes.) The opcodes are:
+ */
+
+// definition number opnd? meaning
+#define END 0 // no End of program.
+#define BOL 1 // no Match "" at beginning of line.
+#define EOL 2 // no Match "" at end of line.
+#define ANY 3 // no Match any one character.
+#define ANYOF 4 // str Match any character in this string.
+#define ANYBUT 5 // str Match any character not in this
+ // string.
+#define BRANCH 6 // node Match this alternative, or the
+ // next...
+#define BACK 7 // no Match "", "next" ptr points backward.
+#define EXACTLY 8 // str Match this string.
+#define NOTHING 9 // no Match empty string.
+#define STAR 10 // node Match this (simple) thing 0 or more
+ // times.
+#define PLUS 11 // node Match this (simple) thing 1 or more
+ // times.
+#define OPEN 20 // no Mark this point in input as start of
+ // #n.
+// OPEN+1 is number 1, etc.
+#define CLOSE 30 // no Analogous to OPEN.
+
+/*
+ * Opcode notes:
+ *
+ * BRANCH The set of branches constituting a single choice are hooked
+ * together with their "next" pointers, since precedence prevents
+ * anything being concatenated to any individual branch. The
+ * "next" pointer of the last BRANCH in a choice points to the
+ * thing following the whole choice. This is also where the
+ * final "next" pointer of each individual branch points; each
+ * branch starts with the operand node of a BRANCH node.
+ *
+ * BACK Normal "next" pointers all implicitly point forward; BACK
+ * exists to make loop structures possible.
+ *
+ * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
+ * BRANCH structures using BACK. Simple cases (one character
+ * per match) are implemented with STAR and PLUS for speed
+ * and to minimize recursive plunges.
+ *
+ * OPEN,CLOSE ...are numbered at compile time.
+ */
+
+/*
+ * A node is one char of opcode followed by two chars of "next" pointer.
+ * "Next" pointers are stored as two 8-bit pieces, high order first. The
+ * value is a positive offset from the opcode of the node containing it.
+ * An operand, if any, simply follows the node. (Note that much of the
+ * code generation knows about this implicit relationship.)
+ *
+ * Using two bytes for the "next" pointer is vast overkill for most things,
+ * but allows patterns to get big without disasters.
+ */
+
+#define OP(p) (*(p))
+#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
+#define OPERAND(p) ((p) + 3)
+
+const unsigned char MAGIC = 0234;
+/*
+ * Utility definitions.
+ */
+
+#define UCHARAT(p) ((const unsigned char*)(p))[0]
+
+
+#define FAIL(m) { regerror(m); return(0); }
+#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?')
+#define META "^$.[()|?+*\\"
+
+
+/*
+ * Flags to be passed up and down.
+ */
+#define HASWIDTH 01 // Known never to match null string.
+#define SIMPLE 02 // Simple enough to be STAR/PLUS operand.
+#define SPSTART 04 // Starts with * or +.
+#define WORST 0 // Worst case.
+
+
+
+/////////////////////////////////////////////////////////////////////////
+//
+// COMPILE AND ASSOCIATED FUNCTIONS
+//
+/////////////////////////////////////////////////////////////////////////
+
+
+/*
+ * Global work variables for compile().
+ */
+static const char* regparse; // Input-scan pointer.
+static int regnpar; // () count.
+static char regdummy;
+static char* regcode; // Code-emit pointer; ®dummy = don't.
+static long regsize; // Code size.
+
+/*
+ * Forward declarations for compile()'s friends.
+ */
+// #ifndef static
+// #define static static
+// #endif
+static char* reg (int, int*);
+static char* regbranch (int*);
+static char* regpiece (int*);
+static char* regatom (int*);
+static char* regnode (char);
+static const char* regnext (register const char*);
+static char* regnext (register char*);
+static void regc (unsigned char);
+static void reginsert (char, char*);
+static void regtail (char*, const char*);
+static void regoptail (char*, const char*);
+
+#ifdef STRCSPN
+static int strcspn ();
+#endif
+
+
+
+/*
+ * We can't allocate space until we know how big the compiled form will be,
+ * but we can't compile it (and thus know how big it is) until we've got a
+ * place to put the code. So we cheat: we compile it twice, once with code
+ * generation turned off and size counting turned on, and once "for real".
+ * This also means that we don't allocate space until we are sure that the
+ * thing really will compile successfully, and we never have to move the
+ * code and thus invalidate pointers into it. (Note that it has to be in
+ * one piece because free() must be able to free it all.)
+ *
+ * Beware that the optimization-preparation code in here knows about some
+ * of the structure of the compiled regexp.
+ */
+
+
+// compile -- compile a regular expression into internal code
+// for later pattern matching.
+
+bool RegularExpression::compile (const char* exp) {
+ register const char* scan;
+ register const char* longest;
+ register unsigned long len;
+ int flags;
+
+ if (exp == 0) {
+ //RAISE Error, SYM(RegularExpression), SYM(No_Expr),
+ printf ("RegularExpression::compile(): No expression supplied.\n");
+ return false;
+ }
+
+ // First pass: determine size, legality.
+ regparse = exp;
+ regnpar = 1;
+ regsize = 0L;
+ regcode = ®dummy;
+ regc(MAGIC);
+ if(!reg(0, &flags))
+ {
+ printf ("RegularExpression::compile(): Error in compile.\n");
+ return false;
+ }
+ this->startp[0] = this->endp[0] = this->searchstring = 0;
+
+ // Small enough for pointer-storage convention?
+ if (regsize >= 32767L) { // Probably could be 65535L.
+ //RAISE Error, SYM(RegularExpression), SYM(Expr_Too_Big),
+ printf ("RegularExpression::compile(): Expression too big.\n");
+ return false;
+ }
+
+ // Allocate space.
+//#ifndef WIN32
+ if (this->program != 0) delete [] this->program;
+//#endif
+ this->program = new char[regsize];
+ this->progsize = static_cast<int>(regsize);
+
+ if (this->program == 0) {
+ //RAISE Error, SYM(RegularExpression), SYM(Out_Of_Memory),
+ printf ("RegularExpression::compile(): Out of memory.\n");
+ return false;
+ }
+
+ // Second pass: emit code.
+ regparse = exp;
+ regnpar = 1;
+ regcode = this->program;
+ regc(MAGIC);
+ reg(0, &flags);
+
+ // Dig out information for optimizations.
+ this->regstart = '\0'; // Worst-case defaults.
+ this->reganch = 0;
+ this->regmust = 0;
+ this->regmlen = 0;
+ scan = this->program + 1; // First BRANCH.
+ if (OP(regnext(scan)) == END) { // Only one top-level choice.
+ scan = OPERAND(scan);
+
+ // Starting-point info.
+ if (OP(scan) == EXACTLY)
+ this->regstart = *OPERAND(scan);
+ else if (OP(scan) == BOL)
+ this->reganch++;
+
+ //
+ // If there's something expensive in the r.e., find the longest
+ // literal string that must appear and make it the regmust. Resolve
+ // ties in favor of later strings, since the regstart check works
+ // with the beginning of the r.e. and avoiding duplication
+ // strengthens checking. Not a strong reason, but sufficient in the
+ // absence of others.
+ //
+ if (flags & SPSTART) {
+ longest = 0;
+ len = 0;
+ for (; scan != 0; scan = regnext(scan))
+ if (OP(scan) == EXACTLY && strlen(OPERAND(scan)) >= len) {
+ longest = OPERAND(scan);
+ len = int(strlen(OPERAND(scan)));
+ }
+ this->regmust = longest;
+ this->regmlen = len;
+ }
+ }
+ return true;
+}
+
+
+/*
+ - reg - regular expression, i.e. main body or parenthesized thing
+ *
+ * Caller must absorb opening parenthesis.
+ *
+ * Combining parenthesis handling with the base level of regular expression
+ * is a trifle forced, but the need to tie the tails of the branches to what
+ * follows makes it hard to avoid.
+ */
+static char* reg (int paren, int *flagp) {
+ register char* ret;
+ register char* br;
+ register char* ender;
+ register int parno =0;
+ int flags;
+
+ *flagp = HASWIDTH; // Tentatively.
+
+ // Make an OPEN node, if parenthesized.
+ if (paren) {
+ if (regnpar >= RegularExpression::NSUBEXP) {
+ //RAISE Error, SYM(RegularExpression), SYM(Too_Many_Parens),
+ printf ("RegularExpression::compile(): Too many parentheses.\n");
+ return 0;
+ }
+ parno = regnpar;
+ regnpar++;
+ ret = regnode(static_cast<char>(OPEN + parno));
+ }
+ else
+ ret = 0;
+
+ // Pick up the branches, linking them together.
+ br = regbranch(&flags);
+ if (br == 0)
+ return (0);
+ if (ret != 0)
+ regtail(ret, br); // OPEN -> first.
+ else
+ ret = br;
+ if (!(flags & HASWIDTH))
+ *flagp &= ~HASWIDTH;
+ *flagp |= flags & SPSTART;
+ while (*regparse == '|') {
+ regparse++;
+ br = regbranch(&flags);
+ if (br == 0)
+ return (0);
+ regtail(ret, br); // BRANCH -> BRANCH.
+ if (!(flags & HASWIDTH))
+ *flagp &= ~HASWIDTH;
+ *flagp |= flags & SPSTART;
+ }
+
+ // Make a closing node, and hook it on the end.
+ ender = regnode(static_cast<char>((paren) ? CLOSE + parno : END));
+ regtail(ret, ender);
+
+ // Hook the tails of the branches to the closing node.
+ for (br = ret; br != 0; br = regnext(br))
+ regoptail(br, ender);
+
+ // Check for proper termination.
+ if (paren && *regparse++ != ')') {
+ //RAISE Error, SYM(RegularExpression), SYM(Unmatched_Parens),
+ printf ("RegularExpression::compile(): Unmatched parentheses.\n");
+ return 0;
+ }
+ else if (!paren && *regparse != '\0') {
+ if (*regparse == ')') {
+ //RAISE Error, SYM(RegularExpression), SYM(Unmatched_Parens),
+ printf ("RegularExpression::compile(): Unmatched parentheses.\n");
+ return 0;
+ }
+ else {
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::compile(): Internal error.\n");
+ return 0;
+ }
+ // NOTREACHED
+ }
+ return (ret);
+}
+
+
+/*
+ - regbranch - one alternative of an | operator
+ *
+ * Implements the concatenation operator.
+ */
+static char* regbranch (int *flagp) {
+ register char* ret;
+ register char* chain;
+ register char* latest;
+ int flags;
+
+ *flagp = WORST; // Tentatively.
+
+ ret = regnode(BRANCH);
+ chain = 0;
+ while (*regparse != '\0' && *regparse != '|' && *regparse != ')') {
+ latest = regpiece(&flags);
+ if (latest == 0)
+ return (0);
+ *flagp |= flags & HASWIDTH;
+ if (chain == 0) // First piece.
+ *flagp |= flags & SPSTART;
+ else
+ regtail(chain, latest);
+ chain = latest;
+ }
+ if (chain == 0) // Loop ran zero times.
+ regnode(NOTHING);
+
+ return (ret);
+}
+
+
+/*
+ - regpiece - something followed by possible [*+?]
+ *
+ * Note that the branching code sequences used for ? and the general cases
+ * of * and + are somewhat optimized: they use the same NOTHING node as
+ * both the endmarker for their branch list and the body of the last branch.
+ * It might seem that this node could be dispensed with entirely, but the
+ * endmarker role is not redundant.
+ */
+static char* regpiece (int *flagp) {
+ register char* ret;
+ register char op;
+ register char* next;
+ int flags;
+
+ ret = regatom(&flags);
+ if (ret == 0)
+ return (0);
+
+ op = *regparse;
+ if (!ISMULT(op)) {
+ *flagp = flags;
+ return (ret);
+ }
+
+ if (!(flags & HASWIDTH) && op != '?') {
+ //RAISE Error, SYM(RegularExpression), SYM(Empty_Operand),
+ printf ("RegularExpression::compile() : *+ operand could be empty.\n");
+ return 0;
+ }
+ *flagp = (op != '+') ? (WORST | SPSTART) : (WORST | HASWIDTH);
+
+ if (op == '*' && (flags & SIMPLE))
+ reginsert(STAR, ret);
+ else if (op == '*') {
+ // Emit x* as (x&|), where & means "self".
+ reginsert(BRANCH, ret); // Either x
+ regoptail(ret, regnode(BACK)); // and loop
+ regoptail(ret, ret); // back
+ regtail(ret, regnode(BRANCH)); // or
+ regtail(ret, regnode(NOTHING)); // null.
+ }
+ else if (op == '+' && (flags & SIMPLE))
+ reginsert(PLUS, ret);
+ else if (op == '+') {
+ // Emit x+ as x(&|), where & means "self".
+ next = regnode(BRANCH); // Either
+ regtail(ret, next);
+ regtail(regnode(BACK), ret); // loop back
+ regtail(next, regnode(BRANCH)); // or
+ regtail(ret, regnode(NOTHING)); // null.
+ }
+ else if (op == '?') {
+ // Emit x? as (x|)
+ reginsert(BRANCH, ret); // Either x
+ regtail(ret, regnode(BRANCH)); // or
+ next = regnode(NOTHING);// null.
+ regtail(ret, next);
+ regoptail(ret, next);
+ }
+ regparse++;
+ if (ISMULT(*regparse)) {
+ //RAISE Error, SYM(RegularExpression), SYM(Nested_Operand),
+ printf ("RegularExpression::compile(): Nested *?+.\n");
+ return 0;
+ }
+ return (ret);
+}
+
+
+/*
+ - regatom - the lowest level
+ *
+ * Optimization: gobbles an entire sequence of ordinary characters so that
+ * it can turn them into a single node, which is smaller to store and
+ * faster to run. Backslashed characters are exceptions, each becoming a
+ * separate node; the code is simpler that way and it's not worth fixing.
+ */
+static char* regatom (int *flagp) {
+ register char* ret;
+ int flags;
+
+ *flagp = WORST; // Tentatively.
+
+ switch (*regparse++) {
+ case '^':
+ ret = regnode(BOL);
+ break;
+ case '$':
+ ret = regnode(EOL);
+ break;
+ case '.':
+ ret = regnode(ANY);
+ *flagp |= HASWIDTH | SIMPLE;
+ break;
+ case '[':{
+ register int rxpclass;
+ register int rxpclassend;
+
+ if (*regparse == '^') { // Complement of range.
+ ret = regnode(ANYBUT);
+ regparse++;
+ }
+ else
+ ret = regnode(ANYOF);
+ if (*regparse == ']' || *regparse == '-')
+ regc(*regparse++);
+ while (*regparse != '\0' && *regparse != ']') {
+ if (*regparse == '-') {
+ regparse++;
+ if (*regparse == ']' || *regparse == '\0')
+ regc('-');
+ else {
+ rxpclass = UCHARAT(regparse - 2) + 1;
+ rxpclassend = UCHARAT(regparse);
+ if (rxpclass > rxpclassend + 1) {
+ //RAISE Error, SYM(RegularExpression), SYM(Invalid_Range),
+ printf ("RegularExpression::compile(): Invalid range in [].\n");
+ return 0;
+ }
+ for (; rxpclass <= rxpclassend; rxpclass++)
+ regc(static_cast<unsigned char>(rxpclass));
+ regparse++;
+ }
+ }
+ else
+ regc(*regparse++);
+ }
+ regc('\0');
+ if (*regparse != ']') {
+ //RAISE Error, SYM(RegularExpression), SYM(Unmatched_Bracket),
+ printf ("RegularExpression::compile(): Unmatched [].\n");
+ return 0;
+ }
+ regparse++;
+ *flagp |= HASWIDTH | SIMPLE;
+ }
+ break;
+ case '(':
+ ret = reg(1, &flags);
+ if (ret == 0)
+ return (0);
+ *flagp |= flags & (HASWIDTH | SPSTART);
+ break;
+ case '\0':
+ case '|':
+ case ')':
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::compile(): Internal error.\n"); // Never here
+ return 0;
+ case '?':
+ case '+':
+ case '*':
+ //RAISE Error, SYM(RegularExpression), SYM(No_Operand),
+ printf ("RegularExpression::compile(): ?+* follows nothing.\n");
+ return 0;
+ case '\\':
+ if (*regparse == '\0') {
+ //RAISE Error, SYM(RegularExpression), SYM(Trailing_Backslash),
+ printf ("RegularExpression::compile(): Trailing backslash.\n");
+ return 0;
+ }
+ ret = regnode(EXACTLY);
+ regc(*regparse++);
+ regc('\0');
+ *flagp |= HASWIDTH | SIMPLE;
+ break;
+ default:{
+ register int len;
+ register char ender;
+
+ regparse--;
+ len = int(strcspn(regparse, META));
+ if (len <= 0) {
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::compile(): Internal error.\n");
+ return 0;
+ }
+ ender = *(regparse + len);
+ if (len > 1 && ISMULT(ender))
+ len--; // Back off clear of ?+* operand.
+ *flagp |= HASWIDTH;
+ if (len == 1)
+ *flagp |= SIMPLE;
+ ret = regnode(EXACTLY);
+ while (len > 0) {
+ regc(*regparse++);
+ len--;
+ }
+ regc('\0');
+ }
+ break;
+ }
+ return (ret);
+}
+
+
+/*
+ - regnode - emit a node
+ Location.
+ */
+static char* regnode (char op) {
+ register char* ret;
+ register char* ptr;
+
+ ret = regcode;
+ if (ret == ®dummy) {
+ regsize += 3;
+ return (ret);
+ }
+
+ ptr = ret;
+ *ptr++ = op;
+ *ptr++ = '\0'; // Null "next" pointer.
+ *ptr++ = '\0';
+ regcode = ptr;
+
+ return (ret);
+}
+
+
+/*
+ - regc - emit (if appropriate) a byte of code
+ */
+static void regc (unsigned char b) {
+ if (regcode != ®dummy)
+ *regcode++ = b;
+ else
+ regsize++;
+}
+
+
+/*
+ - reginsert - insert an operator in front of already-emitted operand
+ *
+ * Means relocating the operand.
+ */
+static void reginsert (char op, char* opnd) {
+ register char* src;
+ register char* dst;
+ register char* place;
+
+ if (regcode == ®dummy) {
+ regsize += 3;
+ return;
+ }
+
+ src = regcode;
+ regcode += 3;
+ dst = regcode;
+ while (src > opnd)
+ *--dst = *--src;
+
+ place = opnd; // Op node, where operand used to be.
+ *place++ = op;
+ *place++ = '\0';
+ *place = '\0';
+}
+
+
+/*
+ - regtail - set the next-pointer at the end of a node chain
+ */
+static void regtail (char* p, const char* val) {
+ register char* scan;
+ register char* temp;
+ register int offset;
+
+ if (p == ®dummy)
+ return;
+
+ // Find last node.
+ scan = p;
+ for (;;) {
+ temp = regnext(scan);
+ if (temp == 0)
+ break;
+ scan = temp;
+ }
+
+ if (OP(scan) == BACK)
+ offset = int(scan - val);
+ else
+ offset = int(val - scan);
+ *(scan + 1) = static_cast<char>((offset >> 8) & 0377);
+ *(scan + 2) = static_cast<char>(offset & 0377);
+}
+
+
+/*
+ - regoptail - regtail on operand of first argument; nop if operandless
+ */
+static void regoptail (char* p, const char* val) {
+ // "Operandless" and "op != BRANCH" are synonymous in practice.
+ if (p == 0 || p == ®dummy || OP(p) != BRANCH)
+ return;
+ regtail(OPERAND(p), val);
+}
+
+
+
+////////////////////////////////////////////////////////////////////////
+//
+// find and friends
+//
+////////////////////////////////////////////////////////////////////////
+
+
+/*
+ * Global work variables for find().
+ */
+static const char* reginput; // String-input pointer.
+static const char* regbol; // Beginning of input, for ^ check.
+static const char* *regstartp; // Pointer to startp array.
+static const char* *regendp; // Ditto for endp.
+
+/*
+ * Forwards.
+ */
+static int regtry (const char*, const char* *,
+ const char* *, const char*);
+static int regmatch (const char*);
+static int regrepeat (const char*);
+
+#ifdef DEBUG
+int regnarrate = 0;
+void regdump ();
+static char* regprop ();
+#endif
+
+bool RegularExpression::find (kwsys_stl::string const& s)
+{
+ return find(s.c_str());
+}
+
+
+
+// find -- Matches the regular expression to the given string.
+// Returns true if found, and sets start and end indexes accordingly.
+
+bool RegularExpression::find (const char* string) {
+ register const char* s;
+
+ this->searchstring = string;
+
+ if (!this->program)
+ {
+ return false;
+ }
+
+ // Check validity of program.
+ if (UCHARAT(this->program) != MAGIC) {
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::find(): Compiled regular expression corrupted.\n");
+ return 0;
+ }
+
+ // If there is a "must appear" string, look for it.
+ if (this->regmust != 0) {
+ s = string;
+ while ((s = strchr(s, this->regmust[0])) != 0) {
+ if (strncmp(s, this->regmust, this->regmlen) == 0)
+ break; // Found it.
+ s++;
+ }
+ if (s == 0) // Not present.
+ return (0);
+ }
+
+ // Mark beginning of line for ^ .
+ regbol = string;
+
+ // Simplest case: anchored match need be tried only once.
+ if (this->reganch)
+ return (regtry(string, this->startp, this->endp, this->program) != 0);
+
+ // Messy cases: unanchored match.
+ s = string;
+ if (this->regstart != '\0')
+ // We know what char it must start with.
+ while ((s = strchr(s, this->regstart)) != 0) {
+ if (regtry(s, this->startp, this->endp, this->program))
+ return (1);
+ s++;
+
+ }
+ else
+ // We don't -- general case.
+ do {
+ if (regtry(s, this->startp, this->endp, this->program))
+ return (1);
+ } while (*s++ != '\0');
+
+ // Failure.
+ return (0);
+}
+
+
+/*
+ - regtry - try match at specific point
+ 0 failure, 1 success
+ */
+static int regtry (const char* string, const char* *start,
+ const char* *end, const char* prog) {
+ register int i;
+ register const char* *sp1;
+ register const char* *ep;
+
+ reginput = string;
+ regstartp = start;
+ regendp = end;
+
+ sp1 = start;
+ ep = end;
+ for (i = RegularExpression::NSUBEXP; i > 0; i--) {
+ *sp1++ = 0;
+ *ep++ = 0;
+ }
+ if (regmatch(prog + 1)) {
+ start[0] = string;
+ end[0] = reginput;
+ return (1);
+ }
+ else
+ return (0);
+}
+
+
+/*
+ - regmatch - main matching routine
+ *
+ * Conceptually the strategy is simple: check to see whether the current
+ * node matches, call self recursively to see whether the rest matches,
+ * and then act accordingly. In practice we make some effort to avoid
+ * recursion, in particular by going through "ordinary" nodes (that don't
+ * need to know whether the rest of the match failed) by a loop instead of
+ * by recursion.
+ * 0 failure, 1 success
+ */
+static int regmatch (const char* prog) {
+ register const char* scan; // Current node.
+ const char* next; // Next node.
+
+ scan = prog;
+
+ while (scan != 0) {
+
+ next = regnext(scan);
+
+ switch (OP(scan)) {
+ case BOL:
+ if (reginput != regbol)
+ return (0);
+ break;
+ case EOL:
+ if (*reginput != '\0')
+ return (0);
+ break;
+ case ANY:
+ if (*reginput == '\0')
+ return (0);
+ reginput++;
+ break;
+ case EXACTLY:{
+ register int len;
+ register const char* opnd;
+
+ opnd = OPERAND(scan);
+ // Inline the first character, for speed.
+ if (*opnd != *reginput)
+ return (0);
+ len = int(strlen(opnd));
+ if (len > 1 && strncmp(opnd, reginput, len) != 0)
+ return (0);
+ reginput += len;
+ }
+ break;
+ case ANYOF:
+ if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == 0)
+ return (0);
+ reginput++;
+ break;
+ case ANYBUT:
+ if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != 0)
+ return (0);
+ reginput++;
+ break;
+ case NOTHING:
+ break;
+ case BACK:
+ break;
+ case OPEN + 1:
+ case OPEN + 2:
+ case OPEN + 3:
+ case OPEN + 4:
+ case OPEN + 5:
+ case OPEN + 6:
+ case OPEN + 7:
+ case OPEN + 8:
+ case OPEN + 9:{
+ register int no;
+ register const char* save;
+
+ no = OP(scan) - OPEN;
+ save = reginput;
+
+ if (regmatch(next)) {
+
+ //
+ // Don't set startp if some later invocation of the
+ // same parentheses already has.
+ //
+ if (regstartp[no] == 0)
+ regstartp[no] = save;
+ return (1);
+ }
+ else
+ return (0);
+ }
+// break;
+ case CLOSE + 1:
+ case CLOSE + 2:
+ case CLOSE + 3:
+ case CLOSE + 4:
+ case CLOSE + 5:
+ case CLOSE + 6:
+ case CLOSE + 7:
+ case CLOSE + 8:
+ case CLOSE + 9:{
+ register int no;
+ register const char* save;
+
+ no = OP(scan) - CLOSE;
+ save = reginput;
+
+ if (regmatch(next)) {
+
+ //
+ // Don't set endp if some later invocation of the
+ // same parentheses already has.
+ //
+ if (regendp[no] == 0)
+ regendp[no] = save;
+ return (1);
+ }
+ else
+ return (0);
+ }
+// break;
+ case BRANCH:{
+
+ register const char* save;
+
+ if (OP(next) != BRANCH) // No choice.
+ next = OPERAND(scan); // Avoid recursion.
+ else {
+ do {
+ save = reginput;
+ if (regmatch(OPERAND(scan)))
+ return (1);
+ reginput = save;
+ scan = regnext(scan);
+ } while (scan != 0 && OP(scan) == BRANCH);
+ return (0);
+ // NOTREACHED
+ }
+ }
+ break;
+ case STAR:
+ case PLUS:{
+ register char nextch;
+ register int no;
+ register const char* save;
+ register int min_no;
+
+ //
+ // Lookahead to avoid useless match attempts when we know
+ // what character comes next.
+ //
+ nextch = '\0';
+ if (OP(next) == EXACTLY)
+ nextch = *OPERAND(next);
+ min_no = (OP(scan) == STAR) ? 0 : 1;
+ save = reginput;
+ no = regrepeat(OPERAND(scan));
+ while (no >= min_no) {
+ // If it could work, try it.
+ if (nextch == '\0' || *reginput == nextch)
+ if (regmatch(next))
+ return (1);
+ // Couldn't or didn't -- back up.
+ no--;
+ reginput = save + no;
+ }
+ return (0);
+ }
+// break;
+ case END:
+ return (1); // Success!
+
+ default:
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::find(): Internal error -- memory corrupted.\n");
+ return 0;
+ }
+ scan = next;
+ }
+
+ //
+ // We get here only if there's trouble -- normally "case END" is the
+ // terminating point.
+ //
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("RegularExpression::find(): Internal error -- corrupted pointers.\n");
+ return (0);
+}
+
+
+/*
+ - regrepeat - repeatedly match something simple, report how many
+ */
+static int regrepeat (const char* p) {
+ register int count = 0;
+ register const char* scan;
+ register const char* opnd;
+
+ scan = reginput;
+ opnd = OPERAND(p);
+ switch (OP(p)) {
+ case ANY:
+ count = int(strlen(scan));
+ scan += count;
+ break;
+ case EXACTLY:
+ while (*opnd == *scan) {
+ count++;
+ scan++;
+ }
+ break;
+ case ANYOF:
+ while (*scan != '\0' && strchr(opnd, *scan) != 0) {
+ count++;
+ scan++;
+ }
+ break;
+ case ANYBUT:
+ while (*scan != '\0' && strchr(opnd, *scan) == 0) {
+ count++;
+ scan++;
+ }
+ break;
+ default: // Oh dear. Called inappropriately.
+ //RAISE Error, SYM(RegularExpression), SYM(Internal_Error),
+ printf ("cm RegularExpression::find(): Internal error.\n");
+ return 0;
+ }
+ reginput = scan;
+ return (count);
+}
+
+
+/*
+ - regnext - dig the "next" pointer out of a node
+ */
+static const char* regnext (register const char* p) {
+ register int offset;
+
+ if (p == ®dummy)
+ return (0);
+
+ offset = NEXT(p);
+ if (offset == 0)
+ return (0);
+
+ if (OP(p) == BACK)
+ return (p - offset);
+ else
+ return (p + offset);
+}
+
+
+static char* regnext (register char* p) {
+ register int offset;
+
+ if (p == ®dummy)
+ return (0);
+
+ offset = NEXT(p);
+ if (offset == 0)
+ return (0);
+
+ if (OP(p) == BACK)
+ return (p - offset);
+ else
+ return (p + offset);
+}
+
+} // namespace KWSYS_NAMESPACE
diff --git a/Utilities/ITK/Utilities/kwsys/RegularExpression.hxx.in b/Utilities/ITK/Utilities/kwsys/RegularExpression.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..d88f6bcb12ceace64b03e41a8ee1d50380c1bbcf
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/RegularExpression.hxx.in
@@ -0,0 +1,392 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: RegularExpression.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+// Original Copyright notice:
+// Copyright (C) 1991 Texas Instruments Incorporated.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated provides this software "as is" without
+// express or implied warranty.
+//
+// Created: MNF 06/13/89 Initial Design and Implementation
+// Updated: LGO 08/09/89 Inherit from Generic
+// Updated: MBN 09/07/89 Added conditional exception handling
+// Updated: MBN 12/15/89 Sprinkled "const" qualifiers all over the place!
+// Updated: DLS 03/22/91 New lite version
+//
+
+#ifndef @KWSYS_NAMESPACE@_RegularExpression_hxx
+#define @KWSYS_NAMESPACE@_RegularExpression_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#include <@KWSYS_NAMESPACE@/stl/string>
+
+/* Define this macro temporarily to keep the code readable. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+/** \class RegularExpression
+ * \brief Implements pattern matching with regular expressions.
+ *
+ * This is the header file for the regular expression class. An object of
+ * this class contains a regular expression, in a special "compiled" format.
+ * This compiled format consists of several slots all kept as the objects
+ * private data. The RegularExpression class provides a convenient way to
+ * represent regular expressions. It makes it easy to search for the same
+ * regular expression in many different strings without having to compile a
+ * string to regular expression format more than necessary.
+ *
+ * This class implements pattern matching via regular expressions.
+ * A regular expression allows a programmer to specify complex
+ * patterns that can be searched for and matched against the
+ * character string of a string object. In its simplest form, a
+ * regular expression is a sequence of characters used to
+ * search for exact character matches. However, many times the
+ * exact sequence to be found is not known, or only a match at
+ * the beginning or end of a string is desired. The RegularExpression regu-
+ * lar expression class implements regular expression pattern
+ * matching as is found and implemented in many UNIX commands
+ * and utilities.
+ *
+ * Example: The perl code
+ *
+ * $filename =~ m"([a-z]+)\.cc";
+ * print $1;
+ *
+ * Is written as follows in C++
+ *
+ * RegularExpression re("([a-z]+)\\.cc");
+ * re.find(filename);
+ * cerr << re.match(1);
+ *
+ *
+ * The regular expression class provides a convenient mechanism
+ * for specifying and manipulating regular expressions. The
+ * regular expression object allows specification of such pat-
+ * terns by using the following regular expression metacharac-
+ * ters:
+ *
+ * ^ Matches at beginning of a line
+ *
+ * $ Matches at end of a line
+ *
+ * . Matches any single character
+ *
+ * [ ] Matches any character(s) inside the brackets
+ *
+ * [^ ] Matches any character(s) not inside the brackets
+ *
+ * - Matches any character in range on either side of a dash
+ *
+ * * Matches preceding pattern zero or more times
+ *
+ * + Matches preceding pattern one or more times
+ *
+ * ? Matches preceding pattern zero or once only
+ *
+ * () Saves a matched expression and uses it in a later match
+ *
+ * Note that more than one of these metacharacters can be used
+ * in a single regular expression in order to create complex
+ * search patterns. For example, the pattern [^ab1-9] says to
+ * match any character sequence that does not begin with the
+ * characters "ab" followed by numbers in the series one
+ * through nine.
+ *
+ * There are three constructors for RegularExpression. One just creates an
+ * empty RegularExpression object. Another creates a RegularExpression
+ * object and initializes it with a regular expression that is given in the
+ * form of a char*. The third takes a reference to a RegularExpression
+ * object as an argument and creates an object initialized with the
+ * information from the given RegularExpression object.
+ *
+ * The find member function finds the first occurence of the regualr
+ * expression of that object in the string given to find as an argument. Find
+ * returns a boolean, and if true, mutates the private data appropriately.
+ * Find sets pointers to the beginning and end of the thing last found, they
+ * are pointers into the actual string that was searched. The start and end
+ * member functions return indicies into the searched string that correspond
+ * to the beginning and end pointers respectively. The compile member
+ * function takes a char* and puts the compiled version of the char* argument
+ * into the object's private data fields. The == and != operators only check
+ * the to see if the compiled regular expression is the same, and the
+ * deep_equal functions also checks to see if the start and end pointers are
+ * the same. The is_valid function returns false if program is set to NULL,
+ * (i.e. there is no valid compiled exression). The set_invalid function sets
+ * the program to NULL (Warning: this deletes the compiled expression). The
+ * following examples may help clarify regular expression usage:
+ *
+ * * The regular expression "^hello" matches a "hello" only at the
+ * beginning of a line. It would match "hello there" but not "hi,
+ * hello there".
+ *
+ * * The regular expression "long$" matches a "long" only at the end
+ * of a line. It would match "so long\0", but not "long ago".
+ *
+ * * The regular expression "t..t..g" will match anything that has a
+ * "t" then any two characters, another "t", any two characters and
+ * then a "g". It will match "testing", or "test again" but would
+ * not match "toasting"
+ *
+ * * The regular expression "[1-9ab]" matches any number one through
+ * nine, and the characters "a" and "b". It would match "hello 1"
+ * or "begin", but would not match "no-match".
+ *
+ * * The regular expression "[^1-9ab]" matches any character that is
+ * not a number one through nine, or an "a" or "b". It would NOT
+ * match "hello 1" or "begin", but would match "no-match".
+ *
+ * * The regular expression "br* " matches something that begins with
+ * a "b", is followed by zero or more "r"s, and ends in a space. It
+ * would match "brrrrr ", and "b ", but would not match "brrh ".
+ *
+ * * The regular expression "br+ " matches something that begins with
+ * a "b", is followed by one or more "r"s, and ends in a space. It
+ * would match "brrrrr ", and "br ", but would not match "b " or
+ * "brrh ".
+ *
+ * * The regular expression "br? " matches something that begins with
+ * a "b", is followed by zero or one "r"s, and ends in a space. It
+ * would match "br ", and "b ", but would not match "brrrr " or
+ * "brrh ".
+ *
+ * * The regular expression "(..p)b" matches something ending with pb
+ * and beginning with whatever the two characters before the first p
+ * encounterd in the line were. It would find "repb" in "rep drepa
+ * qrepb". The regular expression "(..p)a" would find "repa qrepb"
+ * in "rep drepa qrepb"
+ *
+ * * The regular expression "d(..p)" matches something ending with p,
+ * beginning with d, and having two characters in between that are
+ * the same as the two characters before the first p encounterd in
+ * the line. It would match "drepa qrepb" in "rep drepa qrepb".
+ *
+ */
+class @KWSYS_NAMESPACE@_EXPORT RegularExpression
+{
+public:
+ /**
+ * Instantiate RegularExpression with program=NULL.
+ */
+ inline RegularExpression ();
+
+ /**
+ * Instantiate RegularExpression with compiled char*.
+ */
+ inline RegularExpression (char const*);
+
+ /**
+ * Instantiate RegularExpression as a copy of another regular expression.
+ */
+ RegularExpression (RegularExpression const&);
+
+ /**
+ * Destructor.
+ */
+ inline ~RegularExpression();
+
+ /**
+ * Compile a regular expression into internal code
+ * for later pattern matching.
+ */
+ bool compile (char const*);
+
+ /**
+ * Matches the regular expression to the given string.
+ * Returns true if found, and sets start and end indexes accordingly.
+ */
+ bool find (char const*);
+
+ /**
+ * Matches the regular expression to the given std string.
+ * Returns true if found, and sets start and end indexes accordingly.
+ */
+ bool find (kwsys_stl::string const&);
+
+ /**
+ * Index to start of first find.
+ */
+ inline kwsys_stl::string::size_type start() const;
+
+ /**
+ * Index to end of first find.
+ */
+ inline kwsys_stl::string::size_type end() const;
+
+ /**
+ * Returns true if two regular expressions have the same
+ * compiled program for pattern matching.
+ */
+ bool operator== (RegularExpression const&) const;
+
+ /**
+ * Returns true if two regular expressions have different
+ * compiled program for pattern matching.
+ */
+ inline bool operator!= (RegularExpression const&) const;
+
+ /**
+ * Returns true if have the same compiled regular expressions
+ * and the same start and end pointers.
+ */
+ bool deep_equal (RegularExpression const&) const;
+
+ /**
+ * True if the compiled regexp is valid.
+ */
+ inline bool is_valid() const;
+
+ /**
+ * Marks the regular expression as invalid.
+ */
+ inline void set_invalid();
+
+ /**
+ * Destructor.
+ */
+ // awf added
+ kwsys_stl::string::size_type start(int n) const;
+ kwsys_stl::string::size_type end(int n) const;
+ kwsys_stl::string match(int n) const;
+
+ enum { NSUBEXP = 10 };
+private:
+ const char* startp[NSUBEXP];
+ const char* endp[NSUBEXP];
+ char regstart; // Internal use only
+ char reganch; // Internal use only
+ const char* regmust; // Internal use only
+ unsigned long regmlen; // Internal use only
+ char* program;
+ int progsize;
+ const char* searchstring;
+};
+
+/**
+ * Create an empty regular expression.
+ */
+inline RegularExpression::RegularExpression ()
+{
+ this->program = 0;
+}
+
+/**
+ * Creates a regular expression from string s, and
+ * compiles s.
+ */
+inline RegularExpression::RegularExpression (const char* s)
+{
+ this->program = 0;
+ if ( s )
+ {
+ this->compile(s);
+ }
+}
+
+/**
+ * Destroys and frees space allocated for the regular expression.
+ */
+inline RegularExpression::~RegularExpression ()
+{
+//#ifndef WIN32
+ delete [] this->program;
+//#endif
+}
+
+/**
+ * Set the start position for the regular expression.
+ */
+inline kwsys_stl::string::size_type RegularExpression::start () const
+{
+ return(this->startp[0] - searchstring);
+}
+
+
+/**
+ * Returns the start/end index of the last item found.
+ */
+inline kwsys_stl::string::size_type RegularExpression::end () const
+{
+ return(this->endp[0] - searchstring);
+}
+
+/**
+ * Returns true if two regular expressions have different
+ * compiled program for pattern matching.
+ */
+inline bool RegularExpression::operator!= (const RegularExpression& r) const
+{
+ return(!(*this == r));
+}
+
+/**
+ * Returns true if a valid regular expression is compiled
+ * and ready for pattern matching.
+ */
+inline bool RegularExpression::is_valid () const
+{
+ return (this->program != 0);
+}
+
+
+inline void RegularExpression::set_invalid ()
+{
+//#ifndef WIN32
+ delete [] this->program;
+//#endif
+ this->program = 0;
+}
+
+/**
+ * Return start index of nth submatch. start(0) is the start of the full match.
+ */
+inline kwsys_stl::string::size_type RegularExpression::start(int n) const
+{
+ return this->startp[n] - searchstring;
+}
+
+
+/**
+ * Return end index of nth submatch. end(0) is the end of the full match.
+ */
+inline kwsys_stl::string::size_type RegularExpression::end(int n) const
+{
+ return this->endp[n] - searchstring;
+}
+
+/**
+ * Return nth submatch as a string.
+ */
+inline kwsys_stl::string RegularExpression::match(int n) const
+{
+ return kwsys_stl::string(this->startp[n], this->endp[n] - this->startp[n]);
+}
+
+} // namespace @KWSYS_NAMESPACE@
+
+/* Undefine temporary macro. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# undef kwsys_stl
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/SharedForward.h.in b/Utilities/ITK/Utilities/kwsys/SharedForward.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..110d2b06f7af87406a537c5c3217450e1fcdcf5a
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/SharedForward.h.in
@@ -0,0 +1,672 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: SharedForward.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_SharedForward_h
+#define @KWSYS_NAMESPACE@_SharedForward_h
+
+/*
+ This header is used to create a forwarding executable sets up the
+ shared library search path and replaces itself with a real
+ executable. This is useful when creating installations on UNIX with
+ shared libraries that will run from any install directory. Typical
+ usage:
+
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_DIR_BUILD "/path/to/foo-build/bin"
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_BUILD "."
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_INSTALL "../lib/foo-1.2"
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_BUILD "foo-real"
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_INSTALL "../lib/foo-1.2/foo-real"
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_PRINT "--print"
+ #define @KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_LDD "--ldd"
+ #if defined(CMAKE_INTDIR)
+ # define @KWSYS_NAMESPACE@_SHARED_FORWARD_CONFIG_NAME CMAKE_INTDIR
+ #endif
+ #include <@KWSYS_NAMESPACE@/SharedForward.h>
+ int main(int argc, char** argv)
+ {
+ return @KWSYS_NAMESPACE@_shared_forward_to_real(argc, argv);
+ }
+ */
+
+/*--------------------------------------------------------------------------*/
+/* Configuration for this executable. Specify search and executable
+ paths relative to the forwarding executable location or as full
+ paths. Include no trailing slash. */
+
+/* Full path to the directory in which this executable is built. Do
+ not include a trailing slash. */
+#if !defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_DIR_BUILD)
+# error "Must define @KWSYS_NAMESPACE@_SHARED_FORWARD_DIR_BUILD"
+#endif
+#if !defined(KWSYS_SHARED_FORWARD_DIR_BUILD)
+# define KWSYS_SHARED_FORWARD_DIR_BUILD @KWSYS_NAMESPACE@_SHARED_FORWARD_DIR_BUILD
+#endif
+
+/* Library search path for build tree. */
+#if !defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_BUILD)
+# error "Must define @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_BUILD"
+#endif
+#if !defined(KWSYS_SHARED_FORWARD_PATH_BUILD)
+# define KWSYS_SHARED_FORWARD_PATH_BUILD @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_BUILD
+#endif
+
+/* Library search path for install tree. */
+#if !defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_INSTALL)
+# error "Must define @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_INSTALL"
+#endif
+#if !defined(KWSYS_SHARED_FORWARD_PATH_INSTALL)
+# define KWSYS_SHARED_FORWARD_PATH_INSTALL @KWSYS_NAMESPACE@_SHARED_FORWARD_PATH_INSTALL
+#endif
+
+/* The real executable to which to forward in the build tree. */
+#if !defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_BUILD)
+# error "Must define @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_BUILD"
+#endif
+#if !defined(KWSYS_SHARED_FORWARD_EXE_BUILD)
+# define KWSYS_SHARED_FORWARD_EXE_BUILD @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_BUILD
+#endif
+
+/* The real executable to which to forward in the install tree. */
+#if !defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_INSTALL)
+# error "Must define @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_INSTALL"
+#endif
+#if !defined(KWSYS_SHARED_FORWARD_EXE_INSTALL)
+# define KWSYS_SHARED_FORWARD_EXE_INSTALL @KWSYS_NAMESPACE@_SHARED_FORWARD_EXE_INSTALL
+#endif
+
+/* The configuration name with which this executable was built (Debug/Release). */
+#if defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_CONFIG_NAME)
+# define KWSYS_SHARED_FORWARD_CONFIG_NAME @KWSYS_NAMESPACE@_SHARED_FORWARD_CONFIG_NAME
+#else
+# undef KWSYS_SHARED_FORWARD_CONFIG_NAME
+#endif
+
+/* Create command line option to print environment setting and exit. */
+#if defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_PRINT)
+# if !defined(KWSYS_SHARED_FORWARD_OPTION_PRINT)
+# define KWSYS_SHARED_FORWARD_OPTION_PRINT @KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_PRINT
+# endif
+#else
+# undef KWSYS_SHARED_FORWARD_OPTION_PRINT
+#endif
+
+/* Create command line option to run ldd or equivalent. */
+#if defined(@KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_LDD)
+# if !defined(KWSYS_SHARED_FORWARD_OPTION_LDD)
+# define KWSYS_SHARED_FORWARD_OPTION_LDD @KWSYS_NAMESPACE@_SHARED_FORWARD_OPTION_LDD
+# endif
+#else
+# undef KWSYS_SHARED_FORWARD_OPTION_LDD
+#endif
+
+/*--------------------------------------------------------------------------*/
+/* Include needed system headers. */
+
+#include <limits.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <stdio.h>
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+# include <io.h>
+# include <windows.h>
+# include <process.h>
+#else
+# include <unistd.h>
+#endif
+
+/*--------------------------------------------------------------------------*/
+/* Configuration for this platform. */
+
+/* The path separator for this platform. */
+#if defined(_WIN32) && !defined(__CYGWIN__)
+# define KWSYS_SHARED_FORWARD_PATH_SEP ';'
+# define KWSYS_SHARED_FORWARD_PATH_SLASH '\\'
+#else
+# define KWSYS_SHARED_FORWARD_PATH_SEP ':'
+# define KWSYS_SHARED_FORWARD_PATH_SLASH '/'
+#endif
+static const char kwsys_shared_forward_path_sep[2] = {KWSYS_SHARED_FORWARD_PATH_SEP, 0};
+static const char kwsys_shared_forward_path_slash[2] = {KWSYS_SHARED_FORWARD_PATH_SLASH, 0};
+
+/* The maximum length of a file name. */
+#if defined(PATH_MAX)
+# define KWSYS_SHARED_FORWARD_MAXPATH PATH_MAX
+#elif defined(MAXPATHLEN)
+# define KWSYS_SHARED_FORWARD_MAXPATH MAXPATHLEN
+#else
+# define KWSYS_SHARED_FORWARD_MAXPATH 16384
+#endif
+
+/* Select the environment variable holding the shared library runtime
+ search path for this platform and build configuration. Also select
+ ldd command equivalent. */
+
+/* Linux */
+#if defined(__linux)
+# define KWSYS_SHARED_FORWARD_LDD "ldd"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+#endif
+
+/* FreeBSD */
+#if defined(__FreeBSD__)
+# define KWSYS_SHARED_FORWARD_LDD "ldd"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+#endif
+
+/* OSX */
+#if defined(__APPLE__)
+# define KWSYS_SHARED_FORWARD_LDD "otool", "-L"
+# define KWSYS_SHARED_FORWARD_LDD_N 2
+# define KWSYS_SHARED_FORWARD_LDPATH "DYLD_LIBRARY_PATH"
+#endif
+
+/* AIX */
+#if defined(_AIX)
+# define KWSYS_SHARED_FORWARD_LDD "dump", "-H"
+# define KWSYS_SHARED_FORWARD_LDD_N 2
+# define KWSYS_SHARED_FORWARD_LDPATH "LIBPATH"
+#endif
+
+/* SUN */
+#if defined(__sparc)
+# define KWSYS_SHARED_FORWARD_LDD "ldd"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# include <sys/isa_defs.h>
+# if defined(_ILP32)
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+# elif defined(_LP64)
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH_64"
+# endif
+#endif
+
+/* HP-UX */
+#if defined(__hpux)
+# define KWSYS_SHARED_FORWARD_LDD "chatr"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# if defined(__LP64__)
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+# else
+# define KWSYS_SHARED_FORWARD_LDPATH "SHLIB_PATH"
+# endif
+#endif
+
+/* SGI MIPS */
+#if defined(__sgi) && defined(_MIPS_SIM)
+# define KWSYS_SHARED_FORWARD_LDD "ldd"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# if _MIPS_SIM == _ABIO32
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+# elif _MIPS_SIM == _ABIN32
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARYN32_PATH"
+# elif _MIPS_SIM == _ABI64
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY64_PATH"
+# endif
+#endif
+
+/* Windows */
+#if defined(_WIN32)
+# if defined(__CYGWIN__)
+# define KWSYS_SHARED_FORWARD_LDD "cygcheck"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# endif
+# define KWSYS_SHARED_FORWARD_LDPATH "PATH"
+#endif
+
+/* Guess on this unknown system. */
+#if !defined(KWSYS_SHARED_FORWARD_LDPATH)
+# define KWSYS_SHARED_FORWARD_LDD "ldd"
+# define KWSYS_SHARED_FORWARD_LDD_N 1
+# define KWSYS_SHARED_FORWARD_LDPATH "LD_LIBRARY_PATH"
+#endif
+
+/*--------------------------------------------------------------------------*/
+/* Function to convert a logical or relative path to a physical full path. */
+static int kwsys_shared_forward_realpath(const char* in_path, char* out_path)
+{
+#if defined(_WIN32) && !defined(__CYGWIN__)
+ /* Implementation for Windows. */
+ DWORD n = GetFullPathName(in_path, KWSYS_SHARED_FORWARD_MAXPATH,
+ out_path, 0);
+ return n > 0 && n <= KWSYS_SHARED_FORWARD_MAXPATH;
+#else
+ /* Implementation for UNIX. */
+ return realpath(in_path, out_path) != 0;
+#endif
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to report a system error message. */
+static void kwsys_shared_forward_strerror(char* message)
+{
+#if defined(_WIN32) && !defined(__CYGWIN__)
+ /* Implementation for Windows. */
+ DWORD original = GetLastError();
+ DWORD length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
+ FORMAT_MESSAGE_IGNORE_INSERTS, 0, original,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+ message, KWSYS_SHARED_FORWARD_MAXPATH, 0);
+ if(length < 1 || length > KWSYS_SHARED_FORWARD_MAXPATH)
+ {
+ /* FormatMessage failed. Use a default message. */
+ _snprintf(message, KWSYS_SHARED_FORWARD_MAXPATH,
+ "Error 0x%X (FormatMessage failed with error 0x%X)",
+ original, GetLastError());
+ }
+#else
+ /* Implementation for UNIX. */
+ strcpy(message, strerror(errno));
+#endif
+}
+
+/*--------------------------------------------------------------------------*/
+/* Functions to execute a child process. */
+static void kwsys_shared_forward_execv(const char* cmd, char* const argv[])
+{
+#if defined(_MSC_VER)
+ _execv(cmd, argv);
+#else
+ execv(cmd, argv);
+#endif
+}
+static void kwsys_shared_forward_execvp(const char* cmd, char* const argv[])
+{
+#if defined(_MSC_VER)
+ _execvp(cmd, argv);
+#else
+ execvp(cmd, argv);
+#endif
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to get the directory containing the given file or directory. */
+static void kwsys_shared_forward_dirname(const char* begin, char* result)
+{
+ /* Find the location of the last slash. */
+ int last_slash_index = -1;
+ const char* end = begin + strlen(begin);
+ for(;begin <= end && last_slash_index < 0; --end)
+ {
+ if(*end == '/' || *end == '\\')
+ {
+ last_slash_index = end-begin;
+ }
+ }
+
+ /* Handle each case of the index of the last slash. */
+ if(last_slash_index < 0)
+ {
+ /* No slashes. */
+ strcpy(result, ".");
+ }
+ else if(last_slash_index == 0)
+ {
+ /* Only one leading slash. */
+ strcpy(result, kwsys_shared_forward_path_slash);
+ }
+#if defined(_WIN32)
+ else if(last_slash_index == 2 && begin[1] == ':')
+ {
+ /* Only one leading drive letter and slash. */
+ strncpy(result, begin, last_slash_index);
+ result[last_slash_index] = KWSYS_SHARED_FORWARD_PATH_SLASH;
+ result[last_slash_index+1] = 0;
+ }
+#endif
+ else
+ {
+ /* A non-leading slash. */
+ strncpy(result, begin, last_slash_index);
+ result[last_slash_index] = 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to check if a file exists and is executable. */
+static int kwsys_shared_forward_is_executable(const char* f)
+{
+#if defined(_MSC_VER)
+# define KWSYS_SHARED_FORWARD_ACCESS _access
+#else
+# define KWSYS_SHARED_FORWARD_ACCESS access
+#endif
+#if defined(X_OK)
+# define KWSYS_SHARED_FORWARD_ACCESS_OK X_OK
+#else
+# define KWSYS_SHARED_FORWARD_ACCESS_OK 04
+#endif
+ if(KWSYS_SHARED_FORWARD_ACCESS(f, KWSYS_SHARED_FORWARD_ACCESS_OK) == 0)
+ {
+ return 1;
+ }
+ else
+ {
+ return 0;
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to locate the executable currently running. */
+static int kwsys_shared_forward_self_path(const char* argv0, char* result)
+{
+ /* Check whether argv0 has a slash. */
+ int has_slash = 0;
+ const char* p = argv0;
+ for(;*p && !has_slash; ++p)
+ {
+ if(*p == '/' || *p == '\\')
+ {
+ has_slash = 1;
+ }
+ }
+
+ if(has_slash)
+ {
+ /* There is a slash. Use the dirname of the given location. */
+ kwsys_shared_forward_dirname(argv0, result);
+ return 1;
+ }
+ else
+ {
+ /* There is no slash. Search the PATH for the executable. */
+ const char* path = getenv("PATH");
+ const char* begin = path;
+ const char* end = begin + (begin?strlen(begin):0);
+ const char* first = begin;
+ while(first != end)
+ {
+ /* Store the end of this path entry. */
+ const char* last;
+
+ /* Skip all path separators. */
+ for(;*first && *first == KWSYS_SHARED_FORWARD_PATH_SEP; ++first);
+
+ /* Find the next separator. */
+ for(last = first;*last && *last != KWSYS_SHARED_FORWARD_PATH_SEP; ++last);
+
+ /* If we got a non-empty directory, look for the executable there. */
+ if(first < last)
+ {
+ /* Determine the length without trailing slash. */
+ int length = last-first;
+ if(*(last-1) == '/' || *(last-1) == '\\')
+ {
+ --length;
+ }
+
+ /* Construct the name of the executable in this location. */
+ strncpy(result, first, length);
+ result[length] = KWSYS_SHARED_FORWARD_PATH_SLASH;
+ strcpy(result+(length)+1, argv0);
+
+ /* Check if it exists and is executable. */
+ if(kwsys_shared_forward_is_executable(result))
+ {
+ /* Found it. */
+ result[length] = 0;
+ return 1;
+ }
+ }
+
+ /* Move to the next directory in the path. */
+ first = last;
+ }
+ }
+
+ /* We could not find the executable. */
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to convert a specified path to a full path. If it is not
+ already full, it is taken relative to the self path. */
+static int kwsys_shared_forward_fullpath(const char* self_path,
+ const char* in_path,
+ char* result,
+ const char* desc)
+{
+ /* Check the specified path type. */
+ if(in_path[0] == '/')
+ {
+ /* Already a full path. */
+ strcpy(result, in_path);
+ }
+#if defined(_WIN32)
+ else if(in_path[0] && in_path[1] == ':')
+ {
+ /* Already a full path. */
+ strcpy(result, in_path);
+ }
+#endif
+ else
+ {
+ /* Relative to self path. */
+ char temp_path[KWSYS_SHARED_FORWARD_MAXPATH];
+ strcpy(temp_path, self_path);
+ strcat(temp_path, kwsys_shared_forward_path_slash);
+ strcat(temp_path, in_path);
+ if(!kwsys_shared_forward_realpath(temp_path, result))
+ {
+ if(desc)
+ {
+ char msgbuf[KWSYS_SHARED_FORWARD_MAXPATH];
+ kwsys_shared_forward_strerror(msgbuf);
+ fprintf(stderr, "Error converting %s \"%s\" to real path: %s\n",
+ desc, temp_path, msgbuf);
+ }
+ return 0;
+ }
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to compute the library search path and executable name
+ based on the self path. */
+static int kwsys_shared_forward_get_settings(const char* self_path,
+ char* ldpath, char* exe)
+{
+ /* Possible search paths. */
+ static const char* search_path_build[] = {KWSYS_SHARED_FORWARD_PATH_BUILD, 0};
+ static const char* search_path_install[] = {KWSYS_SHARED_FORWARD_PATH_INSTALL, 0};
+
+ /* Chosen paths. */
+ const char** search_path;
+ const char* exe_path;
+
+ /* Get the real name of the build and self paths. */
+#if defined(KWSYS_SHARED_FORWARD_CONFIG_NAME)
+ char build_path[] = KWSYS_SHARED_FORWARD_DIR_BUILD "/" KWSYS_SHARED_FORWARD_CONFIG_NAME;
+ char self_path_logical[KWSYS_SHARED_FORWARD_MAXPATH];
+#else
+ char build_path[] = KWSYS_SHARED_FORWARD_DIR_BUILD;
+ const char* self_path_logical = self_path;
+#endif
+ char build_path_real[KWSYS_SHARED_FORWARD_MAXPATH];
+ char self_path_real[KWSYS_SHARED_FORWARD_MAXPATH];
+ if(!kwsys_shared_forward_realpath(self_path, self_path_real))
+ {
+ char msgbuf[KWSYS_SHARED_FORWARD_MAXPATH];
+ kwsys_shared_forward_strerror(msgbuf);
+ fprintf(stderr, "Error converting self path \"%s\" to real path: %s\n",
+ self_path, msgbuf);
+ return 0;
+ }
+
+ /* Check whether we are running in the build tree or an install tree. */
+ if(kwsys_shared_forward_realpath(build_path, build_path_real) &&
+ strcmp(self_path_real, build_path_real) == 0)
+ {
+ /* Running in build tree. Use the build path and exe. */
+ search_path = search_path_build;
+#if defined(_WIN32)
+ exe_path = KWSYS_SHARED_FORWARD_EXE_BUILD ".exe";
+#else
+ exe_path = KWSYS_SHARED_FORWARD_EXE_BUILD;
+#endif
+
+#if defined(KWSYS_SHARED_FORWARD_CONFIG_NAME)
+ /* Remove the configuration directory from self_path. */
+ kwsys_shared_forward_dirname(self_path, self_path_logical);
+#endif
+ }
+ else
+ {
+ /* Running in install tree. Use the install path and exe. */
+ search_path = search_path_install;
+#if defined(_WIN32)
+ exe_path = KWSYS_SHARED_FORWARD_EXE_INSTALL ".exe";
+#else
+ exe_path = KWSYS_SHARED_FORWARD_EXE_INSTALL;
+#endif
+
+#if defined(KWSYS_SHARED_FORWARD_CONFIG_NAME)
+ /* Use the original self path directory. */
+ strcpy(self_path_logical, self_path);
+#endif
+ }
+
+ /* Construct the runtime search path. */
+ {
+ const char** dir;
+ for(dir = search_path; *dir; ++dir)
+ {
+ /* Add seperator between path components. */
+ if(dir != search_path)
+ {
+ strcat(ldpath, kwsys_shared_forward_path_sep);
+ }
+
+ /* Add this path component. */
+ if(!kwsys_shared_forward_fullpath(self_path_logical, *dir,
+ ldpath+strlen(ldpath),
+ "runtime path entry"))
+ {
+ return 0;
+ }
+ }
+ }
+
+ /* Construct the executable location. */
+ if(!kwsys_shared_forward_fullpath(self_path_logical, exe_path, exe,
+ "executable file"))
+ {
+ return 0;
+ }
+ return 1;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Function to print why execution of a command line failed. */
+static void kwsys_shared_forward_print_failure(char** argv)
+{
+ char msg[KWSYS_SHARED_FORWARD_MAXPATH];
+ char** arg = argv;
+ kwsys_shared_forward_strerror(msg);
+ fprintf(stderr, "Error running");
+ for(; *arg; ++arg)
+ {
+ fprintf(stderr, " \"%s\"", *arg);
+ }
+ fprintf(stderr, ": %s\n", msg);
+}
+
+/* Static storage space to store the updated environment variable. */
+static char kwsys_shared_forward_ldpath[KWSYS_SHARED_FORWARD_MAXPATH*16] = KWSYS_SHARED_FORWARD_LDPATH "=";
+
+/*--------------------------------------------------------------------------*/
+/* Main driver function to be called from main. */
+static int @KWSYS_NAMESPACE@_shared_forward_to_real(int argc, char** argv)
+{
+ /* Get the directory containing this executable. */
+ char self_path[KWSYS_SHARED_FORWARD_MAXPATH];
+ if(kwsys_shared_forward_self_path(argv[0], self_path))
+ {
+ /* Found this executable. Use it to get the library directory. */
+ char exe[KWSYS_SHARED_FORWARD_MAXPATH];
+ if(kwsys_shared_forward_get_settings(self_path,
+ kwsys_shared_forward_ldpath, exe))
+ {
+ /* Append the old runtime search path. */
+ const char* old_ldpath = getenv(KWSYS_SHARED_FORWARD_LDPATH);
+ if(old_ldpath)
+ {
+ strcat(kwsys_shared_forward_ldpath, kwsys_shared_forward_path_sep);
+ strcat(kwsys_shared_forward_ldpath, old_ldpath);
+ }
+
+ /* Store the environment variable. */
+ putenv(kwsys_shared_forward_ldpath);
+
+#if defined(KWSYS_SHARED_FORWARD_OPTION_PRINT)
+ /* Look for the print command line option. */
+ if(argc > 1 && strcmp(argv[1], KWSYS_SHARED_FORWARD_OPTION_PRINT) == 0)
+ {
+ fprintf(stdout, "%s\n", kwsys_shared_forward_ldpath);
+ fprintf(stdout, "%s\n", exe);
+ return 0;
+ }
+#endif
+
+#if defined(KWSYS_SHARED_FORWARD_OPTION_LDD)
+ /* Look for the ldd command line option. */
+ if(argc > 1 && strcmp(argv[1], KWSYS_SHARED_FORWARD_OPTION_LDD) == 0)
+ {
+# if defined(KWSYS_SHARED_FORWARD_LDD)
+ /* Use the named ldd-like executable and arguments. */
+ char* ldd_argv[] = {KWSYS_SHARED_FORWARD_LDD, 0, 0};
+ ldd_argv[KWSYS_SHARED_FORWARD_LDD_N] = exe;
+ kwsys_shared_forward_execvp(ldd_argv[0], ldd_argv);
+
+ /* Report why execution failed. */
+ kwsys_shared_forward_print_failure(ldd_argv);
+ return 1;
+# else
+ /* We have no ldd-like executable available on this platform. */
+ fprintf(stderr, "No ldd-like tool is known to this executable.\n");
+ return 1;
+# endif
+ }
+#endif
+
+ /* Replace this process with the real executable. */
+ argv[0] = exe;
+ kwsys_shared_forward_execv(argv[0], argv);
+
+ /* Report why execution failed. */
+ kwsys_shared_forward_print_failure(argv);
+ }
+ else
+ {
+ /* Could not convert self path to the library directory. */
+ }
+ }
+ else
+ {
+ /* Could not find this executable. */
+ fprintf(stderr, "Error locating executable \"%s\".\n", argv[0]);
+ }
+
+ /* Avoid unused argument warning. */
+ (void)argc;
+
+ /* Exit with failure. */
+ return 1;
+}
+
+#else
+# error "@KWSYS_NAMESPACE@/SharedForward.h should be included only once."
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/String.hxx.in b/Utilities/ITK/Utilities/kwsys/String.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..0c94ea49353fa0cc58477ddc237e9ddef9fe3b4c
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/String.hxx.in
@@ -0,0 +1,59 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: String.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_String_hxx
+#define @KWSYS_NAMESPACE@_String_hxx
+
+#include <@KWSYS_NAMESPACE@/stl/string>
+
+namespace @KWSYS_NAMESPACE@
+{
+
+/** \class String
+ * \brief Short-name version of the STL basic_string class template.
+ *
+ * The standard library "std::string" type is actually a typedef for
+ * "std::basic_string<..long argument list..>". This string class is
+ * simply a subclass of this type with the same interface so that the
+ * name is shorter in debugging symbols and error messages.
+ */
+class @KWSYS_NAMESPACE@_EXPORT String: public @KWSYS_NAMESPACE@_stl::string
+{
+ /** The original string type. */
+ typedef @KWSYS_NAMESPACE@_stl::string stl_string;
+
+public:
+
+ /** String member types. */
+ typedef stl_string::value_type value_type;
+ typedef stl_string::pointer pointer;
+ typedef stl_string::reference reference;
+ typedef stl_string::const_reference const_reference;
+ typedef stl_string::size_type size_type;
+ typedef stl_string::difference_type difference_type;
+ typedef stl_string::iterator iterator;
+ typedef stl_string::const_iterator const_iterator;
+ typedef stl_string::reverse_iterator reverse_iterator;
+ typedef stl_string::const_reverse_iterator const_reverse_iterator;
+
+ /** String constructors. */
+ String(): stl_string() {}
+ String(const value_type* s): stl_string(s) {}
+ String(const value_type* s, size_type n): stl_string(s, n) {}
+ String(const stl_string& s, size_type pos=0, size_type n=npos):
+ stl_string(s, pos, n) {}
+}; // End Class: String
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/SystemTools.cxx b/Utilities/ITK/Utilities/kwsys/SystemTools.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3ed0bb1ad2da07b439875294a5351f1dfaad62cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/SystemTools.cxx
@@ -0,0 +1,3925 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: SystemTools.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(SystemTools.hxx)
+#include KWSYS_HEADER(Directory.hxx)
+
+#include KWSYS_HEADER(ios/iostream)
+#include KWSYS_HEADER(ios/fstream)
+#include KWSYS_HEADER(ios/sstream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "SystemTools.hxx.in"
+# include "Directory.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+# include "kwsys_ios_fstream.h.in"
+# include "kwsys_ios_sstream.h.in"
+#endif
+
+#ifdef _MSC_VER
+# pragma warning (disable: 4786)
+#endif
+
+#if defined(__sgi) && !defined(__GNUC__)
+# pragma set woff 1375 /* base class destructor not virtual */
+#endif
+
+#include <ctype.h>
+#include <errno.h>
+#ifdef __QNX__
+# include <malloc.h> /* for malloc/free on QNX */
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <time.h>
+
+// support for realpath call
+#ifndef _WIN32
+#include <limits.h>
+#include <sys/param.h>
+#include <sys/wait.h>
+#include <sys/ioctl.h>
+#include <unistd.h>
+#include <termios.h>
+#endif
+
+// Windows API. Some parts used even on cygwin.
+#if defined(_WIN32)
+# include <windows.h>
+#endif
+
+// This is a hack to prevent warnings about these functions being
+// declared but not referenced.
+#if defined(__sgi) && !defined(__GNUC__)
+# include <sys/termios.h>
+namespace KWSYS_NAMESPACE
+{
+class SystemToolsHack
+{
+public:
+ enum
+ {
+ Ref1 = sizeof(cfgetospeed(0)),
+ Ref2 = sizeof(cfgetispeed(0)),
+ Ref3 = sizeof(tcgetattr(0, 0)),
+ Ref4 = sizeof(tcsetattr(0, 0, 0)),
+ Ref5 = sizeof(cfsetospeed(0,0)),
+ Ref6 = sizeof(cfsetispeed(0,0))
+ };
+};
+}
+#endif
+
+#if defined(_WIN32) && (defined(_MSC_VER) || defined(__WATCOMC__) ||defined(__BORLANDC__) || defined(__MINGW32__))
+#include <io.h>
+#include <direct.h>
+#define _unlink unlink
+#endif
+
+/* The maximum length of a file name. */
+#if defined(PATH_MAX)
+# define KWSYS_SYSTEMTOOLS_MAXPATH PATH_MAX
+#elif defined(MAXPATHLEN)
+# define KWSYS_SYSTEMTOOLS_MAXPATH MAXPATHLEN
+#else
+# define KWSYS_SYSTEMTOOLS_MAXPATH 16384
+#endif
+#if defined(__WATCOMC__)
+#include <direct.h>
+#define _mkdir mkdir
+#define _rmdir rmdir
+#define _getcwd getcwd
+#define _chdir chdir
+#endif
+
+#if defined(_WIN32) && (defined(_MSC_VER) || defined(__WATCOMC__) || defined(__BORLANDC__) || defined(__MINGW32__))
+inline int Mkdir(const char* dir)
+{
+ return _mkdir(dir);
+}
+inline int Rmdir(const char* dir)
+{
+ return _rmdir(dir);
+}
+inline const char* Getcwd(char* buf, unsigned int len)
+{
+ return _getcwd(buf, len);
+}
+inline int Chdir(const char* dir)
+{
+ #if defined(__BORLANDC__)
+ return chdir(dir);
+ #else
+ return _chdir(dir);
+ #endif
+}
+inline void Realpath(const char *path, kwsys_stl::string & resolved_path)
+{
+ char *ptemp;
+ char fullpath[MAX_PATH];
+ if( GetFullPathName(path, sizeof(fullpath), fullpath, &ptemp) )
+ {
+ resolved_path = fullpath;
+ KWSYS_NAMESPACE::SystemTools::ConvertToUnixSlashes(resolved_path);
+ }
+}
+#else
+#include <sys/types.h>
+#include <fcntl.h>
+#include <unistd.h>
+inline int Mkdir(const char* dir)
+{
+ return mkdir(dir, 00777);
+}
+inline int Rmdir(const char* dir)
+{
+ return rmdir(dir);
+}
+inline const char* Getcwd(char* buf, unsigned int len)
+{
+ return getcwd(buf, len);
+}
+inline int Chdir(const char* dir)
+{
+ return chdir(dir);
+}
+inline void Realpath(const char *path, kwsys_stl::string & resolved_path)
+{
+ char resolved_name[KWSYS_SYSTEMTOOLS_MAXPATH];
+
+ realpath(path, resolved_name);
+ resolved_path = resolved_name;
+}
+#endif
+
+#if !defined(_WIN32) && defined(__COMO__)
+// Hack for como strict mode to avoid defining _SVID_SOURCE or _BSD_SOURCE.
+extern "C"
+{
+extern FILE *popen (__const char *__command, __const char *__modes) __THROW;
+extern int pclose (FILE *__stream) __THROW;
+extern char *realpath (__const char *__restrict __name,
+ char *__restrict __resolved) __THROW;
+extern char *strdup (__const char *__s) __THROW;
+extern int putenv (char *__string) __THROW;
+}
+#endif
+
+/* Implement floattime() for various platforms */
+// Taken from Python 2.1.3
+
+#if defined( _WIN32 ) && !defined( __CYGWIN__ )
+# include <sys/timeb.h>
+# define HAVE_FTIME
+# if defined( __BORLANDC__)
+# define FTIME ftime
+# define TIMEB timeb
+# else // Visual studio?
+# define FTIME _ftime
+# define TIMEB _timeb
+# endif
+#elif defined( __CYGWIN__ ) || defined( __linux__ )
+# include <sys/time.h>
+# include <time.h>
+# define HAVE_GETTIMEOFDAY
+#endif
+
+namespace KWSYS_NAMESPACE
+{
+
+class SystemToolsTranslationMap :
+ public kwsys_stl::map<kwsys_stl::string,kwsys_stl::string>
+{
+};
+
+
+double
+SystemTools::GetTime(void)
+{
+ /* There are three ways to get the time:
+ (1) gettimeofday() -- resolution in microseconds
+ (2) ftime() -- resolution in milliseconds
+ (3) time() -- resolution in seconds
+ In all cases the return value is a float in seconds.
+ Since on some systems (e.g. SCO ODT 3.0) gettimeofday() may
+ fail, so we fall back on ftime() or time().
+ Note: clock resolution does not imply clock accuracy! */
+#ifdef HAVE_GETTIMEOFDAY
+ {
+ struct timeval t;
+#ifdef GETTIMEOFDAY_NO_TZ
+ if (gettimeofday(&t) == 0)
+ return (double)t.tv_sec + t.tv_usec*0.000001;
+#else /* !GETTIMEOFDAY_NO_TZ */
+ if (gettimeofday(&t, (struct timezone *)NULL) == 0)
+ return (double)t.tv_sec + t.tv_usec*0.000001;
+#endif /* !GETTIMEOFDAY_NO_TZ */
+ }
+#endif /* !HAVE_GETTIMEOFDAY */
+ {
+#if defined(HAVE_FTIME)
+ struct TIMEB t;
+ ::FTIME(&t);
+ return (double)t.time + (double)t.millitm * (double)0.001;
+#else /* !HAVE_FTIME */
+ time_t secs;
+ time(&secs);
+ return (double)secs;
+#endif /* !HAVE_FTIME */
+ }
+}
+
+// adds the elements of the env variable path to the arg passed in
+void SystemTools::GetPath(kwsys_stl::vector<kwsys_stl::string>& path, const char* env)
+{
+#if defined(_WIN32) && !defined(__CYGWIN__)
+ const char* pathSep = ";";
+#else
+ const char* pathSep = ":";
+#endif
+ if(!env)
+ {
+ env = "PATH";
+ }
+ const char* cpathEnv = SystemTools::GetEnv(env);
+ if ( !cpathEnv )
+ {
+ return;
+ }
+
+ kwsys_stl::string pathEnv = cpathEnv;
+
+ // A hack to make the below algorithm work.
+ if(pathEnv[pathEnv.length()-1] != ':')
+ {
+ pathEnv += pathSep;
+ }
+ kwsys_stl::string::size_type start =0;
+ bool done = false;
+ while(!done)
+ {
+ kwsys_stl::string::size_type endpos = pathEnv.find(pathSep, start);
+ if(endpos != kwsys_stl::string::npos)
+ {
+ path.push_back(pathEnv.substr(start, endpos-start));
+ start = endpos+1;
+ }
+ else
+ {
+ done = true;
+ }
+ }
+ for(kwsys_stl::vector<kwsys_stl::string>::iterator i = path.begin();
+ i != path.end(); ++i)
+ {
+ SystemTools::ConvertToUnixSlashes(*i);
+ }
+}
+
+const char* SystemTools::GetEnv(const char* key)
+{
+ return getenv(key);
+}
+
+bool SystemTools::GetEnv(const char* key, kwsys_stl::string& result)
+{
+ const char* v = getenv(key);
+ if(v)
+ {
+ result = v;
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+}
+
+const char* SystemTools::GetExecutableExtension()
+{
+#if defined(_WIN32) || defined(__CYGWIN__)
+ return ".exe";
+#else
+ return "";
+#endif
+}
+
+
+bool SystemTools::MakeDirectory(const char* path)
+{
+ if(SystemTools::FileExists(path))
+ {
+ return true;
+ }
+ kwsys_stl::string dir = path;
+ if(dir.size() == 0)
+ {
+ return false;
+ }
+ SystemTools::ConvertToUnixSlashes(dir);
+
+ kwsys_stl::string::size_type pos = dir.find(':');
+ if(pos == kwsys_stl::string::npos)
+ {
+ pos = 0;
+ }
+ kwsys_stl::string topdir;
+ while((pos = dir.find('/', pos)) != kwsys_stl::string::npos)
+ {
+ topdir = dir.substr(0, pos);
+ Mkdir(topdir.c_str());
+ pos++;
+ }
+ if(dir[dir.size()-1] == '/')
+ {
+ topdir = dir.substr(0, dir.size());
+ }
+ else
+ {
+ topdir = dir;
+ }
+ if(Mkdir(topdir.c_str()) != 0)
+ {
+ // There is a bug in the Borland Run time library which makes MKDIR
+ // return EACCES when it should return EEXISTS
+ // if it is some other error besides directory exists
+ // then return false
+ if( (errno != EEXIST)
+#ifdef __BORLANDC__
+ && (errno != EACCES)
+#endif
+ )
+ {
+ return false;
+ }
+ }
+ return true;
+}
+
+
+// replace replace with with as many times as it shows up in source.
+// write the result into source.
+void SystemTools::ReplaceString(kwsys_stl::string& source,
+ const char* replace,
+ const char* with)
+{
+ const char *src = source.c_str();
+ char *searchPos = const_cast<char *>(strstr(src,replace));
+
+ // get out quick if string is not found
+ if (!searchPos)
+ {
+ return;
+ }
+
+ // perform replacements until done
+ size_t replaceSize = strlen(replace);
+ char *orig = strdup(src);
+ char *currentPos = orig;
+ searchPos = searchPos - src + orig;
+
+ // initialize the result
+ source.erase(source.begin(),source.end());
+ do
+ {
+ *searchPos = '\0';
+ source += currentPos;
+ currentPos = searchPos + replaceSize;
+ // replace
+ source += with;
+ searchPos = strstr(currentPos,replace);
+ }
+ while (searchPos);
+
+ // copy any trailing text
+ source += currentPos;
+ free(orig);
+}
+
+// Read a registry value.
+// Example :
+// HKEY_LOCAL_MACHINE\SOFTWARE\Python\PythonCore\2.1\InstallPath
+// => will return the data of the "default" value of the key
+// HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.4;Root
+// => will return the data of the "Root" value of the key
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+bool SystemTools::ReadRegistryValue(const char *key, kwsys_stl::string &value)
+{
+
+ kwsys_stl::string primary = key;
+ kwsys_stl::string second;
+ kwsys_stl::string valuename;
+
+ size_t start = primary.find("\\");
+ if (start == kwsys_stl::string::npos)
+ {
+ return false;
+ }
+
+ size_t valuenamepos = primary.find(";");
+ if (valuenamepos != kwsys_stl::string::npos)
+ {
+ valuename = primary.substr(valuenamepos+1);
+ }
+
+ second = primary.substr(start+1, valuenamepos-start-1);
+ primary = primary.substr(0, start);
+
+ HKEY primaryKey = HKEY_CURRENT_USER;
+ if (primary == "HKEY_CURRENT_USER")
+ {
+ primaryKey = HKEY_CURRENT_USER;
+ }
+ if (primary == "HKEY_CURRENT_CONFIG")
+ {
+ primaryKey = HKEY_CURRENT_CONFIG;
+ }
+ if (primary == "HKEY_CLASSES_ROOT")
+ {
+ primaryKey = HKEY_CLASSES_ROOT;
+ }
+ if (primary == "HKEY_LOCAL_MACHINE")
+ {
+ primaryKey = HKEY_LOCAL_MACHINE;
+ }
+ if (primary == "HKEY_USERS")
+ {
+ primaryKey = HKEY_USERS;
+ }
+
+ HKEY hKey;
+ if(RegOpenKeyEx(primaryKey,
+ second.c_str(),
+ 0,
+ KEY_READ,
+ &hKey) != ERROR_SUCCESS)
+ {
+ return false;
+ }
+ else
+ {
+ DWORD dwType, dwSize;
+ dwSize = 1023;
+ char data[1024];
+ if(RegQueryValueEx(hKey,
+ (LPTSTR)valuename.c_str(),
+ NULL,
+ &dwType,
+ (BYTE *)data,
+ &dwSize) == ERROR_SUCCESS)
+ {
+ if (dwType == REG_SZ)
+ {
+ value = data;
+ RegCloseKey(hKey);
+ return true;
+ }
+ }
+ }
+ return false;
+}
+#else
+bool SystemTools::ReadRegistryValue(const char *, kwsys_stl::string &)
+{
+ return false;
+}
+#endif
+
+
+// Write a registry value.
+// Example :
+// HKEY_LOCAL_MACHINE\SOFTWARE\Python\PythonCore\2.1\InstallPath
+// => will set the data of the "default" value of the key
+// HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.4;Root
+// => will set the data of the "Root" value of the key
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+bool SystemTools::WriteRegistryValue(const char *key, const char *value)
+{
+ kwsys_stl::string primary = key;
+ kwsys_stl::string second;
+ kwsys_stl::string valuename;
+
+ size_t start = primary.find("\\");
+ if (start == kwsys_stl::string::npos)
+ {
+ return false;
+ }
+
+ size_t valuenamepos = primary.find(";");
+ if (valuenamepos != kwsys_stl::string::npos)
+ {
+ valuename = primary.substr(valuenamepos+1);
+ }
+
+ second = primary.substr(start+1, valuenamepos-start-1);
+ primary = primary.substr(0, start);
+
+ HKEY primaryKey = HKEY_CURRENT_USER;
+ if (primary == "HKEY_CURRENT_USER")
+ {
+ primaryKey = HKEY_CURRENT_USER;
+ }
+ if (primary == "HKEY_CURRENT_CONFIG")
+ {
+ primaryKey = HKEY_CURRENT_CONFIG;
+ }
+ if (primary == "HKEY_CLASSES_ROOT")
+ {
+ primaryKey = HKEY_CLASSES_ROOT;
+ }
+ if (primary == "HKEY_LOCAL_MACHINE")
+ {
+ primaryKey = HKEY_LOCAL_MACHINE;
+ }
+ if (primary == "HKEY_USERS")
+ {
+ primaryKey = HKEY_USERS;
+ }
+
+ HKEY hKey;
+ DWORD dwDummy;
+ if(RegCreateKeyEx(primaryKey,
+ second.c_str(),
+ 0,
+ "",
+ REG_OPTION_NON_VOLATILE,
+ KEY_WRITE,
+ NULL,
+ &hKey,
+ &dwDummy) != ERROR_SUCCESS)
+ {
+ return false;
+ }
+
+ if(RegSetValueEx(hKey,
+ (LPTSTR)valuename.c_str(),
+ 0,
+ REG_SZ,
+ (CONST BYTE *)value,
+ (DWORD)(strlen(value) + 1)) == ERROR_SUCCESS)
+ {
+ return true;
+ }
+ return false;
+}
+#else
+bool SystemTools::WriteRegistryValue(const char *, const char *)
+{
+ return false;
+}
+#endif
+
+// Delete a registry value.
+// Example :
+// HKEY_LOCAL_MACHINE\SOFTWARE\Python\PythonCore\2.1\InstallPath
+// => will delete the data of the "default" value of the key
+// HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.4;Root
+// => will delete the data of the "Root" value of the key
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+bool SystemTools::DeleteRegistryValue(const char *key)
+{
+ kwsys_stl::string primary = key;
+ kwsys_stl::string second;
+ kwsys_stl::string valuename;
+
+ size_t start = primary.find("\\");
+ if (start == kwsys_stl::string::npos)
+ {
+ return false;
+ }
+
+ size_t valuenamepos = primary.find(";");
+ if (valuenamepos != kwsys_stl::string::npos)
+ {
+ valuename = primary.substr(valuenamepos+1);
+ }
+
+ second = primary.substr(start+1, valuenamepos-start-1);
+ primary = primary.substr(0, start);
+
+ HKEY primaryKey = HKEY_CURRENT_USER;
+ if (primary == "HKEY_CURRENT_USER")
+ {
+ primaryKey = HKEY_CURRENT_USER;
+ }
+ if (primary == "HKEY_CURRENT_CONFIG")
+ {
+ primaryKey = HKEY_CURRENT_CONFIG;
+ }
+ if (primary == "HKEY_CLASSES_ROOT")
+ {
+ primaryKey = HKEY_CLASSES_ROOT;
+ }
+ if (primary == "HKEY_LOCAL_MACHINE")
+ {
+ primaryKey = HKEY_LOCAL_MACHINE;
+ }
+ if (primary == "HKEY_USERS")
+ {
+ primaryKey = HKEY_USERS;
+ }
+
+ HKEY hKey;
+ if(RegOpenKeyEx(primaryKey,
+ second.c_str(),
+ 0,
+ KEY_WRITE,
+ &hKey) != ERROR_SUCCESS)
+ {
+ return false;
+ }
+ else
+ {
+ if(RegDeleteValue(hKey,
+ (LPTSTR)valuename.c_str()) == ERROR_SUCCESS)
+ {
+ RegCloseKey(hKey);
+ return true;
+ }
+ }
+ return false;
+}
+#else
+bool SystemTools::DeleteRegistryValue(const char *)
+{
+ return false;
+}
+#endif
+
+bool SystemTools::SameFile(const char* file1, const char* file2)
+{
+#ifdef _WIN32
+ HANDLE hFile1, hFile2;
+
+ hFile1 = CreateFile( file1,
+ GENERIC_READ,
+ FILE_SHARE_READ ,
+ NULL,
+ OPEN_EXISTING,
+ FILE_FLAG_BACKUP_SEMANTICS,
+ NULL
+ );
+ hFile2 = CreateFile( file2,
+ GENERIC_READ,
+ FILE_SHARE_READ,
+ NULL,
+ OPEN_EXISTING,
+ FILE_FLAG_BACKUP_SEMANTICS,
+ NULL
+ );
+ if( hFile1 == INVALID_HANDLE_VALUE || hFile2 == INVALID_HANDLE_VALUE)
+ {
+ if(hFile1 != INVALID_HANDLE_VALUE)
+ {
+ CloseHandle(hFile1);
+ }
+ if(hFile2 != INVALID_HANDLE_VALUE)
+ {
+ CloseHandle(hFile2);
+ }
+ return false;
+ }
+
+ BY_HANDLE_FILE_INFORMATION fiBuf1;
+ BY_HANDLE_FILE_INFORMATION fiBuf2;
+ GetFileInformationByHandle( hFile1, &fiBuf1 );
+ GetFileInformationByHandle( hFile2, &fiBuf2 );
+ CloseHandle(hFile1);
+ CloseHandle(hFile2);
+ return (fiBuf1.dwVolumeSerialNumber == fiBuf2.dwVolumeSerialNumber &&
+ fiBuf1.nFileIndexHigh == fiBuf2.nFileIndexHigh &&
+ fiBuf1.nFileIndexLow == fiBuf2.nFileIndexLow);
+#else
+ struct stat fileStat1, fileStat2;
+ if (stat(file1, &fileStat1) == 0 && stat(file2, &fileStat2) == 0)
+ {
+ // see if the files are the same file
+ // check the device inode and size
+ if(memcmp(&fileStat2.st_dev, &fileStat1.st_dev, sizeof(fileStat1.st_dev)) == 0 &&
+ memcmp(&fileStat2.st_ino, &fileStat1.st_ino, sizeof(fileStat1.st_ino)) == 0 &&
+ fileStat2.st_size == fileStat1.st_size
+ )
+ {
+ return true;
+ }
+ }
+ return false;
+#endif
+}
+
+
+// return true if the file exists
+bool SystemTools::FileExists(const char* filename)
+{
+#ifdef _MSC_VER
+# define access _access
+#endif
+#ifndef R_OK
+# define R_OK 04
+#endif
+ if ( access(filename, R_OK) != 0 )
+ {
+ return false;
+ }
+ else
+ {
+ return true;
+ }
+}
+
+
+bool SystemTools::FileTimeCompare(const char* f1, const char* f2,
+ int* result)
+{
+ // Default to same time.
+ *result = 0;
+#if !defined(_WIN32) || defined(__CYGWIN__)
+ // POSIX version. Use stat function to get file modification time.
+ struct stat s1;
+ if(stat(f1, &s1) != 0)
+ {
+ return false;
+ }
+ struct stat s2;
+ if(stat(f2, &s2) != 0)
+ {
+ return false;
+ }
+# if KWSYS_STAT_HAS_ST_MTIM
+ // Compare using nanosecond resolution.
+ if(s1.st_mtim.tv_sec < s2.st_mtim.tv_sec)
+ {
+ *result = -1;
+ }
+ else if(s1.st_mtim.tv_sec > s2.st_mtim.tv_sec)
+ {
+ *result = 1;
+ }
+ else if(s1.st_mtim.tv_nsec < s2.st_mtim.tv_nsec)
+ {
+ *result = -1;
+ }
+ else if(s1.st_mtim.tv_nsec > s2.st_mtim.tv_nsec)
+ {
+ *result = 1;
+ }
+# else
+ // Compare using 1 second resolution.
+ if(s1.st_mtime < s2.st_mtime)
+ {
+ *result = -1;
+ }
+ else if(s1.st_mtime > s2.st_mtime)
+ {
+ *result = 1;
+ }
+# endif
+#else
+ // Windows version. Get the modification time from extended file attributes.
+ WIN32_FILE_ATTRIBUTE_DATA f1d;
+ WIN32_FILE_ATTRIBUTE_DATA f2d;
+ if(!GetFileAttributesEx(f1, GetFileExInfoStandard, &f1d))
+ {
+ return false;
+ }
+ if(!GetFileAttributesEx(f2, GetFileExInfoStandard, &f2d))
+ {
+ return false;
+ }
+
+ // Compare the file times using resolution provided by system call.
+ *result = (int)CompareFileTime(&f1d.ftLastWriteTime, &f2d.ftLastWriteTime);
+#endif
+ return true;
+}
+
+
+// Return a capitalized string (i.e the first letter is uppercased, all other
+// are lowercased)
+kwsys_stl::string SystemTools::Capitalized(const kwsys_stl::string& s)
+{
+ kwsys_stl::string n;
+ if(s.size() == 0)
+ {
+ return n;
+ }
+ n.resize(s.size());
+ n[0] = static_cast<kwsys_stl::string::value_type>(toupper(s[0]));
+ for (size_t i = 1; i < s.size(); i++)
+ {
+ n[i] = static_cast<kwsys_stl::string::value_type>(tolower(s[i]));
+ }
+ return n;
+}
+
+// Return capitalized words
+kwsys_stl::string SystemTools::CapitalizedWords(const kwsys_stl::string& s)
+{
+ kwsys_stl::string n(s);
+ for (size_t i = 0; i < s.size(); i++)
+ {
+ if (isalpha(s[i]) && (i == 0 || isspace(s[i - 1])))
+ {
+ n[i] = static_cast<kwsys_stl::string::value_type>(toupper(s[i]));
+ }
+ }
+ return n;
+}
+
+// Return uncapitalized words
+kwsys_stl::string SystemTools::UnCapitalizedWords(const kwsys_stl::string& s)
+{
+ kwsys_stl::string n(s);
+ for (size_t i = 0; i < s.size(); i++)
+ {
+ if (isalpha(s[i]) && (i == 0 || isspace(s[i - 1])))
+ {
+ n[i] = static_cast<kwsys_stl::string::value_type>(tolower(s[i]));
+ }
+ }
+ return n;
+}
+
+kwsys_stl::string SystemTools::AddSpaceBetweenCapitalizedWords(
+ const kwsys_stl::string& s)
+{
+ kwsys_stl::string n;
+ if (s.size())
+ {
+ n.reserve(s.size());
+ n += s[0];
+ for (size_t i = 1; i < s.size(); i++)
+ {
+ if (isupper(s[i]) && !isspace(s[i - 1]) && !isupper(s[i - 1]))
+ {
+ n += ' ';
+ }
+ n += s[i];
+ }
+ }
+ return n;
+}
+
+char* SystemTools::AppendStrings(const char* str1, const char* str2)
+{
+ if (!str1)
+ {
+ return SystemTools::DuplicateString(str2);
+ }
+ if (!str2)
+ {
+ return SystemTools::DuplicateString(str1);
+ }
+ size_t len1 = strlen(str1);
+ char *newstr = new char[len1 + strlen(str2) + 1];
+ if (!newstr)
+ {
+ return 0;
+ }
+ strcpy(newstr, str1);
+ strcat(newstr + len1, str2);
+ return newstr;
+}
+
+char* SystemTools::AppendStrings(
+ const char* str1, const char* str2, const char* str3)
+{
+ if (!str1)
+ {
+ return SystemTools::AppendStrings(str2, str3);
+ }
+ if (!str2)
+ {
+ return SystemTools::AppendStrings(str1, str3);
+ }
+ if (!str3)
+ {
+ return SystemTools::AppendStrings(str1, str2);
+ }
+
+ size_t len1 = strlen(str1), len2 = strlen(str2);
+ char *newstr = new char[len1 + len2 + strlen(str3) + 1];
+ if (!newstr)
+ {
+ return 0;
+ }
+ strcpy(newstr, str1);
+ strcat(newstr + len1, str2);
+ strcat(newstr + len1 + len2, str3);
+ return newstr;
+}
+
+// Return a lower case string
+kwsys_stl::string SystemTools::LowerCase(const kwsys_stl::string& s)
+{
+ kwsys_stl::string n;
+ n.resize(s.size());
+ for (size_t i = 0; i < s.size(); i++)
+ {
+ n[i] = static_cast<kwsys_stl::string::value_type>(tolower(s[i]));
+ }
+ return n;
+}
+
+// Return a lower case string
+kwsys_stl::string SystemTools::UpperCase(const kwsys_stl::string& s)
+{
+ kwsys_stl::string n;
+ n.resize(s.size());
+ for (size_t i = 0; i < s.size(); i++)
+ {
+ n[i] = static_cast<kwsys_stl::string::value_type>(toupper(s[i]));
+ }
+ return n;
+}
+
+// Count char in string
+size_t SystemTools::CountChar(const char* str, char c)
+{
+ size_t count = 0;
+
+ if (str)
+ {
+ while (*str)
+ {
+ if (*str == c)
+ {
+ ++count;
+ }
+ ++str;
+ }
+ }
+ return count;
+}
+
+// Remove chars in string
+char* SystemTools::RemoveChars(const char* str, const char *toremove)
+{
+ if (!str)
+ {
+ return NULL;
+ }
+ char *clean_str = new char [strlen(str) + 1];
+ char *ptr = clean_str;
+ while (*str)
+ {
+ const char *str2 = toremove;
+ while (*str2 && *str != *str2)
+ {
+ ++str2;
+ }
+ if (!*str2)
+ {
+ *ptr++ = *str;
+ }
+ ++str;
+ }
+ *ptr = '\0';
+ return clean_str;
+}
+
+// Remove chars in string
+char* SystemTools::RemoveCharsButUpperHex(const char* str)
+{
+ if (!str)
+ {
+ return 0;
+ }
+ char *clean_str = new char [strlen(str) + 1];
+ char *ptr = clean_str;
+ while (*str)
+ {
+ if ((*str >= '0' && *str <= '9') || (*str >= 'A' && *str <= 'H'))
+ {
+ *ptr++ = *str;
+ }
+ ++str;
+ }
+ *ptr = '\0';
+ return clean_str;
+}
+
+// Replace chars in string
+char* SystemTools::ReplaceChars(char* str, const char *toreplace, char replacement)
+{
+ if (str)
+ {
+ char *ptr = str;
+ while (*ptr)
+ {
+ const char *ptr2 = toreplace;
+ while (*ptr2)
+ {
+ if (*ptr == *ptr2)
+ {
+ *ptr = replacement;
+ }
+ ++ptr2;
+ }
+ ++ptr;
+ }
+ }
+ return str;
+}
+
+// Returns if string starts with another string
+bool SystemTools::StringStartsWith(const char* str1, const char* str2)
+{
+ if (!str1 || !str2)
+ {
+ return false;
+ }
+ size_t len1 = strlen(str1), len2 = strlen(str2);
+ return len1 >= len2 && !strncmp(str1, str2, len2) ? true : false;
+}
+
+// Returns if string ends with another string
+bool SystemTools::StringEndsWith(const char* str1, const char* str2)
+{
+ if (!str1 || !str2)
+ {
+ return false;
+ }
+ size_t len1 = strlen(str1), len2 = strlen(str2);
+ return len1 >= len2 && !strncmp(str1 + (len1 - len2), str2, len2) ? true : false;
+}
+
+// Returns a pointer to the last occurence of str2 in str1
+const char* SystemTools::FindLastString(const char* str1, const char* str2)
+{
+ if (!str1 || !str2)
+ {
+ return NULL;
+ }
+
+ size_t len1 = strlen(str1), len2 = strlen(str2);
+ if (len1 >= len2)
+ {
+ const char *ptr = str1 + len1 - len2;
+ do
+ {
+ if (!strncmp(ptr, str2, len2))
+ {
+ return ptr;
+ }
+ } while (ptr-- != str1);
+ }
+
+ return NULL;
+}
+
+// Duplicate string
+char* SystemTools::DuplicateString(const char* str)
+{
+ if (str)
+ {
+ char *newstr = new char [strlen(str) + 1];
+ return strcpy(newstr, str);
+ }
+ return NULL;
+}
+
+// Return a cropped string
+kwsys_stl::string SystemTools::CropString(const kwsys_stl::string& s,
+ size_t max_len)
+{
+ if (!s.size() || max_len == 0 || max_len >= s.size())
+ {
+ return s;
+ }
+
+ kwsys_stl::string n;
+ n.reserve(max_len);
+
+ size_t middle = max_len / 2;
+
+ n += s.substr(0, middle);
+ n += s.substr(s.size() - (max_len - middle), kwsys_stl::string::npos);
+
+ if (max_len > 2)
+ {
+ n[middle] = '.';
+ if (max_len > 3)
+ {
+ n[middle - 1] = '.';
+ if (max_len > 4)
+ {
+ n[middle + 1] = '.';
+ }
+ }
+ }
+
+ return n;
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::vector<kwsys::String> SystemTools::SplitString(const char* p, char sep, bool isPath)
+{
+ kwsys_stl::string path = p;
+ kwsys_stl::vector<kwsys::String> paths;
+ if(isPath && path[0] == '/')
+ {
+ path.erase(path.begin());
+ paths.push_back("/");
+ }
+ kwsys_stl::string::size_type pos1 = 0;
+ kwsys_stl::string::size_type pos2 = path.find(sep, pos1+1);
+ while(pos2 != kwsys_stl::string::npos)
+ {
+ paths.push_back(path.substr(pos1, pos2-pos1));
+ pos1 = pos2+1;
+ pos2 = path.find(sep, pos1+1);
+ }
+ paths.push_back(path.substr(pos1, pos2-pos1));
+
+ return paths;
+}
+
+//----------------------------------------------------------------------------
+int SystemTools::EstimateFormatLength(const char *format, va_list ap)
+{
+ if (!format)
+ {
+ return 0;
+ }
+
+ // Quick-hack attempt at estimating the length of the string.
+ // Should never under-estimate.
+
+ // Start with the length of the format string itself.
+
+ int length = strlen(format);
+
+ // Increase the length for every argument in the format.
+
+ const char* cur = format;
+ while(*cur)
+ {
+ if(*cur++ == '%')
+ {
+ // Skip "%%" since it doesn't correspond to a va_arg.
+ if(*cur != '%')
+ {
+ while(!int(isalpha(*cur)))
+ {
+ ++cur;
+ }
+ switch (*cur)
+ {
+ case 's':
+ {
+ // Check the length of the string.
+ char* s = va_arg(ap, char*);
+ if(s)
+ {
+ length += strlen(s);
+ }
+ } break;
+ case 'e':
+ case 'f':
+ case 'g':
+ {
+ // Assume the argument contributes no more than 64 characters.
+ length += 64;
+
+ // Eat the argument.
+ static_cast<void>(va_arg(ap, double));
+ } break;
+ default:
+ {
+ // Assume the argument contributes no more than 64 characters.
+ length += 64;
+
+ // Eat the argument.
+ static_cast<void>(va_arg(ap, int));
+ } break;
+ }
+ }
+
+ // Move past the characters just tested.
+ ++cur;
+ }
+ }
+
+ return length;
+}
+
+kwsys_stl::string SystemTools::EscapeChars(
+ const char *str,
+ const char *chars_to_escape,
+ char escape_char)
+{
+ kwsys_stl::string n;
+ if (str)
+ {
+ if (!chars_to_escape | !*chars_to_escape)
+ {
+ n.append(str);
+ }
+ else
+ {
+ n.reserve(strlen(str));
+ while (*str)
+ {
+ const char *ptr = chars_to_escape;
+ while (*ptr)
+ {
+ if (*str == *ptr)
+ {
+ n += escape_char;
+ break;
+ }
+ ++ptr;
+ }
+ n += *str;
+ ++str;
+ }
+ }
+ }
+ return n;
+}
+
+// convert windows slashes to unix slashes
+void SystemTools::ConvertToUnixSlashes(kwsys_stl::string& path)
+{
+ const char* pathCString = path.c_str();
+ bool hasDoubleSlash = false;
+
+ const char* pos0 = pathCString;
+ const char* pos1 = pathCString+1;
+ for (kwsys_stl::string::size_type pos = 0; *pos0; ++ pos )
+ {
+ // make sure we don't convert an escaped space to a unix slash
+ if ( *pos0 == '\\' && *pos1 != ' ' )
+ {
+ path[pos] = '/';
+ }
+
+ // Also, reuse the loop to check for slash followed by another slash
+ if ( !hasDoubleSlash && *pos1 &&
+ *pos1 == '/' && *(pos1+1) == '/' )
+ {
+#ifdef _WIN32
+ // However, on windows if the first characters are both slashes,
+ // then keep them that way, so that network paths can be handled.
+ if ( pos > 0)
+ {
+ hasDoubleSlash = true;
+ }
+#else
+ hasDoubleSlash = true;
+#endif
+ }
+
+ pos0 ++;
+ pos1 ++;
+ }
+
+ if ( hasDoubleSlash )
+ {
+ SystemTools::ReplaceString(path, "//", "/");
+ }
+
+ // remove any trailing slash
+ if(!path.empty())
+ {
+ // if there is a tilda ~ then replace it with HOME
+ pathCString = path.c_str();
+ if(*pathCString == '~')
+ {
+ const char* homeEnv = SystemTools::GetEnv("HOME");
+ if (homeEnv)
+ {
+ path.replace(0,1,homeEnv);
+ }
+ }
+
+ pathCString = path.c_str();
+ if (*(pathCString+(path.size()-1)) == '/')
+ {
+ path = path.substr(0, path.size()-1);
+ }
+
+ }
+}
+
+// change // to /, and escape any spaces in the path
+kwsys_stl::string SystemTools::ConvertToUnixOutputPath(const char* path)
+{
+ kwsys_stl::string ret = path;
+
+ // remove // except at the beginning might be a cygwin drive
+ kwsys_stl::string::size_type pos=0;
+ while((pos = ret.find("//", pos)) != kwsys_stl::string::npos)
+ {
+ ret.erase(pos, 1);
+ }
+ // now escape spaces if there is a space in the path
+ if(ret.find(" ") != kwsys_stl::string::npos)
+ {
+ kwsys_stl::string result = "";
+ char lastch = 1;
+ for(const char* ch = ret.c_str(); *ch != '\0'; ++ch)
+ {
+ // if it is already escaped then don't try to escape it again
+ if(*ch == ' ' && lastch != '\\')
+ {
+ result += '\\';
+ }
+ result += *ch;
+ lastch = *ch;
+ }
+ ret = result;
+ }
+ return ret;
+}
+
+kwsys_stl::string SystemTools::ConvertToOutputPath(const char* path)
+{
+#if defined(_WIN32) && !defined(__CYGWIN__)
+ return SystemTools::ConvertToWindowsOutputPath(path);
+#else
+ return SystemTools::ConvertToUnixOutputPath(path);
+#endif
+}
+
+// remove double slashes not at the start
+kwsys_stl::string SystemTools::ConvertToWindowsOutputPath(const char* path)
+{
+ kwsys_stl::string ret;
+ // make it big enough for all of path and double quotes
+ ret.reserve(strlen(path)+3);
+ // put path into the string
+ ret.insert(0,path);
+ kwsys_stl::string::size_type pos = 0;
+ // first convert all of the slashes
+ while((pos = ret.find('/', pos)) != kwsys_stl::string::npos)
+ {
+ ret[pos] = '\\';
+ pos++;
+ }
+ // check for really small paths
+ if(ret.size() < 2)
+ {
+ return ret;
+ }
+ // now clean up a bit and remove double slashes
+ // Only if it is not the first position in the path which is a network
+ // path on windows
+ pos = 1; // start at position 1
+ if(ret[0] == '\"')
+ {
+ pos = 2; // if the string is already quoted then start at 2
+ if(ret.size() < 3)
+ {
+ return ret;
+ }
+ }
+ while((pos = ret.find("\\\\", pos)) != kwsys_stl::string::npos)
+ {
+ ret.erase(pos, 1);
+ }
+ // now double quote the path if it has spaces in it
+ // and is not already double quoted
+ if(ret.find(' ') != kwsys_stl::string::npos
+ && ret[0] != '\"')
+ {
+ ret.insert(static_cast<kwsys_stl::string::size_type>(0),
+ static_cast<kwsys_stl::string::size_type>(1), '\"');
+ ret.append(1, '\"');
+ }
+ return ret;
+}
+
+bool SystemTools::CopyFileIfDifferent(const char* source,
+ const char* destination)
+{
+ if(SystemTools::FilesDiffer(source, destination))
+ {
+ return SystemTools::CopyFileAlways(source, destination);
+ }
+ return true;
+}
+
+
+bool SystemTools::FilesDiffer(const char* source,
+ const char* destination)
+{
+ struct stat statSource;
+ if (stat(source, &statSource) != 0)
+ {
+ return true;
+ }
+
+ struct stat statDestination;
+ if (stat(destination, &statDestination) != 0)
+ {
+ return true;
+ }
+
+ if(statSource.st_size != statDestination.st_size)
+ {
+ return true;
+ }
+
+ if(statSource.st_size == 0)
+ {
+ return false;
+ }
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+ kwsys_ios::ifstream finSource(source, (kwsys_ios::ios::binary |
+ kwsys_ios::ios::in));
+ kwsys_ios::ifstream finDestination(destination, (kwsys_ios::ios::binary |
+ kwsys_ios::ios::in));
+#else
+ kwsys_ios::ifstream finSource(source);
+ kwsys_ios::ifstream finDestination(destination);
+#endif
+ if(!finSource || !finDestination)
+ {
+ return true;
+ }
+
+ char* source_buf = new char[statSource.st_size];
+ char* dest_buf = new char[statSource.st_size];
+
+ finSource.read(source_buf, statSource.st_size);
+ finDestination.read(dest_buf, statSource.st_size);
+
+ if(statSource.st_size != static_cast<long>(finSource.gcount()) ||
+ statSource.st_size != static_cast<long>(finDestination.gcount()))
+ {
+ // Failed to read files.
+ delete [] source_buf;
+ delete [] dest_buf;
+ return true;
+ }
+ int ret = memcmp((const void*)source_buf,
+ (const void*)dest_buf,
+ statSource.st_size);
+
+ delete [] dest_buf;
+ delete [] source_buf;
+
+ return ret != 0;
+}
+
+
+/**
+ * Copy a file named by "source" to the file named by "destination".
+ */
+bool SystemTools::CopyFileAlways(const char* source, const char* destination)
+{
+ // If files are the same do not copy
+ if ( SystemTools::SameFile(source, destination) )
+ {
+ return true;
+ }
+
+ mode_t perm = 0;
+ bool perms = SystemTools::GetPermissions(source, perm);
+
+ const int bufferSize = 4096;
+ char buffer[bufferSize];
+
+ // If destination is a directory, try to create a file with the same
+ // name as the source in that directory.
+
+ kwsys_stl::string new_destination;
+ if(SystemTools::FileExists(destination) &&
+ SystemTools::FileIsDirectory(destination))
+ {
+ new_destination = destination;
+ SystemTools::ConvertToUnixSlashes(new_destination);
+ new_destination += '/';
+ kwsys_stl::string source_name = source;
+ new_destination += SystemTools::GetFilenameName(source_name);
+ destination = new_destination.c_str();
+ }
+
+ // Create destination directory
+
+ kwsys_stl::string destination_dir = destination;
+ destination_dir = SystemTools::GetFilenamePath(destination_dir);
+ SystemTools::MakeDirectory(destination_dir.c_str());
+
+ // Open files
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+ kwsys_ios::ifstream fin(source,
+ kwsys_ios::ios::binary | kwsys_ios::ios::in);
+#else
+ kwsys_ios::ifstream fin(source);
+#endif
+ if(!fin)
+ {
+ return false;
+ }
+
+ // try and remove the destination file so that read only destination files
+ // can be written to.
+ // If the remove fails continue so that files in read only directories
+ // that do not allow file removal can be modified.
+ SystemTools::RemoveFile(destination);
+
+#if defined(_WIN32) || defined(__CYGWIN__)
+ kwsys_ios::ofstream fout(destination,
+ kwsys_ios::ios::binary | kwsys_ios::ios::out | kwsys_ios::ios::trunc);
+#else
+ kwsys_ios::ofstream fout(destination,
+ kwsys_ios::ios::out | kwsys_ios::ios::trunc);
+#endif
+ if(!fout)
+ {
+ return false;
+ }
+
+ // This copy loop is very sensitive on certain platforms with
+ // slightly broken stream libraries (like HPUX). Normally, it is
+ // incorrect to not check the error condition on the fin.read()
+ // before using the data, but the fin.gcount() will be zero if an
+ // error occurred. Therefore, the loop should be safe everywhere.
+ while(fin)
+ {
+ fin.read(buffer, bufferSize);
+ if(fin.gcount())
+ {
+ fout.write(buffer, fin.gcount());
+ }
+ }
+
+ // Make sure the operating system has finished writing the file
+ // before closing it. This will ensure the file is finished before
+ // the check below.
+ fout.flush();
+
+ fin.close();
+ fout.close();
+
+ // More checks.
+ struct stat statSource, statDestination;
+ statSource.st_size = 12345;
+ statDestination.st_size = 12345;
+ if(stat(source, &statSource) != 0)
+ {
+ return false;
+ }
+ else if(stat(destination, &statDestination) != 0)
+ {
+ return false;
+ }
+ else if(statSource.st_size != statDestination.st_size)
+ {
+ return false;
+ }
+ if ( perms )
+ {
+ if ( !SystemTools::SetPermissions(destination, perm) )
+ {
+ return false;
+ }
+ }
+ return true;
+}
+
+/**
+ * Copy a directory content from "source" directory to the directory named by
+ * "destination".
+ */
+bool SystemTools::CopyADirectory(const char* source, const char* destination)
+{
+ Directory dir;
+ dir.Load(source);
+ size_t fileNum;
+ if ( !SystemTools::MakeDirectory(destination) )
+ {
+ return false;
+ }
+ for (fileNum = 0; fileNum < dir.GetNumberOfFiles(); ++fileNum)
+ {
+ if (strcmp(dir.GetFile(static_cast<unsigned long>(fileNum)),".") &&
+ strcmp(dir.GetFile(static_cast<unsigned long>(fileNum)),".."))
+ {
+ kwsys_stl::string fullPath = source;
+ fullPath += "/";
+ fullPath += dir.GetFile(static_cast<unsigned long>(fileNum));
+ if(SystemTools::FileIsDirectory(fullPath.c_str()))
+ {
+ kwsys_stl::string fullDestPath = destination;
+ fullDestPath += "/";
+ fullDestPath += dir.GetFile(static_cast<unsigned long>(fileNum));
+ if (!SystemTools::CopyADirectory(fullPath.c_str(), fullDestPath.c_str()))
+ {
+ return false;
+ }
+ }
+ else
+ {
+ if(!SystemTools::CopyFileAlways(fullPath.c_str(), destination))
+ {
+ return false;
+ }
+ }
+ }
+ }
+
+ return true;
+}
+
+
+// return size of file; also returns zero if no file exists
+unsigned long SystemTools::FileLength(const char* filename)
+{
+ struct stat fs;
+ if (stat(filename, &fs) != 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return static_cast<unsigned long>(fs.st_size);
+ }
+}
+
+int SystemTools::Strucmp(const char *s1, const char *s2)
+{
+ // lifted from Graphvis http://www.graphviz.org
+ while ((*s1 != '\0')
+ && (tolower(*s1) == tolower(*s2)))
+ {
+ s1++;
+ s2++;
+ }
+
+ return tolower(*s1) - tolower(*s2);
+}
+
+// return file's modified time
+long int SystemTools::ModifiedTime(const char* filename)
+{
+ struct stat fs;
+ if (stat(filename, &fs) != 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return (long int)fs.st_mtime;
+ }
+}
+
+// return file's creation time
+long int SystemTools::CreationTime(const char* filename)
+{
+ struct stat fs;
+ if (stat(filename, &fs) != 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return fs.st_ctime >= 0 ? (long int)fs.st_ctime : 0;
+ }
+}
+
+bool SystemTools::ConvertDateMacroString(const char *str, time_t *tmt)
+{
+ if (!str || !tmt || strlen(str) < 12)
+ {
+ return false;
+ }
+
+ struct tm tmt2;
+
+ // __DATE__
+ // The compilation date of the current source file. The date is a string
+ // literal of the form Mmm dd yyyy. The month name Mmm is the same as for
+ // dates generated by the library function asctime declared in TIME.H.
+
+ // index: 012345678901
+ // format: Mmm dd yyyy
+ // example: Dec 19 2003
+
+ static char month_names[] = "JanFebMarAprMayJunJulAugSepOctNovDec";
+
+ char buffer[12];
+ strcpy(buffer, str);
+
+ buffer[3] = 0;
+ char *ptr = strstr(month_names, buffer);
+ if (!ptr)
+ {
+ return false;
+ }
+
+ int month = (ptr - month_names) / 3;
+ int day = atoi(buffer + 4);
+ int year = atoi(buffer + 7);
+
+ tmt2.tm_isdst = -1;
+ tmt2.tm_hour = 0;
+ tmt2.tm_min = 0;
+ tmt2.tm_sec = 0;
+ tmt2.tm_wday = 0;
+ tmt2.tm_yday = 0;
+ tmt2.tm_mday = day;
+ tmt2.tm_mon = month;
+ tmt2.tm_year = year - 1900;
+
+ *tmt = mktime(&tmt2);
+ return true;
+}
+
+bool SystemTools::ConvertTimeStampMacroString(const char *str, time_t *tmt)
+{
+ if (!str || !tmt || strlen(str) < 27)
+ {
+ return false;
+ }
+
+ struct tm tmt2;
+
+ // __TIMESTAMP__
+ // The date and time of the last modification of the current source file,
+ // expressed as a string literal in the form Ddd Mmm Date hh:mm:ss yyyy,
+ /// where Ddd is the abbreviated day of the week and Date is an integer
+ // from 1 to 31.
+
+ // index: 0123456789
+ // 0123456789
+ // 0123456789
+ // format: Ddd Mmm Date hh:mm:ss yyyy
+ // example: Fri Dec 19 14:34:58 2003
+
+ static char month_names[] = "JanFebMarAprMayJunJulAugSepOctNovDec";
+
+ char buffer[27];
+ strcpy(buffer, str);
+
+ buffer[7] = 0;
+ char *ptr = strstr(month_names, buffer + 4);
+ if (!ptr)
+ {
+ return false;
+ }
+
+ int month = (ptr - month_names) / 3;
+ int day = atoi(buffer + 8);
+ int hour = atoi(buffer + 11);
+ int min = atoi(buffer + 14);
+ int sec = atoi(buffer + 17);
+ int year = atoi(buffer + 20);
+
+ tmt2.tm_isdst = -1;
+ tmt2.tm_hour = hour;
+ tmt2.tm_min = min;
+ tmt2.tm_sec = sec;
+ tmt2.tm_wday = 0;
+ tmt2.tm_yday = 0;
+ tmt2.tm_mday = day;
+ tmt2.tm_mon = month;
+ tmt2.tm_year = year - 1900;
+
+ *tmt = mktime(&tmt2);
+ return true;
+}
+
+kwsys_stl::string SystemTools::GetLastSystemError()
+{
+ int e = errno;
+ return strerror(e);
+}
+
+bool SystemTools::RemoveFile(const char* source)
+{
+#ifdef _WIN32
+ mode_t mode;
+ if ( !SystemTools::GetPermissions(source, mode) )
+ {
+ return false;
+ }
+ /* Win32 unlink is stupid --- it fails if the file is read-only */
+ SystemTools::SetPermissions(source, S_IWRITE);
+#endif
+ bool res = unlink(source) != 0 ? false : true;
+#ifdef _WIN32
+ if ( !res )
+ {
+ SystemTools::SetPermissions(source, mode);
+ }
+#endif
+ return res;
+}
+
+bool SystemTools::RemoveADirectory(const char* source)
+{
+ Directory dir;
+ dir.Load(source);
+ size_t fileNum;
+ for (fileNum = 0; fileNum < dir.GetNumberOfFiles(); ++fileNum)
+ {
+ if (strcmp(dir.GetFile(static_cast<unsigned long>(fileNum)),".") &&
+ strcmp(dir.GetFile(static_cast<unsigned long>(fileNum)),".."))
+ {
+ kwsys_stl::string fullPath = source;
+ fullPath += "/";
+ fullPath += dir.GetFile(static_cast<unsigned long>(fileNum));
+ if(SystemTools::FileIsDirectory(fullPath.c_str()) &&
+ !SystemTools::FileIsSymlink(fullPath.c_str()))
+ {
+ if (!SystemTools::RemoveADirectory(fullPath.c_str()))
+ {
+ return false;
+ }
+ }
+ else
+ {
+ if(!SystemTools::RemoveFile(fullPath.c_str()))
+ {
+ return false;
+ }
+ }
+ }
+ }
+
+ return (Rmdir(source) == 0);
+}
+
+/**
+ */
+size_t SystemTools::GetMaximumFilePathLength()
+{
+ return KWSYS_SYSTEMTOOLS_MAXPATH;
+}
+
+/**
+ * Find the file the given name. Searches the given path and then
+ * the system search path. Returns the full path to the file if it is
+ * found. Otherwise, the empty string is returned.
+ */
+kwsys_stl::string SystemTools
+::FindFile(const char* name,
+ const kwsys_stl::vector<kwsys_stl::string>& userPaths)
+{
+ // Add the system search path to our path first
+ kwsys_stl::vector<kwsys_stl::string> path;
+ SystemTools::GetPath(path, "CMAKE_FILE_PATH");
+ SystemTools::GetPath(path);
+ // now add the additional paths
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator i = userPaths.begin();
+ i != userPaths.end(); ++i)
+ {
+ path.push_back(*i);
+ }
+ // now look for the file
+ kwsys_stl::string tryPath;
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator p = path.begin();
+ p != path.end(); ++p)
+ {
+ tryPath = *p;
+ tryPath += "/";
+ tryPath += name;
+ if(SystemTools::FileExists(tryPath.c_str()) &&
+ !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ }
+ // Couldn't find the file.
+ return "";
+}
+
+/**
+ * Find the executable with the given name. Searches the given path and then
+ * the system search path. Returns the full path to the executable if it is
+ * found. Otherwise, the empty string is returned.
+ */
+kwsys_stl::string SystemTools::FindProgram(
+ const char* nameIn,
+ const kwsys_stl::vector<kwsys_stl::string>& userPaths,
+ bool no_system_path)
+{
+ if(!nameIn)
+ {
+ return "";
+ }
+ kwsys_stl::string name = nameIn;
+ bool hasExtension = false;
+ // check to see if the name already has a .xxx at
+ // the end of it
+ if(name.size() > 3 && name[name.size()-4] == '.')
+ {
+ hasExtension = true;
+ }
+ kwsys_stl::vector<kwsys_stl::string> extensions;
+#if defined (_WIN32) || defined(__CYGWIN__) | defined(__MINGW32__)
+ // on windows try .com then .exe
+ if(!hasExtension)
+ {
+ extensions.push_back(".com");
+ extensions.push_back(".exe");
+ }
+#endif
+ kwsys_stl::string tryPath;
+ // first try the name as it was given (adding extensions
+ // if needed.)
+ if(extensions.size())
+ {
+ for(kwsys_stl::vector<kwsys_stl::string>::iterator i =
+ extensions.begin(); i != extensions.end(); ++i)
+ {
+ tryPath = name;
+ tryPath += *i;
+ if(SystemTools::FileExists(tryPath.c_str()) &&
+ !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ }
+ }
+ else
+ {
+ tryPath = name;
+ if(SystemTools::FileExists(tryPath.c_str()) &&
+ !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ }
+ // now construct the path
+ kwsys_stl::vector<kwsys_stl::string> path;
+ // Add the system search path to our path.
+ if (!no_system_path)
+ {
+ SystemTools::GetPath(path);
+ }
+ // now add the additional paths
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator i =
+ userPaths.begin(); i != userPaths.end(); ++i)
+ {
+ path.push_back(*i);
+ }
+ // Try each path
+ for(kwsys_stl::vector<kwsys_stl::string>::iterator p = path.begin();
+ p != path.end(); ++p)
+ {
+#ifdef _WIN32
+ // Remove double quotes from the path on windows
+ SystemTools::ReplaceString(*p, "\"", "");
+#endif
+ if(extensions.size())
+ {
+ for(kwsys_stl::vector<kwsys_stl::string>::iterator ext
+ = extensions.begin(); ext != extensions.end(); ++ext)
+ {
+ tryPath = *p;
+ tryPath += "/";
+ tryPath += name;
+ tryPath += *ext;
+ if(SystemTools::FileExists(tryPath.c_str()) &&
+ !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ }
+ }
+ else
+ {
+ tryPath = *p;
+ tryPath += "/";
+ tryPath += name;
+ if(SystemTools::FileExists(tryPath.c_str()) &&
+ !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ }
+ }
+ // Couldn't find the program.
+ return "";
+}
+
+kwsys_stl::string SystemTools::FindProgram(
+ const kwsys_stl::vector<kwsys_stl::string>& names,
+ const kwsys_stl::vector<kwsys_stl::string>& path,
+ bool noSystemPath)
+{
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator it = names.begin();
+ it != names.end() ; ++it)
+ {
+ // Try to find the program.
+ kwsys_stl::string result = SystemTools::FindProgram(it->c_str(),
+ path,
+ noSystemPath);
+ if ( !result.empty() )
+ {
+ return result;
+ }
+ }
+ return "";
+}
+
+/**
+ * Find the library with the given name. Searches the given path and then
+ * the system search path. Returns the full path to the library if it is
+ * found. Otherwise, the empty string is returned.
+ */
+kwsys_stl::string SystemTools
+::FindLibrary(const char* name,
+ const kwsys_stl::vector<kwsys_stl::string>& userPaths)
+{
+ // See if the executable exists as written.
+ if(SystemTools::FileExists(name) &&
+ !SystemTools::FileIsDirectory(name))
+ {
+ return SystemTools::CollapseFullPath(name);
+ }
+
+ // Add the system search path to our path.
+ kwsys_stl::vector<kwsys_stl::string> path;
+ SystemTools::GetPath(path);
+ // now add the additional paths
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator i = userPaths.begin();
+ i != userPaths.end(); ++i)
+ {
+ path.push_back(*i);
+ }
+ kwsys_stl::string tryPath;
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator p = path.begin();
+ p != path.end(); ++p)
+ {
+#if defined(__APPLE__)
+ tryPath = *p;
+ tryPath += "/";
+ tryPath += name;
+ tryPath += ".framework";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+#endif
+#if defined(_WIN32) && !defined(__CYGWIN__) && !defined(__MINGW32__)
+ tryPath = *p;
+ tryPath += "/";
+ tryPath += name;
+ tryPath += ".lib";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+#else
+ tryPath = *p;
+ tryPath += "/lib";
+ tryPath += name;
+ tryPath += ".so";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ tryPath = *p;
+ tryPath += "/lib";
+ tryPath += name;
+ tryPath += ".a";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ tryPath = *p;
+ tryPath += "/lib";
+ tryPath += name;
+ tryPath += ".sl";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ tryPath = *p;
+ tryPath += "/lib";
+ tryPath += name;
+ tryPath += ".dylib";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+ tryPath = *p;
+ tryPath += "/lib";
+ tryPath += name;
+ tryPath += ".dll";
+ if(SystemTools::FileExists(tryPath.c_str())
+ && !SystemTools::FileIsDirectory(tryPath.c_str()))
+ {
+ return SystemTools::CollapseFullPath(tryPath.c_str());
+ }
+#endif
+ }
+
+ // Couldn't find the library.
+ return "";
+}
+
+bool SystemTools::FileIsDirectory(const char* name)
+{
+ struct stat fs;
+ if(stat(name, &fs) == 0)
+ {
+#if _WIN32
+ return ((fs.st_mode & _S_IFDIR) != 0);
+#else
+ return S_ISDIR(fs.st_mode);
+#endif
+ }
+ else
+ {
+ return false;
+ }
+}
+
+bool SystemTools::FileIsSymlink(const char* name)
+{
+#if _WIN32
+ (void)name;
+ return false;
+#else
+ struct stat fs;
+ if(lstat(name, &fs) == 0)
+ {
+ return S_ISLNK(fs.st_mode);
+ }
+ else
+ {
+ return false;
+ }
+#endif
+}
+
+int SystemTools::ChangeDirectory(const char *dir)
+{
+ return Chdir(dir);
+}
+
+kwsys_stl::string SystemTools::GetCurrentWorkingDirectory(bool collapse)
+{
+ char buf[2048];
+ const char* cwd = Getcwd(buf, 2048);
+ kwsys_stl::string path;
+ if ( cwd )
+ {
+ path = cwd;
+ }
+ if(collapse)
+ {
+ return SystemTools::CollapseFullPath(path.c_str());
+ }
+ return path;
+}
+
+kwsys_stl::string SystemTools::GetProgramPath(const char* in_name)
+{
+ kwsys_stl::string dir, file;
+ SystemTools::SplitProgramPath(in_name, dir, file);
+ return dir;
+}
+
+bool SystemTools::SplitProgramPath(const char* in_name,
+ kwsys_stl::string& dir,
+ kwsys_stl::string& file,
+ bool)
+{
+ dir = in_name;
+ file = "";
+ SystemTools::ConvertToUnixSlashes(dir);
+
+ if(!SystemTools::FileIsDirectory(dir.c_str()))
+ {
+ kwsys_stl::string::size_type slashPos = dir.rfind("/");
+ if(slashPos != kwsys_stl::string::npos)
+ {
+ file = dir.substr(slashPos+1);
+ dir = dir.substr(0, slashPos);
+ }
+ else
+ {
+ file = dir;
+ dir = "";
+ }
+ }
+ if(!(dir == "") && !SystemTools::FileIsDirectory(dir.c_str()))
+ {
+ kwsys_stl::string oldDir = in_name;
+ SystemTools::ConvertToUnixSlashes(oldDir);
+ dir = in_name;
+ return false;
+ }
+ return true;
+}
+
+bool SystemTools::FindProgramPath(const char* argv0,
+ kwsys_stl::string& pathOut,
+ kwsys_stl::string& errorMsg,
+ const char* exeName,
+ const char* buildDir,
+ const char* installPrefix )
+{
+ kwsys_stl::vector<kwsys_stl::string> failures;
+ kwsys_stl::string self = argv0;
+ SystemTools::ConvertToUnixSlashes(self);
+ failures.push_back(argv0);
+ self = SystemTools::FindProgram(self.c_str());
+ if(!SystemTools::FileExists(self.c_str()))
+ {
+ if(buildDir)
+ {
+ kwsys_stl::string intdir = ".";
+#ifdef CMAKE_INTDIR
+ intdir = CMAKE_INTDIR;
+#endif
+ self = buildDir;
+ self += "/bin/";
+ self += intdir;
+ self += "/";
+ self += exeName;
+ self += SystemTools::GetExecutableExtension();
+ }
+ }
+ if(installPrefix)
+ {
+ if(!SystemTools::FileExists(self.c_str()))
+ {
+ failures.push_back(self);
+ self = installPrefix;
+ self += "/bin/";
+ self += exeName;
+ }
+ }
+ if(!SystemTools::FileExists(self.c_str()))
+ {
+ failures.push_back(self);
+ kwsys_ios::ostringstream msg;
+ msg << "Can not find the command line program " << exeName << "\n";
+ msg << " argv[0] = \"" << argv0 << "\"\n";
+ msg << " Attempted paths:\n";
+ kwsys_stl::vector<kwsys_stl::string>::iterator i;
+ for(i=failures.begin(); i != failures.end(); ++i)
+ {
+ msg << " \"" << i->c_str() << "\"\n";
+ }
+ errorMsg = msg.str();
+ return false;
+ }
+ pathOut = self;
+ return true;
+}
+
+
+kwsys_stl::string SystemTools::CollapseFullPath(const char* in_relative)
+{
+ return SystemTools::CollapseFullPath(in_relative, 0);
+}
+
+void SystemTools::AddTranslationPath(const char * a, const char * b)
+{
+ kwsys_stl::string path_a = a;
+ kwsys_stl::string path_b = b;
+ SystemTools::ConvertToUnixSlashes(path_a);
+ SystemTools::ConvertToUnixSlashes(path_b);
+ // First check this is a directory path, since we don't want the table to
+ // grow too fat
+ if( SystemTools::FileIsDirectory( path_a.c_str() ) )
+ {
+ // Make sure the path is a full path and does not contain no '..'
+ if( SystemTools::FileIsFullPath(path_b.c_str()) && path_b.find("..")
+ == kwsys_stl::string::npos )
+ {
+ // Before inserting make sure path ends with '/'
+ if(path_a.size() && path_a[path_a.size() -1] != '/')
+ {
+ path_a += '/';
+ }
+ if(path_b.size() && path_b[path_b.size() -1] != '/')
+ {
+ path_b += '/';
+ }
+ if( !(path_a == path_b) )
+ {
+ SystemTools::TranslationMap->insert(
+ SystemToolsTranslationMap::value_type(path_a, path_b));
+ }
+ }
+ }
+}
+
+void SystemTools::AddKeepPath(const char* dir)
+{
+ kwsys_stl::string cdir = SystemTools::CollapseFullPath(dir);
+ SystemTools::AddTranslationPath(cdir.c_str(), dir);
+}
+
+void SystemTools::CheckTranslationPath(kwsys_stl::string & path)
+{
+ // Do not translate paths that are too short to have meaningful
+ // translations.
+ if(path.size() < 2)
+ {
+ return;
+ }
+
+ // Always add a trailing slash before translation. It does not
+ // matter if this adds an extra slash, but we do not want to
+ // translate part of a directory (like the foo part of foo-dir).
+ path += "/";
+
+ // In case a file was specified we still have to go through this:
+ // Now convert any path found in the table back to the one desired:
+ kwsys_stl::map<kwsys_stl::string,kwsys_stl::string>::const_iterator it;
+ for(it = SystemTools::TranslationMap->begin();
+ it != SystemTools::TranslationMap->end();
+ ++it )
+ {
+ // We need to check of the path is a substring of the other path
+ if(path.find( it->first ) == 0)
+ {
+ path = path.replace( 0, it->first.size(), it->second);
+ }
+ }
+
+ // Remove the trailing slash we added before.
+ path.erase(path.end()-1, path.end());
+}
+
+void
+SystemToolsAppendComponents(
+ kwsys_stl::vector<kwsys_stl::string>& out_components,
+ kwsys_stl::vector<kwsys_stl::string>::const_iterator first,
+ kwsys_stl::vector<kwsys_stl::string>::const_iterator last)
+{
+ for(kwsys_stl::vector<kwsys_stl::string>::const_iterator i = first;
+ i != last; ++i)
+ {
+ if(*i == "..")
+ {
+ if(out_components.begin() != out_components.end())
+ {
+ out_components.erase(out_components.end()-1, out_components.end());
+ }
+ }
+ else if(!(*i == ".") && !(*i == ""))
+ {
+ out_components.push_back(*i);
+ }
+ }
+}
+
+kwsys_stl::string SystemTools::CollapseFullPath(const char* in_path,
+ const char* in_base)
+{
+ // Collect the output path components.
+ kwsys_stl::vector<kwsys_stl::string> out_components;
+
+ // Split the input path components.
+ kwsys_stl::vector<kwsys_stl::string> path_components;
+ SystemTools::SplitPath(in_path, path_components);
+
+ // If the input path is relative, start with a base path.
+ if(path_components[0].length() == 0)
+ {
+ kwsys_stl::vector<kwsys_stl::string> base_components;
+ if(in_base)
+ {
+ // Use the given base path.
+ SystemTools::SplitPath(in_base, base_components);
+ }
+ else
+ {
+ // Use the current working directory as a base path.
+ char buf[2048];
+ if(const char* cwd = Getcwd(buf, 2048))
+ {
+ SystemTools::SplitPath(cwd, base_components);
+ }
+ else
+ {
+ // ??
+ }
+ }
+
+ // Append base path components to the output path.
+ out_components.push_back(base_components[0]);
+ SystemToolsAppendComponents(out_components,
+ base_components.begin()+1,
+ base_components.end());
+ }
+
+ // Append input path components to the output path.
+ SystemToolsAppendComponents(out_components,
+ path_components.begin(),
+ path_components.end());
+
+ // Transform the path back to a string.
+ kwsys_stl::string newPath = SystemTools::JoinPath(out_components);
+
+ // Update the translation table with this potentially new path.
+ SystemTools::AddTranslationPath(newPath.c_str(), in_path);
+ SystemTools::CheckTranslationPath(newPath);
+#ifdef _WIN32
+ newPath = SystemTools::GetActualCaseForPath(newPath.c_str());
+ SystemTools::ConvertToUnixSlashes(newPath);
+#endif
+ // Return the reconstructed path.
+ return newPath;
+}
+
+// compute the relative path from here to there
+kwsys_stl::string SystemTools::RelativePath(const char* local, const char* remote)
+{
+ if(!SystemTools::FileIsFullPath(local))
+ {
+ return "";
+ }
+ if(!SystemTools::FileIsFullPath(remote))
+ {
+ return "";
+ }
+
+ // split up both paths into arrays of strings using / as a separator
+ kwsys_stl::vector<kwsys::String> localSplit = SystemTools::SplitString(local, '/', true);
+ kwsys_stl::vector<kwsys::String> remoteSplit = SystemTools::SplitString(remote, '/', true);
+ kwsys_stl::vector<kwsys::String> commonPath; // store shared parts of path in this array
+ kwsys_stl::vector<kwsys::String> finalPath; // store the final relative path here
+ // count up how many matching directory names there are from the start
+ unsigned int sameCount = 0;
+ while(
+ ((sameCount <= (localSplit.size()-1)) && (sameCount <= (remoteSplit.size()-1)))
+ &&
+// for windows and apple do a case insensitive string compare
+#if defined(_WIN32) || defined(__APPLE__)
+ SystemTools::Strucmp(localSplit[sameCount].c_str(),
+ remoteSplit[sameCount].c_str()) == 0
+#else
+ localSplit[sameCount] == remoteSplit[sameCount]
+#endif
+ )
+ {
+ // put the common parts of the path into the commonPath array
+ commonPath.push_back(localSplit[sameCount]);
+ // erase the common parts of the path from the original path arrays
+ localSplit[sameCount] = "";
+ remoteSplit[sameCount] = "";
+ sameCount++;
+ }
+ // If there is nothing in common but the root directory, then just
+ // return the full path.
+ if(sameCount <= 1)
+ {
+ return remote;
+ }
+
+ // for each entry that is not common in the local path
+ // add a ../ to the finalpath array, this gets us out of the local
+ // path into the remote dir
+ for(unsigned int i = 0; i < localSplit.size(); ++i)
+ {
+ if(localSplit[i].size())
+ {
+ finalPath.push_back("../");
+ }
+ }
+ // for each entry that is not common in the remote path add it
+ // to the final path.
+ for(kwsys_stl::vector<String>::iterator vit = remoteSplit.begin();
+ vit != remoteSplit.end(); ++vit)
+ {
+ if(vit->size())
+ {
+ finalPath.push_back(*vit);
+ }
+ }
+ kwsys_stl::string relativePath; // result string
+ // now turn the array of directories into a unix path by puttint /
+ // between each entry that does not already have one
+ for(kwsys_stl::vector<String>::iterator vit1 = finalPath.begin();
+ vit1 != finalPath.end(); ++vit1)
+ {
+ if(relativePath.size() && relativePath[relativePath.size()-1] != '/')
+ {
+ relativePath += "/";
+ }
+ relativePath += *vit1;
+ }
+ return relativePath;
+}
+
+// OK, some fun stuff to get the actual case of a given path.
+// Basically, you just need to call ShortPath, then GetLongPathName,
+// However, GetLongPathName is not implemented on windows NT and 95,
+// so we have to simulate it on those versions
+#ifdef _WIN32
+int OldWindowsGetLongPath(kwsys_stl::string const& shortPath,
+ kwsys_stl::string& longPath )
+{
+ kwsys_stl::string::size_type iFound = shortPath.rfind('/');
+ if (iFound > 1 && iFound != shortPath.npos)
+ {
+ // recurse to peel off components
+ //
+ if (OldWindowsGetLongPath(shortPath.substr(0, iFound), longPath) > 0)
+ {
+ longPath += '/';
+ if (shortPath[1] != '/')
+ {
+ WIN32_FIND_DATA findData;
+
+ // append the long component name to the path
+ //
+ if (INVALID_HANDLE_VALUE != ::FindFirstFile
+ (shortPath.c_str(), &findData))
+ {
+ longPath += findData.cFileName;
+ }
+ else
+ {
+ // if FindFirstFile fails, return the error code
+ //
+ longPath = "";
+ return 0;
+ }
+ }
+ }
+ }
+ else
+ {
+ longPath = shortPath;
+ }
+ return longPath.size();
+}
+
+
+int PortableGetLongPathName(const char* pathIn,
+ kwsys_stl::string & longPath)
+{
+ kwsys_stl::string shortPath;
+ if(!SystemTools::GetShortPath(pathIn, shortPath))
+ {
+ return 0;
+ }
+ HMODULE lh = LoadLibrary("Kernel32.dll");
+ if(lh)
+ {
+ FARPROC proc = GetProcAddress(lh, "GetLongPathNameA");
+ if(proc)
+ {
+ typedef DWORD (WINAPI * GetLongFunctionPtr) (LPCSTR,LPSTR,DWORD);
+ GetLongFunctionPtr func = (GetLongFunctionPtr)proc;
+ char buffer[MAX_PATH+1];
+ int len = (*func)(shortPath.c_str(), buffer, MAX_PATH+1);
+ if(len == 0 || len > MAX_PATH+1)
+ {
+ FreeLibrary(lh);
+ return 0;
+ }
+ longPath = buffer;
+ FreeLibrary(lh);
+ return len;
+ }
+ FreeLibrary(lh);
+ }
+ return OldWindowsGetLongPath(shortPath.c_str(), longPath);
+}
+#endif
+
+
+//----------------------------------------------------------------------------
+kwsys_stl::string SystemTools::GetActualCaseForPath(const char* p)
+{
+#ifndef _WIN32
+ return p;
+#else
+ kwsys_stl::string shortPath;
+ if(!SystemTools::GetShortPath(p, shortPath))
+ {
+ return p;
+ }
+ kwsys_stl::string longPath;
+ int len = PortableGetLongPathName(shortPath.c_str(), longPath);
+ if(len == 0 || len > MAX_PATH+1)
+ {
+ return p;
+ }
+ return longPath;
+#endif
+}
+
+//----------------------------------------------------------------------------
+void SystemTools::SplitPath(const char* p,
+ kwsys_stl::vector<kwsys_stl::string>& components)
+{
+ components.clear();
+ // Identify the root component.
+ const char* c = p;
+ if((c[0] == '/' && c[1] == '/') || (c[0] == '\\' && c[1] == '\\'))
+ {
+ // Network path.
+ components.push_back("//");
+ c += 2;
+ }
+ else if(c[0] == '/')
+ {
+ // Unix path.
+ components.push_back("/");
+ c += 1;
+ }
+ else if(c[0] && c[1] == ':' && (c[2] == '/' || c[2] == '\\'))
+ {
+ // Windows path.
+ kwsys_stl::string root = "_:/";
+ root[0] = c[0];
+ components.push_back(root);
+ c += 3;
+ }
+ else if(c[0] && c[1] == ':')
+ {
+ // Path relative to a windows drive working directory.
+ kwsys_stl::string root = "_:";
+ root[0] = c[0];
+ components.push_back(root);
+ c += 2;
+ }
+ else
+ {
+ // Relative path.
+ components.push_back("");
+ }
+
+ // Parse the remaining components.
+ const char* first = c;
+ const char* last = first;
+ for(;*last; ++last)
+ {
+ if(*last == '/' || *last == '\\')
+ {
+ // End of a component. Save it.
+ components.push_back(kwsys_stl::string(first, last-first));
+ first = last+1;
+ }
+ }
+
+ // Save the last component unless there were no components.
+ if(last != c)
+ {
+ components.push_back(kwsys_stl::string(first, last-first));
+ }
+}
+
+//----------------------------------------------------------------------------
+kwsys_stl::string
+SystemTools::JoinPath(const kwsys_stl::vector<kwsys_stl::string>& components)
+{
+ kwsys_stl::string result;
+ if(components.size() > 0)
+ {
+ result += components[0];
+ }
+ if(components.size() > 1)
+ {
+ result += components[1];
+ }
+ for(unsigned int i=2; i < components.size(); ++i)
+ {
+ result += "/";
+ result += components[i];
+ }
+ return result;
+}
+
+//----------------------------------------------------------------------------
+bool SystemTools::ComparePath(const char* c1, const char* c2)
+{
+#if defined(_WIN32) || defined(__APPLE__)
+ return SystemTools::Strucmp(c1, c2) == 0;
+#else
+ return strcmp(c1, c2) == 0;
+#endif
+}
+
+//----------------------------------------------------------------------------
+bool SystemTools::Split(const char* str, kwsys_stl::vector<kwsys_stl::string>& lines, char separator)
+{
+ kwsys_stl::string data(str);
+ kwsys_stl::string::size_type lpos = 0;
+ while(lpos < data.length())
+ {
+ kwsys_stl::string::size_type rpos = data.find_first_of(separator, lpos);
+ if(rpos == kwsys_stl::string::npos)
+ {
+ // Line ends at end of string without a newline.
+ lines.push_back(data.substr(lpos));
+ return false;
+ }
+ else
+ {
+ // Line ends in a "\n", remove the character.
+ lines.push_back(data.substr(lpos, rpos-lpos));
+ }
+ lpos = rpos+1;
+ }
+ return true;
+}
+
+//----------------------------------------------------------------------------
+bool SystemTools::Split(const char* str, kwsys_stl::vector<kwsys_stl::string>& lines)
+{
+ kwsys_stl::string data(str);
+ kwsys_stl::string::size_type lpos = 0;
+ while(lpos < data.length())
+ {
+ kwsys_stl::string::size_type rpos = data.find_first_of("\n", lpos);
+ if(rpos == kwsys_stl::string::npos)
+ {
+ // Line ends at end of string without a newline.
+ lines.push_back(data.substr(lpos));
+ return false;
+ }
+ if((rpos > lpos) && (data[rpos-1] == '\r'))
+ {
+ // Line ends in a "\r\n" pair, remove both characters.
+ lines.push_back(data.substr(lpos, (rpos-1)-lpos));
+ }
+ else
+ {
+ // Line ends in a "\n", remove the character.
+ lines.push_back(data.substr(lpos, rpos-lpos));
+ }
+ lpos = rpos+1;
+ }
+ return true;
+}
+
+/**
+ * Return path of a full filename (no trailing slashes).
+ * Warning: returned path is converted to Unix slashes format.
+ */
+kwsys_stl::string SystemTools::GetFilenamePath(const kwsys_stl::string& filename)
+{
+ kwsys_stl::string fn = filename;
+ SystemTools::ConvertToUnixSlashes(fn);
+
+ kwsys_stl::string::size_type slash_pos = fn.rfind("/");
+ if(slash_pos != kwsys_stl::string::npos)
+ {
+ return fn.substr(0, slash_pos);
+ }
+ else
+ {
+ return "";
+ }
+}
+
+
+/**
+ * Return file name of a full filename (i.e. file name without path).
+ */
+kwsys_stl::string SystemTools::GetFilenameName(const kwsys_stl::string& filename)
+{
+#if defined(_WIN32)
+ kwsys_stl::string::size_type slash_pos = filename.find_last_of("/\\");
+#else
+ kwsys_stl::string::size_type slash_pos = filename.find_last_of("/");
+#endif
+ if(slash_pos != kwsys_stl::string::npos)
+ {
+ return filename.substr(slash_pos + 1);
+ }
+ else
+ {
+ return filename;
+ }
+}
+
+
+/**
+ * Return file extension of a full filename (dot included).
+ * Warning: this is the longest extension (for example: .tar.gz)
+ */
+kwsys_stl::string SystemTools::GetFilenameExtension(const kwsys_stl::string& filename)
+{
+ kwsys_stl::string name = SystemTools::GetFilenameName(filename);
+ kwsys_stl::string::size_type dot_pos = name.find(".");
+ if(dot_pos != kwsys_stl::string::npos)
+ {
+ return name.substr(dot_pos);
+ }
+ else
+ {
+ return "";
+ }
+}
+
+/**
+ * Return file extension of a full filename (dot included).
+ * Warning: this is the shortest extension (for example: .tar.gz)
+ */
+kwsys_stl::string SystemTools::GetFilenameLastExtension(const kwsys_stl::string& filename)
+{
+ kwsys_stl::string name = SystemTools::GetFilenameName(filename);
+ kwsys_stl::string::size_type dot_pos = name.rfind(".");
+ if(dot_pos != kwsys_stl::string::npos)
+ {
+ return name.substr(dot_pos);
+ }
+ else
+ {
+ return "";
+ }
+}
+
+/**
+ * Return file name without extension of a full filename (i.e. without path).
+ * Warning: it considers the longest extension (for example: .tar.gz)
+ */
+kwsys_stl::string SystemTools::GetFilenameWithoutExtension(const kwsys_stl::string& filename)
+{
+ kwsys_stl::string name = SystemTools::GetFilenameName(filename);
+ kwsys_stl::string::size_type dot_pos = name.find(".");
+ if(dot_pos != kwsys_stl::string::npos)
+ {
+ return name.substr(0, dot_pos);
+ }
+ else
+ {
+ return name;
+ }
+}
+
+
+/**
+ * Return file name without extension of a full filename (i.e. without path).
+ * Warning: it considers the last extension (for example: removes .gz
+ * from .tar.gz)
+ */
+kwsys_stl::string
+SystemTools::GetFilenameWithoutLastExtension(const kwsys_stl::string& filename)
+{
+ kwsys_stl::string name = SystemTools::GetFilenameName(filename);
+ kwsys_stl::string::size_type dot_pos = name.rfind(".");
+ if(dot_pos != kwsys_stl::string::npos)
+ {
+ return name.substr(0, dot_pos);
+ }
+ else
+ {
+ return name;
+ }
+}
+
+bool SystemTools::FileHasSignature(const char *filename,
+ const char *signature,
+ long offset)
+{
+ if (!filename || !signature)
+ {
+ return false;
+ }
+
+ FILE *fp;
+ fp = fopen(filename, "rb");
+ if (!fp)
+ {
+ return false;
+ }
+
+ fseek(fp, offset, SEEK_SET);
+
+ bool res = false;
+ size_t signature_len = strlen(signature);
+ char *buffer = new char [signature_len];
+
+ if (fread(buffer, 1, signature_len, fp) == signature_len)
+ {
+ res = (!strncmp(buffer, signature, signature_len) ? true : false);
+ }
+
+ delete [] buffer;
+
+ fclose(fp);
+ return res;
+}
+
+SystemTools::FileTypeEnum
+SystemTools::DetectFileType(const char *filename,
+ unsigned long length,
+ double percent_bin)
+{
+ if (!filename || percent_bin < 0)
+ {
+ return SystemTools::FileTypeUnknown;
+ }
+
+ FILE *fp;
+ fp = fopen(filename, "rb");
+ if (!fp)
+ {
+ return SystemTools::FileTypeUnknown;
+ }
+
+ // Allocate buffer and read bytes
+
+ unsigned char *buffer = new unsigned char [length];
+ size_t read_length = fread(buffer, 1, length, fp);
+ fclose(fp);
+ if (read_length == 0)
+ {
+ return SystemTools::FileTypeUnknown;
+ }
+
+ // Loop over contents and count
+
+ size_t text_count = 0;
+
+ const unsigned char *ptr = buffer;
+ const unsigned char *buffer_end = buffer + read_length;
+
+ while (ptr != buffer_end)
+ {
+ if ((*ptr >= 0x20 && *ptr <= 0x7F) ||
+ *ptr == '\n' ||
+ *ptr == '\r' ||
+ *ptr == '\t')
+ {
+ text_count++;
+ }
+ ptr++;
+ }
+
+ delete [] buffer;
+
+ double current_percent_bin =
+ ((double)(read_length - text_count) / (double)read_length);
+
+ if (current_percent_bin >= percent_bin)
+ {
+ return SystemTools::FileTypeBinary;
+ }
+
+ return SystemTools::FileTypeText;
+}
+
+bool SystemTools::LocateFileInDir(const char *filename,
+ const char *dir,
+ kwsys_stl::string& filename_found,
+ int try_filename_dirs)
+{
+ if (!filename || !dir)
+ {
+ return false;
+ }
+
+ // Get the basename of 'filename'
+
+ kwsys_stl::string filename_base = SystemTools::GetFilenameName(filename);
+
+ // Check if 'dir' is really a directory
+ // If win32 and matches something like C:, accept it as a dir
+
+ kwsys_stl::string real_dir;
+ if (!SystemTools::FileIsDirectory(dir))
+ {
+#if _WIN32
+ size_t dir_len = strlen(dir);
+ if (dir_len < 2 || dir[dir_len - 1] != ':')
+ {
+#endif
+ real_dir = SystemTools::GetFilenamePath(dir);
+ dir = real_dir.c_str();
+#if _WIN32
+ }
+#endif
+ }
+
+ // Try to find the file in 'dir'
+
+ bool res = false;
+ if (filename_base.size() && dir)
+ {
+ size_t dir_len = strlen(dir);
+ int need_slash =
+ (dir_len && dir[dir_len - 1] != '/' && dir[dir_len - 1] != '\\');
+
+ kwsys_stl::string temp = dir;
+ if (need_slash)
+ {
+ temp += "/";
+ }
+ temp += filename_base;
+
+ if (SystemTools::FileExists(filename_found.c_str()))
+ {
+ res = true;
+ filename_found = temp;
+ }
+
+ // If not found, we can try harder by appending part of the file to
+ // to the directory to look inside.
+ // Example: if we were looking for /foo/bar/yo.txt in /d1/d2, then
+ // try to find yo.txt in /d1/d2/bar, then /d1/d2/foo/bar, etc.
+
+ else if (try_filename_dirs)
+ {
+ kwsys_stl::string filename_dir(filename);
+ kwsys_stl::string filename_dir_base;
+ kwsys_stl::string filename_dir_bases;
+ do
+ {
+ filename_dir = SystemTools::GetFilenamePath(filename_dir);
+ filename_dir_base = SystemTools::GetFilenameName(filename_dir);
+#if _WIN32
+ if (!filename_dir_base.size() ||
+ filename_dir_base[filename_dir_base.size() - 1] == ':')
+#else
+ if (!filename_dir_base.size())
+#endif
+ {
+ break;
+ }
+
+ filename_dir_bases = filename_dir_base + "/" + filename_dir_bases;
+
+ temp = dir;
+ if (need_slash)
+ {
+ temp += "/";
+ }
+ temp += filename_dir_bases;
+
+ res = SystemTools::LocateFileInDir(
+ filename_base.c_str(), temp.c_str(), filename_found, 0);
+
+ } while (!res && filename_dir_base.size());
+ }
+ }
+
+ return res;
+}
+
+bool SystemTools::FileIsFullPath(const char* in_name)
+{
+ kwsys_stl::string name = in_name;
+#if defined(_WIN32) || defined(__CYGWIN__)
+ // On Windows, the name must be at least two characters long.
+ if(name.length() < 2)
+ {
+ return false;
+ }
+ if(name[1] == ':')
+ {
+ return true;
+ }
+ if(name[0] == '\\')
+ {
+ return true;
+ }
+#else
+ // On UNIX, the name must be at least one character long.
+ if(name.length() < 1)
+ {
+ return false;
+ }
+#endif
+ // On UNIX, the name must begin in a '/'.
+ // On Windows, if the name begins in a '/', then it is a full
+ // network path.
+ if(name[0] == '/')
+ {
+ return true;
+ }
+ return false;
+}
+
+bool SystemTools::GetShortPath(const char* path, kwsys_stl::string& shortPath)
+{
+#if defined(WIN32) && !defined(__CYGWIN__)
+ const int size = int(strlen(path)) +1; // size of return
+ char *buffer = new char[size]; // create a buffer
+ char *tempPath = new char[size]; // create a buffer
+ int ret;
+
+ // if the path passed in has quotes around it, first remove the quotes
+ if (path[0] == '"' && path[strlen(path)-1] == '"')
+ {
+ strcpy(tempPath,path+1);
+ tempPath[strlen(tempPath)-1] = '\0';
+ }
+ else
+ {
+ strcpy(tempPath,path);
+ }
+
+ buffer[0] = 0;
+ ret = GetShortPathName(tempPath, buffer, size);
+
+ if(buffer[0] == 0 || ret > size)
+ {
+ delete [] buffer;
+ delete [] tempPath;
+ return false;
+ }
+ else
+ {
+ shortPath = buffer;
+ delete [] buffer;
+ delete [] tempPath;
+ return true;
+ }
+#else
+ shortPath = path;
+ return true;
+#endif
+}
+
+void SystemTools::SplitProgramFromArgs(const char* path,
+ kwsys_stl::string& program, kwsys_stl::string& args)
+{
+ // see if this is a full path to a program
+ // if so then set program to path and args to nothing
+ if(SystemTools::FileExists(path))
+ {
+ program = path;
+ args = "";
+ return;
+ }
+ // Try to find the program in the path, note the program
+ // may have spaces in its name so we have to look for it
+ kwsys_stl::vector<kwsys_stl::string> e;
+ kwsys_stl::string findProg = SystemTools::FindProgram(path, e);
+ if(findProg.size())
+ {
+ program = findProg;
+ args = "";
+ return;
+ }
+
+ // Now try and peel off space separated chunks from the end of the string
+ // so the largest path possible is found allowing for spaces in the path
+ kwsys_stl::string dir = path;
+ kwsys_stl::string::size_type spacePos = dir.rfind(' ');
+ while(spacePos != kwsys_stl::string::npos)
+ {
+ kwsys_stl::string tryProg = dir.substr(0, spacePos);
+ // See if the file exists
+ if(SystemTools::FileExists(tryProg.c_str()))
+ {
+ program = tryProg;
+ // remove trailing spaces from program
+ kwsys_stl::string::size_type pos = program.size()-1;
+ while(program[pos] == ' ')
+ {
+ program.erase(pos);
+ pos--;
+ }
+ args = dir.substr(spacePos, dir.size()-spacePos);
+ return;
+ }
+ // Now try and find the the program in the path
+ findProg = SystemTools::FindProgram(tryProg.c_str(), e);
+ if(findProg.size())
+ {
+ program = findProg;
+ // remove trailing spaces from program
+ kwsys_stl::string::size_type pos = program.size()-1;
+ while(program[pos] == ' ')
+ {
+ program.erase(pos);
+ pos--;
+ }
+ args = dir.substr(spacePos, dir.size()-spacePos);
+ return;
+ }
+ // move past the space for the next search
+ spacePos--;
+ spacePos = dir.rfind(' ', spacePos);
+ }
+
+ program = "";
+ args = "";
+}
+
+kwsys_stl::string SystemTools::GetCurrentDateTime(const char* format)
+{
+ char buf[1024];
+ time_t t;
+ time(&t);
+ strftime(buf, sizeof(buf), format, localtime(&t));
+ return buf;
+}
+
+kwsys_stl::string SystemTools::MakeCindentifier(const char* s)
+{
+ kwsys_stl::string str(s);
+ if (str.find_first_of("0123456789") == 0)
+ {
+ str = "_" + str;
+ }
+
+ kwsys_stl::string permited_chars("_"
+ "abcdefghijklmnopqrstuvwxyz"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "0123456789");
+ kwsys_stl::string::size_type pos = 0;
+ while ((pos = str.find_first_not_of(permited_chars, pos)) != kwsys_stl::string::npos)
+ {
+ str[pos] = '_';
+ }
+ return str;
+}
+
+// Due to a buggy stream library on the HP and another on Mac OSX, we
+// need this very carefully written version of getline. Returns true
+// if any data were read before the end-of-file was reached.
+bool SystemTools::GetLineFromStream(kwsys_ios::istream& is, kwsys_stl::string& line,
+ bool *has_newline /* = 0 */)
+{
+ const int bufferSize = 1024;
+ char buffer[bufferSize];
+ line = "";
+ bool haveData = false;
+ if ( has_newline )
+ {
+ *has_newline = false;
+ }
+
+ // If no characters are read from the stream, the end of file has
+ // been reached.
+ while((is.getline(buffer, bufferSize), is.gcount() > 0))
+ {
+ haveData = true;
+ line.append(buffer);
+
+ // If newline character was read, the gcount includes the
+ // character, but the buffer does not. The end of line has been
+ // reached.
+ if(strlen(buffer) < static_cast<size_t>(is.gcount()))
+ {
+ if ( has_newline )
+ {
+ *has_newline = true;
+ }
+ break;
+ }
+
+ // The fail bit may be set. Clear it.
+ is.clear(is.rdstate() & ~kwsys_ios::ios::failbit);
+ }
+ return haveData;
+}
+
+int SystemTools::GetTerminalWidth()
+{
+ int width = -1;
+#ifndef _WIN32
+ struct winsize ws;
+ char *columns; /* Unix98 environment variable */
+ if(ioctl(1, TIOCGWINSZ, &ws) != -1 && ws.ws_col>0 && ws.ws_row>0)
+ {
+ width = ws.ws_col;
+ }
+ if(!isatty(STDOUT_FILENO))
+ {
+ width = -1;
+ }
+ columns = getenv("COLUMNS");
+ if(columns && *columns)
+ {
+ long t;
+ char *endptr;
+ t = strtol(columns, &endptr, 0);
+ if(endptr && !*endptr && (t>0) && (t<1000))
+ {
+ width = (int)t;
+ }
+ }
+ if ( width < 9 )
+ {
+ width = -1;
+ }
+#endif
+ return width;
+}
+
+bool SystemTools::GetPermissions(const char* file, mode_t& mode)
+{
+ if ( !file )
+ {
+ return false;
+ }
+
+ struct stat st;
+ if ( stat(file, &st) < 0 )
+ {
+ return false;
+ }
+ mode = st.st_mode;
+ return true;
+}
+
+bool SystemTools::SetPermissions(const char* file, mode_t mode)
+{
+ if ( !file )
+ {
+ return false;
+ }
+ if ( !SystemTools::FileExists(file) )
+ {
+ return false;
+ }
+ if ( chmod(file, mode) < 0 )
+ {
+ return false;
+ }
+
+ return true;
+}
+
+kwsys_stl::string SystemTools::GetParentDirectory(const char* fileOrDir)
+{
+ if ( !fileOrDir || !*fileOrDir )
+ {
+ return "";
+ }
+ kwsys_stl::string res = fileOrDir;
+ SystemTools::ConvertToUnixSlashes(res);
+ kwsys_stl::string::size_type cc = res.size()-1;
+ if ( res[cc] == '/' )
+ {
+ cc --;
+ }
+ for ( ; cc > 0; cc -- )
+ {
+ if ( res[cc] == '/' )
+ {
+ break;
+ }
+ }
+ return res.substr(0, cc);
+}
+
+bool SystemTools::IsSubDirectory(const char* cSubdir, const char* cDir)
+{
+ kwsys_stl::string subdir = cSubdir;
+ kwsys_stl::string dir = cDir;
+ SystemTools::ConvertToUnixSlashes(dir);
+ kwsys_stl::string path = subdir;
+ do
+ {
+ path = SystemTools::GetParentDirectory(path.c_str());
+ if ( dir == path )
+ {
+ return true;
+ }
+ }
+ while ( path.size() > dir.size() );
+ return false;
+}
+
+kwsys_stl::string SystemTools::FileExistsInParentDirectories(const char* fname,
+ const char* directory, const char* toplevel)
+{
+ kwsys_stl::string file = fname;
+ SystemTools::ConvertToUnixSlashes(file);
+ kwsys_stl::string dir = directory;
+ SystemTools::ConvertToUnixSlashes(dir);
+ while ( !dir.empty() )
+ {
+ kwsys_stl::string path = dir + "/" + file;
+ if ( SystemTools::FileExists(path.c_str()) )
+ {
+ return path;
+ }
+ if ( dir.size() < strlen(toplevel) )
+ {
+ break;
+ }
+ dir = SystemTools::GetParentDirectory(dir.c_str());
+ }
+ return "";
+}
+
+void SystemTools::Delay(unsigned int msec)
+{
+#ifdef _WIN32
+ Sleep(msec);
+#else
+ usleep(msec * 1000);
+#endif
+}
+
+void SystemTools::ConvertWindowsCommandLineToUnixArguments(
+ const char *cmd_line, int *argc, char ***argv)
+{
+ if (!cmd_line || !argc || !argv)
+ {
+ return;
+ }
+
+ // A space delimites an argument except when it is inside a quote
+
+ (*argc) = 1;
+
+ size_t cmd_line_len = strlen(cmd_line);
+
+ size_t i;
+ for (i = 0; i < cmd_line_len; i++)
+ {
+ while (isspace(cmd_line[i]) && i < cmd_line_len)
+ {
+ i++;
+ }
+ if (i < cmd_line_len)
+ {
+ if (cmd_line[i] == '\"')
+ {
+ i++;
+ while (cmd_line[i] != '\"' && i < cmd_line_len)
+ {
+ i++;
+ }
+ (*argc)++;
+ }
+ else
+ {
+ while (!isspace(cmd_line[i]) && i < cmd_line_len)
+ {
+ i++;
+ }
+ (*argc)++;
+ }
+ }
+ }
+
+ (*argv) = new char* [(*argc) + 1];
+ (*argv)[(*argc)] = NULL;
+
+ // Set the first arg to be the exec name
+
+ (*argv)[0] = new char [1024];
+#ifdef _WIN32
+ ::GetModuleFileName(0, (*argv)[0], 1024);
+#else
+ (*argv)[0][0] = '\0';
+#endif
+
+ // Allocate the others
+
+ int j;
+ for (j = 1; j < (*argc); j++)
+ {
+ (*argv)[j] = new char [cmd_line_len + 10];
+ }
+
+ // Grab the args
+
+ size_t pos;
+ int argc_idx = 1;
+
+ for (i = 0; i < cmd_line_len; i++)
+ {
+ while (isspace(cmd_line[i]) && i < cmd_line_len)
+ {
+ i++;
+ }
+ if (i < cmd_line_len)
+ {
+ if (cmd_line[i] == '\"')
+ {
+ i++;
+ pos = i;
+ while (cmd_line[i] != '\"' && i < cmd_line_len)
+ {
+ i++;
+ }
+ memcpy((*argv)[argc_idx], &cmd_line[pos], i - pos);
+ (*argv)[argc_idx][i - pos] = '\0';
+ argc_idx++;
+ }
+ else
+ {
+ pos = i;
+ while (!isspace(cmd_line[i]) && i < cmd_line_len)
+ {
+ i++;
+ }
+ memcpy((*argv)[argc_idx], &cmd_line[pos], i - pos);
+ (*argv)[argc_idx][i - pos] = '\0';
+ argc_idx++;
+ }
+ }
+ }
+ }
+
+kwsys_stl::string SystemTools::GetOperatingSystemNameAndVersion()
+{
+ kwsys_stl::string res;
+
+#ifdef _WIN32
+ char buffer[256];
+
+ OSVERSIONINFOEX osvi;
+ BOOL bOsVersionInfoEx;
+
+ // Try calling GetVersionEx using the OSVERSIONINFOEX structure.
+ // If that fails, try using the OSVERSIONINFO structure.
+
+ ZeroMemory(&osvi, sizeof(OSVERSIONINFOEX));
+ osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX);
+
+ bOsVersionInfoEx = GetVersionEx((OSVERSIONINFO *)&osvi);
+ if (!bOsVersionInfoEx)
+ {
+ osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ if (!GetVersionEx((OSVERSIONINFO *)&osvi))
+ {
+ return 0;
+ }
+ }
+
+ switch (osvi.dwPlatformId)
+ {
+ // Test for the Windows NT product family.
+
+ case VER_PLATFORM_WIN32_NT:
+
+ // Test for the specific product family.
+
+ if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2)
+ {
+ res += "Microsoft Windows Server 2003 family";
+ }
+
+ if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1)
+ {
+ res += "Microsoft Windows XP";
+ }
+
+ if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0)
+ {
+ res += "Microsoft Windows 2000";
+ }
+
+ if (osvi.dwMajorVersion <= 4)
+ {
+ res += "Microsoft Windows NT";
+ }
+
+ // Test for specific product on Windows NT 4.0 SP6 and later.
+
+ if (bOsVersionInfoEx)
+ {
+ // Test for the workstation type.
+
+#if (_MSC_VER >= 1300)
+ if (osvi.wProductType == VER_NT_WORKSTATION)
+ {
+ if (osvi.dwMajorVersion == 4)
+ {
+ res += " Workstation 4.0";
+ }
+ else if (osvi.wSuiteMask & VER_SUITE_PERSONAL)
+ {
+ res += " Home Edition";
+ }
+ else
+ {
+ res += " Professional";
+ }
+ }
+
+ // Test for the server type.
+
+ else if (osvi.wProductType == VER_NT_SERVER)
+ {
+ if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2)
+ {
+ if (osvi.wSuiteMask & VER_SUITE_DATACENTER)
+ {
+ res += " Datacenter Edition";
+ }
+ else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE)
+ {
+ res += " Enterprise Edition";
+ }
+ else if (osvi.wSuiteMask == VER_SUITE_BLADE)
+ {
+ res += " Web Edition";
+ }
+ else
+ {
+ res += " Standard Edition";
+ }
+ }
+
+ else if (osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0)
+ {
+ if (osvi.wSuiteMask & VER_SUITE_DATACENTER)
+ {
+ res += " Datacenter Server";
+ }
+ else if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE)
+ {
+ res += " Advanced Server";
+ }
+ else
+ {
+ res += " Server";
+ }
+ }
+
+ else // Windows NT 4.0
+ {
+ if (osvi.wSuiteMask & VER_SUITE_ENTERPRISE)
+ {
+ res += " Server 4.0, Enterprise Edition";
+ }
+ else
+ {
+ res += " Server 4.0";
+ }
+ }
+ }
+#endif // Visual Studio 7 and up
+ }
+
+ // Test for specific product on Windows NT 4.0 SP5 and earlier
+
+ else
+ {
+ HKEY hKey;
+ #define BUFSIZE 80
+ char szProductType[BUFSIZE];
+ DWORD dwBufLen=BUFSIZE;
+ LONG lRet;
+
+ lRet = RegOpenKeyEx(
+ HKEY_LOCAL_MACHINE,
+ "SYSTEM\\CurrentControlSet\\Control\\ProductOptions",
+ 0, KEY_QUERY_VALUE, &hKey);
+ if (lRet != ERROR_SUCCESS)
+ {
+ return 0;
+ }
+
+ lRet = RegQueryValueEx(hKey, "ProductType", NULL, NULL,
+ (LPBYTE) szProductType, &dwBufLen);
+
+ if ((lRet != ERROR_SUCCESS) || (dwBufLen > BUFSIZE))
+ {
+ return 0;
+ }
+
+ RegCloseKey(hKey);
+
+ if (lstrcmpi("WINNT", szProductType) == 0)
+ {
+ res += " Workstation";
+ }
+ if (lstrcmpi("LANMANNT", szProductType) == 0)
+ {
+ res += " Server";
+ }
+ if (lstrcmpi("SERVERNT", szProductType) == 0)
+ {
+ res += " Advanced Server";
+ }
+
+ res += " ";
+ sprintf(buffer, "%d", osvi.dwMajorVersion);
+ res += buffer;
+ res += ".";
+ sprintf(buffer, "%d", osvi.dwMinorVersion);
+ res += buffer;
+ }
+
+ // Display service pack (if any) and build number.
+
+ if (osvi.dwMajorVersion == 4 &&
+ lstrcmpi(osvi.szCSDVersion, "Service Pack 6") == 0)
+ {
+ HKEY hKey;
+ LONG lRet;
+
+ // Test for SP6 versus SP6a.
+
+ lRet = RegOpenKeyEx(
+ HKEY_LOCAL_MACHINE,
+ "SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Hotfix\\Q246009",
+ 0, KEY_QUERY_VALUE, &hKey);
+
+ if (lRet == ERROR_SUCCESS)
+ {
+ res += " Service Pack 6a (Build ";
+ sprintf(buffer, "%d", osvi.dwBuildNumber & 0xFFFF);
+ res += buffer;
+ res += ")";
+ }
+ else // Windows NT 4.0 prior to SP6a
+ {
+ res += " ";
+ res += osvi.szCSDVersion;
+ res += " (Build ";
+ sprintf(buffer, "%d", osvi.dwBuildNumber & 0xFFFF);
+ res += buffer;
+ res += ")";
+ }
+
+ RegCloseKey(hKey);
+ }
+ else // Windows NT 3.51 and earlier or Windows 2000 and later
+ {
+ res += " ";
+ res += osvi.szCSDVersion;
+ res += " (Build ";
+ sprintf(buffer, "%d", osvi.dwBuildNumber & 0xFFFF);
+ res += buffer;
+ res += ")";
+ }
+
+ break;
+
+ // Test for the Windows 95 product family.
+
+ case VER_PLATFORM_WIN32_WINDOWS:
+
+ if (osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 0)
+ {
+ res += "Microsoft Windows 95";
+ if (osvi.szCSDVersion[1] == 'C' || osvi.szCSDVersion[1] == 'B')
+ {
+ res += " OSR2";
+ }
+ }
+
+ if (osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 10)
+ {
+ res += "Microsoft Windows 98";
+ if (osvi.szCSDVersion[1] == 'A')
+ {
+ res += " SE";
+ }
+ }
+
+ if (osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 90)
+ {
+ res += "Microsoft Windows Millennium Edition";
+ }
+ break;
+
+ case VER_PLATFORM_WIN32s:
+
+ res += "Microsoft Win32s";
+ break;
+ }
+#endif
+
+ return res;
+}
+
+// These must NOT be initialized. Default initialization to zero is
+// necessary.
+unsigned int SystemToolsManagerCount;
+SystemToolsTranslationMap *SystemTools::TranslationMap;
+
+// SystemToolsManager manages the SystemTools singleton.
+// SystemToolsManager should be included in any translation unit
+// that will use SystemTools or that implements the singleton
+// pattern. It makes sure that the SystemTools singleton is created
+// before and destroyed after all other singletons in CMake.
+
+SystemToolsManager::SystemToolsManager()
+{
+ if(++SystemToolsManagerCount == 1)
+ {
+ SystemTools::ClassInitialize();
+ }
+}
+
+SystemToolsManager::~SystemToolsManager()
+{
+ if(--SystemToolsManagerCount == 0)
+ {
+ SystemTools::ClassFinalize();
+ }
+}
+
+void SystemTools::ClassInitialize()
+{
+ // Allocate the translation map first.
+ SystemTools::TranslationMap = new SystemToolsTranslationMap;
+
+ // Add some special translation paths for unix. These are not added
+ // for windows because drive letters need to be maintained. Also,
+ // there are not sym-links and mount points on windows anyway.
+#if !defined(_WIN32) || defined(__CYGWIN__)
+ // Work-around an SGI problem by always adding this mapping:
+ SystemTools::AddTranslationPath("/tmp_mnt/", "/");
+ // The tmp path is frequently a logical path so always keep it:
+ SystemTools::AddKeepPath("/tmp/");
+
+ // If the current working directory is a logical path then keep the
+ // logical name.
+ if(const char* pwd = getenv("PWD"))
+ {
+ char buf[2048];
+ if(const char* cwd = Getcwd(buf, 2048))
+ {
+ // The current working directory may be a logical path. Find
+ // the shortest logical path that still produces the correct
+ // physical path.
+ kwsys_stl::string cwd_changed;
+ kwsys_stl::string pwd_changed;
+
+ // Test progressively shorter logical-to-physical mappings.
+ kwsys_stl::string pwd_str = pwd;
+ kwsys_stl::string cwd_str = cwd;
+ kwsys_stl::string pwd_path;
+ Realpath(pwd, pwd_path);
+ while(cwd_str == pwd_path && cwd_str != pwd_str)
+ {
+ // The current pair of paths is a working logical mapping.
+ cwd_changed = cwd_str;
+ pwd_changed = pwd_str;
+
+ // Strip off one directory level and see if the logical
+ // mapping still works.
+ pwd_str = SystemTools::GetFilenamePath(pwd_str.c_str());
+ cwd_str = SystemTools::GetFilenamePath(cwd_str.c_str());
+ Realpath(pwd_str.c_str(), pwd_path);
+ }
+
+ // Add the translation to keep the logical path name.
+ if(!cwd_changed.empty() && !pwd_changed.empty())
+ {
+ SystemTools::AddTranslationPath(cwd_changed.c_str(),
+ pwd_changed.c_str());
+ }
+ }
+ }
+#endif
+}
+
+void SystemTools::ClassFinalize()
+{
+ delete SystemTools::TranslationMap;
+}
+
+
+} // namespace KWSYS_NAMESPACE
+
+#if defined(_MSC_VER) && defined(_DEBUG)
+# include <crtdbg.h>
+# include <stdio.h>
+# include <stdlib.h>
+namespace KWSYS_NAMESPACE
+{
+
+static int SystemToolsDebugReport(int, char* message, int*)
+{
+ fprintf(stderr, message);
+ exit(1);
+}
+void SystemTools::EnableMSVCDebugHook()
+{
+ if(getenv("DART_TEST_FROM_DART"))
+ {
+ _CrtSetReportHook(SystemToolsDebugReport);
+ }
+}
+
+} // namespace KWSYS_NAMESPACE
+#else
+namespace KWSYS_NAMESPACE
+{
+void SystemTools::EnableMSVCDebugHook() {}
+} // namespace KWSYS_NAMESPACE
+#endif
+
+
diff --git a/Utilities/ITK/Utilities/kwsys/SystemTools.hxx.in b/Utilities/ITK/Utilities/kwsys/SystemTools.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..66e39446fcce5a525414dc2484e260b7ede4c4ef
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/SystemTools.hxx.in
@@ -0,0 +1,781 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: SystemTools.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_SystemTools_hxx
+#define @KWSYS_NAMESPACE@_SystemTools_hxx
+
+#include <@KWSYS_NAMESPACE@/ios/iosfwd>
+#include <@KWSYS_NAMESPACE@/stl/string>
+#include <@KWSYS_NAMESPACE@/stl/vector>
+#include <@KWSYS_NAMESPACE@/stl/map>
+
+#include <@KWSYS_NAMESPACE@/Configure.h>
+#include <@KWSYS_NAMESPACE@/String.hxx>
+
+#include <sys/types.h>
+
+// Required for va_list
+#include <stdarg.h>
+#if @KWSYS_NAMESPACE@_STL_HAVE_STD && !defined(va_list)
+// Some compilers move va_list into the std:: namespace and there is no way to
+// tell that this has been done. Playing with things being included before or
+// after stdarg.h does not solve things because we do not have control over
+// what the user does. This hack solves this problem by moving va_list to our
+// own namespace that is local for kwsys.
+namespace std {} // Required for platforms that do not have std::
+namespace @KWSYS_NAMESPACE@_VA_LIST
+{
+ using namespace std;
+ typedef va_list hack_va_list;
+}
+namespace @KWSYS_NAMESPACE@
+{
+ typedef @KWSYS_NAMESPACE@_VA_LIST::hack_va_list va_list;
+}
+#endif // va_list
+
+#if defined( _MSC_VER )
+typedef unsigned short mode_t;
+#endif
+
+/* Define these macros temporarily to keep the code readable. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+# define kwsys_ios @KWSYS_NAMESPACE@_ios
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+class SystemToolsTranslationMap;
+/** \class SystemToolsManager
+ * \brief Use to make sure SystemTools is initialized before it is used
+ * and is the last static object destroyed
+ */
+class @KWSYS_NAMESPACE@_EXPORT SystemToolsManager
+{
+public:
+ SystemToolsManager();
+ ~SystemToolsManager();
+};
+
+// This instance will show up in any translation unit that uses
+// SystemTools. It will make sure SystemTools is initialized
+// before it is used and is the last static object destroyed.
+static SystemToolsManager SystemToolsManagerInstance;
+
+/** \class SystemTools
+ * \brief A collection of useful platform-independent system functions.
+ */
+class @KWSYS_NAMESPACE@_EXPORT SystemTools
+{
+public:
+
+ /** -----------------------------------------------------------------
+ * String Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Replace symbols in str that are not valid in C identifiers as
+ * defined by the 1999 standard, ie. anything except [A-Za-z0-9_].
+ * They are replaced with `_' and if the first character is a digit
+ * then an underscore is prepended. Note that this can produce
+ * identifiers that the standard reserves (_[A-Z].* and __.*).
+ */
+ static kwsys_stl::string MakeCindentifier(const char* s);
+
+ /**
+ * Replace replace all occurences of the string in the source string.
+ */
+ static void ReplaceString(kwsys_stl::string& source,
+ const char* replace,
+ const char* with);
+
+ /**
+ * Return a capitalized string (i.e the first letter is uppercased,
+ * all other are lowercased).
+ */
+ static kwsys_stl::string Capitalized(const kwsys_stl::string&);
+
+ /**
+ * Return a 'capitalized words' string (i.e the first letter of each word
+ * is uppercased all other are left untouched though).
+ */
+ static kwsys_stl::string CapitalizedWords(const kwsys_stl::string&);
+
+ /**
+ * Return a 'uncapitalized words' string (i.e the first letter of each word
+ * is lowercased all other are left untouched though).
+ */
+ static kwsys_stl::string UnCapitalizedWords(const kwsys_stl::string&);
+
+ /**
+ * Return a lower case string
+ */
+ static kwsys_stl::string LowerCase(const kwsys_stl::string&);
+
+ /**
+ * Return a lower case string
+ */
+ static kwsys_stl::string UpperCase(const kwsys_stl::string&);
+
+ /**
+ * Count char in string
+ */
+ static size_t CountChar(const char* str, char c);
+
+ /**
+ * Remove some characters from a string.
+ * Return a pointer to the new resulting string (allocated with 'new')
+ */
+ static char* RemoveChars(const char* str, const char *toremove);
+
+ /**
+ * Remove remove all but 0->9, A->F characters from a string.
+ * Return a pointer to the new resulting string (allocated with 'new')
+ */
+ static char* RemoveCharsButUpperHex(const char* str);
+
+ /**
+ * Replace some characters by another character in a string (in-place)
+ * Return a pointer to string
+ */
+ static char* ReplaceChars(char* str, const char *toreplace,char replacement);
+
+ /**
+ * Returns true if str1 starts (respectively ends) with str2
+ */
+ static bool StringStartsWith(const char* str1, const char* str2);
+ static bool StringEndsWith(const char* str1, const char* str2);
+
+ /**
+ * Returns a pointer to the last occurence of str2 in str1
+ */
+ static const char* FindLastString(const char* str1, const char* str2);
+
+ /**
+ * Make a duplicate of the string similar to the strdup C function
+ * but use new to create the 'new' string, so one can use
+ * 'delete' to remove it. Returns 0 if the input is empty.
+ */
+ static char* DuplicateString(const char* str);
+
+ /**
+ * Return the string cropped to a given length by removing chars in the
+ * center of the string and replacing them with an ellipsis (...)
+ */
+ static kwsys_stl::string CropString(const kwsys_stl::string&,size_t max_len);
+
+ /** split a path by separator into an array of strings, default is /.
+ If isPath is true then the string is treated like a path and if
+ s starts with a / then the first element of the returned array will
+ be /, so /foo/bar will be [/, foo, bar]
+ */
+ static kwsys_stl::vector<String> SplitString(const char* s, char separator = '/',
+ bool isPath = false);
+ /**
+ * Perform a case-independent string comparison
+ */
+ static int Strucmp(const char *s1, const char *s2);
+
+ /**
+ * Convert a string in __DATE__ or __TIMESTAMP__ format into a time_t.
+ * Return false on error, true on success
+ */
+ static bool ConvertDateMacroString(const char *str, time_t *tmt);
+ static bool ConvertTimeStampMacroString(const char *str, time_t *tmt);
+
+ /**
+ * Split a string on its newlines into multiple lines
+ * Return false only if the last line stored had no newline
+ */
+ static bool Split(const char* s, kwsys_stl::vector<kwsys_stl::string>& l);
+ static bool Split(const char* s, kwsys_stl::vector<kwsys_stl::string>& l, char separator);
+
+ /**
+ * Return string with space added between capitalized words
+ * (i.e. EatMyShorts becomes Eat My Shorts )
+ */
+ static kwsys_stl::string AddSpaceBetweenCapitalizedWords(
+ const kwsys_stl::string&);
+
+ /**
+ * Append two or more strings and produce new one.
+ * Programmer must 'delete []' the resulting string, which was allocated
+ * with 'new'.
+ * Return 0 if inputs are empty or there was an error
+ */
+ static char* AppendStrings(
+ const char* str1, const char* str2);
+ static char* AppendStrings(
+ const char* str1, const char* str2, const char* str3);
+
+ /**
+ * Estimate the length of the string that will be produced
+ * from printing the given format string and arguments. The
+ * returned length will always be at least as large as the string
+ * that will result from printing.
+ * WARNING: since va_arg is called to iterate of the argument list,
+ * you will not be able to use this 'ap' anymore from the beginning.
+ * It's up to you to call va_end though.
+ */
+ static int EstimateFormatLength(const char *format, va_list ap);
+
+ /**
+ * Escape specific characters in 'str'.
+ */
+ static kwsys_stl::string EscapeChars(
+ const char *str, const char *chars_to_escape, char escape_char = '\\');
+
+ /** -----------------------------------------------------------------
+ * Filename Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Replace Windows file system slashes with Unix-style slashes.
+ */
+ static void ConvertToUnixSlashes(kwsys_stl::string& path);
+
+ /**
+ * For windows this calls ConvertToWindowsOutputPath and for unix
+ * it calls ConvertToUnixOutputPath
+ */
+ static kwsys_stl::string ConvertToOutputPath(const char*);
+
+ /**
+ * Return true if a file exists in the current directory
+ */
+ static bool FileExists(const char* filename);
+
+ /**
+ * Return file length
+ */
+ static unsigned long FileLength(const char *filename);
+
+ /**
+ * Compare file modification times.
+ * Return true for successful comparison and false for error.
+ * When true is returned, result has -1, 0, +1 for
+ * f1 older, same, or newer than f2.
+ */
+ static bool FileTimeCompare(const char* f1, const char* f2,
+ int* result);
+
+ /**
+ * Get the file extension (including ".") needed for an executable
+ * on the current platform ("" for unix, ".exe" for Windows).
+ */
+ static const char* GetExecutableExtension();
+
+ /**
+ * Given a path that exists on a windows machine, return the
+ * actuall case of the path as it was created. If the file
+ * does not exist path is returned unchanged. This does nothing
+ * on unix but return path.
+ */
+ static kwsys_stl::string GetActualCaseForPath(const char* path);
+
+ /**
+ * Given the path to a program executable, get the directory part of
+ * the path with the file stripped off. If there is no directory
+ * part, the empty string is returned.
+ */
+ static kwsys_stl::string GetProgramPath(const char*);
+ static bool SplitProgramPath(const char* in_name,
+ kwsys_stl::string& dir,
+ kwsys_stl::string& file,
+ bool errorReport = true);
+
+ /**
+ * Given argv[0] for a unix program find the full path to a running
+ * executable. argv0 can be null for windows WinMain programs
+ * in this case GetModuleFileName will be used to find the path
+ * to the running executable. If argv0 is not a full path,
+ * then this will try to find the full path. If the path is not
+ * found false is returned, if found true is returned. An error
+ * message of the attempted paths is stored in errorMsg.
+ * exeName is the name of the executable.
+ * buildDir is a possibly null path to the build directory.
+ * installPrefix is a possibly null pointer to the install directory.
+ */
+ static bool FindProgramPath(const char* argv0,
+ kwsys_stl::string& pathOut,
+ kwsys_stl::string& errorMsg,
+ const char* exeName = 0,
+ const char* buildDir = 0,
+ const char* installPrefix = 0);
+
+ /**
+ * Given a path to a file or directory, convert it to a full path.
+ * This collapses away relative paths relative to the cwd argument
+ * (which defaults to the current working directory). The full path
+ * is returned.
+ */
+ static kwsys_stl::string CollapseFullPath(const char* in_relative);
+ static kwsys_stl::string CollapseFullPath(const char* in_relative,
+ const char* in_base);
+
+ /**
+ * Split a path name into its basic components. The first component
+ * is one of the following roots:
+ * "/" = UNIX
+ * "c:/" = Windows full path (can be any drive letter)
+ * "c:" = Windows drive-letter relative path (can be any drive letter)
+ * "//" = Network path
+ * "" = Relative path
+ * The remaining components form the path. If there is a trailing
+ * slash then the last component is the empty string. The
+ * components can be recombined as "c[0]c[1]/c[2]/.../c[n]" to
+ * produce the original path.
+ */
+ static void SplitPath(const char* p,
+ kwsys_stl::vector<kwsys_stl::string>& components);
+
+ /**
+ * Join components of a path name into a single string. See
+ * SplitPath for the format of the components.
+ */
+ static kwsys_stl::string JoinPath(
+ const kwsys_stl::vector<kwsys_stl::string>& components);
+
+ /**
+ * Compare a path or components of a path.
+ */
+ static bool ComparePath(const char* c1, const char* c2);
+
+
+ /**
+ * Return path of a full filename (no trailing slashes)
+ */
+ static kwsys_stl::string GetFilenamePath(const kwsys_stl::string&);
+
+ /**
+ * Return file name of a full filename (i.e. file name without path)
+ */
+ static kwsys_stl::string GetFilenameName(const kwsys_stl::string&);
+
+ /**
+ * Split a program from its arguments and handle spaces in the paths
+ */
+ static void SplitProgramFromArgs(
+ const char* path,
+ kwsys_stl::string& program, kwsys_stl::string& args);
+
+ /**
+ * Return longest file extension of a full filename (dot included)
+ */
+ static kwsys_stl::string GetFilenameExtension(const kwsys_stl::string&);
+
+ /**
+ * Return shortest file extension of a full filename (dot included)
+ */
+ static kwsys_stl::string GetFilenameLastExtension(
+ const kwsys_stl::string& filename);
+
+ /**
+ * Return file name without extension of a full filename
+ */
+ static kwsys_stl::string GetFilenameWithoutExtension(
+ const kwsys_stl::string&);
+
+ /**
+ * Return file name without its last (shortest) extension
+ */
+ static kwsys_stl::string GetFilenameWithoutLastExtension(
+ const kwsys_stl::string&);
+
+ /**
+ * Return whether the path represents a full path (not relative)
+ */
+ static bool FileIsFullPath(const char*);
+
+ /**
+ * For windows return the short path for the given path,
+ * Unix just a pass through
+ */
+ static bool GetShortPath(const char* path, kwsys_stl::string& result);
+
+ /**
+ * Read line from file. Make sure to get everything. Due to a buggy stream
+ * library on the HP and another on Mac OSX, we need this very carefully
+ * written version of getline. Returns true if any data were read before the
+ * end-of-file was reached. If the has_newline argument is specified, it will
+ * be true when the line read had a newline character.
+ */
+ static bool GetLineFromStream(kwsys_ios::istream& istr,
+ kwsys_stl::string& line,
+ bool* has_newline=0);
+
+ /**
+ * Get the parent directory of the directory or file
+ */
+ static kwsys_stl::string GetParentDirectory(const char* fileOrDir);
+
+ /**
+ * Check if the given file or directory is in subdirectory of dir
+ */
+ static bool IsSubDirectory(const char* fileOrDir, const char* dir);
+
+ /**
+ * Convert the path to a string that can be used in a unix makefile.
+ * double slashes are removed, and spaces are escaped.
+ */
+ static kwsys_stl::string ConvertToUnixOutputPath(const char*);
+
+ /** -----------------------------------------------------------------
+ * File Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Make a new directory if it is not there. This function
+ * can make a full path even if none of the directories existed
+ * prior to calling this function.
+ */
+ static bool MakeDirectory(const char* path);
+
+ /**
+ * Copy the source file to the destination file only
+ * if the two files differ.
+ */
+ static bool CopyFileIfDifferent(const char* source,
+ const char* destination);
+
+ /**
+ * Compare the contents of two files. Return true if different
+ */
+ static bool FilesDiffer(const char* source, const char* destination);
+
+ /**
+ * Return true if the two files are the same file
+ */
+ static bool SameFile(const char* file1, const char* file2);
+
+ /**
+ * Copy a file
+ */
+ static bool CopyFileAlways(const char* source, const char* destination);
+
+ /**
+ * Copy content directory to another directory with all files and
+ * subdirectories
+ */
+ static bool CopyADirectory(const char* source, const char* destination);
+
+ /**
+ * Remove a file
+ */
+ static bool RemoveFile(const char* source);
+
+ /**
+ * Remove a directory
+ */
+ static bool RemoveADirectory(const char* source);
+
+ /**
+ * Get the maximum full file path length
+ */
+ static size_t GetMaximumFilePathLength();
+
+ /**
+ * Find a file in the system PATH, with optional extra paths
+ */
+ static kwsys_stl::string FindFile(
+ const char* name,
+ const kwsys_stl::vector<kwsys_stl::string>& path =
+ kwsys_stl::vector<kwsys_stl::string>());
+
+ /**
+ * Find an executable in the system PATH, with optional extra paths
+ */
+ static kwsys_stl::string FindProgram(
+ const char* name,
+ const kwsys_stl::vector<kwsys_stl::string>& path =
+ kwsys_stl::vector<kwsys_stl::string>(),
+ bool no_system_path = false);
+ static kwsys_stl::string FindProgram(
+ const kwsys_stl::vector<kwsys_stl::string>& names,
+ const kwsys_stl::vector<kwsys_stl::string>& path =
+ kwsys_stl::vector<kwsys_stl::string>(),
+ bool no_system_path = false);
+
+ /**
+ * Find a library in the system PATH, with optional extra paths
+ */
+ static kwsys_stl::string FindLibrary(
+ const char* name,
+ const kwsys_stl::vector<kwsys_stl::string>& path);
+
+ /**
+ * Return true if the file is a directory
+ */
+ static bool FileIsDirectory(const char* name);
+
+ /**
+ * Return true if the file is a symlink
+ */
+ static bool FileIsSymlink(const char* name);
+
+ /**
+ * Return true if the file has a given signature (first set of bytes)
+ */
+ static bool FileHasSignature(
+ const char* filename, const char *signature, long offset = 0);
+
+ /**
+ * Attempt to detect and return the type of a file.
+ * Up to 'length' bytes are read from the file, if more than 'percent_bin' %
+ * of the bytes are non-textual elements, the file is considered binary,
+ * otherwise textual. Textual elements are bytes in the ASCII [0x20, 0x7E]
+ * range, but also \n, \r, \t.
+ * The algorithm is simplistic, and should probably check for usual file
+ * extensions, 'magic' signature, unicode, etc.
+ */
+ enum FileTypeEnum
+ {
+ FileTypeUnknown,
+ FileTypeBinary,
+ FileTypeText
+ };
+ static SystemTools::FileTypeEnum DetectFileType(
+ const char* filename,
+ unsigned long length = 256,
+ double percent_bin = 0.05);
+
+ /**
+ * Try to locate the file 'filename' in the directory 'dir'.
+ * If 'filename' is a fully qualified filename, the basename of the file is
+ * used to check for its existence in 'dir'.
+ * If 'dir' is not a directory, GetFilenamePath() is called on 'dir' to
+ * get its directory first (thus, you can pass a filename as 'dir', as
+ * a convenience).
+ * 'filename_found' is assigned the fully qualified name/path of the file
+ * if it is found (not touched otherwise).
+ * If 'try_filename_dirs' is true, try to find the file using the
+ * components of its path, i.e. if we are looking for c:/foo/bar/bill.txt,
+ * first look for bill.txt in 'dir', then in 'dir'/bar, then in 'dir'/foo/bar
+ * etc.
+ * Return true if the file was found, false otherwise.
+ */
+ static bool LocateFileInDir(const char *filename,
+ const char *dir,
+ kwsys_stl::string& filename_found,
+ int try_filename_dirs = 0);
+
+ /**
+ * Check if the given file exists in one of the parent directory of the
+ * given file or directory and if it does, return the name of the file.
+ * Toplevel specifies the top-most directory to where it will look.
+ */
+ static kwsys_stl::string FileExistsInParentDirectories(const char* fname,
+ const char* directory, const char* toplevel);
+
+ /** compute the relative path from local to remote. local must
+ be a directory. remote can be a file or a directory.
+ Both remote and local must be full paths. Basically, if
+ you are in directory local and you want to access the file in remote
+ what is the relative path to do that. For example:
+ /a/b/c/d to /a/b/c1/d1 -> ../../c1/d1
+ from /usr/src to /usr/src/test/blah/foo.cpp -> test/blah/foo.cpp
+ */
+ static kwsys_stl::string RelativePath(const char* local, const char* remote);
+
+ /**
+ * Return file's modified time
+ */
+ static long int ModifiedTime(const char* filename);
+
+ /**
+ * Return file's creation time (Win32: works only for NTFS, not FAT)
+ */
+ static long int CreationTime(const char* filename);
+
+ /**
+ * Get and set permissions of the file.
+ */
+ static bool GetPermissions(const char* file, mode_t& mode);
+ static bool SetPermissions(const char* file, mode_t mode);
+
+ /** -----------------------------------------------------------------
+ * Time Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Get current time as a double. On certain platforms this will
+ * return higher resolution than seconds:
+ * (1) gettimeofday() -- resolution in microseconds
+ * (2) ftime() -- resolution in milliseconds
+ * (3) time() -- resolution in seconds
+ */
+ static double GetTime();
+
+ /**
+ * Get current date/time
+ */
+ static kwsys_stl::string GetCurrentDateTime(const char* format);
+
+ /** -----------------------------------------------------------------
+ * Registry Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Read a registry value
+ */
+ static bool ReadRegistryValue(const char *key, kwsys_stl::string &value);
+
+ /**
+ * Write a registry value
+ */
+ static bool WriteRegistryValue(const char *key, const char *value);
+
+ /**
+ * Delete a registry value
+ */
+ static bool DeleteRegistryValue(const char *key);
+
+ /** -----------------------------------------------------------------
+ * Environment Manipulation Routines
+ * -----------------------------------------------------------------
+ */
+
+ /**
+ * Add the paths from the environment variable PATH to the
+ * string vector passed in. If env is set then the value
+ * of env will be used instead of PATH.
+ */
+ static void GetPath(kwsys_stl::vector<kwsys_stl::string>& path,
+ const char* env=0);
+
+ /**
+ * Read an environment variable
+ */
+ static const char* GetEnv(const char* key);
+ static bool GetEnv(const char* key, kwsys_stl::string& result);
+
+ /**
+ * Get current working directory CWD
+ */
+ static kwsys_stl::string GetCurrentWorkingDirectory(bool collapse =true);
+
+ /**
+ * Change directory the the directory specified
+ */
+ static int ChangeDirectory(const char* dir);
+
+ /**
+ * Get the result of strerror(errno)
+ */
+ static kwsys_stl::string GetLastSystemError();
+
+ /**
+ * When building DEBUG with MSVC, this enables a hook that prevents
+ * error dialogs from popping up if the program is being run from
+ * DART.
+ */
+ static void EnableMSVCDebugHook();
+
+ /**
+ * Get the width of the terminal window. The code may or may not work, so
+ * make sure you have some resonable defaults prepared if the code returns
+ * some bogus size.
+ */
+ static int GetTerminalWidth();
+
+ /**
+ * Add an entry in the path translation table.
+ */
+ static void AddTranslationPath(const char * dir, const char * refdir);
+
+ /**
+ * If dir is different after CollapseFullPath is called,
+ * Then insert it into the path translation table
+ */
+ static void AddKeepPath(const char* dir);
+
+ /**
+ * Update path by going through the Path Translation table;
+ */
+ static void CheckTranslationPath(kwsys_stl::string & path);
+
+ /**
+ * Delay the execution for a specified amount of time specified
+ * in miliseconds
+ */
+ static void Delay(unsigned int msec);
+
+ /**
+ * Get the operating system name and version
+ * This is implemented for Win32 only for the moment
+ */
+ static kwsys_stl::string GetOperatingSystemNameAndVersion();
+
+ /**
+ * Convert windows-style arguments given as a command-line string
+ * into more traditional argc/argv arguments.
+ * Note that argv[0] will be assigned the executable name using
+ * the ::GetModuleFileName function.
+ */
+ static void ConvertWindowsCommandLineToUnixArguments(
+ const char *cmd_line, int *argc, char ***argv);
+
+protected:
+ // these two functions can be called from ConvertToOutputPath
+
+ /**
+ * Convert the path to string that can be used in a windows project or
+ * makefile. Double slashes are removed if they are not at the start of
+ * the string, the slashes are converted to windows style backslashes, and
+ * if there are spaces in the string it is double quoted.
+ */
+ static kwsys_stl::string ConvertToWindowsOutputPath(const char*);
+
+private:
+ /**
+ * Allocate the std::map that serve as the Path Translation table.
+ */
+ static void ClassInitialize();
+
+ /**
+ * Deallocate the std::map that serve as the Path Translation table.
+ */
+ static void ClassFinalize();
+
+ /**
+ * This method prevents warning on SGI
+ */
+ SystemToolsManager* GetSystemToolsManager()
+ {
+ return &SystemToolsManagerInstance;
+ }
+
+ /**
+ * Path translation table from dir to refdir
+ * Each time 'dir' will be found it will be replace by 'refdir'
+ */
+ static SystemToolsTranslationMap *TranslationMap;
+ friend class SystemToolsManager;
+};
+
+} // namespace @KWSYS_NAMESPACE@
+
+/* Undefine temporary macros. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# undef kwsys_stl
+# undef kwsys_ios
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/hash_fun.hxx.in b/Utilities/ITK/Utilities/kwsys/hash_fun.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..36044b697eea614a4beec0d3e76de48bac361dd3
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/hash_fun.hxx.in
@@ -0,0 +1,117 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: hash_fun.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+#ifndef @KWSYS_NAMESPACE@_hash_fun_hxx
+#define @KWSYS_NAMESPACE@_hash_fun_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#include <@KWSYS_NAMESPACE@/cstddef> // size_t
+
+namespace @KWSYS_NAMESPACE@
+{
+
+template <class _Key> struct hash { };
+
+inline size_t _stl_hash_string(const char* __s)
+{
+ unsigned long __h = 0;
+ for ( ; *__s; ++__s)
+ __h = 5*__h + *__s;
+
+ return size_t(__h);
+}
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<char*> {
+ size_t operator()(const char* __s) const { return _stl_hash_string(__s); }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<const char*> {
+ size_t operator()(const char* __s) const { return _stl_hash_string(__s); }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<char> {
+ size_t operator()(char __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<unsigned char> {
+ size_t operator()(unsigned char __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<signed char> {
+ size_t operator()(unsigned char __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<short> {
+ size_t operator()(short __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<unsigned short> {
+ size_t operator()(unsigned short __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<int> {
+ size_t operator()(int __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<unsigned int> {
+ size_t operator()(unsigned int __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<long> {
+ size_t operator()(long __x) const { return __x; }
+};
+
+@KWSYS_NAMESPACE@_CXX_DEFINE_SPECIALIZATION
+struct hash<unsigned long> {
+ size_t operator()(unsigned long __x) const { return __x; }
+};
+
+} // namespace @KWSYS_NAMESPACE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/hash_map.hxx.in b/Utilities/ITK/Utilities/kwsys/hash_map.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..088960cef942928a7e09814b08f81e844c8fd3be
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/hash_map.hxx.in
@@ -0,0 +1,463 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: hash_map.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+#ifndef @KWSYS_NAMESPACE@_hash_map_hxx
+#define @KWSYS_NAMESPACE@_hash_map_hxx
+
+#include <@KWSYS_NAMESPACE@/hashtable.hxx>
+#include <@KWSYS_NAMESPACE@/hash_fun.hxx>
+#include <@KWSYS_NAMESPACE@/stl/functional> // equal_to
+
+#if defined(_MSC_VER)
+# pragma warning (push)
+# pragma warning (disable:4284)
+# pragma warning (disable:4786)
+#endif
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+# pragma set woff 1174
+# pragma set woff 1375
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+// select1st is an extension: it is not part of the standard.
+template <class T1, class T2>
+struct hash_select1st:
+ public @KWSYS_NAMESPACE@_stl::unary_function<@KWSYS_NAMESPACE@_stl::pair<T1, T2>, T1>
+{
+ const T1& operator()(const @KWSYS_NAMESPACE@_stl::pair<T1, T2>& __x) const
+ { return __x.first; }
+};
+
+// Forward declaration of equality operator; needed for friend declaration.
+
+template <class _Key, class _Tp,
+ class _HashFcn = hash<_Key>,
+ class _EqualKey = @KWSYS_NAMESPACE@_stl::equal_to<_Key>,
+ class _Alloc = @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(char) >
+class hash_map;
+
+template <class _Key, class _Tp, class _HashFn, class _EqKey, class _Alloc>
+inline bool operator==(const hash_map<_Key, _Tp, _HashFn, _EqKey, _Alloc>&,
+ const hash_map<_Key, _Tp, _HashFn, _EqKey, _Alloc>&);
+
+template <class _Key, class _Tp, class _HashFcn, class _EqualKey,
+ class _Alloc>
+class hash_map
+{
+private:
+ typedef hashtable<@KWSYS_NAMESPACE@_stl::pair<const _Key,_Tp>,_Key,_HashFcn,
+ hash_select1st<const _Key,_Tp>,_EqualKey,_Alloc> _Ht;
+ _Ht _M_ht;
+
+public:
+ typedef typename _Ht::key_type key_type;
+ typedef _Tp data_type;
+ typedef _Tp mapped_type;
+ typedef typename _Ht::value_type value_type;
+ typedef typename _Ht::hasher hasher;
+ typedef typename _Ht::key_equal key_equal;
+
+ typedef typename _Ht::size_type size_type;
+ typedef typename _Ht::difference_type difference_type;
+ typedef typename _Ht::pointer pointer;
+ typedef typename _Ht::const_pointer const_pointer;
+ typedef typename _Ht::reference reference;
+ typedef typename _Ht::const_reference const_reference;
+
+ typedef typename _Ht::iterator iterator;
+ typedef typename _Ht::const_iterator const_iterator;
+
+ typedef typename _Ht::allocator_type allocator_type;
+
+ hasher hash_funct() const { return _M_ht.hash_funct(); }
+ key_equal key_eq() const { return _M_ht.key_eq(); }
+ allocator_type get_allocator() const { return _M_ht.get_allocator(); }
+
+public:
+ hash_map() : _M_ht(100, hasher(), key_equal(), allocator_type()) {}
+ explicit hash_map(size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type()) {}
+ hash_map(size_type __n, const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type()) {}
+ hash_map(size_type __n, const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a) {}
+
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ hash_map(_InputIterator __f, _InputIterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_map(_InputIterator __f, _InputIterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_map(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_map(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+
+#else
+ hash_map(const value_type* __f, const value_type* __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const value_type* __f, const value_type* __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+
+ hash_map(const_iterator __f, const_iterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const_iterator __f, const_iterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_map(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+#endif
+
+public:
+ size_type size() const { return _M_ht.size(); }
+ size_type max_size() const { return _M_ht.max_size(); }
+ bool empty() const { return _M_ht.empty(); }
+ void swap(hash_map& __hs) { _M_ht.swap(__hs._M_ht); }
+
+ friend bool operator==@KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS(const hash_map&,
+ const hash_map&);
+
+ iterator begin() { return _M_ht.begin(); }
+ iterator end() { return _M_ht.end(); }
+ const_iterator begin() const { return _M_ht.begin(); }
+ const_iterator end() const { return _M_ht.end(); }
+
+public:
+ @KWSYS_NAMESPACE@_stl::pair<iterator,bool> insert(const value_type& __obj)
+ { return _M_ht.insert_unique(__obj); }
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ void insert(_InputIterator __f, _InputIterator __l)
+ { _M_ht.insert_unique(__f,__l); }
+#else
+ void insert(const value_type* __f, const value_type* __l) {
+ _M_ht.insert_unique(__f,__l);
+ }
+ void insert(const_iterator __f, const_iterator __l)
+ { _M_ht.insert_unique(__f, __l); }
+#endif
+ @KWSYS_NAMESPACE@_stl::pair<iterator,bool> insert_noresize(const value_type& __obj)
+ { return _M_ht.insert_unique_noresize(__obj); }
+
+ iterator find(const key_type& __key) { return _M_ht.find(__key); }
+ const_iterator find(const key_type& __key) const
+ { return _M_ht.find(__key); }
+
+ _Tp& operator[](const key_type& __key) {
+ return _M_ht.find_or_insert(value_type(__key, _Tp())).second;
+ }
+
+ size_type count(const key_type& __key) const { return _M_ht.count(__key); }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, iterator> equal_range(const key_type& __key)
+ { return _M_ht.equal_range(__key); }
+ @KWSYS_NAMESPACE@_stl::pair<const_iterator, const_iterator>
+ equal_range(const key_type& __key) const
+ { return _M_ht.equal_range(__key); }
+
+ size_type erase(const key_type& __key) {return _M_ht.erase(__key); }
+ void erase(iterator __it) { _M_ht.erase(__it); }
+ void erase(iterator __f, iterator __l) { _M_ht.erase(__f, __l); }
+ void clear() { _M_ht.clear(); }
+
+ void resize(size_type __hint) { _M_ht.resize(__hint); }
+ size_type bucket_count() const { return _M_ht.bucket_count(); }
+ size_type max_bucket_count() const { return _M_ht.max_bucket_count(); }
+ size_type elems_in_bucket(size_type __n) const
+ { return _M_ht.elems_in_bucket(__n); }
+};
+
+template <class _Key, class _Tp, class _HashFcn, class _EqlKey, class _Alloc>
+inline bool
+operator==(const hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm1,
+ const hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm2)
+{
+ return __hm1._M_ht == __hm2._M_ht;
+}
+
+template <class _Key, class _Tp, class _HashFcn, class _EqlKey, class _Alloc>
+inline bool
+operator!=(const hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm1,
+ const hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm2) {
+ return !(__hm1 == __hm2);
+}
+
+template <class _Key, class _Tp, class _HashFcn, class _EqlKey, class _Alloc>
+inline void
+swap(hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm1,
+ hash_map<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm2)
+{
+ __hm1.swap(__hm2);
+}
+
+// Forward declaration of equality operator; needed for friend declaration.
+
+template <class _Key, class _Tp,
+ class _HashFcn = hash<_Key>,
+ class _EqualKey = @KWSYS_NAMESPACE@_stl::equal_to<_Key>,
+ class _Alloc = @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(char) >
+class hash_multimap;
+
+template <class _Key, class _Tp, class _HF, class _EqKey, class _Alloc>
+inline bool
+operator==(const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm1,
+ const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm2);
+
+template <class _Key, class _Tp, class _HashFcn, class _EqualKey,
+ class _Alloc>
+class hash_multimap
+{
+private:
+ typedef hashtable<@KWSYS_NAMESPACE@_stl::pair<const _Key, _Tp>, _Key, _HashFcn,
+ hash_select1st<const _Key, _Tp>, _EqualKey, _Alloc>
+ _Ht;
+ _Ht _M_ht;
+
+public:
+ typedef typename _Ht::key_type key_type;
+ typedef _Tp data_type;
+ typedef _Tp mapped_type;
+ typedef typename _Ht::value_type value_type;
+ typedef typename _Ht::hasher hasher;
+ typedef typename _Ht::key_equal key_equal;
+
+ typedef typename _Ht::size_type size_type;
+ typedef typename _Ht::difference_type difference_type;
+ typedef typename _Ht::pointer pointer;
+ typedef typename _Ht::const_pointer const_pointer;
+ typedef typename _Ht::reference reference;
+ typedef typename _Ht::const_reference const_reference;
+
+ typedef typename _Ht::iterator iterator;
+ typedef typename _Ht::const_iterator const_iterator;
+
+ typedef typename _Ht::allocator_type allocator_type;
+
+ hasher hash_funct() const { return _M_ht.hash_funct(); }
+ key_equal key_eq() const { return _M_ht.key_eq(); }
+ allocator_type get_allocator() const { return _M_ht.get_allocator(); }
+
+public:
+ hash_multimap() : _M_ht(100, hasher(), key_equal(), allocator_type()) {}
+ explicit hash_multimap(size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type()) {}
+ hash_multimap(size_type __n, const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type()) {}
+ hash_multimap(size_type __n, const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a) {}
+
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ hash_multimap(_InputIterator __f, _InputIterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multimap(_InputIterator __f, _InputIterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multimap(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multimap(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+
+#else
+ hash_multimap(const value_type* __f, const value_type* __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const value_type* __f, const value_type* __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+
+ hash_multimap(const_iterator __f, const_iterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const_iterator __f, const_iterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multimap(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+#endif
+
+public:
+ size_type size() const { return _M_ht.size(); }
+ size_type max_size() const { return _M_ht.max_size(); }
+ bool empty() const { return _M_ht.empty(); }
+ void swap(hash_multimap& __hs) { _M_ht.swap(__hs._M_ht); }
+
+ friend bool operator==@KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS(const hash_multimap&,
+ const hash_multimap&);
+
+ iterator begin() { return _M_ht.begin(); }
+ iterator end() { return _M_ht.end(); }
+ const_iterator begin() const { return _M_ht.begin(); }
+ const_iterator end() const { return _M_ht.end(); }
+
+public:
+ iterator insert(const value_type& __obj)
+ { return _M_ht.insert_equal(__obj); }
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ void insert(_InputIterator __f, _InputIterator __l)
+ { _M_ht.insert_equal(__f,__l); }
+#else
+ void insert(const value_type* __f, const value_type* __l) {
+ _M_ht.insert_equal(__f,__l);
+ }
+ void insert(const_iterator __f, const_iterator __l)
+ { _M_ht.insert_equal(__f, __l); }
+#endif
+ iterator insert_noresize(const value_type& __obj)
+ { return _M_ht.insert_equal_noresize(__obj); }
+
+ iterator find(const key_type& __key) { return _M_ht.find(__key); }
+ const_iterator find(const key_type& __key) const
+ { return _M_ht.find(__key); }
+
+ size_type count(const key_type& __key) const { return _M_ht.count(__key); }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, iterator> equal_range(const key_type& __key)
+ { return _M_ht.equal_range(__key); }
+ @KWSYS_NAMESPACE@_stl::pair<const_iterator, const_iterator>
+ equal_range(const key_type& __key) const
+ { return _M_ht.equal_range(__key); }
+
+ size_type erase(const key_type& __key) {return _M_ht.erase(__key); }
+ void erase(iterator __it) { _M_ht.erase(__it); }
+ void erase(iterator __f, iterator __l) { _M_ht.erase(__f, __l); }
+ void clear() { _M_ht.clear(); }
+
+public:
+ void resize(size_type __hint) { _M_ht.resize(__hint); }
+ size_type bucket_count() const { return _M_ht.bucket_count(); }
+ size_type max_bucket_count() const { return _M_ht.max_bucket_count(); }
+ size_type elems_in_bucket(size_type __n) const
+ { return _M_ht.elems_in_bucket(__n); }
+};
+
+template <class _Key, class _Tp, class _HF, class _EqKey, class _Alloc>
+inline bool
+operator==(const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm1,
+ const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm2)
+{
+ return __hm1._M_ht == __hm2._M_ht;
+}
+
+template <class _Key, class _Tp, class _HF, class _EqKey, class _Alloc>
+inline bool
+operator!=(const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm1,
+ const hash_multimap<_Key,_Tp,_HF,_EqKey,_Alloc>& __hm2) {
+ return !(__hm1 == __hm2);
+}
+
+template <class _Key, class _Tp, class _HashFcn, class _EqlKey, class _Alloc>
+inline void
+swap(hash_multimap<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm1,
+ hash_multimap<_Key,_Tp,_HashFcn,_EqlKey,_Alloc>& __hm2)
+{
+ __hm1.swap(__hm2);
+}
+
+} // namespace @KWSYS_NAMESPACE@
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+# pragma reset woff 1174
+# pragma reset woff 1375
+#endif
+
+#if defined(_MSC_VER)
+# pragma warning (pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/hash_set.hxx.in b/Utilities/ITK/Utilities/kwsys/hash_set.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..10111d34023a318fc8194737bc7984050bf8ea2b
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/hash_set.hxx.in
@@ -0,0 +1,447 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: hash_set.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+#ifndef @KWSYS_NAMESPACE@_hash_set_hxx
+#define @KWSYS_NAMESPACE@_hash_set_hxx
+
+#include <@KWSYS_NAMESPACE@/hashtable.hxx>
+#include <@KWSYS_NAMESPACE@/hash_fun.hxx>
+#include <@KWSYS_NAMESPACE@/stl/functional> // equal_to
+
+#if defined(_MSC_VER)
+# pragma warning (push)
+# pragma warning (disable:4284)
+# pragma warning (disable:4786)
+#endif
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+# pragma set woff 1174
+# pragma set woff 1375
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+// identity is an extension: it is not part of the standard.
+template <class _Tp>
+struct _Identity : public @KWSYS_NAMESPACE@_stl::unary_function<_Tp,_Tp>
+{
+ const _Tp& operator()(const _Tp& __x) const { return __x; }
+};
+
+// Forward declaration of equality operator; needed for friend declaration.
+
+template <class _Value,
+ class _HashFcn = hash<_Value>,
+ class _EqualKey = @KWSYS_NAMESPACE@_stl::equal_to<_Value>,
+ class _Alloc = @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(char) >
+class hash_set;
+
+template <class _Value, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator==(const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs2);
+
+template <class _Value, class _HashFcn, class _EqualKey, class _Alloc>
+class hash_set
+{
+private:
+ typedef hashtable<_Value, _Value, _HashFcn, _Identity<_Value>,
+ _EqualKey, _Alloc> _Ht;
+ _Ht _M_ht;
+
+public:
+ typedef typename _Ht::key_type key_type;
+ typedef typename _Ht::value_type value_type;
+ typedef typename _Ht::hasher hasher;
+ typedef typename _Ht::key_equal key_equal;
+
+ typedef typename _Ht::size_type size_type;
+ typedef typename _Ht::difference_type difference_type;
+ typedef typename _Ht::const_pointer pointer;
+ typedef typename _Ht::const_pointer const_pointer;
+ typedef typename _Ht::const_reference reference;
+ typedef typename _Ht::const_reference const_reference;
+
+ typedef typename _Ht::const_iterator iterator;
+ typedef typename _Ht::const_iterator const_iterator;
+
+ typedef typename _Ht::allocator_type allocator_type;
+
+ hasher hash_funct() const { return _M_ht.hash_funct(); }
+ key_equal key_eq() const { return _M_ht.key_eq(); }
+ allocator_type get_allocator() const { return _M_ht.get_allocator(); }
+
+public:
+ hash_set()
+ : _M_ht(100, hasher(), key_equal(), allocator_type()) {}
+ explicit hash_set(size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type()) {}
+ hash_set(size_type __n, const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type()) {}
+ hash_set(size_type __n, const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a) {}
+
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ hash_set(_InputIterator __f, _InputIterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_set(_InputIterator __f, _InputIterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_set(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ template <class _InputIterator>
+ hash_set(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+#else
+
+ hash_set(const value_type* __f, const value_type* __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const value_type* __f, const value_type* __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+
+ hash_set(const_iterator __f, const_iterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const_iterator __f, const_iterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_unique(__f, __l); }
+ hash_set(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_unique(__f, __l); }
+#endif
+
+public:
+ size_type size() const { return _M_ht.size(); }
+ size_type max_size() const { return _M_ht.max_size(); }
+ bool empty() const { return _M_ht.empty(); }
+ void swap(hash_set& __hs) { _M_ht.swap(__hs._M_ht); }
+
+ friend bool operator==@KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS(const hash_set&,
+ const hash_set&);
+
+ iterator begin() const { return _M_ht.begin(); }
+ iterator end() const { return _M_ht.end(); }
+
+public:
+ @KWSYS_NAMESPACE@_stl::pair<iterator, bool> insert(const value_type& __obj)
+ {
+ typedef typename _Ht::iterator _Ht_iterator;
+ @KWSYS_NAMESPACE@_stl::pair<_Ht_iterator, bool> __p = _M_ht.insert_unique(__obj);
+ return @KWSYS_NAMESPACE@_stl::pair<iterator,bool>(__p.first, __p.second);
+ }
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ void insert(_InputIterator __f, _InputIterator __l)
+ { _M_ht.insert_unique(__f,__l); }
+#else
+ void insert(const value_type* __f, const value_type* __l) {
+ _M_ht.insert_unique(__f,__l);
+ }
+ void insert(const_iterator __f, const_iterator __l)
+ {_M_ht.insert_unique(__f, __l); }
+#endif
+ @KWSYS_NAMESPACE@_stl::pair<iterator, bool> insert_noresize(const value_type& __obj)
+ {
+ typedef typename _Ht::iterator _Ht_iterator;
+ @KWSYS_NAMESPACE@_stl::pair<_Ht_iterator, bool> __p =
+ _M_ht.insert_unique_noresize(__obj);
+ return @KWSYS_NAMESPACE@_stl::pair<iterator, bool>(__p.first, __p.second);
+ }
+
+ iterator find(const key_type& __key) const { return _M_ht.find(__key); }
+
+ size_type count(const key_type& __key) const { return _M_ht.count(__key); }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, iterator> equal_range(const key_type& __key) const
+ { return _M_ht.equal_range(__key); }
+
+ size_type erase(const key_type& __key) {return _M_ht.erase(__key); }
+ void erase(iterator __it) { _M_ht.erase(__it); }
+ void erase(iterator __f, iterator __l) { _M_ht.erase(__f, __l); }
+ void clear() { _M_ht.clear(); }
+
+public:
+ void resize(size_type __hint) { _M_ht.resize(__hint); }
+ size_type bucket_count() const { return _M_ht.bucket_count(); }
+ size_type max_bucket_count() const { return _M_ht.max_bucket_count(); }
+ size_type elems_in_bucket(size_type __n) const
+ { return _M_ht.elems_in_bucket(__n); }
+};
+
+template <class _Value, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator==(const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs2)
+{
+ return __hs1._M_ht == __hs2._M_ht;
+}
+
+template <class _Value, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator!=(const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_set<_Value,_HashFcn,_EqualKey,_Alloc>& __hs2) {
+ return !(__hs1 == __hs2);
+}
+
+template <class _Val, class _HashFcn, class _EqualKey, class _Alloc>
+inline void
+swap(hash_set<_Val,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ hash_set<_Val,_HashFcn,_EqualKey,_Alloc>& __hs2)
+{
+ __hs1.swap(__hs2);
+}
+
+template <class _Value,
+ class _HashFcn = hash<_Value>,
+ class _EqualKey = @KWSYS_NAMESPACE@_stl::equal_to<_Value>,
+ class _Alloc = @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(char) >
+class hash_multiset;
+
+template <class _Val, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator==(const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs2);
+
+
+template <class _Value, class _HashFcn, class _EqualKey, class _Alloc>
+class hash_multiset
+{
+private:
+ typedef hashtable<_Value, _Value, _HashFcn, _Identity<_Value>,
+ _EqualKey, _Alloc> _Ht;
+ _Ht _M_ht;
+
+public:
+ typedef typename _Ht::key_type key_type;
+ typedef typename _Ht::value_type value_type;
+ typedef typename _Ht::hasher hasher;
+ typedef typename _Ht::key_equal key_equal;
+
+ typedef typename _Ht::size_type size_type;
+ typedef typename _Ht::difference_type difference_type;
+ typedef typename _Ht::const_pointer pointer;
+ typedef typename _Ht::const_pointer const_pointer;
+ typedef typename _Ht::const_reference reference;
+ typedef typename _Ht::const_reference const_reference;
+
+ typedef typename _Ht::const_iterator iterator;
+ typedef typename _Ht::const_iterator const_iterator;
+
+ typedef typename _Ht::allocator_type allocator_type;
+
+ hasher hash_funct() const { return _M_ht.hash_funct(); }
+ key_equal key_eq() const { return _M_ht.key_eq(); }
+ allocator_type get_allocator() const { return _M_ht.get_allocator(); }
+
+public:
+ hash_multiset()
+ : _M_ht(100, hasher(), key_equal(), allocator_type()) {}
+ explicit hash_multiset(size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type()) {}
+ hash_multiset(size_type __n, const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type()) {}
+ hash_multiset(size_type __n, const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a) {}
+
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ hash_multiset(_InputIterator __f, _InputIterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multiset(_InputIterator __f, _InputIterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multiset(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ template <class _InputIterator>
+ hash_multiset(_InputIterator __f, _InputIterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+#else
+
+ hash_multiset(const value_type* __f, const value_type* __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const value_type* __f, const value_type* __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const value_type* __f, const value_type* __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+
+ hash_multiset(const_iterator __f, const_iterator __l)
+ : _M_ht(100, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const_iterator __f, const_iterator __l, size_type __n)
+ : _M_ht(__n, hasher(), key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf)
+ : _M_ht(__n, __hf, key_equal(), allocator_type())
+ { _M_ht.insert_equal(__f, __l); }
+ hash_multiset(const_iterator __f, const_iterator __l, size_type __n,
+ const hasher& __hf, const key_equal& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_ht(__n, __hf, __eql, __a)
+ { _M_ht.insert_equal(__f, __l); }
+#endif
+
+public:
+ size_type size() const { return _M_ht.size(); }
+ size_type max_size() const { return _M_ht.max_size(); }
+ bool empty() const { return _M_ht.empty(); }
+ void swap(hash_multiset& hs) { _M_ht.swap(hs._M_ht); }
+
+ friend bool operator==@KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS(const hash_multiset&,
+ const hash_multiset&);
+
+ iterator begin() const { return _M_ht.begin(); }
+ iterator end() const { return _M_ht.end(); }
+
+public:
+ iterator insert(const value_type& __obj)
+ { return _M_ht.insert_equal(__obj); }
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class _InputIterator>
+ void insert(_InputIterator __f, _InputIterator __l)
+ { _M_ht.insert_equal(__f,__l); }
+#else
+ void insert(const value_type* __f, const value_type* __l) {
+ _M_ht.insert_equal(__f,__l);
+ }
+ void insert(const_iterator __f, const_iterator __l)
+ { _M_ht.insert_equal(__f, __l); }
+#endif
+ iterator insert_noresize(const value_type& __obj)
+ { return _M_ht.insert_equal_noresize(__obj); }
+
+ iterator find(const key_type& __key) const { return _M_ht.find(__key); }
+
+ size_type count(const key_type& __key) const { return _M_ht.count(__key); }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, iterator> equal_range(const key_type& __key) const
+ { return _M_ht.equal_range(__key); }
+
+ size_type erase(const key_type& __key) {return _M_ht.erase(__key); }
+ void erase(iterator __it) { _M_ht.erase(__it); }
+ void erase(iterator __f, iterator __l) { _M_ht.erase(__f, __l); }
+ void clear() { _M_ht.clear(); }
+
+public:
+ void resize(size_type __hint) { _M_ht.resize(__hint); }
+ size_type bucket_count() const { return _M_ht.bucket_count(); }
+ size_type max_bucket_count() const { return _M_ht.max_bucket_count(); }
+ size_type elems_in_bucket(size_type __n) const
+ { return _M_ht.elems_in_bucket(__n); }
+};
+
+template <class _Val, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator==(const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs2)
+{
+ return __hs1._M_ht == __hs2._M_ht;
+}
+
+template <class _Val, class _HashFcn, class _EqualKey, class _Alloc>
+inline bool
+operator!=(const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ const hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs2) {
+ return !(__hs1 == __hs2);
+}
+
+template <class _Val, class _HashFcn, class _EqualKey, class _Alloc>
+inline void
+swap(hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs1,
+ hash_multiset<_Val,_HashFcn,_EqualKey,_Alloc>& __hs2) {
+ __hs1.swap(__hs2);
+}
+
+} // namespace @KWSYS_NAMESPACE@
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+# pragma reset woff 1174
+# pragma reset woff 1375
+#endif
+
+#if defined(_MSC_VER)
+# pragma warning (pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/hashtable.hxx.in b/Utilities/ITK/Utilities/kwsys/hashtable.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..64022ac56d7d2ff6c2530adf7321579e92031801
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/hashtable.hxx.in
@@ -0,0 +1,1258 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: hashtable.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+#ifndef @KWSYS_NAMESPACE@_hashtable_hxx
+#define @KWSYS_NAMESPACE@_hashtable_hxx
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#include <@KWSYS_NAMESPACE@/cstddef> // size_t
+#include <@KWSYS_NAMESPACE@/stl/algorithm> // lower_bound
+#include <@KWSYS_NAMESPACE@/stl/functional> // unary_function
+#include <@KWSYS_NAMESPACE@/stl/iterator> // iterator_traits
+#include <@KWSYS_NAMESPACE@/stl/memory> // allocator
+#include <@KWSYS_NAMESPACE@/stl/utility> // pair
+#include <@KWSYS_NAMESPACE@/stl/vector> // vector
+
+#if defined(_MSC_VER)
+# pragma warning (push)
+# pragma warning (disable:4284)
+# pragma warning (disable:4786)
+#endif
+
+#if @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_TEMPLATE
+# define @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(T) @KWSYS_NAMESPACE@_stl::allocator< T >
+#elif @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_NONTEMPLATE
+# define @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(T) @KWSYS_NAMESPACE@_stl::allocator
+#else
+# define @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(T) @KWSYS_NAMESPACE@_stl::alloc
+#endif
+
+#if @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_OBJECTS
+# define @KWSYS_NAMESPACE@_HASH_BUCKETS_INIT(__a) _M_buckets(__a)
+# define @KWSYS_NAMESPACE@_HASH_BUCKETS_GET_ALLOCATOR(__b) , __b.get_allocator()
+#else
+# define @KWSYS_NAMESPACE@_HASH_BUCKETS_INIT(__a) _M_buckets()
+# define @KWSYS_NAMESPACE@_HASH_BUCKETS_GET_ALLOCATOR(__b)
+#endif
+
+namespace @KWSYS_NAMESPACE@
+{
+
+//----------------------------------------------------------------------------
+// Define an allocator adaptor for platforms that do not provide an
+// allocator with the rebind member.
+#if !@KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_REBIND
+
+// Utility functions to convert item counts.
+inline size_t hash_sizeof(void*) { return sizeof(char); }
+inline size_t hash_sizeof(const void*) { return sizeof(char); }
+template <class TPtr> inline size_t hash_sizeof(TPtr p) { return sizeof(*p); }
+template <class POut, class PIn, class TSize>
+inline TSize hash_allocator_n(POut out, PIn in, TSize n)
+{
+ return n*(hash_sizeof(out)/hash_sizeof(in) +
+ (hash_sizeof(out)%hash_sizeof(in)>0));
+}
+
+// Define an allocation method to use the native allocator with
+// the proper signature. The following signatures of the allocate
+// method are used on various STL implementations:
+// pointer allocate(size_type, const void* hint)
+// pointer allocate(size_type)
+// static pointer allocate(size_type, const void* hint)
+// static pointer allocate(size_type)
+// Where pointer might be a real type or void*.
+// This set of overloads decodes the signature for a particular STL.
+// The extra three int/long arguments will favor certain signatures
+// over others in the case that multiple are present to avoid
+// ambiguity errors.
+template <class TAlloc, class PIn, class TSize, class THint, class POut>
+inline void hash_allocate(TAlloc* a, PIn (TAlloc::*allocate)(TSize, THint),
+ TSize n_out, const void* hint, POut& out,
+ int, int, int)
+{
+ TSize n_in = hash_allocator_n(POut(), PIn(), n_out);
+ void* vout = (a->*allocate)(n_in, const_cast<THint>(hint));
+ out = static_cast<POut>(vout);
+}
+
+template <class TAlloc, class PIn, class TSize, class POut>
+inline void hash_allocate(TAlloc* a, PIn (TAlloc::*allocate)(TSize),
+ TSize n_out, const void*, POut& out,
+ int, int, long)
+{
+ TSize n_in = hash_allocator_n(POut(), PIn(), n_out);
+ void* vout = (a->*allocate)(n_in);
+ out = static_cast<POut>(vout);
+}
+
+template <class PIn, class TSize, class THint, class POut>
+inline void hash_allocate(void*, PIn (*allocate)(TSize, THint),
+ TSize n_out, const void* hint, POut& out,
+ int, long, long)
+{
+ TSize n_in = hash_allocator_n(POut(), PIn(), n_out);
+ void* vout = allocate(n_in, const_cast<THint>(hint));
+ out = static_cast<POut>(vout);
+}
+
+template <class PIn, class TSize, class POut>
+inline void hash_allocate(void*, PIn (*allocate)(TSize),
+ TSize n_out, const void*, POut& out,
+ long, long, long)
+{
+ TSize n_in = hash_allocator_n(POut(), PIn(), n_out);
+ void* vout = allocate(n_in);
+ out = static_cast<POut>(vout);
+}
+
+// Define a deallocation method to use the native allocator with
+// the proper signature. The following signatures of the deallocate
+// method are used on various STL implementations:
+// void deallocate(pointer, size_type)
+// void deallocate(pointer)
+// static void deallocate(pointer, size_type)
+// static void deallocate(pointer)
+// Where pointer might be a real type or void*.
+// This set of overloads decodes the signature for a particular STL.
+// The extra three int/long arguments will favor certain signatures
+// over others in the case that multiple are present to avoid
+// ambiguity errors.
+template <class TAlloc, class PIn, class TSize, class PInReal, class POut>
+inline void hash_deallocate(TAlloc* a, void (TAlloc::*deallocate)(PIn, TSize),
+ PInReal, POut p, TSize n_out, int, int, int)
+{
+ TSize n_in = hash_allocator_n(POut(), PInReal(), n_out);
+ void* vout = p;
+ (a->*deallocate)(static_cast<PIn>(vout), n_in);
+}
+
+template <class TAlloc, class PIn, class TSize, class PInReal, class POut>
+inline void hash_deallocate(TAlloc* a, void (TAlloc::*deallocate)(PIn),
+ PInReal, POut p, TSize, int, int, long)
+{
+ void* vout = p;
+ (a->*deallocate)(static_cast<PIn>(vout));
+}
+
+template <class PIn, class TSize, class PInReal, class POut>
+inline void hash_deallocate(void*, void (*deallocate)(PIn, TSize),
+ PInReal, POut p, TSize n_out, int, long, long)
+{
+ TSize n_in = hash_allocator_n(POut(), PInReal(), n_out);
+ void* vout = p;
+ deallocate(static_cast<PIn>(vout), n_in);
+}
+
+template <class PIn, class TSize, class PInReal, class POut>
+inline void hash_deallocate(void*, void (*deallocate)(PIn),
+ PInReal, POut p, TSize, long, long, long)
+{
+ void* vout = p;
+ deallocate(static_cast<PIn>(vout));
+}
+
+// Use the same four overloads as hash_allocate to decode the type
+// really used for allocation. This is passed as PInReal to the
+// deallocate functions so that hash_allocator_n has the proper size.
+template <class TAlloc, class PIn, class TSize, class THint>
+inline PIn hash_allocate_type(PIn (TAlloc::*)(TSize, THint),
+ int, int, int) { return 0; }
+template <class TAlloc, class PIn, class TSize>
+inline PIn hash_allocate_type(PIn (TAlloc::*)(TSize),
+ int, int, long) { return 0; }
+template <class PIn, class TSize, class THint>
+inline PIn hash_allocate_type(PIn (*)(TSize, THint),
+ int, long, long) { return 0; }
+template <class PIn, class TSize>
+inline PIn hash_allocate_type(PIn (*)(TSize),
+ long, long, long) { return 0; }
+
+// Define the comparison operators in terms of a base type to avoid
+// needing templated versions.
+class hash_allocator_base {};
+bool operator==(const hash_allocator_base&,
+ const hash_allocator_base&) throw() { return true; }
+bool operator!=(const hash_allocator_base&,
+ const hash_allocator_base&) throw() { return false; }
+
+// Define the allocator template.
+template <class T, class Alloc>
+class hash_allocator: public hash_allocator_base
+{
+private:
+ // Store the real allocator privately.
+ typedef Alloc alloc_type;
+ alloc_type alloc_;
+
+public:
+ // Standard allocator interface.
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef T* pointer;
+ typedef const T* const_pointer;
+ typedef T& reference;
+ typedef const T& const_reference;
+ typedef T value_type;
+
+ hash_allocator() throw(): alloc_() {}
+ hash_allocator(const hash_allocator_base&) throw() : alloc_() {}
+ hash_allocator(const hash_allocator& a) throw() : alloc_(a.alloc_) {}
+ hash_allocator(const alloc_type& a) throw() : alloc_(a) {}
+ ~hash_allocator() throw() {}
+# if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES
+ template <class U>
+ struct rebind { typedef hash_allocator<U, alloc_type> other; };
+# endif
+ pointer address(reference x) const { return &x; }
+ const_pointer address(const_reference x) const { return &x; }
+ typedef void* void_pointer;
+ typedef const void* const_void_pointer;
+ pointer allocate(size_type n=1, const_void_pointer hint = 0)
+ {
+ if(n)
+ {
+ pointer p;
+ hash_allocate(&alloc_, &alloc_type::allocate, n, hint, p, 1, 1, 1);
+ return p;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ void deallocate(pointer p, size_type n=1)
+ {
+ if(n)
+ {
+ hash_deallocate(&alloc_, &alloc_type::deallocate,
+ hash_allocate_type(&alloc_type::allocate, 1, 1, 1),
+ p, n, 1, 1, 1);
+ }
+ }
+#if @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT
+ size_type max_size(size_type s) const throw()
+ {
+ return alloc_.max_size(s);
+ }
+#else
+ size_type max_size() const throw()
+ {
+ size_type n = alloc_.max_size() / sizeof(value_type);
+ return n>0? n:1;
+ }
+#endif
+ void construct(pointer p, const value_type& val) { new (p) value_type(val); }
+ void destroy(pointer p) { (void)p; p->~value_type(); }
+};
+#endif
+
+template <class _Val>
+struct _Hashtable_node
+{
+ _Hashtable_node* _M_next;
+ _Val _M_val;
+};
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey,
+ class _Alloc = @KWSYS_NAMESPACE@_HASH_DEFAULT_ALLOCATOR(char) >
+class hashtable;
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey, class _Alloc>
+struct _Hashtable_iterator;
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey, class _Alloc>
+struct _Hashtable_const_iterator;
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey, class _Alloc>
+struct _Hashtable_iterator {
+ typedef hashtable<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,_Alloc>
+ _Hashtable;
+ typedef _Hashtable_iterator<_Val, _Key, _HashFcn,
+ _ExtractKey, _EqualKey, _Alloc>
+ iterator;
+ typedef _Hashtable_const_iterator<_Val, _Key, _HashFcn,
+ _ExtractKey, _EqualKey, _Alloc>
+ const_iterator;
+ typedef _Hashtable_node<_Val> _Node;
+
+ typedef @KWSYS_NAMESPACE@_stl::forward_iterator_tag iterator_category;
+ typedef _Val value_type;
+ typedef ptrdiff_t difference_type;
+ typedef size_t size_type;
+ typedef _Val& reference;
+ typedef _Val* pointer;
+
+ _Node* _M_cur;
+ _Hashtable* _M_ht;
+
+ _Hashtable_iterator(_Node* __n, _Hashtable* __tab)
+ : _M_cur(__n), _M_ht(__tab) {}
+ _Hashtable_iterator() {}
+ reference operator*() const { return _M_cur->_M_val; }
+ pointer operator->() const { return &(operator*()); }
+ iterator& operator++();
+ iterator operator++(int);
+ bool operator==(const iterator& __it) const
+ { return _M_cur == __it._M_cur; }
+ bool operator!=(const iterator& __it) const
+ { return _M_cur != __it._M_cur; }
+};
+
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey, class _Alloc>
+struct _Hashtable_const_iterator {
+ typedef hashtable<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,_Alloc>
+ _Hashtable;
+ typedef _Hashtable_iterator<_Val,_Key,_HashFcn,
+ _ExtractKey,_EqualKey,_Alloc>
+ iterator;
+ typedef _Hashtable_const_iterator<_Val, _Key, _HashFcn,
+ _ExtractKey, _EqualKey, _Alloc>
+ const_iterator;
+ typedef _Hashtable_node<_Val> _Node;
+
+ typedef @KWSYS_NAMESPACE@_stl::forward_iterator_tag iterator_category;
+ typedef _Val value_type;
+ typedef ptrdiff_t difference_type;
+ typedef size_t size_type;
+ typedef const _Val& reference;
+ typedef const _Val* pointer;
+
+ const _Node* _M_cur;
+ const _Hashtable* _M_ht;
+
+ _Hashtable_const_iterator(const _Node* __n, const _Hashtable* __tab)
+ : _M_cur(__n), _M_ht(__tab) {}
+ _Hashtable_const_iterator() {}
+ _Hashtable_const_iterator(const iterator& __it)
+ : _M_cur(__it._M_cur), _M_ht(__it._M_ht) {}
+ reference operator*() const { return _M_cur->_M_val; }
+ pointer operator->() const { return &(operator*()); }
+ const_iterator& operator++();
+ const_iterator operator++(int);
+ bool operator==(const const_iterator& __it) const
+ { return _M_cur == __it._M_cur; }
+ bool operator!=(const const_iterator& __it) const
+ { return _M_cur != __it._M_cur; }
+};
+
+// Note: assumes long is at least 32 bits.
+enum { _stl_num_primes = 31 };
+
+static const unsigned long _stl_prime_list[_stl_num_primes] =
+{
+ 5ul, 11ul, 23ul,
+ 53ul, 97ul, 193ul, 389ul, 769ul,
+ 1543ul, 3079ul, 6151ul, 12289ul, 24593ul,
+ 49157ul, 98317ul, 196613ul, 393241ul, 786433ul,
+ 1572869ul, 3145739ul, 6291469ul, 12582917ul, 25165843ul,
+ 50331653ul, 100663319ul, 201326611ul, 402653189ul, 805306457ul,
+ 1610612741ul, 3221225473ul, 4294967291ul
+};
+
+inline unsigned long _stl_next_prime(unsigned long __n)
+{
+ const unsigned long* __first = _stl_prime_list;
+ const unsigned long* __last = _stl_prime_list + (int)_stl_num_primes;
+ const unsigned long* pos = @KWSYS_NAMESPACE@_stl::lower_bound(__first, __last, __n);
+ return pos == __last ? *(__last - 1) : *pos;
+}
+
+// Forward declaration of operator==.
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+class hashtable;
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+bool operator==(const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht1,
+ const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht2);
+
+// Hashtables handle allocators a bit differently than other containers
+// do. If we're using standard-conforming allocators, then a hashtable
+// unconditionally has a member variable to hold its allocator, even if
+// it so happens that all instances of the allocator type are identical.
+// This is because, for hashtables, this extra storage is negligible.
+// Additionally, a base class wouldn't serve any other purposes; it
+// wouldn't, for example, simplify the exception-handling code.
+
+template <class _Val, class _Key, class _HashFcn,
+ class _ExtractKey, class _EqualKey, class _Alloc>
+class hashtable {
+public:
+ typedef _Key key_type;
+ typedef _Val value_type;
+ typedef _HashFcn hasher;
+ typedef _EqualKey key_equal;
+
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef value_type* pointer;
+ typedef const value_type* const_pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+
+ hasher hash_funct() const { return _M_hash; }
+ key_equal key_eq() const { return _M_equals; }
+
+private:
+ typedef _Hashtable_node<_Val> _Node;
+
+#if @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_REBIND
+public:
+ typedef typename _Alloc::template rebind<_Val>::other allocator_type;
+ allocator_type get_allocator() const { return _M_node_allocator; }
+private:
+ typedef typename _Alloc::template rebind<_Node>::other _M_node_allocator_type;
+ typedef typename _Alloc::template rebind<_Node*>::other _M_node_ptr_allocator_type;
+ typedef @KWSYS_NAMESPACE@_stl::vector<_Node*,_M_node_ptr_allocator_type> _M_buckets_type;
+#else
+public:
+ typedef hash_allocator<_Val, _Alloc> allocator_type;
+ allocator_type get_allocator() const { return allocator_type(); }
+private:
+ typedef hash_allocator<_Node, _Alloc> _M_node_allocator_type;
+# if @KWSYS_NAMESPACE@_STL_HAS_ALLOCATOR_OBJECTS
+ typedef hash_allocator<_Node*, _Alloc> _M_node_ptr_allocator_type;
+# else
+ typedef _Alloc _M_node_ptr_allocator_type;
+# endif
+ typedef @KWSYS_NAMESPACE@_stl::vector<_Node*,_M_node_ptr_allocator_type> _M_buckets_type;
+#endif
+
+private:
+ _M_node_allocator_type _M_node_allocator;
+ hasher _M_hash;
+ key_equal _M_equals;
+ _ExtractKey _M_get_key;
+ _M_buckets_type _M_buckets;
+ size_type _M_num_elements;
+
+ _Node* _M_get_node() { return _M_node_allocator.allocate(1); }
+ void _M_put_node(_Node* __p) { _M_node_allocator.deallocate(__p, 1); }
+
+public:
+ typedef _Hashtable_iterator<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,_Alloc>
+ iterator;
+ typedef _Hashtable_const_iterator<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,
+ _Alloc>
+ const_iterator;
+
+ friend struct
+ _Hashtable_iterator<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,_Alloc>;
+ friend struct
+ _Hashtable_const_iterator<_Val,_Key,_HashFcn,_ExtractKey,_EqualKey,_Alloc>;
+
+public:
+ hashtable(size_type __n,
+ const _HashFcn& __hf,
+ const _EqualKey& __eql,
+ const _ExtractKey& __ext,
+ const allocator_type& __a = allocator_type())
+ : _M_node_allocator(__a),
+ _M_hash(__hf),
+ _M_equals(__eql),
+ _M_get_key(__ext),
+ @KWSYS_NAMESPACE@_HASH_BUCKETS_INIT(__a),
+ _M_num_elements(0)
+ {
+ _M_initialize_buckets(__n);
+ }
+
+ hashtable(size_type __n,
+ const _HashFcn& __hf,
+ const _EqualKey& __eql,
+ const allocator_type& __a = allocator_type())
+ : _M_node_allocator(__a),
+ _M_hash(__hf),
+ _M_equals(__eql),
+ _M_get_key(_ExtractKey()),
+ @KWSYS_NAMESPACE@_HASH_BUCKETS_INIT(__a),
+ _M_num_elements(0)
+ {
+ _M_initialize_buckets(__n);
+ }
+
+ hashtable(const hashtable& __ht)
+ : _M_node_allocator(__ht.get_allocator()),
+ _M_hash(__ht._M_hash),
+ _M_equals(__ht._M_equals),
+ _M_get_key(__ht._M_get_key),
+ @KWSYS_NAMESPACE@_HASH_BUCKETS_INIT(__ht.get_allocator()),
+ _M_num_elements(0)
+ {
+ _M_copy_from(__ht);
+ }
+
+ hashtable& operator= (const hashtable& __ht)
+ {
+ if (&__ht != this) {
+ clear();
+ _M_hash = __ht._M_hash;
+ _M_equals = __ht._M_equals;
+ _M_get_key = __ht._M_get_key;
+ _M_copy_from(__ht);
+ }
+ return *this;
+ }
+
+ ~hashtable() { clear(); }
+
+ size_type size() const { return _M_num_elements; }
+ size_type max_size() const { return size_type(-1); }
+ bool empty() const { return size() == 0; }
+
+ void swap(hashtable& __ht)
+ {
+ @KWSYS_NAMESPACE@_stl::swap(_M_hash, __ht._M_hash);
+ @KWSYS_NAMESPACE@_stl::swap(_M_equals, __ht._M_equals);
+ @KWSYS_NAMESPACE@_stl::swap(_M_get_key, __ht._M_get_key);
+ _M_buckets.swap(__ht._M_buckets);
+ @KWSYS_NAMESPACE@_stl::swap(_M_num_elements, __ht._M_num_elements);
+ }
+
+ iterator begin()
+ {
+ for (size_type __n = 0; __n < _M_buckets.size(); ++__n)
+ if (_M_buckets[__n])
+ return iterator(_M_buckets[__n], this);
+ return end();
+ }
+
+ iterator end() { return iterator(0, this); }
+
+ const_iterator begin() const
+ {
+ for (size_type __n = 0; __n < _M_buckets.size(); ++__n)
+ if (_M_buckets[__n])
+ return const_iterator(_M_buckets[__n], this);
+ return end();
+ }
+
+ const_iterator end() const { return const_iterator(0, this); }
+
+ friend bool operator==@KWSYS_NAMESPACE@_CXX_NULL_TEMPLATE_ARGS(const hashtable&,
+ const hashtable&);
+
+public:
+
+ size_type bucket_count() const { return _M_buckets.size(); }
+
+ size_type max_bucket_count() const
+ { return _stl_prime_list[(int)_stl_num_primes - 1]; }
+
+ size_type elems_in_bucket(size_type __bucket) const
+ {
+ size_type __result = 0;
+ for (_Node* __cur = _M_buckets[__bucket]; __cur; __cur = __cur->_M_next)
+ __result += 1;
+ return __result;
+ }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, bool> insert_unique(const value_type& __obj)
+ {
+ resize(_M_num_elements + 1);
+ return insert_unique_noresize(__obj);
+ }
+
+ iterator insert_equal(const value_type& __obj)
+ {
+ resize(_M_num_elements + 1);
+ return insert_equal_noresize(__obj);
+ }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, bool> insert_unique_noresize(const value_type& __obj);
+ iterator insert_equal_noresize(const value_type& __obj);
+
+#if @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_TRAITS
+# define @KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY(T,I) \
+ typename @KWSYS_NAMESPACE@_stl::iterator_traits< T >::iterator_category()
+#elif @KWSYS_NAMESPACE@_STL_HAS_ITERATOR_CATEGORY
+# define @KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY(T,I) \
+ @KWSYS_NAMESPACE@_stl::iterator_category( I )
+#elif @KWSYS_NAMESPACE@_STL_HAS___ITERATOR_CATEGORY
+# define @KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY(T,I) \
+ @KWSYS_NAMESPACE@_stl::__iterator_category( I )
+#endif
+
+#if @KWSYS_NAMESPACE@_CXX_HAS_MEMBER_TEMPLATES && defined(@KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY)
+ template <class _InputIterator>
+ void insert_unique(_InputIterator __f, _InputIterator __l)
+ {
+ insert_unique(__f, __l,
+ @KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY(_InputIterator, __f));
+ }
+
+ template <class _InputIterator>
+ void insert_equal(_InputIterator __f, _InputIterator __l)
+ {
+ insert_equal(__f, __l,
+ @KWSYS_NAMESPACE@_HASH_ITERATOR_CATEGORY(_InputIterator, __f));
+ }
+
+ template <class _InputIterator>
+ void insert_unique(_InputIterator __f, _InputIterator __l,
+ @KWSYS_NAMESPACE@_stl::input_iterator_tag)
+ {
+ for ( ; __f != __l; ++__f)
+ insert_unique(*__f);
+ }
+
+ template <class _InputIterator>
+ void insert_equal(_InputIterator __f, _InputIterator __l,
+ @KWSYS_NAMESPACE@_stl::input_iterator_tag)
+ {
+ for ( ; __f != __l; ++__f)
+ insert_equal(*__f);
+ }
+
+ template <class _ForwardIterator>
+ void insert_unique(_ForwardIterator __f, _ForwardIterator __l,
+ @KWSYS_NAMESPACE@_stl::forward_iterator_tag)
+ {
+ size_type __n = 0;
+ @KWSYS_NAMESPACE@_stl::distance(__f, __l, __n);
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_unique_noresize(*__f);
+ }
+
+ template <class _ForwardIterator>
+ void insert_equal(_ForwardIterator __f, _ForwardIterator __l,
+ @KWSYS_NAMESPACE@_stl::forward_iterator_tag)
+ {
+ size_type __n = 0;
+ @KWSYS_NAMESPACE@_stl::distance(__f, __l, __n);
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_equal_noresize(*__f);
+ }
+
+#else
+ void insert_unique(const value_type* __f, const value_type* __l)
+ {
+ size_type __n = __l - __f;
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_unique_noresize(*__f);
+ }
+
+ void insert_equal(const value_type* __f, const value_type* __l)
+ {
+ size_type __n = __l - __f;
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_equal_noresize(*__f);
+ }
+
+ void insert_unique(const_iterator __f, const_iterator __l)
+ {
+ size_type __n = 0;
+ @KWSYS_NAMESPACE@_stl::distance(__f, __l, __n);
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_unique_noresize(*__f);
+ }
+
+ void insert_equal(const_iterator __f, const_iterator __l)
+ {
+ size_type __n = 0;
+ @KWSYS_NAMESPACE@_stl::distance(__f, __l, __n);
+ resize(_M_num_elements + __n);
+ for ( ; __n > 0; --__n, ++__f)
+ insert_equal_noresize(*__f);
+ }
+#endif
+
+ reference find_or_insert(const value_type& __obj);
+
+ iterator find(const key_type& __key)
+ {
+ size_type __n = _M_bkt_num_key(__key);
+ _Node* __first;
+ for ( __first = _M_buckets[__n];
+ __first && !_M_equals(_M_get_key(__first->_M_val), __key);
+ __first = __first->_M_next)
+ {}
+ return iterator(__first, this);
+ }
+
+ const_iterator find(const key_type& __key) const
+ {
+ size_type __n = _M_bkt_num_key(__key);
+ const _Node* __first;
+ for ( __first = _M_buckets[__n];
+ __first && !_M_equals(_M_get_key(__first->_M_val), __key);
+ __first = __first->_M_next)
+ {}
+ return const_iterator(__first, this);
+ }
+
+ size_type count(const key_type& __key) const
+ {
+ const size_type __n = _M_bkt_num_key(__key);
+ size_type __result = 0;
+
+ for (const _Node* __cur = _M_buckets[__n]; __cur; __cur = __cur->_M_next)
+ if (_M_equals(_M_get_key(__cur->_M_val), __key))
+ ++__result;
+ return __result;
+ }
+
+ @KWSYS_NAMESPACE@_stl::pair<iterator, iterator>
+ equal_range(const key_type& __key);
+
+ @KWSYS_NAMESPACE@_stl::pair<const_iterator, const_iterator>
+ equal_range(const key_type& __key) const;
+
+ size_type erase(const key_type& __key);
+ void erase(const iterator& __it);
+ void erase(iterator __first, iterator __last);
+
+ void erase(const const_iterator& __it);
+ void erase(const_iterator __first, const_iterator __last);
+
+ void resize(size_type __num_elements_hint);
+ void clear();
+
+private:
+ size_type _M_next_size(size_type __n) const
+ { return _stl_next_prime(__n); }
+
+ void _M_initialize_buckets(size_type __n)
+ {
+ const size_type __n_buckets = _M_next_size(__n);
+ _M_buckets.reserve(__n_buckets);
+ _M_buckets.insert(_M_buckets.end(), __n_buckets, (_Node*) 0);
+ _M_num_elements = 0;
+ }
+
+ size_type _M_bkt_num_key(const key_type& __key) const
+ {
+ return _M_bkt_num_key(__key, _M_buckets.size());
+ }
+
+ size_type _M_bkt_num(const value_type& __obj) const
+ {
+ return _M_bkt_num_key(_M_get_key(__obj));
+ }
+
+ size_type _M_bkt_num_key(const key_type& __key, size_t __n) const
+ {
+ return _M_hash(__key) % __n;
+ }
+
+ size_type _M_bkt_num(const value_type& __obj, size_t __n) const
+ {
+ return _M_bkt_num_key(_M_get_key(__obj), __n);
+ }
+
+ void construct(_Val* p, const _Val& v)
+ {
+ new (p) _Val(v);
+ }
+ void destroy(_Val* p)
+ {
+ (void)p;
+ p->~_Val();
+ }
+
+ _Node* _M_new_node(const value_type& __obj)
+ {
+ _Node* __n = _M_get_node();
+ __n->_M_next = 0;
+ try {
+ construct(&__n->_M_val, __obj);
+ return __n;
+ }
+ catch(...) {_M_put_node(__n); throw;}
+ }
+
+ void _M_delete_node(_Node* __n)
+ {
+ destroy(&__n->_M_val);
+ _M_put_node(__n);
+ }
+
+ void _M_erase_bucket(const size_type __n, _Node* __first, _Node* __last);
+ void _M_erase_bucket(const size_type __n, _Node* __last);
+
+ void _M_copy_from(const hashtable& __ht);
+
+};
+
+template <class _Val, class _Key, class _HF, class _ExK, class _EqK,
+ class _All>
+_Hashtable_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>&
+_Hashtable_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>::operator++()
+{
+ const _Node* __old = _M_cur;
+ _M_cur = _M_cur->_M_next;
+ if (!_M_cur) {
+ size_type __bucket = _M_ht->_M_bkt_num(__old->_M_val);
+ while (!_M_cur && ++__bucket < _M_ht->_M_buckets.size())
+ _M_cur = _M_ht->_M_buckets[__bucket];
+ }
+ return *this;
+}
+
+template <class _Val, class _Key, class _HF, class _ExK, class _EqK,
+ class _All>
+inline _Hashtable_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>
+_Hashtable_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>::operator++(int)
+{
+ iterator __tmp = *this;
+ ++*this;
+ return __tmp;
+}
+
+template <class _Val, class _Key, class _HF, class _ExK, class _EqK,
+ class _All>
+_Hashtable_const_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>&
+_Hashtable_const_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>::operator++()
+{
+ const _Node* __old = _M_cur;
+ _M_cur = _M_cur->_M_next;
+ if (!_M_cur) {
+ size_type __bucket = _M_ht->_M_bkt_num(__old->_M_val);
+ while (!_M_cur && ++__bucket < _M_ht->_M_buckets.size())
+ _M_cur = _M_ht->_M_buckets[__bucket];
+ }
+ return *this;
+}
+
+template <class _Val, class _Key, class _HF, class _ExK, class _EqK,
+ class _All>
+inline _Hashtable_const_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>
+_Hashtable_const_iterator<_Val,_Key,_HF,_ExK,_EqK,_All>::operator++(int)
+{
+ const_iterator __tmp = *this;
+ ++*this;
+ return __tmp;
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+bool operator==(const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht1,
+ const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht2)
+{
+ typedef typename hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::_Node _Node;
+ if (__ht1._M_buckets.size() != __ht2._M_buckets.size())
+ return false;
+ for (int __n = 0; __n < __ht1._M_buckets.size(); ++__n) {
+ _Node* __cur1 = __ht1._M_buckets[__n];
+ _Node* __cur2 = __ht2._M_buckets[__n];
+ for ( ; __cur1 && __cur2 && __cur1->_M_val == __cur2->_M_val;
+ __cur1 = __cur1->_M_next, __cur2 = __cur2->_M_next)
+ {}
+ if (__cur1 || __cur2)
+ return false;
+ }
+ return true;
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+inline bool operator!=(const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht1,
+ const hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>& __ht2) {
+ return !(__ht1 == __ht2);
+}
+
+template <class _Val, class _Key, class _HF, class _Extract, class _EqKey,
+ class _All>
+inline void swap(hashtable<_Val, _Key, _HF, _Extract, _EqKey, _All>& __ht1,
+ hashtable<_Val, _Key, _HF, _Extract, _EqKey, _All>& __ht2) {
+ __ht1.swap(__ht2);
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+@KWSYS_NAMESPACE@_stl::pair<@KWSYS_NAMESPACE@_CXX_DECL_TYPENAME hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::iterator, bool>
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::insert_unique_noresize(const value_type& __obj)
+{
+ const size_type __n = _M_bkt_num(__obj);
+ _Node* __first = _M_buckets[__n];
+
+ for (_Node* __cur = __first; __cur; __cur = __cur->_M_next)
+ if (_M_equals(_M_get_key(__cur->_M_val), _M_get_key(__obj)))
+ return @KWSYS_NAMESPACE@_stl::pair<iterator, bool>(iterator(__cur, this), false);
+
+ _Node* __tmp = _M_new_node(__obj);
+ __tmp->_M_next = __first;
+ _M_buckets[__n] = __tmp;
+ ++_M_num_elements;
+ return @KWSYS_NAMESPACE@_stl::pair<iterator, bool>(iterator(__tmp, this), true);
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+typename hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::iterator
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::insert_equal_noresize(const value_type& __obj)
+{
+ const size_type __n = _M_bkt_num(__obj);
+ _Node* __first = _M_buckets[__n];
+
+ for (_Node* __cur = __first; __cur; __cur = __cur->_M_next)
+ if (_M_equals(_M_get_key(__cur->_M_val), _M_get_key(__obj))) {
+ _Node* __tmp = _M_new_node(__obj);
+ __tmp->_M_next = __cur->_M_next;
+ __cur->_M_next = __tmp;
+ ++_M_num_elements;
+ return iterator(__tmp, this);
+ }
+
+ _Node* __tmp = _M_new_node(__obj);
+ __tmp->_M_next = __first;
+ _M_buckets[__n] = __tmp;
+ ++_M_num_elements;
+ return iterator(__tmp, this);
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+typename hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::reference
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::find_or_insert(const value_type& __obj)
+{
+ resize(_M_num_elements + 1);
+
+ size_type __n = _M_bkt_num(__obj);
+ _Node* __first = _M_buckets[__n];
+
+ for (_Node* __cur = __first; __cur; __cur = __cur->_M_next)
+ if (_M_equals(_M_get_key(__cur->_M_val), _M_get_key(__obj)))
+ return __cur->_M_val;
+
+ _Node* __tmp = _M_new_node(__obj);
+ __tmp->_M_next = __first;
+ _M_buckets[__n] = __tmp;
+ ++_M_num_elements;
+ return __tmp->_M_val;
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+@KWSYS_NAMESPACE@_stl::pair<@KWSYS_NAMESPACE@_CXX_DECL_TYPENAME hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::iterator,
+ @KWSYS_NAMESPACE@_CXX_DECL_TYPENAME hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::iterator>
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::equal_range(const key_type& __key)
+{
+ typedef @KWSYS_NAMESPACE@_stl::pair<iterator, iterator> _Pii;
+ const size_type __n = _M_bkt_num_key(__key);
+
+ for (_Node* __first = _M_buckets[__n]; __first; __first = __first->_M_next)
+ if (_M_equals(_M_get_key(__first->_M_val), __key)) {
+ for (_Node* __cur = __first->_M_next; __cur; __cur = __cur->_M_next)
+ if (!_M_equals(_M_get_key(__cur->_M_val), __key))
+ return _Pii(iterator(__first, this), iterator(__cur, this));
+ for (size_type __m = __n + 1; __m < _M_buckets.size(); ++__m)
+ if (_M_buckets[__m])
+ return _Pii(iterator(__first, this),
+ iterator(_M_buckets[__m], this));
+ return _Pii(iterator(__first, this), end());
+ }
+ return _Pii(end(), end());
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+@KWSYS_NAMESPACE@_stl::pair<@KWSYS_NAMESPACE@_CXX_DECL_TYPENAME hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::const_iterator,
+ @KWSYS_NAMESPACE@_CXX_DECL_TYPENAME hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::const_iterator>
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::equal_range(const key_type& __key) const
+{
+ typedef @KWSYS_NAMESPACE@_stl::pair<const_iterator, const_iterator> _Pii;
+ const size_type __n = _M_bkt_num_key(__key);
+
+ for (const _Node* __first = _M_buckets[__n] ;
+ __first;
+ __first = __first->_M_next) {
+ if (_M_equals(_M_get_key(__first->_M_val), __key)) {
+ for (const _Node* __cur = __first->_M_next;
+ __cur;
+ __cur = __cur->_M_next)
+ if (!_M_equals(_M_get_key(__cur->_M_val), __key))
+ return _Pii(const_iterator(__first, this),
+ const_iterator(__cur, this));
+ for (size_type __m = __n + 1; __m < _M_buckets.size(); ++__m)
+ if (_M_buckets[__m])
+ return _Pii(const_iterator(__first, this),
+ const_iterator(_M_buckets[__m], this));
+ return _Pii(const_iterator(__first, this), end());
+ }
+ }
+ return _Pii(end(), end());
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+typename hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::size_type
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::erase(const key_type& __key)
+{
+ const size_type __n = _M_bkt_num_key(__key);
+ _Node* __first = _M_buckets[__n];
+ size_type __erased = 0;
+
+ if (__first) {
+ _Node* __cur = __first;
+ _Node* __next = __cur->_M_next;
+ while (__next) {
+ if (_M_equals(_M_get_key(__next->_M_val), __key)) {
+ __cur->_M_next = __next->_M_next;
+ _M_delete_node(__next);
+ __next = __cur->_M_next;
+ ++__erased;
+ --_M_num_elements;
+ }
+ else {
+ __cur = __next;
+ __next = __cur->_M_next;
+ }
+ }
+ if (_M_equals(_M_get_key(__first->_M_val), __key)) {
+ _M_buckets[__n] = __first->_M_next;
+ _M_delete_node(__first);
+ ++__erased;
+ --_M_num_elements;
+ }
+ }
+ return __erased;
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::erase(const iterator& __it)
+{
+ _Node* __p = __it._M_cur;
+ if (__p) {
+ const size_type __n = _M_bkt_num(__p->_M_val);
+ _Node* __cur = _M_buckets[__n];
+
+ if (__cur == __p) {
+ _M_buckets[__n] = __cur->_M_next;
+ _M_delete_node(__cur);
+ --_M_num_elements;
+ }
+ else {
+ _Node* __next = __cur->_M_next;
+ while (__next) {
+ if (__next == __p) {
+ __cur->_M_next = __next->_M_next;
+ _M_delete_node(__next);
+ --_M_num_elements;
+ break;
+ }
+ else {
+ __cur = __next;
+ __next = __cur->_M_next;
+ }
+ }
+ }
+ }
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::erase(iterator __first, iterator __last)
+{
+ size_type __f_bucket = __first._M_cur ?
+ _M_bkt_num(__first._M_cur->_M_val) : _M_buckets.size();
+ size_type __l_bucket = __last._M_cur ?
+ _M_bkt_num(__last._M_cur->_M_val) : _M_buckets.size();
+
+ if (__first._M_cur == __last._M_cur)
+ return;
+ else if (__f_bucket == __l_bucket)
+ _M_erase_bucket(__f_bucket, __first._M_cur, __last._M_cur);
+ else {
+ _M_erase_bucket(__f_bucket, __first._M_cur, 0);
+ for (size_type __n = __f_bucket + 1; __n < __l_bucket; ++__n)
+ _M_erase_bucket(__n, 0);
+ if (__l_bucket != _M_buckets.size())
+ _M_erase_bucket(__l_bucket, __last._M_cur);
+ }
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+inline void
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::erase(const_iterator __first,
+ const_iterator __last)
+{
+ erase(iterator(const_cast<_Node*>(__first._M_cur),
+ const_cast<hashtable*>(__first._M_ht)),
+ iterator(const_cast<_Node*>(__last._M_cur),
+ const_cast<hashtable*>(__last._M_ht)));
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+inline void
+hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::erase(const const_iterator& __it)
+{
+ erase(iterator(const_cast<_Node*>(__it._M_cur),
+ const_cast<hashtable*>(__it._M_ht)));
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::resize(size_type __num_elements_hint)
+{
+ const size_type __old_n = _M_buckets.size();
+ if (__num_elements_hint > __old_n) {
+ const size_type __n = _M_next_size(__num_elements_hint);
+ if (__n > __old_n) {
+ _M_buckets_type __tmp(
+ __n, (_Node*)(0)
+ @KWSYS_NAMESPACE@_HASH_BUCKETS_GET_ALLOCATOR(_M_buckets));
+ try {
+ for (size_type __bucket = 0; __bucket < __old_n; ++__bucket) {
+ _Node* __first = _M_buckets[__bucket];
+ while (__first) {
+ size_type __new_bucket = _M_bkt_num(__first->_M_val, __n);
+ _M_buckets[__bucket] = __first->_M_next;
+ __first->_M_next = __tmp[__new_bucket];
+ __tmp[__new_bucket] = __first;
+ __first = _M_buckets[__bucket];
+ }
+ }
+ _M_buckets.swap(__tmp);
+ }
+ catch(...) {
+ for (size_type __bucket = 0; __bucket < __tmp.size(); ++__bucket) {
+ while (__tmp[__bucket]) {
+ _Node* __next = __tmp[__bucket]->_M_next;
+ _M_delete_node(__tmp[__bucket]);
+ __tmp[__bucket] = __next;
+ }
+ }
+ throw;
+ }
+ }
+ }
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::_M_erase_bucket(const size_type __n, _Node* __first, _Node* __last)
+{
+ _Node* __cur = _M_buckets[__n];
+ if (__cur == __first)
+ _M_erase_bucket(__n, __last);
+ else {
+ _Node* __next;
+ for (__next = __cur->_M_next;
+ __next != __first;
+ __cur = __next, __next = __cur->_M_next)
+ ;
+ while (__next != __last) {
+ __cur->_M_next = __next->_M_next;
+ _M_delete_node(__next);
+ __next = __cur->_M_next;
+ --_M_num_elements;
+ }
+ }
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::_M_erase_bucket(const size_type __n, _Node* __last)
+{
+ _Node* __cur = _M_buckets[__n];
+ while (__cur != __last) {
+ _Node* __next = __cur->_M_next;
+ _M_delete_node(__cur);
+ __cur = __next;
+ _M_buckets[__n] = __cur;
+ --_M_num_elements;
+ }
+}
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>::clear()
+{
+ for (size_type __i = 0; __i < _M_buckets.size(); ++__i) {
+ _Node* __cur = _M_buckets[__i];
+ while (__cur != 0) {
+ _Node* __next = __cur->_M_next;
+ _M_delete_node(__cur);
+ __cur = __next;
+ }
+ _M_buckets[__i] = 0;
+ }
+ _M_num_elements = 0;
+}
+
+
+template <class _Val, class _Key, class _HF, class _Ex, class _Eq, class _All>
+void hashtable<_Val,_Key,_HF,_Ex,_Eq,_All>
+ ::_M_copy_from(const hashtable& __ht)
+{
+ _M_buckets.clear();
+ _M_buckets.reserve(__ht._M_buckets.size());
+ _M_buckets.insert(_M_buckets.end(), __ht._M_buckets.size(), (_Node*) 0);
+ try {
+ for (size_type __i = 0; __i < __ht._M_buckets.size(); ++__i) {
+ const _Node* __cur = __ht._M_buckets[__i];
+ if (__cur) {
+ _Node* __copy = _M_new_node(__cur->_M_val);
+ _M_buckets[__i] = __copy;
+
+ for (_Node* __next = __cur->_M_next;
+ __next;
+ __cur = __next, __next = __cur->_M_next) {
+ __copy->_M_next = _M_new_node(__next->_M_val);
+ __copy = __copy->_M_next;
+ }
+ }
+ }
+ _M_num_elements = __ht._M_num_elements;
+ }
+ catch(...) {clear(); throw;}
+}
+
+} // namespace @KWSYS_NAMESPACE@
+
+// Normally the comparison operators should be found in the @KWSYS_NAMESPACE@
+// namespace by argument dependent lookup. For compilers that do not
+// support it we must bring them into the global namespace now.
+#if !@KWSYS_NAMESPACE@_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP
+using @KWSYS_NAMESPACE@::operator==;
+using @KWSYS_NAMESPACE@::operator!=;
+#endif
+
+#if defined(_MSC_VER)
+# pragma warning (pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsysHeaderDump.pl b/Utilities/ITK/Utilities/kwsys/kwsysHeaderDump.pl
new file mode 100644
index 0000000000000000000000000000000000000000..4631b9187b2b3b749d10d4461f5ddcfd7baf4d17
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsysHeaderDump.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+#
+# Program: KWSys - Kitware System Library
+# Module: $RCSfile: kwsysHeaderDump.pl,v $
+#
+# Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+# See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+#
+# This software is distributed WITHOUT ANY WARRANTY; without even
+# the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+# PURPOSE. See the above copyright notices for more information.
+#
+
+if ( $#ARGV+1 < 2 )
+{
+ print "Usage: ./kwsysHeaderDump.pl <name> <header>\n";
+ exit(1);
+}
+
+$name = $ARGV[0];
+$max = 0;
+open(INFILE, $ARGV[1]);
+while (chomp ($line = <INFILE>))
+{
+ if (($line !~ /^\#/) &&
+ ($line =~ s/.*kwsys${name}_([A-Za-z0-9_]*).*/\1/) &&
+ ($i{$line}++ < 1))
+ {
+ push(@lines, "$line");
+ if (length($line) > $max)
+ {
+ $max = length($line);
+ }
+ }
+}
+close(INFILE);
+
+$width = $max + 13;
+print sprintf("#define %-${width}s kwsys_ns(${name})\n", "kwsys${name}");
+foreach $l (@lines)
+{
+ print sprintf("#define %-${width}s kwsys_ns(${name}_$l)\n",
+ "kwsys${name}_$l");
+}
+print "\n";
+print sprintf("# undef kwsys${name}\n");
+foreach $l (@lines)
+{
+ print sprintf("# undef kwsys${name}_$l\n");
+}
diff --git a/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cmake b/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..6da82d6cbf29aa3a3c88bed5d02f254ffd0e32ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cmake
@@ -0,0 +1,43 @@
+MACRO(KWSYS_PLATFORM_CXX_TEST var description invert)
+ IF("${var}_COMPILED" MATCHES "^${var}_COMPILED$")
+ MESSAGE(STATUS "${description}")
+ TRY_COMPILE(${var}_COMPILED
+ ${CMAKE_CURRENT_BINARY_DIR}
+ ${CMAKE_CURRENT_SOURCE_DIR}/kwsysPlatformCxxTests.cxx
+ COMPILE_DEFINITIONS -DTEST_${var} ${KWSYS_PLATFORM_CXX_TEST_DEFINES}
+ OUTPUT_VARIABLE OUTPUT)
+ IF(${var}_COMPILED)
+ FILE(APPEND ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeOutput.log
+ "${description} compiled with the following output:\n${OUTPUT}\n\n")
+ ELSE(${var}_COMPILED)
+ FILE(APPEND ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/CMakeError.log
+ "${description} failed to compile with the following output:\n${OUTPUT}\n\n")
+ ENDIF(${var}_COMPILED)
+ IF(${invert} MATCHES INVERT)
+ IF(${var}_COMPILED)
+ MESSAGE(STATUS "${description} - no")
+ ELSE(${var}_COMPILED)
+ MESSAGE(STATUS "${description} - yes")
+ ENDIF(${var}_COMPILED)
+ ELSE(${invert} MATCHES INVERT)
+ IF(${var}_COMPILED)
+ MESSAGE(STATUS "${description} - yes")
+ ELSE(${var}_COMPILED)
+ MESSAGE(STATUS "${description} - no")
+ ENDIF(${var}_COMPILED)
+ ENDIF(${invert} MATCHES INVERT)
+ ENDIF("${var}_COMPILED" MATCHES "^${var}_COMPILED$")
+ IF(${invert} MATCHES INVERT)
+ IF(${var}_COMPILED)
+ SET(${var} 0)
+ ELSE(${var}_COMPILED)
+ SET(${var} 1)
+ ENDIF(${var}_COMPILED)
+ ELSE(${invert} MATCHES INVERT)
+ IF(${var}_COMPILED)
+ SET(${var} 1)
+ ELSE(${var}_COMPILED)
+ SET(${var} 0)
+ ENDIF(${var}_COMPILED)
+ ENDIF(${invert} MATCHES INVERT)
+ENDMACRO(KWSYS_PLATFORM_CXX_TEST)
diff --git a/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cxx b/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e9216765c6ceef2b0893aa2da32885e5f9f10e98
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsysPlatformCxxTests.cxx
@@ -0,0 +1,363 @@
+// Setup for tests that use result of stl namespace test.
+#if defined(KWSYS_STL_HAVE_STD)
+# if KWSYS_STL_HAVE_STD
+# define kwsys_stl std
+# else
+# define kwsys_stl
+# endif
+#endif
+
+#ifdef TEST_KWSYS_STL_HAVE_STD
+#include <list>
+void f(std::list<int>*) {}
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_IOS_USE_ANSI
+#include <iosfwd>
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_IOS_HAVE_STD
+#include <iosfwd>
+void f(std::ostream*) {}
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_IOS_USE_SSTREAM
+#include <sstream>
+int main()
+{
+ std::ostringstream ostr;
+ ostr << "hello";
+ if(ostr.str().size() == 5)
+ {
+ return 0;
+ }
+ return -1;
+}
+#endif
+
+#ifdef TEST_KWSYS_IOS_USE_STRSTREAM_H
+#include <strstream.h>
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_IOS_USE_STRSTREA_H
+#include <strstrea.h>
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_STRING_HAVE_OSTREAM
+# include <iostream.h>
+# include <string>
+void f(ostream& os, const kwsys_stl::string& s) { os << s; }
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_STRING_HAVE_ISTREAM
+# include <iostream.h>
+# include <string>
+void f(istream& is, kwsys_stl::string& s) { is >> s; }
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_STRING_HAVE_NEQ_CHAR
+# include <string>
+bool f(const kwsys_stl::string& s) { return s != ""; }
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_CXX_HAS_CSTDDEF
+#include <cstddef>
+void f(size_t) {}
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_CXX_HAS_NULL_TEMPLATE_ARGS
+template <class T> class A;
+template <class T> int f(A<T>&);
+template <class T> class A
+{
+public:
+ // "friend int f<>(A<T>&)" would conform
+ friend int f(A<T>&);
+private:
+ int x;
+};
+
+template <class T> int f(A<T>& a) { return a.x = 0; }
+template int f(A<int>&);
+
+int main()
+{
+ A<int> a;
+ return f(a);
+}
+#endif
+
+#ifdef TEST_KWSYS_CXX_HAS_MEMBER_TEMPLATES
+template <class U>
+class A
+{
+public:
+ U u;
+ A(): u(0) {}
+ template <class V> V m(V* p) { return *p = u; }
+};
+
+int main()
+{
+ A<short> a;
+ int s = 1;
+ return a.m(&s);
+}
+#endif
+
+#ifdef TEST_KWSYS_CXX_HAS_FULL_SPECIALIZATION
+template <class T> struct A {};
+template <> struct A<int*>
+{
+ static int f() { return 0; }
+};
+int main() { return A<int*>::f(); }
+#endif
+
+#ifdef TEST_KWSYS_CXX_HAS_ARGUMENT_DEPENDENT_LOOKUP
+namespace N
+{
+ class A {};
+ int f(A*) { return 0; }
+}
+void f(void*);
+int main()
+{
+ N::A* a = 0;
+ return f(a);
+}
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ITERATOR_TRAITS
+#include <iterator>
+#include <list>
+void f(kwsys_stl::iterator_traits<kwsys_stl::list<int>::iterator>::iterator_category const&) {}
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ITERATOR_CATEGORY
+#include <iterator>
+#include <list>
+void f(kwsys_stl::list<int>::iterator x) { kwsys_stl::iterator_category(x); }
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS___ITERATOR_CATEGORY
+#include <iterator>
+#include <list>
+void f(kwsys_stl::list<int>::iterator x) { kwsys_stl::__iterator_category(x); }
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ALLOCATOR_TEMPLATE
+#include <memory>
+template <class Alloc>
+void f(const Alloc&)
+{
+ typedef typename Alloc::size_type alloc_size_type;
+}
+int main()
+{
+ f(kwsys_stl::allocator<char>());
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ALLOCATOR_NONTEMPLATE
+#include <memory>
+void f(kwsys_stl::allocator::size_type const&) {}
+int main() { return 0; }
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ALLOCATOR_REBIND
+#include <memory>
+template <class T, class Alloc>
+void f(const T&, const Alloc&)
+{
+ typedef typename Alloc::template rebind<T>::other alloc_type;
+}
+int main()
+{
+ f(0, kwsys_stl::allocator<char>());
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ALLOCATOR_MAX_SIZE_ARGUMENT
+#include <memory>
+void f(kwsys_stl::allocator<char> const& a)
+{
+ a.max_size(sizeof(int));
+}
+int main()
+{
+ f(kwsys_stl::allocator<char>());
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_STL_HAS_ALLOCATOR_OBJECTS
+#include <vector>
+void f(kwsys_stl::vector<int> const& v1)
+{
+ kwsys_stl::vector<int>(1, 1, v1.get_allocator());
+}
+int main()
+{
+ f(kwsys_stl::vector<int>());
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_STAT_HAS_ST_MTIM
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+int main()
+{
+ struct stat stat1;
+ (void)stat1.st_mtim.tv_sec;
+ (void)stat1.st_mtim.tv_nsec;
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_CXX_SAME_LONG_AND___INT64
+void function(long**) {}
+int main()
+{
+ __int64** p = 0;
+ function(p);
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_CXX_SAME_LONG_LONG_AND___INT64
+void function(long long**) {}
+int main()
+{
+ __int64** p = 0;
+ function(p);
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_CAN_CONVERT_UI64_TO_DOUBLE
+void function(double& l, unsigned __int64 const& r)
+{
+ l = static_cast<double>(r);
+}
+
+int main()
+{
+ double tTo = 0.0;
+ unsigned __int64 tFrom = 0;
+ function(tTo, tFrom);
+ return 0;
+}
+#endif
+
+#ifdef TEST_KWSYS_CHAR_IS_SIGNED
+/* Return 1 for char signed and 0 for char unsigned. */
+int main()
+{
+ unsigned char uc = 255;
+ return (*reinterpret_cast<char*>(&uc) < 0)?1:0;
+}
+#endif
+
+#ifdef TEST_KWSYS_CXX_TYPE_INFO
+/* Collect fundamental type information and save it to a CMake script. */
+
+/* Include limits.h to get macros indicating long long and __int64.
+ Note that certain compilers need special macros to define these
+ macros in limits.h. */
+#if defined(_MSC_VER) && !defined(_MSC_EXTENSIONS)
+# define _MSC_EXTENSIONS
+#endif
+#if defined(__GNUC__) && __GNUC__ < 3
+# define _GNU_SOURCE
+#endif
+#include <limits.h>
+
+#include <stdio.h>
+#include <string.h>
+
+/* Due to shell differences and limitations of ADD_DEFINITIONS the
+ KWSYS_CXX_TYPE_INFO_FILE macro will sometimes have double quotes
+ and sometimes not. This macro will make sure the value is treated
+ as a double-quoted string. */
+#define TO_STRING(x) TO_STRING0(x)
+#define TO_STRING0(x) TO_STRING1(x)
+#define TO_STRING1(x) #x
+
+void f() {}
+
+int main()
+{
+ /* Construct the output file name. Some preprocessors will add an
+ extra level of double quotes, so strip them. */
+ char fbuf[] = TO_STRING(KWSYS_CXX_TYPE_INFO_FILE);
+ char* fname = fbuf;
+ if(fname[0] == '"')
+ {
+ ++fname;
+ int len = static_cast<int>(strlen(fname));
+ if(len > 0 && fname[len-1] == '"')
+ {
+ fname[len-1] = 0;
+ }
+ }
+
+ /* Try to open the output file. */
+ if(FILE* fout = fopen(fname, "w"))
+ {
+ /* Set the size of standard types. */
+ fprintf(fout, "SET(KWSYS_SIZEOF_CHAR %d)\n", static_cast<int>(sizeof(char)));
+ fprintf(fout, "SET(KWSYS_SIZEOF_SHORT %d)\n", static_cast<int>(sizeof(short)));
+ fprintf(fout, "SET(KWSYS_SIZEOF_INT %d)\n", static_cast<int>(sizeof(int)));
+ fprintf(fout, "SET(KWSYS_SIZEOF_LONG %d)\n", static_cast<int>(sizeof(long)));
+
+ /* Set the size of some non-standard but common types. */
+ /* Check for a limits.h macro for long long to see if the type exists. */
+#if defined(LLONG_MAX) || defined(LONG_LONG_MAX) || defined(LONGLONG_MAX)
+ fprintf(fout, "SET(KWSYS_SIZEOF_LONG_LONG %d)\n", static_cast<int>(sizeof(long long)));
+#else
+ fprintf(fout, "SET(KWSYS_SIZEOF_LONG_LONG 0) # No long long available.\n");
+#endif
+ /* Check for a limits.h macro for __int64 to see if the type exists. */
+#if defined(_I64_MIN)
+ fprintf(fout, "SET(KWSYS_SIZEOF___INT64 %d)\n", static_cast<int>(sizeof(__int64)));
+#else
+ fprintf(fout, "SET(KWSYS_SIZEOF___INT64 0) # No __int64 available.\n");
+#endif
+
+ /* Set the size of some pointer types. */
+ fprintf(fout, "SET(KWSYS_SIZEOF_PDATA %d)\n", static_cast<int>(sizeof(void*)));
+ fprintf(fout, "SET(KWSYS_SIZEOF_PFUNC %d)\n", static_cast<int>(sizeof(&f)));
+
+ /* Set whether the native type "char" is signed or unsigned. */
+ unsigned char uc = 255;
+ fprintf(fout, "SET(KWSYS_CHAR_IS_SIGNED %d)\n",
+ (*reinterpret_cast<char*>(&uc) < 0)?1:0);
+
+ fclose(fout);
+ return 0;
+ }
+ else
+ {
+ fprintf(stderr, "Failed to write fundamental type info to \"%s\".\n",
+ fname);
+ return 1;
+ }
+}
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsysPrivate.h b/Utilities/ITK/Utilities/kwsys/kwsysPrivate.h
new file mode 100644
index 0000000000000000000000000000000000000000..1b614c9bec6e27013fa4a813c3d0999157a2dd6e
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsysPrivate.h
@@ -0,0 +1,43 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsysPrivate.h,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef KWSYS_NAMESPACE
+# error "Do not include kwsysPrivate.h outside of kwsys c and cxx files."
+#endif
+
+#ifndef _kwsysPrivate_h
+#define _kwsysPrivate_h
+
+/*
+ Define KWSYS_HEADER macro to help the c and cxx files include kwsys
+ headers from the configured namespace directory. The macro can be
+ used like this:
+
+ #include KWSYS_HEADER(Directory.hxx)
+ #include KWSYS_HEADER(std/vector)
+*/
+#define KWSYS_HEADER(x) KWSYS_HEADER0(KWSYS_NAMESPACE/x)
+#define KWSYS_HEADER0(x) KWSYS_HEADER1(x)
+#define KWSYS_HEADER1(x) <x>
+
+/*
+ Define KWSYS_NAMESPACE_STRING to be a string constant containing the
+ name configured for this instance of the kwsys library.
+*/
+#define KWSYS_NAMESPACE_STRING KWSYS_NAMESPACE_STRING0(KWSYS_NAMESPACE)
+#define KWSYS_NAMESPACE_STRING0(x) KWSYS_NAMESPACE_STRING1(x)
+#define KWSYS_NAMESPACE_STRING1(x) #x
+
+#else
+# error "kwsysPrivate.h included multiple times."
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_cstddef.hxx.in b/Utilities/ITK/Utilities/kwsys/kwsys_cstddef.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..2c957593f7f0841498af9bb79b9b40ef7eea8a9b
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_cstddef.hxx.in
@@ -0,0 +1,37 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_cstddef.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_cstddef
+#define @KWSYS_NAMESPACE@_cstddef
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+/* Avoid warnings in MSVC standard headers. */
+#ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# pragma warning (disable: 4786)
+#endif
+
+/* Include the real header. */
+#if @KWSYS_NAMESPACE@_CXX_HAS_CSTDDEF
+# include <cstddef>
+#else
+# include <stddef.h>
+#endif
+
+#ifdef _MSC_VER
+# pragma warning(pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_ios_fstream.h.in b/Utilities/ITK/Utilities/kwsys/kwsys_ios_fstream.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..b20ac0e92ebe562724b98b6f262791ad0c6b8ac6
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_ios_fstream.h.in
@@ -0,0 +1,48 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_ios_fstream.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_ios_fstream
+#define @KWSYS_NAMESPACE@_ios_fstream
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# pragma warning (disable: 4995) /* Old streams are deprecated. */
+#endif
+
+#if @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# include <fstream>
+#else
+# include <fstream.h>
+#endif
+
+#if !@KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+namespace @KWSYS_NAMESPACE@_ios
+{
+ using @KWSYS_NAMESPACE@_ios_namespace::ostream;
+ using @KWSYS_NAMESPACE@_ios_namespace::istream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ofstream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ifstream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ios;
+ using @KWSYS_NAMESPACE@_ios_namespace::endl;
+ using @KWSYS_NAMESPACE@_ios_namespace::flush;
+}
+#endif
+
+#ifdef _MSC_VER
+# pragma warning(pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_ios_iosfwd.h.in b/Utilities/ITK/Utilities/kwsys/kwsys_ios_iosfwd.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..484fddaa3f9c51b2a9e6e15145c6df8f13e976db
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_ios_iosfwd.h.in
@@ -0,0 +1,51 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_ios_iosfwd.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_ios_iosfwd
+#define @KWSYS_NAMESPACE@_ios_iosfwd
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#ifdef _MSC_VER
+#pragma warning (push, 1)
+#pragma warning (disable: 4702)
+#endif
+
+#if @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# include <iosfwd>
+#else
+class fstream;
+class ifstream;
+class ios;
+class istream;
+class ofstream;
+class ostream;
+#endif
+
+#if !@KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+namespace @KWSYS_NAMESPACE@_ios
+{
+ using @KWSYS_NAMESPACE@_ios_namespace::fstream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ifstream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ios;
+ using @KWSYS_NAMESPACE@_ios_namespace::istream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ofstream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ostream;
+}
+#endif
+
+#ifdef _MSC_VER
+#pragma warning(pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_ios_iostream.h.in b/Utilities/ITK/Utilities/kwsys/kwsys_ios_iostream.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..c8303ac4ec3137c0bb1e478f588d3611e4549527
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_ios_iostream.h.in
@@ -0,0 +1,49 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_ios_iostream.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_ios_iostream
+#define @KWSYS_NAMESPACE@_ios_iostream
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+#ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# pragma warning (disable: 4995) /* Old streams are deprecated. */
+#endif
+
+#if @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# include <iostream>
+#else
+# include <iostream.h>
+#endif
+
+#if !@KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+namespace @KWSYS_NAMESPACE@_ios
+{
+ using @KWSYS_NAMESPACE@_ios_namespace::ostream;
+ using @KWSYS_NAMESPACE@_ios_namespace::istream;
+ using @KWSYS_NAMESPACE@_ios_namespace::ios;
+ using @KWSYS_NAMESPACE@_ios_namespace::cout;
+ using @KWSYS_NAMESPACE@_ios_namespace::cerr;
+ using @KWSYS_NAMESPACE@_ios_namespace::cin;
+ using @KWSYS_NAMESPACE@_ios_namespace::endl;
+ using @KWSYS_NAMESPACE@_ios_namespace::flush;
+}
+#endif
+
+#ifdef _MSC_VER
+# pragma warning(pop)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_ios_sstream.h.in b/Utilities/ITK/Utilities/kwsys/kwsys_ios_sstream.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..a4f7eca383187ba7e18180e9aeffecdb67ee33a6
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_ios_sstream.h.in
@@ -0,0 +1,146 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_ios_sstream.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_ios_sstream
+#define @KWSYS_NAMESPACE@_ios_sstream
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+/* Define this macro temporarily to keep the code readable. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# define kwsys_stl @KWSYS_NAMESPACE@_stl
+#endif
+
+#if @KWSYS_NAMESPACE@_IOS_USE_SSTREAM
+# ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# endif
+# include <sstream>
+# ifdef _MSC_VER
+# pragma warning(pop)
+# endif
+#else
+# ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# pragma warning (disable: 4995) /* Old streams are deprecated. */
+# endif
+# if @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# include <strstream>
+# elif @KWSYS_NAMESPACE@_IOS_USE_STRSTREAM_H
+# include <strstream.h>
+# elif @KWSYS_NAMESPACE@_IOS_USE_STRSTREA_H
+# include <strstrea.h>
+# endif
+# if @KWSYS_NAMESPACE@_IOS_USE_ANSI
+# include <new> // Need placement operator new.
+# else
+# include <new.h> // Need placement operator new.
+# endif
+# ifdef _MSC_VER
+# pragma warning(pop)
+# endif
+
+// Only have old std::strstream classes. Wrap them to look like new
+// ostringstream and istringstream classes.
+
+# include <@KWSYS_NAMESPACE@/stl/string>
+
+namespace @KWSYS_NAMESPACE@_ios
+{
+using @KWSYS_NAMESPACE@_ios_namespace::streambuf;
+using @KWSYS_NAMESPACE@_ios_namespace::ostream;
+using @KWSYS_NAMESPACE@_ios_namespace::istream;
+using @KWSYS_NAMESPACE@_ios_namespace::istrstream;
+using @KWSYS_NAMESPACE@_ios_namespace::ostrstream;
+using @KWSYS_NAMESPACE@_ios_namespace::ios;
+using @KWSYS_NAMESPACE@_ios_namespace::endl;
+using @KWSYS_NAMESPACE@_ios_namespace::ends;
+using @KWSYS_NAMESPACE@_ios_namespace::flush;
+
+class ostringstream_cleanup
+{
+public:
+ ostringstream_cleanup(ostrstream& ostr): m_OStrStream(ostr) {}
+ ~ostringstream_cleanup() { m_OStrStream.rdbuf()->freeze(0); }
+ static void IgnoreUnusedVariable(const ostringstream_cleanup&) {}
+protected:
+ ostrstream& m_OStrStream;
+private:
+ void operator=(ostringstream_cleanup const&);
+};
+
+class ostringstream: public ostrstream
+{
+public:
+ typedef ostrstream Superclass;
+ ostringstream() {}
+ ostringstream(const kwsys_stl::string& s) { *this << s.c_str(); }
+ kwsys_stl::string str()
+ {
+ ostringstream_cleanup cleanup(*this);
+ ostringstream_cleanup::IgnoreUnusedVariable(cleanup);
+ int pcount = this->pcount();
+ const char* ptr = this->Superclass::str();
+ return kwsys_stl::string(ptr?ptr:"", pcount);
+ }
+ void str(const kwsys_stl::string& s)
+ {
+ this->~ostringstream();
+ new (this) ostringstream(s);
+ }
+private:
+ ostringstream(const ostringstream&);
+ void operator=(const ostringstream&);
+};
+
+#if defined(_MSC_VER)
+# pragma warning (push)
+# pragma warning (disable: 4097) /* typedef-name used as synonym for class */
+#endif
+
+class istringstream: private kwsys_stl::string, public istrstream
+{
+public:
+ typedef kwsys_stl::string StdString;
+ typedef istrstream IStrStream;
+ istringstream(): StdString(),
+ IStrStream(const_cast<char*>(StdString::c_str())) {}
+ istringstream(const kwsys_stl::string& s):
+ StdString(s), IStrStream(const_cast<char*>(StdString::c_str())) {}
+ kwsys_stl::string str() const { return *this; }
+ void str(const kwsys_stl::string& s)
+ {
+ this->~istringstream();
+ new (this) istringstream(s);
+ }
+private:
+ istringstream(const istringstream&);
+ void operator=(const istringstream&);
+};
+
+#if defined(_MSC_VER)
+# pragma warning (pop)
+#endif
+
+} // namespace @KWSYS_NAMESPACE@_ios
+
+#endif
+
+/* Undefine temporary macro. */
+#if !defined (KWSYS_NAMESPACE) && !@KWSYS_NAMESPACE@_NAME_IS_KWSYS
+# undef kwsys_stl
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_stl.hxx.in b/Utilities/ITK/Utilities/kwsys/kwsys_stl.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..8c2d9ea02485831a065d8e4f3510b8e64fe3abaa
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_stl.hxx.in
@@ -0,0 +1,51 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_stl.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_stl_@KWSYS_STL_HEADER@
+#define @KWSYS_NAMESPACE@_stl_@KWSYS_STL_HEADER@
+
+#include <@KWSYS_NAMESPACE@/Configure.hxx>
+
+/* Avoid warnings in MSVC standard headers. */
+#ifdef _MSC_VER
+# pragma warning (push, 1)
+# pragma warning (disable: 4702)
+# pragma warning (disable: 4786)
+#endif
+
+/* The HP standard library defines the functor "times" instead of
+ "multiplies" as specified by C++98 20.3.2 for backward
+ compatibility with earlier specifications. Defining this macro
+ fixes this behavior. The name "times" also conflicts with the
+ function declared in sys/times.h on that platform, so we must do
+ this as a work-around anyway. */
+#if defined(__HP_aCC) && !defined(__HPACC_USING_MULTIPLIES_IN_FUNCTIONAL)
+# define __HPACC_USING_MULTIPLIES_IN_FUNCTIONAL
+# define @KWSYS_NAMESPACE@_DEFINED___HPACC_USING_MULTIPLIES_IN_FUNCTIONAL
+#endif
+
+/* Include the real header. */
+#include <@KWSYS_STL_HEADER@>
+
+/* Cleanup. */
+#if defined(@KWSYS_NAMESPACE@_DEFINED___HPACC_USING_MULTIPLIES_IN_FUNCTIONAL)
+# undef @KWSYS_NAMESPACE@_DEFINED___HPACC_USING_MULTIPLIES_IN_FUNCTIONAL
+# undef __HPACC_USING_MULTIPLIES_IN_FUNCTIONAL
+#endif
+
+#ifdef _MSC_VER
+# pragma warning(pop)
+#endif
+
+@KWSYS_STL_HEADER_EXTRA@
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/kwsys_stl_string.hxx.in b/Utilities/ITK/Utilities/kwsys/kwsys_stl_string.hxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..2c9b316c657d31fbd006ef802c600a61e293c8f0
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/kwsys_stl_string.hxx.in
@@ -0,0 +1,114 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: kwsys_stl_string.hxx.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+
+// This header is extra code for <@KWSYS_NAMESPACE@/stl/string>.
+#if !defined(@KWSYS_NAMESPACE@_stl_string_including_hxx)
+# error "The header <@KWSYS_NAMESPACE@/stl/string.hxx> may be included only by <@KWSYS_NAMESPACE@/stl/string>."
+#endif
+
+// Provide the istream operator for the stl string if it is not
+// provided by the system or another copy of kwsys. Allow user code
+// to block this definition by defining the macro
+// @KWSYS_NAMESPACE@_STL_STRING_NO_ISTREAM
+// to avoid conflicts with other libraries. User code can test for
+// this definition by checking the macro
+// @KWSYS_NAMESPACE@_STL_STRING_ISTREAM_DEFINED
+#if !@KWSYS_NAMESPACE@_STL_STRING_HAVE_ISTREAM && !defined(@KWSYS_NAMESPACE@_STL_STRING_NO_ISTREAM) && !defined(KWSYS_STL_STRING_ISTREAM_DEFINED)
+# define KWSYS_STL_STRING_ISTREAM_DEFINED
+# define @KWSYS_NAMESPACE@_STL_STRING_ISTREAM_DEFINED
+# include <ctype.h> // isspace
+# include <@KWSYS_NAMESPACE@/ios/iostream>
+inline @KWSYS_NAMESPACE@_ios::istream&
+operator>>(@KWSYS_NAMESPACE@_ios::istream& is,
+ @KWSYS_NAMESPACE@_stl::string& s)
+{
+ // Keep track of the resulting state.
+ int state = @KWSYS_NAMESPACE@_ios::ios::goodbit;
+
+ // Save the width setting and set it back to zero.
+ size_t n = static_cast<size_t>(is.width(0));
+
+ // Clear any old contents of the output string.
+ s.erase();
+
+ // Skip leading whitespace.
+ is.eatwhite();
+ istream& okay = is;
+
+ if(okay)
+ {
+ // Select a maximum possible length.
+ if(n == 0 || n >= s.max_size())
+ {
+ n = s.max_size();
+ }
+
+ // Read until a space is found or the maximum length is reached.
+ bool success = false;
+ for(int c = is.peek(); (--n > 0 && c != EOF && !isspace(c)); c = is.peek())
+ {
+ s += static_cast<char>(c);
+ success = true;
+ is.ignore();
+ }
+
+ // Set flags for resulting state.
+ if(is.peek() == EOF) { state |= @KWSYS_NAMESPACE@_ios::ios::eofbit; }
+ if(success) { state |= @KWSYS_NAMESPACE@_ios::ios::failbit; }
+ }
+
+ // Set the final result state.
+ is.clear(state);
+ return is;
+}
+#endif
+
+// Provide the ostream operator for the stl string if it is not
+// provided by the system or another copy of kwsys. Allow user code
+// to block this definition by defining the macro
+// @KWSYS_NAMESPACE@_STL_STRING_NO_OSTREAM
+// to avoid conflicts with other libraries. User code can test for
+// this definition by checking the macro
+// @KWSYS_NAMESPACE@_STL_STRING_OSTREAM_DEFINED
+#if !@KWSYS_NAMESPACE@_STL_STRING_HAVE_OSTREAM && !defined(@KWSYS_NAMESPACE@_STL_STRING_NO_OSTREAM) && !defined(KWSYS_STL_STRING_OSTREAM_DEFINED)
+# define KWSYS_STL_STRING_OSTREAM_DEFINED
+# define @KWSYS_NAMESPACE@_STL_STRING_OSTREAM_DEFINED
+# include <@KWSYS_NAMESPACE@/ios/iostream>
+inline @KWSYS_NAMESPACE@_ios::ostream&
+operator<<(@KWSYS_NAMESPACE@_ios::ostream& os,
+ @KWSYS_NAMESPACE@_stl::string const& s)
+{
+ return os << s.c_str();
+}
+#endif
+
+// Provide the operator!= for the stl string and char* if it is not
+// provided by the system or another copy of kwsys. Allow user code
+// to block this definition by defining the macro
+// @KWSYS_NAMESPACE@_STL_STRING_NO_NEQ_CHAR
+// to avoid conflicts with other libraries. User code can test for
+// this definition by checking the macro
+// @KWSYS_NAMESPACE@_STL_STRING_NEQ_CHAR_DEFINED
+#if !@KWSYS_NAMESPACE@_STL_STRING_HAVE_NEQ_CHAR && !defined(@KWSYS_NAMESPACE@_STL_STRING_NO_NEQ_CHAR) && !defined(KWSYS_STL_STRING_NEQ_CHAR_DEFINED)
+# define KWSYS_STL_STRING_NEQ_CHAR_DEFINED
+# define @KWSYS_NAMESPACE@_STL_STRING_NEQ_CHAR_DEFINED
+inline bool operator!=(@KWSYS_NAMESPACE@_stl::string const& s, const char* c)
+{
+ return !(s == c);
+}
+inline bool operator!=(const char* c, @KWSYS_NAMESPACE@_stl::string const& s)
+{
+ return !(s == c);
+}
+#endif
diff --git a/Utilities/ITK/Utilities/kwsys/testCommandLineArguments.cxx b/Utilities/ITK/Utilities/kwsys/testCommandLineArguments.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ea68016b856d3f0e2b6cbcad50b7c20fda40f39d
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testCommandLineArguments.cxx
@@ -0,0 +1,119 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testCommandLineArguments.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(CommandLineArguments.hxx)
+#include KWSYS_HEADER(ios/iostream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "CommandLineArguments.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+void* random_ptr = reinterpret_cast<void*>(0x123);
+
+int argument(const char* arg, const char* value, void* call_data)
+{
+ kwsys_ios::cout << "Got argument: \"" << arg << "\" value: \"" << (value?value:"(null)") << "\"" << kwsys_ios::endl;
+ if ( call_data != random_ptr )
+ {
+ kwsys_ios::cerr << "Problem processing call_data" << kwsys_ios::endl;
+ return 0;
+ }
+ return 1;
+}
+
+int unknown_argument(const char* argument, void* call_data)
+{
+ kwsys_ios::cout << "Got unknown argument: \"" << argument << "\"" << kwsys_ios::endl;
+ if ( call_data != random_ptr )
+ {
+ kwsys_ios::cerr << "Problem processing call_data" << kwsys_ios::endl;
+ return 0;
+ }
+ return 1;
+}
+
+int main(int argc, char* argv[])
+{
+ // Example run: ./testCommandLineArguments --some-int-variable 4
+ // --another-bool-variable --some-bool-variable=yes
+ // --some-stl-string-variable=foobar --set-bool-arg1 --set-bool-arg2
+ // --some-string-variable=hello
+
+ int res = 0;
+ kwsys::CommandLineArguments arg;
+ arg.Initialize(argc, argv);
+
+ // For error handling
+ arg.SetClientData(random_ptr);
+ arg.SetUnknownArgumentCallback(unknown_argument);
+
+ int some_int_variable = 10;
+ double some_double_variable = 10.10;
+ char* some_string_variable = 0;
+ kwsys_stl::string some_stl_string_variable = "";
+ bool some_bool_variable = false;
+ bool some_bool_variable1 = false;
+ bool bool_arg1 = false;
+ int bool_arg2 = 0;
+
+ typedef kwsys::CommandLineArguments argT;
+
+ arg.AddArgument("--some-int-variable", argT::SPACE_ARGUMENT, &some_int_variable, "Set some random int variable");
+ arg.AddArgument("--some-double-variable", argT::CONCAT_ARGUMENT, &some_double_variable, "Set some random double variable");
+ arg.AddArgument("--some-string-variable", argT::EQUAL_ARGUMENT, &some_string_variable, "Set some random string variable");
+ arg.AddArgument("--some-stl-string-variable", argT::EQUAL_ARGUMENT, &some_stl_string_variable, "Set some random stl string variable");
+ arg.AddArgument("--some-bool-variable", argT::EQUAL_ARGUMENT, &some_bool_variable, "Set some random bool variable");
+ arg.AddArgument("--another-bool-variable", argT::NO_ARGUMENT, &some_bool_variable1, "Set some random bool variable 1");
+ arg.AddBooleanArgument("--set-bool-arg1", &bool_arg1, "Test AddBooleanArgument 1");
+ arg.AddBooleanArgument("--set-bool-arg2", &bool_arg2, "Test AddBooleanArgument 2");
+
+ arg.AddCallback("-A", argT::NO_ARGUMENT, argument, random_ptr, "Some option -A. This option has a multiline comment. It should demonstrate how the code splits lines.");
+ arg.AddCallback("-B", argT::SPACE_ARGUMENT, argument, random_ptr, "Option -B takes argument with space");
+ arg.AddCallback("-C", argT::EQUAL_ARGUMENT, argument, random_ptr, "Option -C takes argument after =");
+ arg.AddCallback("-D", argT::CONCAT_ARGUMENT, argument, random_ptr, "This option takes concatinated argument");
+ arg.AddCallback("--long1", argT::NO_ARGUMENT, argument, random_ptr, "-A");
+ arg.AddCallback("--long2", argT::SPACE_ARGUMENT, argument, random_ptr, "-B");
+ arg.AddCallback("--long3", argT::EQUAL_ARGUMENT, argument, random_ptr, "Same as -C but a bit different");
+ arg.AddCallback("--long4", argT::CONCAT_ARGUMENT, argument, random_ptr, "-C");
+
+ if ( !arg.Parse() )
+ {
+ kwsys_ios::cerr << "Problem parsing arguments" << kwsys_ios::endl;
+ res = 1;
+ }
+ kwsys_ios::cout << "Help: " << arg.GetHelp() << kwsys_ios::endl;
+
+ kwsys_ios::cout << "Some int variable was set to: " << some_int_variable << kwsys_ios::endl;
+ kwsys_ios::cout << "Some double variable was set to: " << some_double_variable << kwsys_ios::endl;
+ if ( some_string_variable )
+ {
+ kwsys_ios::cout << "Some string variable was set to: " << some_string_variable << kwsys_ios::endl;
+ delete [] some_string_variable;
+ }
+ else
+ {
+ kwsys_ios::cerr << "Problem setting string variable" << kwsys_ios::endl;
+ res = 1;
+ }
+ kwsys_ios::cout << "Some STL String variable was set to: " << some_stl_string_variable.c_str() << kwsys_ios::endl;
+ kwsys_ios::cout << "Some bool variable was set to: " << some_bool_variable << kwsys_ios::endl;
+ kwsys_ios::cout << "Some bool variable was set to: " << some_bool_variable1 << kwsys_ios::endl;
+ kwsys_ios::cout << "bool_arg1 variable was set to: " << bool_arg1 << kwsys_ios::endl;
+ kwsys_ios::cout << "bool_arg2 variable was set to: " << bool_arg2 << kwsys_ios::endl;
+ kwsys_ios::cout << kwsys_ios::endl;
+ return res;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testDynamicLoader.cxx b/Utilities/ITK/Utilities/kwsys/testDynamicLoader.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5195c3449d010d7bdcffc17d298099d78cd9072f
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testDynamicLoader.cxx
@@ -0,0 +1,103 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testDynamicLoader.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+
+#include KWSYS_HEADER(DynamicLoader.hxx)
+#include KWSYS_HEADER(ios/iostream)
+#include KWSYS_HEADER(stl/string)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "DynamicLoader.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+# include "kwsys_stl_string.hxx.in"
+#endif
+
+#include "testSystemTools.h"
+
+kwsys_stl::string GetLibName(const char* lname)
+{
+ // Construct proper name of lib
+ kwsys_stl::string slname;
+ slname = EXECUTABLE_OUTPUT_PATH;
+#ifdef CMAKE_INTDIR
+ slname += "/";
+ slname += CMAKE_INTDIR;
+#endif
+ slname += "/";
+ slname += kwsys::DynamicLoader::LibPrefix();
+ slname += lname;
+ slname += kwsys::DynamicLoader::LibExtension();
+
+ return slname;
+}
+
+/* libname = Library name (proper prefix, proper extension)
+ * System = symbol to lookup in libname
+ * r1: should OpenLibrary succeed ?
+ * r2: should GetSymbolAddress succeed ?
+ * r3: should CloseLibrary succeed ?
+ */
+int TestDynamicLoader(const char* libname, const char* symbol, int r1, int r2, int r3)
+{
+ kwsys_ios::cerr << "Testing: " << libname << kwsys_ios::endl;
+ kwsys::LibHandle l = kwsys::DynamicLoader::OpenLibrary(libname);
+ // If result is incompatible with expectation just fails (xor):
+ if( (r1 && !l) || (!r1 && l) )
+ {
+ kwsys_ios::cerr
+ << kwsys::DynamicLoader::LastError() << kwsys_ios::endl;
+ return 1;
+ }
+ kwsys::DynamicLoaderFunction f = kwsys::DynamicLoader::GetSymbolAddress(l, symbol);
+ if( (r2 && !f) || (!r2 && f) )
+ {
+ kwsys_ios::cerr
+ << kwsys::DynamicLoader::LastError() << kwsys_ios::endl;
+ return 1;
+ }
+ int s = kwsys::DynamicLoader::CloseLibrary(l);
+ if( (r3 && !s) || (!r3 && s) )
+ {
+ kwsys_ios::cerr
+ << kwsys::DynamicLoader::LastError() << kwsys_ios::endl;
+ return 1;
+ }
+ return 0;
+}
+
+int main(int , char *[])
+{
+ int res;
+ // Make sure that inexistant lib is giving correct result
+ res = TestDynamicLoader("azerty_", "foo_bar",0,0,0);
+ // Make sure that random binary file cannnot be assimilated as dylib
+ res += TestDynamicLoader(TEST_SYSTEMTOOLS_BIN_FILE, "wp",0,0,0);
+#ifdef __linux__
+ // This one is actually fun to test, since dlopen is by default loaded...wonder why :)
+ res += TestDynamicLoader("foobar.lib", "dlopen",0,1,0);
+ res += TestDynamicLoader("libdl.so", "dlopen",1,1,1);
+ res += TestDynamicLoader("libdl.so", "TestDynamicLoader",1,0,1);
+#endif
+ // Now try on the generated library
+ kwsys_stl::string libname = GetLibName("testDynload");
+ res += TestDynamicLoader(libname.c_str(), "dummy",1,0,1);
+ res += TestDynamicLoader(libname.c_str(), "TestDynamicLoaderFunction",1,1,1);
+ res += TestDynamicLoader(libname.c_str(), "_TestDynamicLoaderFunction",1,0,1);
+ res += TestDynamicLoader(libname.c_str(), "TestDynamicLoaderData",1,1,1);
+ res += TestDynamicLoader(libname.c_str(), "_TestDynamicLoaderData",1,0,1);
+
+ return res;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testDynload.c b/Utilities/ITK/Utilities/kwsys/testDynload.c
new file mode 100644
index 0000000000000000000000000000000000000000..7308530c03c24f3c72585b4dbd1ae8c89dac5ef2
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testDynload.c
@@ -0,0 +1,11 @@
+#ifdef _WIN32
+#define DL_EXPORT __declspec( dllexport )
+#else
+#define DL_EXPORT
+#endif
+
+DL_EXPORT int TestDynamicLoaderData = 0;
+
+DL_EXPORT void TestDynamicLoaderFunction()
+{
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testFail.c b/Utilities/ITK/Utilities/kwsys/testFail.c
new file mode 100644
index 0000000000000000000000000000000000000000..612295b180b84c98ae39ec707467714c378b12ab
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testFail.c
@@ -0,0 +1,24 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+int main(int argc, char* argv[])
+{
+ char* env = getenv("DASHBOARD_TEST_FROM_CTEST");
+ int oldCtest = 0;
+ if(env)
+ {
+ if(strcmp(env, "1") == 0)
+ {
+ oldCtest = 1;
+ }
+ printf("DASHBOARD_TEST_FROM_CTEST = %s\n", env);
+ }
+ printf("%s: This test intentionally fails\n", argv[0]);
+ if(oldCtest)
+ {
+ printf("The version of ctest is not able to handle intentionally failing tests, so pass.\n");
+ return 0;
+ }
+ return argc;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testHashSTL.cxx b/Utilities/ITK/Utilities/kwsys/testHashSTL.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f8e98bec901d3f5b7ccd6aa164b48185d2a1074f
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testHashSTL.cxx
@@ -0,0 +1,77 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testHashSTL.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(hash_map.hxx)
+#include KWSYS_HEADER(hash_set.hxx)
+#include KWSYS_HEADER(ios/iostream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "hash_map.hxx.in"
+# include "hash_set.hxx.in"
+# include "hashtable.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+#if defined(_MSC_VER)
+# pragma warning (disable:4786)
+#endif
+
+#if defined(__sgi) && !defined(__GNUC__)
+# pragma set woff 1468 /* inline function cannot be explicitly instantiated */
+#endif
+
+template class kwsys::hash_map<const char*, int>;
+template class kwsys::hash_set<int>;
+
+bool test_hash_map()
+{
+ typedef kwsys::hash_map<const char*, int> mtype;
+ mtype m;
+ const char* keys[] = {"hello", "world"};
+ m[keys[0]] = 1;
+ m.insert(mtype::value_type(keys[1], 2));
+ int sum = 0;
+ for(mtype::iterator mi = m.begin(); mi != m.end(); ++mi)
+ {
+ kwsys_ios::cout << "Found entry [" << mi->first << "," << mi->second << "]"
+ << kwsys_ios::endl;
+ sum += mi->second;
+ }
+ return sum == 3;
+}
+
+bool test_hash_set()
+{
+ typedef kwsys::hash_set<int> stype;
+ stype s;
+ s.insert(1);
+ s.insert(2);
+ int sum = 0;
+ for(stype::iterator si = s.begin(); si != s.end(); ++si)
+ {
+ kwsys_ios::cout << "Found entry [" << *si << "]" << kwsys_ios::endl;
+ sum += *si;
+ }
+ return sum == 3;
+}
+
+int main()
+{
+ bool result = true;
+ result = test_hash_map() && result;
+ result = test_hash_set() && result;
+ return result? 0:1;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testIOS.cxx b/Utilities/ITK/Utilities/kwsys/testIOS.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d699ae591eaff40e49c4273e310f15bb15307f2d
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testIOS.cxx
@@ -0,0 +1,20 @@
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(stl/vector)
+#include KWSYS_HEADER(ios/sstream)
+#include KWSYS_HEADER(ios/iostream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "kwsys_stl_vector.h.in"
+# include "kwsys_ios_sstream.h.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+int main()
+{
+ kwsys_ios::ostringstream ostr;
+ ostr << "Hello, World!";
+ kwsys_ios::cout << ostr.str() << kwsys_ios::endl;
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testProcess.c b/Utilities/ITK/Utilities/kwsys/testProcess.c
new file mode 100644
index 0000000000000000000000000000000000000000..ecf9f2845b8074894cdb060d7a253d761521c45b
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testProcess.c
@@ -0,0 +1,456 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testProcess.c,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+#include KWSYS_HEADER(Process.h)
+
+/* Work-around CMake dependency scanning limitation. This must
+ duplicate the above list of headers. */
+#if 0
+# include "Process.h.in"
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if defined(_WIN32)
+# include <windows.h>
+#else
+# include <unistd.h>
+#endif
+
+int runChild(const char* cmd[], int state, int exception, int value,
+ int share, int output, int delay, double timeout, int poll,
+ int repeat);
+
+int test1(int argc, const char* argv[])
+{
+ (void)argc; (void)argv;
+ fprintf(stdout, "Output on stdout from test returning 0.\n");
+ fprintf(stderr, "Output on stderr from test returning 0.\n");
+ return 0;
+}
+
+int test2(int argc, const char* argv[])
+{
+ (void)argc; (void)argv;
+ fprintf(stdout, "Output on stdout from test returning 123.\n");
+ fprintf(stderr, "Output on stderr from test returning 123.\n");
+ return 123;
+}
+
+int test3(int argc, const char* argv[])
+{
+ (void)argc; (void)argv;
+ fprintf(stdout, "Output before sleep on stdout from timeout test.\n");
+ fprintf(stderr, "Output before sleep on stderr from timeout test.\n");
+ fflush(stdout);
+ fflush(stderr);
+#if defined(_WIN32)
+ Sleep(15000);
+#else
+ sleep(15);
+#endif
+ fprintf(stdout, "Output after sleep on stdout from timeout test.\n");
+ fprintf(stderr, "Output after sleep on stderr from timeout test.\n");
+ return 0;
+}
+
+int test4(int argc, const char* argv[])
+{
+#if defined(_WIN32)
+ /* Avoid error diagnostic popups since we are crashing on purpose. */
+ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
+#endif
+ (void)argc; (void)argv;
+ fprintf(stdout, "Output before crash on stdout from crash test.\n");
+ fprintf(stderr, "Output before crash on stderr from crash test.\n");
+ fflush(stdout);
+ fflush(stderr);
+ *(int*)0 = 0;
+ fprintf(stdout, "Output after crash on stdout from crash test.\n");
+ fprintf(stderr, "Output after crash on stderr from crash test.\n");
+ return 0;
+}
+
+/* Quick hack to test grandchild killing. */
+/*#define TEST5_GRANDCHILD_KILL*/
+#ifdef TEST5_GRANDCHILD_KILL
+# define TEST5_TIMEOUT 10
+#else
+# define TEST5_TIMEOUT 30
+#endif
+
+int test5(int argc, const char* argv[])
+{
+ int r;
+ const char* cmd[4];
+ (void)argc;
+ cmd[0] = argv[0];
+ cmd[1] = "run";
+#ifdef TEST5_GRANDCHILD_KILL
+ cmd[2] = "3";
+#else
+ cmd[2] = "4";
+#endif
+ cmd[3] = 0;
+ fprintf(stdout, "Output on stdout before recursive test.\n");
+ fprintf(stderr, "Output on stderr before recursive test.\n");
+ fflush(stdout);
+ fflush(stderr);
+ r = runChild(cmd, kwsysProcess_State_Exception,
+ kwsysProcess_Exception_Fault, 1, 1, 1, 0, 15, 0, 1);
+ fprintf(stdout, "Output on stdout after recursive test.\n");
+ fprintf(stderr, "Output on stderr after recursive test.\n");
+ fflush(stdout);
+ fflush(stderr);
+ return r;
+}
+
+#define TEST6_SIZE (4096*2)
+void test6(int argc, const char* argv[])
+{
+ int i;
+ char runaway[TEST6_SIZE+1];
+ (void)argc; (void)argv;
+ for(i=0;i < TEST6_SIZE;++i)
+ {
+ runaway[i] = '.';
+ }
+ runaway[TEST6_SIZE] = '\n';
+
+ /* Generate huge amounts of output to test killing. */
+ for(;;)
+ {
+ fwrite(runaway, 1, TEST6_SIZE+1, stdout);
+ fflush(stdout);
+ }
+}
+
+/* Define MINPOLL to be one more than the number of times output is
+ written. Define MAXPOLL to be the largest number of times a loop
+ delaying 1/10th of a second should ever have to poll. */
+#define MINPOLL 5
+#define MAXPOLL 20
+int test7(int argc, const char* argv[])
+{
+ (void)argc; (void)argv;
+ fprintf(stdout, "Output on stdout before sleep.\n");
+ fprintf(stderr, "Output on stderr before sleep.\n");
+ fflush(stdout);
+ fflush(stderr);
+ /* Sleep for 1 second. */
+#if defined(_WIN32)
+ Sleep(1000);
+#else
+ sleep(1);
+#endif
+ fprintf(stdout, "Output on stdout after sleep.\n");
+ fprintf(stderr, "Output on stderr after sleep.\n");
+ fflush(stdout);
+ fflush(stderr);
+ return 0;
+}
+
+int runChild2(kwsysProcess* kp,
+ const char* cmd[], int state, int exception, int value,
+ int share, int output, int delay, double timeout,
+ int poll)
+{
+ int result = 0;
+ char* data = 0;
+ int length = 0;
+ double userTimeout = 0;
+ double* pUserTimeout = 0;
+ kwsysProcess_SetCommand(kp, cmd);
+ if(timeout >= 0)
+ {
+ kwsysProcess_SetTimeout(kp, timeout);
+ }
+ if(share)
+ {
+ kwsysProcess_SetPipeShared(kp, kwsysProcess_Pipe_STDOUT, 1);
+ kwsysProcess_SetPipeShared(kp, kwsysProcess_Pipe_STDERR, 1);
+ }
+ kwsysProcess_Execute(kp);
+
+ if(poll)
+ {
+ pUserTimeout = &userTimeout;
+ }
+
+ if(!share)
+ {
+ int p;
+ while((p = kwsysProcess_WaitForData(kp, &data, &length, pUserTimeout)))
+ {
+ if(output)
+ {
+ if(poll && p == kwsysProcess_Pipe_Timeout)
+ {
+ fprintf(stdout, "WaitForData timeout reached.\n");
+ fflush(stdout);
+
+ /* Count the number of times we polled without getting data.
+ If it is excessive then kill the child and fail. */
+ if(++poll >= MAXPOLL)
+ {
+ fprintf(stdout, "Poll count reached limit %d.\n",
+ MAXPOLL);
+ kwsysProcess_Kill(kp);
+ }
+ }
+ else
+ {
+ fwrite(data, 1, length, stdout);
+ fflush(stdout);
+ }
+ }
+ if(poll)
+ {
+ /* Delay to avoid busy loop during polling. */
+#if defined(_WIN32)
+ Sleep(100);
+#else
+ usleep(100000);
+#endif
+ }
+ if(delay)
+ {
+ /* Purposely sleeping only on Win32 to let pipe fill up. */
+#if defined(_WIN32)
+ Sleep(100);
+#endif
+ }
+ }
+ }
+
+ kwsysProcess_WaitForExit(kp, 0);
+
+ switch (kwsysProcess_GetState(kp))
+ {
+ case kwsysProcess_State_Starting:
+ printf("No process has been executed.\n"); break;
+ case kwsysProcess_State_Executing:
+ printf("The process is still executing.\n"); break;
+ case kwsysProcess_State_Expired:
+ printf("Child was killed when timeout expired.\n"); break;
+ case kwsysProcess_State_Exited:
+ printf("Child exited with value = %d\n",
+ kwsysProcess_GetExitValue(kp));
+ result = ((exception != kwsysProcess_GetExitException(kp)) ||
+ (value != kwsysProcess_GetExitValue(kp))); break;
+ case kwsysProcess_State_Killed:
+ printf("Child was killed by parent.\n"); break;
+ case kwsysProcess_State_Exception:
+ printf("Child terminated abnormally: %s\n",
+ kwsysProcess_GetExceptionString(kp));
+ result = ((exception != kwsysProcess_GetExitException(kp)) ||
+ (value != kwsysProcess_GetExitValue(kp))); break;
+ case kwsysProcess_State_Error:
+ printf("Error in administrating child process: [%s]\n",
+ kwsysProcess_GetErrorString(kp)); break;
+ };
+
+ if(result)
+ {
+ if(exception != kwsysProcess_GetExitException(kp))
+ {
+ fprintf(stderr, "Mismatch in exit exception. "
+ "Should have been %d, was %d.\n",
+ exception, kwsysProcess_GetExitException(kp));
+ }
+ if(value != kwsysProcess_GetExitValue(kp))
+ {
+ fprintf(stderr, "Mismatch in exit value. "
+ "Should have been %d, was %d.\n",
+ value, kwsysProcess_GetExitValue(kp));
+ }
+ }
+
+ if(kwsysProcess_GetState(kp) != state)
+ {
+ fprintf(stderr, "Mismatch in state. "
+ "Should have been %d, was %d.\n",
+ state, kwsysProcess_GetState(kp));
+ result = 1;
+ }
+
+ /* We should have polled more times than there were data if polling
+ was enabled. */
+ if(poll && poll < MINPOLL)
+ {
+ fprintf(stderr, "Poll count is %d, which is less than %d.\n",
+ poll, MINPOLL);
+ result = 1;
+ }
+
+ return result;
+}
+
+int runChild(const char* cmd[], int state, int exception, int value,
+ int share, int output, int delay, double timeout,
+ int poll, int repeat)
+{
+ int result = 1;
+ kwsysProcess* kp = kwsysProcess_New();
+ if(!kp)
+ {
+ fprintf(stderr, "kwsysProcess_New returned NULL!\n");
+ return 1;
+ }
+ while(repeat-- > 0)
+ {
+ result = runChild2(kp, cmd, state, exception, value, share,
+ output, delay, timeout, poll);
+ }
+ kwsysProcess_Delete(kp);
+ return result;
+}
+
+int main(int argc, const char* argv[])
+{
+ int n = 0;
+#if 0
+ {
+ HANDLE out = GetStdHandle(STD_OUTPUT_HANDLE);
+ DuplicateHandle(GetCurrentProcess(), out,
+ GetCurrentProcess(), &out, 0, FALSE,
+ DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+ SetStdHandle(STD_OUTPUT_HANDLE, out);
+ }
+ {
+ HANDLE out = GetStdHandle(STD_ERROR_HANDLE);
+ DuplicateHandle(GetCurrentProcess(), out,
+ GetCurrentProcess(), &out, 0, FALSE,
+ DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+ SetStdHandle(STD_ERROR_HANDLE, out);
+ }
+#endif
+ if(argc == 2)
+ {
+ n = atoi(argv[1]);
+ }
+ else if(argc == 3 && strcmp(argv[1], "run") == 0)
+ {
+ n = atoi(argv[2]);
+ }
+ /* Check arguments. */
+ if(n >= 1 && n <= 7 && argc == 3)
+ {
+ /* This is the child process for a requested test number. */
+ switch (n)
+ {
+ case 1: return test1(argc, argv);
+ case 2: return test2(argc, argv);
+ case 3: return test3(argc, argv);
+ case 4: return test4(argc, argv);
+ case 5: return test5(argc, argv);
+ case 6: test6(argc, argv); return 0;
+ case 7: return test7(argc, argv);
+ }
+ fprintf(stderr, "Invalid test number %d.\n", n);
+ return 1;
+ }
+ else if(n >= 1 && n <= 7)
+ {
+ /* This is the parent process for a requested test number. */
+ int states[7] =
+ {
+ kwsysProcess_State_Exited,
+ kwsysProcess_State_Exited,
+ kwsysProcess_State_Expired,
+ kwsysProcess_State_Exception,
+ kwsysProcess_State_Exited,
+ kwsysProcess_State_Expired,
+ kwsysProcess_State_Exited
+ };
+ int exceptions[7] =
+ {
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_Fault,
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_None,
+ kwsysProcess_Exception_None
+ };
+ int values[7] = {0, 123, 1, 1, 0, 0, 0};
+ int outputs[7] = {1, 1, 1, 1, 1, 0, 1};
+ int delays[7] = {0, 0, 0, 0, 0, 1, 0};
+ double timeouts[7] = {10, 10, 10, 10, TEST5_TIMEOUT, 10, -1};
+ int polls[7] = {0, 0, 0, 0, 0, 0, 1};
+ int repeat[7] = {2, 1, 1, 1, 1, 1, 1};
+ int r;
+ const char* cmd[4];
+#ifdef _WIN32
+ char* argv0 = 0;
+ if(n == 0 && (argv0 = strdup(argv[0])))
+ {
+ /* Try converting to forward slashes to see if it works. */
+ char* c;
+ for(c=argv0; *c; ++c)
+ {
+ if(*c == '\\')
+ {
+ *c = '/';
+ }
+ }
+ cmd[0] = argv0;
+ }
+ else
+ {
+ cmd[0] = argv[0];
+ }
+#else
+ cmd[0] = argv[0];
+#endif
+ cmd[1] = "run";
+ cmd[2] = argv[1];
+ cmd[3] = 0;
+ fprintf(stdout, "Output on stdout before test %d.\n", n);
+ fprintf(stderr, "Output on stderr before test %d.\n", n);
+ fflush(stdout);
+ fflush(stderr);
+ r = runChild(cmd, states[n-1], exceptions[n-1], values[n-1], 0,
+ outputs[n-1], delays[n-1], timeouts[n-1],
+ polls[n-1], repeat[n-1]);
+ fprintf(stdout, "Output on stdout after test %d.\n", n);
+ fprintf(stderr, "Output on stderr after test %d.\n", n);
+ fflush(stdout);
+ fflush(stderr);
+#if _WIN32
+ if(argv0) { free(argv0); }
+#endif
+ return r;
+ }
+ else if(argc > 2 && strcmp(argv[1], "0") == 0)
+ {
+ /* This is the special debugging test to run a given command
+ line. */
+ const char** cmd = argv+2;
+ int state = kwsysProcess_State_Exited;
+ int exception = kwsysProcess_Exception_None;
+ int value = 0;
+ double timeout = 0;
+ int r = runChild(cmd, state, exception, value, 0, 1, 0, timeout, 0, 1);
+ return r;
+ }
+ else
+ {
+ /* Improper usage. */
+ fprintf(stdout, "Usage: %s <test number>\n", argv[0]);
+ return 1;
+ }
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testRegistry.cxx b/Utilities/ITK/Utilities/kwsys/testRegistry.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..332c8a56745d4c52a032974b15e95c23731443aa
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testRegistry.cxx
@@ -0,0 +1,112 @@
+/*=========================================================================
+
+ Program: ParaView
+ Module: $RCSfile: testRegistry.cxx,v $
+
+ Copyright (c) Kitware, Inc.
+ All rights reserved.
+ See Copyright.txt or http://www.paraview.org/HTML/Copyright.html for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+
+#include KWSYS_HEADER(Registry.hxx)
+#include KWSYS_HEADER(ios/iostream)
+#include <string.h>
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "Registry.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+#define IFT(x,res) if ( !x ) \
+ { \
+ res = 1; \
+ kwsys_ios::cout << "Error in: " << #x << kwsys_ios::endl; \
+ }
+#define IFNT(x,res) if ( x ) \
+ { \
+ res = 1; \
+ kwsys_ios::cout << "Error in: " << #x << kwsys_ios::endl; \
+ }
+
+#define CHE(x,y,res) if ( x && y && strcmp(x,y) ) \
+ { \
+ res = 1; \
+ kwsys_ios::cout << "Error, " << x << " != " << y << kwsys_ios::endl; \
+ }
+
+int main(int, char**)
+{
+ int res = 0;
+
+ kwsys::Registry reg;
+ reg.SetTopLevel("TestRegistry");
+
+ IFT(reg.SetValue("TestSubkey", "TestKey1", "Test Value 1"), res);
+ IFT(reg.SetValue("TestSubkey1", "TestKey2", "Test Value 2"), res);
+ IFT(reg.SetValue("TestSubkey", "TestKey3", "Test Value 3"), res);
+ IFT(reg.SetValue("TestSubkey2", "TestKey4", "Test Value 4"), res);
+
+ const char *buffer;
+ IFT(reg.ReadValue("TestSubkey", "TestKey1", &buffer), res);
+ CHE(buffer, "Test Value 1", res);
+ IFT(reg.ReadValue("TestSubkey1", "TestKey2", &buffer), res);
+ CHE(buffer, "Test Value 2", res);
+ IFT(reg.ReadValue("TestSubkey", "TestKey3", &buffer), res);
+ CHE(buffer, "Test Value 3", res);
+ IFT(reg.ReadValue("TestSubkey2", "TestKey4", &buffer), res);
+ CHE(buffer, "Test Value 4", res);
+
+ IFT(reg.SetValue("TestSubkey", "TestKey1", "New Test Value 1"), res);
+ IFT(reg.SetValue("TestSubkey1", "TestKey2", "New Test Value 2"), res);
+ IFT(reg.SetValue("TestSubkey", "TestKey3", "New Test Value 3"), res);
+ IFT(reg.SetValue("TestSubkey2", "TestKey4", "New Test Value 4"), res);
+
+ IFT(reg.ReadValue("TestSubkey", "TestKey1", &buffer), res);
+ CHE(buffer, "New Test Value 1", res);
+ IFT(reg.ReadValue("TestSubkey1", "TestKey2", &buffer), res);
+ CHE(buffer, "New Test Value 2", res);
+ IFT(reg.ReadValue("TestSubkey", "TestKey3", &buffer), res);
+ CHE(buffer, "New Test Value 3", res);
+ IFT(reg.ReadValue("TestSubkey2", "TestKey4", &buffer), res);
+ CHE(buffer, "New Test Value 4", res);
+
+ IFT( reg.DeleteValue("TestSubkey", "TestKey1"), res);
+ IFNT(reg.ReadValue( "TestSubkey", "TestKey1", &buffer), res);
+ IFT( reg.DeleteValue("TestSubkey1", "TestKey2"), res);
+ IFNT(reg.ReadValue( "TestSubkey1", "TestKey2", &buffer), res);
+ IFT( reg.DeleteValue("TestSubkey", "TestKey3"), res);
+ IFNT(reg.ReadValue( "TestSubkey", "TestKey3", &buffer), res);
+ IFT( reg.DeleteValue("TestSubkey2", "TestKey4"), res);
+ IFNT(reg.ReadValue( "TestSubkey2", "TestKey5", &buffer), res);
+
+ const char* longStringWithNewLines = "Value with embedded CR and LF characters CR='\015' LF='\012' CRLF='\015\012'";
+ IFT(reg.SetValue("TestSubkeyWithVeryLongInFactSoLongItsHardToImagineAnybodyWouldReallyDoItLongName", "TestKey1", longStringWithNewLines), res);
+ IFT(reg.ReadValue("TestSubkeyWithVeryLongInFactSoLongItsHardToImagineAnybodyWouldReallyDoItLongName", "TestKey1", &buffer), res);
+ CHE(buffer, longStringWithNewLines, res);
+ IFT(reg.DeleteValue("TestSubkeyWithVeryLongInFactSoLongItsHardToImagineAnybodyWouldReallyDoItLongName", "TestKey1"), res);
+ IFNT(reg.ReadValue("TestSubkeyWithVeryLongInFactSoLongItsHardToImagineAnybodyWouldReallyDoItLongName", "TestKey1", &buffer), res);
+
+ IFT(reg.SetValue("TestSubkeyWith = EqualSignChar", "TestKey = 1", "Some value"), res);
+ IFT(reg.ReadValue("TestSubkeyWith = EqualSignChar", "TestKey = 1", &buffer), res);
+ CHE(buffer, "Some value", res);
+ IFT(reg.DeleteValue("TestSubkeyWith = EqualSignChar", "TestKey = 1"), res);
+ IFNT(reg.ReadValue("TestSubkeyWith = EqualSignChar", "TestKey = 1", &buffer), res);
+
+ if ( res )
+ {
+ kwsys_ios::cout << "Test failed" << kwsys_ios::endl;
+ }
+ else
+ {
+ kwsys_ios::cout << "Test passed" << kwsys_ios::endl;
+ }
+ return res;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testSystemTools.bin b/Utilities/ITK/Utilities/kwsys/testSystemTools.bin
new file mode 100644
index 0000000000000000000000000000000000000000..961a4043b9b2785351ab26a33cfcb1f366c1391b
Binary files /dev/null and b/Utilities/ITK/Utilities/kwsys/testSystemTools.bin differ
diff --git a/Utilities/ITK/Utilities/kwsys/testSystemTools.cxx b/Utilities/ITK/Utilities/kwsys/testSystemTools.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..894d6b8a27969cefb623b65040305faa32072b08
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testSystemTools.cxx
@@ -0,0 +1,149 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testSystemTools.cxx,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#include "kwsysPrivate.h"
+
+#if defined(_MSC_VER)
+# pragma warning (disable:4786)
+#endif
+
+#include KWSYS_HEADER(SystemTools.hxx)
+#include KWSYS_HEADER(ios/iostream)
+
+// Work-around CMake dependency scanning limitation. This must
+// duplicate the above list of headers.
+#if 0
+# include "SystemTools.hxx.in"
+# include "kwsys_ios_iostream.h.in"
+#endif
+
+#include "testSystemTools.h"
+
+//----------------------------------------------------------------------------
+const char* toUnixPaths[][2] =
+{
+ { "/usr/local/bin/passwd", "/usr/local/bin/passwd" },
+ { "/usr/lo cal/bin/pa sswd", "/usr/lo cal/bin/pa sswd" },
+ { "/usr/lo\\ cal/bin/pa\\ sswd", "/usr/lo\\ cal/bin/pa\\ sswd" },
+ { "c:/usr/local/bin/passwd", "c:/usr/local/bin/passwd" },
+ { "c:/usr/lo cal/bin/pa sswd", "c:/usr/lo cal/bin/pa sswd" },
+ { "c:/usr/lo\\ cal/bin/pa\\ sswd", "c:/usr/lo\\ cal/bin/pa\\ sswd" },
+ { "\\usr\\local\\bin\\passwd", "/usr/local/bin/passwd" },
+ { "\\usr\\lo cal\\bin\\pa sswd", "/usr/lo cal/bin/pa sswd" },
+ { "\\usr\\lo\\ cal\\bin\\pa\\ sswd", "/usr/lo\\ cal/bin/pa\\ sswd" },
+ { "c:\\usr\\local\\bin\\passwd", "c:/usr/local/bin/passwd" },
+ { "c:\\usr\\lo cal\\bin\\pa sswd", "c:/usr/lo cal/bin/pa sswd" },
+ { "c:\\usr\\lo\\ cal\\bin\\pa\\ sswd", "c:/usr/lo\\ cal/bin/pa\\ sswd" },
+ { "\\\\usr\\local\\bin\\passwd", "//usr/local/bin/passwd" },
+ { "\\\\usr\\lo cal\\bin\\pa sswd", "//usr/lo cal/bin/pa sswd" },
+ { "\\\\usr\\lo\\ cal\\bin\\pa\\ sswd", "//usr/lo\\ cal/bin/pa\\ sswd" },
+ {0, 0}
+};
+
+bool CheckConvertToUnixSlashes(kwsys_stl::string input,
+ kwsys_stl::string output)
+{
+ kwsys_stl::string result = input;
+ kwsys::SystemTools::ConvertToUnixSlashes(result);
+ if ( result != output )
+ {
+ kwsys_ios::cerr
+ << "Problem with ConvertToUnixSlashes - input: " << input.c_str()
+ << " output: " << result.c_str() << " expected: " << output.c_str()
+ << kwsys_ios::endl;
+ return false;
+ }
+ return true;
+}
+
+//----------------------------------------------------------------------------
+const char* checkEscapeChars[][4] =
+{
+ { "1 foo 2 bar 2", "12", "\\", "\\1 foo \\2 bar \\2"},
+ { " {} ", "{}", "#", " #{#} "},
+ {0, 0, 0, 0}
+};
+
+bool CheckEscapeChars(kwsys_stl::string input,
+ const char *chars_to_escape,
+ char escape_char,
+ kwsys_stl::string output)
+{
+ kwsys_stl::string result = kwsys::SystemTools::EscapeChars(
+ input.c_str(), chars_to_escape, escape_char);
+ if (result != output)
+ {
+ kwsys_ios::cerr
+ << "Problem with CheckEscapeChars - input: " << input.c_str()
+ << " output: " << result.c_str() << " expected: " << output.c_str()
+ << kwsys_ios::endl;
+ return false;
+ }
+ return true;
+}
+
+//----------------------------------------------------------------------------
+bool CheckDetectFileType()
+{
+ bool res = true;
+
+ if (kwsys::SystemTools::DetectFileType(TEST_SYSTEMTOOLS_BIN_FILE) !=
+ kwsys::SystemTools::FileTypeBinary)
+ {
+ kwsys_ios::cerr
+ << "Problem with DetectFileType - failed to detect type of: "
+ << TEST_SYSTEMTOOLS_BIN_FILE << kwsys_ios::endl;
+ res = false;
+ }
+
+ if (kwsys::SystemTools::DetectFileType(TEST_SYSTEMTOOLS_SRC_FILE) !=
+ kwsys::SystemTools::FileTypeText)
+ {
+ kwsys_ios::cerr
+ << "Problem with DetectFileType - failed to detect type of: "
+ << TEST_SYSTEMTOOLS_SRC_FILE << kwsys_ios::endl;
+ res = false;
+ }
+
+ return res;
+}
+
+//----------------------------------------------------------------------------
+int main(/*int argc, char* argv*/)
+{
+ bool res = true;
+
+ int cc;
+ for ( cc = 0; toUnixPaths[cc][0]; cc ++ )
+ {
+ res &= CheckConvertToUnixSlashes(toUnixPaths[cc][0], toUnixPaths[cc][1]);
+ }
+
+ // Special check for ~
+ kwsys_stl::string output;
+ if(kwsys::SystemTools::GetEnv("HOME", output))
+ {
+ output += "/foo bar/lala";
+ res &= CheckConvertToUnixSlashes("~/foo bar/lala", output);
+ }
+
+ for (cc = 0; checkEscapeChars[cc][0]; cc ++ )
+ {
+ res &= CheckEscapeChars(checkEscapeChars[cc][0], checkEscapeChars[cc][1],
+ *checkEscapeChars[cc][2], checkEscapeChars[cc][3]);
+ }
+
+ res &= CheckDetectFileType();
+
+ return res ? 0 : 1;
+}
diff --git a/Utilities/ITK/Utilities/kwsys/testSystemTools.h.in b/Utilities/ITK/Utilities/kwsys/testSystemTools.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..e0d7b326aa58364bc89c23c55389c82e621374dc
--- /dev/null
+++ b/Utilities/ITK/Utilities/kwsys/testSystemTools.h.in
@@ -0,0 +1,22 @@
+/*=========================================================================
+
+ Program: KWSys - Kitware System Library
+ Module: $RCSfile: testSystemTools.h.in,v $
+
+ Copyright (c) Kitware, Inc., Insight Consortium. All rights reserved.
+ See Copyright.txt or http://www.kitware.com/Copyright.htm for details.
+
+ This software is distributed WITHOUT ANY WARRANTY; without even
+ the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+ PURPOSE. See the above copyright notices for more information.
+
+=========================================================================*/
+#ifndef @KWSYS_NAMESPACE@_testSystemtools_h
+#define @KWSYS_NAMESPACE@_testSystemtools_h
+
+#define EXECUTABLE_OUTPUT_PATH "@CMAKE_CURRENT_BINARY_DIR@"
+
+#define TEST_SYSTEMTOOLS_BIN_FILE "@TEST_SYSTEMTOOLS_BIN_FILE@"
+#define TEST_SYSTEMTOOLS_SRC_FILE "@TEST_SYSTEMTOOLS_SRC_FILE@"
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..872ac59a55976819e235e0f809ff76a9581279dd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/CMakeLists.txt
@@ -0,0 +1,26 @@
+# Root vxl ported to ITK Utilities.
+PROJECT(vxl)
+
+IF(NOT ITK_SOURCE_DIR)
+ SET(BUILD_TESTING 1)
+ SET(LIBRARY_OUTPUT_PATH ${vxl_BINARY_DIR}/bin)
+ SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/bin)
+ENDIF(NOT ITK_SOURCE_DIR)
+
+# CMake support directory.
+SET(VXL_CMAKE_DIR ${vxl_SOURCE_DIR}/config/cmake/Modules)
+SET(MODULE_PATH ${vxl_SOURCE_DIR}/config/cmake/Modules)
+
+# Do platform-specific configuration.
+SUBDIRS(config/cmake/config)
+
+# Build the core vxl + support libraries
+SUBDIRS(vcl v3p core)
+
+# Standard include directories.
+SET(VXLCORE_INCLUDE_DIR ${vxl_BINARY_DIR}/core ${vxl_SOURCE_DIR}/core)
+SET(VCL_INCLUDE_DIR ${vxl_BINARY_DIR}/vcl ${vxl_SOURCE_DIR}/vcl)
+
+INCLUDE_DIRECTORIES(${VCL_INCLUDE_DIR} ${VXLCORE_INCLUDE_DIR})
+
+SET(VXL_INSTALL_ROOT /include/InsightToolkit/Utilities/vxl)
diff --git a/Utilities/ITK/Utilities/vxl/config/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/config/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..5c176f3dd8f6667e9f0f0141740aa7e3657e18ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/CMakeLists.txt
@@ -0,0 +1,2 @@
+# This CMakeLists.txt file should always remain empty. It is here so
+# that this comment serves as a reminder.
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/config/cmake/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..5c176f3dd8f6667e9f0f0141740aa7e3657e18ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/CMakeLists.txt
@@ -0,0 +1,2 @@
+# This CMakeLists.txt file should always remain empty. It is here so
+# that this comment serves as a reminder.
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..abc63e851963c9de1c63f9e59d745e6041506dcf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/DLLHeader.dsptemplate
@@ -0,0 +1,106 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+
+
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MT /W3 /GR /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /GR /GX /O2 BUILD_INCLUDES EXTRA_DEFINES /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# SUBTRACT CPP /YX
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MTd /W3 /GR /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /GR /GX /Zi /Od BUILD_INCLUDES EXTRA_DEFINES /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /GZ /c
+# SUBTRACT CPP /YX
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 CM_DEBUG_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..83bed405e73aa2744ad1e39e83d9f87b0e0ec48d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/EXEHeader.dsptemplate
@@ -0,0 +1,127 @@
+# Microsoft Developer Studio Project File - Name="pcbuilder" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# CM DSP Header file
+# This file is read by the build system of cm, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+# CM_LIBRARIES == libraries linked in
+# TARGTYPE "Win32 (x86) Application" 0x0101
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release MinSize" (based on "Win32 (x86) Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GR /GX /Zm1000 /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /MD /W3 /GR /GX /Zm1000 /O2 /D "WIN32" BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /W3 /GR /Zm1000 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FD /GZ /c
+# ADD CPP /nologo /W3 /MDd /GR /Gm /GX /Zm1000 /ZI /Od /D "WIN32" BUILD_INCLUDES EXTRA_DEFINES /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FD /GZ /c
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_DEBUG_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release MinSize"
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "ReleaseMinSize"
+# PROP BASE Intermediate_Dir "ReleaseMinSize"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "ReleaseMinSize"
+# PROP Intermediate_Dir "ReleaseMinSize"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MD /W3 /GR /GX /Zm1000 /O1 /Gs /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /MD /W3 /GR /GX /Zm1000 /O1 /Gs /D "WIN32" BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 Release MinSize"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..f59001dfc059b04d2c4f5eded347b7378af29343
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityFooter.dsptemplate
@@ -0,0 +1,2 @@
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..02f56b48a9dd5702c4e73ffa1b9ea94883d5cf12
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/UtilityHeader.dsptemplate
@@ -0,0 +1,76 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Generic Project" 0x010a
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release MinSize" (based on "Win32 (x86) Generic Project")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+MTL=midl.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release MinSize"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "testutility___Win32_Release_MinSize"
+# PROP BASE Intermediate_Dir "testutility___Win32_Release_MinSize"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "testutility___Win32_Release_MinSize"
+# PROP Intermediate_Dir "testutility___Win32_Release_MinSize"
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 Release MinSize"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..a15513d2746ba9c33ccd4fe99575fb0c02d2081b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/default/staticLibHeader.dsptemplate
@@ -0,0 +1,119 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+
+# TARGTYPE "Win32 (x86) Static Library" 0x0104
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release MinSize" (based on "Win32 (x86) Static Library")
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /GR /MD /W3 /GX /Zm1000 /O2 BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /FD /c
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /W3 /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /GR /GX /Zm1000 /Zi /Od BUILD_INCLUDES EXTRA_DEFINES /D "_DEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /FD /GZ /c
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release MinSize"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "ReleaseMinSize"
+# PROP BASE Intermediate_Dir "ReleaseMinSize"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "ReleaseMinSize"
+# PROP Intermediate_Dir "ReleaseMinSize"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /MD /W3 /O1 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_DLL" /FD /c
+# ADD CPP /nologo /GR /GX /Zm1000 /MD /W3 /O1 BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "_MBCS" /D "_ATL_DLL" /D "WIN32" /D "_WINDOWS" /D "_USRDLL" /FD /c
+# SUBTRACT CPP /YX /Yc /Yu
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 Release MinSize"
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..6c4c135fc7e4a2bf079aba79aa05ecb45eed9f75
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeLists.txt
@@ -0,0 +1,3 @@
+# just install the modules
+INSTALL_FILES(/share/CMake/Templates "" CMakeSystemConfig.cmake.in)
+INSTALL_PROGRAMS(/share/CMake/Templates configure install-sh)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeNMakeWindowsSystemConfig.cmake0000644 b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeNMakeWindowsSystemConfig.cmake0000644
new file mode 100644
index 0000000000000000000000000000000000000000..0019f1e7765a807ed7e01e99e7194771def17144
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeNMakeWindowsSystemConfig.cmake0000644
@@ -0,0 +1,31 @@
+# microsoft specific config file
+SET (WORDS_BIGENDIAN )
+SET (HAVE_LIMITS_H 1)
+SET (HAVE_UNISTD_H 1)
+SET (CMAKE_CXX_COMPILER cl CACHE FILEPATH
+ "Name of C++ compiler used.")
+SET (CMAKE_C_COMPILER cl CACHE FILEPATH
+ "Name of C compiler used.")
+SET (CMAKE_CFLAGS "/W3 /Zm1000" CACHE STRING
+ "Flags for C compiler.")
+SET (CMAKE_BUILD_TYPE Debug CACHE STRING
+"Choose the type of build, options are: Debug Release RelWithDebInfo MinSizeRel")
+SET (CMAKE_CXX_FLAGS_RELEASE "/MD /O2" CACHE STRING
+ "Flags used by the compiler during release builds (/MD /Ob1 /Oi /Ot /Oy /Gs will produce slightly less optimized but smaller files)")
+SET (CMAKE_CXX_FLAGS_RELWITHDEBINFO "/MD /Zi /O2" CACHE STRING
+ "Flags used by the compiler during Release with Debug Info builds")
+SET (CMAKE_CXX_FLAGS_MINSIZEREL "/MD /O1" CACHE STRING
+ "Flags used by the compiler during release minsize builds")
+SET (CMAKE_CXX_FLAGS_DEBUG "/MDd /Zi /Od /GZ" CACHE STRING
+ "Flags used by the compiler during debug builds")
+SET (CMAKE_CXX_FLAGS "/W3 /Zm1000 /GX /GR" CACHE STRING
+ "Flags used by the compiler during all build types, /GX /GR are for exceptions and rtti in VC++, /Zm1000 increases the compiler's memory allocation to support ANSI C++/stdlib")
+SET (CMAKE_USE_WIN32_THREADS 1 CACHE BOOL "Use the win32 thread library")
+SET (CMAKE_STANDARD_WINDOWS_LIBRARIES "kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib" CACHE STRING "Libraries linked by defalut with all applications")
+SET (CMAKE_SHLIB_SUFFIX ".dll" CACHE STRING "Shared library suffix")
+SET (CMAKE_MODULE_SUFFIX ".dll" CACHE STRING "Module library suffix")
+SET (CMAKE_MAKE_PROGRAM "nmake" CACHE STRING "Program used to build from makefiles.")
+
+
+
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeSystemConfig.cmake.in b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeSystemConfig.cmake.in
new file mode 100644
index 0000000000000000000000000000000000000000..737374caeb0e0a51746da714d5e2f7a3c3882810
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeSystemConfig.cmake.in
@@ -0,0 +1,106 @@
+#
+# CMakeLocal.make.in should be in the directory where you run configure
+# in, which need not be the source directory
+#
+SET (CMAKE_INSTALL_PREFIX @prefix@ CACHE PATH
+ "Install path prefix, prepended onto install directories")
+SET (CMAKE_WORDS_BIGENDIAN @CMAKE_WORDS_BIGENDIAN@ )
+SET (CMAKE_USE_SPROC @CMAKE_USE_SPROC@ CACHE BOOL "Use sproc libs.")
+SET (CMAKE_USE_PTHREADS @CMAKE_USE_PTHREADS@ CACHE BOOL
+ "Use the pthreads library")
+SET (CMAKE_USE_WIN32_THREADS @CMAKE_USE_WIN32_THREADS@ CACHE BOOL
+ "Use the win32 thread library")
+SET (CMAKE_HP_PTHREADS @CMAKE_HP_PTHREADS@ CACHE BOOL
+ "Use HP pthreads")
+SET (CMAKE_LIB_EXT @CMAKE_LIB_EXT@ CACHE STRING
+ "Library extension used by this machine" )
+SET (CMAKE_RANLIB "@RANLIB@" CACHE FILEPATH
+ " Library randomizer program used on archive libraries." )
+SET (CMAKE_AR "@CMAKE_AR@" CACHE FILEPATH
+ " Archive program used to make archive libraries." )
+SET (CMAKE_AR_ARGS "@CMAKE_AR_ARGS@" CACHE STRING
+ " Arguments for CMAKE_AR program to create an archive library." )
+SET (CMAKE_CXX_COMPILER "@CXX@" CACHE FILEPATH "CXX compiler used.")
+SET (CMAKE_CXX_FLAGS "@CXXFLAGS@" CACHE STRING
+ "Flags used by CXX compiler")
+SET (CMAKE_TEMPLATE_FLAGS "@CMAKE_TEMPLATE_FLAGS@" CACHE STRING
+ "CXX template flags used by compiler")
+SET (CMAKE_C_COMPILER "@CC@" CACHE FILEPATH
+ "C compiler used.")
+SET (CMAKE_C_FLAGS "@CFLAGS@" CACHE STRING "C compiler flags")
+
+SET (CMAKE_SHLIB_CFLAGS "@CMAKE_SHLIB_CFLAGS@" CACHE STRING
+ "Flag used for building shared library objects" )
+SET (CMAKE_SHLIB_BUILD_FLAGS "@CMAKE_SHLIB_BUILD_FLAGS@" CACHE STRING
+ "Flag used by CXX to build a shared library")
+SET (CMAKE_MODULE_BUILD_FLAGS "@CMAKE_MODULE_BUILD_FLAGS@" CACHE STRING
+ "Flag used by CXX to build a shared library")
+SET (CMAKE_SHLIB_SUFFIX @CMAKE_SHLIB_SUFFIX@ CACHE STRING
+ "Shared library suffix")
+SET (CMAKE_MODULE_SUFFIX @CMAKE_MODULE_SUFFIX@ CACHE STRING
+ "Module library suffix")
+SET (CMAKE_THREAD_LIBS "@CMAKE_THREAD_LIBS@" CACHE STRING
+ "Thread library used")
+SET (CMAKE_DL_LIBS "@CMAKE_DL_LIBS@" CACHE STRING
+ "Dynamic link library to link in.")
+SET (CMAKE_SHLIB_LINK_FLAGS "@CMAKE_SHLIB_LINK_FLAGS@" CACHE STRING
+ "Flags used to link a shared library.")
+SET (CMAKE_MODULE_LINK_FLAGS "@CMAKE_MODULE_LINK_FLAGS@" CACHE STRING
+ "Flags used to link a shared library.")
+SET (CMAKE_SHLIB_LD_LIBS "@CMAKE_SHLIB_LD_LIBS@" CACHE STRING
+ "Libraries used by LD for shared libraries")
+SET (CMAKE_SHLIB_RUNTIME_FLAG "@CMAKE_SHLIB_RUNTIME_FLAG@" CACHE STRING
+ "Flag used to specify run-time search paths")
+SET (CMAKE_SHLIB_RUNTIME_SEP "@CMAKE_SHLIB_RUNTIME_SEP@" CACHE STRING
+ "If null, each runtime path is a separate option. Otherwise, they are all joined, separated by this.")
+# support for X11
+SET (CMAKE_X_LIBS "@X_PRE_LIBS@ @X_LIBS@ -lX11 -lXext @X_EXTRA_LIBS@" CACHE STRING "Libraries and options used in X11 programs")
+SET (CMAKE_X_CFLAGS "@X_CFLAGS@" CACHE STRING "X11 extra flags")
+SET (CMAKE_HAS_X @CMAKE_HAS_X@ CACHE INTERNAL "Is X11 around")
+SET (CMAKE_NO_ANSI_STREAM_HEADERS @CMAKE_NO_ANSI_STREAM_HEADERS@ CACHE INTERNAL "does the compiler support headers like iostream ")
+SET (CMAKE_NO_STD_NAMESPACE @CMAKE_NO_STD_NAMESPACE@ CACHE INTERNAL "does the compiler support std:: ")
+SET (CMAKE_NO_ANSI_FOR_SCOPE @CMAKE_NO_ANSI_FOR_SCOPE@ CACHE INTERNAL "does the compiler support ansi for scoping.")
+SET (CMAKE_COMPILER_IS_GNUCXX @CMAKE_COMPILER_IS_GNUCXX@ CACHE INTERNAL "Is the compile GNU C++")
+SET (CMAKE_ANSI_CFLAGS @CMAKE_ANSI_CFLAGS@ CACHE INTERNAL "What flags are required by the c++ compiler to make it ansi.")
+SET (CMAKE_ANSI_CXXFLAGS @CMAKE_ANSI_CXXFLAGS@ CACHE INTERNAL "What flags are required by the c++ compiler to make it ansi.")
+SET (CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION @CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION@ CACHE INTERNAL "does the compiler not support explicit template instantiation.")
+FIND_PROGRAM(CMAKE_MAKE_PROGRAM NAMES gmake make )
+
+# the following variables are advanced
+MARK_AS_ADVANCED(
+CMAKE_X_LIBS
+CMAKE_USE_WIN32_THREADS
+CMAKE_USE_SPROC
+CMAKE_USE_PTHREADS
+CMAKE_SHLIB_SUFFIX
+CMAKE_MODULE_SUFFIX
+CMAKE_INSTALL_PREFIX
+CMAKE_CXX_COMPILER
+CMAKE_C_COMPILER
+CMAKE_HP_PTHREADS
+CMAKE_WORDS_BIGENDIAN
+CMAKE_LIB_EXT
+CMAKE_RANLIB
+CMAKE_AR
+CMAKE_AR_ARGS
+CMAKE_TEMPLATE_FLAGS
+CMAKE_SHLIB_CFLAGS
+CMAKE_SHLIB_BUILD_FLAGS
+CMAKE_MODULE_BUILD_FLAGS
+CMAKE_THREAD_LIBS
+CMAKE_DL_LIBS
+CMAKE_SHLIB_LINK_FLAGS
+CMAKE_MODULE_LINK_FLAGS
+CMAKE_SHLIB_LD_LIBS
+CMAKE_SHLIB_RUNTIME_FLAG
+CMAKE_SHLIB_RUNTIME_SEP
+CMAKE_X_CFLAGS
+CMAKE_NO_ANSI_STREAM_HEADERS
+CMAKE_NO_ANSI_FOR_SCOPE
+CMAKE_NO_STD_NAMESPACE
+CMAKE_COMPILER_IS_GNUCXX
+CMAKE_ANSI_CFLAGS
+CMAKE_ANSI_CXXFLAGS
+CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION
+CMAKE_MAKE_PROGRAM
+)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..86e8ca8dcec1a8d02eec1ee305a5f8d677556a64
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig.cmake
@@ -0,0 +1,97 @@
+#
+# Borland configuration.
+# Note that this is valid for Borland C++Builder 5 with patch #1
+#
+
+SET (WORDS_BIGENDIAN )
+
+SET (CMAKE_CXX_COMPILER "Borland_BCB_5.5.1" CACHE STRING "C++ compiler used.")
+
+#
+# We need the Borland compiler path
+#
+
+FIND_PATH(BCB_BIN_PATH bcc32.exe
+ "C:/Program Files/Borland/CBuilder5/Bin"
+ "C:/Borland/Bcc55/Bin"
+ "/Borland/Bcc55/Bin"
+ [HKEY_LOCAL_MACHINE/SOFTWARE/Borland/C++Builder/5.0/RootDir]/Bin
+)
+
+#
+# override opengl library as it is bound to import32.lib already
+#
+
+IF (OPENGL_LIBRARY)
+ SET (OPENGL_LIBRARY import32 CACHE STRING "OpenGL library linked by Borland's import32.lib")
+ENDIF (OPENGL_LIBRARY)
+
+#
+# Set debug compile flags if not already set/edited by user
+#
+
+IF (NOT FLAGS_CPP_DEBUG)
+ SET (FLAGS_CPP_DEBUG "-a8 -c -d -tWM -tWR -Ve -Vx -k -Od -r- -v -vi- -y" CACHE STRING "Flags used by CPP compiler in DEBUG mode")
+ENDIF (NOT FLAGS_CPP_DEBUG)
+
+#
+# Set release compile flags if not already set/edited by user
+#
+
+IF (NOT FLAGS_CPP_RELEASE)
+ SET (FLAGS_CPP_RELEASE "-a8 -c -d -tWM -tWR -Ve -Vx -k- -O2 -r -v-" CACHE STRING "Flags used by CPP compiler in RELEASE mode")
+ENDIF (NOT FLAGS_CPP_RELEASE)
+
+#
+# Set compiler warning flags if not already set/edited by user
+#
+
+IF (NOT FLAGS_CPP_WARNING)
+ SET (FLAGS_CPP_WARNING "-w- -whid -waus -wpar" CACHE STRING "Flags used to control compiler warnings")
+ENDIF (NOT FLAGS_CPP_WARNING)
+
+#
+# Set link flags if not already set/edited by user
+#
+
+IF (NOT FLAGS_LINK_DLL)
+ SET (FLAGS_LINK_DLL "-aa -Tpd -x -Gn -Gl" CACHE STRING "Flags used by Linker for DLL")
+ENDIF (NOT FLAGS_LINK_DLL)
+
+IF (NOT FLAGS_LINK_BPL)
+ SET (FLAGS_LINK_BPL "-aa -Tpp -x -Gn -Gi" CACHE STRING "Flags used by Linker for BPL")
+ENDIF (NOT FLAGS_LINK_BPL)
+
+IF (NOT FLAGS_LINK_LIB)
+ SET (FLAGS_LINK_LIB "-aa -x -Gn -Gl -P128" CACHE STRING "Flags used by Linker for LIB")
+ENDIF (NOT FLAGS_LINK_LIB)
+
+IF (NOT FLAGS_LINK_EXE)
+ SET (FLAGS_LINK_EXE "-aa -Tpe -x -Gn" CACHE STRING "Flags used by Linker for EXE")
+ENDIF (NOT FLAGS_LINK_EXE)
+
+IF (NOT FLAGS_LINK_DEBUG)
+ SET (FLAGS_LINK_DEBUG "-v" CACHE STRING "Flags used by Linker in DEBUG mode")
+ENDIF (NOT FLAGS_LINK_DEBUG)
+
+IF (NOT FLAGS_LINK_STATIC)
+ SET (FLAGS_LINK_STATIC "/P128" CACHE STRING "Set default Page size to 128 for static libraries")
+ENDIF (NOT FLAGS_LINK_STATIC)
+
+#
+# Set User Conditional Defines to Defaults
+#
+
+IF (NOT DEFS_USER)
+ SET (DEFS_USER "" CACHE STRING "Compiler conditional defines set by the user")
+ENDIF (NOT DEFS_USER)
+
+#
+# Set SYS Conditional Defines to Defaults
+#
+
+IF (NOT DEFS_SYS)
+ SET (DEFS_SYS "-DWIN32;WIN32_LEAN_AND_MEAN;STRICT;_RTLDLL;USEPACKAGES" CACHE STRING "Compiler conditional defines required for correct compilation")
+ENDIF (NOT DEFS_SYS)
+
+FIND_PROGRAM(CMAKE_MAKE_PROGRAM make ${BCB_BIN_PATH} )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig2.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig2.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..b67aad8c2e6f005ae288de6334ce9ab893e9bd2c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsBorlandConfig2.cmake
@@ -0,0 +1,40 @@
+# microsoft specific config file
+
+FIND_PATH(BCB_BIN_PATH bcc32.exe
+ "C:/Program Files/Borland/CBuilder5/Bin"
+ "C:/Borland/Bcc55/Bin"
+ "/Borland/Bcc55/Bin"
+ [HKEY_LOCAL_MACHINE/SOFTWARE/Borland/C++Builder/5.0/RootDir]/Bin
+)
+SET (BORLAND 1)
+SET (WORDS_BIGENDIAN )
+SET (HAVE_LIMITS_H 1)
+SET (HAVE_UNISTD_H 1)
+SET (CMAKE_CXX_COMPILER "${BCB_BIN_PATH}/bcc32" CACHE FILEPATH
+ "Name of C++ compiler used.")
+SET (CMAKE_C_COMPILER ${BCB_BIN_PATH}/bcc32 CACHE FILEPATH
+ "Name of C compiler used.")
+SET (CMAKE_CFLAGS "-w- -whid -waus -wpar" CACHE STRING
+ "Flags for C compiler.")
+SET (CMAKE_BUILD_TYPE Debug CACHE STRING
+"Choose the type of build, options are: Debug Release RelWithDebInfo MinSizeRel")
+SET (CMAKE_CXX_FLAGS_RELEASE "-O2" CACHE STRING
+ "Flags used by the compiler during release builds.)")
+SET (CMAKE_CXX_FLAGS_RELWITHDEBINFO "-Od" CACHE STRING
+ "Flags used by the compiler during Release with Debug Info builds")
+SET (CMAKE_CXX_FLAGS_MINSIZEREL "-O1" CACHE STRING
+ "Flags used by the compiler during release minsize builds")
+SET (CMAKE_CXX_FLAGS_DEBUG "-Od" CACHE STRING
+ "Flags used by the compiler during debug builds")
+SET (CMAKE_CXX_FLAGS "-w- -whid -waus -wpar" CACHE STRING
+ "Flags used by the compiler during all build types, /GX /GR are for exceptions and rtti in VC++, /Zm1000 increases the compiler's memory allocation to support ANSI C++/stdlib")
+SET (CMAKE_USE_WIN32_THREADS 1 CACHE BOOL "Use the win32 thread library")
+SET (CMAKE_STANDARD_WINDOWS_LIBRARIES "import32.lib"
+ CACHE STRING "Libraries linked by defalut with all applications")
+SET (CMAKE_SHLIB_SUFFIX ".dll" CACHE STRING "Shared library suffix")
+SET (CMAKE_MODULE_SUFFIX ".dll" CACHE STRING "Module library suffix")
+
+FIND_PROGRAM(CMAKE_MAKE_PROGRAM make ${BCB_BIN_PATH} )
+
+
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsSystemConfig.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsSystemConfig.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..3a57d049464bf4936481322484013a01c139e9f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/CMakeWindowsSystemConfig.cmake
@@ -0,0 +1,30 @@
+# microsoft specific config file
+SET (WORDS_BIGENDIAN )
+SET (HAVE_LIMITS_H 1)
+SET (HAVE_UNISTD_H 1)
+SET (CMAKE_CXX_COMPILER VC++60 CACHE STRING
+ "Name of C++ compiler used.")
+SET (CMAKE_CXX_FLAGS_RELEASE "/MD /O2" CACHE STRING
+ "Flags used by the compiler during release builds (/MD /Ob1 /Oi /Ot /Oy /Gs will produce slightly less optimized but smaller files)")
+SET (CMAKE_CXX_FLAGS_RELWITHDEBINFO "/MD /Zi /O2" CACHE STRING
+ "Flags used by the compiler during Release with Debug Info builds")
+SET (CMAKE_CXX_FLAGS_MINSIZEREL "/MD /O1" CACHE STRING
+ "Flags used by the compiler during release minsize builds")
+SET (CMAKE_CXX_FLAGS_DEBUG "/MDd /Zi /Od /GZ" CACHE STRING
+ "Flags used by the compiler during debug builds")
+SET (CMAKE_CXX_FLAGS "/W3 /Zm1000 /GX /GR" CACHE STRING
+ "Flags used by the compiler during all build types, /GX /GR are for exceptions and rtti in VC++, /Zm1000 increases the compiler's memory allocation to support ANSI C++/stdlib")
+SET (CMAKE_USE_WIN32_THREADS 1 CACHE BOOL "Use the win32 thread library")
+SET (CMAKE_MAKE_PROGRAM "msdev" CACHE STRING "Program used to build from dsp files.")
+MARK_AS_ADVANCED(
+WORDS_BIGENDIAN
+HAVE_UNISTD_H
+HAVE_LIMITS_H
+CMAKE_CXX_COMPILER
+CMAKE_CXX_FLAGS_RELEASE
+CMAKE_CXX_FLAGS_RELWITHDEBINFO
+CMAKE_CXX_FLAGS_MINSIZEREL
+CMAKE_CXX_FLAGS_DEBUG
+CMAKE_USE_WIN32_THREADS
+CMAKE_MAKE_PROGRAM
+)
\ No newline at end of file
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..c56ab022034296513c6cedd16f225ae4e9889946
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/DLLHeader.dsptemplate
@@ -0,0 +1,180 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 RelWithDebInfo" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# LIBRARY_OUTPUT_PATH == override in output directory
+# OUTPUT_LIBNAME == name of output library
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 CM_DEBUG_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Ignore_Export_Lib 0
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# SUBTRACT BASE CPP /YX
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /stack:0x989680 /dll /machine:I386
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /stack:0x989680 /dll /machine:I386
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "RelWithDebInfo"
+# PROP BASE Intermediate_Dir "RelWithDebInfo"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelWithDebInfo"
+# PROP Intermediate_Dir "RelWithDebInfo"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELWITHDEBINFO
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386 /pdbtype:sept
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# Name "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..31abd380d953dc4cd25f0bb8f4794a2477e9ece1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEHeader.dsptemplate
@@ -0,0 +1,175 @@
+# Microsoft Developer Studio Project File - Name="pcbuilder" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# CM DSP Header file
+# This file is read by the build system of cm, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXECUTABLE_OUTPUT_PATH == override in output directory
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+# CM_LIBRARIES == libraries linked in
+# TARGTYPE "Win32 (x86) Application" 0x0103
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 RelWithDebInfo" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FD /GZ /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_DEBUG_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "RelWithDebInfo"
+# PROP BASE Intermediate_Dir "RelWithDebInfo"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelWithDebInfo"
+# PROP Intermediate_Dir "RelWithDebInfo"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELWITHDEBINFO
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# Name "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEWinHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEWinHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..359a4065396dbbd8784de1d6d74453b1a8e08600
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/EXEWinHeader.dsptemplate
@@ -0,0 +1,180 @@
+# Microsoft Developer Studio Project File - Name="pcbuilder" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# CM DSP Header file
+# This file is read by the build system of cm, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXECUTABLE_OUTPUT_PATH == override in output directory
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+# CM_LIBRARIES == libraries linked in
+# TARGTYPE "Win32 (x86) Application" 0x0101
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 RelWithDebInfo" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_DEBUG_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "RelWithDebInfo"
+# PROP BASE Intermediate_Dir "RelWithDebInfo"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelWithDebInfo"
+# PROP Intermediate_Dir "RelWithDebInfo"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELWITHDEBINFO
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# Name "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..f59001dfc059b04d2c4f5eded347b7378af29343
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityFooter.dsptemplate
@@ -0,0 +1,2 @@
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..19bd20c56cdb8dd2f5d9bf5079d80f8fa06e7fc5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/UtilityHeader.dsptemplate
@@ -0,0 +1,91 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Generic Project" 0x010a
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 RelWithDebInfo" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Generic Project")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+MTL=midl.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "RelWithDebInfo"
+# PROP BASE Intermediate_Dir "RelWithDebInfo"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelWithDebInfo"
+# PROP Intermediate_Dir "RelWithDebInfo"
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# Name "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure
new file mode 100644
index 0000000000000000000000000000000000000000..6c15a69df4990946be3dcd028ad04a2fcef29590
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure
@@ -0,0 +1,3490 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --with-x use the X Window System"
+ac_help="$ac_help
+ --with-sproc use sproc instead of pthreads if possible"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+CMAKE_CONFIG_DIR=`pwd`
+
+
+#
+# check for some programs we use
+#
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:539: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:569: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:620: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:652: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 663 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:668: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:694: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:699: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:708: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:727: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+for ac_prog in $CCC c++ g++ gcc CC cxx cc++ cl
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:763: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CXX'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CXX"; then
+ ac_cv_prog_CXX="$CXX" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CXX="$ac_prog"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CXX="$ac_cv_prog_CXX"
+if test -n "$CXX"; then
+ echo "$ac_t""$CXX" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$CXX" && break
+done
+test -n "$CXX" || CXX="gcc"
+
+
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:795: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) works" >&5
+
+ac_ext=C
+# CXXFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='${CXX-g++} -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CXX-g++} -o conftest${ac_exeext} $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cxx_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 806 "configure"
+#include "confdefs.h"
+
+int main(){return(0);}
+EOF
+if { (eval echo configure:811: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cxx_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cxx_cross=no
+ else
+ ac_cv_prog_cxx_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cxx_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cxx_works" 1>&6
+if test $ac_cv_prog_cxx_works = no; then
+ { echo "configure: error: installation or configuration problem: C++ compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:837: checking whether the C++ compiler ($CXX $CXXFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cxx_cross" 1>&6
+cross_compiling=$ac_cv_prog_cxx_cross
+
+echo $ac_n "checking whether we are using GNU C++""... $ac_c" 1>&6
+echo "configure:842: checking whether we are using GNU C++" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gxx'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.C <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CXX-g++} -E conftest.C'; { (eval echo configure:851: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gxx=yes
+else
+ ac_cv_prog_gxx=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gxx" 1>&6
+
+if test $ac_cv_prog_gxx = yes; then
+ GXX=yes
+else
+ GXX=
+fi
+
+ac_test_CXXFLAGS="${CXXFLAGS+set}"
+ac_save_CXXFLAGS="$CXXFLAGS"
+CXXFLAGS=
+echo $ac_n "checking whether ${CXX-g++} accepts -g""... $ac_c" 1>&6
+echo "configure:870: checking whether ${CXX-g++} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cxx_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.cc
+if test -z "`${CXX-g++} -g -c conftest.cc 2>&1`"; then
+ ac_cv_prog_cxx_g=yes
+else
+ ac_cv_prog_cxx_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cxx_g" 1>&6
+if test "$ac_test_CXXFLAGS" = set; then
+ CXXFLAGS="$ac_save_CXXFLAGS"
+elif test $ac_cv_prog_cxx_g = yes; then
+ if test "$GXX" = yes; then
+ CXXFLAGS="-g -O2"
+ else
+ CXXFLAGS="-g"
+ fi
+else
+ if test "$GXX" = yes; then
+ CXXFLAGS="-O2"
+ else
+ CXXFLAGS=
+ fi
+fi
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:904: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:962: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# check for X11 support
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1017: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1032 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1038: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1049 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1055: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1066 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1072: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+# If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# Uses ac_ vars as temps to allow command line to override cache and checks.
+# --without-x overrides everything else, but does not touch the cache.
+echo $ac_n "checking for X""... $ac_c" 1>&6
+echo "configure:1101: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+ withval="$with_x"
+ :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+ # Both variables are already set.
+ have_x=yes
+ else
+if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+ cd conftestdir
+ # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+ cat > Imakefile <<'EOF'
+acfindx:
+ @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl; do
+ if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+ test -f $ac_im_libdir/libX11.$ac_extension; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case "$ac_im_incroot" in
+ /usr/include) ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+ esac
+ case "$ac_im_usrlibdir" in
+ /usr/lib | /lib) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+ esac
+ fi
+ cd ..
+ rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+ # Guess where to find include files, by looking for this one X11 .h file.
+ test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+ # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 1163 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1168: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ for ac_dir in \
+ /usr/X11/include \
+ /usr/X11R6/include \
+ /usr/X11R5/include \
+ /usr/X11R4/include \
+ \
+ /usr/include/X11 \
+ /usr/include/X11R6 \
+ /usr/include/X11R5 \
+ /usr/include/X11R4 \
+ \
+ /usr/local/X11/include \
+ /usr/local/X11R6/include \
+ /usr/local/X11R5/include \
+ /usr/local/X11R4/include \
+ \
+ /usr/local/include/X11 \
+ /usr/local/include/X11R6 \
+ /usr/local/include/X11R5 \
+ /usr/local/include/X11R4 \
+ \
+ /usr/X386/include \
+ /usr/x386/include \
+ /usr/XFree86/include/X11 \
+ \
+ /usr/include \
+ /usr/local/include \
+ /usr/unsupported/include \
+ /usr/athena/include \
+ /usr/local/x11r5/include \
+ /usr/lpp/Xamples/include \
+ \
+ /usr/openwin/include \
+ /usr/openwin/share/include \
+ ; \
+ do
+ if test -r "$ac_dir/$x_direct_test_include"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+ done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+ # Check for the libraries.
+
+ test -z "$x_direct_test_library" && x_direct_test_library=Xt
+ test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS="$LIBS"
+ LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1237 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:1244: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+ /usr/X11/lib \
+ /usr/X11R6/lib \
+ /usr/X11R5/lib \
+ /usr/X11R4/lib \
+ \
+ /usr/lib/X11 \
+ /usr/lib/X11R6 \
+ /usr/lib/X11R5 \
+ /usr/lib/X11R4 \
+ \
+ /usr/local/X11/lib \
+ /usr/local/X11R6/lib \
+ /usr/local/X11R5/lib \
+ /usr/local/X11R4/lib \
+ \
+ /usr/local/lib/X11 \
+ /usr/local/lib/X11R6 \
+ /usr/local/lib/X11R5 \
+ /usr/local/lib/X11R4 \
+ \
+ /usr/X386/lib \
+ /usr/x386/lib \
+ /usr/XFree86/lib/X11 \
+ \
+ /usr/lib \
+ /usr/local/lib \
+ /usr/unsupported/lib \
+ /usr/athena/lib \
+ /usr/local/x11r5/lib \
+ /usr/lpp/Xamples/lib \
+ /lib/usr/lib/X11 \
+ \
+ /usr/openwin/lib \
+ /usr/openwin/share/lib \
+ ; \
+do
+ for ac_extension in a so sl; do
+ if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+ # Didn't find X anywhere. Cache the known absence of X.
+ ac_cv_have_x="have_x=no"
+else
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+fi
+ fi
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ echo "$ac_t""$have_x" 1>&6
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+ echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+if test "$no_x" = yes; then
+ # Not all programs may use this symbol, but it does not hurt to define it.
+ cat >> confdefs.h <<\EOF
+#define X_DISPLAY_MISSING 1
+EOF
+
+ X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
+else
+ if test -n "$x_includes"; then
+ X_CFLAGS="$X_CFLAGS -I$x_includes"
+ fi
+
+ # It would also be nice to do this for all -L options, not just this one.
+ if test -n "$x_libraries"; then
+ X_LIBS="$X_LIBS -L$x_libraries"
+ # For Solaris; some versions of Sun CC require a space after -R and
+ # others require no space. Words are not sufficient . . . .
+ case "`(uname -sr) 2>/dev/null`" in
+ "SunOS 5"*)
+ echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6
+echo "configure:1350: checking whether -R must be followed by a space" >&5
+ ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 1353 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1360: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_R_nospace=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_nospace=no
+fi
+rm -f conftest*
+ if test $ac_R_nospace = yes; then
+ echo "$ac_t""no" 1>&6
+ X_LIBS="$X_LIBS -R$x_libraries"
+ else
+ LIBS="$ac_xsave_LIBS -R $x_libraries"
+ cat > conftest.$ac_ext <<EOF
+#line 1376 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1383: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_R_space=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_R_space=no
+fi
+rm -f conftest*
+ if test $ac_R_space = yes; then
+ echo "$ac_t""yes" 1>&6
+ X_LIBS="$X_LIBS -R $x_libraries"
+ else
+ echo "$ac_t""neither works" 1>&6
+ fi
+ fi
+ LIBS="$ac_xsave_LIBS"
+ esac
+ fi
+
+ # Check for system-dependent libraries X programs must link with.
+ # Do this before checking for the system-independent R6 libraries
+ # (-lICE), since we may need -lsocket or whatever for X linking.
+
+ if test "$ISC" = yes; then
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
+ else
+ # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X
+ # libraries were built with DECnet support. And karl@cs.umb.edu says
+ # the Alpha needs dnet_stub (dnet does not exist).
+ echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6
+echo "configure:1415: checking for dnet_ntoa in -ldnet" >&5
+ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldnet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1423 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:1434: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_lib_dnet_dnet_ntoa = no; then
+ echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6
+echo "configure:1456: checking for dnet_ntoa in -ldnet_stub" >&5
+ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldnet_stub $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1464 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dnet_ntoa();
+
+int main() {
+dnet_ntoa()
+; return 0; }
+EOF
+if { (eval echo configure:1475: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
+ # to get the SysV transport functions.
+ # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4)
+ # needs -lnsl.
+ # The nsl library prevents programs from opening the X display
+ # on Irix 5.2, according to dickey@clark.net.
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:1504: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1509 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1532: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_gethostbyname = no; then
+ echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6
+echo "configure:1553: checking for gethostbyname in -lnsl" >&5
+ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1561 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+gethostbyname()
+; return 0; }
+EOF
+if { (eval echo configure:1572: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # lieder@skyler.mavd.honeywell.com says without -lsocket,
+ # socket/setsockopt and other routines are undefined under SCO ODT
+ # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary
+ # on later versions), says simon@lia.di.epfl.ch: it contains
+ # gethostby* variants that don't use the nameserver (or something).
+ # -lsocket must be given before -lnsl if both are needed.
+ # We assume that if connect needs -lnsl, so does gethostbyname.
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:1602: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1607 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1630: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_connect = no; then
+ echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6
+echo "configure:1651: checking for connect in -lsocket" >&5
+ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1659 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+connect()
+; return 0; }
+EOF
+if { (eval echo configure:1670: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX.
+ echo $ac_n "checking for remove""... $ac_c" 1>&6
+echo "configure:1694: checking for remove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_remove'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1699 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char remove(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char remove();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_remove) || defined (__stub___remove)
+choke me
+#else
+remove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1722: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_remove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_remove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_remove = no; then
+ echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6
+echo "configure:1743: checking for remove in -lposix" >&5
+ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lposix $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1751 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char remove();
+
+int main() {
+remove()
+; return 0; }
+EOF
+if { (eval echo configure:1762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+
+ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
+ echo $ac_n "checking for shmat""... $ac_c" 1>&6
+echo "configure:1786: checking for shmat" >&5
+if eval "test \"`echo '$''{'ac_cv_func_shmat'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1791 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char shmat(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shmat();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_shmat) || defined (__stub___shmat)
+choke me
+#else
+shmat();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1814: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_shmat=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test $ac_cv_func_shmat = no; then
+ echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6
+echo "configure:1835: checking for shmat in -lipc" >&5
+ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lipc $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1843 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shmat();
+
+int main() {
+shmat()
+; return 0; }
+EOF
+if { (eval echo configure:1854: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ fi
+
+ # Check for libraries that X11R6 Xt/Xaw programs need.
+ ac_save_LDFLAGS="$LDFLAGS"
+ test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
+ # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
+ # check for ICE first), but we must link in the order -lSM -lICE or
+ # we get undefined symbols. So assume we have SM if we have ICE.
+ # These have to be linked with before -lX11, unlike the other
+ # libraries we check for below, so use a different variable.
+ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu.
+ echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6
+echo "configure:1887: checking for IceConnectionNumber in -lICE" >&5
+ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lICE $X_EXTRA_LIBS $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1895 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char IceConnectionNumber();
+
+int main() {
+IceConnectionNumber()
+; return 0; }
+EOF
+if { (eval echo configure:1906: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ LDFLAGS="$ac_save_LDFLAGS"
+
+fi
+
+CMAKE_HAS_X=0
+if test "$no_x"a = a; then
+CMAKE_HAS_X=1
+fi
+
+
+# get byte swapping info
+echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6
+echo "configure:1938: checking whether byte ordering is bigendian" >&5
+if eval "test \"`echo '$''{'ac_cv_c_bigendian'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_cv_c_bigendian=unknown
+# See if sys/param.h defines the BYTE_ORDER macro.
+cat > conftest.$ac_ext <<EOF
+#line 1945 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
+ bogus endian macros
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1956: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+cat > conftest.$ac_ext <<EOF
+#line 1960 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/param.h>
+int main() {
+
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+#endif
+; return 0; }
+EOF
+if { (eval echo configure:1971: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_c_bigendian=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_c_bigendian=no
+fi
+rm -f conftest*
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+fi
+rm -f conftest*
+if test $ac_cv_c_bigendian = unknown; then
+if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1991 "configure"
+#include "confdefs.h"
+main () {
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long l;
+ char c[sizeof (long)];
+ } u;
+ u.l = 1;
+ exit (u.c[sizeof (long) - 1] == 1);
+}
+EOF
+if { (eval echo configure:2004: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_bigendian=no
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_bigendian=yes
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_bigendian" 1>&6
+if test $ac_cv_c_bigendian = yes; then
+ cat >> confdefs.h <<\EOF
+#define WORDS_BIGENDIAN 1
+EOF
+
+fi
+
+if test $ac_cv_c_bigendian = yes; then
+ CMAKE_WORDS_BIGENDIAN=1
+fi
+
+
+
+# some stuff Tcl uses
+#
+ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for limits.h""... $ac_c" 1>&6
+echo "configure:2037: checking for limits.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2042 "configure"
+#include "confdefs.h"
+#include <limits.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2047: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ HAVE_LIMITS_H=-DHAVE_LIMITS_H
+else
+ echo "$ac_t""no" 1>&6
+HAVE_LIMITS_H=""
+fi
+
+
+for ac_hdr in unistd.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2074: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2079 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2084: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ HAVE_UNISTD_H=-DHAVE_UNISTD_H
+else
+ echo "$ac_t""no" 1>&6
+HAVE_UNISTD_H=""
+fi
+done
+
+
+
+# Step 1: set the variable "system" to hold the name and version number
+# for the system. This can usually be done via the "uname" command, but
+# there are a few systems, like Next, where this doesn't work.
+
+echo $ac_n "checking system version (for dynamic loading)""... $ac_c" 1>&6
+echo "configure:2118: checking system version (for dynamic loading)" >&5
+if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ echo "$ac_t""unknown (can't find uname command)" 1>&6
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ echo "$ac_t""$system" 1>&6
+ fi
+fi
+
+#
+# use shared libs
+#
+
+
+CMAKE_shared_ok="yes"
+# the following is an excerpt from the tcl7.5b2 configure.in
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# dynamic loading and shared libraries:
+#
+# CMAKE_SHLIB_CFLAGS - Flags to pass to cc when compiling the components
+# of a shared library (may request position-independent
+# code, among other things).
+# CMAKE_SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
+# creating shared libraries. This symbol typically
+# goes at the end of the "ld" commands that build
+# shared libraries. The value of the symbol if
+# "${LIBS}" if all of the dependent libraries should
+# be specified when creating a shared library. If
+# dependent libraries should not be specified (as on
+# SunOS 4.x, where they cause the link to fail, or in
+# general if Tcl and Tk aren't themselves shared
+# libraries), then this symbol has an empty string
+# as its value.
+# CMAKE_SHLIB_SUFFIX - Suffix to use for the name of the shared library. An
+# empty string means we don't know how to use shared
+# libraries on this platform.
+# CMAKE_SHLIB_BUILD_FLAGS -
+# Flags to use when building a shared library.
+# CMAKE_SHLIB_LINK_FLAGS -
+# Flags to pass to the compiler when linking object
+# files into an executable application binary such
+# as tclsh.
+# CMAKE_SHLIB_RUNTIME_FLAG -
+# Flag used to specify the runtime directories (e.g. "-R" or
+# "-Wl,-rpath,"). If null, no attempt is make to specify the
+# runtime paths.
+# CMAKE_SHLIB_RUNTIME_SEP -
+# If null, then each path is a separate argument. If not null,
+# then all the directories are joined together, separated by
+# $(CMAKE_SHLIB_RUNTIME_SEP) and appended to
+# $(CMAKE_SHLIB_RUNTIME_FLAG). When not null, this is
+# typically a colon ":".
+#--------------------------------------------------------------------
+
+
+# Step 2: check for existence of -ldl library. This is needed because
+# Linux can use either -ldl or -ldld for dynamic loading.
+
+echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
+echo "configure:2188: checking for dlopen in -ldl" >&5
+ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2196 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dlopen();
+
+int main() {
+dlopen()
+; return 0; }
+EOF
+if { (eval echo configure:2207: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ have_dl=yes
+else
+ echo "$ac_t""no" 1>&6
+have_dl=no
+fi
+
+
+# Step 4: set configuration options based on system name and version.
+
+fullSrcDir=`cd $srcdir; pwd`
+
+case $system in
+ AIX-*)
+ # AIX: can't link shared library extensions unless Tcl and Tk are
+ # also shared libraries.
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS='${LIBS}'
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ echo $ac_n "checking for printf in -lld""... $ac_c" 1>&6
+echo "configure:2243: checking for printf in -lld" >&5
+ac_lib_var=`echo ld'_'printf | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lld $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2251 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char printf();
+
+int main() {
+printf()
+; return 0; }
+EOF
+if { (eval echo configure:2262: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_DL_LIBS="-lld"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ Darwin-*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".dylib"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-dynamiclib"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_BUILD_FLAGS="-bundle"
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
+ CMAKE_SHLIB_CFLAGS="+z"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".sl"
+ CMAKE_MODULE_SUFFIX=".sl"
+ CMAKE_DL_LIBS="-ldld"
+ CMAKE_SHLIB_BUILD_FLAGS='+Z -Wl,-E -b'
+ CMAKE_SHLIB_LINK_FLAGS='-Wl,+s'
+ CMAKE_MODULE_BUILD_FLAGS='+Z -Wl,-E -b'
+ CMAKE_MODULE_LINK_FLAGS='-Wl,+s'
+ CMAKE_SHLIB_RUNTIME_FLAG='-Wl,+b,'
+ CMAKE_SHLIB_RUNTIME_SEP=':'
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-E -Wl,-b'
+ CMAKE_SHLIB_LINK_FLAGS='-Wl,+s'
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-E -Wl,-b'
+ CMAKE_MODULE_LINK_FLAGS='-Wl,+s'
+ CMAKE_SHLIB_RUNTIME_FLAG='-Wl,+b,'
+ CMAKE_SHLIB_RUNTIME_SEP=':'
+ fi
+ ;;
+ IRIX-5.*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ IRIX-6* | IRIX64-6* | IRIX-64-6*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ Linux*)
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ if test "$have_dl" = yes; then
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-rdynamic"
+ CMAKE_MODULE_LINK_FLAGS="-rdynamic"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ else
+ ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dld.h""... $ac_c" 1>&6
+echo "configure:2359: checking for dld.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2364 "configure"
+#include "confdefs.h"
+#include <dld.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2369: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+
+ CMAKE_DL_LIBS="-ldld"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=""
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ ;;
+ CYGWIN_NT*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_DL_LIBS="-lgdi32"
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ CMAKE_SHLIB_SUFFIX=".dll"
+ CMAKE_MODULE_SUFFIX=".dll"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ MP-RAS-02*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ MP-RAS-*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ NetBSD-*|FreeBSD-*)
+ # Not available on all versions: check for include file.
+ if test -f /usr/include/dlfcn.h; then
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ else
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ fi
+ ;;
+ NEXTSTEP-*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-1.012)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ CMAKE_SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ CMAKE_SHLIB_CFLAGS="-fpic"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-expect_unresolved,\\*'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-expect_unresolved,\\*'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ RISCos-*)
+ CMAKE_SHLIB_CFLAGS="-G 0"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ CMAKE_SHLIB_CFLAGS="-Kpic -belf"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-belf -Wl,-Bexport"
+ CMAKE_SHLIB_MODULE_FLAGS="-belf -Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SINIX*5.4*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SunOS-4*)
+ CMAKE_SHLIB_CFLAGS="-PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-r -nostdlib'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-r -nostdlib'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-R,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ SunOS-5*)
+ CMAKE_SHLIB_CFLAGS="-KPIC"
+ CMAKE_SHLIB_LD_LIBS='${LIBS}'
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_BUILD_FLAGS='-G'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-G'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-R "
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_BUILD_FLAGS='-Wl,-G'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-Wl,-G'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-R,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ fi
+ ;;
+ ULTRIX-4.*)
+ CMAKE_SHLIB_CFLAGS="-G 0"
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ UNIX_SV*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+esac
+export CMAKE_SHLIB_SUFFIX
+export CMAKE_MODULE_SUFFIX
+
+# If we're running gcc, then change the C flags for compiling shared
+# libraries to the right flags for gcc, instead of those for the
+# standard manufacturer compiler.
+if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+fi
+# if running on cygwin remove -fPIC flag
+case $system in
+ CYGWIN_NT*)
+ CMAKE_SHLIB_CFLAGS=""
+ ;;
+ Darwin*) #don't need -fPIC on Darwin (on by default)
+ CMAKE_SHLIB_CFLAGS=""
+ ;;
+esac
+
+# if running on darwin no explicit template instantiations
+case $system in
+ Darwin*)
+ CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION="1"
+ ;;
+esac
+
+
+# If the user has supplied C flags for compiling shared objects, use
+# those instead
+if test "${SHLIB_CFLAGS}" != ""; then
+ CMAKE_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+fi
+CMAKE_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+##########################
+## ##
+## Check thread support ##
+## ##
+##########################
+# initialize thread vars
+CMAKE_THREAD_LIBS=""
+use_sproc=no
+CMAKE_USE_SPROC=0
+CMAKE_USE_PTHREADS=0
+CMAKE_HP_PTHREADS=0
+
+##########################
+## ##
+## sproc ##
+## ##
+##########################
+# check for sproc
+force_sproc=no
+# Check whether --with-sproc or --without-sproc was given.
+if test "${with_sproc+set}" = set; then
+ withval="$with_sproc"
+ if test "$withval" = yes; then
+ force_sproc=yes
+ fi
+fi
+
+
+
+
+for ac_hdr in sys/prctl.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2683: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2688 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2693: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ use_sproc=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+if test "$use_sproc" = "yes"; then
+case $system in
+ Linux* | IRIX64-6.5 | IRIX-6.5)
+ if test "$force_sproc" = "yes"; then
+ CMAKE_USE_SPROC=1
+ else
+ use_sproc=no
+ fi
+ ;;
+ IRIX*)
+ CMAKE_USE_SPROC=1
+ ;;
+esac
+fi
+use_pthreads=no
+for ac_hdr in pthread.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:2738: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2743 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2748: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+ use_pthreads=yes
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+if test "$use_pthreads" = "yes"; then
+ if test "$use_sproc" = "no"; then
+ echo $ac_n "checking for pthread_create in -lpthreads""... $ac_c" 1>&6
+echo "configure:2777: checking for pthread_create in -lpthreads" >&5
+ac_lib_var=`echo pthreads'_'pthread_create | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthreads $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2785 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_create();
+
+int main() {
+pthread_create()
+; return 0; }
+EOF
+if { (eval echo configure:2796: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_THREAD_LIBS="-lpthreads"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ echo $ac_n "checking for pthread_create in -lpthread""... $ac_c" 1>&6
+echo "configure:2817: checking for pthread_create in -lpthread" >&5
+ac_lib_var=`echo pthread'_'pthread_create | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2825 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char pthread_create();
+
+int main() {
+pthread_create()
+; return 0; }
+EOF
+if { (eval echo configure:2836: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_THREAD_LIBS="-lpthread"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+# Work around Solaris 5.6 and 5.7 bug:
+ if test "`uname -s -r`" = "SunOS 5.6"; then
+ echo $ac_n "checking for thr_create in -lthread""... $ac_c" 1>&6
+echo "configure:2859: checking for thr_create in -lthread" >&5
+ac_lib_var=`echo thread'_'thr_create | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2867 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char thr_create();
+
+int main() {
+thr_create()
+; return 0; }
+EOF
+if { (eval echo configure:2878: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_THREAD_LIBS="$CMAKE_THREAD_LIBS -lthread"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ if test "`uname -s -r`" = "SunOS 5.7"; then
+ echo $ac_n "checking for thr_create in -lthread""... $ac_c" 1>&6
+echo "configure:2901: checking for thr_create in -lthread" >&5
+ac_lib_var=`echo thread'_'thr_create | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2909 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char thr_create();
+
+int main() {
+thr_create()
+; return 0; }
+EOF
+if { (eval echo configure:2920: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_THREAD_LIBS="$CMAKE_THREAD_LIBS -lthread"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ CMAKE_USE_PTHREADS=1
+ fi
+fi
+
+# on an HP with pthread we need to use -lcma
+# on dec alphas we have had problems as well
+if test "$use_pthreads" = "yes"; then
+case $system in
+ HP-UX-*.10.*)
+ CMAKE_THREAD_LIBS="-lcma"
+ CMAKE_USE_PTHREADS=1
+ CMAKE_HP_PTHREADS=1
+ ;;
+ OSF1-V*)
+ CMAKE_USE_PTHREADS=0
+ CMAKE_THREAD_LIBS=""
+ ;;
+ FreeBSD*)
+ CMAKE_USE_PTHREADS=0
+ CMAKE_THREAD_LIBS=""
+ ;;
+ CYGWIN_NT*)
+ CMAKE_THREAD_LIBS=""
+ CMAKE_USE_WIN32_THREADS=0
+ CMAKE_USE_PTHREADS=1
+ ;;
+esac
+fi
+
+
+
+
+
+
+
+
+CMAKE_ANSI_CFLAGS=""
+CMAKE_ANSI_CXXFLAGS=""
+# on hp use -Aa for ansi
+if test $ac_cv_prog_gxx = no; then
+case $system in
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
+ echo $ac_n "checking whether ${CC} accepts -Aa""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.c
+ if test -z "`${CC} -Aa -c conftest.c 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_ANSI_CFLAGS="-Aa"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+ ;;
+ IRIX-5* | IRIX-6* | IRIX64-6* | IRIX-64-6*)
+ echo $ac_n "checking whether ${CC} accepts -LANG:std""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.c
+ if test -z "`${CC} -LANG:std -c conftest.c 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_ANSI_CXXFLAGS="-LANG:std"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+ ;;
+esac
+fi
+
+
+
+# if we are not running g++ then we might need some other flags
+# to get the templates compiled correctly
+CMAKE_TEMPLATE_FLAGS=""
+if test $ac_cv_prog_gxx = no; then
+ echo $ac_n "checking whether ${CXX} accepts -ptused -no_prelink""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.cc
+ if test -z "`${CXX} -ptused -no_prelink -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_TEMPLATE_FLAGS="-ptused -no_prelink"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+fi
+
+
+
+# check no g++ compilers to see if they have the standard
+# ansi stream files (without the .h)
+if test $ac_cv_prog_gxx = no; then
+ echo $ac_n "checking ansi standard C++ stream headers ""... $ac_c" 1>&6
+echo "configure:3030: checking ansi standard C++ stream headers " >&5
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+#include <iostream>
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_ANSI_STREAM_HEADERS="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+
+
+# check to see if stl is in the std namespace
+if test $ac_cv_prog_gxx = no; then
+ echo $ac_n "checking ansi standard namespace support ""... $ac_c" 1>&6
+echo "configure:3047: checking ansi standard namespace support " >&5
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+#include <list>
+void foo() { std::list<int> l; }
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_STD_NAMESPACE="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+
+
+# check to see if for scoping is supported
+if test $ac_cv_prog_gxx = no; then
+ echo $ac_n "checking ansi for scope support ""... $ac_c" 1>&6
+echo "configure:3065: checking ansi for scope support " >&5
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+void foo() { for(int i;;); for(int i;;); }
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_ANSI_FOR_SCOPE="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+
+
+
+if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ SHLIB_CFLAGS="-fPIC"
+fi
+
+# find make to use to build cmake, prefer gmake
+for ac_prog in gmake make
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:3090: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_RUNMAKE'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$RUNMAKE" in
+ /*)
+ ac_cv_path_RUNMAKE="$RUNMAKE" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_RUNMAKE="$RUNMAKE" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_RUNMAKE="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+RUNMAKE="$ac_cv_path_RUNMAKE"
+if test -n "$RUNMAKE"; then
+ echo "$ac_t""$RUNMAKE" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$RUNMAKE" && break
+done
+
+for ac_prog in ar
+do
+# Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:3130: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_CMAKE_AR_TMP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$CMAKE_AR_TMP" in
+ /*)
+ ac_cv_path_CMAKE_AR_TMP="$CMAKE_AR_TMP" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_CMAKE_AR_TMP="$CMAKE_AR_TMP" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_CMAKE_AR_TMP="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+CMAKE_AR_TMP="$ac_cv_path_CMAKE_AR_TMP"
+if test -n "$CMAKE_AR_TMP"; then
+ echo "$ac_t""$CMAKE_AR_TMP" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+test -n "$CMAKE_AR_TMP" && break
+done
+
+CMAKE_AR="$CMAKE_AR_TMP"
+CMAKE_AR_ARGS="cr"
+# if on SunOS and not using gXX then use the compiler to make .a libs
+case $system in
+ SunOS-5*)
+ if test $ac_cv_prog_gxx = yes; then
+ :
+ else
+ echo "Using $CXX -xar -o for creating .a libraries"
+ CMAKE_AR="$CXX"
+ CMAKE_AR_ARGS="-xar -o"
+ fi
+esac
+
+
+
+CMAKE_COMPILER_IS_GNUGXX=0
+if test $ac_cv_prog_gxx = yes; then
+ CMAKE_COMPILER_IS_GNUCXX=1
+fi
+
+# generate output files.
+# create mkdir files just to make some of the directories
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "CMakeSystemConfig.cmake " | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CMAKE_CONFIG_DIR@%$CMAKE_CONFIG_DIR%g
+s%@CC@%$CC%g
+s%@CXX@%$CXX%g
+s%@RANLIB@%$RANLIB%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@CPP@%$CPP%g
+s%@X_CFLAGS@%$X_CFLAGS%g
+s%@X_PRE_LIBS@%$X_PRE_LIBS%g
+s%@X_LIBS@%$X_LIBS%g
+s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g
+s%@CMAKE_HAS_X@%$CMAKE_HAS_X%g
+s%@CMAKE_WORDS_BIGENDIAN@%$CMAKE_WORDS_BIGENDIAN%g
+s%@CMAKE_HAVE_LIMITS_H@%$CMAKE_HAVE_LIMITS_H%g
+s%@CMAKE_HAVE_UNISTD_H@%$CMAKE_HAVE_UNISTD_H%g
+s%@fullSrcDir@%$fullSrcDir%g
+s%@CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION@%$CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION%g
+s%@CMAKE_SHLIB_LINK_FLAGS@%$CMAKE_SHLIB_LINK_FLAGS%g
+s%@CMAKE_SHLIB_BUILD_FLAGS@%$CMAKE_SHLIB_BUILD_FLAGS%g
+s%@CMAKE_MODULE_LINK_FLAGS@%$CMAKE_MODULE_LINK_FLAGS%g
+s%@CMAKE_MODULE_BUILD_FLAGS@%$CMAKE_MODULE_BUILD_FLAGS%g
+s%@CMAKE_SHLIB_CFLAGS@%$CMAKE_SHLIB_CFLAGS%g
+s%@CMAKE_LIB_EXT@%$CMAKE_LIB_EXT%g
+s%@CMAKE_DL_LIBS@%$CMAKE_DL_LIBS%g
+s%@CMAKE_SHLIB_LD_LIBS@%$CMAKE_SHLIB_LD_LIBS%g
+s%@CMAKE_SHLIB_SUFFIX@%$CMAKE_SHLIB_SUFFIX%g
+s%@CMAKE_MODULE_SUFFIX@%$CMAKE_MODULE_SUFFIX%g
+s%@CMAKE_SHLIB_RUNTIME_FLAG@%$CMAKE_SHLIB_RUNTIME_FLAG%g
+s%@CMAKE_SHLIB_RUNTIME_SEP@%$CMAKE_SHLIB_RUNTIME_SEP%g
+s%@CMAKE_USE_SPROC@%$CMAKE_USE_SPROC%g
+s%@CMAKE_USE_PTHREADS@%$CMAKE_USE_PTHREADS%g
+s%@CMAKE_USE_WIN32_THREADS@%$CMAKE_USE_WIN32_THREADS%g
+s%@CMAKE_HP_PTHREADS@%$CMAKE_HP_PTHREADS%g
+s%@CMAKE_THREAD_LIBS@%$CMAKE_THREAD_LIBS%g
+s%@CMAKE_ANSI_CFLAGS@%$CMAKE_ANSI_CFLAGS%g
+s%@CMAKE_ANSI_CXXFLAGS@%$CMAKE_ANSI_CXXFLAGS%g
+s%@CMAKE_TEMPLATE_FLAGS@%$CMAKE_TEMPLATE_FLAGS%g
+s%@CMAKE_NO_ANSI_STREAM_HEADERS@%$CMAKE_NO_ANSI_STREAM_HEADERS%g
+s%@CMAKE_NO_STD_NAMESPACE@%$CMAKE_NO_STD_NAMESPACE%g
+s%@CMAKE_NO_ANSI_FOR_SCOPE@%$CMAKE_NO_ANSI_FOR_SCOPE%g
+s%@RUNMAKE@%$RUNMAKE%g
+s%@CMAKE_AR_TMP@%$CMAKE_AR_TMP%g
+s%@CMAKE_AR@%$CMAKE_AR%g
+s%@CMAKE_AR_ARGS@%$CMAKE_AR_ARGS%g
+s%@CMAKE_COMPILER_IS_GNUCXX@%$CMAKE_COMPILER_IS_GNUCXX%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"CMakeSystemConfig.cmake "}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure.in b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure.in
new file mode 100644
index 0000000000000000000000000000000000000000..c74091bac170080ccc7972477e2a14c18efdbebd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/configure.in
@@ -0,0 +1,684 @@
+# Process this file with autoconf to produce a configure script.
+AC_INIT()
+
+CMAKE_CONFIG_DIR=`pwd`
+AC_SUBST(CMAKE_CONFIG_DIR)
+
+#
+# check for some programs we use
+#
+AC_PROG_CC
+AC_PROG_CXX
+AC_PROG_RANLIB
+AC_PROG_INSTALL
+
+# check for X11 support
+AC_PATH_XTRA
+CMAKE_HAS_X=0
+if test "$no_x"a = a; then
+CMAKE_HAS_X=1
+fi
+AC_SUBST(CMAKE_HAS_X)
+
+# get byte swapping info
+AC_C_BIGENDIAN
+if test $ac_cv_c_bigendian = yes; then
+ CMAKE_WORDS_BIGENDIAN=1
+fi
+AC_SUBST(CMAKE_WORDS_BIGENDIAN)
+
+
+# some stuff Tcl uses
+#
+AC_CHECK_HEADER(limits.h, HAVE_LIMITS_H=-DHAVE_LIMITS_H,HAVE_LIMITS_H="")
+AC_SUBST(CMAKE_HAVE_LIMITS_H)
+AC_HAVE_HEADERS(unistd.h, HAVE_UNISTD_H=-DHAVE_UNISTD_H,HAVE_UNISTD_H="")
+AC_SUBST(CMAKE_HAVE_UNISTD_H)
+
+# Step 1: set the variable "system" to hold the name and version number
+# for the system. This can usually be done via the "uname" command, but
+# there are a few systems, like Next, where this doesn't work.
+
+AC_MSG_CHECKING([system version (for dynamic loading)])
+if test -f /usr/lib/NextStep/software_version; then
+ system=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+else
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ AC_MSG_RESULT([unknown (can't find uname command)])
+ system=unknown
+ else
+ # Special check for weird MP-RAS system (uname returns weird
+ # results, and the version is kept in special file).
+
+ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
+ system=MP-RAS-`awk '{print $3}' /etc/.relid'`
+ fi
+ AC_MSG_RESULT($system)
+ fi
+fi
+
+#
+# use shared libs
+#
+
+
+CMAKE_shared_ok="yes"
+# the following is an excerpt from the tcl7.5b2 configure.in
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# dynamic loading and shared libraries:
+#
+# CMAKE_SHLIB_CFLAGS - Flags to pass to cc when compiling the components
+# of a shared library (may request position-independent
+# code, among other things).
+# CMAKE_SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
+# creating shared libraries. This symbol typically
+# goes at the end of the "ld" commands that build
+# shared libraries. The value of the symbol if
+# "${LIBS}" if all of the dependent libraries should
+# be specified when creating a shared library. If
+# dependent libraries should not be specified (as on
+# SunOS 4.x, where they cause the link to fail, or in
+# general if Tcl and Tk aren't themselves shared
+# libraries), then this symbol has an empty string
+# as its value.
+# CMAKE_SHLIB_SUFFIX - Suffix to use for the name of the shared library. An
+# empty string means we don't know how to use shared
+# libraries on this platform.
+# CMAKE_SHLIB_BUILD_FLAGS -
+# Flags to use when building a shared library.
+# CMAKE_SHLIB_LINK_FLAGS -
+# Flags to pass to the compiler when linking object
+# files into an executable application binary such
+# as tclsh.
+# CMAKE_SHLIB_RUNTIME_FLAG -
+# Flag used to specify the runtime directories (e.g. "-R" or
+# "-Wl,-rpath,"). If null, no attempt is make to specify the
+# runtime paths.
+# CMAKE_SHLIB_RUNTIME_SEP -
+# If null, then each path is a separate argument. If not null,
+# then all the directories are joined together, separated by
+# $(CMAKE_SHLIB_RUNTIME_SEP) and appended to
+# $(CMAKE_SHLIB_RUNTIME_FLAG). When not null, this is
+# typically a colon ":".
+#--------------------------------------------------------------------
+
+
+# Step 2: check for existence of -ldl library. This is needed because
+# Linux can use either -ldl or -ldld for dynamic loading.
+
+AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
+
+# Step 4: set configuration options based on system name and version.
+
+fullSrcDir=`cd $srcdir; pwd`
+AC_SUBST(fullSrcDir)
+case $system in
+ AIX-*)
+ # AIX: can't link shared library extensions unless Tcl and Tk are
+ # also shared libraries.
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS='${LIBS}'
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ AC_CHECK_LIB(ld,printf, CMAKE_DL_LIBS="-lld")
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ Darwin-*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".dylib"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-dynamiclib"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_BUILD_FLAGS="-bundle"
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
+ CMAKE_SHLIB_CFLAGS="+z"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".sl"
+ CMAKE_MODULE_SUFFIX=".sl"
+ CMAKE_DL_LIBS="-ldld"
+ CMAKE_SHLIB_BUILD_FLAGS='+Z -Wl,-E -b'
+ CMAKE_SHLIB_LINK_FLAGS='-Wl,+s'
+ CMAKE_MODULE_BUILD_FLAGS='+Z -Wl,-E -b'
+ CMAKE_MODULE_LINK_FLAGS='-Wl,+s'
+ CMAKE_SHLIB_RUNTIME_FLAG='-Wl,+b,'
+ CMAKE_SHLIB_RUNTIME_SEP=':'
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-E -Wl,-b'
+ CMAKE_SHLIB_LINK_FLAGS='-Wl,+s'
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-E -Wl,-b'
+ CMAKE_MODULE_LINK_FLAGS='-Wl,+s'
+ CMAKE_SHLIB_RUNTIME_FLAG='-Wl,+b,'
+ CMAKE_SHLIB_RUNTIME_SEP=':'
+ fi
+ ;;
+ IRIX-5.*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ IRIX-6* | IRIX64-6* | IRIX-64-6*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared -rdata_shared"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ Linux*)
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ if test "$have_dl" = yes; then
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-rdynamic"
+ CMAKE_MODULE_LINK_FLAGS="-rdynamic"
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ else
+ AC_CHECK_HEADER(dld.h, [
+ CMAKE_DL_LIBS="-ldld"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=""])
+ fi
+ ;;
+ CYGWIN_NT*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_DL_LIBS="-lgdi32"
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ CMAKE_SHLIB_SUFFIX=".dll"
+ CMAKE_MODULE_SUFFIX=".dll"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ MP-RAS-02*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ MP-RAS-*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ NetBSD-*|FreeBSD-*)
+ # Not available on all versions: check for include file.
+ if test -f /usr/include/dlfcn.h; then
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS="-shared"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_BUILD_FLAGS="-shared"
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ else
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ fi
+ ;;
+ NEXTSTEP-*)
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-1.[012])
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ CMAKE_SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ CMAKE_SHLIB_CFLAGS="-fpic"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ CMAKE_SHLIB_CFLAGS=""
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-expect_unresolved,\\*'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-expect_unresolved,\\*'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-rpath,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ RISCos-*)
+ CMAKE_SHLIB_CFLAGS="-G 0"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ CMAKE_SHLIB_CFLAGS="-Kpic -belf"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-belf -Wl,-Bexport"
+ CMAKE_SHLIB_MODULE_FLAGS="-belf -Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SINIX*5.4*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS=""
+ CMAKE_MODULE_LINK_FLAGS=""
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ SunOS-4*)
+ CMAKE_SHLIB_CFLAGS="-PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_BUILD_FLAGS='-shared -Wl,-r -nostdlib'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-shared -Wl,-r -nostdlib'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-R,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ ;;
+ SunOS-5*)
+ CMAKE_SHLIB_CFLAGS="-KPIC"
+ CMAKE_SHLIB_LD_LIBS='${LIBS}'
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_BUILD_FLAGS='-G'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-G'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-R "
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_BUILD_FLAGS='-Wl,-G'
+ CMAKE_SHLIB_LINK_FLAGS=''
+ CMAKE_MODULE_BUILD_FLAGS='-Wl,-G'
+ CMAKE_MODULE_LINK_FLAGS=''
+ CMAKE_SHLIB_RUNTIME_FLAG="-Wl,-R,"
+ CMAKE_SHLIB_RUNTIME_SEP=":"
+ fi
+ ;;
+ ULTRIX-4.*)
+ CMAKE_SHLIB_CFLAGS="-G 0"
+ CMAKE_SHLIB_SUFFIX="..o"
+ CMAKE_MODULE_SUFFIX="..o"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_DL_LIBS=""
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-D,08000000"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+ UNIX_SV*)
+ CMAKE_SHLIB_CFLAGS="-K PIC"
+ CMAKE_SHLIB_LD_LIBS=""
+ CMAKE_SHLIB_SUFFIX=".so"
+ CMAKE_MODULE_SUFFIX=".so"
+ CMAKE_DL_LIBS="-ldl"
+ CMAKE_SHLIB_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_MODULE_LINK_FLAGS="-Wl,-Bexport"
+ CMAKE_SHLIB_RUNTIME_FLAG=""
+ CMAKE_SHLIB_RUNTIME_SEP=""
+ ;;
+esac
+export CMAKE_SHLIB_SUFFIX
+export CMAKE_MODULE_SUFFIX
+
+# If we're running gcc, then change the C flags for compiling shared
+# libraries to the right flags for gcc, instead of those for the
+# standard manufacturer compiler.
+if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ CMAKE_SHLIB_CFLAGS="-fPIC"
+fi
+# if running on cygwin remove -fPIC flag
+case $system in
+ CYGWIN_NT*)
+ CMAKE_SHLIB_CFLAGS=""
+ ;;
+ Darwin*) #don't need -fPIC on Darwin (on by default)
+ CMAKE_SHLIB_CFLAGS=""
+ ;;
+esac
+
+# if running on darwin no explicit template instantiations
+case $system in
+ Darwin*)
+ CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION="1"
+ ;;
+esac
+AC_SUBST(CMAKE_NO_EXPLICIT_TEMPLATE_INSTANTIATION)
+
+# If the user has supplied C flags for compiling shared objects, use
+# those instead
+if test "${SHLIB_CFLAGS}" != ""; then
+ CMAKE_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+fi
+CMAKE_LD_SEARCH_FLAGS="${LD_SEARCH_FLAGS}"
+
+
+AC_SUBST(CMAKE_SHLIB_LINK_FLAGS)
+AC_SUBST(CMAKE_SHLIB_BUILD_FLAGS)
+AC_SUBST(CMAKE_MODULE_LINK_FLAGS)
+AC_SUBST(CMAKE_MODULE_BUILD_FLAGS)
+AC_SUBST(CMAKE_SHLIB_CFLAGS)
+AC_SUBST(CMAKE_LIB_EXT)
+AC_SUBST(CMAKE_DL_LIBS)
+AC_SUBST(CMAKE_SHLIB_LD_LIBS)
+AC_SUBST(CMAKE_SHLIB_SUFFIX)
+AC_SUBST(CMAKE_MODULE_SUFFIX)
+AC_SUBST(CMAKE_SHLIB_RUNTIME_FLAG)
+AC_SUBST(CMAKE_SHLIB_RUNTIME_SEP)
+
+
+##########################
+## ##
+## Check thread support ##
+## ##
+##########################
+# initialize thread vars
+CMAKE_THREAD_LIBS=""
+use_sproc=no
+CMAKE_USE_SPROC=0
+CMAKE_USE_PTHREADS=0
+CMAKE_HP_PTHREADS=0
+
+##########################
+## ##
+## sproc ##
+## ##
+##########################
+# check for sproc
+force_sproc=no
+AC_ARG_WITH(sproc,
+ [ --with-sproc use sproc instead of pthreads if possible],
+ if test "$withval" = yes; then
+ force_sproc=yes
+ fi,)
+
+
+
+AC_CHECK_HEADERS(sys/prctl.h, [use_sproc=yes])
+if test "$use_sproc" = "yes"; then
+case $system in
+ Linux* | IRIX64-6.5 | IRIX-6.5)
+ if test "$force_sproc" = "yes"; then
+ CMAKE_USE_SPROC=1
+ else
+ use_sproc=no
+ fi
+ ;;
+ IRIX*)
+ CMAKE_USE_SPROC=1
+ ;;
+esac
+fi
+use_pthreads=no
+AC_CHECK_HEADERS(pthread.h, [use_pthreads=yes])
+if test "$use_pthreads" = "yes"; then
+ if test "$use_sproc" = "no"; then
+ AC_CHECK_LIB(pthreads, pthread_create, CMAKE_THREAD_LIBS="-lpthreads")
+ AC_CHECK_LIB(pthread, pthread_create, CMAKE_THREAD_LIBS="-lpthread")
+# Work around Solaris 5.6 and 5.7 bug:
+ if test "`uname -s -r`" = "SunOS 5.6"; then
+ AC_CHECK_LIB(thread, thr_create, CMAKE_THREAD_LIBS="$CMAKE_THREAD_LIBS -lthread")
+ fi
+ if test "`uname -s -r`" = "SunOS 5.7"; then
+ AC_CHECK_LIB(thread, thr_create, CMAKE_THREAD_LIBS="$CMAKE_THREAD_LIBS -lthread")
+ fi
+ CMAKE_USE_PTHREADS=1
+ fi
+fi
+
+# on an HP with pthread we need to use -lcma
+# on dec alphas we have had problems as well
+if test "$use_pthreads" = "yes"; then
+case $system in
+ HP-UX-*.10.*)
+ CMAKE_THREAD_LIBS="-lcma"
+ CMAKE_USE_PTHREADS=1
+ CMAKE_HP_PTHREADS=1
+ ;;
+ OSF1-V*)
+ CMAKE_USE_PTHREADS=0
+ CMAKE_THREAD_LIBS=""
+ ;;
+ FreeBSD*)
+ CMAKE_USE_PTHREADS=0
+ CMAKE_THREAD_LIBS=""
+ ;;
+ CYGWIN_NT*)
+ CMAKE_THREAD_LIBS=""
+ CMAKE_USE_WIN32_THREADS=0
+ CMAKE_USE_PTHREADS=1
+ ;;
+esac
+fi
+
+AC_SUBST(CMAKE_USE_SPROC)
+AC_SUBST(CMAKE_USE_PTHREADS)
+AC_SUBST(CMAKE_USE_WIN32_THREADS)
+AC_SUBST(CMAKE_HP_PTHREADS)
+AC_SUBST(CMAKE_THREAD_LIBS)
+
+
+CMAKE_ANSI_CFLAGS=""
+CMAKE_ANSI_CXXFLAGS=""
+# on hp use -Aa for ansi
+if test $ac_cv_prog_gxx = no; then
+case $system in
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
+ echo $ac_n "checking whether ${CC} accepts -Aa""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.c
+ if test -z "`${CC} -Aa -c conftest.c 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_ANSI_CFLAGS="-Aa"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+ ;;
+ IRIX-5* | IRIX-6* | IRIX64-6* | IRIX-64-6*)
+ echo $ac_n "checking whether ${CC} accepts -LANG:std""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.c
+ if test -z "`${CC} -LANG:std -c conftest.c 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_ANSI_CXXFLAGS="-LANG:std"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+ ;;
+esac
+fi
+AC_SUBST(CMAKE_ANSI_CFLAGS)
+AC_SUBST(CMAKE_ANSI_CXXFLAGS)
+
+# if we are not running g++ then we might need some other flags
+# to get the templates compiled correctly
+CMAKE_TEMPLATE_FLAGS=""
+if test $ac_cv_prog_gxx = no; then
+ echo $ac_n "checking whether ${CXX} accepts -ptused -no_prelink""... $ac_c" 1>&6
+ echo 'void f(){}' > conftest.cc
+ if test -z "`${CXX} -ptused -no_prelink -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ CMAKE_TEMPLATE_FLAGS="-ptused -no_prelink"
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ rm -f conftest*
+fi
+AC_SUBST(CMAKE_TEMPLATE_FLAGS)
+
+
+# check no g++ compilers to see if they have the standard
+# ansi stream files (without the .h)
+if test $ac_cv_prog_gxx = no; then
+ AC_MSG_CHECKING( ansi standard C++ stream headers )
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+#include <iostream>
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_ANSI_STREAM_HEADERS="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+AC_SUBST(CMAKE_NO_ANSI_STREAM_HEADERS)
+
+# check to see if stl is in the std namespace
+if test $ac_cv_prog_gxx = no; then
+ AC_MSG_CHECKING( ansi standard namespace support )
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+#include <list>
+void foo() { std::list<int> l; }
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_STD_NAMESPACE="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+AC_SUBST(CMAKE_NO_STD_NAMESPACE)
+
+# check to see if for scoping is supported
+if test $ac_cv_prog_gxx = no; then
+ AC_MSG_CHECKING( ansi for scope support )
+ rm -rf conftest.*
+ cat > conftest.cc <<!
+void foo() { for(int i;;); for(int i;;); }
+!
+ if test -z "`${CXX} ${CMAKE_ANSI_CXXFLAGS} $CXXFLAGS $CPPFLAGS -c conftest.cc 2>&1`"; then
+ echo "$ac_t""yes" 1>&6
+ else
+ CMAKE_NO_ANSI_FOR_SCOPE="1"
+ echo "$ac_t""no" 1>&6
+ fi
+fi
+AC_SUBST(CMAKE_NO_ANSI_FOR_SCOPE)
+
+
+if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ SHLIB_CFLAGS="-fPIC"
+fi
+
+# find make to use to build cmake, prefer gmake
+AC_PATH_PROGS(RUNMAKE, gmake make)
+AC_PATH_PROGS(CMAKE_AR_TMP, ar)
+CMAKE_AR="$CMAKE_AR_TMP"
+CMAKE_AR_ARGS="cr"
+# if on SunOS and not using gXX then use the compiler to make .a libs
+case $system in
+ SunOS-5*)
+ if test $ac_cv_prog_gxx = yes; then
+ :
+ else
+ echo "Using $CXX -xar -o for creating .a libraries"
+ CMAKE_AR="$CXX"
+ CMAKE_AR_ARGS="-xar -o"
+ fi
+esac
+AC_SUBST(CMAKE_AR)
+AC_SUBST(CMAKE_AR_ARGS)
+
+CMAKE_COMPILER_IS_GNUGXX=0
+if test $ac_cv_prog_gxx = yes; then
+ CMAKE_COMPILER_IS_GNUCXX=1
+fi
+AC_SUBST(CMAKE_COMPILER_IS_GNUCXX)
+# generate output files.
+# create mkdir files just to make some of the directories
+
+AC_OUTPUT( CMakeSystemConfig.cmake )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/install-sh b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/install-sh
new file mode 100644
index 0000000000000000000000000000000000000000..e9de23842dcd44d2953129c866b1ad25f7e1f1d9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/install-sh
@@ -0,0 +1,251 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch. It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ true
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ chmodcmd=""
+ else
+ instcmd=mkdir
+ fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ true
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ true
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ true
+ fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ true
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ true
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..58e4f94197db680837a9bb53d40100a52b910773
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/mex/staticLibHeader.dsptemplate
@@ -0,0 +1,164 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# LIBRARY_OUTPUT_PATH == override in output directory
+# OUTPUT_LIBNAME == name of output library
+
+# TARGTYPE "Win32 (x86) Static Library" 0x0104
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 RelWithDebInfo" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Static Library")
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /D "NDEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /D "_DEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_DLL" /FD /c
+# ADD CPP /nologo /D "NDEBUG" /D "_MBCS" /D "_ATL_DLL" /D "WIN32" /D "_WINDOWS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
+# PROP BASE Use_MFC CMAKE_MFC_FLAG
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "RelWithDebInfo"
+# PROP BASE Intermediate_Dir "RelWithDebInfo"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC CMAKE_MFC_FLAG
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelWithDebInfo"
+# PROP Intermediate_Dir "RelWithDebInfo"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /D "NDEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELWITHDEBINFO
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+CMAKE_CUSTOM_RULE_CODE
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# Name "OUTPUT_LIBNAME - Win32 RelWithDebInfo"
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..a7f3ad59983c72661aeaa8b021a92b31a38d1c51
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/DLLHeader.dsptemplate
@@ -0,0 +1,141 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# LIBRARY_OUTPUT_PATH == override in output directory
+# OUTPUT_LIBNAME == name of output library
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "OUTPUT_LIBNAME_EXPORTS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+# ADD LINK32 CM_DEBUG_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /pdbtype:sept
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Ignore_Export_Lib 0
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# SUBTRACT BASE CPP /YX
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /stack:0x989680 /dll /machine:I386
+# ADD LINK32 CM_OPTIMIZED_LIBRARIES CM_LIBRARIES kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /stack:0x989680 /dll /machine:I386
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..cb11378db5c7bbd5ce9b30e31d9f0ae63f79203f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEHeader.dsptemplate
@@ -0,0 +1,137 @@
+# Microsoft Developer Studio Project File - Name="pcbuilder" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# CM DSP Header file
+# This file is read by the build system of cm, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXECUTABLE_OUTPUT_PATH == override in output directory
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+# CM_LIBRARIES == libraries linked in
+# TARGTYPE "Win32 (x86) Application" 0x0103
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /FD /GZ /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /D "_AFXDLL" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_DEBUG_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /FD /c
+# ADD CPP /nologo /D "WIN32" BUILD_INCLUDES EXTRA_DEFINES /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEWinHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEWinHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..b6cc164983bb3ecebe33d2dcbb042eb7eb6d6b58
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/EXEWinHeader.dsptemplate
@@ -0,0 +1,140 @@
+# Microsoft Developer Studio Project File - Name="pcbuilder" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# CM DSP Header file
+# This file is read by the build system of cm, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXECUTABLE_OUTPUT_PATH == override in output directory
+# EXTRA_DEFINES == compiler defines
+# OUTPUT_LIBNAME == name of output library
+# CM_LIBRARIES == libraries linked in
+# TARGTYPE "Win32 (x86) Application" 0x0101
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Application")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+MTL=midl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+# ADD BASE RSC /l 0x409 /d "_DEBUG" /d "_AFXDLL"
+# ADD RSC /l 0x409 /d "_DEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_DEBUG_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /pdbtype:sept /IGNORE:4089
+CM_MULTILINE_OPTIMIZED_LIBRARIES
+CM_MULTILINE_LIBRARIES
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..f59001dfc059b04d2c4f5eded347b7378af29343
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityFooter.dsptemplate
@@ -0,0 +1,2 @@
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..71d4ebcae43e65776314d3e14d2864055d817ebb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/UtilityHeader.dsptemplate
@@ -0,0 +1,76 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Generic Project" 0x010a
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Generic Project")
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Generic Project")
+!MESSAGE
+
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+MTL=midl.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "EXECUTABLE_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibFooter.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibFooter.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..ce11878f130222fdab45ab274a35635519a87beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibFooter.dsptemplate
@@ -0,0 +1,4 @@
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibHeader.dsptemplate b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibHeader.dsptemplate
new file mode 100644
index 0000000000000000000000000000000000000000..4a703870c2217938fd44832ad44bab43f01e1adc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/DSPTemplates/with_mfc/staticLibHeader.dsptemplate
@@ -0,0 +1,128 @@
+# Microsoft Developer Studio Project File - Name="OUTPUT_LIBNAME" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 6.00
+# ** DO NOT EDIT **
+
+# ITK DSP Header file
+# This file is read by the build system of itk, and is used as the top part of
+# a microsoft project dsp header file
+# IF this is in a dsp file, then it is not the header, but has
+# already been used, so do not edit here...
+
+# variables to REPLACE
+#
+# BUILD_INCLUDES == include path
+# EXTRA_DEFINES == compiler defines
+# LIBRARY_OUTPUT_PATH == override in output directory
+# OUTPUT_LIBNAME == name of output library
+
+# TARGTYPE "Win32 (x86) Static Library" 0x0104
+
+CFG=OUTPUT_LIBNAME - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "OUTPUT_LIBNAME.mak" CFG="OUTPUT_LIBNAME - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "OUTPUT_LIBNAME - Win32 Release" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 Debug" (based on "Win32 (x86) Static Library")
+!MESSAGE "OUTPUT_LIBNAME - Win32 MinSizeRel" (based on "Win32 (x86) Static Library")
+# Begin Project
+# PROP AllowPerConfigDependencies 0
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+CPP=cl.exe
+RSC=rc.exe
+
+!IF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Release"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHRelease"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /D "NDEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_RELEASE
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 Debug"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHDebug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "_DEBUG" /D "_MBCS" /D "_LIB" /FD /c
+# ADD CPP /nologo /D "_DEBUG" /D "WIN32" /D "_MBCS" /D "_LIB" /D "_AFXDLL" /FD /GZ /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_DEBUG
+# ADD BASE RSC /l 0x409 /d "_DEBUG"
+# ADD RSC /l 0x409 /d "_DEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+!ELSEIF "$(CFG)" == "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
+# PROP BASE Use_MFC 2
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "MinSizeRel"
+# PROP BASE Intermediate_Dir "MinSizeRel"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 2
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "LIBRARY_OUTPUT_PATHMinSizeRel"
+# PROP Intermediate_Dir "MinSizeRel"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+# ADD BASE CPP /nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_DLL" /FD /c
+# ADD CPP /nologo /D "NDEBUG" /D "_MBCS" /D "_ATL_DLL" /D "WIN32" /D "_WINDOWS" /D "_USRDLL" /D "_AFXDLL" /FD /c
+# ADD CPP BUILD_INCLUDES EXTRA_DEFINES /D "OUTPUT_LIBNAME_EXPORTS"
+# ADD CPP CMAKE_CXX_FLAGS
+# ADD CPP CMAKE_CXX_FLAGS_MINSIZEREL
+# ADD BASE RSC /l 0x409 /d "NDEBUG"
+# ADD RSC /l 0x409 /d "NDEBUG" /d "_AFXDLL"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LIB32=link.exe -lib
+# ADD BASE LIB32 /nologo
+# ADD LIB32 /nologo
+
+
+!ENDIF
+
+# Begin Target
+
+# Name "OUTPUT_LIBNAME - Win32 Release"
+# Name "OUTPUT_LIBNAME - Win32 Debug"
+# Name "OUTPUT_LIBNAME - Win32 MinSizeRel"
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/FORCEBUILD b/Utilities/ITK/Utilities/vxl/config/cmake/FORCEBUILD
new file mode 100644
index 0000000000000000000000000000000000000000..af07b628e0730478db09a4a1d0c8ecd1ea54acd4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/FORCEBUILD
@@ -0,0 +1,9 @@
+This FORCEBUILD file should be deleted by Dart scripts to force Dart
+to do a continuous build even if no other file in the repository has
+been changed. The idea is to fool Dart into thinking a file has been
+changed so it will compile and submit. This should be done when some
+dependency of the build changes. It is also helpful for triggering a
+new continuous build when it is first started up. Seeing that this
+file has changed on the dashboard will make it apparent that the build
+was started for reasons other than a file in the repository being
+changed.
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/GETTING_STARTED b/Utilities/ITK/Utilities/vxl/config/cmake/GETTING_STARTED
new file mode 100644
index 0000000000000000000000000000000000000000..66758d6b70c31eefda3cc86adfb9cf56d2c2b993
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/GETTING_STARTED
@@ -0,0 +1 @@
+The build instructions are available at http://vxl.sourceforge.net
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExists.cxx.in b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExists.cxx.in
new file mode 100644
index 0000000000000000000000000000000000000000..edf6be56fe6f1229cefaa6d525274a1971f61dd0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExists.cxx.in
@@ -0,0 +1,13 @@
+#include <${FILE}>
+
+${CHECK_PROTOTYPE_EXISTS_CXX_EXTERNC_BEGIN}
+
+typedef union { int member; } dummyStruct;
+
+dummyStruct ${FUNC}( dummyStruct );
+
+${CHECK_PROTOTYPE_EXISTS_CXX_EXTERNC_END}
+
+int main() {
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExistsCXX.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExistsCXX.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..cd210f0de10891bf15dfc94c1f23da031581fb35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/CheckPrototypeExistsCXX.cmake
@@ -0,0 +1,67 @@
+#
+# This checks if a prototype for FUNC (with C linkage) has been
+# declared in any one of the header files listed in INCLUDE. It uses
+# the C++ compiler.
+#
+# (The check is actually whether declaring a prototype will cause a
+# conflict and thus an error. The results may differ depending on the
+# compiler. For example, gcc under Cygwin will issue a warning but g++
+# will issue an error. In the DCMTK, the prototypes are used in a C++
+# context, so we use the C++ compiler to check.
+#
+MACRO(CHECK_PROTOTYPE_EXISTS_CXX FUNC INCLUDE VARIABLE)
+ IF("${VARIABLE}" MATCHES "^${VARIABLE}$")
+ SET( CHECK_PROTOTYPE_EXISTS_CXX_FILE_IN "${VXL_CMAKE_DIR}/CheckPrototypeExists.cxx.in" )
+ SET( CHECK_PROTOTYPE_EXISTS_CXX_FILE "${CMAKE_BINARY_DIR}/CMakeTmp/CheckPrototypeExists.cxx" )
+ SET( CHECK_PROTOTYPE_EXISTS_CXX_EXTERNC_BEGIN "extern \"C\" {\n" )
+ SET( CHECK_PROTOTYPE_EXISTS_CXX_EXTERNC_END "}\n" )
+
+ SET(MACRO_CHECK_PROTOTYPE_EXISTS_CXX_FLAGS ${CMAKE_REQUIRED_FLAGS})
+ MESSAGE(STATUS "Looking for prototype for ${FUNC} in ${INCLUDE}")
+
+ SET( ${VARIABLE} 0 )
+ FOREACH(FILE ${INCLUDE})
+
+ # First check if the header exists. Cache the result in a variable named after
+ # the header, so that we don't re-do the effort
+ STRING( REGEX REPLACE "\\.|/" "_" CLEAN_FILE ${FILE} )
+ SET( CHECK_PROTOTYPE_EXISTS_CXX_INCLUDE "CHECK_PROTOTYPE_EXISTS_CXX_INCLUDE_${CLEAN_FILE}" )
+ CHECK_INCLUDE_FILE( ${FILE} ${CHECK_PROTOTYPE_EXISTS_CXX_INCLUDE} )
+ IF( CHECK_PROTOTYPE_EXISTS_CXX_INCLUDE )
+
+ FILE(APPEND ${CMAKE_BINARY_DIR}/CMakeOutput.log "Trying struct with ${FILE}\n" )
+ CONFIGURE_FILE( ${CHECK_PROTOTYPE_EXISTS_CXX_FILE_IN}
+ ${CHECK_PROTOTYPE_EXISTS_CXX_FILE} IMMEDIATE )
+
+ TRY_COMPILE( CHECK_PROTOTYPE_EXISTS_CXX_RESULT
+ ${CMAKE_BINARY_DIR}
+ ${CHECK_PROTOTYPE_EXISTS_CXX_FILE}
+ CMAKE_FLAGS
+ -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_PROTOTYPE_EXISTS_CXX_FLAGS}
+ OUTPUT_VARIABLE OUTPUT)
+ IF( CHECK_PROTOTYPE_EXISTS_CXX_RESULT )
+ FILE(APPEND ${CMAKE_BINARY_DIR}/CMakeOutput.log
+ "Determining if prototype ${FUNC} exists in ${FILE} "
+ "failed with the following output:\n"
+ "${OUTPUT}\n\n")
+ ELSE( CHECK_PROTOTYPE_EXISTS_CXX_RESULT )
+ FILE(APPEND ${CMAKE_BINARY_DIR}/CMakeOutput.log
+ "Determining if prototype ${FUNC} exists in ${FILE} "
+ "passed with the following output:\n"
+ "${OUTPUT}\n\n")
+ MESSAGE(STATUS " Found in ${FILE}")
+ SET( ${VARIABLE} 1 )
+ ENDIF( CHECK_PROTOTYPE_EXISTS_CXX_RESULT )
+
+ ENDIF( CHECK_PROTOTYPE_EXISTS_CXX_INCLUDE )
+ ENDFOREACH(FILE)
+
+ IF( ${VARIABLE} )
+ MESSAGE(STATUS "Looking for prototype of ${FUNC} - found")
+ SET(${VARIABLE} 1 CACHE INTERNAL "Have prototype ${VARIABLE}")
+ ELSE(${VARIABLE})
+ MESSAGE(STATUS "Looking for prototype of ${FUNC} - not found")
+ SET(${VARIABLE} "" CACHE INTERNAL "Have prototype ${VARIABLE}")
+ ENDIF(${VARIABLE})
+ ENDIF("${VARIABLE}" MATCHES "^${VARIABLE}$")
+ENDMACRO(CHECK_PROTOTYPE_EXISTS_CXX)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindDCMTK.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindDCMTK.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..8afd2cbb6204b97d6c3cc681d8ebf0098df45c55
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindDCMTK.cmake
@@ -0,0 +1,43 @@
+#
+# Find the DCMTK libraries
+#
+# This file is used to find either a system built DCMTK library or the
+# one in v3p, if provided.
+#
+# Provides:
+# DCMTK_INCLUDE_DIR - Directories to include to use DCMTK
+# DCMTK_LIBRARIES - Files to link against to use DCMTK
+# DCMTK_FOUND - If false, don't try to use DCMTK
+# DCMTK_DIR - (optional) Source directory for DCMTK
+#
+#
+# Additionally,
+# VXL_USING_NATIVE_DCMTK - True if we are using system DCMTK libraries.
+
+# If this FORCE variable is unset or is false, try to find a native library
+IF( VXL_FORCE_V3P_DCMTK )
+ELSE( VXL_FORCE_V3P_DCMTK )
+ INCLUDE( ${VXL_CMAKE_DIR}/NewCMake/FindDCMTK.cmake )
+ENDIF( VXL_FORCE_V3P_DCMTK )
+
+IF( DCMTK_FOUND )
+
+ SET( VXL_USING_NATIVE_DCMTK "YES" )
+
+ELSE( DCMTK_FOUND )
+
+ # If the v3p version exists and is being build, use it
+ IF( VXL_BUILD_DCMTK )
+
+ SET( DCMTK_FOUND "YES" )
+ SET( DCMTK_INCLUDE_DIR
+ ${dcmtk_BINARY_DIR} # for generated osconfig
+ ${dcmtk_SOURCE_DIR}/ofstd/include
+ ${dcmtk_SOURCE_DIR}/dcmdata/include
+ ${dcmtk_SOURCE_DIR}/dcmimgle/include
+ )
+ SET( DCMTK_LIBRARIES dcmtk )
+
+ ENDIF( VXL_BUILD_DCMTK )
+
+ENDIF( DCMTK_FOUND )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindJPEG.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindJPEG.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..ea307dab0dd187b83ef3da6adb1dead4ffe7c8ce
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindJPEG.cmake
@@ -0,0 +1,41 @@
+#
+# Find a JPEG library
+#
+#
+# This file is used to manage using either a natively provided JPEG library or the one in v3p if provided.
+#
+#
+# As per the standard scheme the following definitions are used
+# JPEG_INCLUDE_DIR - where to find jpeglib.h
+# JPEG_LIBRARIES - the set of libraries to include to use JPEG.
+# JPEG_FOUND - TRUE, if available somewhere on the system.
+
+# Additionally
+# VXL_USING_NATIVE_JPEG - True if we are using a JPEG library provided outside vxl (or v3p)
+
+# If this FORCE variable is unset or is FALSE, try to find a native library.
+IF( VXL_FORCE_V3P_JPEG )
+ELSE( VXL_FORCE_V3P_JPEG )
+ INCLUDE( ${CMAKE_ROOT}/Modules/FindJPEG.cmake )
+ENDIF( VXL_FORCE_V3P_JPEG )
+
+IF(JPEG_FOUND)
+
+ SET(VXL_USING_NATIVE_JPEG "YES")
+
+ELSE(JPEG_FOUND)
+
+ #
+ # At some point, in a "release" version, it is possible that someone
+ # will not have the v3p jpeg library
+ #
+
+ IF(EXISTS ${vxl_SOURCE_DIR}/v3p/jpeg/jpeglib.h)
+
+ SET( JPEG_FOUND "YES" )
+ SET( JPEG_LIBRARIES jpeg )
+ SET( JPEG_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p/jpeg)
+
+ ENDIF(EXISTS ${vxl_SOURCE_DIR}/v3p/jpeg/jpeglib.h)
+
+ENDIF(JPEG_FOUND)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindMPEG2.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindMPEG2.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..c262ce4dc224ce44b9da914ab6f16fbd5590ab12
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindMPEG2.cmake
@@ -0,0 +1,46 @@
+#
+# Find an MPEG2 library
+#
+# This file is used to manage using either a natively provided MPEG2
+# library or the one in v3p if provided.
+#
+#
+# As per the standard scheme the following definitions are used
+# MPEG2_INCLUDE_DIR - where to find mpeg2dec/mpeg2.h
+# MPEG2_LIBRARIES - the set of libraries to include to use MPEG2.
+# MPEG2_FOUND - TRUE, if available somewhere on the system.
+
+# Additionally
+# VXL_USING_NATIVE_MPEG2 - True if we are using a MPEG2 library provided outside vxl (or v3p)
+
+# If this FORCE variable is unset or is FALSE, try to find a native library.
+IF( VXL_FORCE_V3P_MPEG2 )
+ELSE( VXL_FORCE_V3P_MPEG2 )
+ INCLUDE( ${CMAKE_ROOT}/Modules/FindMPEG2.cmake )
+ENDIF( VXL_FORCE_V3P_MPEG2 )
+
+IF( MPEG2_FOUND )
+
+ SET(VXL_USING_NATIVE_MPEG2 "YES")
+
+ELSE( MPEG2_FOUND )
+
+ #
+ # At some point, in a "release" version, it is possible that someone
+ # will not have the v3p mpeg2 library
+ #
+
+ IF(EXISTS ${vxl_SOURCE_DIR}/v3p/mpeg2/include/mpeg2dec/mpeg2.h)
+
+ SET( MPEG2_FOUND "YES" )
+ SET( MPEG2_LIBRARIES mpeg2 vo )
+ SET( MPEG2_INCLUDE_DIR
+ ${vxl_SOURCE_DIR}/v3p/mpeg2/include
+ # use of the following is deprecated
+ # it is better to use #include <mpeg2dec/mpeg2.h> in client code
+ ${vxl_SOURCE_DIR}/v3p/mpeg2/include/mpeg2dec
+ )
+
+ ENDIF(EXISTS ${vxl_SOURCE_DIR}/v3p/mpeg2/include/mpeg2dec/mpeg2.h)
+
+ENDIF( MPEG2_FOUND )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindNetlib.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindNetlib.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..928b1d7632b64fcf0ab9b2f70a4995036aa9ea87
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindNetlib.cmake
@@ -0,0 +1,12 @@
+#
+# Try to find netlib
+#
+
+# AGAP: Is it even possible to have a "native" netlib? Even if not, it is
+# good to have this file in place, so that all things in v3p are found
+# via a module.
+
+SET( NETLIB_FOUND "YES" )
+SET( NETLIB_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p/netlib )
+SET( NETLIB_LIBRARIES itknetlib )
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindPNG.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindPNG.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..989b7e160fbca0852ba865c371360ce28d6c4d57
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindPNG.cmake
@@ -0,0 +1,57 @@
+#
+# Find a PNG library
+#
+#
+# This file is used to manage using either a natively provided PNG library or the one in v3p if provided.
+#
+#
+# As per the standard scheme the following definitions are used
+# PNG_INCLUDE_DIR - where to find png.h
+# PNG_LIBRARIES - the set of libraries to include to use PNG.
+# PNG_DEFINITIONS - You should ADD_DEFINITONS(${PNG_DEFINITIONS}) before compiling code that includes png library files.
+# PNG_FOUND - TRUE, if available somewhere on the system.
+
+# Additionally
+# VXL_USING_NATIVE_PNG - True if we are using a PNG library provided outsidevxl (or v3p)
+
+
+# If this FORCE variable is unset or is FALSE, try to find a native library.
+IF( VXL_FORCE_V3P_PNG )
+ELSE( VXL_FORCE_V3P_PNG )
+ INCLUDE( ${CMAKE_ROOT}/Modules/FindPNG.cmake )
+ENDIF( VXL_FORCE_V3P_PNG )
+
+IF(PNG_FOUND)
+
+ SET(VXL_USING_NATIVE_PNG "YES")
+
+ELSE(PNG_FOUND)
+
+ INCLUDE( ${MODULE_PATH}/FindZLIB.cmake )
+ IF(ZLIB_FOUND)
+
+ #
+ # At some point, in a "release" version, it is possible that someone
+ # will not have the v3p png library, so make sure the headers
+ # exist.
+ #
+
+
+ IF(EXISTS ${vxl_SOURCE_DIR}/v3p/png/png.h)
+
+ SET( PNG_FOUND "YES" )
+ SET( PNG_LIBRARIES png)
+ SET( PNG_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p/png ${ZLIB_INCLUDE_DIR} )
+
+ IF (CYGWIN)
+ IF(BUILD_SHARED_LIBS)
+ # No need to define PNG_USE_DLL here, because it's default for Cygwin.
+ ELSE(BUILD_SHARED_LIBS)
+ SET (PNG_DEFINITIONS ${PNG_DEFINITIONS} -DPNG_STATIC)
+ ENDIF(BUILD_SHARED_LIBS)
+ ENDIF (CYGWIN)
+
+ ENDIF(EXISTS ${vxl_SOURCE_DIR}/v3p/png/png.h)
+
+ ENDIF(ZLIB_FOUND)
+ENDIF(PNG_FOUND)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindQv.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindQv.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..984a0882c9e3f43736766fe84d4cc3cf7d979742
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindQv.cmake
@@ -0,0 +1,7 @@
+#
+# Try to find Qv
+#
+
+SET( QV_FOUND "YES" )
+SET( QV_LIBRARIES Qv )
+SET( QV_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindTIFF.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindTIFF.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..7727e59e94fff1baa247ede8709f1f990e541365
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindTIFF.cmake
@@ -0,0 +1,43 @@
+#
+# Find a TIFF library
+#
+# This file is used to manage using either a natively provided TIFF library or the one in v3p if provided.
+#
+#
+# As per the standard scheme the following definitions are used
+# TIFF_INCLUDE_DIR - where to find tiff.h
+# TIFF_LIBRARIES - the set of libraries to include to use TIFF.
+# TIFF_FOUND - TRUE, if available somewhere on the system.
+
+# Additionally
+# VXL_USING_NATIVE_TIFF - True if we are using a TIFF library provided outside vxl (or v3p)
+
+
+# If this FORCE variable is unset or is FALSE, try to find a native library.
+IF( VXL_FORCE_V3P_TIFF )
+ELSE( VXL_FORCE_V3P_TIFF )
+ INCLUDE( ${CMAKE_ROOT}/Modules/FindTIFF.cmake )
+ENDIF( VXL_FORCE_V3P_TIFF )
+
+
+IF(TIFF_FOUND)
+
+ SET(VXL_USING_NATIVE_TIFF "YES")
+
+ELSE(TIFF_FOUND)
+
+ #
+ # At some point, in a "release" version, it is possible that someone
+ # will not have the v3p tiff library, so make sure the headers
+ # exist.
+ #
+
+ IF(EXISTS ${vxl_SOURCE_DIR}/v3p/tiff/tiff.h)
+
+ SET( TIFF_FOUND "YES" )
+ SET( TIFF_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p/tiff)
+ SET( TIFF_LIBRARIES tiff )
+
+ ENDIF(EXISTS ${vxl_SOURCE_DIR}/v3p/tiff/tiff.h)
+
+ENDIF(TIFF_FOUND)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindZLIB.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindZLIB.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..298b477e47dffcdfaf8bf271d4c73e6084afb1b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/FindZLIB.cmake
@@ -0,0 +1,44 @@
+#
+# Find a ZLIB library
+#
+# This file is used to manage using either a natively provided ZLIB library or the one in v3p if provided.
+#
+#
+# As per the standard scheme the following definitions are used
+# ZLIB_INCLUDE_DIR - where to find zlib.h
+# ZLIB_LIBRARIES - the set of libraries to include to use ZLIB.
+# ZLIB_FOUND - TRUE, if available somewhere on the system.
+
+# Additionally
+# VXL_USING_NATIVE_ZLIB - True if we are using a ZLIB library provided outside vxl (or v3p)
+
+
+# If this FORCE variable is unset or is FALSE, try to find a native library.
+IF( VXL_FORCE_V3P_ZLIB )
+ELSE( VXL_FORCE_V3P_ZLIB )
+ INCLUDE( ${CMAKE_ROOT}/Modules/FindZLIB.cmake )
+ENDIF( VXL_FORCE_V3P_ZLIB )
+
+
+IF(ZLIB_FOUND)
+
+ SET(VXL_USING_NATIVE_ZLIB "YES")
+ # All the other variables are set by CMake's FindZLIB. Don't
+ # set them here.
+
+ELSE(ZLIB_FOUND)
+
+ #
+ # At some point, in a "release" version, it is possible that someone
+ # will not have the v3p ZLIB library, so make sure the headers
+ # exist.
+ #
+
+ IF(EXISTS ${vxl_SOURCE_DIR}/v3p/zlib/zlib.h)
+
+ SET( ZLIB_FOUND "YES" )
+ SET( ZLIB_INCLUDE_DIR ${vxl_SOURCE_DIR}/v3p/zlib)
+ SET( ZLIB_LIBRARIES z )
+
+ ENDIF(EXISTS ${vxl_SOURCE_DIR}/v3p/zlib/zlib.h)
+ENDIF(ZLIB_FOUND)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindDCMTK.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindDCMTK.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..992e0f4c6772e45145a9d25b989be2210aea6794
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindDCMTK.cmake
@@ -0,0 +1,93 @@
+#
+# try to find DCMTK libraries
+#
+
+# DCMTK_INCLUDE_DIR - Directories to include to use DCMTK
+# DCMTK_LIBRARIES - Files to link against to use DCMTK
+# DCMTK_FOUND - If false, don't try to use DCMTK
+# DCMTK_DIR - (optional) Source directory for DCMTK
+#
+# DCMTK_DIR can be used to make it simpler to find the various include
+# directories and compiled libraries if you've just compiled it in the
+# source tree. Just set it to the root of the tree where you extracted
+# the source.
+#
+# VXL only requires dcmimgle and its dependents, so we only check for
+# these. A more general version may want to check for the rest.
+
+FIND_PATH( DCMTK_config_INCLUDE_DIR osconfig.h
+ ${DCMTK_DIR}/config/include
+)
+
+FIND_PATH( DCMTK_ofstd_INCLUDE_DIR ofstdinc.h
+ ${DCMTK_DIR}/ofstd/include
+)
+
+FIND_LIBRARY( DCMTK_ofstd_LIBRARY ofstd
+ ${DCMTK_DIR}/ofstd/libsrc
+ ${DCMTK_DIR}/ofstd/Release
+ ${DCMTK_DIR}/ofstd/Debug
+)
+
+
+FIND_PATH( DCMTK_dcmdata_INCLUDE_DIR dctypes.h
+ ${DCMTK_DIR}/dcmdata/include
+)
+
+FIND_LIBRARY( DCMTK_dcmdata_LIBRARY dcmdata
+ ${DCMTK_DIR}/dcmdata/libsrc
+ ${DCMTK_DIR}/dcmdata/Release
+ ${DCMTK_DIR}/dcmdata/Debug
+)
+
+
+FIND_PATH( DCMTK_dcmimgle_INCLUDE_DIR dcmimage.h
+ ${DCMTK_DIR}/dcmimgle/include
+)
+
+FIND_LIBRARY( DCMTK_dcmimgle_LIBRARY dcmimgle
+ ${DCMTK_DIR}/dcmimgle/libsrc
+ ${DCMTK_DIR}/dcmimgle/Release
+ ${DCMTK_DIR}/dcmimgle/Debug
+)
+
+
+IF( DCMTK_config_INCLUDE_DIR )
+IF( DCMTK_ofstd_INCLUDE_DIR )
+IF( DCMTK_ofstd_LIBRARY )
+IF( DCMTK_dcmdata_INCLUDE_DIR )
+IF( DCMTK_dcmdata_LIBRARY )
+IF( DCMTK_dcmimgle_INCLUDE_DIR )
+IF( DCMTK_dcmimgle_LIBRARY )
+
+ SET( DCMTK_FOUND "YES" )
+ SET( DCMTK_INCLUDE_DIR
+ ${DCMTK_config_INCLUDE_DIR}
+ ${DCMTK_ofstd_INCLUDE_DIR}
+ ${DCMTK_dcmdata_INCLUDE_DIR}
+ ${DCMTK_dcmimgle_INCLUDE_DIR}
+ )
+
+ SET( DCMTK_LIBRARIES
+ ${DCMTK_dcmimgle_LIBRARY}
+ ${DCMTK_dcmdata_LIBRARY}
+ ${DCMTK_ofstd_LIBRARY}
+ ${DCMTK_config_LIBRARY}
+ )
+
+ IF( WIN32 )
+ SET( DCMTK_LIBRARIES ${DCMTK_LIBRARIES} netapi32 )
+ ENDIF( WIN32 )
+
+ENDIF( DCMTK_dcmimgle_LIBRARY )
+ENDIF( DCMTK_dcmimgle_INCLUDE_DIR )
+ENDIF( DCMTK_dcmdata_LIBRARY )
+ENDIF( DCMTK_dcmdata_INCLUDE_DIR )
+ENDIF( DCMTK_ofstd_LIBRARY )
+ENDIF( DCMTK_ofstd_INCLUDE_DIR )
+ENDIF( DCMTK_config_INCLUDE_DIR )
+
+IF( NOT DCMTK_FOUND )
+ SET( DCMTK_DIR "" CACHE PATH "Root of DCMTK source tree (optional)." )
+ MARK_AS_ADVANCED( DCMTK_DIR )
+ENDIF( NOT DCMTK_FOUND )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindFFMPEG.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindFFMPEG.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..c056f997d726c5ba650224192a79d4fe079f83d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindFFMPEG.cmake
@@ -0,0 +1,39 @@
+# Find the FFmpeg library
+#
+# Sets
+# FFMPEG_FOUND. If false, don't try to use ffmpeg
+# FFMPEG_INCLUDE_DIR
+# FFMPEG_LIBRARIES
+
+SET( FFMPEG_FOUND "NO" )
+
+
+FIND_PATH( FFMPEG_INCLUDE_DIR ffmpeg/avcodec.h
+ /usr/include
+ /usr/local/include
+)
+
+FIND_LIBRARY( FFMPEG_avcodec_LIBRARY avcodec
+ /usr/lib
+ /usr/local/lib
+ /usr/lib64
+ /usr/local/lib64
+)
+
+FIND_LIBRARY( FFMPEG_avformat_LIBRARY avformat
+ /usr/lib
+ /usr/local/lib
+ /usr/lib64
+ /usr/local/lib64
+)
+
+IF( FFMPEG_INCLUDE_DIR )
+IF( FFMPEG_avcodec_LIBRARY )
+IF( FFMPEG_avformat_LIBRARY )
+
+ SET( FFMPEG_FOUND "YES" )
+ SET( FFMPEG_LIBRARIES ${FFMPEG_avformat_LIBRARY} ${FFMPEG_avcodec_LIBRARY} )
+
+ENDIF( FFMPEG_avformat_LIBRARY )
+ENDIF( FFMPEG_avcodec_LIBRARY )
+ENDIF( FFMPEG_INCLUDE_DIR )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGLUT.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGLUT.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..31844221672f9ebd718ad755946d8bc1239e08bb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGLUT.cmake
@@ -0,0 +1,120 @@
+#
+# try to find glut library and include files
+#
+# GLUT_INCLUDE_DIR, where to find GL/glut.h, etc.
+# GLUT_LIBRARIES, the libraries to link against to use GLUT.
+# GLUT_FOUND, If false, do not try to use GLUT.
+
+# also defined, but not for general use are
+# GLUT_glut_LIBRARY, where to find the glut library.
+# GLUT_Xmu_LIBRARY, where to find the Xmu library if available.
+# GLUT_Xi_LIBRARY, where to find the Xi Library if available.
+
+IF (WIN32)
+
+ IF(CYGWIN)
+
+ FIND_PATH( GLUT_INCLUDE_DIR GL/glut.h
+ /usr/include
+ ${GLUT_INCLUDE_PATH}
+ )
+
+ FIND_LIBRARY( GLUT_glut_LIBRARY glut32
+ ${OPENGL_LIBRARY_DIR}
+ /usr/lib64
+ /usr/lib
+ /usr/lib/w32api
+ /usr/local/lib
+ /usr/X11R6/lib
+ )
+
+
+ ELSE(CYGWIN)
+
+ FIND_PATH( GLUT_INCLUDE_DIR GL/glut.h
+ ${GLUT_ROOT_PATH}/include
+ )
+
+ FIND_LIBRARY( GLUT_glut_LIBRARY glut
+ ${GLUT_ROOT_PATH}/Release
+ ${OPENGL_LIBRARY_DIR}
+ )
+
+ ENDIF(CYGWIN)
+
+ELSE (WIN32)
+
+ IF (APPLE)
+# These values for Apple could probably do with improvement.
+ FIND_PATH( GLUT_INCLUDE_DIR GL/glut.h
+ ${OPENGL_LIBRARY_DIR}
+ )
+ SET(GLUT_glut_LIBRARY "-framework Glut" CACHE STRING "GLUT library for OSX")
+ ELSE (APPLE)
+
+ FIND_PATH( GLUT_INCLUDE_DIR GL/glut.h
+ /usr/include
+ /usr/include/GL
+ /usr/local/include
+ /usr/openwin/share/include
+ /usr/openwin/include
+ /usr/X11R6/include
+ /usr/include/X11
+ /opt/graphics/OpenGL/include
+ /opt/graphics/OpenGL/contrib/libglut
+ ${GLUT_INCLUDE_PATH}
+ )
+
+ FIND_LIBRARY( GLUT_glut_LIBRARY glut
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ FIND_LIBRARY( GLUT_Xi_LIBRARY Xi
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ FIND_LIBRARY( GLUT_Xmu_LIBRARY Xmu
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ ENDIF (APPLE)
+
+ENDIF (WIN32)
+
+SET( GLUT_FOUND "NO" )
+IF(GLUT_INCLUDE_DIR)
+ IF(GLUT_glut_LIBRARY)
+ # Is -lXi and -lXmu required on all platforms that have it?
+ # If not, we need some way to figure out what platform we are on.
+ SET( GLUT_LIBRARIES
+ ${GLUT_glut_LIBRARY}
+ ${GLUT_Xmu_LIBRARY}
+ ${GLUT_Xi_LIBRARY}
+ )
+ SET( GLUT_FOUND "YES" )
+
+#The following deprecated settings are for backwards compatibility with CMake1.4
+ SET (GLUT_LIBRARY ${GLUT_LIBRARIES})
+ SET (GLUT_INCLUDE_PATH ${GLUT_INCLUDE_DIR})
+
+ ENDIF(GLUT_glut_LIBRARY)
+ENDIF(GLUT_INCLUDE_DIR)
+
+MARK_AS_ADVANCED(
+ GLUT_INCLUDE_DIR
+ GLUT_glut_LIBRARY
+ GLUT_Xmu_LIBRARY
+ GLUT_Xi_LIBRARY
+)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGTK2.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGTK2.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..ba7d4a3075cedda2b630580f86b30d3486fd87ab
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindGTK2.cmake
@@ -0,0 +1,33 @@
+#
+# try to find GTK2 (and glib2) and GTKGLExt
+#
+
+# GTK2_INCLUDE_DIR - Directories to include to use GTK2
+# GTK2_LIBRARIES - Files to link against to use GTK2
+# GTK2_DEFINITIONS - Compiler flags to compile against GTK2
+# GTK2_FOUND - If false, don't try to use GTK2
+
+SET( GTK2_FOUND "NO" )
+
+FIND_PROGRAM( PKG_CONFIG pkg-config
+ /usr/bin
+ /usr/local/bin
+ ${HOME}/bin
+)
+
+IF( PKG_CONFIG )
+ EXEC_PROGRAM( ${PKG_CONFIG} ARGS "--exists gtkglext-1.0" RETURN_VALUE GTK2_PKG_RET_VAL )
+
+ IF( ${GTK2_PKG_RET_VAL} MATCHES "0" )
+
+ # The dependencies for GTK-GLExt should have all the GTK parts too, so no need to explictly find them
+ EXEC_PROGRAM( ${PKG_CONFIG} ARGS "--cflags gtkglext-1.0" OUTPUT_VARIABLE GTK2_glext_DEFINITIONS )
+ EXEC_PROGRAM( ${PKG_CONFIG} ARGS "--libs gtkglext-1.0" OUTPUT_VARIABLE GTK2_glext_LIBRARIES )
+
+ SET( GTK2_FOUND "YES" )
+ SET( GTK2_DEFINITIONS "${GTK2_gtk_DEFINITIONS} ${GTK2_glext_DEFINITIONS}" )
+ SET( GTK2_LIBRARIES "${GTK2_gtk_LIBRARIES} ${GTK2_glext_LIBRARIES}" )
+
+ ENDIF( ${GTK2_PKG_RET_VAL} MATCHES "0" )
+
+ENDIF( PKG_CONFIG )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindOpenGL.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindOpenGL.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..efb45880ef161ae0807450dce933c38d21a29438
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindOpenGL.cmake
@@ -0,0 +1,171 @@
+# Try to find OpenGL
+# Once done this will define
+#
+# OPENGL_FOUND - system has OpenGL and it should be used
+# OPENGL_XMESA_FOUND - system has XMESA, and it should be used.
+# OPENGL_GLU_FOUND - system has GLU and it should be used.
+# OPENGL_INCLUDE_DIR - where the GL include directory can be found
+# OPENGL_LIBRARIES - Link these to use OpenGL
+#
+#
+# Also defined, but not for general use are
+# OPENGL_gl_LIBRARY - Path to OpenGL Library
+# OPENGL_glu_LIBRARY - Path to GLU Library
+#
+
+IF (WIN32)
+ IF (CYGWIN)
+
+ FIND_PATH(OPENGL_INCLUDE_DIR GL/gl.h
+ /usr/include
+ /usr/X11R6/include
+ ${OPENGL_INCLUDE_PATH}
+ )
+
+ FIND_LIBRARY(OPENGL_gl_LIBRARY opengl32
+ /usr/lib64
+ /usr/lib
+ /usr/lib/w32api
+ )
+
+ FIND_LIBRARY(OPENGL_glu_LIBRARY glu32
+ /usr/lib64
+ /usr/lib
+ /usr/lib/w32api
+ )
+
+ ELSE (CYGWIN)
+
+ IF(BORLAND)
+ SET (OPENGL_gl_LIBRARY import32 CACHE STRING "OpenGL library for win32")
+ SET (OPENGL_glu_LIBRARY import32 CACHE STRING "GLU library for win32")
+ ELSE(BORLAND)
+ SET (OPENGL_gl_LIBRARY opengl32 CACHE STRING "OpenGL library for win32")
+ SET (OPENGL_glu_LIBRARY glu32 CACHE STRING "GLU library for win32")
+ ENDIF(BORLAND)
+
+ # No extra include path needed because OpenGL includes are with
+ # the system includes but, cmake will create makefiles with
+ # "-I${OPENGL_INCLUDE_DIR}" options if OPENGL_INCLUDE_DIR is
+ # not set. OPENGL_INCLUDE_DIR cannot be set to "" because the
+ # resulting -I option to "cl" will eat the following
+ # "-IC:\really\needed" option. This is a kludge to get around
+ # cmake not ignoring INCLUDE_DIRECTORIES commands with empty
+ # strings.
+ SET( OPENGL_INCLUDE_DIR "${PROJECT_SOURCE_DIR}" )
+
+ ENDIF (CYGWIN)
+
+ELSE (WIN32)
+
+ # The first line below is to make sure that the proper headers
+ # are used on a Linux machine with the NVidia drivers installed.
+ # They replace Mesa with NVidia's own library but normally do not
+ # install headers and that causes the linking to
+ # fail since the compiler finds the Mesa headers but NVidia's library.
+ # Make sure the NVIDIA directory comes BEFORE the others.
+ # - Atanas Georgiev <atanas@cs.columbia.edu>
+
+ FIND_PATH(OPENGL_INCLUDE_DIR GL/gl.h
+ /usr/share/doc/NVIDIA_GLX-1.0/include
+ /usr/include
+ /usr/local/include
+ /usr/openwin/share/include
+ /opt/graphics/OpenGL/include
+ /usr/X11R6/include
+ ${OPENGL_INCLUDE_PATH}
+ )
+
+ FIND_PATH(OPENGL_xmesa_INCLUDE_DIR GL/xmesa.h
+ /usr/share/doc/NVIDIA_GLX-1.0/include
+ /usr/include
+ /usr/local/include
+ /usr/openwin/share/include
+ /opt/graphics/OpenGL/include
+ /usr/X11R6/include
+ )
+
+ FIND_LIBRARY(OPENGL_gl_LIBRARY
+ NAMES MesaGL GL
+ PATHS /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /opt/graphics/OpenGL/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ # On Unix OpenGL most certainly always requires X11.
+ # Feel free to tighten up these conditions if you don't
+ # think this is always true.
+
+ IF (OPENGL_gl_LIBRARY)
+ INCLUDE( ${MODULE_PATH}/NewCMake/FindX11.cmake )
+ IF (X11_FOUND)
+ SET (OPENGL_LIBRARIES ${X11_LIBRARIES})
+ ENDIF (X11_FOUND)
+ ENDIF (OPENGL_gl_LIBRARY)
+
+ FIND_LIBRARY(OPENGL_glu_LIBRARY
+ NAMES MesaGLU GLU
+ PATHS ${OPENGL_gl_LIBRARY}
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /opt/graphics/OpenGL/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ENDIF (WIN32)
+
+SET( OPENGL_FOUND "NO" )
+IF(OPENGL_INCLUDE_DIR)
+ IF(OPENGL_gl_LIBRARY)
+
+ IF(OPENGL_xmesa_INCLUDE_DIR)
+ SET( OPENGL_XMESA_FOUND "YES" )
+ ELSE(OPENGL_xmesa_INCLUDE_DIR)
+ SET( OPENGL_XMESA_FOUND "NO" )
+ ENDIF(OPENGL_xmesa_INCLUDE_DIR)
+
+ SET( OPENGL_LIBRARIES ${OPENGL_gl_LIBRARY} ${OPENGL_LIBRARIES})
+ IF(OPENGL_glu_LIBRARY)
+ SET( OPENGL_GLU_FOUND "YES" )
+ SET( OPENGL_LIBRARIES ${OPENGL_glu_LIBRARY} ${OPENGL_LIBRARIES} )
+ ELSE(OPENGL_glu_LIBRARY)
+ SET( OPENGL_GLU_FOUND "NO" )
+ ENDIF(OPENGL_glu_LIBRARY)
+
+ SET( OPENGL_FOUND "YES" )
+
+ # The following deprecated settings are for backwards
+ # compatibility with CMake1.4
+
+ SET (OPENGL_LIBRARY ${OPENGL_LIBRARIES})
+ SET (OPENGL_INCLUDE_PATH ${OPENGL_INCLUDE_DIR})
+
+ ENDIF(OPENGL_gl_LIBRARY)
+
+ SET(OPENGL_INCLUDE_PATH ${OPENGL_INCLUDE_DIR})
+
+ENDIF(OPENGL_INCLUDE_DIR)
+
+# On OSX, OpenGL is always there - this will need refining for those
+# using OpenGL with X11
+
+IF (APPLE)
+ SET (OPENGL_FOUND "YES")
+ SET (OPENGL_GLU_FOUND "YES")
+ SET (OPENGL_LIBRARIES "-framework AGL -framework OpenGL" CACHE STRING "OpenGL lib for OSX")
+ SET (OPENGL_LIBRARY ${OPENGL_LIBRARIES} CACHE STRING "OpenGL lib for OSX (for CMake 1.4)")
+ SET (OPENGL_gl_LIBRARY "-framework OpenGL" CACHE STRING "OpenGL lib for OSX")
+ SET (OPENGL_glu_LIBRARY "-framework AGL" CACHE STRING "AGL lib for OSX")
+ENDIF (APPLE)
+
+MARK_AS_ADVANCED(
+ OPENGL_INCLUDE_DIR
+ OPENGL_xmesa_INCLUDE_DIR
+ OPENGL_glu_LIBRARY
+ OPENGL_gl_LIBRARY
+)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindSTLPort.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindSTLPort.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..7095f1e388fe9b0eb66ff8b56c7cf6e9a265b3a1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindSTLPort.cmake
@@ -0,0 +1,76 @@
+#
+# Look for a directory containing STLPort.
+#
+# The following values are defined
+# STLPORT_INSTALL_DIR - STLPort's installation directory.
+# STLPORT_INCLUDE_DIR - where to find vector, etc.
+# STLPORT_LIBRARIES - link against these to use STLPort
+# STLPORT_FOUND - True if the X11 extensions are available.
+
+
+# Provide some common installation locations.
+# Otherwise, the user will have to specify it in the cache.
+FIND_PATH( STLPORT_INSTALL_DIR stlport/iostream
+ /usr/local/STLPort-4.5.3
+)
+
+# Assume for the moment that the STLPORT_INSTALL directory contains
+# both the subdirectory for header file includes (.../stlport) and
+# the subdirectory for libraries (../lib).
+
+
+FIND_PATH( STLPORT_INCLUDE_DIR iostream
+ ${STLPORT_INSTALL_DIR}/stlport
+)
+
+
+IF(CMAKE_BUILD_TYPE MATCHES "Debug")
+ # "Debug" probably means we do not want the non-debug ones.
+ FIND_LIBRARY( STLPORT_LIBRARIES
+ NAMES stlport_cygwin_debug
+ stlport_cygwin_stldebug
+ stlport_gcc_debug
+ stlport_gcc_stldebug
+ PATHS ${STLPORT_INSTALL_DIR}/lib
+ )
+ELSE(CMAKE_BUILD_TYPE MATCHES "Debug")
+ # if we only have debug libraries, use them.
+ # that is surely better than nothing.
+ FIND_LIBRARY( STLPORT_LIBRARIES
+ NAMES stlport_cygwin
+ stlport_cygwin_debug
+ stlport_cygwin_stldebug
+ stlport_gcc
+ stlport_gcc_debug
+ stlport_gcc_stldebug
+ PATHS ${STLPORT_INSTALL_DIR}/lib
+ )
+ENDIF(CMAKE_BUILD_TYPE MATCHES "Debug")
+
+
+#
+# For GCC, should we consider using -nostdinc or -isystem to
+# point to the STLPort system header directory? It is quite
+# important that we get the STLPort C++ header files and not
+# those that come with GCC.
+#
+
+
+IF( STLPORT_INCLUDE_DIR )
+ IF( STLPORT_LIBRARIES )
+ SET( STLPORT_FOUND "YES" )
+
+ # stlport_gcc needs pthread.
+ IF(UNIX)
+ SET( STLPORT_LIBRARIES
+ ${STLPORT_LIBRARIES} pthread )
+ ENDIF(UNIX)
+
+ ENDIF( STLPORT_LIBRARIES )
+ENDIF( STLPORT_INCLUDE_DIR )
+
+MARK_AS_ADVANCED(
+ STLPORT_INCLUDE_DIR
+ STLPORT_INSTALL_DIR
+ STLPORT_LIBRARIES
+)
\ No newline at end of file
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindX11.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindX11.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..45f91687c82890ffef5a1baa3c26e4aae4b04433
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/FindX11.cmake
@@ -0,0 +1,62 @@
+#
+# try to find X11 on UNIX systems.
+#
+# The following values are defined
+# X11_INCLUDE_DIR - where to find X11.h
+# X11_LIBRARIES - link against these to use X11
+# X11_FOUND - True if X11 is available
+# X11_Xext_FOUND - True if the X11 extensions are available.
+
+IF (UNIX)
+
+ FIND_PATH(X11_INCLUDE_DIR X11/X.h
+ /usr/include
+ /usr/local/include
+ /usr/openwin/include
+ /usr/openwin/share/include
+ /usr/X11R6/include
+ /usr/include/X11
+ /opt/graphics/OpenGL/include
+ )
+
+
+ FIND_LIBRARY(X11_X11_LIBRARY X11
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ FIND_LIBRARY(X11_Xext_LIBRARY Xext
+ /usr/lib64
+ /usr/lib
+ /usr/local/lib
+ /usr/openwin/lib
+ /usr/X11R6/lib
+ )
+
+ IF(X11_INCLUDE_DIR)
+
+ IF(X11_X11_LIBRARY)
+ SET( X11_FOUND "YES" )
+ SET( X11_LIBRARIES ${X11_X11_LIBRARY} )
+ ENDIF(X11_X11_LIBRARY)
+
+ IF(X11_Xext_LIBRARY)
+ SET( X11_LIBRARIES ${X11_LIBRARIES} ${X11_Xext_LIBRARY} )
+ SET( X11_Xext_FOUND "YES")
+ ENDIF(X11_Xext_LIBRARY)
+
+ ENDIF(X11_INCLUDE_DIR)
+
+ # Deprecated variable fro backwards compatibility with CMake 1.4
+ SET (X11_LIBRARY ${X11_X11_LIBRARY})
+
+MARK_AS_ADVANCED(
+ X11_X11_LIBRARY
+ X11_Xext_LIBRARY
+ X11_INCLUDE_DIR
+)
+
+ENDIF (UNIX)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/readme.txt b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/readme.txt
new file mode 100644
index 0000000000000000000000000000000000000000..3f8ef0d56fbb0fc9f1f7eb6cab23f23aa9d10c59
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/NewCMake/readme.txt
@@ -0,0 +1,2 @@
+This directory contains Module files which will be available from the CMake distribution in the next release.
+Any files in this directory should be identical to the latest versions in the CMake repository.
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVGUI.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVGUI.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..35722e377282326c8da07c2bc4db6ed3243fd58f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVGUI.cmake
@@ -0,0 +1,16 @@
+IF( VGUI_FOUND )
+ SET( HAS_VGUI "YES" )
+ INCLUDE(${CMAKE_ROOT}/Modules/FindOpenGL.cmake)
+ INCLUDE_DIRECTORIES( ${OPENGL_INCLUDE_PATH} )
+ ADD_DEFINITIONS( -DHAS_OPENGL)
+ INCLUDE(${CMAKE_ROOT}/Modules/FindGTK.cmake)
+ IF(VGUI_USE_GTK)
+ LINK_LIBRARIES( ${GTK_LIBRARIES} ${OPENGL_LIBRARIES} )
+ ENDIF(VGUI_USE_GTK)
+ENDIF( VGUI_FOUND )
+
+IF( VXL_VGUI_FOUND )
+ SET( HAS_VGUI "YES" )
+ INCLUDE_DIRECTORIES( ${VXL_VGUI_INCLUDE_DIR} )
+ LINK_LIBRARIES( ${VXL_VGUI_LIBRARIES} )
+ENDIF( VXL_VGUI_FOUND )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVXL.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVXL.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..195a5e8420110a28bdc66e3d0c493f680e797a4f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/UseVXL.cmake
@@ -0,0 +1,130 @@
+# vxl/config/cmake/UseVXL.cmake
+# (also copied by CMake to the top-level of the vxl build tree)
+#
+# This CMake file may be included by projects outside VXL. It
+# configures them to make use of VXL headers and libraries. The file
+# is written to work in one of two ways.
+#
+# The preferred way to use VXL from an outside project with UseVXL.cmake:
+#
+# FIND_PACKAGE(VXL)
+# IF(VXL_FOUND)
+# INCLUDE(${VXL_CMAKE_DIR}/UseVXL.cmake)
+# ELSE(VXL_FOUND)
+# MESSAGE("VXL_DIR should be set to the VXL build directory.")
+# ENDIF(VXL_FOUND)
+#
+# Read vxl/config/cmake/VXLConfig.cmake for the list of variables
+# provided. The names have changed to reduce namespace pollution.
+# The old names can be made available by placing this line before
+# including UseVXL.cmake:
+#
+# SET(VXL_PROVIDE_OLD_CACHE_NAMES 1)
+#
+# This UseVXL.cmake no longer adds options and testing features automatically
+# to projects including it unless this line appears before including it:
+#
+# SET(VXL_PROVIDE_STANDARD_OPTIONS 1)
+#
+# For example, in order to enable full backward-compatibility while
+# still using FIND_PACKAGE, use these lines:
+#
+# FIND_PACKAGE(VXL)
+# IF(VXL_FOUND)
+# SET(VXL_PROVIDE_OLD_CACHE_NAMES 1)
+# SET(VXL_PROVIDE_STANDARD_OPTIONS 1)
+# INCLUDE(${VXL_CMAKE_DIR}/UseVXL.cmake)
+# ELSE(VXL_FOUND)
+# MESSAGE("VXL_DIR should be set to the VXL build directory.")
+# ENDIF(VXL_FOUND)
+#
+# The old way to use VXL from an outside project with UseVXL.cmake is
+# also supported for backward-compatibility:
+#
+# SET(VXL_BINARY_PATH "" CACHE PATH "VXL build directory (location of UseVXL.cmake)")
+# IF(VXL_BINARY_PATH)
+# INCLUDE(${VXL_BINARY_PATH}/UseVXL.cmake)
+# ELSE(VXL_BINARY_PATH)
+# MESSAGE("VXL_BINARY_PATH should be set to the VXL build directory (location of UseVXL.cmake)" )
+# ENDIF(VXL_BINARY_PATH)
+#
+
+# If this file has been included directly by a user project instead of
+# through VXL_USE_FILE from VXLConfig.cmake, simulate old behavior.
+IF(NOT VXL_CONFIG_CMAKE)
+ IF(VXL_BINARY_PATH)
+
+ # Let FIND_PACKAGE import the VXLConfig.cmake module.
+ SET(VXL_DIR ${VXL_BINARY_PATH})
+ FIND_PACKAGE(VXL)
+
+ # Enable compatibility mode.
+ SET(VXL_PROVIDE_OLD_CACHE_NAMES 1)
+ SET(VXL_PROVIDE_STANDARD_OPTIONS 1)
+
+ ENDIF(VXL_BINARY_PATH)
+ENDIF(NOT VXL_CONFIG_CMAKE)
+
+# VXLConfig.cmake has now been included. Use its settings.
+IF(VXL_CONFIG_CMAKE)
+ # Load the compiler settings used for VXL.
+ IF(VXL_BUILD_SETTINGS_FILE)
+ INCLUDE(${CMAKE_ROOT}/Modules/CMakeImportBuildSettings.cmake)
+ CMAKE_IMPORT_BUILD_SETTINGS(${VXL_BUILD_SETTINGS_FILE})
+ ENDIF(VXL_BUILD_SETTINGS_FILE)
+
+ # Use the standard VXL include directories.
+ INCLUDE_DIRECTORIES(${VXL_VCL_INCLUDE_DIR} ${VXL_CORE_INCLUDE_DIR})
+
+ # Add link directories needed to use VXL.
+ LINK_DIRECTORIES(${VXL_LIBRARY_DIR})
+
+ # Provide backwards compatibility if it is requested.
+ IF(VXL_PROVIDE_OLD_CACHE_NAMES)
+ # Translate include directory variables back to old names.
+ SET(VTHREEP_INCLUDE_DIR ${VXL_V3P_INCLUDE_DIR_deprecated})
+ SET(VCL_INCLUDE_DIR ${VXL_VCL_INCLUDE_DIR})
+ SET(VXLCORE_INCLUDE_DIR ${VXL_CORE_INCLUDE_DIR})
+ SET(BRL_INCLUDE_DIR ${VXL_BRL_INCLUDE_DIR})
+ SET(GEL_INCLUDE_DIR ${VXL_GEL_INCLUDE_DIR})
+ SET(MUL_INCLUDE_DIR ${VXL_MUL_INCLUDE_DIR})
+ SET(OUL_INCLUDE_DIR ${VXL_OUL_INCLUDE_DIR})
+ SET(OXL_INCLUDE_DIR ${VXL_OXL_INCLUDE_DIR})
+ SET(RPL_INCLUDE_DIR ${VXL_RPL_INCLUDE_DIR})
+ SET(TBL_INCLUDE_DIR ${VXL_TBL_INCLUDE_DIR})
+ SET(CONVERSIONS_INCLUDE_DIR ${VXL_CONVERSIONS_INCLUDE_DIR})
+
+ SET(BUILD_VGUI ${VXL_VGUI_FOUND})
+ SET(BUILD_BRL ${VXL_BRL_FOUND})
+ SET(BUILD_OUL ${VXL_OUL_FOUND})
+ SET(BUILD_CONTRIB ${VXL_CONTRIB_FOUND})
+ SET(BUILD_TARGETJR ${VXL_TARGETJR_FOUND})
+ # These were excluded by LOAD_CACHE in old UseVXL.cmake.
+ # SET(BUILD_CONVERSIONS ${VXL_CONVERSIONS_FOUND})
+ # SET(BUILD_GEL ${VXL_GEL_FOUND})
+ # SET(BUILD_MUL ${VXL_MUL_FOUND})
+ # SET(BUILD_OXL ${VXL_OXL_FOUND})
+ # SET(BUILD_RPL ${VXL_RPL_FOUND})
+ # SET(BUILD_TBL ${VXL_TBL_FOUND})
+
+ SET(VGUI_USE_GLUT ${VXL_VGUI_USE_GLUT_deprecated})
+ SET(VGUI_USE_QT ${VXL_VGUI_USE_QT_deprecated})
+ SET(VGUI_USE_MFC ${VXL_VGUI_USE_MFC_deprecated})
+ SET(VGUI_USE_GTK ${VXL_VGUI_USE_GTK_deprecated})
+ SET(VGUI_USE_GTK2 ${VXL_VGUI_USE_GTK2_deprecated})
+
+ SET(VXL_FORCE_V3P_ZLIB ${VXL_FORCE_V3P_ZLIB_deprecated})
+ SET(VXL_FORCE_V3P_JPEG ${VXL_FORCE_V3P_JPEG_deprecated})
+ SET(VXL_FORCE_V3P_TIFF ${VXL_FORCE_V3P_TIFF_deprecated})
+ SET(VXL_FORCE_V3P_PNG ${VXL_FORCE_V3P_PNG_deprecated})
+ SET(VXL_FORCE_V3P_MPEG2 ${VXL_FORCE_V3P_MPEG2_deprecated})
+
+ SET(MODULE_PATH ${VXL_CMAKE_DIR})
+ SET(VXL_LIBRARY_PATH ${VXL_LIBRARY_DIR})
+ ENDIF(VXL_PROVIDE_OLD_CACHE_NAMES)
+
+ IF(VXL_PROVIDE_STANDARD_OPTIONS)
+ # Provide the standard set of VXL CMake options to the project.
+ INCLUDE(${VXL_CMAKE_DIR}/VXLStandardOptions.cmake)
+ ENDIF(VXL_PROVIDE_STANDARD_OPTIONS)
+ENDIF(VXL_CONFIG_CMAKE)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLConfig.cmake.in b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLConfig.cmake.in
new file mode 100644
index 0000000000000000000000000000000000000000..99b2221f11e71a7dcca0e53fe1998dfbae766ef6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLConfig.cmake.in
@@ -0,0 +1,165 @@
+# vxl/config/cmake/VXLConfig.cmake.in
+# also configured by CMake to
+# @vxl_BINARY_DIR@/VXLConfig.cmake
+#
+# This CMake module is configured by VXL's build process to export the
+# project settings for use by client projects. A client project may
+# find VXL and include this module using the FIND_PACKAGE command:
+#
+# FIND_PACKAGE(VXL)
+#
+# After this command executes, projects may test VXL_FOUND for whether
+# VXL has been found. If so, the settings listed below in this file
+# have been loaded and are available for use.
+#
+# Typically, a client project will include UseVXL.cmake from the
+# directory specified by the VXL_CMAKE_DIR setting:
+#
+# FIND_PACKAGE(VXL)
+# IF(VXL_FOUND)
+# INCLUDE(${VXL_CMAKE_DIR}/UseVXL.cmake)
+# ELSE(VXL_FOUND)
+# MESSAGE("VXL_DIR should be set to the VXL build directory.")
+# ENDIF(VXL_FOUND)
+#
+# See vxl/config/cmake/UseVXL.cmake for details.
+#
+
+# The build settings file.
+SET(VXL_BUILD_SETTINGS_FILE "@VXL_BUILD_SETTINGS_FILE@")
+
+# The VXL library dependencies.
+IF(NOT VXL_NO_LIBRARY_DEPENDS)
+ INCLUDE("@VXL_LIBRARY_DEPENDS_FILE@")
+ENDIF(NOT VXL_NO_LIBRARY_DEPENDS)
+
+# The VXL library directory.
+SET(VXL_LIBRARY_DIR "@LIBRARY_OUTPUT_PATH@")
+
+# The VXL CMake support directory.
+# Clients projects should not use the Find*.cmake files in this directory.
+SET(VXL_CMAKE_DIR "@VXL_CMAKE_DIR@")
+
+# VXL Configuration options.
+SET(VXL_BUILD_SHARED_LIBS "@BUILD_SHARED_LIBS@")
+SET(VXL_BUILD_TESTS "@BUILD_TESTS@")
+SET(VXL_BUILD_EXAMPLES "@BUILD_EXAMPLES@")
+
+# VXL has many parts that are optional, depending on selections made
+# when building. The stanzas below give a consistent (though
+# pedantic) interface to each part. Clients use these settings to
+# determine whether a part was built (_FOUND), where its headers are
+# located (_INCLUDE_DIR) and in some cases what libraries must be
+# linked to use the part (_LIBRARIES). Most client projects will
+# likely still refer to vcl by hard-wired "vcl" instead of using the
+# variable VXL_VCL_LIBRARIES, but it is there just in case.
+
+SET(VXL_VCL_FOUND "YES" ) # VXL vcl is always FOUND. It is not optional.
+SET(VXL_VCL_INCLUDE_DIR "@VCL_INCLUDE_DIR@")
+SET(VXL_VCL_LIBRARIES "vcl")
+
+SET(VXL_CORE_FOUND "YES" ) # VXL core is always FOUND. It is not optional.
+SET(VXL_CORE_INCLUDE_DIR "@VXLCORE_INCLUDE_DIR@")
+# VXL core has many libraries
+
+SET(VXL_VGUI_FOUND "@VGUI_FOUND@")
+SET(VXL_VGUI_INCLUDE_DIR "@OPENGL_INCLUDE_DIR@")
+SET(VXL_VGUI_LIBRARIES "vgui")
+
+SET(VXL_CONTRIB_FOUND "@BUILD_CONTRIB@")
+# VXL contrib has subdirectories handled independently below
+# VXL contrib has many libraries
+
+SET(VXL_BRL_FOUND "@BUILD_BRL@")
+SET(VXL_BRL_INCLUDE_DIR "@BRL_INCLUDE_DIR@")
+# VXL BRL has many libraries
+
+SET(VXL_GEL_FOUND "@BUILD_GEL@")
+SET(VXL_GEL_INCLUDE_DIR "@GEL_INCLUDE_DIR@")
+# VXL GEL has many libraries
+
+SET(VXL_MUL_FOUND "@BUILD_MUL@")
+SET(VXL_MUL_INCLUDE_DIR "@MUL_INCLUDE_DIR@")
+# VXL MUL has many libraries
+
+SET(VXL_OUL_FOUND "@BUILD_OUL@")
+SET(VXL_OUL_INCLUDE_DIR "@OUL_INCLUDE_DIR@")
+# VXL OUL has many libraries
+
+SET(VXL_OXL_FOUND "@BUILD_OXL@")
+SET(VXL_OXL_INCLUDE_DIR "@OXL_INCLUDE_DIR@")
+# VXL OXL has many libraries
+
+SET(VXL_RPL_FOUND "@BUILD_RPL@")
+SET(VXL_RPL_INCLUDE_DIR "@RPL_INCLUDE_DIR@")
+# VXL RPL has many libraries
+
+SET(VXL_TBL_FOUND "@BUILD_TBL@")
+SET(VXL_TBL_INCLUDE_DIR "@TBL_INCLUDE_DIR@")
+# VXL TBL has many libraries
+
+SET(VXL_CONVERSIONS_FOUND "@BUILD_CONVERSIONS@")
+SET(VXL_CONVERSIONS_INCLUDE_DIR "@CONVERSIONS_INCLUDE_DIR@")
+# VXL CONVERSIONS has no libraries
+
+SET(VXL_TARGETJR_FOUND "@BUILD_TARGETJR@")
+
+# Client projects use these setting to find and use the 3rd party
+# libraries that VXL either found on the system or built for itself.
+# Sometimes, VXL will point client projects to the library VXL built
+# for itself, and sometimes VXL will point client projects to the
+# system library it found.
+
+SET(VXL_NETLIB_FOUND "@NETLIB_FOUND@")
+SET(VXL_NETLIB_INCLUDE_DIR "@NETLIB_INCLUDE_DIR@")
+SET(VXL_NETLIB_LIBRARIES "@NETLIB_LIBRARIES@")
+
+SET(VXL_QV_FOUND "@QV_FOUND@")
+SET(VXL_QV_INCLUDE_DIR "@QV_INCLUDE_DIR@")
+SET(VXL_QV_LIBRARIES "@QV_LIBRARIES@")
+
+SET(VXL_ZLIB_FOUND "@ZLIB_FOUND@")
+SET(VXL_ZLIB_INCLUDE_DIR "@ZLIB_INCLUDE_DIR@")
+SET(VXL_ZLIB_LIBRARIES "@ZLIB_LIBRARIES@")
+
+SET(VXL_PNG_FOUND "@PNG_FOUND@")
+SET(VXL_PNG_INCLUDE_DIR "@PNG_INCLUDE_DIR@")
+SET(VXL_PNG_LIBRARIES "@PNG_LIBRARIES@")
+
+SET(VXL_JPEG_FOUND "@JPEG_FOUND@")
+SET(VXL_JPEG_INCLUDE_DIR "@JPEG_INCLUDE_DIR@")
+SET(VXL_JPEG_LIBRARIES "@JPEG_LIBRARIES@")
+
+SET(VXL_TIFF_FOUND "@TIFF_FOUND@")
+SET(VXL_TIFF_INCLUDE_DIR "@TIFF_INCLUDE_DIR@")
+SET(VXL_TIFF_LIBRARIES "@TIFF_LIBRARIES@")
+
+SET(VXL_MPEG2_FOUND "@MPEG2_FOUND@")
+SET(VXL_MPEG2_INCLUDE_DIR "@MPEG2_INCLUDE_DIR@")
+SET(VXL_MPEG2_LIBRARIES "@MPEG2_LIBRARIES@")
+
+# Tell UseVXL.cmake that VXLConfig.cmake has been included.
+SET(VXL_CONFIG_CMAKE 1)
+
+### deprecated variables set below ###
+# These should be removed after some time to upgrade has passed.
+
+# VXL include directories.
+# There is no need for clients to use this directly
+SET(VXL_V3P_INCLUDE_DIR_deprecated "@VTHREEP_INCLUDE_DIR@")
+
+# Would a client project need to use these variables ever?
+# These are needed for backward compatibility mode for now, see UseVXL.cmake
+SET(VXL_VGUI_USE_GLUT_deprecated "@VGUI_USE_GLUT@")
+SET(VXL_VGUI_USE_QT_deprecated "@VGUI_USE_QT@")
+SET(VXL_VGUI_USE_MFC_deprecated "@VGUI_USE_MFC@")
+SET(VXL_VGUI_USE_GTK_deprecated "@VGUI_USE_GTK@")
+SET(VXL_VGUI_USE_GTK2_deprecated "@VGUI_USE_GTK2@")
+
+# There is no need for clients to know this.
+# These are needed for backward compatibility mode for now, see UseVXL.cmake
+SET(VXL_FORCE_V3P_ZLIB_deprecated "@VXL_FORCE_V3P_ZLIB@")
+SET(VXL_FORCE_V3P_JPEG_deprecated "@VXL_FORCE_V3P_JPEG@")
+SET(VXL_FORCE_V3P_TIFF_deprecated "@VXL_FORCE_V3P_TIFF@")
+SET(VXL_FORCE_V3P_PNG_deprecated "@VXL_FORCE_V3P_PNG@")
+SET(VXL_FORCE_V3P_MPEG2_deprecated "@VXL_FORCE_V3P_MPEG2@")
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLStandardOptions.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLStandardOptions.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..c0414fc5ca5de1d13ed97450579804ca1b63acf7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/VXLStandardOptions.cmake
@@ -0,0 +1,74 @@
+# vxl/config/cmake/VXLStandardOptions.cmake
+#
+# This CMake module is included by vxl/CMakeLists.txt. It adds
+# several vxl-standard testing and build options to the project:
+#
+# BUILD_SHARED_LIBS
+# BUILD_TESTING
+# BUILD_EXAMPLES
+# WARN_DEPRECATED
+# WARN_DEPRECATED_ONCE
+# WARN_DEPRECATED_ABORT
+#
+# These options may be introduced into client projects with this line:
+#
+# INCLUDE(${VXL_CMAKE_DIR}/VXLStandardOptions.cmake)
+#
+# This module may be automatically included by UseVXL.cmake.
+# See vxl/config/cmake/UseVXL.cmake for details.
+#
+
+# Everything here should be valid for both the vxl source and for
+# client projects.
+
+INCLUDE( ${CMAKE_ROOT}/Modules/Dart.cmake )
+
+IF( WIN32 )
+ OPTION( BUILD_SHARED_LIBS "Should shared libraries be the default?" NO )
+ELSE( WIN32 )
+ OPTION( BUILD_SHARED_LIBS "Should shared libraries be the default?" NO )
+ENDIF( WIN32 )
+
+SET( SOLARIS 0 )
+IF( CMAKE_SYSTEM MATCHES "SunOS.*" )
+ SET( SOLARIS 1 )
+ENDIF( CMAKE_SYSTEM MATCHES "SunOS.*" )
+
+# if this is a dashboard build
+IF( DART_ROOT )
+ ADD_DEFINITIONS( -DDART_BUILD )
+ENDIF( DART_ROOT)
+
+# Some people may want to build the test cases even though they aren't
+# using Dart.
+IF( NOT DART_ROOT )
+ IF( WIN32 )
+ OPTION( BUILD_TESTING "Should the tests be built?" NO )
+ ELSE( WIN32 )
+ OPTION( BUILD_TESTING "Should the tests be built?" YES )
+ ENDIF( WIN32 )
+
+ IF( BUILD_TESTING )
+ ENABLE_TESTING()
+ ENDIF( BUILD_TESTING )
+ENDIF( NOT DART_ROOT )
+OPTION( BUILD_TESTING "Should the tests be built?" YES )
+
+# By default, build examples when building tests.
+OPTION( BUILD_EXAMPLES "Should the examples be built?" ${BUILD_TESTING} )
+
+OPTION( WARN_DEPRECATED "Enable runtime warnings for deprecated functions?" YES )
+OPTION( WARN_DEPRECATED_ONCE "Only warn once per function (if runtime warnings are enabled)?" YES )
+OPTION( WARN_DEPRECATED_ABORT "Abort on executing a deprecated function (if runtime warnings are enabled)?" NO )
+
+MARK_AS_ADVANCED( WARN_DEPRECATED WARN_DEPRECATED_ONCE WARN_DEPRECATED_ABORT )
+
+IF(WARN_DEPRECATED)
+ ADD_DEFINITIONS( -DVXL_WARN_DEPRECATED )
+ IF(WARN_DEPRECATED_ONCE)
+ ADD_DEFINITIONS( -DVXL_WARN_DEPRECATED_ONCE )
+ ENDIF(WARN_DEPRECATED_ONCE)
+ IF(WARN_DEPRECATED_ABORT)
+ ADD_DEFINITIONS( -DVXL_WARN_DEPRECATED_ABORT )
+ ENDIF(WARN_DEPRECATED_ABORT)
+ENDIF(WARN_DEPRECATED)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/Modules/readme.txt b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/readme.txt
new file mode 100644
index 0000000000000000000000000000000000000000..76d210951107ab98890186e8757b9c2a7ffadc31
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/Modules/readme.txt
@@ -0,0 +1,21 @@
+This directory should only contain FindXXX.cmake modules and other CMake configuration files specific to VXL.
+In particular it should contain specialised files to deal with the libraries provided in v3p.
+
+In the past the this directory and NewCMake were used to store FindXXX.cmake modules
+that were not yet available from CMake. Initially VXL needed many more FindXXX.cmake modules, (or several vastly
+better written modules) than were available from CMake. Now however, CMake provides all the module files needed
+by VXL, and has access to many more bug reports for its module files than VXL has.
+
+It no longer makes any sense in all but a few rare and temporary cases for VXL to attempt to maintain ordinary
+module files. Trying to maintain parallel copies in VXL and CMake is unnecessary and difficult work.
+
+If the CMake provided module file is buggy then please submit a fix to CMake at cmake@www.cmake.org
+If you need a new FindXXX.cmake file for your private code, then please do not add it to VXL. You
+can submit it to CMake at cmake@www.cmake.org
+
+If you are adding some new functionality to VXL and you need a third party library, (and VXL-maintainers agrees
+that VXL can depend on this additional library) then you can temporarily add the file to the NewCMake subdirectory.
+Please also submit it to CMake at cmake@www.cmake.org, and delete it from the VXL repository when the next
+version of CMake is widely available.
+
+
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/config/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/config/cmake/config/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..438a68dc799cac43da67a367da65784583c2d75a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/config/CMakeLists.txt
@@ -0,0 +1,297 @@
+# vxl/config/cmake/config/CMakeLists.txt
+#
+
+PROJECT(vxl_config)
+CMAKE_MINIMUM_REQUIRED(VERSION 1.8)
+
+# When adding new configuration tests that cache results, please make
+# sure they honour VXL_UPDATE_CONFIGURATION: if this variable is ON,
+# redo the test and update the cached value.
+
+#
+# The tests results will be cached. Allow the user to re-run the tests
+# if necessary This flag will be reset to "OFF" every time, so that
+# the tests are typically just run once. Set it to ON to refresh your
+# machine's configuration if you believe the test results are stale or
+# wrong.
+#
+OPTION( VXL_UPDATE_CONFIGURATION "Re-run the configuration tests to update cached results?" "OFF" )
+MARK_AS_ADVANCED( VXL_UPDATE_CONFIGURATION )
+
+# The serial number below will allow the maintainers to force builds
+# to update cached results. Whenever you make a change that makes it
+# necessary for cached values to be updated, increment the serial
+# number. The format follows a DNS-style numbering: the current date
+# followed by a modification time within the day.
+#
+SET( VXL_CONFIG_SERIAL_CURRENT "2004-02-10-001" )
+
+IF( ${VXL_CONFIG_SERIAL_CURRENT} MATCHES "^${VXL_CONFIG_SERIAL_LAST}$" )
+ # The configuration is current
+ELSE( ${VXL_CONFIG_SERIAL_CURRENT} MATCHES "^${VXL_CONFIG_SERIAL_LAST}$" )
+ SET( VXL_UPDATE_CONFIGURATION "ON" )
+ # Record that we've done the new config.
+ SET( VXL_CONFIG_SERIAL_LAST ${VXL_CONFIG_SERIAL_CURRENT} CACHE INTERNAL "Serial number of last configuration" )
+ENDIF( ${VXL_CONFIG_SERIAL_CURRENT} MATCHES "^${VXL_CONFIG_SERIAL_LAST}$" )
+
+
+
+#
+# Include necessary modules
+#
+
+INCLUDE (${CMAKE_ROOT}/Modules/CheckSymbolExists.cmake)
+INCLUDE (${CMAKE_ROOT}/Modules/TestBigEndian.cmake)
+INCLUDE (${CMAKE_ROOT}/Modules/CheckTypeSize.cmake)
+
+INCLUDE (${vxl_SOURCE_DIR}/config/cmake/config/vxl_config_macros.cmake)
+
+#
+# Perform all the specific tests
+#
+
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_BOOL)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_TYPENAME)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_EXPORT)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_MUTABLE)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_EXPLICIT)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_DYNAMIC_CAST)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_RTTI)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_FOR_SCOPE_HACK)
+ SET_INVERT(VCL_FOR_SCOPE_HACK "${VCL_FOR_SCOPE_HACK}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_DEFAULT_VALUE)
+ SET_BOOL(VCL_DEFAULT_VALUE "/* no need */" " = x")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_MEMBER_TEMPLATES)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_PARTIAL_SPECIALIZATION)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_ALLOWS_INLINE_INSTANTIATION)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_NEEDS_INLINE_INSTANTIATION)
+ SET_INVERT(VCL_NEEDS_INLINE_INSTANTIATION "${VCL_NEEDS_INLINE_INSTANTIATION}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_STATIC_CONST_INIT_INT)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_STATIC_CONST_INIT_NO_DEFN)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_STATIC_CONST_INIT_FLOAT)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_STATIC_TEMPLATE_MEMBER)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD)
+ SET_INVERT(VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD "${VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_OVERLOAD_CAST)
+ SET_BOOL(VCL_OVERLOAD_CAST "(x)" "((T)(x))")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_NULL_TMPL_ARGS)
+ SET_BOOL(VCL_NULL_TMPL_ARGS "/* <> */" "<>")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_NO_STATIC_DATA_MEMBERS)
+ SET_INVERT(VCL_NO_STATIC_DATA_MEMBERS "${VCL_NO_STATIC_DATA_MEMBERS}")
+PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_HAS_TEMPLATE_SYMBOLS)
+ SET_INVERT(VCL_HAS_TEMPLATE_SYMBOLS "${VCL_HAS_TEMPLATE_SYMBOLS}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_IMPLICIT_TEMPLATES)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_TEMPLATE_MATCHES_TOO_OFTEN)
+ SET_INVERT(VCL_TEMPLATE_MATCHES_TOO_OFTEN "${VCL_TEMPLATE_MATCHES_TOO_OFTEN}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_SUNPRO_CLASS_SCOPE_HACK)
+ SET_BOOL(VCL_SUNPRO_CLASS_SCOPE_HACK "/* , A */" ", A")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_EXCEPTIONS)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_HAS_NAMESPACES)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_ALLOWS_NAMESPACE_STD)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_NEEDS_NAMESPACE_STD)
+ SET_INVERT(VCL_NEEDS_NAMESPACE_STD "${VCL_NEEDS_NAMESPACE_STD}")
+PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_HAS_SLICED_DESTRUCTOR_BUG)
+ SET_INVERT(VCL_HAS_SLICED_DESTRUCTOR_BUG "${VCL_HAS_SLICED_DESTRUCTOR_BUG}")
+PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_HAS_WORKING_STRINGSTREAM)
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VXL_UNISTD_USLEEP_IS_VOID)
+ SET_INVERT(VXL_UNISTD_USLEEP_IS_VOID "${VXL_UNISTD_USLEEP_IS_VOID}")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VXL_STDLIB_HAS_QSORT)
+
+# Test how to define a template specialization, and whether
+# specializations can be properly distinguished by top-level
+# cv-qualifiers.
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_DEFINE_SPECIALIZATION)
+IF(NOT VCL_DEFINE_SPECIALIZATION)
+ SET(CMAKE_REQUIRED_FLAGS "-DNOT_CONFORMING_SPECIALIZATION")
+ENDIF(NOT VCL_DEFINE_SPECIALIZATION)
+ SET_BOOL(VCL_DEFINE_SPECIALIZATION "template <>" "/* template <> */")
+PERFORM_CMAKE_TEST(vxl_platform_tests.cxx VCL_CANNOT_SPECIALIZE_CV)
+ SET_INVERT(VCL_CANNOT_SPECIALIZE_CV "${VCL_CANNOT_SPECIALIZE_CV}")
+SET(CMAKE_REQUIRED_FLAGS)
+
+#
+# Find header files
+#
+
+PERFORM_CHECK_HEADER(cassert VCL_CXX_HAS_HEADER_CASSERT)
+PERFORM_CHECK_HEADER(ciso646 VCL_CXX_HAS_HEADER_CISO646)
+PERFORM_CHECK_HEADER(csetjmp VCL_CXX_HAS_HEADER_CSETJMP)
+PERFORM_CHECK_HEADER(cstdio VCL_CXX_HAS_HEADER_CSTDIO)
+PERFORM_CHECK_HEADER(ctime VCL_CXX_HAS_HEADER_CTIME)
+PERFORM_CHECK_HEADER(cctype VCL_CXX_HAS_HEADER_CCTYPE)
+PERFORM_CHECK_HEADER(climits VCL_CXX_HAS_HEADER_CLIMITS)
+PERFORM_CHECK_HEADER(csignal VCL_CXX_HAS_HEADER_CSIGNAL)
+PERFORM_CHECK_HEADER(cstdlib VCL_CXX_HAS_HEADER_CSTDLIB)
+PERFORM_CHECK_HEADER(cwchar VCL_CXX_HAS_HEADER_CWCHAR)
+PERFORM_CHECK_HEADER(cerrno VCL_CXX_HAS_HEADER_CERRNO)
+PERFORM_CHECK_HEADER(clocale VCL_CXX_HAS_HEADER_CLOCALE)
+PERFORM_CHECK_HEADER(cstdarg VCL_CXX_HAS_HEADER_CSTDARG)
+PERFORM_CHECK_HEADER(cstring VCL_CXX_HAS_HEADER_CSTRING)
+PERFORM_CHECK_HEADER(cwctype VCL_CXX_HAS_HEADER_CWCTYPE)
+PERFORM_CHECK_HEADER(cfloat VCL_CXX_HAS_HEADER_CFLOAT)
+PERFORM_CHECK_HEADER(cmath VCL_CXX_HAS_HEADER_CMATH)
+PERFORM_CHECK_HEADER(cstddef VCL_CXX_HAS_HEADER_CSTDDEF)
+PERFORM_CHECK_HEADER(algorithm VCL_CXX_HAS_HEADER_ALGORITHM)
+PERFORM_CHECK_HEADER(iomanip VCL_CXX_HAS_HEADER_IOMANIP)
+PERFORM_CHECK_HEADER(list VCL_CXX_HAS_HEADER_LIST)
+PERFORM_CHECK_HEADER(ostream VCL_CXX_HAS_HEADER_OSTREAM)
+PERFORM_CHECK_HEADER(streambuf VCL_CXX_HAS_HEADER_STREAMBUF)
+PERFORM_CHECK_HEADER(bitset VCL_CXX_HAS_HEADER_BITSET)
+PERFORM_CHECK_HEADER(ios VCL_CXX_HAS_HEADER_IOS)
+PERFORM_CHECK_HEADER(locale VCL_CXX_HAS_HEADER_LOCALE)
+PERFORM_CHECK_HEADER(queue VCL_CXX_HAS_HEADER_QUEUE)
+PERFORM_CHECK_HEADER(string VCL_CXX_HAS_HEADER_STRING)
+PERFORM_CHECK_HEADER(complex VCL_CXX_HAS_HEADER_COMPLEX)
+PERFORM_CHECK_HEADER(iosfwd VCL_CXX_HAS_HEADER_IOSFWD)
+PERFORM_CHECK_HEADER(map VCL_CXX_HAS_HEADER_MAP)
+PERFORM_CHECK_HEADER(set VCL_CXX_HAS_HEADER_SET)
+PERFORM_CHECK_HEADER(typeinfo VCL_CXX_HAS_HEADER_TYPEINFO)
+PERFORM_CHECK_HEADER(deque VCL_CXX_HAS_HEADER_DEQUE)
+PERFORM_CHECK_HEADER(iostream VCL_CXX_HAS_HEADER_IOSTREAM)
+PERFORM_CHECK_HEADER(memory VCL_CXX_HAS_HEADER_MEMORY)
+PERFORM_CHECK_HEADER(sstream VCL_CXX_HAS_HEADER_SSTREAM)
+PERFORM_CHECK_HEADER(utility VCL_CXX_HAS_HEADER_UTILITY)
+PERFORM_CHECK_HEADER(exception VCL_CXX_HAS_HEADER_EXCEPTION)
+PERFORM_CHECK_HEADER(istream VCL_CXX_HAS_HEADER_ISTREAM)
+PERFORM_CHECK_HEADER(new VCL_CXX_HAS_HEADER_NEW)
+PERFORM_CHECK_HEADER(stack VCL_CXX_HAS_HEADER_STACK)
+PERFORM_CHECK_HEADER(valarray VCL_CXX_HAS_HEADER_VALARRAY)
+PERFORM_CHECK_HEADER(fstream VCL_CXX_HAS_HEADER_FSTREAM)
+PERFORM_CHECK_HEADER(iterator VCL_CXX_HAS_HEADER_ITERATOR)
+PERFORM_CHECK_HEADER(numeric VCL_CXX_HAS_HEADER_NUMERIC)
+PERFORM_CHECK_HEADER(stdexcept VCL_CXX_HAS_HEADER_STDEXCEPT)
+PERFORM_CHECK_HEADER(vector VCL_CXX_HAS_HEADER_VECTOR)
+PERFORM_CHECK_HEADER(functional VCL_CXX_HAS_HEADER_FUNCTIONAL)
+PERFORM_CHECK_HEADER(limits VCL_CXX_HAS_HEADER_LIMITS)
+PERFORM_CHECK_HEADER(strstream VCL_CXX_HAS_HEADER_STRSTREAM)
+PERFORM_CHECK_HEADER(pthread.h VXL_HAS_PTHREAD_H)
+PERFORM_CHECK_HEADER(semaphore.h VXL_HAS_SEMAPHORE_H)
+PERFORM_CHECK_HEADER(ieeefp.h VXL_HAS_IEEEFP_H)
+PERFORM_CHECK_HEADER(iso646.h VCL_CXX_HAS_HEADER_ISO646_H)
+
+
+#
+# Check complex pow stuff
+#
+
+IF(VCL_CXX_HAS_HEADER_COMPLEX)
+ PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_COMPLEX_POW_WORKS)
+ENDIF(VCL_CXX_HAS_HEADER_COMPLEX)
+
+# Tests of math.h may need math library on UNIX.
+IF(UNIX)
+ SET(CMAKE_REQUIRED_LIBRARIES "${CMAKE_REQUIRED_LIBRARIES};m")
+ENDIF(UNIX)
+
+PERFORM_C_CHECK_FUNCTION(sqrtf "math.h" VXL_C_MATH_HAS_SQRTF)
+PERFORM_C_CHECK_FUNCTION(finite "math.h" VXL_C_MATH_HAS_FINITE)
+PERFORM_C_CHECK_FUNCTION(finitef "math.h" VXL_C_MATH_HAS_FINITEF)
+PERFORM_C_CHECK_FUNCTION(finitel "math.h" VXL_C_MATH_HAS_FINITEL)
+PERFORM_C_CHECK_FUNCTION(finite "ieeefp.h" VXL_IEEEFP_HAS_FINITE)
+#PERFORM_C_CHECK_FUNCTION(qsort "stdlib.h" VXL_STDLIB_HAS_QSORT)
+PERFORM_C_CHECK_FUNCTION(lrand48 "stdlib.h" VXL_STDLIB_HAS_LRAND48)
+PERFORM_C_CHECK_FUNCTION(drand48 "stdlib.h" VXL_STDLIB_HAS_DRAND48)
+PERFORM_C_CHECK_FUNCTION(srand48 "stdlib.h" VXL_STDLIB_HAS_SRAND48)
+
+TEST_BIG_ENDIAN(VXL_BIG_ENDIAN)
+SET_INVERT(VXL_LITTLE_ENDIAN "${VXL_BIG_ENDIAN}")
+
+#
+# Values which are to be manually set
+#
+
+SET(VCL_USE_NATIVE_STL 1) # change if no
+SET(VCL_USE_NATIVE_COMPLEX 1)
+SET(VCL_USE_IMPLICIT_TEMPLATES 1) # change if no
+SET(VXL_TWO_ARG_GETTIME 0) # not used
+
+IF(NOT VCL_CAN_DO_IMPLICIT_TEMPLATES)
+ MESSAGE("Warning: turning off implicit template instantiation")
+ SET(VCL_USE_IMPLICIT_TEMPLATES 0)
+ENDIF(NOT VCL_CAN_DO_IMPLICIT_TEMPLATES)
+
+PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_CHAR_IS_SIGNED)
+
+#
+# Check type sizes
+#
+
+SET(CMAKE_REQUIRED_FLAGS ${CMAKE_ANSI_CFLAGS})
+
+# The types are listed in reverse order of preference. That is, the
+# last type is should be the most preferred type name.
+#
+DETERMINE_TYPE(BYTE 1 8 "char")
+DETERMINE_TYPE(INT_8 1 8 "short;char")
+DETERMINE_TYPE(INT_16 1 16 "char;int;short")
+DETERMINE_TYPE(INT_32 1 32 "short;long;int")
+DETERMINE_TYPE(INT_64 1 64 "__int64;long long;long")
+DETERMINE_TYPE(IEEE_32 0 32 "long double;double;float")
+DETERMINE_TYPE(IEEE_64 0 64 "float;long double;double")
+DETERMINE_TYPE(IEEE_96 0 96 "float;double;long double")
+DETERMINE_TYPE(IEEE_128 0 128 "float;double;long double")
+IF (${VXL_INT_64} MATCHES "^long$")
+ SET(VXL_INT_64_IS_LONG 1)
+ELSE(${VXL_INT_64} MATCHES "^long$")
+ SET(VXL_INT_64_IS_LONG 0)
+ENDIF(${VXL_INT_64} MATCHES "^long$")
+
+#
+# Check unistd stuff
+#
+
+CHECK_INCLUDE_FILE_CXX("unistd.h" HAVE_UNISTD_H)
+IF(HAVE_UNISTD_H)
+ CHECK_TYPE_EXISTS_ZERO(useconds_t "unistd.h" VXL_UNISTD_HAS_USECONDS_T)
+ CHECK_TYPE_EXISTS_ZERO(intptr_t "unistd.h" VXL_UNISTD_HAS_INTPTR_T)
+ CHECK_FUNCTION_EXISTS_ZERO(ualarm VXL_UNISTD_HAS_UALARM)
+ CHECK_FUNCTION_EXISTS_ZERO(usleep VXL_UNISTD_HAS_USLEEP)
+ CHECK_FUNCTION_EXISTS_ZERO(lchown VXL_UNISTD_HAS_LCHOWN)
+ CHECK_FUNCTION_EXISTS_ZERO(pread VXL_UNISTD_HAS_PREAD)
+ CHECK_FUNCTION_EXISTS_ZERO(pwrite VXL_UNISTD_HAS_PWRITE)
+ CHECK_FUNCTION_EXISTS_ZERO(tell VXL_UNISTD_HAS_TELL)
+ELSE(HAVE_UNISTD_H)
+ # If there is not unistd.h, assume windows and therefore hardcode results.
+ SET(VXL_UNISTD_HAS_USECONDS_T 0)
+ SET(VXL_UNISTD_HAS_INTPTR_T 0)
+ SET(VXL_UNISTD_HAS_UALARM 1)
+ SET(VXL_UNISTD_HAS_USLEEP 1)
+ SET(VXL_UNISTD_HAS_LCHOWN 1)
+ SET(VXL_UNISTD_HAS_PREAD 1)
+ SET(VXL_UNISTD_HAS_PWRITE 1)
+ SET(VXL_UNISTD_HAS_TELL 1)
+ENDIF(HAVE_UNISTD_H)
+
+
+#
+# Check numeric_limits infinity stuff
+#
+
+IF(VCL_CXX_HAS_HEADER_LIMITS)
+ PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_NUMERIC_LIMITS_HAS_INFINITY)
+ IF(VCL_CXX_HAS_HEADER_CFLOAT)
+ PERFORM_CMAKE_TEST_RUN(vxl_platform_tests.cxx VCL_PROCESSOR_HAS_INFINITY)
+ ELSE(VCL_CXX_HAS_HEADER_CFLOAT)
+ SET(VCL_PROCESSOR_HAS_INFINITY 0)
+ ENDIF(VCL_CXX_HAS_HEADER_CFLOAT)
+ELSE(VCL_CXX_HAS_HEADER_LIMITS)
+ SET(VCL_NUMERIC_LIMITS_HAS_INFINITY 0)
+ SET(VCL_PROCESSOR_HAS_INFINITY 0)
+ENDIF(VCL_CXX_HAS_HEADER_LIMITS)
+
+
+#
+# configure files
+#
+
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/vcl/vcl_config_compiler.h.in ${vxl_BINARY_DIR}/vcl/vcl_config_compiler.h)
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/vcl/vcl_config_headers.h.in ${vxl_BINARY_DIR}/vcl/vcl_config_headers.h)
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/vcl/vcl_config_manual.h.in ${vxl_BINARY_DIR}/vcl/vcl_config_manual.h)
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/vcl/vcl_where_root_dir.h.in ${vxl_BINARY_DIR}/vcl/vcl_where_root_dir.h)
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/core/vxl_config.h.in ${vxl_BINARY_DIR}/core/vxl_config.h)
+
+# Reset the update configuration flag
+SET( VXL_UPDATE_CONFIGURATION "OFF" CACHE BOOL "Re-run the configuration tests?" FORCE )
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_config_macros.cmake b/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_config_macros.cmake
new file mode 100644
index 0000000000000000000000000000000000000000..8535d32ac5837a0fc7d68ac219b681fa5e17f24d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_config_macros.cmake
@@ -0,0 +1,297 @@
+INCLUDE (${CMAKE_ROOT}/Modules/CheckIncludeFileCXX.cmake)
+INCLUDE (${CMAKE_ROOT}/Modules/CheckFunctionExists.cmake)
+
+#
+# Perform the VXL specific test with status output
+#
+# Sets the TEST to 1 if the corresponding program could be compiled
+# and linked
+#
+
+MACRO(PERFORM_CMAKE_TEST FILE TEST)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${TEST} "${TEST}" )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ IF("${TEST}" MATCHES "^${TEST}$")
+ # Perform test
+ SET(MACRO_CHECK_FUNCTION_DEFINITIONS
+ "-D${TEST} ${CMAKE_REQUIRED_FLAGS}")
+ IF(CMAKE_REQUIRED_LIBRARIES)
+ SET(TEST_ADD_LIBRARIES
+ "-DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}")
+ ENDIF(CMAKE_REQUIRED_LIBRARIES)
+ MESSAGE(STATUS "Performing Test ${TEST}")
+
+ TRY_COMPILE(${TEST}
+ ${CMAKE_BINARY_DIR}
+ ${vxl_config_SOURCE_DIR}/${FILE}
+ CMAKE_FLAGS -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_FUNCTION_DEFINITIONS}
+ "${TEST_ADD_LIBRARIES}"
+ OUTPUT_VARIABLE OUTPUT)
+ IF(${TEST})
+ SET(${TEST} 1 CACHE INTERNAL "VXL test ${FUNCTION}")
+ MESSAGE(STATUS "Performing Test ${TEST} - Success")
+ ELSE(${TEST})
+ MESSAGE(STATUS "Performing Test ${TEST} - Failed")
+ SET(${TEST} 0 CACHE INTERNAL "Test ${FUNCTION}")
+ WRITE_FILE(${CMAKE_BINARY_DIR}/CMakeError.log
+ "Performing Test ${TEST} failed with the following output:\n"
+ "${OUTPUT}\n" APPEND)
+ ENDIF(${TEST})
+ ELSE("${TEST}" MATCHES "^${TEST}$")
+ # Have result
+ #FOREACH(tst ${TEST})
+ # MESSAGE("Test ${TEST} resulted in ${${tst}}")
+ #ENDFOREACH(tst ${TEST})
+ ENDIF("${TEST}" MATCHES "^${TEST}$")
+ENDMACRO(PERFORM_CMAKE_TEST FILE TEST)
+
+#
+# Perform the VXL specific try-run test with status output
+#
+# Sets TEST to 1 if the corresponding program compiles, links, run,
+# and returns 0 (indicating success).
+#
+
+MACRO(PERFORM_CMAKE_TEST_RUN FILE TEST)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${TEST} "${TEST}" )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ IF("${TEST}" MATCHES "^${TEST}$")
+ # Perform test
+ SET(MACRO_CHECK_FUNCTION_DEFINITIONS
+ "-D${TEST} ${CMAKE_REQUIRED_FLAGS}")
+ IF(CMAKE_REQUIRED_LIBRARIES)
+ SET(TEST_ADD_LIBRARIES
+ "-DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}")
+ ENDIF(CMAKE_REQUIRED_LIBRARIES)
+ MESSAGE(STATUS "Performing Test ${TEST}")
+
+ TRY_RUN(${TEST} ${TEST}_COMPILED
+ ${CMAKE_BINARY_DIR}
+ ${vxl_config_SOURCE_DIR}/${FILE}
+ CMAKE_FLAGS -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_FUNCTION_DEFINITIONS}
+ "${TEST_ADD_LIBRARIES}"
+ OUTPUT_VARIABLE OUTPUT)
+ IF(${TEST}_COMPILED)
+ IF(${TEST})
+ MESSAGE(STATUS "Performing Test ${TEST} - Failed")
+ SET(${TEST} 0 CACHE INTERNAL "Test ${FUNCTION} (failed to run)")
+ WRITE_FILE(${CMAKE_BINARY_DIR}/CMakeError.log
+ "Performing Test ${TEST} failed with the following output:\n"
+ "${OUTPUT}\n" APPEND)
+ ELSE(${TEST})
+ SET(${TEST} 1 CACHE INTERNAL "VXL test ${FUNCTION} (successful run)")
+ MESSAGE(STATUS "Performing Test ${TEST} - Success")
+ WRITE_FILE(${CMAKE_BINARY_DIR}/CMakeError.log
+ "Performing Test ${TEST} succeeded with the following output:\n"
+ "${OUTPUT}\n" APPEND)
+ ENDIF(${TEST})
+ ELSE(${TEST}_COMPILED)
+ MESSAGE(STATUS "Performing Try-Run Test ${TEST} - Test Compilation Failed")
+ SET(${TEST} 0 CACHE INTERNAL "Test ${FUNCTION} (failed to compile)")
+ WRITE_FILE(${CMAKE_BINARY_DIR}/CMakeError.log
+ "Performing Try-Run Test ${TEST} failed to compile with the following output:\n"
+ "${OUTPUT}\n" APPEND)
+ ENDIF(${TEST}_COMPILED)
+ ELSE("${TEST}" MATCHES "^${TEST}$")
+ # Have result
+ #FOREACH(tst ${TEST})
+ # MESSAGE("Test ${TEST} resulted in ${${tst}}")
+ #ENDFOREACH(tst ${TEST})
+ ENDIF("${TEST}" MATCHES "^${TEST}$")
+ENDMACRO(PERFORM_CMAKE_TEST_RUN FILE TEST)
+
+#
+# Check for include file and if not found, set variable to 0
+#
+
+MACRO(PERFORM_CHECK_HEADER FILE VARIABLE)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${VARIABLE} ${VARIABLE} )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ CHECK_INCLUDE_FILE_CXX(${FILE} ${VARIABLE})
+ IF("${VARIABLE}" MATCHES "^$")
+ SET(${VARIABLE} 0)
+ ENDIF("${VARIABLE}" MATCHES "^$")
+ENDMACRO(PERFORM_CHECK_HEADER FILE VARIABLE)
+
+#
+# Check value of variable and if true, set to VALUE_TRUE, otherwise to
+# VALUE_FALSE
+#
+
+MACRO(SET_BOOL VAR VALUE_TRUE VALUE_FALSE)
+ SET(SET_BOOL_VAR "${VAR}")
+ IF(${SET_BOOL_VAR})
+ SET(${VAR} ${VALUE_TRUE})
+ ELSE(${SET_BOOL_VAR})
+ SET(${VAR} ${VALUE_FALSE})
+ ENDIF(${SET_BOOL_VAR})
+ENDMACRO(SET_BOOL VAR VALUE_TRUE VALUE_FALSE)
+
+#
+# Set the variable to inverse of the given value
+#
+
+MACRO(SET_INVERT VAR VALUE)
+ SET(SET_INVERT_VAR "${VALUE}")
+ IF(SET_INVERT_VAR)
+ SET(${VAR} "0")
+ ELSE(SET_INVERT_VAR)
+ SET(${VAR} "1")
+ ENDIF(SET_INVERT_VAR)
+ENDMACRO(SET_INVERT VAR VALUE)
+
+#
+# Check if the type exists (should really go to CMake/Modules)
+#
+
+MACRO(CHECK_TYPE_EXISTS TYPE FILES VARIABLE)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${VARIABLE} "${VARIABLE}" )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ IF("${VARIABLE}" MATCHES "^${VARIABLE}$")
+ SET(CHECK_TYPE_EXISTS_CONTENT "/* */\n")
+ SET(MACRO_CHECK_TYPE_EXISTS_FLAGS ${CMAKE_REQUIRED_FLAGS})
+ IF(CMAKE_REQUIRED_LIBRARIES)
+ SET(CHECK_TYPE_EXISTS_LIBS
+ "-DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}")
+ ENDIF(CMAKE_REQUIRED_LIBRARIES)
+ FOREACH(FILE ${FILES})
+ SET(CHECK_TYPE_EXISTS_CONTENT
+ "${CHECK_TYPE_EXISTS_CONTENT}#include <${FILE}>\n")
+ ENDFOREACH(FILE)
+ SET(CHECK_TYPE_EXISTS_CONTENT
+ "${CHECK_TYPE_EXISTS_CONTENT}\nvoid cmakeRequireSymbol(${TYPE} dummy){(void)dummy;}\nint main()\n{return 0;\n}\n")
+
+ FILE(WRITE ${CMAKE_BINARY_DIR}/CMakeTmp/CheckTypeExists.cxx
+ "${CHECK_TYPE_EXISTS_CONTENT}")
+
+ MESSAGE(STATUS "Looking for ${TYPE}")
+ TRY_COMPILE(${VARIABLE}
+ ${CMAKE_BINARY_DIR}
+ ${CMAKE_BINARY_DIR}/CMakeTmp/CheckTypeExists.cxx
+ CMAKE_FLAGS
+ -DCOMPILE_DEFINITIONS:STRING=${MACRO_CHECK_TYPE_EXISTS_FLAGS}
+ "${CHECK_TYPE_EXISTS_LIBS}"
+ OUTPUT_VARIABLE OUTPUT)
+ IF(${VARIABLE})
+ MESSAGE(STATUS "Looking for ${TYPE} - found")
+ SET(${VARIABLE} 1 CACHE INTERNAL "Have symbol ${TYPE}")
+ FILE(APPEND ${CMAKE_BINARY_DIR}/CMakeOutput.log
+ "Determining if the ${TYPE} "
+ "exist passed with the following output:\n"
+ "${OUTPUT}\nFile ${CMAKE_BINARY_DIR}/CMakeTmp/CheckTypeExists.cxx:\n"
+ "${CHECK_TYPE_EXISTS_CONTENT}\n")
+ ELSE(${VARIABLE})
+ MESSAGE(STATUS "Looking for ${TYPE} - not found.")
+ SET(${VARIABLE} "" CACHE INTERNAL "Have symbol ${TYPE}")
+ FILE(APPEND ${CMAKE_BINARY_DIR}/CMakeError.log
+ "Determining if the ${TYPE} "
+ "exist failed with the following output:\n"
+ "${OUTPUT}\nFile ${CMAKE_BINARY_DIR}/CMakeTmp/CheckTypeExists.c:\n"
+ "${CHECK_TYPE_EXISTS_CONTENT}\n")
+ ENDIF(${VARIABLE})
+ ENDIF("${VARIABLE}" MATCHES "^${VARIABLE}$")
+ENDMACRO(CHECK_TYPE_EXISTS TYPE FILES VARIABLE)
+
+#
+# Check if the type exists and if not make result 0
+#
+
+MACRO(CHECK_TYPE_EXISTS_ZERO SYMBOL FILES VARIABLE)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${VARIABLE} )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ CHECK_TYPE_EXISTS("${SYMBOL}" "${FILES}" "${VARIABLE}")
+ IF(NOT ${VARIABLE})
+ SET(${VARIABLE} 0)
+ ENDIF(NOT ${VARIABLE})
+ENDMACRO(CHECK_TYPE_EXISTS_ZERO SYMBOL FILES VARIABLE)
+
+#
+# Check if the function exists and if not make result 0
+#
+
+MACRO(CHECK_FUNCTION_EXISTS_ZERO FUNCTION VARIABLE)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${VARIABLE} ${VARIABLE} )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ CHECK_FUNCTION_EXISTS("${FUNCTION}" "${VARIABLE}")
+ IF(NOT ${VARIABLE})
+ SET(${VARIABLE} 0)
+ ENDIF(NOT ${VARIABLE})
+ENDMACRO(CHECK_FUNCTION_EXISTS_ZERO FUNCTION VARIABLE)
+
+#
+# Determine which C++ type matches the given size
+#
+
+MACRO( DETERMINE_TYPE VAR INTEGRAL_TYPE SIZE TYPE_LIST )
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( VXL_${VAR} "" )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ # If we've tested this before, use the cached result and don't re-run
+ IF( NOT VXL_${VAR} )
+ # We can't have IF commands on a macro parameter. For example,
+ # IF( INTEGRAL_TYPE ) doesn't seem to work. I think the
+ # expansion is done at the wrong time. A macro is not a procedure
+ # call. This is a workaround.
+ SET( MSG1 "Looking for ${SIZE}-bit int." )
+ SET( MSG0 "Looking for ${SIZE}-bit float." )
+ SET( MSG ${MSG${INTEGRAL_TYPE}} )
+
+ SET( VXL_${VAR} "void" )
+ SET( VXL_HAS_${VAR} 0 )
+ FOREACH( TYPE ${TYPE_LIST} )
+ # Write the config to a file instead of passing on the command
+ # line to avoid issues with spaces. (In "long double", for
+ # example)
+ WRITE_FILE( ${CMAKE_BINARY_DIR}/CMakeTmp/config.h "#define THE_TYPE ${TYPE}\n#define THE_SIZE ${SIZE}\n#define INTEGRAL_TYPE ${INTEGRAL_TYPE}" )
+ SET( MACRO_DETERMINE_TYPE_FLAGS "-DVXL_HAS_TYPE_OF_SIZE -I\"${CMAKE_BINARY_DIR}/CMakeTmp\"" )
+ MESSAGE( STATUS "${MSG} [Checking ${TYPE}...]" )
+ TRY_RUN( RUN_RESULT COMPILE_RESULT
+ ${CMAKE_BINARY_DIR}
+ ${vxl_config_SOURCE_DIR}/vxl_platform_tests.cxx
+ CMAKE_FLAGS -DCOMPILE_DEFINITIONS:STRING=${MACRO_DETERMINE_TYPE_FLAGS}
+ -DLINK_LIBRARIES:STRING=${CMAKE_REQUIRED_LIBRARIES}
+ OUTPUT_VARIABLE OUTPUT )
+ IF( COMPILE_RESULT )
+ IF( NOT RUN_RESULT )
+ SET( VXL_${VAR} ${TYPE} )
+ SET( VXL_HAS_${VAR} 1 )
+ ENDIF( NOT RUN_RESULT )
+ ELSE( COMPILE_RESULT )
+ WRITE_FILE( ${CMAKE_BINARY_DIR}/CMakeError.log
+ "${MSG} Failed with the following output:\n(FLAGS=${MACRO_DETERMINE_TYPE_FLAGS})\n${OUTPUT}\n"
+ APPEND )
+ ENDIF( COMPILE_RESULT )
+ ENDFOREACH( TYPE )
+ IF( VXL_HAS_${VAR} )
+ MESSAGE( STATUS "${MSG} Found ${VXL_${VAR}}." )
+ ELSE( VXL_HAS_${VAR} )
+ MESSAGE( STATUS "${MSG} Not found." )
+ ENDIF( VXL_HAS_${VAR} )
+ # Cache the value to prevent a second run of the test
+ SET( VXL_${VAR} ${VXL_${VAR}} CACHE INTERNAL "VXL test result" )
+ SET( VXL_HAS_${VAR} ${VXL_HAS_${VAR}} CACHE INTERNAL "VXL test result" )
+ ENDIF( NOT VXL_${VAR} )
+ENDMACRO( DETERMINE_TYPE VAR SIZE TYPE_LIST )
+
+
+#
+# Determine if a particular function is declared in the given header.
+#
+
+MACRO(PERFORM_C_CHECK_FUNCTION SYMBOL FILE VARIABLE)
+ IF( VXL_UPDATE_CONFIGURATION )
+ SET( ${VARIABLE} ${VARIABLE} )
+ ENDIF( VXL_UPDATE_CONFIGURATION )
+ CHECK_SYMBOL_EXISTS(${SYMBOL} ${FILE} ${VARIABLE})
+ IF(${VARIABLE})
+ SET(${VARIABLE} "1")
+ ELSE(${VARIABLE})
+ SET(${VARIABLE} "0")
+ ENDIF(${VARIABLE})
+ENDMACRO(PERFORM_C_CHECK_FUNCTION SYMBOL FILE VARIABLE)
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_platform_tests.cxx b/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_platform_tests.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..54745a00a42a6b0c89914fa6b739b1c40e39255c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/config/vxl_platform_tests.cxx
@@ -0,0 +1,1062 @@
+//-------------------------------------
+
+#ifdef VCL_HAS_BOOL
+
+void function(int i, void *ptr, bool v) {}
+
+int main() { return 0; }
+#endif // VCL_HAS_BOOL
+
+//-------------------------------------
+
+#ifdef VCL_HAS_TYPENAME
+
+template <typename T>
+class bingo { public: void bongo(T **); };
+
+int main() { return 0; }
+#endif // VCL_HAS_TYPENAME
+
+//-------------------------------------
+
+#ifdef VCL_HAS_EXPORT
+
+export
+template <class T, int N>
+struct plither
+{
+ plither(){}
+ ~plither(){}
+ void f(T *, int){}
+};
+
+void g()
+{
+ double x;
+ int y;
+ plither<double, 3> obj;
+ obj.f(&x, y);
+}
+
+int main() { return 0; }
+#endif // VCL_HAS_EXPORT
+
+//-------------------------------------
+
+#ifdef VCL_HAS_MUTABLE
+
+class X {
+ public:
+ mutable int const *p;
+};
+
+int main() { return 0; }
+#endif // VCL_HAS_MUTABLE
+
+//-------------------------------------
+
+#ifdef VCL_HAS_EXPLICIT
+
+class X { public: explicit X(int) {} };
+
+int main() { return 0; }
+#endif // VCL_HAS_EXPLICIT
+
+//-------------------------------------
+
+#ifdef VCL_HAS_DYNAMIC_CAST
+
+struct foo { foo(){} virtual ~foo(){} virtual void f()=0; };
+struct boo : public foo { void f() { *(int*)0 = 1; } };
+boo *try_dynamic_cast() { boo *b = 0; foo *f = b; return dynamic_cast<boo*>(f); }
+
+int main() { return 0; }
+#endif // VCL_HAS_DYNAMIC_CAST
+
+//-------------------------------------
+
+#ifdef VCL_HAS_RTTI
+
+#include <typeinfo>
+class A { public: virtual ~A() {} virtual void f() {} };
+class B : public A { public: void f() {} };
+bool try_rtti() { B*b=0; A*a1=b,*a2=b; return typeid(a1)==typeid(a2); }
+
+int main() { return 0; }
+#endif // VCL_HAS_RTTI
+
+//-------------------------------------
+
+#ifdef VCL_FOR_SCOPE_HACK
+// VCL_FOR_SCOPE_HACK will be set to "1" if this fails to compile
+class A { public: void f() { } };
+
+void fn() {
+ for (int i=0; i<100; ++i) {}
+ for (long i=0; i<1000; ++i) {}
+ for (double i = 3.141; i<100.0; i += 1.0) { }
+ // VC7 only raises warnings for previous tests
+ A i; i.f();
+}
+int main() { return 0; }
+#endif // VCL_FOR_SCOPE_HACK
+
+//-------------------------------------
+
+#ifdef VCL_DEFAULT_VALUE
+// VCL_DEFAULT_VALUE(x) will be set to "= x" if this test fails, to "" otherwise
+
+// declaration
+void function(int x, char *ptr = "foo");
+
+// definition
+void function(int x, char *ptr) { ++ ptr[x]; }
+
+int main() { return 0; }
+#endif // VCL_DEFAULT_VALUE
+
+//-------------------------------------
+
+#ifdef VCL_HAS_MEMBER_TEMPLATES
+
+template <class S>
+class blip {
+ public:
+ S *ptr;
+ template <class T> void klor(T *p) { *ptr = *p; }
+};
+void function()
+{
+ blip<double> b;
+ int s;
+ b.klor(&s);
+}
+
+int main() { return 0; }
+#endif // VCL_HAS_MEMBER_TEMPLATES
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_PARTIAL_SPECIALIZATION
+
+template <class T>
+class victor
+{
+ T data[256];
+ public:
+ victor() {}
+ T &operator[](unsigned i) { return data[i]; }
+};
+
+template <class T>
+class victor<T *>
+{
+ T *data[256];
+ public:
+ T * &operator[](unsigned i) { return data[i]; }
+ void slarf() { data[0] += (data[2] - data[1]); }
+};
+
+template <class A, class R>
+struct foo {
+ typedef A a;
+ typedef R r;
+};
+
+template <class T> struct foo<T *, T *> { void bar() {} };
+template <class T> struct foo<int *, T> { void baz() {} };
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_PARTIAL_SPECIALIZATION
+
+//-------------------------------------
+
+#ifdef VCL_DEFINE_SPECIALIZATION
+// VCL_DEFINE_SPECIALIZATION is set to "template <>" if this compiles, to "" otherwise
+
+// declaration
+template <class T> class traits {};
+
+// specialization
+template <>
+class traits<double> {
+ public:
+ typedef double abs_t;
+ typedef double float_t;
+};
+
+int main() { return 0; }
+#endif // VCL_DEFINE_SPECIALIZATION
+
+//-------------------------------------
+
+#ifdef VCL_ALLOWS_INLINE_INSTANTIATION
+
+template <class T>
+inline
+T dot(T const *a, T const *b)
+{
+ return a[0]*b[0];
+}
+
+template double dot(double const *, double const *);
+
+int main() { return 0; }
+#endif // VCL_ALLOWS_INLINE_INSTANTIATION
+
+//-------------------------------------
+
+#ifdef VCL_NEEDS_INLINE_INSTANTIATION
+// VCL_NEEDS_INLINE_INSTANTIATION is set to 1 if this fails to compile
+
+template <class T>
+inline T dot(T const *a, T const *b) { return a[0]*b[0]+a[1]*b[1]+a[2]*b[2]; }
+int function();
+int call_this() { function(); return 0; }
+int function()
+{
+ double a[3] = {1.0, 2.0, 3.0};
+ double b[3] = {4.0, 5.0, 6.0};
+ double a_b = dot(a, b);
+ return int(a_b);
+}
+// If the program links, the compiler inlined the function template.
+
+int main() { return 0; }
+#endif // VCL_NEEDS_INLINE_INSTANTIATION
+
+//-------------------------------------
+
+#ifdef VCL_STATIC_CONST_INIT_INT
+
+class A {
+ public:
+ static const int x = 27;
+ static const bool y = false;
+};
+
+int main() { return A::x == 27 && !A::y ? 0 : 1; }
+#endif // VCL_STATIC_CONST_INIT_INT
+
+//-------------------------------------
+
+#ifdef VCL_STATIC_CONST_INIT_NO_DEFN
+
+// This should not compile. C++ requires storage to be allocated for
+// the constant to use it at runtime. Some compilers do compile this,
+// though, and if a definition is given, it becomes a multiply defined
+// symbol. If this does compile, we should not give a definition for
+// such constants.
+class A
+{
+ public:
+ static const int x = 27;
+};
+
+int f(const void* x) { return x?1:0; }
+int main() { return f(&A::x); }
+#endif // VCL_STATIC_CONST_INIT_NO_DEFN
+
+//-------------------------------------
+
+#ifdef VCL_STATIC_CONST_INIT_FLOAT
+
+class A {
+ public:
+ static const float x = 27.0f;
+ static const double y = 27.0;
+};
+
+int main() { return A::x == 27.0f && A::y == 27.0 ? 0 : 1; }
+#endif // VCL_STATIC_CONST_INIT_FLOAT
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+
+template <class T> struct A { A() {} static char *fmt; };
+template <class T> char *A<T>::fmt = 0;
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER
+
+template <class T, int n> struct splek { T data[n]; };
+
+template <class T, int n>
+void splok_that_splek(splek<T, n> &s)
+{
+ for (int i=0; i<n; ++i)
+ s.data[i] = T(27);
+}
+
+template struct splek<double, 3>;
+template void splok_that_splek(splek<double, 3> &);
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER
+
+//-------------------------------------
+
+#ifdef VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+// VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD is set to 1 if this fails to compile
+
+template <class T>
+class victor_base {
+ public:
+ T &operator[](unsigned i) { return data[i]; }
+
+ protected:
+ victor_base(T *p, unsigned n) : data(p), size(n) {}
+
+ private:
+ T *data;
+ unsigned size;
+};
+
+template <class T>
+bool operator==(victor_base<T> const&, victor_base<T> const&) { return false; }
+
+template <class T, int n>
+class victor_fixed : public victor_base<T> {
+ public:
+ T data_fixed[n];
+
+ victor_fixed() : victor_base<T>(data_fixed, n) {}
+};
+
+int function(victor_fixed<double, 3> const &a,
+ victor_fixed<double, 3> const &b)
+{
+ if (a == b) // 2.7 fails to resolve this.
+ return 3141;
+ else
+ return 2718;
+}
+
+int main() { return 0; }
+#endif // VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+
+//-------------------------------------
+
+#ifdef VCL_OVERLOAD_CAST
+// VCL_OVERLOAD_CAST(x) is set to "(x)" if this compiles, to "((T)(x))" otherwise
+
+template <class T>
+class vnl_vector {
+ public:
+ unsigned size;
+ T *data;
+ vnl_vector(unsigned n, T *ptr) : size(n), data(ptr) {}
+};
+
+template <class T>
+bool operator==(vnl_vector<T> const&, vnl_vector<T> const&) { return false; }
+
+//
+template <unsigned n, class T>
+class vnl_vector_fixed : public vnl_vector<T> {
+ public:
+ T data_fixedn;
+ vnl_vector_fixed() : vnl_vector<T>(n, data_fixed) {}
+};
+
+//
+void print_it(vnl_vector<double> const &){}
+
+void try_it(vnl_vector_fixed<3, double> const &u,
+ vnl_vector_fixed<3, double> const &v)
+{
+ // gcc 2.7 fails in this function.
+ if (u == v)
+ print_it(u);
+ else {
+ print_it(u);
+ print_it(v);
+ }
+}
+
+//
+template <class S, class T>
+void copy_image(S const * const *src, T * const *dst, int, int) {}
+
+typedef unsigned char byte;
+
+void do_vision(int w, int h, byte **image_i, float **image_f) {
+ // SGI CC 7.21 fails here.
+ copy_image(image_i, image_f, w, h);
+}
+
+int main() { return 0; }
+#endif // VCL_OVERLOAD_CAST
+
+//-------------------------------------
+
+#ifdef VCL_NULL_TMPL_ARGS
+// VCL_NULL_TMPL_ARGS is set to "<>" if this fails to compile, to "" otherwise
+
+template <class T> class victor;
+template <class T> T dot(victor<T> const &u, victor<T> const &v);
+
+template <class T> class victor {
+ public:
+ // Without -fguiding-decls, egcs and 2.95 will rightly think
+ // this declares a non-template and so the program will fail
+ // due to access violation below (and missing symbols at link time).
+ friend T dot(victor<T> const &, victor<T> const &);
+
+ private:
+ T data[3];
+};
+
+template <class T> T dot(victor<T> const &u, victor<T> const &v)
+{
+ return // access violation here:
+ u.data[0] * v.data[0] +
+ u.data[1] * v.data[1] +
+ u.data[2] * v.data[2];
+}
+
+template double dot(victor<double> const &, victor<double> const &);
+
+double function(victor<double> const &u,
+ victor<double> const &v)
+{
+ double uu = dot(u, u);
+ double uv = dot(u, v);
+ double vv = dot(v, v);
+ return (uv*uv)/(uu*vv);
+}
+
+int main() { return 0; }
+#endif // VCL_NULL_TMPL_ARGS
+
+//-------------------------------------
+
+#ifdef VCL_NO_STATIC_DATA_MEMBERS
+// VCL_NO_STATIC_DATA_MEMBERS is set to 1 if this fails to compile
+
+template <class T> class vvv { static T xxx; };
+template class vvv<int>;
+
+int main() { return 0; }
+#endif // VCL_NO_STATIC_DATA_MEMBERS
+
+//-------------------------------------
+
+#ifdef VCL_HAS_TEMPLATE_SYMBOLS
+// VCL_HAS_TEMPLATE_SYMBOLS is set to 1 if this fails to link
+
+// Declare a function template.
+template <class T> void function(T *ptr, int n);
+
+int caller()
+{
+ double array[3];
+ function(array, 0); // This should call function<double>(double *, int);
+ return 0;
+}
+
+// Define a non-template function with the same name and signature.
+void function(double *, int) {}
+
+// If the program links, the compiler didn't make a distinction.
+
+int main() { return 0; }
+#endif // VCL_HAS_TEMPLATE_SYMBOLS
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_IMPLICIT_TEMPLATES
+
+# ifdef _MSC_VER
+// Use template typing to figure out correct method, because
+// several MSVC versions can't cope with overloaded return types
+template <class S> struct ims_what;
+
+template <>
+struct ims_what<double *> {
+ typedef double type; };
+
+template <class S>
+struct ims_what {
+ typedef int type; };
+
+
+template <class I, class T>
+void fsm_plop(I b, I e, T x, int)
+{
+ for (I p=b; p!=e; ++p)
+ *p = x;
+}
+
+template <class T>
+void fsm_plop(double *b, double *e, T x, double)
+{
+ for (double *p=b; p<e; ++p)
+ *p = x;
+}
+
+template <class I, class T>
+inline void fsm_plip(I b, I e, T x)
+{
+ if (b != e)
+ fsm_plop(b, e, x, ims_what<I>::type());
+}
+
+# else
+// FSM: The code is imitating the way the gcc STL chooses (or did choose, way
+// back) between algorithms for different iterator types. A very brief look
+// at the 3.2.2 <algorithm> header suggests they no longer use that mechanism
+// so maybe it was deemed non-standard and abandoned.
+
+struct fsm_plap_normal {};
+
+template <class I>
+inline fsm_plap_normal fsm_plap(I) { return fsm_plap_normal(); }
+
+struct fsm_plap_double_star {};
+inline fsm_plap_double_star fsm_plap(double *) { return fsm_plap_double_star(); }
+
+
+template <class I, class T>
+void fsm_plop(I b, I e, T x, fsm_plap_normal)
+{
+ for (I p=b; p!=e; ++p)
+ *p = x;
+}
+
+template <class T>
+void fsm_plop(double *b, double *e, T x, fsm_plap_double_star)
+{
+ for (double *p=b; p<e; ++p)
+ *p = x;
+}
+
+template <class I, class T>
+inline void fsm_plip(I b, I e, T x)
+{
+ if (b != e)
+ fsm_plop(b, e, x, fsm_plap(b));
+}
+
+# endif
+
+void f()
+{
+ int iarray[20];
+ fsm_plip(iarray, iarray+20, 3141);
+
+ double darray[20];
+ fsm_plip(darray, darray+20, 2718);
+}
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_IMPLICIT_TEMPLATES
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER
+
+template <class T> struct less {};
+
+template <class T, class C=less<int> >
+struct X
+{
+ typedef X<T,C> self;
+ self foo(self const & t) {
+ if ( t.a == 0 )
+ return *this;
+ else
+ return t;
+ }
+ private:
+ int a;
+};
+
+X<int> a;
+X<int, less<short> > b;
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER
+
+//-------------------------------------
+
+#ifdef VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER
+
+template <class T> struct less {};
+template <class T, class C=less<T> > struct X { C t1; };
+X<int> a;
+X<int, less<short> > b;
+
+int main() { return 0; }
+#endif // VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER
+
+//-------------------------------------
+
+#ifdef VCL_SUNPRO_CLASS_SCOPE_HACK
+// VCL_SUNPRO_CLASS_SCOPE_HACK(A) is set to ", A" if this fails to compile, to "" otherwise
+
+template < class T >
+struct allocator
+{
+ allocator() {}
+ allocator(const allocator<T>& ) {}
+};
+
+template < class T , class Allocator = allocator < T > >
+struct vector
+{
+ vector() {}
+ ~vector() {}
+};
+
+template < class T >
+struct spoof
+{
+ void set_row( unsigned , vector < T /*, allocator<T>*/ > const & );
+};
+
+template < class T >
+void spoof < T > :: set_row( unsigned , vector < T /*, allocator<T>*/ > const & )
+{
+}
+
+template class spoof < double >;
+
+// If the program compiles, we don't need the hack
+
+int main() { return 0; }
+#endif // VCL_SUNPRO_CLASS_SCOPE_HACK
+
+//-------------------------------------
+
+#ifdef VCL_HAS_EXCEPTIONS
+
+struct bizop {};
+
+int functionella(char const *a, char const *b)
+{
+ if (!a && b)
+ throw "a is no good";
+ if ( a && !b)
+ throw "b is no better";
+ if (!a && !b)
+ throw bizop();
+
+ return *a - *b;
+}
+
+void monkeylette()
+{
+ try {
+ functionella( 0, 0);
+ functionella("a", 0);
+ functionella( 0, "b");
+ functionella("a", "b");
+ }
+ catch (char const *s) {
+ // oops.
+ }
+ catch (bizop b) {
+ // outch
+ }
+ catch (...) {
+ // phew
+ }
+}
+
+int main() { return 0; }
+#endif // VCL_HAS_EXCEPTIONS
+
+//-------------------------------------
+
+#ifdef VCL_HAS_NAMESPACES
+
+namespace foo {
+ int hello() { return 10; }
+};
+
+// 7.3.1
+namespace Outer {
+ int i;
+ namespace Inner {
+ void f() { i++; } // Outer::i
+ int i;
+ void g() { i++; } // Inner::i
+ }
+}
+
+// 7.3.1.1
+namespace { int i; } // unique::i
+void f() { i++; } // unique::i (gcc 2.7.2 fails here).
+
+namespace A {
+ namespace {
+ int i; // A::unique::i
+ int j; // A::unique::j
+ }
+ void g() { i++; } // A::unique::i
+}
+
+using namespace A;
+void h() {
+ //i++; // error: unique::i or A::unique::i
+ A::i++; // A::unique::i
+ j++; // A::unique::j
+}
+
+extern "C" double vxl_sqrt(double){return 0;}
+
+namespace foo {
+ template <class T> struct complex { T re, im; };
+ template <class T> T abs(complex<T> const &z) { return T(::vxl_sqrt(double(z.re*z.re + z.im+z.im))); }
+}
+
+namespace bar {
+ int abs(int){return 0;}
+ long abs(long){return 0;}
+ float abs(float){return 0;}
+ double abs(double){return 0;}
+}
+
+namespace diced {
+ using foo::complex; // <-- I'm told vc60 fails here.
+ using foo::abs;
+ using bar::abs;
+}
+
+extern "C" int printf(char const *, ...);
+
+void flegg() {
+ int a = -1;
+ long b = -2;
+ float c = -3;
+ double d = -4;
+ diced::complex<double> e = { 3, 4 };
+ printf("%d\n", diced::abs(a)); // 1
+ printf("%ld\n", diced::abs(b)); // 2
+ printf("%f\n", diced::abs(c)); // 3
+ printf("%lf\n", diced::abs(d)); // 4
+ printf("%lf\n", diced::abs(e)); // 5
+}
+
+int main() { return 0; }
+#endif // VCL_HAS_NAMESPACES
+
+//-------------------------------------
+
+#ifdef VCL_ALLOWS_NAMESPACE_STD
+
+#include <cmath>
+#include <vector>
+#include <iostream>
+void function() {
+ std::vector<double> flaz;
+ flaz.push_back(std::sqrt(2.0));
+ flaz.push_back(std::fabs(1.0f));
+ std::cerr << "hello, std::world" << std::endl;
+}
+
+int main() { return 0; }
+#endif // VCL_ALLOWS_NAMESPACE_STD
+
+//-------------------------------------
+
+#ifdef VCL_NEEDS_NAMESPACE_STD
+// VCL_NEEDS_NAMESPACE_STD is set to 1 if this fails to compile
+
+#include <cmath>
+#include <vector>
+//#include <iostream>
+void function() {
+ vector<double> flaz; // correct should be: std::vector<double>
+ flaz.push_back(sqrt(2.0)); // should be: std::sqrt(2.0)
+ flaz.push_back(fabs(1.0f)); // should be: std::fabs(1.0)
+ //cerr << "hello, world" << endl;
+}
+
+int main() { return 0; }
+#endif // VCL_NEEDS_NAMESPACE_STD
+
+//-------------------------------------
+
+#ifdef VXL_UNISTD_USLEEP_IS_VOID
+// VXL_UNISTD_USLEEP_IS_VOID is set to 1 if this test fails
+#include <unistd.h>
+
+int main() { int x = usleep(0); return x*0; }
+#endif // VXL_UNISTD_USLEEP_IS_VOID
+
+//-------------------------------------
+
+#ifdef VXL_STDLIB_HAS_QSORT
+
+// This is not a C++ header, strictly speaking.
+// Actually, it is normative but deprecated, strictly speaking :)
+#include <stdlib.h>
+int f(const void *a,const void *b) { return 1; }
+
+int main() { int a[5]; qsort(a, 5, sizeof(int), f); return 0; }
+#endif // VXL_STDLIB_HAS_QSORT
+
+//-------------------------------------
+
+#ifdef VCL_COMPLEX_POW_WORKS
+// It appears several programmers have (independently)
+// not realised their lack of knowledge of complex numbers.
+// pow(complex(-1,0),0.5) should return (0,1) not (Nan,0), etc.
+
+#include <complex>
+int main()
+{
+ const std::complex<double> neg1(-1.0, 0.0);
+ const std::complex<double> half(0.5,0.0);
+ const std::complex<double> i(0.0, 1.0);
+ std::complex<double> sqrt_neg1 = std::pow(neg1, 0.5);
+ double error = std::abs(sqrt_neg1-i);
+// Need to be careful of quiet NANs, and dodgy behaviour on some platforms.
+// It woud be much easier if I could just have a reliable test for NaNs
+// which are produced by all the broken pow()s I've seen. IMS
+ if ( error >= 0 && -error > -1e-6)
+ {}
+ else
+ return 1;
+ if (error != error)
+ return 1;
+
+ sqrt_neg1 = std::pow(neg1, half);
+ error = std::abs(sqrt_neg1-i);
+ if ( error >= 0 && -error > -1e-6)
+ {}
+ else
+ return 1;
+ if (error != error)
+ return 1;
+
+ sqrt_neg1 = std::pow(-1.0, half);
+ error = std::abs(sqrt_neg1-i);
+ if ( error >= 0 && -error > -1e-6)
+ {}
+ else
+ return 1;
+ if (error != error)
+ return 1;
+
+ return 0; // success
+}
+#endif // VCL_COMPLEX_POW_WORKS
+
+//-------------------------------------
+#ifdef VCL_NUMERIC_LIMITS_HAS_INFINITY
+// Does vcl_numeric_limits<float>::has_infinity == 1?
+
+// Several versions of gcc (3.0, 3.1, and 3.2) come with a
+// numeric_limits that reports that they have no infinity.
+#include <limits>
+int main() {
+ return std::numeric_limits<double>::has_infinity &&
+ std::numeric_limits<float>::has_infinity ? 0 : 1;
+}
+#endif // VCL_NUMERIC_LIMITS_HAS_INFINITY
+
+//-------------------------------------
+
+#ifdef VCL_PROCESSOR_HAS_INFINITY
+// Does the processor actually have an infinity?
+
+// The Borland 5.5 defines DBL_MAX as _max_dble but only declares
+// _max_dble in the std namespace if we include <cfloag>. Including
+// <float.h> moves _max_dble to the global namespace and allows the
+// DBL_MAX macro to work.
+#include <float.h>
+
+union u { double d; unsigned char c[8]; };
+
+int main()
+{
+ if (sizeof(double) != 8) return 1; // If you have an odd machine, then add
+ // your own construction of infinity.
+
+ u v;
+ // Can we generate an IEEE infinity artifically on a big-endian machine?
+ v.c[0] = 0x7f; v.c[1] = 0xf0;
+ v.c[2] = v.c[3] = v.c[4] = v.c[5] = v.c[6] = v.c[7] = 0x00;
+ if (v.d > DBL_MAX)
+ return 0;
+
+ // Can we generate an IEEE infinity artifically on a little-endian machine?
+ v.c[7] = 0x7f; v.c[6] = 0xf0;
+ v.c[0] = v.c[1] = v.c[2] = v.c[3] = v.c[4] = v.c[5] = 0x00;
+ if (v.d > DBL_MAX)
+ return 0;
+ return 1;
+}
+#endif // VCL_PROCESSOR_HAS_INFINITY
+
+//-------------------------------------
+
+#ifdef VCL_CANNOT_SPECIALIZE_CV
+// VCL_CANNOT_SPECIALIZE_CV is set to 1 if this fails to compile
+
+// Some compilers do not distinguish between A<int> and A<int const>.
+
+template <class T> struct A;
+#if !defined(NOT_CONFORMING_SPECIALIZATION)
+template <> struct A<int> {};
+template <> struct A<int const> {};
+#else
+struct A<int> {};
+struct A<int const> {};
+#endif // VCL_CANNOT_SPECIALIZE_CV
+
+int main() { return 0; }
+
+#endif
+
+//-------------------------------------
+
+#ifdef VCL_TEMPLATE_MATCHES_TOO_OFTEN
+// VCL_TEMPLATE_MATCHES_TOO_OFTEN is set to 1 if this fails to compile
+
+// Some compilers will incorrectly choose the template over the
+// non-template. This will not compile if the template is chosen,
+// which will reveal the bug.
+
+class A {};
+template <class T> void f(T t) { t.compiler_selected_wrong_overload(); }
+void f(const A&) {}
+
+int main()
+{
+ f(A());
+ return 0;
+}
+
+#endif // VCL_TEMPLATE_MATCHES_TOO_OFTEN
+
+//-------------------------------------
+
+#ifdef VCL_HAS_SLICED_DESTRUCTOR_BUG
+// VCL_HAS_SLICED_DESTRUCTOR_BUG is set to 1 if this program exist(1)s
+
+// Some compilers (at least Intel C++ 7) will create a B temporary on
+// the f(c) line below and call both the A and B constructors, but
+// then destroy the temporary by calling only ~A() and not calling
+// ~B() first (or ever). This program will return 1 if the bug exists
+// and 0 otherwise.
+
+#include <stdlib.h>
+
+struct A
+{
+ A(): mark(0) {}
+ A(const A&): mark(0) {}
+ ~A() { if (mark) { exit(1); } }
+ int mark;
+};
+
+struct B: public A
+{
+ B(): A() {}
+ B(const B& b): A(b) { mark = 1; }
+ ~B() { mark = 0; }
+};
+
+struct C
+{
+ operator B () { return B(); }
+};
+
+void f(A) {}
+
+int main()
+{
+ C c;
+ f(c);
+ return 0;
+}
+
+#endif // VCL_HAS_SLICED_DESTRUCTOR_BUG
+
+//-------------------------------------
+
+#ifdef VCL_HAS_WORKING_STRINGSTREAM
+// VCL_HAS_WORKING_STRINGSTREAM is set to 1 if a fully functional std::stringstream is found.
+
+// Some compilers don't provide a fully functional std::stringstream.
+// This program will return 0 whenever sufficient functionality is detected.
+
+#include <sstream>
+
+int main()
+{
+ std::istringstream s1("text"); char c;
+ s1 >> c; if (c != 't') return 1;
+ s1 >> c; if (c != 'e') return 1;
+ s1 >> c; if (c != 'x') return 1;
+ std::ostringstream s2; s2 << "text";
+ if (s2.str() != "text") return 1;
+ std::ostringstream s3;
+ c = 't'; s3 << c;
+ c = 'e'; s3 << c;
+ c = 'x'; s3 << c;
+ c = 't'; s3 << c;
+ if (s3.str() != "text") return 1;
+ return 0; // success
+}
+
+#endif // VCL_HAS_WORKING_STRINGSTREAM
+
+//-------------------------------------
+
+#ifdef VXL_HAS_TYPE_OF_SIZE
+// This is used to check if (1) a type exists, (2) is has the required
+// size in bytes, and (3) it is functional. The last requirement is
+// driven by MSCV 6 which has __int64, but it is not fully
+// functional. (It can't be cast to a double, for example.)
+
+// CHAR_BIT is the number of bits per char.
+#include <limits.h>
+#ifndef CHAR_BIT
+# define CHAR_BIT 8
+#endif
+
+#include "config.h"
+
+#if INTEGRAL_TYPE
+double cast( THE_TYPE a, unsigned THE_TYPE b, signed THE_TYPE c )
+{
+ return double( a ) + double( b ) + double( c );
+}
+#else // INTEGRAL_TYPE
+double cast( THE_TYPE a )
+{
+ return double( a );
+}
+#endif // INTEGRAL_TYPE
+
+int main()
+{
+ return sizeof(THE_TYPE) * CHAR_BIT == THE_SIZE ? 0 : 1;
+}
+
+#endif // VXL_HAS_TYPE_OF_SIZE
+
+//-------------------------------------
+
+#ifdef VCL_CHAR_IS_SIGNED
+
+// Return 0 for char signed and 1 for char unsigned.
+int main()
+{
+ unsigned char uc = 255;
+ return (*reinterpret_cast<char*>(&uc) < 0)?0:1;
+}
+
+#endif // VCL_CHAR_IS_SIGNED
+
+//-------------------------------------
diff --git a/Utilities/ITK/Utilities/vxl/config/cmake/export/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/config/cmake/export/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..0d10514c6c2a33daf4e44729a0ade5aea81e40df
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/cmake/export/CMakeLists.txt
@@ -0,0 +1,28 @@
+# This CMakeLists.txt file handles the creation of files needed by
+# other client projects that use VXL. Nothing is built by this
+# CMakeLists.txt file. This CMakeLists.txt file must be processed by
+# CMake after all the other CMakeLists.txt files in the VXL tree,
+# which is why the SUBDIRS(config/cmake/export) command is at the end
+# of the top level CMakeLists.txt file.
+
+# Needed to get non-cached variable settings used in VXLConfig.cmake.in
+INCLUDE( ${MODULE_PATH}/FindNetlib.cmake )
+INCLUDE( ${MODULE_PATH}/FindQv.cmake )
+INCLUDE( ${MODULE_PATH}/FindZLIB.cmake )
+INCLUDE( ${MODULE_PATH}/FindPNG.cmake )
+INCLUDE( ${MODULE_PATH}/FindJPEG.cmake )
+INCLUDE( ${MODULE_PATH}/FindTIFF.cmake )
+INCLUDE( ${MODULE_PATH}/FindMPEG2.cmake )
+
+# Save the compiler settings so another project can import them.
+INCLUDE(${CMAKE_ROOT}/Modules/CMakeExportBuildSettings.cmake)
+SET(VXL_BUILD_SETTINGS_FILE ${vxl_BINARY_DIR}/VXLBuildSettings.cmake)
+CMAKE_EXPORT_BUILD_SETTINGS(${VXL_BUILD_SETTINGS_FILE})
+
+# Save library dependencies.
+SET(VXL_LIBRARY_DEPENDS_FILE ${vxl_BINARY_DIR}/VXLLibraryDepends.cmake)
+EXPORT_LIBRARY_DEPENDENCIES(${VXL_LIBRARY_DEPENDS_FILE})
+
+# Create the VXLConfig.cmake file for the build tree.
+CONFIGURE_FILE(${VXL_CMAKE_DIR}/VXLConfig.cmake.in
+ ${vxl_BINARY_DIR}/VXLConfig.cmake @ONLY IMMEDIATE)
diff --git a/Utilities/ITK/Utilities/vxl/config/valgrind.supp b/Utilities/ITK/Utilities/vxl/config/valgrind.supp
new file mode 100644
index 0000000000000000000000000000000000000000..0bfe69dc9533462aa9f207075761936466f16020
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/config/valgrind.supp
@@ -0,0 +1,140 @@
+# This is a list of valgrind warnings to
+# suppress by default with all VXL programs.
+# They consist of occasions where valgrind is being too strict,
+# of where errors and deep in the OS, and we can maybe assume
+# that they don't cause any problems.
+# For Glibcpp (version>=3) set environment variable
+# GLIBCPP_FORCE_NEW=yes to avoid lots of incorrect leak warnings
+
+# Author: Ian Scott.
+
+# Format of this file is:
+# {
+# name_of_suppression
+# skin_name:supp_kind
+# (optional extra info for some suppression types)
+# caller0 name, or /name/of/so/file.so
+# caller1 name, or ditto
+# (optionally: caller2 name)
+# (optionally: caller3 name)
+# }
+#
+# For Memcheck, the supp_kinds are:
+#
+# Param Value1 Value2 Value4 Value8
+# Free Addr1 Addr2 Addr4 Addr8 Leak
+# Cond (previously known as Value0)
+#
+# and the optional extra info is:
+# if Param: name of system call param
+# if Free: name of free-ing fn)
+
+{
+ malloc/__newlocale(Leak)
+ Addrcheck,Memcheck:Leak
+ fun:malloc
+ fun:__newlocale
+ fun:_ZNSt6locale5facet18_S_create_c_localeERP15__locale_structPKcS2_
+}
+{
+ malloc/realloc/argz_append(Leak)
+ Addrcheck,Memcheck:Leak
+ fun:malloc
+ fun:realloc
+ fun:__argz_append
+}
+{
+ my_malloc/specifics/pthread(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:my_malloc
+ fun:get_or_allocate_specifics_ptr
+ fun:__pthread_key_create
+}
+
+# A leak found in every call to putenv
+# Space must be allocated for the new environment
+# variable. It shouldn't accumulate over time
+{
+ vpl_putenv/known(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:malloc
+ fun:__strdup
+ fun:_Z10vpl_putenvPKc
+}
+
+
+# Lots of leaks found in vul/tests/test_url.cxx
+# when calling vul_http_exists
+# I assume they are correctly managed in libc and
+# do not accumulate over time.
+{
+ gethostbyname/libc/1(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:malloc
+ fun:_dl_map_object_deps
+ fun:dl_open_worker
+}
+{
+ gethostbyname/libc/2(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:malloc
+ fun:_dl_map_object
+ fun:openaux
+}
+{
+ gethostbyname/libc/3(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:malloc
+ fun:__res_nsend
+ fun:__res_nquery
+}
+{
+ gethostbyname/libc/4(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:calloc
+ fun:_dl_check_map_versions
+ fun:dl_open_worker
+}
+{
+ gethostbyname/libc/5(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:calloc
+ fun:_dl_new_object
+ fun:_dl_map_object_from_fd
+}
+{
+ gethostbyname/libc/6(Leak)
+ AddrCheck,Memcheck:Leak
+ fun:malloc
+ fun:_dl_new_object
+ fun:_dl_map_object_from_fd
+}
+
+# Lots of uninitialised memory reads found in triangle.c
+# The uninitialised value is loaded, but then discarded.
+# Unfortunately valgrind treats loading into a floating-point
+# register as a final use, and so triggers the error.
+{
+ v3p/netlib/triangulate/1(Uninitialised_value)
+ Memcheck:Value8
+ fun:fast_expansion_sum_zeroelim
+ fun:incircleadapt
+ fun:incircle
+ fun:mergehulls
+}
+{
+ v3p/netlib/triangulate/2(Uninitialised_value)
+ Memcheck:Value8
+ fun:fast_expansion_sum_zeroelim
+ fun:incircleadapt
+ fun:incircle
+ fun:triangulatepolygon
+}
+{
+ v3p/netlib/triangulate/3(Uninitialised_value)
+ Memcheck:Value8
+ fun:fast_expansion_sum_zeroelim
+ fun:incircleadapt
+ fun:incircle
+ fun:insertsite
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..db1222cf7f1058c3b84a08c12f32e36623ffc073
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/CMakeLists.txt
@@ -0,0 +1,15 @@
+PROJECT( vxlcore )
+
+SET(global_sources
+ vxl_copyright.h
+ vxl_version.h
+ vxl_config.h.in
+)
+
+# common test executable
+SUBDIRS(testlib)
+
+# numerics
+SUBDIRS(vnl)
+
+INSTALL_FILES(${VXL_INSTALL_ROOT}/core ".h" vxl_config vxl_copyright vxl_version)
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/testlib/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/testlib/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..2d732332db140dc1e35b24330792b0972f0b42b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/CMakeLists.txt
@@ -0,0 +1,29 @@
+# ./vxl/testlib/CMakeLists.txt
+
+SET(TESTLIB_VCL_WHERE_ROOT_DIR_H ${vxl_BINARY_DIR}/vcl/vcl_where_root_dir.h)
+
+IF (TESTLIB_VCL_WHERE_ROOT_DIR_H)
+ ADD_DEFINITIONS(-DVCL_WHERE_ROOT_DIR_H_EXISTS)
+ENDIF(TESTLIB_VCL_WHERE_ROOT_DIR_H)
+
+SET( testlib_sources
+
+ # Useful utilities for the tests
+ testlib_test.h testlib_test.cxx
+
+ # For use by the driver program
+ testlib_register.h
+
+ # The main function of the driver executable
+ testlib_main.cxx
+
+ # Used to locate test files in source tree
+ testlib_root_dir.h testlib_root_dir.cxx
+)
+
+ADD_LIBRARY( itktestlib ${testlib_sources} )
+TARGET_LINK_LIBRARIES( itktestlib itkvcl )
+
+IF( BUILD_TESTING )
+ SUBDIRS( tests )
+ENDIF( BUILD_TESTING )
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/introduction_doxy.txt b/Utilities/ITK/Utilities/vxl/core/testlib/introduction_doxy.txt
new file mode 100644
index 0000000000000000000000000000000000000000..b1ec6e246c7f0d3dc1abbaf4e853c8e3fbfab911
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/introduction_doxy.txt
@@ -0,0 +1,10 @@
+// The following text is included in the main documentation page by doxygen
+/*! \mainpage testlib : Testing Library
+*
+* testlib provides some common functionality used in testing vxl. It
+* provides a framework for generating a single test driver that will
+* run a bunch of tests, thus minimising the number of test executables
+* generated.
+*
+* testlib_root_dir() can be used to find golden data files.
+*/
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_main.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_main.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0cb12d33759c065805a870f41b65fe0828449670
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_main.cxx
@@ -0,0 +1,202 @@
+#include "testlib_register.h"
+
+#include <vcl_iostream.h>
+#include <vcl_string.h>
+#include <vcl_vector.h>
+#if VCL_HAS_EXCEPTIONS
+#include <vcl_exception.h>
+#endif
+
+#if defined(VCL_VC) || defined(VCL_BORLAND)
+# include <crtdbg.h>
+# include <windows.h>
+# include <vcl_cstdio.h>
+
+LONG WINAPI vxl_exception_filter( struct _EXCEPTION_POINTERS *ExceptionInfo )
+{
+ // Retrieve exception information
+ PVOID ExceptionAddress = ExceptionInfo->ExceptionRecord->ExceptionAddress;
+ DWORD ExceptionCode = ExceptionInfo->ExceptionRecord->ExceptionCode;
+ DWORD* ExceptionInformation = (DWORD*)ExceptionInfo->ExceptionRecord->ExceptionInformation;
+
+ vcl_fprintf(stderr, "\nTOP-LEVEL EXCEPTION HANDLER\n");
+ switch (ExceptionCode)
+ {
+ case EXCEPTION_ACCESS_VIOLATION:
+ vcl_fprintf(stderr, "The instruction at \"0x%.8p\" failed to %s memory at \"0x%.8x\".\n\n",
+ ExceptionAddress, ExceptionInformation[0] ? "write to" :"read",
+ ExceptionInformation[1]);
+ break;
+
+ case EXCEPTION_INT_DIVIDE_BY_ZERO:
+ vcl_fprintf(stderr, "The instruction at \"0x%.8p\" caused an exception of integer devision by zero.\n\n",
+ ExceptionAddress);
+ break;
+ default:
+ vcl_fprintf(stderr, "The instruction at \"0x%.8p\" caused an unknown exception (exception code: \"0x%.8x\").\n\n",
+ ExceptionAddress,
+ ExceptionCode);
+ }
+
+ // Default action is to abort
+ vcl_printf("Execution aborted!\n");
+ return EXCEPTION_EXECUTE_HANDLER;
+}
+#endif // defined(VCL_WIN32)
+
+#if defined(VCL_BORLAND)
+# include <math.h>
+# include <float.h> // for _control87()
+#endif // defined(VCL_BORLAND)
+
+static vcl_vector<TestMainFunction> testlib_test_func_;
+static vcl_vector<vcl_string> testlib_test_name_;
+
+void
+list_test_names( vcl_ostream& ostr )
+{
+ ostr << "The registered test names are:\n";
+ for ( unsigned int i = 0; i < testlib_test_name_.size(); ++i )
+ ostr << " " << testlib_test_name_[i] << '\n';
+ ostr << "\nOmitting a test name, or specifying the name \"all\" will run all the tests.\n";
+}
+
+
+void
+testlib_enter_stealth_mode()
+{
+ // check for Dashboard test
+ char * env_var1 = getenv("DART_TEST_FROM_DART");
+ char * env_var2 = getenv("DASHBOARD_TEST_FROM_CTEST"); // DART Client built in CMake
+ if ( env_var1 || env_var2 ) {
+
+ // Don't allow DART test to open critical error dialog boxes
+#if defined(VCL_VC)
+ // No abort or ANSI assertion failure dialog box
+ _CrtSetReportMode(_CRT_ERROR, _CRTDBG_MODE_FILE);
+ _CrtSetReportFile(_CRT_ERROR, _CRTDBG_FILE_STDERR);
+
+ // No Windows style ASSERT failure dialog box
+ _CrtSetReportMode(_CRT_ASSERT, _CRTDBG_MODE_FILE);
+ _CrtSetReportFile(_CRT_ASSERT, _CRTDBG_FILE_STDERR);
+
+ // No unhandled exceptions dialog box,
+ // such as access violation and integer division by zero
+ SetUnhandledExceptionFilter( vxl_exception_filter );
+#endif //defined(VCL_VC)
+
+ }
+
+ // Disable Borland's floating point exceptions.
+#if defined(VCL_BORLAND)
+ _control87(MCW_EM, MCW_EM);
+#endif // defined(VCL_BORLAND)
+}
+
+
+int testlib_run_test_unit(vcl_vector<vcl_string>::size_type i, int argc, char *argv[])
+{
+#if VCL_HAS_EXCEPTIONS
+ char * env_var1 = getenv("DART_TEST_FROM_DART");
+ char * env_var2 = getenv("DASHBOARD_TEST_FROM_CTEST"); // DART Client built in CMake
+ if ( env_var1 || env_var2 ) {
+ try {
+ return testlib_test_func_[i]( argc, argv );
+ }
+ catch (const vcl_exception &e)
+ {
+ vcl_cerr << "\nTOP-LEVEL EXCEPTION HANDLER **FAILED**\n"
+ << e.what() << "\n\n";
+ return 1;
+ }
+ }
+// Leave MS structured exceptions to the SE handler.
+ else
+#endif
+ return testlib_test_func_[i]( argc, argv );
+}
+
+
+int
+testlib_main( int argc, char* argv[] )
+{
+ // The caller should already have called register_tests().
+
+ // NOT to produce any dialog windows
+ testlib_enter_stealth_mode();
+
+ // Assume the index type for vector<string> and
+ // vector<TestMainFunction> are the same.
+ typedef vcl_vector<vcl_string>::size_type vec_size_t;
+
+ // Error check.
+ if ( testlib_test_func_.size() != testlib_test_name_.size() ) {
+ vcl_cerr << "Error: " << testlib_test_func_.size() << " test functions are registered, but "
+ << testlib_test_name_.size() << " test names are registered.\n";
+ return 1;
+ }
+
+
+ // If a test name is given, try to run it. Otherwise, try to run all
+ // the tests. The first argument, if available, is assumed to be a
+ // test name. The special test name "all" can be used to run all the tests
+ // with the subsequent arguments passed to each test.
+
+ bool test_name_given = argc >= 2;
+
+ if ( test_name_given && vcl_string("all") == argv[1] )
+ {
+ --argc; ++argv; test_name_given = false;
+ }
+ if ( test_name_given )
+ {
+ for ( vec_size_t i = 0; i < testlib_test_name_.size(); ++i )
+ if ( testlib_test_name_[i] == argv[1] )
+ return testlib_run_test_unit(i, argc-1, argv+1);
+
+
+ vcl_cerr << "Test " << argv[1] << " not registered.\n";
+ list_test_names( vcl_cerr );
+ }
+ else
+ {
+ vcl_cout << "No test name provided. Attempting to run all tests.\n";
+ list_test_names( vcl_cout );
+ vcl_cout << "If you want to run a single test, specify one of the above on the command line.\n\n" << vcl_flush;
+
+ bool all_pass = true;
+ for ( vec_size_t i = 0; i < testlib_test_name_.size(); ++i )
+ {
+ vcl_cout << "----------------------------------------\n"
+ << "Running: " << testlib_test_name_[i] << '\n'
+ << "----------------------------------------\n" << vcl_flush;
+
+ int result = testlib_run_test_unit(i, argc, argv);
+
+ vcl_cout << "----------------------------------------\n"
+ << testlib_test_name_[i] << " returned " << result << ' '
+ << ( result==0 ? "(PASS)" : "(FAIL)" ) << '\n'
+ << "----------------------------------------\n" << vcl_flush;
+ all_pass &= (result == 0);
+ }
+
+ vcl_cout << "\n\nCombined result of " << testlib_test_name_.size() << " tests: "
+ << ( all_pass ? "PASS" : "FAIL" ) << vcl_endl;
+ return all_pass ? 0 : 1;
+ }
+
+ return 1;
+}
+
+void testlib_register_test(const vcl_string & name, TestMainFunction func)
+{
+ testlib_test_func_.push_back(func);
+ testlib_test_name_.push_back(name);
+}
+
+
+void testlib_cleanup()
+{
+ testlib_test_func_.clear();
+ testlib_test_func_.clear();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_register.h b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_register.h
new file mode 100644
index 0000000000000000000000000000000000000000..5660f47930e8a585d0ee1922c94a3cc54e898148
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_register.h
@@ -0,0 +1,65 @@
+#ifndef TESTLIB_REGISTER_H_
+#define TESTLIB_REGISTER_H_
+//:
+// \file
+// \author Amitha Perera
+// \brief Macros for registering the tests with the driver.
+//
+// A test driver program would simply look like
+// \code
+// #include <testlib/testlib_register.h>
+// DECLARE( some_test_name );
+// void register_tests()
+// {
+// REGISTER( some_test_name );
+// }
+// DEFINE_MAIN;
+// \endcode
+// The DEFINE_MAIN macro will define the main() function for the driver.
+// You will also have to link in a file defining a function
+// \code
+// int some_test_name_main(int,char*[])
+// \endcode
+// See the vxl tests for further examples (such as vil/tests).
+
+#include <vcl_string.h>
+
+#if 0 // ifdef VCL_VC - gives compiler errors - PVr
+typedef int ( (__cdecl *const) TestMainFunction)( int, char*[] );
+#else
+typedef int (*TestMainFunction)( int, char*[] );
+#endif
+
+
+//: Declare the existence of the test.
+// If you DECLARE( x ), then you will need to define a function int x_main(int,char*[]).
+#ifdef VCL_VC
+#define DECLARE( testname ) int _cdecl testname ## _main ( int argc, char* argv[] )
+#else
+#define DECLARE( testname ) int testname ## _main ( int argc, char* argv[] )
+#endif
+
+void testlib_register_test(const vcl_string &, TestMainFunction);
+
+//: Register the test with the driver.
+// \param testname should be the same as one of the tests declared with DECLARE.
+#define REGISTER( testname ) \
+ testlib_register_test(#testname, & testname ## _main );
+
+//: Define the main() routine for this test driver.
+// This allows the main function to be defined in the driver code
+// itself--instead of in the testlib library--thus avoiding
+// "awf-weirdness". This also means that functionality from the test
+// library, such as testlib_root_dir, can be used even if it is not
+// used to create a test driver.
+#define DEFINE_MAIN \
+ int testlib_main(int,char*[]); \
+ void testlib_cleanup(); \
+ int main( int argc, char* argv[] ) { \
+ register_tests(); \
+ int retval = testlib_main( argc, argv ); \
+ testlib_cleanup(); \
+ return retval; \
+ }
+
+#endif // TESTLIB_REGISTER_H_
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ca7c4e71f570295a35f00ff02b3001a6b90c5106
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.cxx
@@ -0,0 +1,42 @@
+// This is core/testlib/testlib_root_dir.cxx
+#include "testlib_root_dir.h"
+//:
+// \file
+
+#include <vcl_cstdlib.h>
+#include <vcl_iostream.h>
+
+// The following should have been created automatically by the
+// configuration scripts from vcl_where_root_dir.h.in
+// We need to check for its existence and if it doesn't exist - do something else.
+#ifdef VCL_WHERE_ROOT_DIR_H_EXISTS
+#include <vcl_where_root_dir.h>
+//: Return source root directory (ie the one just below vcl).
+vcl_string testlib_root_dir()
+{
+ return vcl_string(VCL_SOURCE_ROOT_DIR);
+}
+#else
+//: Return source root directory (ie the one just below vcl and vxl).
+vcl_string testlib_root_dir()
+{
+ char* ptr;
+
+ ptr= vcl_getenv("VXLSRC");
+ if (ptr)
+ return vcl_string(ptr);
+
+ ptr= vcl_getenv("VCLSRC");
+ if (ptr)
+ return vcl_string(ptr);
+
+ ptr= vcl_getenv("VXL_SRC");
+ if (ptr)
+ return vcl_string(ptr);
+
+ vcl_cerr<<"ERROR: testlib_root_dir() Unable to retrieve directory from\n"
+ <<"$VCLSRC or $VXLSRC or $VXL_SRC. Sorry.\n";
+ return vcl_string("");
+}
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.h b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.h
new file mode 100644
index 0000000000000000000000000000000000000000..d0df083e2e84919898d6eca4f26376bec7ec9c79
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_root_dir.h
@@ -0,0 +1,23 @@
+#ifndef testlib_root_dir_h_
+#define testlib_root_dir_h_
+//:
+// \file
+// \brief Function to return root directory (ie the one just below vcl).
+// \author Tim Cootes
+// \verbatim
+// Modifications
+// 17-05-2001 I. Scott - Moved from vul to testlib
+// \endverbatim
+#include <vcl_string.h>
+
+//: Return source root directory (ie the one just below vcl).
+// If the file vcl_where_root_dir.h has been automatically generated
+// during configuration (which will happen with cmake) then the
+// appropriate source directory will be returned.
+//
+// If another build system is used in which this is not created,
+// the function will return the value of either of the environment
+// variables: VXLSRC, VCLSRC or VXL_SRC in that order.
+vcl_string testlib_root_dir();
+
+#endif // testlib_root_dir_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..311da060e66459c274d2adcd8d655ef35e2f53a3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.cxx
@@ -0,0 +1,167 @@
+// This is core/testlib/testlib_test.cxx
+#include "testlib_test.h"
+//
+// Copyright (C) 1991 Texas Instruments Incorporated.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated provides this software "as is" without
+// express or implied warranty.
+//
+// Created: 11-Mar-2001: TFC Copy of vnl_test
+// Created: 25-Apr-2002: AGAP Modified copy of testlib_test
+//
+#include <vcl_cmath.h>
+#include <vcl_cstdlib.h> // for abs(long)
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h> // for setfill, setw
+#include <vcl_complex.h>
+
+static int num_test;
+static int tests_passed;
+static int tests_failed;
+static const char* test_name;
+
+void testlib_test_start(const char* name)
+{
+ num_test = 0;
+ tests_passed = 0;
+ tests_failed = 0;
+ test_name = name;
+ vcl_cout << "-----------------------------------------------------------------------------\n"
+ << "Start Testing";
+ if (test_name != NULL) vcl_cout << ' ' << test_name;
+ vcl_cout << ":\n-----------------------------------------------------------------------------\n" << vcl_flush;
+ }
+
+void testlib_test_begin(const char* msg)
+{
+ num_test++;
+ vcl_cout <<" Test "<< vcl_setw(3) << vcl_right << vcl_setfill('0') << num_test
+ <<": "<< vcl_setw(53) << vcl_left << vcl_setfill(' ')<< msg <<" --> "
+ << vcl_flush;
+}
+
+// NOTE: We don't pass in the message (see test_begin) because
+// we want to ensure that the message is printed BEFORE
+// the test is executed. This way when a test crashes
+// we can tell if it was during a test, or between tests.
+void testlib_test_perform(bool success)
+{
+ if (success) {
+ tests_passed++;
+ vcl_cout << " PASSED\n" << vcl_flush;
+ } else {
+ tests_failed++;
+ vcl_cout << "**FAILED**\n" << vcl_flush;
+ }
+}
+
+int testlib_test_summary()
+{
+ vcl_cout << "-----------------------------------------------------------------------------\n";
+ if (test_name) vcl_cout << test_name << ' ';
+ vcl_cout << "Test Summary: ";
+ if (tests_failed > 0)
+ {
+ if (tests_passed == 0)
+ vcl_cout << "No tests succeeded";
+ else if (tests_passed == 1)
+ vcl_cout << "1 test succeeded";
+ else
+ vcl_cout << tests_passed <<" tests succeeded";
+ if (tests_failed == 1)
+ vcl_cout <<", 1 test failed";
+ else
+ vcl_cout <<", "<< tests_failed <<" tests failed";
+ vcl_cout<<"\t\t*****";
+ }
+ else
+ {
+ if (tests_passed > 1)
+ vcl_cout << "All "<< tests_passed <<" tests succeeded";
+ else if (tests_passed == 1)
+ vcl_cout << "1 test succeeded";
+ else
+ vcl_cout << "Test succeeded";
+ }
+ vcl_cout << "\n-----------------------------------------------------------------------------\n" << vcl_flush;
+ return tests_failed;
+}
+
+void testlib_test_assert(const vcl_string& msg, bool expr)
+{
+ vcl_cout << msg << " - " << vcl_flush;
+ testlib_test_perform(expr);
+}
+
+void testlib_test_assert_near(const vcl_string& msg, double expr, double target, double tol)
+{
+ vcl_cout << msg << " should be " << target << ", is " << expr << ", " << vcl_flush;
+ double diff = vcl_abs(expr - target);
+ if (target != 0.0 && diff != 0.0)
+ vcl_cout << "difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff <= tol);
+}
+
+void testlib_test_assert_near(const vcl_string& msg, vcl_complex<double> expr, vcl_complex<double> target, double tol)
+{
+ vcl_cout << msg << " should be " << target << ", is " << expr << ", " << vcl_flush;
+ double diff = vcl_abs(expr - target);
+ if (target != vcl_complex<double>(0,0) && diff != 0.0)
+ vcl_cout << "difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff <= tol);
+}
+
+void testlib_test_assert_near_relative(const vcl_string& msg, double expr, double target, double tol)
+{
+ vcl_cout << msg << " should be " << target << ", is " << expr << ", " << vcl_flush;
+ double max = vcl_abs(target); if (vcl_abs(expr) > max) max = vcl_abs(expr);
+ if (max==0.0 || target==0.0) max=1.0;
+ double diff = vcl_abs(expr - target) / max;
+ if (target != 0.0 && diff != 0.0)
+ vcl_cout << "relative difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff <= tol);
+}
+
+void testlib_test_assert_near_relative(const vcl_string& msg, vcl_complex<double> expr, vcl_complex<double> target, double tol)
+{
+ vcl_cout << msg << " should be " << target << ", is " << expr << ", " << vcl_flush;
+ double max = vcl_abs(target); if (vcl_abs(expr) > max) max = vcl_abs(expr);
+ if (max==0.0 || target==vcl_complex<double>(0,0)) max=1.0;
+ double diff = vcl_abs(expr - target) / max;
+ if (target != vcl_complex<double>(0,0) && diff != 0.0)
+ vcl_cout << "relative difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff <= tol);
+}
+
+void testlib_test_assert_far(const vcl_string& msg, double expr, double target, double tol)
+{
+ vcl_cout << msg << " should not be " << target << ", is " << expr << ", " << vcl_flush;
+ double diff = vcl_abs(expr - target);
+ if (target != 0.0 && diff != 0.0)
+ vcl_cout << "difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff > tol);
+}
+
+void testlib_test_assert_far(const vcl_string& msg, vcl_complex<double> expr, vcl_complex<double> target, double tol)
+{
+ vcl_cout << msg << " should not be " << target << ", is " << expr << ", " << vcl_flush;
+ double diff = vcl_abs(expr - target);
+ if (target != vcl_complex<double>(0,0) && diff != 0.0)
+ vcl_cout << "difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff > tol);
+}
+
+void testlib_test_assert_equal(const vcl_string& msg, long expr, long target)
+{
+ vcl_cout << msg << " should be " << target << ", is " << expr << ", " << vcl_flush;
+ long diff = vcl_abs(expr - target);
+ if (target != 0 && diff != 0)
+ vcl_cout << "difference " << diff << ", " << vcl_flush;
+ testlib_test_perform(diff == 0);
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.h b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.h
new file mode 100644
index 0000000000000000000000000000000000000000..7ba2760761ad0810ab2b2584054ed9b9e5036289
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/testlib_test.h
@@ -0,0 +1,137 @@
+// This is core/testlib/testlib_test.h
+#ifndef testlib_test_h_
+#define testlib_test_h_
+//:
+// \file
+// \brief Testing software
+// \author Tim Cootes
+// \verbatim
+// Modifications
+// Apr 2002, Amitha Perera: Copied from vil_test and moved into testlib in an
+// attempt to consolidate all the repeated test functionality.
+// Sep.2004, Peter Vanroose: added testlib_test_assert_near_relative().
+// \endverbatim
+
+#include <vcl_string.h>
+#include <vcl_complex.h>
+
+//: initialise test counters, check test name 'name' exists
+void testlib_test_start(const char* name = 0);
+//: increment number of tests, then output msg
+void testlib_test_begin(const char* msg);
+//: increment success/failure counters
+void testlib_test_perform(bool success);
+//: output summary of tests performed
+int testlib_test_summary();
+
+//: output msg, then perform test in expr
+void testlib_test_assert(const vcl_string& msg, bool expr);
+//: output msg, then perform test to see if expr is within tol of target
+void testlib_test_assert_near(const vcl_string& msg, double expr,
+ double target = 0, double tol = 1e-12);
+//: output msg, then perform test to see if expr is within tol of target
+void testlib_test_assert_near(const vcl_string& msg, vcl_complex<double> expr,
+ vcl_complex<double> target, double tol = 1e-12);
+//: output msg, then test to see if expr is within relative tol of target
+void testlib_test_assert_near_relative(const vcl_string& msg, double expr,
+ double target = 0, double tol = 1e-12);
+//: output msg, then test to see if expr is within relative tol of target
+void testlib_test_assert_near_relative(const vcl_string& msg,
+ vcl_complex<double> expr,
+ vcl_complex<double> target,
+ double tol = 1e-12);
+//: output msg, then perform test to see if expr is not within tol of target
+void testlib_test_assert_far(const vcl_string& msg, double expr,
+ double target = 0, double tol = 1e-12);
+//: output msg, then perform test to see if expr is not within tol of target
+void testlib_test_assert_far(const vcl_string& msg, vcl_complex<double> expr,
+ vcl_complex<double> target, double tol = 1e-12);
+//: output msg, then perform test to see if expr is equal to target
+void testlib_test_assert_equal(const vcl_string& msg, long expr, long target);
+
+#define Assert testlib_test_assert
+#define AssertNear testlib_test_assert_near
+#define AssertFar testlib_test_assert_far
+
+//: initialise test
+#define START(s) testlib_test_start(s)
+
+//: TEST function, s is message, test to see if p==v
+#define TEST(s,p,v) \
+do { \
+ testlib_test_begin(s); \
+ testlib_test_perform((p)==(v)); \
+} while (false)
+
+//: TEST function, s is message, test to see if p==v for integral values
+#define TEST_EQUAL(s,p,v) \
+do { \
+ testlib_test_begin(s); \
+ testlib_test_assert_equal("",p,v); \
+} while (false)
+
+//: TEST function, s is message, test to see if p is close to v, tolerance t
+#define TEST_NEAR(s,p,v,t) \
+do { \
+ testlib_test_begin(s); \
+ testlib_test_assert_near("",p,v,t); \
+} while (false)
+
+//: TEST function, message s, test to see if (p-v)/p is small compared to t
+#define TEST_NEAR_REL(s,p,v,t) \
+do { \
+ testlib_test_begin(s); \
+ testlib_test_assert_near_relative("",p,v,t); \
+} while (false)
+
+//: TEST function, s is message, test to see if p is far from v, tolerance t
+#define TEST_FAR(s,p,v,t) \
+do { \
+ testlib_test_begin(s); \
+ testlib_test_assert_far("",p,v,t); \
+} while (false)
+
+//: run x, s is message, then test to see if p==v
+#define TEST_RUN(s,x,p,v) \
+do { \
+ testlib_test_begin(s); \
+ x; \
+ testlib_test_perform((p)==(v)); \
+} while (false)
+
+//: Summarise test
+#define SUMMARY() return testlib_test_summary()
+
+//: Run a singleton test function
+#define RUN_TEST_FUNC(x) \
+ testlib_test_start(#x); x(); return testlib_test_summary()
+
+//: Declare the main function.
+#define MAIN( testname ) \
+ int testname ## _main(int,char*[])
+
+//: Declare the main function with parameter passing.
+#define MAIN_ARGS( testname ) \
+ int testname ## _main(int argc, char* argv[])
+
+//: A simplified version of the main test, just in one line.
+// Avoids compiler warnings about "unused argc and argv".
+#define TESTMAIN( testname ) \
+ int testname ## _main(int,char*[]) { START(#testname); testname(); SUMMARY(); }
+
+//: A simplified version of the main test, with parameter passing.
+#undef TESTMAIN_ARGS
+#define TESTMAIN_ARGS( x ) \
+ int x ## _main(int argc, char*argv[]) { START(#x); x(argc,argv); SUMMARY(); }
+
+//: Another simplified main test. To be used in a standalone executable.
+#undef TESTLIB_DEFINE_MAIN
+#define TESTLIB_DEFINE_MAIN(x) \
+ int main() { START(#x); x(); return testlib_test_summary(); }
+
+//: A simplified main test with parameter passing. To be used in a standalone executable.
+#undef TESTLIB_DEFINE_MAIN_ARGS
+#define TESTLIB_DEFINE_MAIN_ARGS(x) \
+ int main(int argc, char * argv[]) { START(#x); x(argc,argv); SUMMARY(); }
+
+#endif // testlib_test_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/testlib/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/testlib/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..3f5e84ffd5a361e7bf2ddc518941dc4c9583ad08
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/CMakeLists.txt
@@ -0,0 +1,27 @@
+# This is core/testlib/tests/CMakeLists.txt
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/core/testlib/tests)
+
+ADD_EXECUTABLE( testlib_test_all
+ test_driver.cxx
+
+ test_assert.cxx
+ test_macros.cxx
+ test_args.cxx
+ test_root_dir.cxx
+)
+TARGET_LINK_LIBRARIES( testlib_test_all itktestlib )
+
+ADD_EXECUTABLE( testlib_test_link
+ test_link.cxx
+)
+TARGET_LINK_LIBRARIES( testlib_test_link itktestlib )
+
+ADD_TEST( testlib_assert testlib_test_all test_assert )
+ADD_TEST( testlib_macros testlib_test_all test_macros )
+ADD_TEST( testlib_args testlib_test_all test_args one two )
+ADD_TEST( testlib_root_dir testlib_test_all test_root_dir )
+ADD_TEST( testlib_test_link testlib_test_link )
+ADD_TEST( testlib_all testlib_test_all all one two )
+
+ADD_EXECUTABLE( testlib_test_include test_include.cxx )
+TARGET_LINK_LIBRARIES( testlib_test_include itktestlib )
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_args.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_args.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..98b272b97eb1a4f99c335467653a1d98b0e6fc36
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_args.cxx
@@ -0,0 +1,24 @@
+#include <testlib/testlib_test.h>
+
+#include <vcl_string.h>
+
+MAIN_ARGS( test_args )
+{
+ START( "argument passing" );
+ TEST( "argument count (should be 3)", argc, 3 );
+ if ( argc >= 1 )
+ {
+ testlib_test_begin( "argv[0] should be the test name, or \"all\"" );
+ testlib_test_perform( vcl_string("test_args") == argv[0] ||
+ vcl_string("all") == argv[0]);
+ }
+ if ( argc >= 2 )
+ {
+ TEST( "argv[1] should be \"one\"", vcl_string("one"), argv[1] );
+ }
+ if ( argc >= 3 )
+ {
+ TEST( "argv[2] should be \"two\"", vcl_string("two"), argv[2] );
+ }
+ SUMMARY();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_assert.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_assert.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..34d0b1de11f7379e819402bdf4b02203c3f75f05
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_assert.cxx
@@ -0,0 +1,11 @@
+#include <testlib/testlib_test.h>
+
+static void test_assert()
+{
+ testlib_test_assert( "Assert:", true );
+ testlib_test_assert_near( "Assert near:", 1.2345, 1.2346, 0.001 );
+ testlib_test_assert_near_relative("Assert near:", 1.235e20, 1.236e20, 0.001);
+ testlib_test_assert_far( "Assert far: ", 1.235, 1.237, 0.001 );
+}
+
+TESTMAIN(test_assert);
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_driver.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_driver.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cff6fb1ec758c0d5740593106482be6ca9821c06
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_driver.cxx
@@ -0,0 +1,17 @@
+#include <testlib/testlib_register.h>
+
+DECLARE( test_assert );
+DECLARE( test_macros );
+DECLARE( test_args );
+DECLARE( test_root_dir );
+
+void
+register_tests()
+{
+ REGISTER( test_assert );
+ REGISTER( test_macros );
+ REGISTER( test_args );
+ REGISTER( test_root_dir );
+}
+
+DEFINE_MAIN;
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_include.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_include.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..88595cd2b43d09d71a60c2eab70399458d6e1879
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_include.cxx
@@ -0,0 +1,5 @@
+#include <testlib/testlib_register.h>
+#include <testlib/testlib_root_dir.h>
+#include <testlib/testlib_test.h>
+
+int main() { return 0; }
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_link.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_link.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..46e431fe88d9f4c82db94101e2f91470bf558476
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_link.cxx
@@ -0,0 +1,9 @@
+// This is to make sure that the testlib functionality can be used
+// even if it is not used to create a test driver. That is, we should
+// be able to link against testlib even if we don't register tests or
+// we have a different main() than typical test drivers.
+
+int main()
+{
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_macros.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_macros.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..aff14ee3d036fe3ce1697f825210a65ef6f3f818
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_macros.cxx
@@ -0,0 +1,18 @@
+#include <testlib/testlib_test.h>
+
+static int val = 0;
+
+void
+my_function()
+{
+ val = 1;
+}
+
+int
+test_macros_main( int, char*[] )
+{
+ START( "macros" );
+ TEST( "TEST macro", 5, 5 );
+ TEST_RUN( "TEST_RUN macro", my_function(), val, 1 );
+ SUMMARY();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_root_dir.cxx b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_root_dir.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..66b012afbe547808f9ad5d108514a03e04e6d5ef
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/testlib/tests/test_root_dir.cxx
@@ -0,0 +1,27 @@
+#include <vcl_iostream.h>
+#include <vcl_fstream.h>
+#include <testlib/testlib_test.h>
+#include <testlib/testlib_root_dir.h>
+
+static void test_root_dir()
+{
+ // Check that a file exists
+ vcl_string path = testlib_root_dir() + "/core/testlib/testlib_root_dir.h";
+
+ vcl_fstream is(path.c_str(),vcl_ios_in);
+
+ TEST ("Opening file using testlib_root_dir", !is, false);
+
+ if (!is)
+ {
+ vcl_cerr<<"Unable to open "<<path<<"\ntestlib_root_dir() is probably wrong.\n"
+ "Try setting $VXLSRC to the source root directory.\n";
+ }
+ else
+ {
+ is.close();
+ vcl_cout<<"Root Dir: "<<testlib_root_dir()<<" appears to be correct.\n";
+ }
+}
+
+TESTMAIN(test_root_dir);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..da4e4e1f19d1c9076e7a38b099c50f9b7ce082b5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/CMakeLists.txt
@@ -0,0 +1,205 @@
+# vxl/core/vnl/CMakeLists.txt
+
+# Create vnl_config.h
+OPTION(VNL_CONFIG_CHECK_BOUNDS
+ "Whether vnl_vector/vnl_matrix accessor methods check index bounds." ON)
+OPTION(VNL_CONFIG_LEGACY_METHODS
+ "Whether backward-compatibility methods are provided by vnl." OFF)
+OPTION(VNL_CONFIG_THREAD_SAFE
+ "Whether thread-safe vnl implementations are used." ON)
+MARK_AS_ADVANCED(
+ VNL_CONFIG_CHECK_BOUNDS
+ VNL_CONFIG_LEGACY_METHODS
+ VNL_CONFIG_THREAD_SAFE
+ )
+# Need to enforce 1/0 values for configuration.
+IF(VNL_CONFIG_CHECK_BOUNDS)
+ SET(VNL_CONFIG_CHECK_BOUNDS 1)
+ELSE(VNL_CONFIG_CHECK_BOUNDS)
+ SET(VNL_CONFIG_CHECK_BOUNDS 0)
+ENDIF(VNL_CONFIG_CHECK_BOUNDS)
+IF(VNL_CONFIG_LEGACY_METHODS)
+ SET(VNL_CONFIG_LEGACY_METHODS 1)
+ELSE(VNL_CONFIG_LEGACY_METHODS)
+ SET(VNL_CONFIG_LEGACY_METHODS 0)
+ENDIF(VNL_CONFIG_LEGACY_METHODS)
+IF(VNL_CONFIG_THREAD_SAFE)
+ SET(VNL_CONFIG_THREAD_SAFE 1)
+ELSE(VNL_CONFIG_THREAD_SAFE)
+ SET(VNL_CONFIG_THREAD_SAFE 0)
+ENDIF(VNL_CONFIG_THREAD_SAFE)
+CONFIGURE_FILE(${vxl_SOURCE_DIR}/core/vnl/vnl_config.h.in
+ ${vxl_BINARY_DIR}/core/vnl/vnl_config.h @ONLY IMMEDIATE)
+
+SET( vnl_sources
+ vnl_config.h.in
+ vnl_fwd.h
+ vnl_tag.h
+
+ # vector and matrix
+ vnl_c_vector.txx vnl_c_vector.h
+ vnl_vector.txx vnl_vector.h
+ vnl_vector_ref.h
+ vnl_vector_fixed.txx vnl_vector_fixed.h
+ vnl_vector_fixed_ref.txx vnl_vector_fixed_ref.h
+ vnl_file_vector.txx vnl_file_vector.h
+ vnl_matrix.txx vnl_matrix.h
+ vnl_matrix_ref.h
+ vnl_matrix_fixed.txx vnl_matrix_fixed.h
+ vnl_matrix_fixed_ref.txx vnl_matrix_fixed_ref.h
+ vnl_diag_matrix.txx vnl_diag_matrix.h
+ vnl_sparse_matrix.txx vnl_sparse_matrix.h
+ vnl_matrix_exp.txx vnl_matrix_exp.h
+ vnl_file_matrix.txx vnl_file_matrix.h
+ vnl_sym_matrix.txx vnl_sym_matrix.h
+
+ # matrix operators
+ vnl_fortran_copy.txx vnl_fortran_copy.h
+ vnl_det.txx vnl_det.h
+ vnl_transpose.h
+ vnl_inverse.h
+ vnl_trace.h
+ vnl_rank.txx vnl_rank.h
+ vnl_scalar_join_iterator.txx vnl_scalar_join_iterator.h
+
+ #
+ vnl_alloc.cxx vnl_alloc.h
+ vnl_block.cxx vnl_block.h
+ vnl_math.cxx vnl_math.h
+ vnl_copy.cxx vnl_copy.h
+ vnl_complex.h
+ vnl_error.cxx vnl_error.h
+ vnl_matlab_print.txx vnl_matlab_print.h
+ vnl_matlab_print_format.cxx vnl_matlab_print_format.h
+ vnl_matlab_print_scalar.cxx vnl_matlab_print_scalar.h
+ vnl_matlab_print2.h
+ vnl_matlab_header.h
+ vnl_matlab_write.cxx vnl_matlab_write.h
+ vnl_matlab_read.cxx vnl_matlab_read.h
+ vnl_matlab_filewrite.cxx vnl_matlab_filewrite.h
+ vnl_matops.cxx vnl_matops.h
+ vnl_real_polynomial.cxx vnl_real_polynomial.h
+ vnl_real_npolynomial.cxx vnl_real_npolynomial.h
+
+ # alternative number representations
+
+ # Quaternions
+ vnl_quaternion.txx vnl_quaternion.h
+ # Rational number arithmetic; represented by two long integers
+ vnl_rational.cxx vnl_rational.h
+ # Arbitrary precision integers
+ vnl_bignum.cxx vnl_bignum.h
+ # Finite field and finite ring numbers and arithmetic
+ vnl_finite.h
+
+ # ops
+ vnl_fastops.cxx vnl_fastops.h
+ vnl_operators.h
+ vnl_linear_operators_3.h
+ vnl_complex_ops.txx vnl_complexify.h vnl_real.h vnl_imag.h
+
+ # traits
+ vnl_numeric_traits.cxx vnl_numeric_traits.h
+ vnl_complex_traits.h
+ vnl_bignum_traits.cxx vnl_bignum_traits.h
+ vnl_rational_traits.cxx vnl_rational_traits.h
+
+ # matrix and vector specialisations
+ vnl_int_matrix.cxx vnl_int_matrix.h
+ vnl_T_n.h
+ vnl_int_2.h
+ vnl_int_3.h
+ vnl_int_4.h
+ vnl_float_2.h
+ vnl_float_3.h
+ vnl_float_4.h
+ vnl_double_2.h
+ vnl_double_3.h
+ vnl_double_4.h
+
+ vnl_int_1x1.h
+ vnl_int_2x2.h
+ vnl_float_1x1.h
+ vnl_float_1x2.h
+ vnl_float_2x1.h
+ vnl_float_2x2.h
+ vnl_float_1x3.h
+ vnl_float_3x1.h
+ vnl_float_3x3.h
+ vnl_float_3x4.h
+ vnl_float_4x3.h
+ vnl_float_4x4.h
+ vnl_double_1x1.h
+ vnl_double_1x2.h
+ vnl_double_2x1.h
+ vnl_double_2x2.h
+ vnl_double_1x3.h
+ vnl_double_3x1.h
+ vnl_double_2x3.h
+ vnl_double_3x2.h
+ vnl_double_3x3.h
+ vnl_double_3x4.h
+ vnl_double_4x3.h
+ vnl_double_4x4.h
+
+ # optimisation
+ vnl_cost_function.cxx vnl_cost_function.h
+ vnl_least_squares_function.cxx vnl_least_squares_function.h
+ vnl_least_squares_cost_function.cxx vnl_least_squares_cost_function.h
+ vnl_nonlinear_minimizer.cxx vnl_nonlinear_minimizer.h
+
+ vnl_hungarian_algorithm.cxx vnl_hungarian_algorithm.h
+
+ # linear systems
+ vnl_linear_system.cxx vnl_linear_system.h
+ vnl_sparse_matrix_linear_system.cxx vnl_sparse_matrix_linear_system.h
+
+ # special matrices
+ vnl_rotation_matrix.cxx vnl_rotation_matrix.h
+ vnl_cross_product_matrix.h
+ vnl_identity_3x3.h
+
+ # Special functions
+ vnl_bessel.cxx vnl_bessel.h
+ vnl_cross.h
+ vnl_gamma.cxx vnl_gamma.h
+ vnl_erf.cxx vnl_erf.h
+ vnl_sample.cxx vnl_sample.h
+ vnl_unary_function.txx vnl_unary_function.h
+ vnl_identity.h
+ vnl_random.cxx vnl_random.h
+
+ # numerical integration
+ vnl_integrant_fnct.h
+ vnl_analytic_integrant.h
+ vnl_definite_integral.cxx vnl_definite_integral.h
+)
+
+AUX_SOURCE_DIRECTORY(Templates vnl_sources)
+
+IF(CMAKE_COMPILER_IS_GNUCXX)
+ # with optimisation, the is_finite etc functions fail on Alpha for long double:
+ SET_SOURCE_FILES_PROPERTIES(vnl_math.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(vnl_bignum.cxx PROPERTIES COMPILE_FLAGS -O0)
+ # and these need too much memory with gcc 3.0 on Alpha:
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_matrix+long-.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_matrix+ulong-.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_matrix+vcl_complex+double--.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_matrix+vcl_complex+long_double--.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_matrix_fixed+vnl_bignum.3.3-.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_vector+vnl_rational-.cxx PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vnl_vector_fixed+vnl_rational.3-.cxx PROPERTIES COMPILE_FLAGS -O0)
+ENDIF(CMAKE_COMPILER_IS_GNUCXX)
+
+ADD_LIBRARY(itkvnl ${vnl_sources})
+TARGET_LINK_LIBRARIES( itkvnl itkvcl )
+
+SUBDIRS(algo)
+
+IF( BUILD_TESTING )
+ SUBDIRS(tests)
+ENDIF( BUILD_TESTING )
+
+INSTALL_TARGETS(/lib/InsightToolkit itkvnl)
+INSTALL_FILES(${VXL_INSTALL_ROOT}/core/vnl "(\\.h|\\.txx)$")
+INSTALL_FILES(${VXL_INSTALL_ROOT}/core/vnl .h vnl_config)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vcl_complex+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vcl_complex+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..667829ad8ef5b82285ab0ed1bd2c871da9a61365
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vcl_complex+vnl_rational-.cxx
@@ -0,0 +1,76 @@
+#include <vcl_iostream.h>
+#include <vnl/vnl_rational.h>
+#include <vcl_complex.txx>
+
+// this function will tickle implicit templates for
+// some compilers and detect missing instances for others.
+template <class T>
+vcl_complex<T> vcl_complex_instances_ticker(T *)
+{
+ vcl_complex<T> z(1, 2);
+ return vcl_conj(z);
+}
+
+template vcl_complex<vnl_rational> vcl_complex_instances_ticker(vnl_rational *);
+
+// macro to implement an operator>>, for compilers that need it.
+# define implement_rsh(T) \
+vcl_istream &operator>>(vcl_istream &is, vcl_complex<T > &z) { \
+ T r, i; \
+ is >> r >> i; \
+ z = vcl_complex<T >(r, i); \
+ return is; \
+}
+
+// ---------- emulation
+#if !VCL_USE_NATIVE_COMPLEX
+// ** make sure gcc 2.7 sees this **
+VCL_COMPLEX_INSTANTIATE(vnl_rational);
+
+// ---------- egcs
+# elif defined(VCL_EGCS)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+template vcl_ostream& operator<<(vcl_ostream &, vcl_complex<vnl_rational> const &);
+template vcl_complex<vnl_rational> operator/ (vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator/ (vcl_complex<vnl_rational>const&,vnl_rational);
+implement_rsh(vnl_rational);
+#include <std/complext.cc>
+template vcl_complex<vnl_rational>& __doadv<vnl_rational>(vcl_complex<vnl_rational>*, vcl_complex<vnl_rational> const&);
+# endif
+
+// ---------- gcc 2.95
+#elif defined(VCL_GCC_295) && !defined(GNU_LIBSTDCXX_V3)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+# define VCL_COMPLEX_INSTANTIATE_INLINE(x) template x
+template bool operator==(vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template bool operator==(vnl_rational,vcl_complex<vnl_rational>const&);
+template bool operator==(vcl_complex<vnl_rational>const&,vnl_rational);
+template vnl_rational vcl_imag(vcl_complex<vnl_rational>const&);
+template vnl_rational vcl_real(vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator+(vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator+(vcl_complex<vnl_rational>const&,vnl_rational);
+template vcl_complex<vnl_rational> operator+(vnl_rational,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator-(vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator-(vcl_complex<vnl_rational>const&,vnl_rational);
+template vcl_complex<vnl_rational> operator-(vnl_rational,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator*(vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator*(vcl_complex<vnl_rational>const&,vnl_rational);
+template vcl_complex<vnl_rational> operator*(vnl_rational,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator/(vcl_complex<vnl_rational>const&,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> operator/(vcl_complex<vnl_rational>const&,vnl_rational);
+template vcl_complex<vnl_rational> operator/(vnl_rational,vcl_complex<vnl_rational>const&);
+template vcl_complex<vnl_rational> vcl_pow (vcl_complex<vnl_rational>const&,int);
+template vcl_ostream& operator<<(vcl_ostream&, vcl_complex<vnl_rational>const&);
+implement_rsh(vnl_rational);
+#include <std/complext.cc>
+template vcl_complex<vnl_rational>& __doadv<vnl_rational>(vcl_complex<vnl_rational>*, vcl_complex<vnl_rational> const&);
+# endif
+
+// ---------- sunpro
+#elif defined(VCL_SUNPRO_CC)
+template vcl_complex<vnl_rational> vcl_conj<vnl_rational>(vcl_complex<vnl_rational> const &);
+
+// ---------- ISO
+#else
+// ISO compilers are magic as far as instantiation goes.
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..341435befc34f15c4bf1c56e1bd7c1978e072bf5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double_complex-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double_complex-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cb80aae53916fa26c2bbca29df44e3f278cfa9b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+double_complex-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_unordered(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6c809c76c9d55d279511f45e49b5e0c3981819d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float_complex-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float_complex-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..05801d88bfb03fac1f15aba09bdad499b7e0defd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+float_complex-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_unordered(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9e67436f07b3905fb5530683c3b2a1c0b0ef6cc3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+int-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7d08932c8b756427874829a39d6f123f655ef3e9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..50ff9e640b2b014505d1a5c01ee928629caefe21
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double_complex-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double_complex-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e032cdb1a186f3a9a30b213529f52cd0e01e64a7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+long_double_complex-.cxx
@@ -0,0 +1,6 @@
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_c_vector.txx>
+
+#ifndef __hppa // bug in HP assembler?
+VNL_C_VECTOR_INSTANTIATE_unordered(vcl_complex<long double>);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+schar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+schar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..980c94bd2fadb4005cfde1cf1aa3fe16f2273be2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+schar-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(signed char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uchar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uchar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..95349c3b8c8fffad75c2e063de2795940b7d2cfb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uchar-.cxx
@@ -0,0 +1,11 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(unsigned char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bb168646f21b67b62ce1ce6ba0cd5928d6f89c62
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+uint-.cxx
@@ -0,0 +1,11 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+ulong-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+ulong-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bda9bd9cd871107af556e7a50ed3d0c1e92c00b3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+ulong-.cxx
@@ -0,0 +1,11 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_c_vector.txx>
+
+VNL_C_VECTOR_INSTANTIATE_ordered(unsigned long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..408731f15ba3d76dc290fe61068967e68cfb8b73
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_bignum-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_c_vector.txx>
+VNL_C_VECTOR_INSTANTIATE_ordered(vnl_bignum);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dfbe9a134815d6aca49056b505f30cacefb21eaf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_c_vector+vnl_rational-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_c_vector.txx>
+VNL_C_VECTOR_INSTANTIATE_ordered(vnl_rational);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bf5bfc3a6d1faf60279220323f0ce7a9d8ddf2d9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_complex_ops.txx>
+
+VNL_COMPLEX_OPS_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8e98b0d6d4b9575f0dabd1a13b63cb3345f58155
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_complex_ops.txx>
+
+VNL_COMPLEX_OPS_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..954b64b9f9833e5fd0117769afe0e62bffeb59eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_complex_ops+long_double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_complex_ops.txx>
+
+VNL_COMPLEX_OPS_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0f695708422501bab2ad607fd5bc73117332e621
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_det.txx>
+
+// this could also be instantiated for 'int', 'long' and 'rational'.
+VNL_DET_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0ac318cccbdadb3413f23b08b34ad1b06db336be
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_det.txx>
+
+VNL_DET_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..925c843215b0b9c9a9f6028c96b8c6c9b5d7acdf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+long_double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_det.txx>
+
+VNL_DET_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b26220ae03f0025fe908df0f5689152e9ddd586d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_det.txx>
+
+VNL_DET_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2cbc41aa0369ad221311017fca0f5781288ca744
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+float--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_det.txx>
+
+VNL_DET_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+long_double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+long_double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9b24676b9e7375cf8074391481117b5351ee3d56
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vcl_complex+long_double--.cxx
@@ -0,0 +1,6 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_det.txx>
+
+#ifndef __hppa // bug in HP assembler?
+VNL_DET_INSTANTIATE(vcl_complex<long double>);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c07bec2f998e19382ddc8d0b1e317814276fe3e8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_bignum-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_det.txx>
+VNL_DET_INSTANTIATE(vnl_bignum);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ed0beb1240335ccdecf258e3ba4e6e4550db7fe5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_det+vnl_rational-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_det.txx>
+VNL_DET_INSTANTIATE(vnl_rational);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..179de1e51487de157e3ede5115ce956b5dacb174
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_diag_matrix.txx>
+VNL_DIAG_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8764213f07bd4017f8c9c67f2cebede58c0ca938
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_diag_matrix.txx>
+
+VNL_DIAG_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e05993547cf87ad132802e92e9484992fd91b6fb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+int-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_diag_matrix.txx>
+
+VNL_DIAG_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..08da50e805a6d536b0ec76f0157799ca08fdb04d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+long_double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_diag_matrix.txx>
+VNL_DIAG_MATRIX_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5299377e10fc894407e0ef02e2ad721eb2468f4f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_diag_matrix.txx>
+
+VNL_DIAG_MATRIX_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8e57588e9a4056542f512e92359b27332a678488
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vcl_complex+float--.cxx
@@ -0,0 +1,5 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vnl/vnl_diag_matrix.txx>
+
+VNL_DIAG_MATRIX_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a025f7800b06fe8e51622e9f04a35942f02abab5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_bignum-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_diag_matrix.txx>
+VNL_DIAG_MATRIX_INSTANTIATE(vnl_bignum);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b773c40ecc7efce03b86cac9c4de867c8a3d510c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_diag_matrix+vnl_rational-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_diag_matrix.txx>
+VNL_DIAG_MATRIX_INSTANTIATE(vnl_rational);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d0bc033d04d8ef4b364fa97a64c52318e42fd92c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_file_matrix.h>
+#include <vnl/vnl_file_matrix.txx>
+
+VNL_FILE_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..15f99a87c981f4f7f476b87619dddf7f125a7307
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+float-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_file_matrix.h>
+#include <vnl/vnl_file_matrix.txx>
+
+VNL_FILE_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e214542f5af3ddd8e350e0f3deae545cad3de1c3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_matrix+long_double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_file_matrix.h>
+#include <vnl/vnl_file_matrix.txx>
+
+VNL_FILE_MATRIX_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_vector+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_vector+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c2f362a351e7ef1b7e20c14c6b8013b8dc4c7994
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_file_vector+double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_file_vector.h>
+#include <vnl/vnl_file_vector.txx>
+
+VNL_FILE_VECTOR_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..77b733186929ebce306a70668a648be825d667f3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b5387d76dea17e22a373eeb030689d246c9b11d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d9d2140064d6b30862ce0da1023ad08c5df81124
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+long_double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e80cc9b9e35c28efbcf93eb85e6f017af6615364
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f82c9b7036de81b63422be27475640390d27977f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+float--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+long_double--.cxx0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+long_double--.cxx0000644
new file mode 100644
index 0000000000000000000000000000000000000000..bf68f31e904be4a558f09a426317fd597ff5c334
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_fortran_copy+vcl_complex+long_double--.cxx0000644
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_fortran_copy.txx>
+
+VNL_FORTRAN_COPY_INSTANTIATE(vcl_complex<long double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_identity+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_identity+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..74b8cc9946329565a5f737d05c881e22ebe2fd88
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_identity+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_identity.h>
+template class vnl_identity<int>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5553d90e63b482e9d54382d12e120a358933011f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print.txx>
+VNL_MATLAB_PRINT_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9528a8c1d0b4679c7a56809cb14c85da971e3ac4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print.txx>
+VNL_MATLAB_PRINT_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b9c34a1b9d3bcdfa3b89cb65ff9cabe3f3606d34
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print.txx>
+VNL_MATLAB_PRINT_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..742971cc8044b24ff9da0c0f84c2b74e9f94bf93
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+long_double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print.txx>
+VNL_MATLAB_PRINT_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c4b0ab44d2d6706cea69c5f256d8f87a2ebb00a7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+uint-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print.txx>
+VNL_MATLAB_PRINT_INSTANTIATE(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1566c572f657336a1e009ef9ee3d39b324344a27
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_print.txx>
+
+VNL_MATLAB_PRINT_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..34239c8415aea8d0450eb0226d752bb9b91ecd6c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+float--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_print.txx>
+
+VNL_MATLAB_PRINT_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+long_double--.cxx0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+long_double--.cxx0000644
new file mode 100644
index 0000000000000000000000000000000000000000..a1b61f3370bb71d4f089552ccf5b2e48127019b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print+vcl_complex+long_double--.cxx0000644
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_print.txx>
+
+VNL_MATLAB_PRINT_INSTANTIATE(vcl_complex<long double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..14f7b0e78ed1b9ec42b3375dc2cd915dc94b4d6e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+double--.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print2.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_matrix<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fc1ee2b163e944fdac683164ad4dabafd981af19
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+float--.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print2.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_matrix<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+vcl_complex+doubl0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+vcl_complex+doubl0000644
new file mode 100644
index 0000000000000000000000000000000000000000..8c0a19ffce218ee7cc279a9bc308369f3f89c90b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_matrix+vcl_complex+doubl0000644
@@ -0,0 +1,3 @@
+#include <vnl/vnl_matlab_print2.h>
+#include <vcl_complex.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_matrix<vcl_complex<double> >);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..88a6df195d47c8381634d19e18306046a7c4ddce
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+double--.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print2.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_vector<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2f73c93e98a3b72a5473fd210485df48b4fd74d1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+float--.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matlab_print2.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_vector<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+vcl_complex+doubl0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+vcl_complex+doubl0000644
new file mode 100644
index 0000000000000000000000000000000000000000..ed271d75a5a4030728a457d512d2369fe047fa3c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matlab_print2+vnl_vector+vcl_complex+doubl0000644
@@ -0,0 +1,3 @@
+#include <vnl/vnl_matlab_print2.h>
+#include <vcl_complex.h>
+VNL_MATLAB_PRINT2_INSTANTIATE(vnl_vector<vcl_complex<double> >);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..58ee53b2b417495431cd658ef2931ed26263f7ff
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7fe549024b5253c5d8fac9ee1788691ba21ede10
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..368219bf5b382dc3052cccc770dd02408e115c02
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d46c34179b692a3afa4ec26057a3f2d3d2e21b8a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..adf650c20d11ce5343d7a2b967f17923762ec515
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+long_double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+schar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+schar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..db7eba06436daa819d7fe463c8ea18d1bae3496e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+schar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(signed char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uchar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uchar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c2e0f2bbe3eb1588337ffdf967961a5a94180ec8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uchar-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(unsigned char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0e55f78b17b8ff23bd435eee10371baec30d618f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+uint-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+ulong-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+ulong-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6ec7aff20d03297d6aac23a51d6b3dc050374767
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+ulong-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(unsigned long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..91c00bc19b2391fe1122f49ef794efdc86857f86
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+double--.cxx
@@ -0,0 +1,10 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_matrix.txx>
+
+VNL_MATRIX_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..19d1a18015ca6cf49d289a1903375d9856788770
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+float--.cxx
@@ -0,0 +1,10 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_matrix.txx>
+
+VNL_MATRIX_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+long_double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+long_double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a06cb4e4ca29982ff2208d898f88ad0174d006cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vcl_complex+long_double--.cxx
@@ -0,0 +1,10 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_matrix.txx>
+
+VNL_MATRIX_INSTANTIATE(vcl_complex<long double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a37838981d51428709c8e2f4c3f93ed476856cd3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_bignum-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(vnl_bignum);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0373dda0c476bf01e7e73372e05833d3a704af6e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix+vnl_rational-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_matrix.txx>
+VNL_MATRIX_INSTANTIATE(vnl_rational);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_exp+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_exp+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dab528f5d2a35f504b65f944ea2ce6a2521044f2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_exp+double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_matrix_exp.txx>
+
+VNL_MATRIX_EXP_INSTANTIATE(double);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ec59f07d11a2bc2fc2ca33d13500ac52b1da5ed4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+template class vnl_matrix_fixed<double,1,1>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..237ad45723da9ea6924412e27f3626397ff0eaa3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,1,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..101d0252f30fc372210692329979508c4ce0871e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.1.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,1,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a3d232b0d290a51142a242a9b9cabea14bb761a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..08fd24ca7541c7cd187b591bc37fba116b0c4ec1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c95dc3a2b35eaa71e85e746bde97f3d1b7eee0e4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..54827587562667c048ee951ef0f139909e3ee796
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.6-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.6-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..314b7d6cd5f81b52a238f67e14e41dfe6bc26720
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.6-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,6);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.9-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.9-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..41873cfbe6df82609a25f7d0abbe4426a74bf37b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.2.9-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,2,9);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..222e4b2a309afea4a0767e9cc41d862de6364f72
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,3,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b1d00b1d03776ec8e810d0034fa1a05fccab1b9d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,3,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f12d6740c8918f7a3a654d4079818717e4c83af5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cd77180026e790bf9662d820dfe33eb17342577e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,3,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.9-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.9-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d7e7989eb08bfde95d6fe9131312f89dbe29c119
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.3.9-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,3,9);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dee3ce57f53f87627470bcbb974e66b46f9e2542
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,4,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..79b8943b53375edefb56637125dc46f42756aafa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,4,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c754987178512cb3c5d681577ef8de53b5ba3e2a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,4,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..49a229dfa3827fdba14f4d0dba5b61bc7b6eef80
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.4.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,4,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..21e628b710bf2d8757cb08044c222db3ec906843
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,6,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.6-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.6-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7702cb0b9f2b576d85c604c94585da4134688444
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+double.6.6-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(double,6,6);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..38387893d716d26d28d5bb78c57adda791787d2d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,1,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..14c7cd8bcc0944d77c6c6f2e27a819ea16ef1374
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,1,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d09b16ad981b44d82ad49a6c7a71f40adb55b17e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.1.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,1,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6d6131bb7855c85f74d724516baea9fd5ee4d9f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,2,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7d59e6e0092f8aa432c437c85d3734e4e0fe7946
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,2,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..80cfc5f2053714b994d4256f2fd79cb0ff4be229
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.2.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,2,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..40ff854464b23ea06494bc22851d0050bf2e87ce
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,3,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..55bf3007cdf68c1d06e5eaeb7df4ef9fba55fa5e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..caae32f794c221663f2dc159eef3ebce5bc7a1b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,3,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.5-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.5-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e6431b5cd20d37eb3355d146fa4118df1a7b5d71
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.3.5-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,3,5);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..caff223815018bfb47b8b178d2b1717af4cde6f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,4,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a0cb122e3724e64d2d659157541f7626570f740c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.4.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,4,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.6.6-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.6.6-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..81b42804d6b2b68310246596dbd61addb06e0d9d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+float.6.6-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(float,6,6);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.1.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.1.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5badf2d94a89759b8957fa339931ca827b158d16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.1.1-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(int,1,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.2.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.2.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..833a673dfb77d4897bde2fa6efdc878fef22a2fa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.2.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(int,2,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.3.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.3.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1b5a2a64b4e69f9f89a6ef4630078d7c4db44c9e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+int.3.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(int,3,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_bignum.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_bignum.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0f3b403e8f526f8095218b5dc3be6e3553062c2a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_bignum.3.3-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(vnl_bignum,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_rational.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_rational.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..832f24e6d23daaaaf032cb92da4c5158bf76d32e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed+vnl_rational.3.3-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_matrix_fixed.txx>
+VNL_MATRIX_FIXED_INSTANTIATE(vnl_rational,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..711486a89f85031584b6ff25a3e9e108a6391332
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed_ref.txx>
+VNL_MATRIX_FIXED_REF_INSTANTIATE(double,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b5c949101ebf4c49df5ccaf157e93915bb2c6e22
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+double.3.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed_ref.txx>
+VNL_MATRIX_FIXED_REF_INSTANTIATE(double,3,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7710472cfda1f5fbb543f91f10c74b4c4865f21e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed_ref.txx>
+VNL_MATRIX_FIXED_REF_INSTANTIATE(float,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2d0160da815962c99feb7ae7edef6bbc4b9b8d4c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_fixed_ref+float.3.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_fixed_ref.txx>
+VNL_MATRIX_FIXED_REF_INSTANTIATE(float,3,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..11a2a1eee273e50d337b5ebf99d60f91ea45ed75
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_ref.h>
+template class vnl_matrix_ref<double>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..968aad4deb1f05fdbff727e941ce000c02a98756
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_matrix_ref.h>
+template class vnl_matrix_ref<float>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e25250c2562149a5263d69253fb03591357cb985
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_bignum-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_matrix_ref.h>
+template class vnl_matrix_ref<vnl_bignum>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ba16fe516a60b46519c81fb75e8b8e9d45d2babe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_matrix_ref+vnl_rational-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_matrix_ref.h>
+template class vnl_matrix_ref<vnl_rational>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c10da013cebc47c71b6c6e0456eaf6011c53ee12
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+double-.cxx
@@ -0,0 +1,4 @@
+
+#include <vnl/vnl_quaternion.txx>
+
+VNL_QUATERNION_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e7fdbe48c675f158ad5b3228a8de940de9efaba4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_quaternion+float-.cxx
@@ -0,0 +1,4 @@
+
+#include <vnl/vnl_quaternion.txx>
+
+VNL_QUATERNION_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e729dba482c08ae9707213c0eef79f08d888060f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_rank.txx>
+VNL_RANK_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..60cdc09605c6e2551881e6e6e59a6fab0c5b107a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_rank+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_rank.txx>
+VNL_RANK_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e5882ef177c5a6e4ca9eaac5c1ed56ee8658556f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+double-.cxx
@@ -0,0 +1,10 @@
+#include <vnl/vnl_sparse_matrix.txx>
+
+template class vnl_sparse_matrix<double>;
+
+static double vnl_sparse_matrix_double_tickler()
+{
+ vnl_sparse_matrix<double> md(3, 5);
+ vnl_sparse_matrix_double_tickler(); // to avoid compiler warning
+ return md(0,0);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..07cc875e885b5e13804b94985ef9072c131c6912
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+float-.cxx
@@ -0,0 +1,10 @@
+#include <vnl/vnl_sparse_matrix.txx>
+
+template class vnl_sparse_matrix<float>;
+
+static float vnl_sparse_matrix_float_tickler()
+{
+ vnl_sparse_matrix<float> md(3, 5);
+ vnl_sparse_matrix_float_tickler(); // to avoid compiler warning
+ return md(0,0);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d719910c5095f51477d9bf665515084c3f69df20
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_bignum-.cxx
@@ -0,0 +1,12 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_sparse_matrix.txx>
+
+template class vnl_sparse_matrix<vnl_bignum>;
+
+static vnl_bignum vnl_sparse_matrix_vnl_bignum_tickler()
+{
+ vnl_sparse_matrix<vnl_bignum> md(3, 5);
+ vnl_sparse_matrix_vnl_bignum_tickler(); // to avoid compiler warning
+ return md(0,0);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dfb41ec517f006be4d973deef8339f95eacb98b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sparse_matrix+vnl_rational-.cxx
@@ -0,0 +1,12 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_sparse_matrix.txx>
+
+template class vnl_sparse_matrix<vnl_rational>;
+
+static vnl_rational vnl_sparse_matrix_vnl_rational_tickler()
+{
+ vnl_sparse_matrix<vnl_rational> md(3, 5);
+ vnl_sparse_matrix_vnl_rational_tickler(); // to avoid compiler warning
+ return md(0,0);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a0a985adf2296d8a9f29a858fb76ea7f2fc7a34a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_sym_matrix.txx>
+VNL_SYM_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9243dfb0fc769ab60c35abdbbb11b449718aea97
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_sym_matrix+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_sym_matrix.txx>
+VNL_SYM_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+double.vnl_vector+double--.0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+double.vnl_vector+double--.0000644
new file mode 100644
index 0000000000000000000000000000000000000000..379932d63d6d6a7bb1bf6a6fa808a345061ec989
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+double.vnl_vector+double--.0000644
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_unary_function.txx>
+VNL_UNARY_FUNCTION_INSTANTIATE(double, vnl_vector<double> );
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+int.int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+int.int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a14ee7c237003793eb7421794bb662950acc7fd9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_unary_function+int.int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_unary_function.txx>
+VNL_UNARY_FUNCTION_INSTANTIATE(int, int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..188aee95a176d36dc1fa3575ee96d46f6b5eefde
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+double-.cxx
@@ -0,0 +1,5 @@
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(double);
+#ifdef GNU_LIBSTDCXX_V3
+template double vnl_vector_ssd<double> (vnl_vector<double> const&, vnl_vector<double> const&);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d2d7d7a1f12611187f12466732edb970d706f935
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2f8605303a0427e6371407661e2d8c3d3dbad576
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+int-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(int);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e76b66fe4f47fc4e9d4f9e42482adce73e133484
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long_double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long_double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dfdb48ee8d72ad4be561158250e4d245e8cf9c80
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+long_double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector.txx>
+
+VNL_VECTOR_INSTANTIATE(long double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+schar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+schar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..29af84e1e57425dba1ca1449d46e235e2880f3b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+schar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(signed char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uchar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uchar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c266e6262dacd758b3d2b61f08179c94b2d5e684
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uchar-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(unsigned char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fcc3675f48fb6736f9acd707672dc2549a97fa6a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+uint-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+ulong-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+ulong-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1059d2d5a7105540c045f09df41feabc64e7aa66
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+ulong-.cxx
@@ -0,0 +1,9 @@
+#include <vcl_compiler.h>
+// Disable warning
+#ifdef VCL_VC_DOTNET
+// 4146: unary minus operator applied to unsigned type, result still unsigned
+# pragma warning(disable:4146)
+#endif //VCL_VC_DOTNET
+
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(unsigned long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..77960ddf0eae388b95bb7dc53af4d9c8b3cebb06
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+double--.cxx
@@ -0,0 +1,9 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+#include <vnl/vnl_complex.h> // for vnl_math_isfinite(complex)
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE_COMPLEX(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bddc7947e54fda9a0f9b2afae3c7dd4283d450b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+float--.cxx
@@ -0,0 +1,11 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+// disable cast warning generated by explicit cast.
+# pragma warning(disable: 4244)
+#endif
+
+#include <vnl/vnl_complex.h> // for vnl_math_isfinite(complex)
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE_COMPLEX(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+long_double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+long_double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..063de8829a79658d86729d5d6d72743e593f4834
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vcl_complex+long_double--.cxx
@@ -0,0 +1,10 @@
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+#include <vnl/vnl_complex.h> // for vnl_math_isfinite(complex)
+#include <vnl/vnl_vector.txx>
+
+VNL_VECTOR_INSTANTIATE_COMPLEX(vcl_complex<long double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_bignum-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_bignum-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7787778698d16307a34576cc21de2e5283274f9a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_bignum-.cxx
@@ -0,0 +1,7 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(vnl_bignum);
+#ifdef GNU_LIBSTDCXX_V3
+template vnl_bignum vnl_vector_ssd<vnl_bignum> (vnl_vector<vnl_bignum> const&, vnl_vector<vnl_bignum> const&);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_rational-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_rational-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2f6f40670191537d9f4262986cc33535de4ea3b2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector+vnl_rational-.cxx
@@ -0,0 +1,7 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_vector.txx>
+VNL_VECTOR_INSTANTIATE(vnl_rational);
+#ifdef GNU_LIBSTDCXX_V3
+template vnl_rational vnl_vector_ssd<vnl_rational> (vnl_vector<vnl_rational> const&, vnl_vector<vnl_rational> const&);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..66ab5a37fbef9aee96f6481e07af8c3ac727de68
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.1-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(double,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..40f1012be773675c1f6a991f0ce872ea42870739
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.2-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(double,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..69571ede6f87dcaea09faaa7e0fcc0c9f003849f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.3-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(double,3);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9cb36888ffa0f4811d2df05e46cfc45e60c74d7b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.4-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(double,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.6-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.6-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ed65672acb668669c86068aab321c2bd87948211
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+double.6-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(double,6);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..498c94e560637c7278f838f10a467d455bac49e4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.1-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(float,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4df24df74b40d932ae1c4cfe5837589267ec02a1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.2-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(float,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c37e1b860c26d7f90384dc64dc254085f5248c89
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.3-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(float,3);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9395094f932cbf09e9b886fad55847ff8b29291c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.4-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(float,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.5-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.5-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..026da7827725224a147d9c440949d4a17cdd3259
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.5-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(float,5);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.9-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.9-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..13d2a885790bc30cc51d7e9bcb1db00f65ba1ec6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+float.9-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(float,9);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..da0a2c579f45ae951f1ee9f375948207ef2ec4c5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.1-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(int,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f68ef139485e33ed68507ed6ae64cf63f8801233
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.2-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(int,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4234c5b08d65c020eb29b6dbdef58e6a86719ccc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.3-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(int,3);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2df657d4d0046b06bc0afd713a3aaab36d5ce4dd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+int.4-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/vnl_vector_fixed.txx>
+
+VNL_VECTOR_FIXED_INSTANTIATE(int,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6f81ab154358f52ac57963dfc5792b9d2cb47538
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.1-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_bignum,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8b24ac888b6093a3d1aefd668401e309dd4c1521
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.2-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_bignum,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..434489612c4f80b373e7afe0a675ca07b4c0f7b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_bignum.3-.cxx
@@ -0,0 +1,5 @@
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_bignum,3);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.1-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.1-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d9918749dcb81e99bd49638efce5354f3dc697ed
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.1-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_rational,1);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..56d550f262cd3936981b2a5a2c16b02ffba80ec4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.2-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_rational,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9fd575e2a058152e4fc21856787556d0eedb63f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed+vnl_rational.3-.cxx
@@ -0,0 +1,5 @@
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_vector_fixed.txx>
+VNL_VECTOR_FIXED_INSTANTIATE(vnl_rational,3);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7f6db465d4b8cda993271099a9cc94caaebdd1ee
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector_fixed_ref.txx>
+VNL_VECTOR_FIXED_REF_INSTANTIATE(double,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.4-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.4-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..78fab53ded3086a0a76efdfbf22ae28351453aac
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+double.4-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector_fixed_ref.txx>
+VNL_VECTOR_FIXED_REF_INSTANTIATE(double,4);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+float.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+float.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e078e3281aa912b3c6de5e6f0e203680823709a6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/Templates/vnl_vector_fixed_ref+float.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/vnl_vector_fixed_ref.txx>
+VNL_VECTOR_FIXED_REF_INSTANTIATE(float,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/algo/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..b7650125eb721230c848a05e2669beca50302662
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/CMakeLists.txt
@@ -0,0 +1,93 @@
+# vxl/vnl/algo/CMakeLists.txt
+
+INCLUDE( ${MODULE_PATH}/FindNetlib.cmake )
+
+# most of vnl_algo is simply a wrapper around netlib, so we must have netlib.
+IF(NETLIB_FOUND)
+
+# Direct netlib dependencies are:
+# vnl_chi_squared dchscdf_
+# vnl_cholesky dpoco_ dpodi_ dpofa_ dposl_
+# vnl_complex_eigensystem zgeev_
+# vnl_conjugate_gradient cg_
+# vnl_fft dgpfa_ dsetgpfa_ gpfa_ setgpfa_
+# vnl_generalized_eigensystem rsg_
+# vnl_generalized_schur dgges_
+# vnl_lbfgs lbfgs_ lb3_
+# vnl_levenberg_marquardt lmder1_ lmdif_
+# vnl_lsqr lsqr_
+# vnl_qr cqrdc_ cqrsl_ dqrdc_ dqrsl_ sqrdc_ sqrsl_ zqrdc_ zqrsl_
+# vnl_real_eigensystem rg_
+# vnl_rpoly_roots rpoly_
+# vnl_sparse_symmetric_eigensystem dnlaso_
+# vnl_svd csvdc_ dsvdc_ ssvdc_ zsvdc_
+# vnl_svd_economy csvdc_ dsvdc_ ssvdc_ zsvdc_
+# vnl_symmetric_eigensystem rs_
+
+ INCLUDE_DIRECTORIES( ${NETLIB_INCLUDE_DIR} )
+
+ SET( vnl_algo_sources
+ vnl_algo_fwd.h
+ vnl_netlib.h
+
+ # matrix decompositions
+ vnl_svd.txx vnl_svd.h
+ vnl_svd_economy.txx vnl_svd_economy.h
+ vnl_matrix_inverse.txx vnl_matrix_inverse.h
+ vnl_qr.txx vnl_qr.h
+ vnl_scatter_3x3.txx vnl_scatter_3x3.h
+ vnl_cholesky.cxx vnl_cholesky.h
+ vnl_real_eigensystem.cxx vnl_real_eigensystem.h
+ vnl_complex_eigensystem.cxx vnl_complex_eigensystem.h
+ vnl_symmetric_eigensystem.cxx vnl_symmetric_eigensystem.h
+ vnl_generalized_eigensystem.cxx vnl_generalized_eigensystem.h
+ vnl_sparse_symmetric_eigensystem.cxx vnl_sparse_symmetric_eigensystem.h
+ vnl_generalized_schur.cxx vnl_generalized_schur.h
+
+ # optimisation
+ vnl_discrete_diff.cxx vnl_discrete_diff.h
+ vnl_levenberg_marquardt.cxx vnl_levenberg_marquardt.h
+ vnl_conjugate_gradient.cxx vnl_conjugate_gradient.h
+ vnl_lbfgs.cxx vnl_lbfgs.h
+ vnl_amoeba.cxx vnl_amoeba.h
+ vnl_powell.cxx vnl_powell.h
+ vnl_brent.cxx vnl_brent.h
+ vnl_lsqr.cxx vnl_lsqr.h
+
+ # equation solvers
+ vnl_rpoly_roots.cxx vnl_rpoly_roots.h
+ vnl_cpoly_roots.cxx vnl_cpoly_roots.h
+ vnl_rnpoly_solve.cxx vnl_rnpoly_solve.h
+
+ # fft
+ vnl_fft.cxx vnl_fft.h
+ vnl_fft_base.txx vnl_fft_base.h
+ vnl_fft_1d.txx vnl_fft_1d.h
+ vnl_fft_2d.txx vnl_fft_2d.h
+ vnl_fft_prime_factors.txx vnl_fft_prime_factors.h
+
+ # stuff
+ vnl_convolve.txx vnl_convolve.h
+ vnl_determinant.cxx vnl_determinant.txx vnl_determinant.h
+ vnl_chi_squared.cxx vnl_chi_squared.h
+ vnl_gaussian_kernel_1d.cxx vnl_gaussian_kernel_1d.h
+ vnl_adjugate.txx vnl_adjugate.h
+ vnl_orthogonal_complement.txx vnl_orthogonal_complement.h
+
+ # integral
+ vnl_simpson_integral.cxx vnl_simpson_integral.h
+ vnl_adaptsimpson_integral.cxx vnl_adaptsimpson_integral.h
+ )
+
+ AUX_SOURCE_DIRECTORY(Templates vnl_algo_sources)
+
+ ADD_LIBRARY( itkvnl_algo ${vnl_algo_sources})
+ TARGET_LINK_LIBRARIES( itkvnl_algo ${NETLIB_LIBRARIES} itkvnl )
+ INSTALL_TARGETS(/lib/InsightToolkit itkvnl_algo)
+
+ IF( BUILD_TESTING )
+ SUBDIRS(tests)
+ ENDIF( BUILD_TESTING )
+
+ENDIF(NETLIB_FOUND)
+INSTALL_FILES(${VXL_INSTALL_ROOT}/core/vnl/algo "(\\.h|\\.txx)$")
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cbeec15fc5c20e091ea3bdebd19f9566f5fddc8e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_adjugate.txx>
+VNL_ADJUGATE_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7567189d0a3f0071ee7d8d805c2a90ba2bee7fd9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_adjugate+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_adjugate.txx>
+VNL_ADJUGATE_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+double.double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+double.double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..486867fda10e1a38ca0142d16fcbb7a85ebc8430
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+double.double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_convolve.txx>
+
+VNL_CONVOLVE_INSTANTIATE(double, double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0e474f718ff6839eb96b552efc86d46b10d310b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_convolve.txx>
+
+VNL_CONVOLVE_INSTANTIATE_2(int, double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2a52a6a7a3a0a56a5ac74be8cf70ee1fb38c8008
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_convolve+int.int-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_convolve.txx>
+
+VNL_CONVOLVE_INSTANTIATE(int, int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e59da6bb494e30104300b764c5f2a33547949342
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_determinant.txx>
+VNL_DETERMINANT_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..73c062b3780994fe1447837ebba6c59548ce51f5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_determinant.txx>
+VNL_DETERMINANT_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..27d3d2324aecf55c21757d1c06672572849d72b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_determinant.txx>
+VNL_DETERMINANT_INSTANTIATE_1(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..83a3398f7d2355acc3b5bb4d0eee8f3b29eb2184
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+double--.cxx
@@ -0,0 +1,3 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_determinant.txx>
+VNL_DETERMINANT_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6307ed952fb7377c2c3482c5bbb4cab73bb12405
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_determinant+vcl_complex+float--.cxx
@@ -0,0 +1,3 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_determinant.txx>
+VNL_DETERMINANT_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..137747e6aceaa24166cb2bd4318a04864b730706
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_1d.txx>
+VNL_FFT_1D_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..31c46b11009f41fa169bac92c07e343b7d664c4c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_1d+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_1d.txx>
+VNL_FFT_1D_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ce0808201fc4fd4ccf34309d01ed934b486010d7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_2d.txx>
+VNL_FFT_2D_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e955d1901ecac131408ddcfa1f92f447f33c5ed8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_2d+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_2d.txx>
+VNL_FFT_2D_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ab8ab3c1225c8c87ba6e8327b0bb022f6fdd8bf2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_base.txx>
+VNL_FFT_BASE_INSTANTIATE(1, double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fdb865a774b093c0128fafe5b839106d61f124ef
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+1.float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_base.txx>
+VNL_FFT_BASE_INSTANTIATE(1, float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..134efc9ff3accaea024b3640bb11435ab2efe5a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_base.txx>
+VNL_FFT_BASE_INSTANTIATE(2, double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6fb6d07354495ef65e3642a0b36200ed57bb8309
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_base+2.float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_base.txx>
+VNL_FFT_BASE_INSTANTIATE(2, float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8fde98ab46acd3bc1ce4c3326c7dd5a513c42bee
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_prime_factors.txx>
+VNL_FFT_PRIME_FACTORS_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3ddc97db92b2e7465c0cfcaa2e3c7f95fde7f352
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_fft_prime_factors+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_fft_prime_factors.txx>
+VNL_FFT_PRIME_FACTORS_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_matrix_inverse+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_matrix_inverse+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bb5775a4349e6502f4bd28f6ccbb2508f39c352e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_matrix_inverse+double-.cxx
@@ -0,0 +1,4 @@
+#include <vnl/algo/vnl_matrix_inverse.h>
+#include <vnl/algo/vnl_matrix_inverse.txx>
+
+VNL_MATRIX_INVERSE_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..325c754beab4f3fdd362ec9c21ac788f37834081
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_orthogonal_complement.txx>
+VNL_ORTHOGONAL_COMPLEMENT_INSTANTIATE(double);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+dou0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+dou0000644
new file mode 100644
index 0000000000000000000000000000000000000000..844f9788139f5d39547b1a911393386298f1cc2e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+dou0000644
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_orthogonal_complement.txx>
+
+VNL_ORTHOGONAL_COMPLEMENT_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+flo0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+flo0000644
new file mode 100644
index 0000000000000000000000000000000000000000..9009a4971d848a4bf9c68ec014529c693e1c1a95
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_orthogonal_complement+vcl_complex+flo0000644
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_orthogonal_complement.txx>
+
+VNL_ORTHOGONAL_COMPLEMENT_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b582a85e10a5bde8ca9c1e07ab3da32c9674a5da
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_qr.txx>
+
+VNL_QR_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..27ac2f2cf3de03c5e1301a09a6d30de6eedca57c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_qr.txx>
+
+VNL_QR_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0e9232e036086f04042d97ef20d7e468fee38b8c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_qr.txx>
+
+VNL_QR_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c01809efb0c1831bde89c5cf5cf0e46bf801ddfa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_qr+vcl_complex+float--.cxx
@@ -0,0 +1,112 @@
+// This is core/vnl/algo/Templates/vnl_qr+vcl_complex+float--.cxx
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_qr.txx>
+//:
+// \file
+
+#if 1
+VNL_QR_INSTANTIATE(vcl_complex<float>);
+
+#else
+// the netlib qrsl routine seems to have a bug
+// for single precision complex scalars, so let's
+// try to use the double precision version instead.
+//
+// hmm... that still doesn't work.
+
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_copy.h>
+
+VCL_DEFINE_SPECIALIZATION
+vnl_vector<vcl_complex<float>> vnl_qr<vcl_complex<float>>::solve(const vnl_vector<vcl_complex<float>>& b) const
+{
+ assert(!"this does not work");
+ int n = qrdc_out_.columns();
+ int p = qrdc_out_.rows();
+
+ vnl_matrix<vcl_complex<double>> DOUBLE_qrdc_out_(qrdc_out_.rows(), qrdc_out_.cols());
+ vnl_copy(qrdc_out_, DOUBLE_qrdc_out_);
+
+ vnl_vector<vcl_complex<double>> DOUBLE_qraux_(qraux_.size());
+ vnl_copy(qraux_, DOUBLE_qraux_);
+
+ vnl_vector<vcl_complex<double>> DOUBLE_b(b.size());
+ vnl_copy(b, DOUBLE_b);
+
+ const vcl_complex<double> * DOUBLE_b_data = DOUBLE_b.data_block();
+ vnl_vector<vcl_complex<double>> DOUBLE_QtB(n);
+ vnl_vector<vcl_complex<double>> DOUBLE_x(p);
+
+ // see comment above
+ int JOB = 100;
+
+ int info = 0;
+ vnl_linpack_qrsl(DOUBLE_qrdc_out_.data_block(),
+ n, n, p,
+ DOUBLE_qraux_.data_block(),
+ DOUBLE_b_data, 0, DOUBLE_QtB.data_block(),
+ DOUBLE_x.data_block(),
+ 0/*residual*/,
+ 0/*Ax*/,
+ JOB,
+ &info);
+
+ if (info > 0)
+ vcl_cerr << "vnl_qr<T>::solve() : A is rank-deficient by " << info << '\n';
+
+ vnl_vector<vcl_complex<float>> x(p);
+ vnl_copy(DOUBLE_x, x);
+
+ return x;
+}
+
+//: Return residual vector d of M x = b -> d = Q'b
+VCL_DEFINE_SPECIALIZATION
+vnl_vector<vcl_complex<float>> vnl_qr<vcl_complex<float>>::QtB(const vnl_vector<vcl_complex<float>>& b) const
+{
+ assert(!"this does not work");
+ int n = qrdc_out_.columns();
+ int p = qrdc_out_.rows();
+
+ vnl_matrix<vcl_complex<double>> DOUBLE_qrdc_out_(qrdc_out_.rows(), qrdc_out_.cols());
+ vnl_copy(qrdc_out_, DOUBLE_qrdc_out_);
+
+ vnl_vector<vcl_complex<double>> DOUBLE_qraux_(qraux_.size());
+ vnl_copy(qraux_, DOUBLE_qraux_);
+
+ vnl_vector<vcl_complex<double>> DOUBLE_b(b.size());
+ vnl_copy(b, DOUBLE_b);
+
+ const vcl_complex<double> * DOUBLE_b_data = DOUBLE_b.data_block();
+ vnl_vector<vcl_complex<double>> DOUBLE_QtB(n);
+
+ // see comment above
+ int JOB = 1000;
+
+ int info = 0;
+ vnl_linpack_qrsl(DOUBLE_qrdc_out_.data_block(),
+ n, n, p,
+ DOUBLE_qraux_.data_block(),
+ DOUBLE_b_data,
+ 0, // A: Qb
+ DOUBLE_QtB.data_block(), // B: Q'b
+ 0, // C: x
+ 0, // D: residual
+ 0, // E: Ax
+ JOB,
+ &info);
+
+ if (info > 0) {
+ vcl_cerr << "vnl_qr<T>::QtB() -- A is rank-def by " << info << '\n';
+ }
+
+ vnl_vector<vcl_complex<float>> QtB(n);
+ vnl_copy(DOUBLE_QtB, QtB);
+
+ return QtB;
+}
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0a4e19b5150380fe1f3f821bef88aa298347ee00
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+double-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_scatter_3x3.txx>
+
+VNL_SCATTER_3X3_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6982e8e2b4e8bc2e57bba59d37b747be0d0dc611
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_scatter_3x3+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_scatter_3x3.txx>
+
+VNL_SCATTER_3X3_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..63b964f775574e6aa55b46046705d0fa890e230f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_svd.txx>
+VNL_SVD_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..379d8553efd5e6ce5fe2540448e62eb9d8641756
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+float-.cxx
@@ -0,0 +1,3 @@
+#include <vnl/algo/vnl_svd.txx>
+
+VNL_SVD_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..baee8ce1664fef81d19df2093e9874b42ab8624b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+double--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_svd.txx>
+
+VNL_SVD_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..727306f110176b6244a9f58b658b46694d54313a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd+vcl_complex+float--.cxx
@@ -0,0 +1,4 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_svd.txx>
+
+VNL_SVD_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..693e125b5a8e3dad7630e505a885aa5f390136c0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_svd_economy.txx>
+VNL_SVD_ECONOMY_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..23ba261362d44163676e4416f18014f1907e4735
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/algo/vnl_svd_economy.txx>
+VNL_SVD_ECONOMY_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9e6a17d416131417be549221ecc934da42ae99f4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+double--.cxx
@@ -0,0 +1,3 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_svd_economy.txx>
+VNL_SVD_ECONOMY_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a13a7c058bb55a9798f5116dec7be28c98adad01
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/Templates/vnl_svd_economy+vcl_complex+float--.cxx
@@ -0,0 +1,3 @@
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_svd_economy.txx>
+VNL_SVD_ECONOMY_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/dll.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/dll.h
new file mode 100644
index 0000000000000000000000000000000000000000..de13b4e65838895762513c6ec32c14cd15cc0efa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/dll.h
@@ -0,0 +1,17 @@
+#ifndef vnl_algo_dll_h_
+#define vnl_algo_dll_h_
+
+#include <vcl_compiler.h>
+
+#define VNL_ALGO_DLL_DATA
+
+#if defined(VCL_WIN32) && !defined(BUILDING_VNL_ALGO_DLL)
+// if win32 and not buiding the DLL then you need a dllimport
+// Only if you are building a DLL linked application.
+# ifdef BUILD_DLL
+# undef VNL_ALGO_DLL_DATA
+# define VNL_ALGO_DLL_DATA _declspec(dllimport)
+# endif // BUILD_DLL
+#endif // VCL_WIN32 and !Building_*_dll
+
+#endif // vnl_algo_dll_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..5cb7edc8e5eb8b8b341295b9dd99e38aa5fa5a8c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/CMakeLists.txt
@@ -0,0 +1,102 @@
+# This is core/vnl/algo/tests/CMakeLists.txt
+
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/core/vnl/algo/tests)
+INCLUDE( ${MODULE_PATH}/FindNetlib.cmake )
+
+# MESSAGE( NETLIB_FOUND " is " ${NETLIB_FOUND} )
+IF(NETLIB_FOUND)
+
+ INCLUDE_DIRECTORIES( ${NETLIB_INCLUDE_DIR} )
+
+ ADD_EXECUTABLE( vnl_algo_test_all
+ # Driver source and utilities
+ test_driver.cxx
+ test_util.cxx test_util.h
+
+ # The tests
+ test_algo.cxx
+ test_amoeba.cxx
+ test_cholesky.cxx
+ test_complex_eigensystem.cxx
+ #test_convolve.cxx # Removing for ITK: needs vul
+ test_cpoly_roots.cxx
+ test_determinant.cxx
+ test_fft.cxx
+ test_fft1d.cxx
+ test_fft2d.cxx
+ test_functions.cxx
+ test_generalized_eigensystem.cxx
+ test_levenberg_marquardt.cxx
+ test_minimizers.cxx
+ test_qr.cxx
+ test_qsvd.cxx
+ test_rank.cxx
+ test_real_eigensystem.cxx
+ test_rnpoly_roots.cxx
+ test_rpoly_roots.cxx
+ test_sparse_matrix.cxx
+ test_svd.cxx
+ #test_symmetric_eigensystem.cxx # Removing for ITK: needs vul
+ test_integral.cxx
+ )
+
+
+ TARGET_LINK_LIBRARIES( vnl_algo_test_all itkvnl_algo itktestlib ${CMAKE_THREAD_LIBS} )
+
+
+ ADD_TEST( vnl_test_algo vnl_algo_test_all test_algo )
+ ADD_TEST( vnl_test_amoeba vnl_algo_test_all test_amoeba )
+ ADD_TEST( vnl_test_cholesky vnl_algo_test_all test_cholesky )
+ ADD_TEST( vnl_test_complex_eigensystem vnl_algo_test_all test_complex_eigensystem )
+ #ADD_TEST( vnl_test_convolve vnl_algo_test_all test_convolve )
+ ADD_TEST( vnl_test_cpoly_roots vnl_algo_test_all test_cpoly_roots )
+ ADD_TEST( vnl_test_determinant vnl_algo_test_all test_determinant )
+ ADD_TEST( vnl_test_fft vnl_algo_test_all test_fft )
+ ADD_TEST( vnl_test_fft1d vnl_algo_test_all test_fft1d )
+ ADD_TEST( vnl_test_fft2d vnl_algo_test_all test_fft2d )
+ ADD_TEST( vnl_test_functions vnl_algo_test_all test_functions )
+ ADD_TEST( vnl_test_generalized_eigensystem vnl_algo_test_all test_generalized_eigensystem )
+ ADD_TEST( vnl_test_levenberg_marquardt vnl_algo_test_all test_levenberg_marquardt )
+ ADD_TEST( vnl_test_minimizers vnl_algo_test_all test_minimizers )
+ ADD_TEST( vnl_test_qr vnl_algo_test_all test_qr )
+ ADD_TEST( vnl_test_qsvd vnl_algo_test_all test_qsvd )
+ ADD_TEST( vnl_test_rank vnl_algo_test_all test_rank )
+ ADD_TEST( vnl_test_real_eigensystem vnl_algo_test_all test_real_eigensystem )
+ ADD_TEST( vnl_test_rnpoly_roots vnl_algo_test_all test_rnpoly_roots )
+ ADD_TEST( vnl_test_rpoly_roots vnl_algo_test_all test_rpoly_roots )
+ ADD_TEST( vnl_test_integral vnl_algo_test_all test_integral )
+
+ IF ( SITE MATCHES "isbe.man.ac.uk" )
+ # For some reason my box (linux-gcc-3.2) has a problem with the optimisation
+ # settings for dnlaso.c in netlib. It cannot be fixed until > CMAKE 1.8.3
+ ELSE ( SITE MATCHES "isbe.man.ac.uk" )
+ ADD_TEST( vnl_test_sparse_matrix vnl_algo_test_all test_sparse_matrix )
+ ENDIF ( SITE MATCHES "isbe.man.ac.uk" )
+ ADD_TEST( vnl_test_svd vnl_algo_test_all test_svd )
+ #ADD_TEST( vnl_test_symmetric_eigensystem vnl_algo_test_all test_symmetric_eigensystem )
+ENDIF(NETLIB_FOUND)
+
+# GCC 2.95 has problems when compiling test_algo.cxx with "-O2" flag.
+# The solution is to turn off optimization for GCC < 3.0
+IF(CMAKE_COMPILER_IS_GNUCXX)
+ IF ( VNL_COMPILER_IS_GNUCXX_2XX MATCHES "VNL_COMPILER_IS_GNUCXX_2XX")
+ EXEC_PROGRAM(${CMAKE_CXX_COMPILER} ARGS --version OUTPUT_VARIABLE CMAKE_CXX_COMPILER_VERSION)
+ IF(CMAKE_CXX_COMPILER_VERSION MATCHES ".*2\\.9[0-9]\\.[0-9].*")
+ SET ( VNL_COMPILER_IS_GNUCXX_2XX 1 CACHE INTERNAL "Are we using an version of gcc < 3.0")
+ ELSE(CMAKE_CXX_COMPILER_VERSION MATCHES ".*2\\.9[0-9]\\.[0-9].*")
+ SET ( VNL_COMPILER_IS_GNUCXX_2XX 0 CACHE INTERNAL "Are we using an version of gcc < 3.0")
+ ENDIF(CMAKE_CXX_COMPILER_VERSION MATCHES ".*2\\.9[0-9]\\.[0-9].*")
+ ENDIF ( VNL_COMPILER_IS_GNUCXX_2XX MATCHES "VNL_COMPILER_IS_GNUCXX_2XX")
+
+ IF(VNL_COMPILER_IS_GNUCXX_2XX)
+ # We only need to remove "-O2" flag from test_algo.cxx.
+ # But it is much easier to do it for all
+ FOREACH(var CMAKE_CXX_FLAGS CMAKE_CXX_FLAGS_RELEASE CMAKE_CXX_FLAGS_DEBUG
+ CMAKE_CXX_FLAGS_RELWITHDEBINFO CMAKE_CXX_FLAGS_MINSIZEREL)
+ STRING(REGEX REPLACE "-O2" "" "${var}" "${${var}}")
+ ENDFOREACH(var)
+ ENDIF(VNL_COMPILER_IS_GNUCXX_2XX)
+ENDIF ( CMAKE_COMPILER_IS_GNUCXX )
+
+ADD_EXECUTABLE( vnl_algo_test_include test_include.cxx )
+TARGET_LINK_LIBRARIES( vnl_algo_test_include itkvnl_algo )
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_algo.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_algo.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..30c6da30291a610fc529e162563c3cf65d3240e6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_algo.cxx
@@ -0,0 +1,157 @@
+// This is core/vnl/algo/tests/test_algo.cxx
+
+//:
+// \file
+// \brief test miscellaneous classes and functions in vnl/algo.
+// This file contains short tests for several algorithms in vnl/algo
+// that are not tested more extensively in separate test files.
+// Currently, the following classes or functions are tested here:
+// - vnl_adjugate
+// - vnl_svd_economy
+// - vnl_matrix_inverse
+// - vnl_fft_1d
+// - vnl_fft_2d
+// - vnl_orthogonal_complement
+// - vnl_conjugate_gradient
+// - vnl_lbfgs
+// - vnl_powell
+// - vnl_lsqr
+// - vnl_discrete_diff_fwd
+// - vnl_discrete_diff_sym
+// - vnl_generalized_schur
+//
+// \author Peter Vanroose, KULeuven/ESAT.
+// \date 20 September 2003
+
+#include <vcl_complex.h>
+#include <testlib/testlib_test.h>
+
+#include <vnl/algo/vnl_adjugate.h>
+#include <vnl/algo/vnl_conjugate_gradient.h>
+#include <vnl/algo/vnl_discrete_diff.h>
+#include <vnl/algo/vnl_fft_1d.h>
+#include <vnl/algo/vnl_fft_2d.h>
+#include <vnl/algo/vnl_generalized_schur.h>
+#include <vnl/algo/vnl_lbfgs.h>
+#include <vnl/algo/vnl_lsqr.h>
+#include <vnl/algo/vnl_matrix_inverse.h>
+#include <vnl/algo/vnl_orthogonal_complement.h>
+#include <vnl/algo/vnl_powell.h>
+#include <vnl/algo/vnl_svd_economy.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/vnl_sparse_matrix_linear_system.h>
+#include <vnl/vnl_least_squares_function.h>
+
+static void test_adjugate()
+{
+ int data[] = { 1, -1, 1, -1, 1, 1, -1, -1, 1, 1, 1, 1, 1, -1, -1, 1 };
+ vnl_matrix<int> m(data,4,4);
+ vnl_matrix<int> m_adj = vnl_adjugate(m);
+ vnl_matrix<int> identity(4,4); identity.set_identity();
+ TEST("vnl_adjugate", (m*m_adj-16*identity).array_inf_norm(), 0);
+}
+
+static void test_matrix_inverse()
+{
+ double data[] = {1.,-1.,1.,-1., 1.,1.,-1.,-1., 1.,1.,1.,1., 1.,-1.,-1.,1.};
+ vnl_matrix<double> m(data,4,4);
+ vnl_svd_economy<double> svde(m); vnl_matrix<double> V = svde.V();
+ vnl_svd<double> svd(m); vnl_matrix<double> V0 = svd.V();
+ TEST_NEAR("vnl_svd_economy", V[0][1], V0[0][1], 1e-6);
+
+ vnl_matrix<double> inv = vnl_matrix_inverse<double>(m);
+ vnl_matrix<double> identity(4,4); identity.set_identity();
+ TEST_NEAR("vnl_matrix_inverse", (m*inv-identity).array_inf_norm(), 0, 1e-6);
+}
+
+static void test_fft()
+{
+ vcl_vector<vcl_complex<double> > v(256); for (int i=0; i<256; ++i) v[i]=0.5+i;
+ vnl_fft_1d<double> fft1d(256); fft1d.fwd_transform(v); fft1d.bwd_transform(v);
+ TEST_NEAR("vnl_fft_1d", v[10], 256*10.5, 1e-6);
+ vnl_matrix<vcl_complex<double> > m(10,9);
+ for (int i=0; i<10; ++i) for (int j=0; j<9; ++j) m[i][j]=0.5+i+j;
+ vnl_fft_2d<double> fft2d(10,9); fft2d.fwd_transform(m); fft2d.bwd_transform(m);
+ TEST_NEAR("vnl_fft_2d", m[5][5], 10*9*10.5, 1e-6);
+}
+
+static void test_orthogonal_complement()
+{
+ vnl_vector<double> v(20); for (int i=0; i<20; ++i) v[i]=0.5+i;
+ vnl_matrix<double> oc = vnl_orthogonal_complement(v);
+ TEST("vnl_orthogonal_complement", oc[0][0]<0 && oc[0][1]==0 && oc[1][0]>0, true);
+}
+
+class F_test_powell : public vnl_cost_function
+ {
+ public: F_test_powell() : vnl_cost_function(2) {}
+ double f(vnl_vector<double> const& x) { double u=x[0]-x[1]*x[1], v=x[1]-1; return u*u+v*v+1; }
+ void gradf(vnl_vector<double> const& x, vnl_vector<double>& g) {
+ g[0]=2*x[0]-2*x[1]*x[1]; g[1]=4*x[1]*x[1]*x[1]-4*x[0]*x[1]+2*x[1]-2; }
+ };
+
+static void test_powell()
+{
+ F_test_powell f; // local minimum is 1 in (1,1).
+ vnl_vector<double> x(2); x[0]=x[1]=0.0;
+ vnl_conjugate_gradient cg(f); cg.minimize(x);
+ TEST_NEAR("vnl_conjugate_gradient", x[0], 1.0, 1e-5);
+
+ vnl_lbfgs lbfgs(f); x[0]=x[1]=0.0; lbfgs.minimize(x);
+ TEST_NEAR("vnl_lbfgs", x[1], 1.0, 1e-6);
+
+ vnl_powell powell(&f); x[0]=x[1]=0.0; powell.minimize(x);
+ TEST_NEAR("vnl_powell", f.f(x), 1.0, 1e-6);
+}
+
+static void test_lsqr()
+{
+ vnl_sparse_matrix<double> A(2,2); vnl_vector<double> b(2);
+ A(0,0)=2; A(0,1)=3; A(1,0)=4; A(1,1)=5; b[0]=5; b[1]=9;
+ vnl_sparse_matrix_linear_system<double> ls(A,b);
+ vnl_vector<double> x(2); x[0]=x[1]=0.0;
+ vnl_lsqr lsqr(ls); lsqr.minimize(x);
+ TEST_NEAR("vnl_lsqr", x[1], 1.0, 1e-6);
+}
+
+class F_test_discrete_diff : public vnl_least_squares_function
+ {
+ public:
+ F_test_discrete_diff(): vnl_least_squares_function(2, 2, no_gradient) {}
+ void f(vnl_vector<double> const& x, vnl_vector<double>& fx) { fx[0]=x[0]-x[1]*x[1]; fx[1]=x[1]-1; }
+ };
+
+
+static void test_discrete_diff()
+{
+ F_test_discrete_diff f;
+ double h = 0.1;
+ vnl_vector<double> x(2); x[0]=5.0; x[1]=9.0;
+ vnl_matrix<double> J(2,2);
+ vnl_discrete_diff_fwd(&f, h, x, J);
+ TEST_NEAR("vnl_discrete_diff_fwd", J(0,1), -18.1, 1e-6);
+ vnl_discrete_diff_sym(&f, h, x, J);
+ TEST_NEAR("vnl_discrete_diff_sym", J(0,1), -18, 1e-6);
+}
+
+static void test_generalized_schur()
+{
+ vnl_matrix<float> A(4,4,0.0), B(4,4,0.0), L(4,4,1.0), R(4,4,1.0);
+ vnl_vector<float> ar(4,0.0), ai(4,0.0), b(4,0.0);
+ vnl_generalized_schur(&A, &B, &ar, &ai, &b, &L, &R);
+ TEST("vnl_generalized_schur", true, true);
+}
+
+void test_algo()
+{
+ test_adjugate();
+ test_matrix_inverse();
+ test_fft();
+ test_orthogonal_complement();
+ test_powell();
+ test_lsqr();
+ test_discrete_diff();
+ test_generalized_schur();
+}
+
+TESTMAIN(test_algo);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_amoeba.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_amoeba.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e935fd61534eeb8488a9afe9510f26b36e5f9e9e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_amoeba.cxx
@@ -0,0 +1,81 @@
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+#include <vcl_cmath.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_amoeba.h>
+#include <vnl/vnl_cost_function.h>
+
+#include <testlib/testlib_test.h>
+
+struct testlib_test_amoeba_cubic : public vnl_cost_function {
+ testlib_test_amoeba_cubic() : vnl_cost_function(1) {}
+
+ double f(const vnl_vector<double>& x) {
+ return (2 - x[0]) * (2 - x[0]) + 10;
+ }
+};
+
+struct testlib_test_amoeba_cost1 : public vnl_cost_function {
+ testlib_test_amoeba_cost1(int n) : vnl_cost_function(n) {}
+
+ double f(const vnl_vector<double>& x) {
+ assert((int)x.size()==dim);
+ double sum=0;
+ for (unsigned int i=0;i<x.size();++i) sum+=(x[i]-i)*(x[i]-i);
+ return sum;
+ }
+};
+
+void test_amoeba()
+{
+ vcl_cout<<" ================== test_amoeba ===============\n"
+
+ <<"Testing on 1D cubic\n";
+ testlib_test_amoeba_cubic c;
+ vnl_amoeba amoeba1(c);
+ vnl_vector<double> x(1);
+ x[0]=77;
+ vcl_cout << "amoeba1: ";
+ amoeba1.minimize(x);
+ TEST_NEAR("amoeba1", x[0], 2, 1e-5);
+
+ int n = 4;
+ vcl_cout<<"Testing on "<<n<<"-D quadratic\n";
+ x.set_size(n);
+ x.fill(1);
+ testlib_test_amoeba_cost1 cost1(n);
+ vnl_amoeba amoeba2(cost1);
+ amoeba2.minimize(x);
+
+ double err=0;
+ for (int i=0;i<n;++i) err+=vcl_fabs(x[i]-i);
+ TEST_NEAR("Quadratic, starting at (1,1,1...)", err, 0.0, 1e-5);
+ vcl_cout<<"Number of evaluations: "<<amoeba2.get_num_evaluations()<<vcl_endl;
+
+ x.fill(0);
+ amoeba2.set_max_iterations(10000);
+ amoeba2.minimize(x);
+ err=0;
+ for (int i=0;i<n;++i) err+=vcl_fabs(x[i]-i);
+ TEST_NEAR("Quadratic, starting at (0,0,0...)", err, 0.0, 1e-5);
+ vcl_cout<<"Number of evaluations: "<<amoeba2.get_num_evaluations()<<vcl_endl;
+
+ vnl_vector<double> dx(n);
+ dx.fill(0.1);
+ x.fill(0);
+ amoeba2.minimize(x,dx);
+ err=0;
+ for (int i=0;i<n;++i) err+=vcl_fabs(x[i]-i);
+ TEST_NEAR("Quadratic, starting at (0,0,0...) using minimise(x,dx)",err,0,1e-5);
+ vcl_cout<<"Number of evaluations: "<<amoeba2.get_num_evaluations()<<vcl_endl
+
+ <<"Test static functions\n";
+ x.fill(0);
+ vnl_amoeba::minimize(cost1,x,dx);
+ err=0;
+ for (int i=0;i<n;++i) err+=vcl_fabs(x[i]-i);
+ TEST_NEAR("Quadratic, starting at (0,0,0...) using minimise(x,dx)",err,0,1e-5);
+}
+
+TESTMAIN(test_amoeba);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cholesky.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cholesky.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f906664b29e8e7dcaef4dbeebe87f12a27bcf072
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cholesky.cxx
@@ -0,0 +1,41 @@
+// This is core/vnl/algo/tests/test_cholesky.cxx
+#include <testlib/testlib_test.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_cholesky.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/vnl_random.h>
+
+#include "test_util.h"
+
+void test_cholesky()
+{
+ vnl_random rng(1000);
+ vnl_matrix<double> A(3,3);
+ test_util_fill_random(A.begin(), A.end(), rng);
+ A = A * A.transpose();
+
+ vnl_matrix<double> I(3,3);
+ I.set_identity();
+
+ {
+ vnl_cholesky chol(A);
+ vnl_svd<double> svd(A);
+ vcl_cout << "cholesky inverse:\n" << chol.inverse() << '\n'
+ << "svd inverse:\n" << svd.inverse() << '\n';
+ testlib_test_assert_near("svd.inverse() ~= cholesky.inverse()",
+ (chol.inverse() - svd.inverse()).fro_norm());
+ }
+ {
+ vnl_cholesky chol(A);
+ testlib_test_assert_near("Ai * A - I", (chol.inverse() * A - I).fro_norm());
+ testlib_test_assert_near("Ai * A - I", (A * chol.inverse() - I).fro_norm());
+ }
+ {
+ vnl_cholesky chol(A, vnl_cholesky::estimate_condition);
+ testlib_test_assert_near("Ai * A - I", (chol.inverse() * A - I).fro_norm());
+ testlib_test_assert_near("Ai * A - I", (A * chol.inverse() - I).fro_norm());
+ }
+}
+
+TESTMAIN(test_cholesky);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_complex_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_complex_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4150db0150c0020cbf0e5031832b79735f762df8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_complex_eigensystem.cxx
@@ -0,0 +1,92 @@
+//:
+// \file
+// \author fsm, Oxford RRG
+// \date 7 September 1999
+#include <vcl_complex.h>
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_complex_eigensystem.h>
+
+#include <testlib/testlib_test.h>
+
+void test_complex_eigensystem1()
+{
+ const unsigned N=6;
+ double a_real[N*N] = {
+ 0.5965, -0.7781, -1.6925, 9.8017, -3.5993, -1.2015,
+ 2.8105, 1.3566, -3.9000, 5.7772, 9.2020, 8.6676,
+ -5.8186, 5.8842, 7.4873, -1.2268, 4.5326, 3.6666,
+ -2.4036, -8.8163, -9.6998, -0.0338, -1.7609, -5.7488,
+ 5.6666, 2.0574, 5.3590, -5.7207, 4.8913, 6.7848,
+ 3.6169, -8.9946, 9.4169, 2.8698, -4.6411, 2.5757
+ };
+ vnl_matrix<double> A_real(a_real,N,N);
+
+ double a_imag[N*N] = {
+ 6.9244, 3.6255, -3.9077, -6.9825, -0.0690, -3.1606,
+ 0.5030, -2.4104, -6.2069, 3.9580, 7.9954, -4.2055,
+ -5.9471, 6.6359, -6.1314, -2.4325, 6.4326, -3.1761,
+ 3.4427, 0.0563, 3.6445, 7.2002, 2.8982, 0.6816,
+ 6.7624, 4.1894, -3.9447, 7.0731, 6.3595, 4.5423,
+ -9.6072, -1.4222, 0.8335, 1.8713, 3.2046, -3.8142
+ };
+ vnl_matrix<double> A_imag(a_imag,N,N);
+
+ vnl_matrix<vcl_complex<double> > A(N,N);
+ for (unsigned i=0;i<N;i++)
+ for (unsigned j=0;j<N;j++)
+ A(i,j) = vcl_complex<double>(A_real(i,j), A_imag(i,j));
+
+ vnl_complex_eigensystem eig(A, // compute both
+ true, // left and right
+ true); // eigenvectors
+ TEST("vnl_complex_eigensystem constructor", eig.N, N);
+#if 0
+ vcl_cout << "A = " << A << '\n'
+ << "eigenvalues = " << eig.W << '\n'
+ << "L = " << eig.L << '\n'
+ << "R = " << eig.R << '\n';
+#endif
+ for (unsigned i=0;i<N;i++) {
+ vcl_complex<double> w = eig.W[i];
+ vcl_cout << " W[" << i << "] = " << w << '\n';
+ //
+ vnl_vector<vcl_complex<double> > l = eig.left_eigen_vector(i);
+ vnl_vector<vcl_complex<double> > err = l*A - l*w;
+ testlib_test_assert_near(" Left eigenvalue residue", err.magnitude());
+ //
+ vnl_vector<vcl_complex<double> > r = eig.right_eigen_vector(i);
+ err = A*r - w*r;
+ testlib_test_assert_near(" Right eigenvalue residue", err.magnitude());
+ }
+}
+
+void test_complex_eigensystem2()
+{
+ // The standard version of ZLAHQR fails to converge on this 6x6 matrix
+ // because the maximum number of iterations is reached. Removing the
+ // upper limit makes it work, though.
+ double Adata[6][6] = {
+ { 6.811898476755, -0.750947244402, 0.029620459055, 0.082784816274, -0.003265374870, 0.000128799864},
+ {-0.302642078990, 7.243967032503, -0.238733709072, -1.593479414193, 0.057672293761, -0.002070468886},
+ {-0.224780478514, 1.663978565954, 6.516036730518, -0.364143980645, -0.711203495953, 0.056672152613},
+ { 0.003361479487, -0.160548535977, 0.005288667260, 7.668002291196, -0.252593475373, 0.008320741358},
+ { 0.004993323929, -0.155932510596, -0.140831520110, 3.504603640364, 6.856177569090, -0.455504863942},
+ { 0.001854338541, -0.027249736525, -0.107516848058, 0.400438282672, 1.579973514772, 6.233960176641}
+ };
+ vnl_matrix<vcl_complex<double> > A(6, 6);
+ for (int i=0; i<6; ++i)
+ for (int j=0; j<6; ++j)
+ A[i][j] = Adata[i][j]; //(0.77+i) + (0.1+j)*(0.33+j);
+ vnl_complex_eigensystem eig(A);
+ TEST("vnl_complex_eigensystem constructor", eig.N, 6);
+ for (int i=0; i<6; ++i)
+ vcl_cout << " W[" << i << "] = " << eig.eigen_value(i) << '\n';
+}
+
+void test_complex_eigensystem()
+{
+ test_complex_eigensystem1();
+ test_complex_eigensystem2();
+}
+
+TESTMAIN(test_complex_eigensystem);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_convolve.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_convolve.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0e72e6ae8b36e3406b0782ed9d4ed4730b6f942c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_convolve.cxx
@@ -0,0 +1,95 @@
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_convolve.h>
+#include <vnl/vnl_double_2.h>
+#include <vnl/vnl_random.h>
+#include <vnl/vnl_int_2.h>
+#include <vul/vul_timer.h>
+
+#include <testlib/testlib_test.h>
+
+#include "test_util.h"
+
+void test_convolve()
+{
+ int b_data[] = { -2, 0, 4, 6, 2, 0 };
+ vnl_vector<int> b(6, 6, b_data);
+ vnl_vector<double> k1 = vnl_double_2(0.5,-0.5).as_vector();
+
+ vnl_vector<double> r1 = vnl_convolve(b, k1, (double*)0);
+ TEST("vnl_convolve() simple length", r1.size(), 7);
+ vcl_cout << r1 << vcl_endl;
+ TEST("vnl_convolve() simple values", true,
+ r1[0]==-1 && r1[1]==1 && r1[2]==2 && r1[3]==1 && r1[4]==-2 && r1[5]==-1 && r1[6]==0);
+
+ vnl_vector<int> k2 = vnl_int_2(1,-1).as_vector();
+ vnl_vector<int> r2 = vnl_convolve(b, k2);
+ TEST("vnl_convolve() simple length", r2.size(), 7);
+ vcl_cout << r2 << vcl_endl;
+ TEST("vnl_convolve() simple values", true,
+ r2[0]==-2 && r2[1]==2 && r2[2]==4 && r2[3]==2 && r2[4]==-4 && r2[5]==-2 && r2[6]==0);
+ vnl_vector<int> r3 = vnl_convolve(b, k2, (int*)0);
+ TEST("vnl_convolve() 2nd form", r3, r2);
+ vnl_vector<int> r4 = vnl_convolve(k2, b);
+ TEST("vnl_convolve() commutativity", r4, r2);
+ vnl_vector<double> r7 = vnl_convolve(b, k1, (double*)0, 1);
+ vcl_cout << r7 << vcl_endl;
+ TEST_NEAR("vnl_convolve() with_fft(7)", (r7-r1).two_norm(), 0.0, 1e-6);
+ vnl_vector<double> r8 = vnl_convolve(b, k1, (double*)0, 8);
+ vcl_cout << r8 << vcl_endl;
+ TEST_NEAR("vnl_convolve() with_fft(8)", (r8-r1).two_norm(), 0.0, 1e-6);
+
+ // TIMING TEST on a very long convolution:
+ vnl_vector<double> l(10000), k3(2000);
+ vnl_random rng;
+ test_util_fill_random(l.begin(), l.end(), rng);
+ test_util_fill_random(k3.begin(), k3.end(), rng);
+ const unsigned ntimes = 10; // repeat some expts to get more accurate timings.
+ vnl_vector<double> r9;
+ vul_timer timer;
+ for (unsigned i=0; i < ntimes; ++i)
+ r9 = vnl_convolve(l, k3);
+ int ms1 = timer.user();
+ vcl_cout << "Done straightforward 10000x2000 convolution in " << ms1/double(ntimes) << " milliseconds\n";
+
+ vnl_vector<double> r10;
+ timer.mark();
+ for (unsigned i=0; i < ntimes; ++i)
+ r10 = vnl_convolve(l, k3, 16384);
+ int ms2 = timer.user();
+ TEST_NEAR("vnl_convolve() with_fft(16384)", (r9-r10).two_norm(), 0.0, 1e-6);
+ vcl_cout << "Done FFT-2-based 10000x2000 convolution in " << ms2/double(ntimes) << " milliseconds\n";
+ TEST("vnl_convolve() timing: should be at least 2.5x faster", 5*ms2 < 2*ms1, true);
+
+ vnl_vector<double> r11;
+ timer.mark();
+ for (unsigned i=0; i < ntimes; ++i)
+ r11 = vnl_convolve(l, k3, 12800);
+ int ms3 = timer.user();
+ TEST_NEAR("vnl_convolve() with_fft(12800)", (r9-r11).two_norm(), 0.0, 1e-6);
+ vcl_cout << "Done FFT-2,5-based 10000x2000 convolution in " << ms3/double(ntimes) << " milliseconds\n";
+ TEST("vnl_convolve() timing: should even be faster", ms3 < ms2, true);
+
+ vnl_vector<double> r12;
+ timer.mark();
+ for (unsigned i=0; i < ntimes; ++i)
+ r12 = vnl_convolve(l, k3, 27648);
+ int ms4 = timer.user();
+ TEST_NEAR("vnl_convolve() with_fft(27648)", (r9-r12).two_norm(), 0.0, 1e-6);
+ vcl_cout << "Done FFT-2,3-based 10000x2000 convolution in " << ms4/double(ntimes) << " milliseconds\n";
+ TEST("vnl_convolve() timing: should be slower", 5*ms4 > 3*ms2, true);
+
+ double c1_data[] = { -1, 0, 1, 2, 3, 4 };
+ vnl_vector<double> c1(6, 6, c1_data);
+ double c2_data[] = { 5, 3, 1, -1, -3, -5 };
+ vnl_vector<double> c2(6, 6, c2_data);
+ vnl_vector<double> r5 = vnl_convolve_cyclic(c1, c2, (double*)0);
+ TEST("vnl_convolve_cyclic() length", r5.size(), 6);
+ vcl_cout << r5 << vcl_endl;
+ TEST("vnl_convolve_cyclic() values", true,
+ r5[0]==5 && r5[1]==-13 && r5[2]==-19 && r5[3]==-13 && r5[4]==5 && r5[5]==35);
+ vnl_vector<double> r6 = vnl_convolve_cyclic(c1, c2, (double*)0, true);
+ vcl_cout << r6 << vcl_endl;
+ TEST_NEAR("vnl_convolve_cyclic() with_fft", (r6-r5).two_norm(), 0.0, 1e-6);
+}
+
+TESTMAIN(test_convolve);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cpoly_roots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cpoly_roots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a5735d8877358634191f217eed8a7da0e7bedc8e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_cpoly_roots.cxx
@@ -0,0 +1,22 @@
+#include <vnl/vnl_real_polynomial.h>
+#include <vnl/algo/vnl_cpoly_roots.h>
+
+#include <testlib/testlib_test.h>
+
+void test_cpoly_roots()
+{
+ const double coeffs[] = {6, 5, 4, 3, 2, 1};
+ vnl_vector<double> a(coeffs, 6);
+
+ vnl_vector<double> monic( (a/a[0]).extract(a.size()-1,1) );
+ vnl_cpoly_roots roots( monic, 0.0*monic );
+
+ testlib_test_assert( "Number of solutions", roots.solns.size() == monic.size() );
+
+ // Evaluate results
+ vnl_real_polynomial f(a);
+ for (int i = 0; i < f.degree(); ++i)
+ testlib_test_assert("Root residual", vcl_abs(f.evaluate(roots.solns[i])) < 1e-12);
+}
+
+TESTMAIN(test_cpoly_roots);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_determinant.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_determinant.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..42e2862caa46dda080834c047582bd8903e902e6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_determinant.cxx
@@ -0,0 +1,162 @@
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_qr.h>
+#include <vnl/algo/vnl_determinant.h>
+#include <vnl/vnl_det.h>
+
+#include <testlib/testlib_test.h>
+
+double qr_det(vnl_matrix<double> const &M) {
+ return vnl_qr<double>(M).determinant();
+}
+
+void test_determinant() {
+ double eps = 1e-14;
+
+#if 0 // commented out
+ {
+ double M1[1][1] = {
+ { 0.95012928514718 }
+ };
+ vnl_matrix<double> m1(&M1[0][0],1,1);
+ double d1 = M1[0][0];
+ testlib_test_assert_near("1x1 vnl_determinant(vnl_matrix<double>)", vnl_determinant(m1), d1, eps);
+ testlib_test_assert_near("1x1 qr_det(vnl_matrix<double>)", qr_det(m1), d1, eps);
+ testlib_test_assert_near("1x1 vnl_determinant(double, ...)", vnl_determinant(M1[0]), d1, eps);
+ vnl_matrix_fixed<double,1,1> m_1 = m1;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,1,1>)", vnl_det(m_1), d1, eps);
+ }
+
+ {
+ double N1[1][1] = {
+ { -0.95012928514718 }
+ };
+ vnl_matrix<double> n1(&N1[0][0],1,1);
+ double d1 = N1[0][0];
+ testlib_test_assert_near("1x1 vnl_determinant(vnl_matix<double>)", vnl_determinant(n1), d1, eps);
+ testlib_test_assert_near("1x1 qr_det(vnl_matrix<double>)", qr_det(n1), d1, eps);
+ testlib_test_assert_near("1x1 vnl_determinant(double, ...)", vnl_determinant(N1[0]), d1, eps);
+ vnl_matrix_fixed<double,1,1> n_1 = n1;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,1,1>)", vnl_det(n_1), d1, eps);
+ }
+#endif
+ {
+ double M2[2][2] = {
+ { 0.60684258354179, 0.89129896614890 },
+ { 0.48598246870930, 0.76209683302739 }
+ };
+ vnl_matrix<double> m2(&M2[0][0],2,2);
+ double d2 = qr_det(m2);
+ testlib_test_assert_near("2x2 vnl_determinant(vnl_matix<double>)", vnl_determinant(m2), d2, eps);
+ testlib_test_assert_near("2x2 vnl_determinant(double, ...)", vnl_determinant(M2[0], M2[1]), d2, eps);
+ vnl_matrix_fixed<double,2,2> m_2 = m2;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,2,2>)", vnl_det(m_2), d2, eps);
+ }
+
+ {
+ double N2[2][2] = {
+ { 0.60684258354179, 0.89129896614890 },
+ { 0.48598246870930, -0.76209683302739 }
+ };
+ vnl_matrix<double> n2(&N2[0][0],2,2);
+ double d2 = qr_det(n2);
+ testlib_test_assert_near("2x2 vnl_determinant(vnl_matix<double>)", vnl_determinant(n2), d2, eps);
+ testlib_test_assert_near("2x2 vnl_determinant(double, ...)", vnl_determinant(N2[0], N2[1]), d2, eps);
+ vnl_matrix_fixed<double,2,2> n_2 = n2;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,2,2>)", vnl_det(n_2), d2, eps);
+ }
+
+ {
+ double M3[3][3] = {
+ { 0.45646766516834, 0.44470336435319, 0.92181297074480 },
+ { 0.01850364324822, 0.61543234810009, 0.73820724581067 },
+ { 0.82140716429525, 0.79193703742704, 0.17626614449462 }
+ };
+ vnl_matrix<double> m3(&M3[0][0],3,3);
+ double d3 = qr_det(m3);
+ testlib_test_assert_near("3x3 vnl_determinant(vnl_matix<double>)", vnl_determinant(m3), d3, eps);
+ testlib_test_assert_near("3x3 vnl_determinant(double, ...)", vnl_determinant(M3[0], M3[1], M3[2]), d3, eps);
+ vnl_matrix_fixed<double,3,3> m_3 = m3;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,3,3>)", vnl_det(m_3), d3, eps);
+ }
+
+ {
+ double N3[3][3] = {
+ { 0.45646766516834, 0.44470336435319, -0.92181297074480 },
+ { 0.01850364324822, 0.61543234810009, -0.73820724581067 },
+ { 0.82140716429525, 0.79193703742704, 0.17626614449462 }
+ };
+ vnl_matrix<double> n3(&N3[0][0],3,3);
+ double d3 = qr_det(n3);
+ testlib_test_assert_near("3x3 vnl_determinant(vnl_matix<double>)", vnl_determinant(n3), d3, eps);
+ testlib_test_assert_near("3x3 vnl_determinant(double, ...)", vnl_determinant(N3[0], N3[1], N3[2]), d3, eps);
+ vnl_matrix_fixed<double,3,3> n_3 = n3;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,3,3>)", vnl_det(n_3), d3, eps);
+ }
+
+ {
+ double M4[4][4] = {
+ { 0.40570621306210, 0.89364953091353, 0.00986130066092, 0.60379247919382 },
+ { 0.93546969910761, 0.05789130478427, 0.13889088195695, 0.27218792496996 },
+ { 0.91690443991341, 0.35286813221700, 0.20276521856027, 0.19881426776106 },
+ { 0.41027020699095, 0.81316649730376, 0.19872174266149, 0.01527392702904 }
+ };
+ vnl_matrix<double> m4(&M4[0][0],4,4);
+ double d4 = qr_det(m4);
+ testlib_test_assert_near("4x4 vnl_determinant(vnl_matix<double>)", vnl_determinant(m4), d4, eps);
+ testlib_test_assert_near("4x4 vnl_determinant(double, ...)", vnl_determinant(M4[0],M4[1],M4[2],M4[3]), d4, eps);
+ vnl_matrix_fixed<double,4,4> m_4 = m4;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,4,4>)", vnl_det(m_4), d4, eps);
+ }
+
+ {
+ double N4[4][4] = {
+ { 0.40570621306210, -0.89364953091353, 0.00986130066092, -0.60379247919382 },
+ { 0.93546969910761, 0.05789130478427, 0.13889088195695, 0.27218792496996 },
+ { 0.91690443991341, -0.35286813221700, 0.20276521856027, -0.19881426776106 },
+ { 0.41027020699095, 0.81316649730376, 0.19872174266149, 0.01527392702904 }
+ };
+ vnl_matrix<double> n4(&N4[0][0],4,4);
+ double d4 = qr_det(n4);
+ testlib_test_assert_near("4x4 vnl_determinant(vnl_matix<double>)", vnl_determinant(n4), d4, eps);
+ testlib_test_assert_near("4x4 vnl_determinant(double, ...)", vnl_determinant(N4[0],N4[1],N4[2],N4[3]), d4, eps);
+ vnl_matrix_fixed<double,4,4> n_4 = n4;
+ testlib_test_assert_near("vnl_det(vnl_matrix_fixed<double,4,4>)", vnl_det(n_4), d4, eps);
+
+ double N5[5][5] = {
+ { 1, 0, 0, 0, 0 },
+ { 0, N4[0][0], N4[0][1], N4[0][2], N4[0][3] },
+ { 0, N4[1][0], N4[1][1], N4[1][2], N4[1][3] },
+ { 0, N4[2][0], N4[2][1], N4[2][2], N4[2][3] },
+ { 0, N4[3][0], N4[3][1], N4[3][2], N4[3][3] }
+ };
+ vnl_matrix<double> n5(&N5[0][0],5,5);
+ double d5 = qr_det(n5);
+ testlib_test_assert_near("5x5 qr_det equals 4x4 one", d5, d4, eps);
+ testlib_test_assert_near("5x5 vnl_determinant(vnl_matix<double>)", vnl_determinant(n5), d5, eps);
+ vnl_matrix_fixed<double,5,5> n_5 = n5;
+ testlib_test_assert_near("vnl_determinant(vnl_matrix_fixed<double,5,5>)", vnl_determinant(n_5), d5, eps);
+ }
+
+ {
+ int M6[3][3] = {
+ { 2, 0, 0 },
+ { 0, 1, 0 },
+ { 0, 0, 5 } };
+ vnl_matrix<int> m6(&M6[0][0],3,3);
+ testlib_test_assert_near("3x3 vnl_determinant(vnl_matix<int>)", vnl_determinant(m6), 10, eps);
+ }
+
+ {
+ int M7[6][6] = {
+ { 2, 0, 0, 0, 0, 0 },
+ { 0, 1, 0, 0, 0, 0 },
+ { 0, 0, 5, 0, 0, 0 },
+ { 0, 0, 0, 4, 0, 0 },
+ { 0, 0, 0, 0, 2, 0 },
+ { 0, 0, 0, 0, 0, 6 } };
+ vnl_matrix<int> m7(&M7[0][0],6,6);
+ testlib_test_assert_near("6x6 vnl_determinant(vnl_matix<int>)", vnl_determinant(m7), 2*1*5*4*2*6, eps);
+ }
+}
+
+TESTMAIN(test_determinant);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_driver.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_driver.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..37ea4b8e78f28a6f5ff89c24acc6d90f06e8bdc8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_driver.cxx
@@ -0,0 +1,58 @@
+#include <testlib/testlib_register.h>
+
+DECLARE( test_amoeba );
+DECLARE( test_cholesky );
+DECLARE( test_complex_eigensystem );
+//DECLARE( test_convolve );
+DECLARE( test_cpoly_roots );
+DECLARE( test_determinant );
+DECLARE( test_rank );
+DECLARE( test_fft );
+DECLARE( test_fft1d );
+DECLARE( test_fft2d );
+DECLARE( test_functions );
+DECLARE( test_generalized_eigensystem );
+DECLARE( test_levenberg_marquardt );
+DECLARE( test_minimizers );
+DECLARE( test_qr );
+DECLARE( test_qsvd );
+DECLARE( test_rational );
+DECLARE( test_real_eigensystem );
+DECLARE( test_rnpoly_roots );
+DECLARE( test_rpoly_roots );
+DECLARE( test_sparse_matrix );
+DECLARE( test_integral );
+DECLARE( test_svd );
+//DECLARE( test_symmetric_eigensystem );
+DECLARE( test_algo );
+
+void
+register_tests()
+{
+ REGISTER( test_amoeba );
+ REGISTER( test_cholesky );
+ REGISTER( test_complex_eigensystem );
+ //REGISTER( test_convolve );
+ REGISTER( test_cpoly_roots );
+ REGISTER( test_determinant );
+ REGISTER( test_rank );
+ REGISTER( test_fft );
+ REGISTER( test_fft1d );
+ REGISTER( test_fft2d );
+ REGISTER( test_functions );
+ REGISTER( test_generalized_eigensystem );
+ REGISTER( test_levenberg_marquardt );
+ REGISTER( test_minimizers );
+ REGISTER( test_qr );
+ REGISTER( test_qsvd );
+ REGISTER( test_real_eigensystem );
+ REGISTER( test_integral );
+ REGISTER( test_rnpoly_roots );
+ REGISTER( test_rpoly_roots );
+ REGISTER( test_sparse_matrix );
+ REGISTER( test_svd );
+ //REGISTER( test_symmetric_eigensystem );
+ REGISTER( test_algo );
+}
+
+DEFINE_MAIN;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2e9d6c72f9924b386b0043af9c4b52c6d08aae7a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft.cxx
@@ -0,0 +1,69 @@
+// This is core/vnl/algo/tests/test_fft.cxx
+/*
+ fsm
+*/
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_random.h>
+
+#include <vnl/algo/vnl_fft_1d.h>
+#include <vnl/algo/vnl_fft_2d.h>
+
+#include <testlib/testlib_test.h>
+
+#include "test_util.h"
+
+void test_fft_1d(unsigned int N)
+{
+ vnl_random rng;
+ vnl_vector<vcl_complex<double> > signal(N);
+ test_util_fill_random(signal.begin(), signal.end(), rng);
+
+ vnl_fft_1d<double> fft(N);
+
+ vnl_vector<vcl_complex<double> > tmp = signal;
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ fft.fwd_transform(tmp);
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ fft.bwd_transform(tmp); tmp /= N;
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ double err = (tmp - signal).two_norm();
+ vcl_cout << "err = " << err << vcl_endl;
+ testlib_test_assert_near("test fwd-bwd", err, 0.0, 1e-10);
+}
+
+void test_fft_2d(unsigned int M, unsigned int N)
+{
+ vnl_random rng;
+ vnl_matrix<vcl_complex<double> > signal(M, N);
+ test_util_fill_random(signal.begin(), signal.end(), rng);
+
+ vnl_fft_2d<double> fft(M, N);
+
+ vnl_matrix<vcl_complex<double> > tmp = signal;
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ fft.fwd_transform(tmp);
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ fft.bwd_transform(tmp); tmp /= (M*N);
+ vnl_matlab_print(vcl_cout, tmp, "tmp");
+
+ double err = (tmp - signal).fro_norm();
+ vcl_cout << "err = " << err << vcl_endl;
+ testlib_test_assert_near("test fwd-bwd", err, 0.0, 1e-10);
+}
+
+void test_fft()
+{
+ test_fft_1d(24);
+ test_fft_2d(25, 30);
+}
+
+TESTMAIN (test_fft);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft1d.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft1d.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..357a82071381783bde777d317d184e33e9a64688
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft1d.cxx
@@ -0,0 +1,161 @@
+// This is core/vnl/algo/tests/test_fft1d.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \brief test program for 1D FFT routines.
+// \author Veit U.B. Schenk, Oxford RRG.
+// \date 20 Mar 1998
+//
+// Creates 1D arrays and vectors, computes forward fft, then backward fft
+// for all (where applicable) constructors of the class
+// and computes differences between input and output.
+//
+// \verbatim
+// Modifications
+// Jan. 2002 - Peter Vanroose - adapted from vnl_fft1d to vnl_fft_1d
+// June 2003 - Peter Vanroose - added tests for the vcl_vector interface
+// \endverbatim
+
+//-----------------------------------------------------------------------------
+#include <vcl_cstdlib.h> // for vcl_abort
+#include <vcl_cmath.h> // for vcl_fabs
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vcl_vector.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_fft_1d.h>
+
+void test_fft_1d(int n)
+{
+ vcl_cout << "=================================\n"
+ << "Testing vnl_fft_1d for length " << n << '\n'
+ << "=================================\n";
+
+ // calculate prime factors for this size array
+ //============================================
+ vnl_fft_prime_factors<double> oPFx(n);
+ if (!oPFx) {
+ vcl_cerr << "cannot decompose X-size " << n << ")into the form (2^P)(3^Q)(5^R)\n";
+ vcl_abort();
+ }
+
+ // create a number of arrays for testing the transform
+ //====================================================
+ vnl_vector<vcl_complex<double> > fTestArrayConvert(n);
+ vnl_vector<vcl_complex<double> > fTestArrayFwd(n);
+ vcl_vector<vcl_complex<double> > fTestVecConvert(n);
+ vcl_vector<vcl_complex<double> > fTestVecFwd(n);
+ vcl_complex<double>* fTestPtrConvert = new vcl_complex<double>[n];
+ vcl_complex<double>* fTestPtrFwd = new vcl_complex<double>[n];
+
+ //fill with data
+ for (int iC = 0;iC < n;iC ++)
+ fTestArrayConvert(iC) = fTestArrayFwd(iC) =
+ fTestVecConvert[iC] = fTestVecFwd[iC] =
+ fTestPtrConvert[iC] = fTestPtrFwd[iC] =
+ vcl_complex<double>(iC-3.5,0.0);
+
+ //============================= super-easy transform =====================
+ vnl_fft_1d<double> oFFTSimple(n);
+ oFFTSimple.transform(fTestArrayConvert, +1);
+ oFFTSimple.fwd_transform(fTestArrayFwd);
+ oFFTSimple.transform(fTestVecConvert, +1);
+ oFFTSimple.fwd_transform(fTestVecFwd);
+ oFFTSimple.transform(fTestPtrConvert, +1);
+ oFFTSimple.fwd_transform(fTestPtrFwd);
+
+ // now compare the results
+ TEST("test forward vnl_vector", fTestArrayConvert, fTestArrayFwd);
+ TEST("test forward vcl_vector", fTestVecConvert, fTestVecFwd);
+ bool test_Ptr=true;
+ for (int iC = 0;iC < n;iC ++)
+ if (fTestPtrConvert[iC]!=fTestVecFwd[iC] ||
+ fTestPtrFwd[iC]!=fTestVecConvert[iC]) { test_Ptr = false; break; }
+ TEST("test forward C-array", test_Ptr, true);
+
+ // the whole thing backwards
+ //==========================
+ oFFTSimple.transform(fTestArrayConvert, -1);
+ oFFTSimple.bwd_transform(fTestArrayFwd);
+ oFFTSimple.transform(fTestVecConvert, -1);
+ oFFTSimple.bwd_transform(fTestVecFwd);
+ oFFTSimple.transform(fTestPtrConvert, -1);
+ oFFTSimple.bwd_transform(fTestPtrFwd);
+
+ TEST("test backward vnl_vector", fTestArrayConvert, fTestArrayFwd);
+ TEST("test backward vcl_vector", fTestVecConvert, fTestVecFwd);
+ test_Ptr=true;
+ for (int iC = 0;iC < n;iC ++)
+ if (fTestPtrConvert[iC]!=fTestVecFwd[iC] ||
+ fTestPtrFwd[iC]!=fTestVecConvert[iC]) {
+ vcl_cout<<"C-array_fwd_bwd["<<iC<<"]="<<fTestPtrFwd[iC]
+ <<", C-array_convert["<<iC<<"]="<<fTestPtrConvert[iC]
+ <<", vcl_vector["<<iC<<"]="<<fTestVecFwd[iC]<<'\n';
+ test_Ptr = false; break;
+ }
+ TEST("test backward C-array", test_Ptr, true);
+
+ double fArrayRealError = 0.0, fArrayImagError = 0.0,
+ fVecRealError = 0.0, fVecImagError = 0.0,
+ fPtrRealError = 0.0, fPtrImagError = 0.0,
+ fFwdRealError = 0.0, fFwdImagError = 0.0;
+
+ for (int iC = 0;iC < n;iC ++)
+ {
+ // divide by n (since by definition fft_bwd(a) == n*....)
+ fArrayRealError += vcl_fabs(vcl_real(fTestArrayConvert(iC))/n - (iC-3.5));
+ fArrayImagError += vcl_fabs(vcl_imag(fTestArrayConvert(iC))/n);
+ fVecRealError += vcl_fabs(vcl_real(fTestVecConvert[iC])/n - (iC-3.5));
+ fVecImagError += vcl_fabs(vcl_imag(fTestVecConvert[iC])/n);
+ fPtrRealError += vcl_fabs(vcl_real(fTestPtrConvert[iC])/n - (iC-3.5));
+ fPtrImagError += vcl_fabs(vcl_imag(fTestPtrConvert[iC])/n);
+ fFwdRealError += vcl_fabs(vcl_real(fTestPtrFwd[iC])/n - (iC-3.5));
+ fFwdImagError += vcl_fabs(vcl_imag(fTestPtrFwd[iC])/n);
+ }
+
+ TEST_NEAR("vnl_vector absolute error, real part (per element)", fArrayRealError/n, 0.0, 1e-9);
+ TEST_NEAR("vnl_vector absolute error, imag part (per element)", fArrayImagError/n, 0.0, 1e-9);
+ TEST_NEAR("vcl_vector absolute error, real part (per element)", fVecRealError/n, 0.0, 1e-9);
+ TEST_NEAR("vcl_vector absolute error, imag part (per element)", fVecImagError/n, 0.0, 1e-9);
+ TEST_NEAR("C-array absolute error, real part (per element)", fPtrRealError/n, 0.0, 1e-9);
+ TEST_NEAR("C-array absolute error, imag part (per element)", fPtrImagError/n, 0.0, 1e-9);
+ TEST_NEAR("C-array fwd absolute error, real part (per element)", fFwdRealError/n, 0.0, 1e-9);
+ TEST_NEAR("C-array fwd absolute error, imag part (per element)", fFwdImagError/n, 0.0, 1e-9);
+
+ delete[] fTestPtrConvert;
+ delete[] fTestPtrFwd;
+}
+
+void test_fft1d()
+{
+ test_fft_1d(256);
+ test_fft_1d(243);
+ test_fft_1d(625);
+
+ test_fft_1d(1);
+ test_fft_1d(2);
+ test_fft_1d(3);
+ test_fft_1d(4);
+ test_fft_1d(5);
+ test_fft_1d(6);
+ test_fft_1d(8);
+ test_fft_1d(9);
+ test_fft_1d(10);
+ test_fft_1d(16);
+ test_fft_1d(32);
+ test_fft_1d(64);
+ test_fft_1d(128);
+
+ test_fft_1d(200);
+ test_fft_1d(216);
+ test_fft_1d(225);
+ test_fft_1d(240);
+ test_fft_1d(250);
+ test_fft_1d(270);
+ test_fft_1d(288);
+
+ test_fft_1d(10000);
+ test_fft_1d(65536);
+}
+
+TESTMAIN(test_fft1d);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft2d.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft2d.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7f1727ff1df9cb194b78497ae94d40fffe7a2507
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_fft2d.cxx
@@ -0,0 +1,98 @@
+// This is core/vnl/algo/tests/test_fft2d.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \brief test program for 2D FFT routines.
+// \author Veit U.B. Schenk, Oxford RRG.
+// \date 20 Mar 1998
+//
+// Creates 2D arrays and matrices, computes forward fft, then backward fft
+// for all (where applicable) constructors of the class
+// and computes differences between input and output.
+//
+// \verbatim
+// Modifications
+// Jan. 2002 - Peter Vanroose - adapted from vnl_fft2d to vnl_fft_2d
+// \endverbatim
+
+//-----------------------------------------------------------------------------
+#include <vcl_cstdlib.h>
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+
+#include <vnl/vnl_complexify.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_fft_2d.h>
+
+inline static double function(unsigned i, unsigned j) { return i * j; }
+
+void test_cplx(vnl_fft_prime_factors<double> const &/*prx*/,
+ vnl_fft_prime_factors<double> const &/*pry*/,
+ vnl_matrix<vcl_complex<double> > const &M,
+ int dir)
+{
+ vnl_matrix<vcl_complex<double> > fft_matrix = M;
+ vnl_fft_2d<double> fft(M.rows(), M.cols()); fft.transform(fft_matrix, dir);
+ testlib_test_assert ("test rows", fft.rows() == M.rows());
+ testlib_test_assert ("test cols", fft.cols() == M.cols());
+ testlib_test_assert ("test transform", fft_matrix != M);
+}
+
+void test_fft2d () {
+ const unsigned int rows = 64;
+ const unsigned int cols = 64;
+
+ // calculate prime factors for this size array
+ vnl_fft_prime_factors<double> prx (rows);
+ vnl_fft_prime_factors<double> pry (cols);
+
+ if (!prx) {
+ vcl_cerr << "cannot decompose X-size " << rows << ") into the form (2^P)(3^Q)(5^R)\n";
+ vcl_abort();
+ }
+ if (!pry) {
+ vcl_cerr << "cannot decompose Y-size (" << cols << ") into the form (2^P)(3^Q)(5^R)\n";
+ vcl_abort();
+ }
+
+ // create arrays for testing the transform
+
+ // data as arrays :
+ double real_array[cols*rows];
+ double imag_array[cols*rows];
+
+ // fill with stuff :
+ for (unsigned i=0; i<rows; ++i) {
+ for (unsigned j=0; j<cols; ++j) {
+ real_array[i*cols + j] = function(i, j);
+ imag_array[i*cols + j] = 0.0;
+ }
+ }
+
+ // complexify :
+ vcl_complex<double> cplx_array[rows*cols];
+ vnl_complexify(real_array, imag_array, cplx_array, rows*cols);
+
+ // data as matrices :
+ vnl_matrix<vcl_complex<double> > cplx_matrix(cplx_array, rows,cols);
+
+ //--------------------------------------------------------------------------------
+
+ test_cplx(prx, pry, cplx_matrix, +1);
+ test_cplx(prx, pry, cplx_matrix, -1);
+
+ //--------------------------------------------------------------------------------
+
+ // verify that backwards * forwards is multiplication by .size().
+
+ vnl_matrix<vcl_complex<double> > fft_matrix = cplx_matrix;
+ vnl_fft_2d<double> fft(cplx_matrix.rows(), cplx_matrix.cols());
+ fft.fwd_transform(fft_matrix);
+ fft.bwd_transform(fft_matrix);
+
+ double error = (fft_matrix - vcl_complex<double>(cplx_matrix.size())*cplx_matrix).fro_norm();
+ vcl_cout << "error = " << error << vcl_endl;
+ testlib_test_assert ("fwd-bwd error", error < 1e-7); // increase for float
+}
+
+TESTMAIN (test_fft2d);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_functions.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_functions.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9e14bb08ba711aea9bb642f826260c172f8c2375
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_functions.cxx
@@ -0,0 +1,124 @@
+// This is core/vnl/algo/tests/test_functions.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+//
+// Test function results for chi-squared cumulative density function.
+// The values are those calculated from this function on solaris, and
+// agree (to 3sf) with those from a mathematical table.
+//
+// Each row is for a different dof, from 1 through 96 in increments of
+// 5 (20 rows).
+//
+// Each column is for a different chi-squared, from 0 though 180 in
+// increments of 20 (10 columns).
+//
+// For readability reasons, the rows are split in 2x 5 rows, with an extra
+// indentation for the second half of each row.
+
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h>
+#include <vcl_cmath.h>
+#include <vcl_ctime.h>
+
+#include <vnl/algo/vnl_chi_squared.h>
+
+double cdf_baseline[] =
+{
+ 0.0, 0.9999922488859869, 0.9999999997449120, 0.9999999999999905, 1.0,
+ 1.0, 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.9972306042844884, 0.9999995444850495, 0.9999999999549898, 0.9999999999999964,
+ 1.0, 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.9546593186683575, 0.9999642248743472, 0.9999999907278384, 0.9999999999985243,
+ 0.9999999999999998, 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.7797793533983011, 0.9992214099174926, 0.9999994766265833, 0.9999999998335990,
+ 0.9999999999999654, 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.4787387426184652, 0.9925632227010702, 0.9999872283117348, 0.9999999919251898,
+ 0.9999999999971140, 0.9999999999999993, 1.0, 1.0, 1.0,
+ 0.0, 0.2084435236051257, 0.9609880071450072, 0.9998323023504486, 0.9999997903577246,
+ 0.9999999998716507, 0.9999999999999505, 1.0, 1.0, 1.0,
+ 0.0, 0.0641963723612628, 0.8709596508694845, 0.9986502140214748, 0.9999966874714471,
+ 0.9999999965356298, 0.9999999999979206, 0.9999999999999991, 1.0, 1.0,
+ 0.0, 0.0142776135970496, 0.7029716020753263, 0.9927297837948102, 0.9999652953758086,
+ 0.9999999382046935, 0.9999999999423534, 0.9999999999999658, 1.0, 1.0,
+ 0.0, 0.0023551011658856, 0.4850483796984979, 0.9720590475678458, 0.9997436372936986,
+ 0.9999992259610407, 0.9999999988798406, 0.9999999999990349, 0.9999999999999994, 1.0,
+ 0.0, 0.0002957368080061, 0.2793886568739744, 0.9194309789050203, 0.9986010626587202,
+ 0.9999928735024521, 0.9999999840351245, 0.9999999999800138, 0.9999999999999838, 1.0,
+ 0.0, 0.0000289361257476, 0.1331225579748673, 0.8182400707526587, 0.9941486753062340,
+ 0.9999500186862800, 0.9999998271108139, 0.9999999996858998, 0.9999999999996467, 0.9999999999999998,
+ 0.0, 0.0000022535340508, 0.0524807132282665, 0.6671309159544766, 0.9806610209037141,
+ 0.9997251552759223, 0.9999985364764852, 0.9999999961469799, 0.9999999999940054, 0.9999999999999938,
+ 0.0, 0.0000001352148233, 0.0172069984403675, 0.4878147556882595, 0.9481646213453065,
+ 0.9987862811130113, 0.9999900872908165, 0.9999999622464486, 0.9999999999188310, 0.9999999999998879,
+ 0.0, 0.0000000073722077, 0.0047274255385307, 0.3154587502878544, 0.8846964150660444,
+ 0.9956070677677689, 0.9999452153818948, 0.9999996987525844, 0.999999999105923, 0.9999999999983556,
+ 0.0, 0.0, 0.0010974342908522, 0.1790828046260967, 0.7825800096649158,
+ 0.9867347062121498, 0.9997487615314837, 0.9999980101056154, 0.9999999918570519, 0.9999999999800666,
+ 0.0, 0.0000000000116404, 0.0002170786956947, 0.0890129923177431, 0.6453492639226499,
+ 0.9660451059031501, 0.9990298866149123, 0.9999889634183597, 0.9999999378147725, 0.9999999997975395,
+ 0.0, 0.0, 0.0000368857904673, 0.0387583535447800, 0.4894571445703249,
+ 0.9252463664134718, 0.9968048573119753, 0.9999479616312844, 0.9999995969280049, 0.9999999982561550,
+ 0.0, 0.0000000000000097, 0.0000054252284960, 0.0148195154453572, 0.3381826989258588,
+ 0.8564977678812210, 0.9909185509763581, 0.9997891030141784, 0.9999977585673097, 0.9999999871266845,
+ 0.0, 0.0, 0.0000006956282422, 0.0049930250351178, 0.2116235676678424,
+ 0.7565873548899793, 0.9774854404134016, 0.9992580809522048, 0.9999892041010620, 0.9999999177818010,
+ 0.0, 0.0000000000000002, 0.0000000782693028, 0.0014883025723802, 0.1195827092276646,
+ 0.6303318279959211, 0.9508233262755118, 0.9977140253664275, 0.9999545743054137, 0.9999995418724694
+};
+
+int test_functions()
+{
+ int n;
+ double chisq;
+ int idx = 0;
+ for (n=1; n<100; n+=5)
+ {
+ for (chisq = 0; chisq < 200; chisq+=20)
+ {
+ double cdf = vnl_chi_squared_cumulative(chisq,n);
+ double err = vcl_fabs(cdf - cdf_baseline[idx++]);
+ vcl_cout << "vnl_chi_squared_cumulative(" << chisq << ',' << n << ')';
+ testlib_test_assert(" CDF", err < 2e-15);
+ if (err >= 2e-15)
+ vcl_cout << "Error = " << vcl_setprecision(16) << err << vcl_endl;
+ }
+ }
+
+ vcl_cout << "cdf(7.88,1) = " << vnl_chi_squared_cumulative(7.88,1)
+ << " should be about 0.995\n"
+ << "cdf(14.8,12) = " << vnl_chi_squared_cumulative(14.8,12)
+ << " should be about 0.75\n"
+ << "cdf(10.1,19) = " << vnl_chi_squared_cumulative(10.1,19)
+ << " should be about 0.05\n"
+ << "cdf(39.3,40) = " << vnl_chi_squared_cumulative(39.3,40)
+ << " should be about 0.50\n"
+ << "cdf(109.1,100) = " << vnl_chi_squared_cumulative(109.1,100)
+ << " should be about 0.75\n";
+
+ // rand() is not always a good random number generator,
+ // so use the following congruential random number generator - PVr
+ static unsigned long sample_seed = (unsigned long)vcl_time(0);
+
+ double hist1[20];
+ for (int i=0; i<20; i++)
+ {
+ sample_seed = (sample_seed*16807)%2147483647L;
+ double u = double(sample_seed)/0x7fffffff; // 0x7fffffff == 2147483711L
+ hist1[i] = 10.0+20.0*(u-0.5); // uniform in the interval 0 - 20
+ }
+ chisq = 0;
+ for (int i=0; i<20; i++)
+ {
+ vcl_cout << i << ' ' << hist1[i] << vcl_endl;
+ double delta = hist1[i] - 10.0;
+ chisq += delta*delta/(hist1[i] + 10.0);
+ }
+ vcl_cout << "cdf(" << chisq << ",20) = "
+ << vnl_chi_squared_cumulative(chisq,20)
+ << " so P(same dist) = " << (1.0 - vnl_chi_squared_cumulative(chisq,20))
+ << vcl_endl;
+ return 0;
+}
+
+TESTMAIN(test_functions);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_generalized_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_generalized_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b4f9c73887a675a5d6b732bedcdfac0527dad9bf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_generalized_eigensystem.cxx
@@ -0,0 +1,47 @@
+// This is core/vnl/algo/tests/test_generalized_eigensystem.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \brief test program for generalized eigensystem routines.
+// \author Andrew W. Fitzgibbon, Oxford RRG.
+// \date 29 Aug 96
+
+//-----------------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_generalized_eigensystem.h>
+
+void test_generalized_eigensystem()
+{
+ double Sdata[36] = {
+ 30.0000, -3.4273, 13.9254, 13.7049, -2.4446, 20.2380,
+ -3.4273, 13.7049, -2.4446, 1.3659, 3.6702, -0.2282,
+ 13.9254, -2.4446, 20.2380, 3.6702, -0.2282, 28.6779,
+ 13.7049, 1.3659, 3.6702, 12.5273, -1.6045, 3.9419,
+ -2.4446, 3.6702, -0.2282, -1.6045, 3.9419, 2.5821,
+ 20.2380, -0.2282, 28.6779, 3.9419, 2.5821, 44.0636,
+ };
+ double Cdata[36] = {
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 2,
+ 0, 0, 0, 0, -1, 0,
+ 0, 0, 0, 2, 0, 0,
+ };
+
+ vnl_matrix<double> S(Sdata, 6,6);
+ vnl_matrix<double> C(Cdata, 6,6);
+
+ vnl_generalized_eigensystem gev(C, S);
+
+ vcl_cout << "V = " << gev.V << vcl_endl
+ << "D = " << gev.D << vcl_endl
+ << "residual = " << C * gev.V - S * gev.V * gev.D << vcl_endl;
+ double err = (C * gev.V - S * gev.V * gev.D).fro_norm();
+ vcl_cout << "Recomposition residual = " << err << vcl_endl;
+
+ testlib_test_assert("Recomposition residual < 1e-12", err < 1e-12);
+}
+
+TESTMAIN(test_generalized_eigensystem);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_include.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_include.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ca88fd4a61bc91e0dc39ccb32574a7197dce2d87
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_include.cxx
@@ -0,0 +1,42 @@
+#include <vnl/algo/vnl_algo_fwd.h>
+
+#include <vnl/algo/vnl_adaptsimpson_integral.h>
+#include <vnl/algo/vnl_adjugate.h>
+#include <vnl/algo/vnl_amoeba.h>
+#include <vnl/algo/vnl_brent.h>
+#include <vnl/algo/vnl_chi_squared.h>
+#include <vnl/algo/vnl_cholesky.h>
+#include <vnl/algo/vnl_complex_eigensystem.h>
+#include <vnl/algo/vnl_conjugate_gradient.h>
+#include <vnl/algo/vnl_convolve.h>
+#include <vnl/algo/vnl_cpoly_roots.h>
+#include <vnl/algo/vnl_determinant.h>
+#include <vnl/algo/vnl_discrete_diff.h>
+#include <vnl/algo/vnl_fft_1d.h>
+#include <vnl/algo/vnl_fft_2d.h>
+#include <vnl/algo/vnl_fft.h>
+#include <vnl/algo/vnl_gaussian_kernel_1d.h>
+#include <vnl/algo/vnl_generalized_eigensystem.h>
+#include <vnl/algo/vnl_generalized_schur.h>
+#include <vnl/algo/vnl_lbfgs.h>
+#include <vnl/algo/vnl_levenberg_marquardt.h>
+#include <vnl/algo/vnl_lsqr.h>
+#include <vnl/algo/vnl_matrix_inverse.h>
+#include <vnl/algo/vnl_netlib.h>
+#include <vnl/algo/vnl_orthogonal_complement.h>
+#include <vnl/algo/vnl_powell.h>
+#include <vnl/algo/vnl_qr.h>
+#include <vnl/algo/vnl_real_eigensystem.h>
+#include <vnl/algo/vnl_rnpoly_solve.h>
+#include <vnl/algo/vnl_rpoly_roots.h>
+#include <vnl/algo/vnl_scatter_3x3.h>
+#include <vnl/algo/vnl_simpson_integral.h>
+#include <vnl/algo/vnl_sparse_symmetric_eigensystem.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/algo/vnl_svd_economy.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+
+#include <vnl/algo/vnl_fft_base.h>
+#include <vnl/algo/vnl_fft_prime_factors.h>
+
+int main() { return 0; }
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_integral.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_integral.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1cdbf188d56b63485d7b7cb786490b7e9673cb22
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_integral.cxx
@@ -0,0 +1,115 @@
+#include <vcl_iostream.h>
+#include <vcl_cmath.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_analytic_integrant.h>
+#include <vnl/algo/vnl_simpson_integral.h>
+#include <vnl/algo/vnl_adaptsimpson_integral.h>
+#include <testlib/testlib_test.h>
+
+class my_test_integrant : public vnl_analytic_integrant
+{
+ public:
+ double f_(double x) { return x/(1+x*x); }
+};
+
+class gaussian_integrant : public vnl_analytic_integrant
+{
+ public:
+ gaussian_integrant(double sr, double sz, vnl_double_3 p0) : sr_(sr), sz_(sz), p0_(p0)
+
+ {
+
+ oneoversr2_ = 1 / vcl_pow(sr_, 2);
+
+ oneoversz2_ = 1 / vcl_pow(sz_, 2);
+
+ normalizer_ = -vcl_pow(sr_,2) / (sz_ * 2 * vcl_sqrt(2*vnl_math::pi));
+
+ }
+
+ void set_varying_params(double theta, double phi)
+
+ {
+
+ theta_ = theta;
+
+ phi_ = phi;
+
+ }
+
+ double f_(double rho)
+
+ {
+
+ double x2 = vcl_pow( p0_.get(0) + rho * vcl_sin(theta_) * vcl_cos(phi_), 2 );
+
+ double y2 = vcl_pow( p0_.get(1) + rho * vcl_sin(theta_) * vcl_sin(phi_), 2 );
+
+ double z2 = vcl_pow( p0_.get(2) + rho * vcl_cos(theta_), 2 );
+
+ double term1 = oneoversr2_ * ((x2 + y2) * oneoversr2_ - 2);
+
+ double term2 = vcl_exp(-(x2+y2)*oneoversr2_/2) * vcl_exp(-z2*oneoversz2_/2);
+
+ return (normalizer_ * term1 * term2);
+
+ }
+
+
+ protected:
+
+ // fixed parameters
+
+ double sr_;
+
+ double sz_;
+
+ vnl_double_3 p0_;
+
+ // varying parameters
+
+ double theta_;
+
+ double phi_;
+
+ // pre-calculated values to save computing time
+
+ double oneoversr2_;
+
+ double oneoversz2_;
+
+ double normalizer_;
+
+};
+
+
+void test_integral()
+{
+ my_test_integrant f;
+ vnl_simpson_integral simpson_integral;
+
+ double a = 0;
+ double b = 1;
+
+ TEST_NEAR("simpson integral of x/(1+x^2) from 0 to 1 is: ",
+ simpson_integral.integral(&f, a, b, 100), 0.5*vcl_log(2.0), 1e-6);
+
+ vnl_adaptsimpson_integral adaptsimpson_integral;
+
+ TEST_NEAR("adaptive simpson integral of x/(1+x^2) from 0 to 1 is: ",
+ adaptsimpson_integral.integral(&f, a, b, 1e-11f), 0.5*vcl_log(2.0), 1e-6);
+
+ gaussian_integrant filter_fnct(0.04, 0.1, vnl_double_3(0,0,0));
+ filter_fnct.set_varying_params(0, 0);
+
+ TEST_NEAR("simpson integral of a filter function from -10 to 10 is: ",
+ simpson_integral.integral(&filter_fnct, -10, 10, 1000), 1, 1e-6);
+
+
+ TEST_NEAR("adaptive simpson integral of a filter function from -10 to 10 is: ",
+ adaptsimpson_integral.integral(&filter_fnct, -10, 10, 1e-6), 1, 1e-6);
+
+}
+
+TESTMAIN( test_integral );
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_levenberg_marquardt.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_levenberg_marquardt.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fb5e84d5db96e4874ed3114494ae88a38f3c6ecc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_levenberg_marquardt.cxx
@@ -0,0 +1,136 @@
+// @author fsm
+#include <vnl/vnl_double_2.h>
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_least_squares_function.h>
+#include <vnl/algo/vnl_levenberg_marquardt.h>
+
+struct vnl_rosenbrock : public vnl_least_squares_function
+{
+ vnl_rosenbrock(bool with_grad): vnl_least_squares_function(2, 2, with_grad ? use_gradient : no_gradient) {}
+
+ void f(vnl_vector<double> const& x, vnl_vector<double>& y) {
+ //testlib_test_assert("size of x", x.size() == 2);
+ //testlib_test_assert("size of y", y.size() == 2);
+ y[0] = 10*(x[1] - x[0]*x[0]);
+ y[1] = 1 - x[0];
+ }
+
+ void gradf(vnl_vector<double> const& x, vnl_matrix<double> &J) {
+ //testlib_test_assert("size of x", x.size() == 2);
+ //testlib_test_assert("size of J", J.rows() == 2 && J.cols() == 2);
+ J[0][0] = -20 * x[0]; J[0][1] = 10;
+ J[1][0] = -1; J[1][1] = 0;
+ }
+};
+
+struct linear_est : public vnl_least_squares_function
+{
+ linear_est(vnl_matrix<double> const& A, vnl_vector<double> const& b, bool with_grad)
+ : vnl_least_squares_function(A.cols(), A.rows(), with_grad ? use_gradient : no_gradient),
+ A_(A), b_(b)
+ { assert(A.rows() == b.size()); }
+
+ void f(vnl_vector<double> const& x, vnl_vector<double>& y) {
+ y = A_*x -b_;
+ }
+
+ void gradf(vnl_vector<double> const& /*x*/, vnl_matrix<double> &J) {
+ J=A_;
+ }
+
+ vnl_matrix<double> A_;
+ vnl_vector<double> b_;
+};
+
+static
+void do_rosenbrock_test(bool with_grad)
+{
+ vnl_rosenbrock f(with_grad);
+
+ vnl_double_2 x0(2.7,-1.3);
+ vcl_cout << "x0 = " << x0 << vcl_endl;
+
+ vnl_levenberg_marquardt lm(f);
+
+ vnl_vector<double> x1 = x0.as_vector();
+ if (f.has_gradient())
+ lm.minimize_using_gradient(x1);
+ else
+ lm.minimize_without_gradient(x1);
+ lm.diagnose_outcome(vcl_cout);
+ vcl_cout << "x1 = " << x1 << vcl_endl;
+
+ double err = vcl_abs(x1[0] - 1) + vcl_abs(x1[1] - 1);
+ vcl_cout << "err = " << err << vcl_endl;
+ testlib_test_assert("converged to (1, 1)", err <= 1e-10);
+}
+
+static
+void do_linear_test( bool with_grad )
+{
+ vnl_matrix<double> A(6,2,1.0);
+ vnl_vector<double> b(6);
+
+ A(0,1) = 10;
+ A(1,1) = 15;
+ A(2,1) = 5.1;
+ A(3,1) = 20.2;
+ A(4,1) = -0.3;
+ A(5,1) = 25;
+
+ b(0) = 10;
+ b(1) = 15.5;
+ b(2) = 4.5;
+ b(3) = 21;
+ b(4) = 1;
+ b(5) = 24.3;
+
+ linear_est f(A, b, with_grad);
+ vnl_levenberg_marquardt lm(f);
+ vnl_vector<double> x(2,-1000.0); // init can be far off
+ // since obj function is linear
+ // high precision can be achieved
+ lm.set_x_tolerance(1e-12);
+ lm.set_f_tolerance(1e-12);
+ lm.set_g_tolerance(1e-12);
+
+ if (f.has_gradient())
+ lm.minimize_using_gradient(x);
+ else
+ lm.minimize_without_gradient(x);
+ lm.diagnose_outcome(vcl_cout);
+ vcl_cout << "x = " << x << vcl_endl;
+
+ vnl_vector<double> true_x(2);
+ true_x[1]=0.969684757298943;
+ true_x[0]=0.595607200429874;
+
+ TEST_NEAR( "converged to true estimate", (true_x-x).two_norm(), 0, 1e-6 );
+
+ // now check (inverse of) covariance approximation
+ vnl_matrix<double> true_cov(2,2);
+ true_cov(0,0)=6;
+ true_cov(1,0)=75;
+ true_cov(0,1)=75;
+ true_cov(1,1)=1384.14;
+
+ vnl_matrix<double> covar = lm.get_JtJ();
+ vcl_cout << "Cov(x) =\n" << covar << vcl_endl;
+ TEST_NEAR( "covariance approximation", (true_cov-covar).array_two_norm(), 0, 1e-5 );
+}
+
+static
+void test_levenberg_marquardt()
+{
+ do_rosenbrock_test(true);
+ do_rosenbrock_test(false);
+
+ do_linear_test(true);
+ do_linear_test(false);
+}
+
+TESTMAIN(test_levenberg_marquardt);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_minimizers.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_minimizers.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e9b4710ab54d8c0ba1c962d3383324895637675c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_minimizers.cxx
@@ -0,0 +1,32 @@
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_brent.h>
+
+#include <testlib/testlib_test.h>
+
+struct cubic : public vnl_cost_function {
+ cubic() : vnl_cost_function(1) {}
+
+ double f(const vnl_vector<double>& x) {
+ vcl_cout << ' ' << x[0];
+ return (2 - x[0]) * (2 - x[0]) + 10;
+ }
+};
+
+void test_minimizers()
+{
+ cubic c;
+ vnl_brent b(&c);
+ double x = 77;
+ vcl_cout << "brent1: ";
+ b.minimize_given_bounds(-100, x, 100, 1e-6, &x);
+ vcl_cout << vcl_endl;
+ TEST_NEAR("brent1", x, 2, 1e-5);
+ vcl_cout << "brent2: ";
+ x = 77;
+ x = b.minimize(x);
+ vcl_cout << vcl_endl;
+ TEST_NEAR("brent2", x, 2, 1e-5);
+}
+
+TESTMAIN(test_minimizers);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qr.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qr.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e4f4e569449f3fd9b488b61954d88f86ebdcdcfa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qr.cxx
@@ -0,0 +1,180 @@
+// This is core/vnl/algo/tests/test_qr.cxx
+#include "test_util.h"
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_random.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/algo/vnl_qr.h>
+
+//--------------------------------------------------------------------------------
+
+void test_matrix(char const* name, const vnl_matrix<double>& A, double det = 0)
+{
+ vnl_qr<double> qr(A);
+
+ vcl_string n(name); n+= ": ";
+ testlib_test_assert_near(n+"Q * R residual", (qr.Q() * qr.R() - A).fro_norm());
+ testlib_test_assert(n+"Q * Q = I", (qr.Q().transpose() * qr.Q()).is_identity(1e-12));
+
+ if (det)
+ testlib_test_assert_near(n+ "Determinant", qr.determinant(), det, 1e-9);
+}
+
+void double_test()
+{
+ double A_data[] = {
+ 89, 21, 27,
+ 62, 71, 0,
+ 84, 13, 41,
+ 16, 9, 3,
+ };
+ vnl_matrix<double> A(A_data, 4,3);
+
+ test_matrix("A", A);
+ test_matrix("AT", A.transpose());
+
+ test_matrix("A-102", A-102);
+ test_matrix("AT-12", A.transpose() - 12);
+
+ test_matrix("AA'*1e-3 - 1", A*A.transpose()*1e-3 - 1, -2.77433958399998);
+
+ double b_data[] = {
+ 68, 39, 39, 50
+ };
+
+ vnl_vector<double> b(b_data, 4);
+ vnl_qr<double> qr(A);
+
+ vnl_matlab_print(vcl_cout, qr.Q(), "Q");
+ vnl_matlab_print(vcl_cout, qr.R(), "R");
+
+ vnl_vector<double> x = qr.solve(b);
+
+ double res = (A * x - b).magnitude();
+
+ testlib_test_assert_near("Solve residual", res, 37.8841, 1e-3);
+
+ {
+ double S_data[] = {
+ 89, 21, 27,
+ 62, 71, 0,
+ 84, 13, 41,
+ };
+ vnl_matrix<double> S(S_data, 3,3);
+ test_matrix("S", S, 66431);
+ test_matrix("S-100", S-100, -79869);
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+inline float eps(float *) { return 1e-5f; }
+inline double eps(double *) { return 1e-12; }
+inline float eps(vcl_complex<float> *) { return 1e-5f; }
+inline double eps(vcl_complex<double> *) { return 1e-12; }
+#define rounding_epsilon(T) ::eps((T*)0)
+
+template <class T>
+void new_test(T *)
+{
+ vnl_random rng(1000);
+ unsigned m = 5; // m must be >= n when using the netlib QR algorithms,
+ unsigned n = 5; // but n >= m for a random A and b to have exact solution.
+
+ vnl_matrix<T> A(m, n);
+ test_util_fill_random(A.begin(), A.end(), rng);
+ vnl_matlab_print(vcl_cout, A, "A");
+
+ vnl_vector<T> b(m);
+ test_util_fill_random(b.begin(), b.end(), rng);
+ vnl_matlab_print(vcl_cout, b, "b");
+
+ vnl_qr<T> qr(A);
+ vnl_matrix<T> const &Q = qr.Q();
+ vnl_matrix<T> const &R = qr.R();
+ vnl_vector<T> x = qr.solve(b);
+
+ vnl_matlab_print(vcl_cout, Q, "Q");
+ vnl_matlab_print(vcl_cout, R, "R");
+ vnl_matlab_print(vcl_cout, x, "x");
+
+ vnl_matrix<T> QR(Q * R);
+ vnl_matlab_print(vcl_cout, QR, "QR");
+
+ vnl_matrix<T> I(m, m); I.set_identity();
+ testlib_test_assert_near("||Q'Q - 1||", (Q.conjugate_transpose()*Q - I).fro_norm(), 0, rounding_epsilon(T));
+ testlib_test_assert_near("||A - QR||", (A - QR).fro_norm(), 0, rounding_epsilon(T));
+ testlib_test_assert_near("||Ax - b||", (A*x - b).two_norm(), 0, rounding_epsilon(T));
+}
+
+#define inst(T) \
+template void new_test(T *);
+inst(float);
+inst(double);
+inst(vcl_complex<float>);
+inst(vcl_complex<double>);
+#undef inst
+
+void complex_test()
+{
+ typedef vcl_complex<double> ct;
+
+ vnl_matrix<ct> A(5,4); // #rows must be >= #cols when using netlib QR decomposition
+ vnl_vector<ct> b(5);
+
+ A(0,0)=ct( -0.1370,0.5573);
+ A(1,0)=ct( 0.6187,0.3482);
+ A(2,0)=ct( -0.4402,0.6825);
+ A(3,0)=ct( 0.7284,0.7294);
+ A(4,0)=ct( -0.5840,0.5004);
+ A(0,1)=ct( -0.4108,0.7201);
+ A(1,1)=ct( -0.5621,0.6056);
+ A(2,1)=ct( 0.4312,0.1262);
+ A(3,1)=ct( 0.9796,0.6049);
+ A(4,1)=ct( -0.1388,0.4999);
+ A(0,2)=ct( 0.7219,0.5105);
+ A(1,2)=ct( 0.9562,0.7896);
+ A(2,2)=ct( -0.1356,0.2092);
+ A(3,2)=ct( -0.0847,0.7457);
+ A(4,2)=ct( 0.9721,0.5243);
+ A(0,3)=ct( 0.2085,0.3057);
+ A(1,3)=ct( -0.0903,0.5162);
+ A(2,3)=ct( -0.8424,0.5799);
+ A(3,3)=ct( -0.6948,0.0472);
+ A(4,3)=ct( 0.8900,0.5085);
+
+ b(0)=ct( 0.9764,0.2280);
+ b(1)=ct( 0.5994,0.0454);
+ b(2)=ct(-0.2385,0.4884);
+ b(3)=ct( 0.0538,0.0402);
+ b(4)=ct( 1.8634,.64558);
+ vnl_matlab_print(vcl_cout, b, "b");
+ vnl_qr<ct> qr(A); vnl_matlab_print(vcl_cout, A, "A");
+ const vnl_matrix<ct>& Q = qr.Q(); vnl_matlab_print(vcl_cout, Q, "Q");
+ const vnl_matrix<ct>& R = qr.R(); vnl_matlab_print(vcl_cout, R, "R");
+ vnl_vector<ct> x = qr.solve(b); vnl_matlab_print(vcl_cout, x, "solve");
+ testlib_test_assert_near("||Ax - b||", (A*x - b).two_norm(), 0, 1e-5);
+}
+
+//--------------------------------------------------------------------------------
+
+extern "C" void test_qr()
+{
+ vcl_cout << "-------------------- double_complex\n";
+ complex_test();
+ vcl_cout << "-------------------- double\n";
+ double_test();
+
+ vcl_cout << "-------------------- float\n";
+ new_test((float*)0);
+ vcl_cout << "-------------------- double\n";
+ new_test((double*)0);
+ vcl_cout << "-------------------- float_complex\n";
+ new_test((vcl_complex<float>*)0);
+ vcl_cout << "-------------------- double_complex\n";
+ new_test((vcl_complex<double>*)0);
+}
+
+TESTMAIN(test_qr);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qsvd.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qsvd.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c9222ba015f8b21db22123000d0b3314d44d6259
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_qsvd.cxx
@@ -0,0 +1,50 @@
+#include <vnl/vnl_math.h> // vnl_math_abs()
+#include <testlib/testlib_test.h>
+#undef printf // to work around a bug in libintl.h
+#include <vcl_cstdio.h>
+
+extern "C"
+int sggsvd_(char const *jobu, char const *jobv, char const *jobq, int *m, int *n, int *p,
+ int *k, int *l, float *a, int *lda, float *b, int *ldb,
+ float *alpha, float *beta, float *u, int *ldu, float *v,
+ int *ldv, float *q, int *ldq, float *work, int *iwork,
+ int *info);
+
+static
+void test_qsvd() {
+ float AA[9]={2.f/3, -1.36f/3, .2f/3, 2.8f/3, .4f/3, 1.f/3, 1, .16f, -.2f};
+ float BB[9]={.16f, -.224f, -.768f, .8f, .36f, -.48f, 1.12f, -.168f, -.576f};
+ float U[9], V[9], Q[9], Alpha[3], Beta[3], Work[12];
+ int m=3, n=3, p=3, k, l, Iwork[3], info;
+
+ vcl_printf("m = 3, n = 3, p = 3\n");
+ sggsvd_("U", "V", "Q", &m, &n, &p, &k, &l, AA, &n, BB, &n, Alpha, Beta,
+ U, &n, V, &n, Q, &n, Work, Iwork, &info);
+
+ vcl_printf("k = %d, l = %d, return = %d\n", k, l, info);
+ testlib_test_assert("(k,l) must be (0,3)", k==0 && l==3);
+ testlib_test_assert("sggsvd should return 0", info==0);
+
+ vcl_printf("U = %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n",
+ U[0], U[3], U[6], U[1], U[4], U[7], U[2], U[5], U[8]);
+ vcl_printf("V = %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n",
+ V[0], V[3], V[6], V[1], V[4], V[7], V[2], V[5], V[8]);
+ vcl_printf("Q = %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n",
+ Q[0], Q[3], Q[6], Q[1], Q[4], Q[7], Q[2], Q[5], Q[8]);
+ vcl_printf("D1 = diag(%12g %12g %12g)\n", Alpha[0], Alpha[1], Alpha[2]);
+ vcl_printf("D2 = diag(%12g %12g %12g)\n", Beta[0], Beta[1], Beta[2]);
+ vcl_printf("R = %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n %12.7f %12.7f %12.7f\n",
+ AA[0], AA[3], AA[6], AA[1], AA[4], AA[7], AA[2], AA[5], AA[8]);
+
+ testlib_test_assert("D1 must be (0.6,0.8,0.6)",
+ vnl_math_abs(Alpha[0]-0.6)<1e-6 &&
+ vnl_math_abs(Alpha[1]-0.8)<1e-6 &&
+ vnl_math_abs(Alpha[2]-0.6)<1e-6);
+
+ testlib_test_assert("D2 must be (0.8,0.6,0.8)",
+ vnl_math_abs(Beta[0]-0.8)<1e-6 &&
+ vnl_math_abs(Beta[1]-0.6)<1e-6 &&
+ vnl_math_abs(Beta[2]-0.8)<1e-6);
+}
+
+TESTMAIN(test_qsvd);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rank.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rank.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d192c49115d8df9dad4b8209f06b0102c150ad65
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rank.cxx
@@ -0,0 +1,227 @@
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/vnl_rank.h>
+
+#include <testlib/testlib_test.h>
+
+inline int svd_rank(vnl_matrix<double> const& M) { return vnl_svd<double>(M, 1e-8).rank(); }
+
+void test_rank()
+{
+ // 1x1 double
+ vnl_matrix<double> m11(1,1, 0.0); // all zero matrix
+ TEST("zero_1x1.vnl_svd().rank()", svd_rank(m11), 0);
+ TEST("vnl_rank(zero_1x1)", vnl_rank(m11), 0);
+ m11[0][0] = -3.0;
+ TEST("-3_1x1.vnl_svd().rank()", svd_rank(m11), 1);
+ TEST("vnl_rank(-3_1x1)", vnl_rank(m11), 1);
+ TEST("vnl_rank(-3_1x1, vnl_rank_row)", vnl_rank(m11, vnl_rank_row), 1);
+ TEST("vnl_rank(-3_1x1, vnl_rank_column)", vnl_rank(m11, vnl_rank_column), 1);
+
+ // 1x1 int
+ vnl_matrix<int> i11(1,1, 0); // all zero matrix
+ TEST("vnl_rank(int_zero_1x1)", vnl_rank(i11), 0);
+ i11[0][0] = -3;
+ TEST("vnl_rank(int_-3_1x1)", vnl_rank(i11), 1);
+ TEST("vnl_rank(int_-3_1x1, vnl_rank_row)", vnl_rank(i11, vnl_rank_row), 1);
+ TEST("vnl_rank(int_-3_1x1, vnl_rank_column)", vnl_rank(i11, vnl_rank_column), 1);
+
+ // 1x2 double
+ vnl_matrix<double> m12(1,2, 0.0); // all zero matrix
+ TEST("zero_1x2.vnl_svd().rank()", svd_rank(m12), 0);
+ TEST("vnl_rank(zero_1x2)", vnl_rank(m12), 0);
+ TEST("vnl_rank(zero_1x2, vnl_rank_row)", vnl_rank(m12, vnl_rank_row), 0);
+ TEST("vnl_rank(zero_1x2, vnl_rank_column)", vnl_rank(m12, vnl_rank_column), 0);
+ m12[0][1] = -2.0;
+ TEST("0-2_1x2.vnl_svd().rank()", svd_rank(m12), 1);
+ TEST("vnl_rank(0-2_1x2)", vnl_rank(m12), 1);
+ TEST("vnl_rank(0-2_1x2, vnl_rank_row)", vnl_rank(m12, vnl_rank_row), 1);
+ TEST("vnl_rank(0-2_1x2, vnl_rank_column)", vnl_rank(m12, vnl_rank_column), 1);
+ m12[0][0] = 1.0;
+ TEST("1-2_1x2.vnl_svd().rank()", svd_rank(m12), 1);
+ TEST("vnl_rank(1-2_1x2)", vnl_rank(m12), 1);
+ TEST("vnl_rank(1-2_1x2, vnl_rank_row)", vnl_rank(m12, vnl_rank_row), 1);
+ TEST("vnl_rank(1-2_1x2, vnl_rank_column)", vnl_rank(m12, vnl_rank_column), 1);
+
+ // 1x2 int
+ vnl_matrix<int> i12(1,2, 0); // all zero matrix
+ TEST("vnl_rank(int_zero_1x2)", vnl_rank(i12), 0);
+ TEST("vnl_rank(int_zero_1x2, vnl_rank_row)", vnl_rank(i12, vnl_rank_row), 0);
+ TEST("vnl_rank(int_zero_1x2, vnl_rank_column)", vnl_rank(i12, vnl_rank_column), 0);
+ i12[0][1] = -2;
+ TEST("vnl_rank(int_0-2_1x2)", vnl_rank(i12), 1);
+ TEST("vnl_rank(int_0-2_1x2, vnl_rank_row)", vnl_rank(i12, vnl_rank_row), 1);
+ TEST("vnl_rank(int_0-2_1x2, vnl_rank_column)", vnl_rank(i12, vnl_rank_column), 1);
+ i12[0][0] = 1;
+ TEST("vnl_rank(int_1-2_1x2)", vnl_rank(i12), 1);
+ TEST("vnl_rank(int_1-2_1x2, vnl_rank_row)", vnl_rank(i12, vnl_rank_row), 1);
+ TEST("vnl_rank(int_1-2_1x2, vnl_rank_column)", vnl_rank(i12, vnl_rank_column), 1);
+
+ // 2x2 double
+ vnl_matrix<double> m22(2,2, 0.0); // all zero matrix
+ TEST("zero_2x2.vnl_svd().rank()", svd_rank(m22), 0);
+ TEST("vnl_rank(zero_2x2)", vnl_rank(m22), 0);
+ TEST("vnl_rank(zero_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 0);
+ TEST("vnl_rank(zero_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 0);
+ m22[0][1] = 6.0;
+ TEST("0300_2x2.vnl_svd().rank()", svd_rank(m22), 1);
+ TEST("vnl_rank(0600_2x2)", vnl_rank(m22), 1);
+ TEST("vnl_rank(0600_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 1);
+ TEST("vnl_rank(0600_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 1);
+ m22[1][0] = -1.0;
+ TEST("06-10_2x2.vnl_svd().rank()", svd_rank(m22), 2);
+ TEST("vnl_rank(06-10_2x2)", vnl_rank(m22), 2);
+ TEST("vnl_rank(06-10_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 2);
+ TEST("vnl_rank(06-10_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 2);
+ m22[0][0] = -2.0; m22[1][1] = 3.0;
+ TEST("-26-13_2x2.vnl_svd().rank()", svd_rank(m22), 1);
+ TEST("vnl_rank(-26-13_2x2)", vnl_rank(m22), 1);
+ TEST("vnl_rank(-26-13_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 1);
+ TEST("vnl_rank(-26-13_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 1);
+ m22[1][0] = -3.0; m22[1][1] = 9.0;
+ TEST("-26-39_2x2.vnl_svd().rank()", svd_rank(m22), 1);
+ TEST("vnl_rank(-26-39_2x2)", vnl_rank(m22), 1);
+ TEST("vnl_rank(-26-39_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 1);
+ TEST("vnl_rank(-26-39_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 1);
+ m22 *= 2.0; // now the pivot element will never be 1
+ TEST("-4_12_-6_18_2x2.vnl_svd().rank()", svd_rank(m22), 1);
+ TEST("vnl_rank(-4_12_-6_18_2x2)", vnl_rank(m22), 1);
+ TEST("vnl_rank(-4_12_-6_18_2x2, vnl_rank_row)", vnl_rank(m22, vnl_rank_row), 1);
+ TEST("vnl_rank(-4_12_-6_18_2x2, vnl_rank_column)", vnl_rank(m22, vnl_rank_column), 1);
+
+ // 2x2 int
+ vnl_matrix<int> i22(2,2, 0); // all zero matrix
+ TEST("vnl_rank(int_zero_2x2)", vnl_rank(i22), 0);
+ TEST("vnl_rank(int_zero_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 0);
+ TEST("vnl_rank(int_zero_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 0);
+ i22[0][1] = 6;
+ TEST("vnl_rank(int_0600_2x2)", vnl_rank(i22), 1);
+ TEST("vnl_rank(int_0600_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 1);
+ TEST("vnl_rank(int_0600_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 1);
+ i22[1][0] = -1;
+ TEST("vnl_rank(int_06-10_2x2)", vnl_rank(i22), 2);
+ TEST("vnl_rank(int_06-10_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 2);
+ TEST("vnl_rank(int_06-10_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 2);
+ i22[0][0] = -2; i22[1][1] = 3;
+ TEST("vnl_rank(int_-26-13_2x2)", vnl_rank(i22), 1);
+ TEST("vnl_rank(int_-26-13_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 1);
+ TEST("vnl_rank(int_-26-13_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 1);
+ i22[1][0] = -3; i22[1][1] = 9;
+ TEST("vnl_rank(int_-26-39_2x2)", vnl_rank(i22), 1);
+ TEST("vnl_rank(int_-26-39_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 1);
+ TEST("vnl_rank(int_-26-39_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 1);
+ i22 *= 2; // now the pivot element will never be 1
+ TEST("vnl_rank(-4_12_-6_18_2x2)", vnl_rank(i22), 1);
+ TEST("vnl_rank(-4_12_-6_18_2x2, vnl_rank_row)", vnl_rank(i22, vnl_rank_row), 1);
+ TEST("vnl_rank(-4_12_-6_18_2x2, vnl_rank_column)", vnl_rank(i22, vnl_rank_column), 1);
+
+ // 3x2 double
+ vnl_matrix<double> m32(3,2, 0.0); // all zero matrix
+ TEST("zero_3x2.vnl_svd().rank()", svd_rank(m32), 0);
+ TEST("vnl_rank(zero_3x2)", vnl_rank(m32), 0);
+ TEST("vnl_rank(zero_3x2, vnl_rank_row)", vnl_rank(m32, vnl_rank_row), 0);
+ TEST("vnl_rank(zero_3x2, vnl_rank_column)", vnl_rank(m32, vnl_rank_column), 0);
+ m32[0][1] = 6.0;
+ TEST("3x2.vnl_svd().rank()", svd_rank(m32), 1);
+ TEST("vnl_rank(3x2)", vnl_rank(m32), 1);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(m32, vnl_rank_row), 1);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(m32, vnl_rank_column), 1);
+ m32[2][0] = -1.0;
+ TEST("3x2.vnl_svd().rank()", svd_rank(m32), 2);
+ TEST("vnl_rank(3x2)", vnl_rank(m32), 2);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(m32, vnl_rank_row), 2);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(m32, vnl_rank_column), 2);
+ m32[1][0] = 3.0; m32[2][1] = 1.0;
+ TEST("3x2.vnl_svd().rank()", svd_rank(m32), 2);
+ TEST("vnl_rank(3x2)", vnl_rank(m32), 2);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(m32, vnl_rank_row), 2);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(m32, vnl_rank_column), 2);
+ m32[0][0] = -6.0; m32[1][1] = -3.0;
+ TEST("3x2.vnl_svd().rank()", svd_rank(m32), 1);
+ TEST("vnl_rank(3x2)", vnl_rank(m32), 1);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(m32, vnl_rank_row), 1);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(m32, vnl_rank_column), 1);
+ m32 *= 2.0;
+ TEST("3x2.vnl_svd().rank()", svd_rank(m32), 1);
+ TEST("vnl_rank(3x2)", vnl_rank(m32), 1);
+
+ // 3x2 int
+ vnl_matrix<int> i32(3,2, 0); // all zero matrix
+ TEST("vnl_rank(zero_3x2)", vnl_rank(i32), 0);
+ TEST("vnl_rank(zero_3x2, vnl_rank_row)", vnl_rank(i32, vnl_rank_row), 0);
+ TEST("vnl_rank(zero_3x2, vnl_rank_column)", vnl_rank(i32, vnl_rank_column), 0);
+ i32[0][1] = 6;
+ TEST("vnl_rank(3x2)", vnl_rank(i32), 1);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(i32, vnl_rank_row), 1);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(i32, vnl_rank_column), 1);
+ i32[2][0] = -1;
+ TEST("vnl_rank(3x2)", vnl_rank(i32), 2);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(i32, vnl_rank_row), 2);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(i32, vnl_rank_column), 2);
+ i32[1][0] = 3; i32[2][1] = 1;
+ TEST("vnl_rank(3x2)", vnl_rank(i32), 2);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(i32, vnl_rank_row), 2);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(i32, vnl_rank_column), 2);
+ i32[0][0] = -6; i32[1][1] = -3;
+ TEST("vnl_rank(3x2)", vnl_rank(i32), 1);
+ TEST("vnl_rank(3x2, vnl_rank_row)", vnl_rank(i32, vnl_rank_row), 1);
+ TEST("vnl_rank(3x2, vnl_rank_column)", vnl_rank(i32, vnl_rank_column), 1);
+ i32 *= 2;
+ TEST("vnl_rank(3x2)", vnl_rank(i32), 1);
+
+ // 3x3 double
+ vnl_matrix<double> m33(3,3, 0.0); // all zero matrix
+ TEST("zero_3x3.vnl_svd().rank()", svd_rank(m33), 0);
+ TEST("vnl_rank(zero_3x3)", vnl_rank(m33), 0);
+ TEST("vnl_rank(zero_3x3, vnl_rank_row)", vnl_rank(m33, vnl_rank_row), 0);
+ TEST("vnl_rank(zero_3x3, vnl_rank_column)", vnl_rank(m33, vnl_rank_column), 0);
+ m33[0][1] = 6.0; m33[0][2] = -2.0;
+ TEST("3x3.vnl_svd().rank()", svd_rank(m33), 1);
+ TEST("vnl_rank(3x3)", vnl_rank(m33), 1);
+ TEST("vnl_rank(3x3, vnl_rank_row)", vnl_rank(m33, vnl_rank_row), 1);
+ TEST("vnl_rank(3x3, vnl_rank_column)", vnl_rank(m33, vnl_rank_column), 1);
+ m33[1][2] = -1.0; m33[1][0] = 7.0;
+ TEST("3x3.vnl_svd().rank()", svd_rank(m33), 2);
+ TEST("vnl_rank(3x3)", vnl_rank(m33), 2);
+ TEST("vnl_rank(3x3, vnl_rank_row)", vnl_rank(m33, vnl_rank_row), 2);
+ TEST("vnl_rank(3x3, vnl_rank_column)", vnl_rank(m33, vnl_rank_column), 2);
+ m33[2][0] = 7.0;
+ TEST("3x3.vnl_svd().rank()", svd_rank(m33), 3);
+ TEST("vnl_rank(3x3)", vnl_rank(m33), 3);
+ TEST("vnl_rank(3x3, vnl_rank_row)", vnl_rank(m33, vnl_rank_row), 3);
+ TEST("vnl_rank(3x3, vnl_rank_column)", vnl_rank(m33, vnl_rank_column), 3);
+ m33[2][1] = 6.0; m33[2][2] = -3.0;
+ TEST("3x3.vnl_svd().rank()", svd_rank(m33), 2);
+ TEST("vnl_rank(3x3)", vnl_rank(m33), 2);
+ m33 *= 2.0;
+ TEST("3x3.vnl_svd().rank()", svd_rank(m33), 2);
+ TEST("vnl_rank(3x3)", vnl_rank(m33), 2);
+
+ // 3x3 int
+ vnl_matrix<int> i33(3,3, 0); // all zero matrix
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 0);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 0);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 0);
+ i33[0][1] = 6; i33[0][2] = -2;
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 1);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 1);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 1);
+ i33[1][2] = -1; i33[1][0] = 7;
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 2);
+ i33[2][0] = 7;
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 3);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 3);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 3);
+ i33[2][1] = 6; i33[2][2] = -3;
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 2);
+ i33 *= 2;
+ TEST("vnl_rank(int_3x3)", vnl_rank(i33), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_row)", vnl_rank(i33, vnl_rank_row), 2);
+ TEST("vnl_rank(int_3x3, vnl_rank_column)", vnl_rank(i33, vnl_rank_column), 2);
+}
+
+TESTMAIN(test_rank);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_real_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_real_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0d83684841779e420c6b6bf1984c338038e73a6c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_real_eigensystem.cxx
@@ -0,0 +1,73 @@
+// This is core/vnl/algo/tests/test_real_eigensystem.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Jan 96
+//
+//-----------------------------------------------------------------------------
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_complexify.h>
+#include <vnl/algo/vnl_real_eigensystem.h>
+
+static void test_6x6()
+{
+ double Sdata[36] = {
+ 30.0000, -3.4273, 13.9254, 13.7049, -2.4446, 20.2380,
+ -3.4273, 13.7049, -2.4446, 1.3659, 3.6702, -0.2282,
+ 13.9254, -2.4446, 20.2380, 3.6702, -0.2282, 28.6779,
+ 13.7049, 1.3659, 3.6702, 12.5273, -1.6045, 3.9419,
+ -2.4446, 3.6702, -0.2282, -1.6045, 3.9419, 2.5821,
+ 20.2380, -0.2282, 28.6779, 3.9419, 2.5821, 44.0636,
+ };
+ vnl_matrix<double> S(Sdata, 6,6);
+
+ vnl_real_eigensystem eig(S);
+ vnl_diag_matrix<vcl_complex<double> > D(eig.D.rows());
+ for (unsigned i = 0; i < eig.D.rows(); ++i)
+ {
+ testlib_test_assert("All real", vcl_imag(eig.D(i,i)) < 1e-15);
+ D(i,i) = vcl_real(eig.D(i,i));
+ }
+
+ vcl_cout << "D = " << eig.D << vcl_endl
+ << "V = " << eig.V << vcl_endl;
+
+ vnl_matrix<vcl_complex<double> > diff = vnl_complexify(S*eig.Vreal) - vnl_complexify(eig.Vreal)*D;
+ vcl_cout << "X*V - V*D = " << diff << vcl_endl
+ << "residual = " << diff.fro_norm() << vcl_endl;
+ testlib_test_assert("recompose residual", diff.fro_norm() < 1e-12);
+}
+
+static void test_4x4()
+{
+ // unsympathetic
+ double Xdata[] = {
+ 686, 526, 701, 47,
+ 588, 91, 910, 736,
+ 930, 653, 762, 328,
+ 846, 415, 262, 632
+ };
+ vnl_matrix<double> X(Xdata, 4, 4);
+
+ vnl_real_eigensystem eig(X);
+
+ vcl_cout << "D = " << eig.D << vcl_endl
+ << "V = " << eig.V << vcl_endl;
+
+ vnl_matrix<vcl_complex<double> > XC = vnl_complexify(X);
+
+ vnl_matrix<vcl_complex<double> > diff = XC*eig.V - eig.V*eig.D;
+ vcl_cout << "X*V - V*D = " << diff << vcl_endl
+ << "residual = " << diff.fro_norm() << vcl_endl;
+ testlib_test_assert("recompose residual", diff.fro_norm() < 1e-11);
+}
+
+static void test_real_eigensystem()
+{
+ test_6x6();
+ test_4x4();
+}
+
+TESTMAIN(test_real_eigensystem)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rnpoly_roots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rnpoly_roots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2a5d6cbe074d70851c4dcf43180770aa5232242d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rnpoly_roots.cxx
@@ -0,0 +1,92 @@
+#include <vcl_iostream.h>
+#include <vnl/vnl_real_npolynomial.h>
+#include <vnl/vnl_double_2.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/algo/vnl_rnpoly_solve.h>
+#include <testlib/testlib_test.h>
+
+static void test_rnpoly_roots()
+{
+ // Intersection of two unit circles, centered in (0,0) and in (1,0):
+
+ vnl_double_3 f1(1.0,1.0,-1.0);
+ vnl_matrix<unsigned int> p1(3,2, 0); p1(0,0) = 2; p1(1,1) = 2;
+ vnl_real_npolynomial poly1(f1,p1); vcl_cout << poly1; // X^2 +Y^2 -1
+
+ vnl_double_2 f2(1.0,-1.0);
+ vnl_matrix<unsigned int> p2(2,2, 0); p2(0,0) = 1;
+ vnl_real_npolynomial monom1(f2,p2); vcl_cout << monom1; // X-1
+
+ vnl_real_npolynomial poly2 = monom1 * monom1; // (X-1)^2
+ poly2 = poly2 - 1;
+
+ vnl_vector<double> f3(1, 1.0);
+ vnl_matrix<unsigned int> p3(1,2, 0); p3(0,1) = 2;
+ vnl_real_npolynomial monom3(f3,p3); // Y^2
+
+ poly2 = poly2 + monom3; vcl_cout << poly2; // (X-1)^2 +Y^2 -1 = X^2 -2X +Y^2
+
+ vcl_vector<vnl_vector<double>*>::iterator rp, ip;
+
+ vcl_vector<vnl_real_npolynomial*> l(1, &poly1); l.push_back(&poly2);
+ vnl_rnpoly_solve solver(l);
+
+ vcl_vector<vnl_vector<double>*> r = solver.realroots();
+ TEST("There should be two real roots", r.size(), 2);
+ for (rp = r.begin(); rp != r.end(); ++rp) {
+ vnl_vector<double>& root = *(*rp);
+ vcl_cout << root << vcl_endl;
+ TEST_NEAR("x==0.5", root[0], 0.5, 1e-9);
+ TEST_NEAR("y==sqrt(0.75)", root[1]*root[1], 0.75, 1e-9);
+ }
+ vcl_vector<vnl_vector<double>*> roots_r = solver.real();
+ vcl_vector<vnl_vector<double>*> roots_i = solver.imag();
+ TEST("and no more finite imaginary roots", roots_r.size(), 2);
+ TEST("and equally many imaginary parts", roots_i.size(), 2);
+ for (rp=roots_r.begin(),ip=roots_i.begin(); rp!=roots_r.end(); ++rp,++ip)
+ vcl_cout << " REAL " << *((*rp)) << " IMAG " << *((*ip)) << vcl_endl;
+
+ // Real intersection of two ellipses, both centered in (0,0):
+
+ f1(0) = 1; f1(1) = 2;
+ vnl_real_npolynomial poly3(f1,p1); vcl_cout << poly3; // X^2 +2 Y^2 -1
+
+ f1(0) = 2; f1(1) = 1;
+ vnl_real_npolynomial poly4(f1,p1); vcl_cout << poly4; // 2 X^2 +Y^2 -1
+
+ l.clear(); l.push_back(&poly3); l.push_back(&poly4);
+ vnl_rnpoly_solve solver2(l);
+
+ r = solver2.realroots();
+ TEST("There should be four real roots", r.size(), 4);
+ for (rp = r.begin(); rp != r.end(); ++rp)
+ {
+ vnl_vector<double>& root = *(*rp);
+ vcl_cout << root << vcl_endl;
+ TEST_NEAR("x==sqrt(1/3)", 3*root[0]*root[0], 1.0, 1e-9);
+ TEST_NEAR("y==sqrt(1/3)", 3*root[1]*root[1], 1.0, 1e-9);
+ }
+ roots_r = solver2.real(); roots_i = solver2.imag();
+ TEST("and no more imaginary roots", roots_r.size(), 4);
+ TEST("and equally many imaginary parts", roots_i.size(), 4);
+ for (rp=roots_r.begin(),ip=roots_i.begin(); rp!=roots_r.end(); ++rp,++ip)
+ vcl_cout << " REAL " << *((*rp)) << " IMAG " << *((*ip)) << vcl_endl;
+
+ // Imaginary intersection of two ellipses, both centered in (0,0):
+
+ f1(0) = 2; f1(1) = 3;
+ vnl_real_npolynomial poly5(f1,p1); vcl_cout << poly5; // 2 X^2 +3 Y^2 -1
+
+ l.clear(); l.push_back(&poly3); l.push_back(&poly5);
+ vnl_rnpoly_solve solver3(l);
+
+ r = solver3.realroots();
+ TEST("There should be no real roots", r.size(), 0);
+ TEST("and four imaginary roots", solver3.real().size(), 4);
+ TEST("and equally many imaginary parts", solver3.imag().size(), 4);
+ roots_r = solver3.real(); roots_i = solver3.imag();
+ for (rp=roots_r.begin(),ip=roots_i.begin(); rp!=roots_r.end(); ++rp,++ip)
+ vcl_cout << " REAL " << *((*rp)) << " IMAG " << *((*ip)) << vcl_endl;
+}
+
+TESTMAIN(test_rnpoly_roots);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rpoly_roots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rpoly_roots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..99982bc2d8dec9e001d0e4938f2e997940943cf4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_rpoly_roots.cxx
@@ -0,0 +1,23 @@
+#include <vnl/vnl_real_polynomial.h>
+#include <vnl/algo/vnl_rpoly_roots.h>
+
+#include <testlib/testlib_test.h>
+
+void test_rpoly_roots()
+{
+ double coeffs[] = {5, 4, 3, 2, 1};
+ vnl_vector<double> a(coeffs, 5);
+
+ vnl_rpoly_roots roots(a);
+
+ testlib_test_assert("Result sizes", (roots.real().size() == 4) && (roots.imag().size() == 4));
+ testlib_test_assert("Complex size", (roots.roots().size() == 4));
+ //testlib_test_assert("degree", roots.degree() == 4);
+
+ // Evaluate results
+ vnl_real_polynomial p(a);
+ for (int i = 0; i < p.degree(); ++i)
+ testlib_test_assert("Root residual", vcl_abs(p.evaluate(roots[i])) < 1e-12);
+}
+
+TESTMAIN(test_rpoly_roots);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_sparse_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_sparse_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ad76660be3d34c400843626f9e0b601486165917
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_sparse_matrix.cxx
@@ -0,0 +1,175 @@
+// This is core/vnl/algo/tests/test_sparse_matrix.cxx
+#include <vcl_ctime.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_sparse_matrix.h>
+#include <vnl/algo/vnl_sparse_symmetric_eigensystem.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+
+#include <testlib/testlib_test.h>
+
+// Test the sparse matrix operations.
+void doTest1()
+{
+ const unsigned int n = 20;
+
+ vnl_sparse_matrix<double> m1(n,n);
+ for (unsigned i=0; i<n; i++) {
+ m1(i,i) = 2.0;
+ m1(i,(i+3)%n) = 1.0;
+ }
+
+ vcl_cout << "m1:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << m1(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ vnl_sparse_matrix<double> m2(n,n);
+ for (unsigned i=0; i<n; i++) {
+ m2(i,i) = 2.0;
+ m2(i,(i+n-3)%n) = 1.0;
+ }
+
+ vcl_cout << "m2:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << m2(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ vnl_sparse_matrix<double> prod;
+ m1.mult(m2,prod);
+
+ vcl_cout << "prod:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << prod(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ vnl_sparse_matrix<double> sum;
+ m1.add(m2,sum);
+
+ vcl_cout << "sum:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << sum(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ vnl_sparse_matrix<double> diff;
+ m1.subtract(m2,diff);
+
+ vcl_cout << "diff:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << diff(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+}
+
+void doTest2()
+{
+ vcl_clock_t t = vcl_clock();
+ for (unsigned int n = 1000; n<4000; n+=1000)
+ {
+ vnl_sparse_matrix<double> m1(n,n);
+ for (unsigned i=0; i<n; i++) {
+ m1(i,i) = 2.0;
+ m1(i,(i+3)%n) = 1.0;
+ }
+
+ vnl_sparse_matrix<double> m2(n,n);
+ for (unsigned i=0; i<n; i++) {
+ m2(i,i) = 2.0;
+ m2(i,(i+n-3)%n) = 1.0;
+ }
+
+ vnl_sparse_matrix<double> prod;
+ m1.mult(m2,prod);
+
+ vcl_clock_t tn = vcl_clock();
+ vcl_cout << n << ' ' << tn - t << vcl_endl;
+ t = tn;
+ }
+}
+
+void doTest3()
+{
+ const unsigned int n = 20;
+
+ vnl_sparse_matrix<double> ms(n,n);
+ vnl_matrix<double> md(n,n); md = 0.0; // Initialise to all zeros
+ // The matrix must be symmetric
+ for (unsigned i=0; i<n; i++) {
+ ms(i,i) = md(i,i) = i+1.0;
+ ms(i,(i+3)%n) = md(i,(i+3)%n) = 1.0;
+ ms(i,(i+n-3)%n) = md(i,(i+n-3)%n) = 1.0;
+ // ms(i,i) = md(i,i) = 1.0*(i+1)*(i+1);
+ }
+
+ vcl_cout << "ms:\n";
+ for (unsigned i=0; i<n; i++) {
+ for (unsigned j=0; j<n; j++)
+ vcl_cout << ms(i,j) << ' ';
+ vcl_cout << vcl_endl;
+ }
+ vcl_cout << "md:\n" << md << vcl_endl;
+
+ const unsigned int nvals = 2;
+ vnl_symmetric_eigensystem<double> ed(md);
+ vnl_sparse_symmetric_eigensystem es;
+ TEST ("vnl_sparse_symmetric_eigensystem::CalculateNPairs()",
+ es.CalculateNPairs(ms,nvals,true,20), 0);
+
+ // Report 'em.
+ for (unsigned i=0; i<nvals; i++) {
+ vcl_cout << "Dense[" << i << "] : " << ed.D(i,i) << " -> "
+ << ed.get_eigenvector(i) << vcl_endl
+ << "Sparse[" << i << "]: " << es.get_eigenvalue(i) << " -> "
+ << es.get_eigenvector(i) << vcl_endl;
+ }
+}
+
+void doTest4()
+{
+ const unsigned int n = 20;
+
+ vnl_sparse_matrix<double> ms(n,n);
+ vnl_matrix<double> md(n,n); md = 0.0; // Initialise to all zeros
+ // The matrix must be symmetric
+ for (unsigned i=0; i<n; i++) {
+ ms(i,i) = md(i,i) = i+1.0;
+ ms(i,(i+3)%n) = md(i,(i+3)%n) = 1.0;
+ ms(i,(i+n-3)%n) = md(i,(i+n-3)%n) = 1.0;
+ // ms(i,i) = md(i,i) = 1.0*(i+1)*(i+1);
+ }
+
+ const unsigned int nvals = 3;
+ vnl_symmetric_eigensystem<double> ed(md);
+ vnl_sparse_symmetric_eigensystem es;
+ TEST("vnl_sparse_symmetric_eigensystem::CalculateNPairs() succeeded",
+ es.CalculateNPairs(ms,nvals), 0);
+
+ // Report 'em.
+ for (unsigned i=0; i<nvals; i++)
+ {
+ double dense = ed.D(i,i);
+ double sparse = es.get_eigenvalue(i);
+ vcl_cout << "Dense[" << i << "] : " << dense << vcl_endl
+ << "Sparse[" << i << "]: " << sparse << vcl_endl;
+ double err = sparse - dense;
+ TEST_NEAR("vnl_sparse_symmetric_eigensystem eigenvalue difference", err, 0.0, 1e-10);
+ }
+}
+
+static void test_sparse_matrix()
+{
+ vcl_cout << "Starting test 1\n"; doTest1();
+ vcl_cout << "Starting test 2\n"; doTest2();
+ vcl_cout << "Starting test 3\n"; doTest3();
+ vcl_cout << "Starting test 4\n"; doTest4();
+}
+
+TESTMAIN(test_sparse_matrix);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_svd.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_svd.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f95841c82d73735cd11feda23998218b5eef6949
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_svd.cxx
@@ -0,0 +1,233 @@
+// This is core/vnl/algo/tests/test_svd.cxx
+#include "test_util.h"
+//:
+// \file
+#include <testlib/testlib_test.h>
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_random.h>
+#include <vnl/algo/vnl_svd.h>
+
+//: Solve LS problem M x = B, warning if M is nearly singular.
+vnl_matrix<double> solve_with_warning(const vnl_matrix<double>& M,
+ const vnl_matrix<double>& B)
+{
+ // Take svd of vnl_matrix<double> M, trim the singular values at 1e-8,
+ // and hold the result.
+ vnl_svd<double> svd(M, 1e-8);
+ // Check for rank-deficiency
+ if (svd.singularities() > 1)
+ vcl_cout << "Warning: Singular matrix, condition = " << svd.well_condition() << vcl_endl;
+ return svd.solve(B);
+}
+
+template <class T, class S>
+void test_hilbert(T /*dummy*/, char const* type, S residual)
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ // Test inversion and recomposition of 5x5 hilbert matrix
+ vnl_matrix<T> H(5,5);
+ for (int i = 0; i < 5; ++i)
+ for (int j = 0; j < 5; ++j)
+ H(i,j) = T(1) / T(abs_t(i+j+1)); // sic, because i,j are zero based
+
+ vcl_cout << "H = <"<<type<<">[ " << H << "]\n";
+
+ vnl_svd<T> svd(H);
+
+ vcl_cout << "rcond(H) = " << svd.well_condition() << vcl_endl;
+
+ vnl_matrix<T> Hinv = svd.inverse();
+
+ vnl_matrix<T> X = Hinv * H;
+
+ vcl_cout << "H*inv(H) = " << X << vcl_endl;
+
+ vnl_matrix<T> I(5,5);
+ I = 0.0;
+ I.fill_diagonal(1.0);
+
+ vnl_matrix<T> res = X - I;
+ vcl_cout << "Hilbert recomposition residual = " << res.fro_norm() << vcl_endl;
+ testlib_test_assert("Hilbert recomposition residual", res.fro_norm() < residual);
+}
+
+//: Test recovery of parameters of least-squares parabola fit.
+void test_ls()
+{
+ double a = 0.15;
+ double b = 1.2;
+ double c = 3.1;
+
+ // Generate parabola design matrix
+ vnl_matrix<double> D(100, 3);
+ for (int n = 0; n < 100; ++n)
+ {
+ double x = n;
+ D(n, 0) = x*x;
+ D(n, 1) = x;
+ D(n, 2) = 1.0;
+ }
+
+ // Generate Y vector
+ vnl_vector<double> y(100);
+ for (int n = 0; n < 100; ++n)
+ {
+ double x = n;
+ double fx = a * x * x + b * x + c;
+ // Add sawtooth "noise"
+ y(n) = fx + (n%4 - 2) / 10.0;
+ }
+ vcl_cout << "y = [" << y << "]\n";
+
+ // Extract vnl_svd<double>
+ vnl_svd<double> svd(D);
+
+ // Solve for parameters
+ vnl_double_3 A = svd.solve(y);
+ vcl_cout << "A = " << A << '\n';
+
+ vnl_double_3 T(a,b,c);
+ vcl_cout << "residual = " << (A - T).squared_magnitude() << vcl_endl;
+ testlib_test_assert("Least squares residual", (A - T).squared_magnitude() < 0.005);
+}
+
+// temporarily unused
+double test_fmatrix()
+{
+ double pdata[] = {
+ 2, 0, 0, 0,
+ 3, 10, 5, 5,
+ 5, 12, 6, 6,
+ };
+ vnl_matrix<double> P(pdata, 3,4);
+ vnl_svd<double> svd(P);
+ vnl_matrix<double> N = svd.nullspace();
+ vcl_cout << "null(P) = " << N << vcl_endl
+ << "P * null(P) = " << P*N << vcl_endl;
+
+ return dot_product(P*N, P*N);
+}
+
+//: Test nullspace extraction of rank=2 3x4 matrix.
+void test_pmatrix()
+{
+ double pdata[] = {
+ 2, 0, 0, 0,
+ 3, 10, 5, 5,
+ 5, 12, 6, 6,
+ };
+ vnl_matrix<double> P(pdata, 3,4);
+ vnl_svd<double> svd(P, 1e-8);
+
+ vnl_matrix<double> res = svd.recompose() - P;
+ vcl_cout << "Recomposition residual = " << res.fro_norm() << vcl_endl;
+ testlib_test_assert("PMatrix recomposition residual", res.fro_norm() < 1e-12);
+ vcl_cout << " Inv = " << svd.inverse() << vcl_endl;
+
+ testlib_test_assert("singularities = 2", svd.singularities() == 2);
+ testlib_test_assert("rank = 2", svd.rank() == 2);
+
+ vnl_matrix<double> N = svd.nullspace();
+ testlib_test_assert("nullspace dimension", N.columns() == 2);
+ vcl_cout << "null(P) =\n" << N << vcl_endl;
+
+ vnl_matrix<double> PN = P*N;
+ vcl_cout << "P * null(P) =\n" << PN << vcl_endl
+ << "nullspace residual = " << PN.fro_norm() << vcl_endl;
+ testlib_test_assert("P nullspace residual", PN.fro_norm() < 1e-12);
+
+ vnl_vector<double> n = svd.nullvector();
+ vcl_cout << "nullvector residual = " << (P*n).magnitude() << vcl_endl;
+ testlib_test_assert("P nullvector residual", (P*n).magnitude() < 1e-12);
+
+ vnl_vector<double> l = svd.left_nullvector();
+ vcl_cout << "left_nullvector(P) = " << l << vcl_endl
+ << "left_nullvector residual = " << (l*P).magnitude() << vcl_endl;
+ testlib_test_assert("P left nullvector residual", (l*P).magnitude() < 1e-12);
+}
+
+void test_I()
+{
+ double Idata[] = {
+ 1, 0, 0, 0,
+ 0, 1, 0, 0,
+ 0, 0, 1, 0,
+ };
+ vnl_matrix<double> P(3, 4, 12, Idata);
+ vnl_svd<double> svd(P);
+ vcl_cout << svd;
+}
+
+template <class T>
+void test_svd_recomposition(char const *type, double maxres, T* /* tag */, vnl_random &rng)
+{
+ // Test inversion of 5x5 matrix of T :
+ vcl_cout << "----- testing vnl_svd<" << type << "> recomposition -----\n";
+
+ vnl_matrix<T> A(5,5);
+ test_util_fill_random(A.begin(), A.end(), rng);
+
+ vcl_cout << "A = [\n" << A << "]\n";
+ vnl_svd<T> svd(A);
+
+ vnl_matrix<T> B=svd.recompose();
+ vcl_cout << "B = [\n" << B << "]\n";
+
+ double residual=(A - B).fro_norm();
+ vcl_cout << "residual=" << residual << vcl_endl;
+ testlib_test_assert("vnl_svd<float> recomposition residual", residual < maxres);
+}
+
+template void test_svd_recomposition(char const *, double, float *, vnl_random &rng);
+template void test_svd_recomposition(char const *, double, double *, vnl_random &rng);
+template void test_svd_recomposition(char const *, double, vcl_complex<float> *, vnl_random &rng);
+template void test_svd_recomposition(char const *, double, vcl_complex<double> *, vnl_random &rng);
+
+#include <vnl/vnl_matlab_print.h>
+template <class T>
+void test_nullvector(char const *type, T *, vnl_random &rng)
+{
+ int n = 5;
+ vnl_matrix<T> A(n, n+1);
+ test_util_fill_random(A.begin(), A.end(), rng);
+ vnl_svd<T> svd(A);
+ vnl_vector<T> x = svd.nullvector();
+ vnl_vector<T> Ax = A*x;
+ vcl_cout << __FILE__ ": type = " << type << vcl_endl;
+ vnl_matlab_print(vcl_cout, A, "A", vnl_matlab_print_format_long);
+ vcl_cout << __FILE__ ": || x|| = " << x.two_norm() << vcl_endl
+ << __FILE__ ": ||Ax|| = " << Ax.two_norm() << vcl_endl;
+}
+
+template void test_nullvector(char const *, float *, vnl_random &rng);
+template void test_nullvector(char const *, double *, vnl_random &rng);
+template void test_nullvector(char const *, vcl_complex<float> *, vnl_random &rng);
+template void test_nullvector(char const *, vcl_complex<double> *, vnl_random &rng);
+
+// Driver
+void test_svd()
+{
+ vnl_random rng;
+ test_hilbert(double(), "double", 1.1e-10);
+ test_hilbert(float(), "float", float(0.025));
+ test_hilbert(vcl_complex<double>(), "vcl_complex<double>", double(4.4e-10));
+ test_hilbert(vcl_complex<float>(), "vcl_complex<float>", float(0.04));
+ test_ls();
+ test_pmatrix();
+ test_I();
+ test_svd_recomposition("float", 1e-5 , (float*)0, rng);
+ test_svd_recomposition("double", 1e-10, (double*)0, rng);
+ test_svd_recomposition("vcl_complex<float>", 1e-5 , (vcl_complex<float>*)0, rng);
+ test_svd_recomposition("vcl_complex<double>", 1e-10, (vcl_complex<double>*)0, rng);
+
+ test_nullvector("float", (float*)0, rng);
+ test_nullvector("double", (double*)0, rng);
+ test_nullvector("vcl_complex<float>", (vcl_complex<float>*)0, rng);
+ test_nullvector("vcl_complex<double>", (vcl_complex<double>*)0, rng);
+}
+
+TESTMAIN(test_svd);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_symmetric_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_symmetric_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d487385202f127405cc6fd087e024fd87f80c352
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_symmetric_eigensystem.cxx
@@ -0,0 +1,173 @@
+// This is core/vnl/algo/tests/test_symmetric_eigensystem.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \brief test program for symmetric eigensystem routines.
+// \author Andrew W. Fitzgibbon, Oxford RRG.
+// \date 29 Aug 96
+
+//-----------------------------------------------------------------------------
+
+
+#include <vcl_iostream.h>
+#include <vcl_algorithm.h>
+#include <vnl/vnl_double_3x3.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_random.h>
+#include <vul/vul_timer.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+
+//extern "C"
+void test_symmetric_eigensystem()
+{
+ double Sdata[36] = {
+ 30.0000, -3.4273, 13.9254, 13.7049, -2.4446, 20.2380,
+ -3.4273, 13.7049, -2.4446, 1.3659, 3.6702, -0.2282,
+ 13.9254, -2.4446, 20.2380, 3.6702, -0.2282, 28.6779,
+ 13.7049, 1.3659, 3.6702, 12.5273, -1.6045, 3.9419,
+ -2.4446, 3.6702, -0.2282, -1.6045, 3.9419, 2.5821,
+ 20.2380, -0.2282, 28.6779, 3.9419, 2.5821, 44.0636,
+ };
+ vnl_matrix<double> S(Sdata, 6,6);
+
+ {
+ vnl_symmetric_eigensystem<double> eig(S);
+ vnl_matrix<double> res = eig.recompose() - S;
+ vcl_cout << "V'*D*V - S = " << res << vcl_endl
+ << "residual = " << res.fro_norm() << vcl_endl;
+ testlib_test_assert("recompose residual", res.fro_norm() < 1e-12);
+
+ vcl_cout<<"Eigenvalues: ";
+ for (int i=0;i<6;++i)
+ vcl_cout << eig.get_eigenvalue(i) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ double Cdata[36] = {
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 2,
+ 0, 0, 0, 0, -1, 0,
+ 0, 0, 0, 2, 0, 0,
+ };
+
+ vnl_matrix<double> C(Cdata, 6,6);
+
+ {
+ vnl_symmetric_eigensystem<double> eig(C);
+ vnl_matrix<double> res = eig.recompose() - C;
+ vcl_cout << "V'*D*V - C = " << res << vcl_endl
+ << "residual = " << res.fro_norm() << vcl_endl;
+ testlib_test_assert("recompose residual", res.fro_norm() < 1e-12);
+
+ vcl_cout<<"Eigenvalues: ";
+ for (int i=0;i<6;++i)
+ vcl_cout << eig.get_eigenvalue(i) << ' ';
+ vcl_cout << vcl_endl;
+ }
+
+ {
+ // Generate a random system
+ vnl_random rng;
+ int n = 6;
+ int s = 10;
+ vnl_matrix<double> D_rand(s,n);
+ for (int i=0;i<s;++i)
+ for (int j=0;j<n;++j)
+ D_rand(i,j) = 1.0 + 2.0*rng.normal64();
+
+ vnl_matrix<double> S = D_rand.transpose() * D_rand;
+ vnl_matrix<double> evecs(n,n);
+ vnl_vector<double> evals(n);
+ vnl_symmetric_eigensystem_compute(S,evecs,evals);
+ vcl_cout << "Testing random system:\n"
+ << "evals: "<<evals<<vcl_endl;
+ for (int i=1;i<n;++i)
+ {
+ TEST("Eigenvalue increases", evals(i) >= evals(i-1), true);
+ }
+ }
+
+ { // test I with specialised 3x3 version
+ double l1, l2, l3;
+ vnl_symmetric_eigensystem_compute_eigenvals(1.0, 0.0, 0.0, 1.0, 0.0, 1.0,
+ l1, l2, l3);
+ vcl_cout << "Eigenvals: " << l1 << ' ' << l2 << ' ' << l3 << vcl_endl;
+ TEST("Correct eigenvalues for I", l1==1.0 && l2==1.0 && l3 ==1.0, true);
+ }
+
+ { // compare speed and values of specialised 3x3 version with nxn version
+ vul_timer timer;
+ int netlib_time, fixed_time;
+ const unsigned n = 20000;
+ double fixed_data[n][3];
+ double netlib_data[n][3];
+
+ {
+ double M11, M12, M13, M22, M23, M33;
+ // Generate a random system
+ vnl_random rng(5);
+
+ timer.mark();
+ for (unsigned c = 0; c < n; ++c)
+ {
+ M11 = rng.drand64()*10.0-5.0; M12 = rng.drand64()*10.0-5.0; M13 = rng.drand64()*10.0-5.0;
+ M22 = rng.drand64()*10.0-5.0; M23 = rng.drand64()*10.0-5.0;
+ M33 = rng.drand64()*10.0-5.0;
+ vnl_symmetric_eigensystem_compute_eigenvals(M11, M12, M13, M22, M23, M33,
+ fixed_data[c][0], fixed_data[c][1], fixed_data[c][2]);
+ }
+ fixed_time = timer.user();
+ }
+
+ {
+ // Generate same random system
+ vnl_random rng(5);
+ vnl_double_3x3 M, evecs;
+ vnl_double_3 evals;
+
+ timer.mark();
+ for (unsigned c = 0; c < n; ++c)
+ {
+ M(0,0)=rng.drand64()*10.0-5.0; M(1,0)=M(0,1)=rng.drand64()*10.0-5.0; M(2,0)=M(0,2)= rng.drand64()*10.0-5.0;
+ M(1,1)=rng.drand64()*10.0-5.0; M(2,1)=M(1,2)=rng.drand64()*10.0-5.0;
+ M(2,2) = rng.drand64()*10.0-5.0;
+
+ vnl_symmetric_eigensystem_compute(M.as_ref(), evecs.as_ref().non_const(), evals.as_ref().non_const());
+ netlib_data[c][0] = evals[0];
+ netlib_data[c][1] = evals[1];
+ netlib_data[c][2] = evals[2];
+ }
+ netlib_time = timer.user();
+ }
+
+ vcl_cout << "Fixed Time: " << fixed_time << " netlib time: " <<netlib_time<<vcl_endl;
+ TEST("Specialised version is faster", fixed_time < netlib_time, true);
+
+ double sum_dsq=0.0;
+ double max_dsq=0.0;
+ for (unsigned c = 0; c < n; ++c)
+ {
+ const double dsq = vnl_c_vector<double>::euclid_dist_sq(netlib_data[c], fixed_data[c],3);
+ max_dsq = vcl_max(dsq,max_dsq);
+ sum_dsq += dsq;
+ }
+ vcl_cout << "max_dsq: " <<max_dsq<<" mean_dsq: "<<sum_dsq/static_cast<double>(n)<<vcl_endl;
+ TEST("Specialised version gives similar results", max_dsq < 1e-8, true);
+ }
+
+ {
+ double v1, v2, v3;
+ vnl_symmetric_eigensystem_compute_eigenvals(
+ 4199.0, 0.0, 0.0, 4199.0, 0.0, 4801.0, v1, v2, v3);
+ vcl_cout << v1 << " " << v2 << " " << v3 << vcl_endl;
+ TEST_NEAR("Numerically diificult values are ok 1a", v1, 4199, 1e-7);
+ TEST_NEAR("Numerically diificult values are ok 1b", v2, 4199, 1e-7);
+ TEST_NEAR("Numerically diificult values are ok 1c", v3, 4801, 1e-7);
+ }
+
+}
+
+TESTMAIN(test_symmetric_eigensystem);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cfddd781c2b578dc110ce395e50cc937c3b4f254
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.cxx
@@ -0,0 +1,20 @@
+// This is core/vnl/algo/tests/test_util.cxx
+#include <vcl_complex.h>
+#include <vnl/vnl_random.h>
+
+#define macro(T) \
+void test_util_fill_random(T *b, T *e, vnl_random &rng) \
+{ \
+ for (T *p=b; p<e; ++p) \
+ *p = (T)rng.drand64(-1.0, +1.0); \
+} \
+void test_util_fill_random(vcl_complex<T> *b, vcl_complex<T> *e, vnl_random &rng) \
+{ \
+ for (vcl_complex<T> *p=b; p<e; ++p) \
+ *p = vcl_complex<T>((T)rng.drand64(-1.0, +1.0), (T)rng.drand64(-1.0, +1.0)); \
+}
+
+macro(float);
+macro(double);
+macro(long double);
+#undef macro
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.h
new file mode 100644
index 0000000000000000000000000000000000000000..d817091c4eade6dcb75b31b9a3460d9a73b3a86a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/tests/test_util.h
@@ -0,0 +1,15 @@
+#ifndef test_util_h_
+#define test_util_h_
+
+class vnl_random;
+#include <vcl_complex.h>
+#define macro(T) void test_util_fill_random(T *begin, T *end, vnl_random &rng)
+macro(float);
+macro(double);
+macro(long double);
+macro(vcl_complex<float>);
+macro(vcl_complex<double>);
+macro(vcl_complex<long double>);
+#undef macro
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d513888e8920fb222e3e03bb2cf12bd39d19082e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.cxx
@@ -0,0 +1,50 @@
+#include "vnl_adaptsimpson_integral.h"
+#include <vcl_iostream.h>
+#include <vcl_cmath.h>
+
+double vnl_adaptsimpson_integral::int_fnct_(double* x)
+{
+ return pfnct_->f_(*x);
+}
+
+double vnl_adaptsimpson_integral::integral(vnl_integrant_fnct* f, double a,
+ double b, double acury)
+{
+ //set the function
+ pfnct_ = f;
+
+ return adaptivesimpson(&vnl_adaptsimpson_integral::int_fnct_, a, b, acury, 0, deepth_);
+}
+
+double vnl_adaptsimpson_integral::adaptivesimpson(double(*f)(double*),
+ double a, double b, double eps, int level, int level_max)
+{
+ double c, d, e, h, result;
+ double one_simpson, two_simpson;
+ double left_simpson, right_simpson;
+
+ h = b-a;
+ c = 0.5*(a+b);
+ one_simpson = h*(f(&a)+4.0*f(&c)+f(&b))/6.0;
+ d = 0.5*(a+c);
+ e = 0.5*(c+b);
+ two_simpson = h*(f(&a)+4.0*f(&d)+2.0*f(&c)+4.0*f(&e)+f(&b))/12.0;
+ /* Check for level */
+ if (level+1 >= level_max) {
+ result = two_simpson;
+ vcl_cerr<< "Maximum level reached\n";
+ }
+ else {
+ /* Check for desired accuracy */
+ if (vcl_fabs(two_simpson-one_simpson) < 15.0*eps)
+ result = two_simpson + (two_simpson-one_simpson)/15.0;
+ /* Divide further */
+ else {
+ left_simpson = adaptivesimpson(f,a,c,eps/2.0,level+1,level_max);
+ right_simpson = adaptivesimpson(f,c,b,eps/2.0,level+1,level_max);
+ result = left_simpson + right_simpson;
+ }
+ }
+ return result;
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.h
new file mode 100644
index 0000000000000000000000000000000000000000..5395b65e80de8b560fd93e6e547a3dfbf9cd366e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adaptsimpson_integral.h
@@ -0,0 +1,33 @@
+#ifndef VNL_ADAPTSIMPSON_INTEGRAL_H_
+#define VNL_ADAPTSIMPSON_INTEGRAL_H_
+//:
+// \file
+// \author Kongbin Kang at Brown
+// \date Jan. 17th, 2005
+//
+#include <vnl/vnl_definite_integral.h>
+
+class vnl_adaptsimpson_integral : public vnl_definite_integral
+{
+ private:
+ //: used to wrap the function class to an ordinary function.
+ static double int_fnct_(double* x);
+
+ protected:
+
+ //: maximum recursion deepth
+ int deepth_;
+
+ //: real computation
+ double adaptivesimpson(double(*f)(double*), double a, double b, double eps, int level, int level_max);
+
+ public:
+ vnl_adaptsimpson_integral(int deepth = 32) : deepth_(deepth) {}
+
+ //: a and b are integral limits respectively.
+ // n is the number of intervals used in integral.
+ // accuracy is the accuracy you want to achieve. Norally accuracy > 1e-11)
+ double integral(vnl_integrant_fnct *f, double a, double b, double accuracy);
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.h
new file mode 100644
index 0000000000000000000000000000000000000000..309a0b41ad8cb7cf42a9ecebb9165cc1e2d2df52
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.h
@@ -0,0 +1,28 @@
+// This is core/vnl/algo/vnl_adjugate.h
+#ifndef vnl_adjugate_h_
+#define vnl_adjugate_h_
+//:
+// \file
+// \author fsm and Peter Vanroose
+// The adjoint matrix of a square matrix, sometimes also called the adjugate
+// matrix (although that name is also used for the transpose of the complex
+// conjugate), is defined as the matrix whose (i,k)-th entry is the cofactor
+// of the (k,i)-th entry of the given matrix. The cofactor of entry (k,i)
+// is the determinant of the matrix obtained by deleting row k and column i
+// from the given matrix.
+//
+// The adjugate matrix is useful in finding the inverse of a square matrix
+// since det(A) * A_inverse = A_adj.
+//
+// In contrast to the inverse matrix, however, calculating the adjoint matrix
+// does not involve divisions, so the adjoint of an integer matrix is integer.
+
+template <class T> class vnl_matrix;
+
+template <class T>
+void vnl_adjugate(vnl_matrix<T> const &A, vnl_matrix<T> *out);
+
+template <class T>
+vnl_matrix<T> vnl_adjugate(vnl_matrix<T> const &A);
+
+#endif // vnl_adjugate_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.txx
new file mode 100644
index 0000000000000000000000000000000000000000..70f318336b7233a5223bc07dee5fb7268e4df937
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_adjugate.txx
@@ -0,0 +1,54 @@
+#ifndef vnl_adjugate_txx_
+#define vnl_adjugate_txx_
+//:
+// \file
+// \author fsm
+
+#include "vnl_adjugate.h"
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_determinant.h>
+
+// This is a rudimentary implementation. It could be improved by noting
+// that adj(A B) = adj(B) adj(A) for all matrices A, B (invertible or
+// not) and then using a matrix decomposition for larger matrices.
+//
+// E.g. using a singular value decomposition A = U D V^* gives
+// adj(A) = V adj(D) U^*.
+//
+// On the other hand, SVD decomposition makes no sense for e.g. integer matrices
+// and we want to keep T as general as possible.
+
+template <class T>
+void vnl_adjugate(vnl_matrix<T> const &A, vnl_matrix<T> *out)
+{
+ int n = A.rows();
+ A.assert_size(n, n);
+ out->assert_size(n, n);
+
+ vnl_matrix<T> sub(n-1, n-1);
+ for (int i=0; i<n; ++i)
+ for (int j=0; j<n; ++j)
+ {
+ for (int u=0; u<n-1; ++u)
+ for (int v=0; v<n-1; ++v)
+ sub[u][v] = A[v+(v<i?0:1)][u+(u<j?0:1)];
+ (*out)[i][j] = vnl_determinant(sub, false);
+ }
+}
+
+template <class T>
+vnl_matrix<T> vnl_adjugate(vnl_matrix<T> const &A)
+{
+ vnl_matrix<T> adj(A.rows(), A.cols());
+ vnl_adjugate(A, &adj);
+ return adj;
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_ADJUGATE_INSTANTIATE
+#define VNL_ADJUGATE_INSTANTIATE(T) \
+template void vnl_adjugate(vnl_matrix<T > const &, vnl_matrix<T > *); \
+template vnl_matrix<T > vnl_adjugate(vnl_matrix<T > const &)
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_algo_fwd.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_algo_fwd.h
new file mode 100644
index 0000000000000000000000000000000000000000..efc7593be029385361edb101af6f1217b5d61df7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_algo_fwd.h
@@ -0,0 +1,20 @@
+//-*- c++ -*-------------------------------------------------------------------
+#ifndef vnl_algo_fwd_h_
+#define vnl_algo_fwd_h_
+
+
+template <class T> struct vnl_matrix_inverse;
+template <class T> class vnl_svd;
+template <class T> class vnl_qr;
+template <class T> class vnl_symmetric_eigensystem;
+struct vnl_amoeba_SimplexCorner;
+class vnl_cholesky;
+class vnl_complex_eigensystem;
+class vnl_conjugate_gradient;
+class vnl_conjugate_gradient_Activate;
+class vnl_cpoly_roots;
+class vnl_lbfgs;
+class vnl_levenberg_marquardt;
+class vnl_levenberg_marquardt_Activate;
+
+#endif // vnl_algo_fwd_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..be947134b765ce7c3a2b04be114085dde00a75ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.cxx
@@ -0,0 +1,444 @@
+// This is core/vnl/algo/vnl_amoeba.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Oct 97
+//-----------------------------------------------------------------------------
+
+#include "vnl_amoeba.h"
+
+#include <vcl_cstdio.h> // for sprintf()
+#include <vcl_cstdlib.h> // for vcl_qsort
+#include <vcl_iostream.h>
+#include <vcl_vector.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_least_squares_function.h>
+
+bool vnl_amoeba::default_verbose = false;
+
+vnl_amoeba::vnl_amoeba(vnl_cost_function& f)
+ : fptr(&f)
+{
+ verbose = default_verbose;
+ maxiter = f.get_number_of_unknowns() * 200;
+ X_tolerance = 1e-8;
+ F_tolerance = 1e-4;
+ relative_diameter = 0.05;
+}
+
+
+struct vnl_amoebaFit : public vnl_amoeba
+{
+ int cnt;
+
+ vnl_amoebaFit(vnl_amoeba& a): vnl_amoeba(a) {
+ cnt = 0;
+ }
+
+ //: Initialise the simplex given one corner, x (scale each element to get other corners)
+ void set_up_simplex_relative(vcl_vector<vnl_amoeba_SimplexCorner>& simplex,
+ const vnl_vector<double>& x);
+
+ //: Initialise the simplex given one corner, x and displacements of others
+ void set_up_simplex_absolute(vcl_vector<vnl_amoeba_SimplexCorner>& simplex,
+ const vnl_vector<double>& x,
+ const vnl_vector<double>& dx);
+
+ //: Perform optimisation. Start simplex defined by scaling elements of x
+ void amoeba(vnl_vector<double>& x);
+
+ //: Perform optimisation. Start simplex defined by adding dx[i] to each x[i]
+ void amoeba(vnl_vector<double>& x, const vnl_vector<double>& dx);
+
+ //: Perform optimisation, given simplex to start
+ void amoeba(vnl_vector<double>& x, vcl_vector<vnl_amoeba_SimplexCorner>& simplex);
+
+ double f(const vnl_vector<double>& x) {
+ return fptr->f(x);
+ }
+
+ void set_corner(vnl_amoeba_SimplexCorner * s,
+ const vnl_vector<double>& v)
+ {
+ s->v = v;
+ s->fv = f(v);
+ cnt++;
+ }
+ void set_corner_a_plus_bl(vnl_amoeba_SimplexCorner * s,
+ const vnl_vector<double>& vbar,
+ const vnl_vector<double>& v,
+ double lambda)
+ {
+ s->v = (1 - lambda) * vbar + lambda * v;
+ s->fv = f(s->v);
+ cnt++;
+ }
+};
+
+int vnl_amoeba_SimplexCorner::compare(vnl_amoeba_SimplexCorner const& s1,
+ vnl_amoeba_SimplexCorner const& s2)
+{
+ return vnl_math_sgn(s1.fv - s2.fv);
+}
+
+#ifdef VCL_SUNPRO_CC
+extern "C"
+#else
+static
+#endif
+int compare_aux(const void * s1, const void * s2)
+{
+ return vnl_amoeba_SimplexCorner::compare(*(const vnl_amoeba_SimplexCorner*)s1,
+ *(const vnl_amoeba_SimplexCorner*)s2);
+}
+
+static
+void sort_simplex(vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ vcl_qsort(&simplex[0], simplex.size(), sizeof simplex[0], compare_aux);
+}
+
+static
+double maxabsdiff(const vnl_vector<double>& a, const vnl_vector<double>& b)
+{
+ double v = 0;
+ for (unsigned i = 0; i < a.size(); ++i) {
+ double ad = vnl_math_abs(a[i] - b[i]);
+ if (ad > v)
+ v = ad;
+ }
+ return v;
+}
+
+static
+double sorted_simplex_fdiameter(const vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ return simplex[simplex.size()-1].fv - simplex[0].fv;
+}
+
+#if 0
+static
+double simplex_fdiameter(const vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ // simplex assumed sorted, so fdiam is n - 0
+ double max = 0;
+ for (unsigned i = 1; i < simplex.size(); i++) {
+ double thismax = vnl_math_abs(simplex[0].fv - simplex[i].fv);
+ if (thismax > max)
+ max = thismax;
+ }
+ return max;
+}
+#endif
+
+static
+double simplex_diameter(const vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ double max = 0;
+ for (unsigned i = 0; i < simplex.size() - 1; i++) {
+ double thismax = maxabsdiff(simplex[i].v, simplex[i+1].v);
+ if (thismax > max)
+ max = thismax;
+ }
+ return max;
+}
+
+
+vcl_ostream& operator<<(vcl_ostream& s, const vnl_amoeba_SimplexCorner& simplex)
+{
+ s << 'S' << simplex.fv << ' ';
+ return s;
+}
+
+vcl_ostream& operator<<(vcl_ostream& s, const vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ for (unsigned i = 0; i < simplex.size(); ++i)
+ s << simplex[i].fv << ' ';
+ return s;
+}
+
+
+bool operator==(const vnl_amoeba_SimplexCorner& a, const vnl_amoeba_SimplexCorner& b)
+{
+ return (&a) == (&b);
+}
+
+//: Initialise the simplex given one corner, x
+void vnl_amoebaFit::set_up_simplex_relative(vcl_vector<vnl_amoeba_SimplexCorner>& simplex,
+ const vnl_vector<double>& x)
+{
+ int n = x.size();
+
+ simplex[0].v = x;
+ simplex[0].fv = f(x);
+
+ // Following improvement suggested by L.Pfeffer at Stanford
+ const double usual_delta = relative_diameter; // 5 percent deltas for non-zero terms
+ const double zero_term_delta = 0.00025; // Even smaller delta for zero elements of x
+// vnl_vector<double> y(n);
+ for (int j = 0; j < n; ++j) {
+ vnl_amoeba_SimplexCorner *s = &simplex[j+1];
+ s->v = x;
+
+ // perturb s->v(j)
+ if (vnl_math_abs(s->v[j]) > zero_term_delta)
+ s->v[j] = (1 + usual_delta)*s->v[j];
+ else
+ s->v[j] = zero_term_delta;
+
+ s->fv = f(s->v);
+ }
+}
+
+//: Initialise the simplex given one corner, x and displacements of others
+void vnl_amoebaFit::set_up_simplex_absolute(vcl_vector<vnl_amoeba_SimplexCorner>& simplex,
+ const vnl_vector<double>& x,
+ const vnl_vector<double>& dx)
+{
+ int n = x.size();
+
+ simplex[0].v = x;
+ simplex[0].fv = f(x);
+
+ for (int j = 0; j < n; ++j) {
+ vnl_amoeba_SimplexCorner *s = &simplex[j+1];
+ s->v = x;
+
+ // perturb s->v(j)
+ s->v[j] = s->v[j] + dx[j];
+
+ s->fv = f(s->v);
+ }
+}
+
+//: FMINS Minimize a function of several variables.
+// FMINS('F',X0) attempts to return a vector x which is a local minimizer
+// of F(x) near the starting vector X0. 'F' is a string containing the
+// name of the objective function to be minimized. F(x) should be a
+// scalar valued function of a vector variable.
+//
+// FMINS('F',X0,OPTIONS) uses a vector of control parameters.
+// If OPTIONS(1) is nonzero, intermediate steps in the solution are
+// displayed; the default is OPTIONS(1) = 0. OPTIONS(2) is the termination
+// tolerance for x; the default is 1.e-4. OPTIONS(3) is the termination
+// tolerance for F(x); the default is 1.e-4. OPTIONS(14) is the maximum
+// number of steps; the default is OPTIONS(14) = 500. The other components
+// of OPTIONS are not used as input control parameters by FMIN. For more
+// information, see FOPTIONS.
+//
+// FMINS('F',X0,OPTIONS,[],P1,P2,...) provides for up to 10 additional
+// arguments which are passed to the objective function, F(X,P1,P2,...)
+//
+// FMINS uses a simplex search method.
+//
+// See also FMIN.
+//
+// Reference: J. E. Dennis, Jr. and D. J. Woods, New Computing
+// Environments: Microcomputers in Large-Scale Computing,
+// edited by A. Wouk, SIAM, 1987, pp. 116-122.
+
+void vnl_amoebaFit::amoeba(vnl_vector<double>& x)
+{
+// Set up a simplex near the initial guess.
+ int n = x.size();
+ vcl_vector<vnl_amoeba_SimplexCorner> simplex(n+1, vnl_amoeba_SimplexCorner(n));
+
+ set_up_simplex_relative(simplex,x);
+ amoeba(x,simplex);
+}
+
+void vnl_amoebaFit::amoeba(vnl_vector<double>& x, const vnl_vector<double>& dx)
+{
+// Set up a simplex near the initial guess.
+ int n = x.size();
+ vcl_vector<vnl_amoeba_SimplexCorner> simplex(n+1, vnl_amoeba_SimplexCorner(n));
+
+ set_up_simplex_absolute(simplex,x,dx);
+ amoeba(x,simplex);
+}
+
+ //: Perform optimisation, given simplex to start
+void vnl_amoebaFit::amoeba(vnl_vector<double>& x,
+ vcl_vector<vnl_amoeba_SimplexCorner>& simplex)
+{
+ int n = x.size();
+ sort_simplex(simplex);
+
+ if (verbose > 1) {
+ vcl_cerr << "initial\n" << simplex;
+ } else if (verbose) {
+ vcl_cerr << "initial: " << simplex << vcl_endl;
+ }
+
+ // Iterate until the diameter of the simplex is less than X_tolerance.
+ vnl_amoeba_SimplexCorner reflect(n);
+ vnl_amoeba_SimplexCorner expand(n);
+ vnl_amoeba_SimplexCorner contract(n);
+ vnl_amoeba_SimplexCorner shrink(n);
+ vnl_amoeba_SimplexCorner *next;
+
+ vnl_vector<double> vbar(n);
+ while (cnt < maxiter) {
+ if (simplex_diameter(simplex) < X_tolerance &&
+ sorted_simplex_fdiameter(simplex) < F_tolerance)
+ break;
+
+ // One step of the Nelder-Mead simplex algorithm
+ for (int k = 0; k < n; ++k) {
+ vbar[k] = 0;
+ for (int i = 0; i < n; ++i)
+ vbar[k] += simplex[i].v[k];
+ vbar[k] /= n;
+ }
+
+ set_corner_a_plus_bl(&reflect, vbar, simplex[n].v, -1);
+
+ next = &reflect;
+ const char *how = "reflect ";
+ if (reflect.fv < simplex[n-1].fv) {
+ // Reflection not totally crap...
+ if (reflect.fv < simplex[0].fv) {
+ // Reflection actually the best, try expanding
+ set_corner_a_plus_bl(&expand, vbar, reflect.v, 2);
+
+ if (expand.fv < simplex[0].fv) {
+ next = &expand;
+ how = "expand ";
+ }
+ }
+ } else {
+ // Reflection *is* totally crap...
+ {
+ vnl_amoeba_SimplexCorner *tmp = &simplex[n];
+ if (reflect.fv < tmp->fv)
+ // replace simplex[n] by reflection as at least it's better than that
+ tmp = &reflect;
+ set_corner_a_plus_bl(&contract, vbar, tmp->v, 0.5);
+ }
+
+ if (contract.fv < simplex[0].fv) {
+ // The contraction point was really good, hold it there
+ next = &contract;
+ how = "contract";
+ }
+ else {
+ // The contraction point was only average, shrink the entire simplex.
+ for (int j = 1; j < n; ++j)
+
+ set_corner_a_plus_bl(&simplex[j], simplex[0].v, simplex[j].v, 0.5);
+ set_corner_a_plus_bl(&shrink, simplex[0].v, simplex[n].v, 0.5);
+
+ next = &shrink;
+ how = "shrink ";
+ }
+ }
+ simplex[n] = *next;
+
+ sort_simplex(simplex);
+
+ // Print debugging info
+ if (verbose) {
+ char buf[16383];
+ vcl_sprintf(buf, "iter %5d: %s ", cnt, how);
+ vcl_cerr << buf;
+ if (verbose ==2)
+ vcl_cerr << "\nFirst corner: " << simplex[0].v;
+ if (verbose > 1)
+ {
+ vcl_streamsize a = vcl_cerr.width(10);
+ vcl_cerr << vcl_endl << simplex << vcl_endl;
+ vcl_cerr.width(a);
+ }
+ else if (verbose)
+ vcl_cerr << simplex << vcl_endl;
+ }
+ }
+ num_evaluations_ = cnt;
+ x = simplex[0].v;
+}
+
+//: Modify x to minimise function supplied in constructor
+// Start simplex defined by scaling elements of x
+void vnl_amoeba::minimize(vnl_vector<double>& x)
+{
+ vnl_amoebaFit af(*this);
+ af.amoeba(x);
+ num_evaluations_ = af.num_evaluations_;
+}
+
+//: Perform optimisation. Start simplex defined by adding dx[i] to each x[i]
+void vnl_amoeba::minimize(vnl_vector<double>& x, const vnl_vector<double>& dx)
+{
+ vnl_amoebaFit af(*this);
+ af.amoeba(x,dx);
+ num_evaluations_ = af.num_evaluations_;
+}
+
+
+//: Static method
+void vnl_amoeba::minimize(vnl_cost_function& f, vnl_vector<double>& x)
+{
+ minimize(f, x, 0);
+}
+
+//: Static method
+void vnl_amoeba::minimize(vnl_cost_function& f, vnl_vector<double>& x, double delta)
+{
+ vnl_amoeba a(f);
+ a.verbose = vnl_amoeba::default_verbose;
+ if (delta != 0)
+ a.relative_diameter = delta;
+ vnl_amoebaFit amoeba(a);
+ amoeba.amoeba(x);
+}
+
+//: Static method
+void vnl_amoeba::minimize(vnl_cost_function& f, vnl_vector<double>& x,
+ const vnl_vector<double>& dx)
+{
+ vnl_amoeba a(f);
+ a.verbose = vnl_amoeba::default_verbose;
+ vnl_amoebaFit amoeba(a);
+ amoeba.amoeba(x,dx);
+}
+
+
+class vnl_amoeba_LSCF : public vnl_cost_function
+{
+ vnl_least_squares_function* ls_;
+ vnl_vector<double> fx;
+ public:
+ vnl_amoeba_LSCF(vnl_least_squares_function& ls)
+ : vnl_cost_function(ls.get_number_of_unknowns()),
+ ls_(&ls), fx(ls.get_number_of_residuals()) {}
+
+ ~vnl_amoeba_LSCF() {}
+
+ double f(vnl_vector<double> const& x) {
+ ls_->f(x, fx);
+ return fx.squared_magnitude();
+ }
+};
+
+void vnl_amoeba::minimize(vnl_least_squares_function& f, vnl_vector<double>& x)
+{
+ vnl_amoeba_LSCF lsf(f);
+ minimize(lsf, x);
+}
+
+/////////////////////////////////////////////////////////////////////////////
+vnl_amoeba_SimplexCorner::vnl_amoeba_SimplexCorner(int n) : v(n) {}
+
+vnl_amoeba_SimplexCorner& vnl_amoeba_SimplexCorner::operator=(const vnl_amoeba_SimplexCorner& that)
+{
+ v = that.v;
+ fv = that.fv;
+ return *this;
+}
+
+//--------------------------------------------------------------------------------
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.h
new file mode 100644
index 0000000000000000000000000000000000000000..71e5a04b5fc2fe195e031c2ab33b2c057f9b1280
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_amoeba.h
@@ -0,0 +1,122 @@
+// This is core/vnl/algo/vnl_amoeba.h
+#ifndef vnl_amoeba_h_
+#define vnl_amoeba_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Nelder-Meade downhill simplex.
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Oct 97
+//
+// \verbatim
+// Modifications
+// 971023 AWF Initial version
+// dac (Manchester) 26/03/2001: tidied up documentation
+// Tim Cootes 7-Jan-02: Added documentation and additional methods
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+
+class vnl_cost_function;
+class vnl_least_squares_function;
+
+//: Nelder-Meade downhill simplex.
+// vnl_amoeba is an implementation of the Nelder-Meade downhill simplex
+// algorithm. For most problems, it's a few times slower than
+// vnl_levenberg_marquardt, but it can perform much better on noisy error
+// functions.
+//
+// It works by creating a simplex (n+1 points in n-D space) which then
+// crawls about the space searching for the solution.
+//
+// By default the set of (n+1) starting points are generated by applying
+// a scaling (relative_diameter) to each element of the supplied starting
+// vector, with a small offset used instead if the value is zero.
+//
+// Alternatively, if one uses minimize(x,dx), then the starting points
+// are obtained by adding each dx[i] to the elements of x, one at a time.
+// This is useful if you know roughly the scale of your space.
+
+class vnl_amoeba
+{
+ public:
+ int verbose;
+ int maxiter;
+ double X_tolerance;
+ double F_tolerance;
+
+ //: Define maximum number of iterations to use
+ void set_max_iterations(int n) { maxiter = n; }
+
+ //: Define tolerance on elements of x
+ void set_x_tolerance(double tol) { X_tolerance = tol; }
+
+ //: Define tolerance on function evaluation
+ void set_f_tolerance(double tol) { F_tolerance = tol; }
+
+ //: Define scaling used to select starting vertices relative to initial x0.
+ // I.e. the i'th vertex has x[i] = x0[i]*(1+relative_diameter)
+ void set_relative_diameter(double r) { relative_diameter = r; }
+
+ //: Scaling used to select starting vertices relative to initial x0.
+ // I.e. the i'th vertex has x[i] = x0[i]*(1+relative_diameter)
+ double relative_diameter;
+
+ //: Construct and supply function to be minimized
+ vnl_amoeba(vnl_cost_function& f);
+
+ //: Modify x to minimise function supplied in constructor
+ // Start simplex defined by scaling elements of x
+ void minimize(vnl_vector<double>& x);
+
+ //: Perform optimisation.
+ // Start simplex defined by adding dx[i] to each x[i]
+ void minimize(vnl_vector<double>& x, const vnl_vector<double>& dx);
+
+ //: Number of evaluations used in last call to minimize
+ int get_num_evaluations() const { return num_evaluations_; }
+
+ public:
+ //: Modify x so as to minimise f(x)
+ static void minimize(vnl_cost_function& f, vnl_vector<double>& x);
+
+ //: Modify x so as to minimise f(x)
+ // Start simplex defined by adding dx[i] to each x[i]
+ static void minimize(vnl_cost_function& f, vnl_vector<double>& x,
+ const vnl_vector<double>& dx);
+
+ //: Modify x so as to minimise f(x)
+ // delta defines relative size of initial simplex
+ // ie the i'th vertex has xi[i] = x[i]*(1+delta)
+ static void minimize(vnl_cost_function& f, vnl_vector<double>& x,
+ double delta);
+
+ //: Modify x so as to minimise f(x)
+ static void minimize(vnl_least_squares_function& f, vnl_vector<double>& x);
+
+ static bool default_verbose;
+
+ protected:
+ vnl_cost_function* fptr;
+ int num_evaluations_;
+};
+
+// Private struct needs to be declared in the header file
+// in order to instantiate STL container of it elsewhere.
+struct vnl_amoeba_SimplexCorner
+{
+ vnl_vector<double> v;
+ double fv;
+
+ vnl_amoeba_SimplexCorner(int = 0);
+ vnl_amoeba_SimplexCorner& operator= (const vnl_amoeba_SimplexCorner& that);
+ static int compare(vnl_amoeba_SimplexCorner const& s1,
+ vnl_amoeba_SimplexCorner const& s2);
+};
+
+#endif // vnl_amoeba_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e2d8e62adff0b1b3216516632ff0a5202184bddb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.cxx
@@ -0,0 +1,260 @@
+// This is core/vnl/algo/vnl_brent.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+
+#include "vnl_brent.h"
+
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+#include <vcl_algorithm.h>
+
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_vector_fixed.h>
+
+struct vnl_brent_data
+{
+ vnl_cost_function* functor;
+ vnl_vector_fixed<double,1> vx;
+ double tol;
+
+ double f(double x) {
+ vx[0] = x;
+ return functor->f(vx.as_ref());
+ }
+};
+
+vnl_brent::vnl_brent(vnl_cost_function* functor)
+{
+ p = new vnl_brent_data;
+ p->functor = functor;
+ p->tol = 2.0e-4;
+}
+
+vnl_brent::~vnl_brent()
+{
+ delete p;
+}
+
+static const int ITMAX = 100;
+static const double CGOLD = 0.3819660;
+static const double ZEPS = 1.0e-10;
+
+static
+void SHFT(double* a, double* b, double* c, double d)
+{
+ *a = *b;
+ *b = *c;
+ *c = d;
+}
+
+double vnl_brent::minimize_given_bounds(double ax, double bx, double cx,
+ double tol,
+ double *xmin)
+{
+ int iter;
+ double a,b,d=0.0,etemp,fu,fv,fw,fx,p1,q,r,tol1,tol2,u,v,w,x,xm;
+ double e=0.0;
+
+ a=(ax < cx ? ax : cx);
+ b=(ax > cx ? ax : cx);
+ x=w=v=bx;
+ fw=fv=fx=p->f(x);
+ if (verbose_) vcl_cerr << "vnl_brent f("<<x<<") \t= "<<fx <<'\n';
+ for (iter=1;iter<=ITMAX;iter++)
+ {
+ xm=0.5*(a+b);
+ tol1=tol*vcl_fabs(x)+ZEPS;
+ tol2=2.0*(tol1);
+ if (vcl_fabs(x-xm) <= (tol2-0.5*(b-a))) {
+ *xmin=x;
+ return fx;
+ }
+ if (vcl_fabs(e) > tol1) {
+ r=(x-w)*(fx-fv);
+ q=(x-v)*(fx-fw);
+ p1=(x-v)*q-(x-w)*r;
+ q=2.0*(q-r);
+ if (q > 0.0) p1 = -p1;
+ q=vcl_fabs(q);
+ etemp=e;
+ e=d; // Warning: The variable d has not yet been assigned a value.
+ if (vcl_fabs(p1) >= vcl_fabs(0.5*q*etemp) || p1 <= q*(a-x) || p1 >= q*(b-x))
+ d=CGOLD*(e=(x >= xm ? a-x : b-x));
+ else {
+ d=p1/q;
+ u=x+d;
+ if (u-a < tol2 || b-u < tol2)
+ d=tol1 * vnl_math_sgn(xm-x);
+ }
+ } else {
+ d=CGOLD*(e=(x >= xm ? a-x : b-x));
+ }
+ u=(vcl_fabs(d) >= tol1 ? x+d : x + tol1 * vnl_math_sgn(d));
+ fu= p->f(u);
+ if (verbose_) vcl_cerr << "vnl_brent f("<<u<<") \t= "<<fu <<'\n';
+ if (fu <= fx) {
+ if (u >= x) a=x; else b=x;
+ SHFT(&v,&w,&x,u);
+ SHFT(&fv,&fw,&fx,fu);
+ } else {
+ if (u < x) a=u; else b=u;
+ if (fu <= fw || w == x) {
+ v=w;
+ w=u;
+ fv=fw;
+ fw=fu;
+ } else if (fu <= fv || v == x || v == w) {
+ v=u;
+ fv=fu;
+ }
+ }
+ }
+ vcl_cerr << "Too many iterations in brent\n";
+ *xmin=x;
+ return fx;
+}
+
+double vnl_brent::minimize_given_bounds_and_1st_f(double ax, double bx,
+ double fb, double cx,
+ double tol, double *xmin)
+{
+ int iter;
+ double a,b,d=0.0,etemp,fu,fv,fw,fx,p1,q,r,tol1,tol2,u,v,w,x,xm;
+ double e=0.0;
+
+ a=(ax < cx ? ax : cx);
+ b=(ax > cx ? ax : cx);
+ x=w=v=bx;
+ fw=fv=fx=fb;
+ for (iter=1;iter<=ITMAX;iter++)
+ {
+ xm=0.5*(a+b);
+ tol1=tol*vcl_fabs(x)+ZEPS;
+ tol2=2.0*(tol1);
+ if (vcl_fabs(x-xm) <= (tol2-0.5*(b-a))) {
+ *xmin=x;
+ return fx;
+ }
+ if (vcl_fabs(e) > tol1) {
+ r=(x-w)*(fx-fv);
+ q=(x-v)*(fx-fw);
+ p1=(x-v)*q-(x-w)*r;
+ q=2.0*(q-r);
+ if (q > 0.0) p1 = -p1;
+ q=vcl_fabs(q);
+ etemp=e;
+ e=d; // Warning: The variable d has not yet been assigned a value.
+ if (vcl_fabs(p1) >= vcl_fabs(0.5*q*etemp) || p1 <= q*(a-x) || p1 >= q*(b-x))
+ d=CGOLD*(e=(x >= xm ? a-x : b-x));
+ else {
+ d=p1/q;
+ u=x+d;
+ if (u-a < tol2 || b-u < tol2)
+ d=tol1 * vnl_math_sgn(xm-x);
+ }
+ } else {
+ d=CGOLD*(e=(x >= xm ? a-x : b-x));
+ }
+ u=(vcl_fabs(d) >= tol1 ? x+d : x + tol1 * vnl_math_sgn(d));
+ fu= p->f(u);
+ if (verbose_) vcl_cerr << "vnl_brent f("<<u<<") \t= "<<fu <<'\n';
+ if (fu <= fx) {
+ if (u >= x) a=x; else b=x;
+ SHFT(&v,&w,&x,u);
+ SHFT(&fv,&fw,&fx,fu);
+ } else {
+ if (u < x) a=u; else b=u;
+ if (fu <= fw || w == x) {
+ v=w;
+ w=u;
+ fv=fw;
+ fw=fu;
+ } else if (fu <= fv || v == x || v == w) {
+ v=u;
+ fv=fu;
+ }
+ }
+ }
+ vcl_cerr << "Too many iterations in brent\n";
+ *xmin=x;
+ return fx;
+}
+
+
+void vnl_brent::bracket_minimum(double *ax, double *bx, double *cx)
+{
+ double fa, fb, fc;
+ bracket_minimum(ax,bx,cx,&fa,&fb,&fc);
+}
+
+const double GOLD = 1.618034;
+const double GLIMIT = 100.0;
+const double TINY = 1.0e-20;
+
+void vnl_brent::bracket_minimum(double *ax, double *bx, double *cx,
+ double *fa, double *fb, double *fc)
+{
+ double ulim,u,r,q,fu;
+
+ *fa=p->f(*ax);
+ *fb=p->f(*bx);
+ if (*fb > *fa) {
+ vcl_swap(*ax, *bx);
+ vcl_swap(*fa, *fb);
+ }
+ *cx=(*bx)+GOLD*(*bx-*ax);
+ *fc=p->f(*cx);
+ while (*fb > *fc) {
+ r=(*bx-*ax)*(*fb-*fc);
+ q=(*bx-*cx)*(*fb-*fa);
+ double dq = q-r;
+ if (vcl_abs(dq) < TINY)
+ dq = vnl_math_sgn(dq) * TINY;
+
+ u=(*bx)-((*bx-*cx)*q-(*bx-*ax)*r)/(2.0*dq);
+ ulim=(*bx)+GLIMIT*(*cx-*bx);
+ if ((*bx-u)*(u-*cx) > 0.0) {
+ fu=p->f(u);
+ if (fu < *fc) {
+ *ax=(*bx);
+ *bx=u;
+ *fa=(*fb);
+ *fb=fu;
+ return;
+ } else if (fu > *fb) {
+ *cx=u;
+ *fc=fu;
+ return;
+ }
+ u=(*cx)+GOLD*(*cx-*bx);
+ fu=p->f(u);
+ } else if ((*cx-u)*(u-ulim) > 0.0) {
+ fu=p->f(u);
+ if (fu < *fc) {
+ //SHFT(bx,cx,&u,*cx+GOLD*(*cx-*bx)); awf dumped -- c is useless
+ SHFT(bx,cx,&u,u+GOLD*(u-*cx));
+ SHFT(fb,fc,&fu,p->f(u));
+ }
+ } else if ((u-ulim)*(ulim-*cx) >= 0.0) {
+ u=ulim;
+ fu=p->f(u);
+ } else {
+ u=(*cx)+GOLD*(*cx-*bx);
+ fu=p->f(u);
+ }
+ SHFT(ax,bx,cx,u);
+ SHFT(fa,fb,fc,fu);
+ }
+}
+
+
+double vnl_brent::minimize(double x)
+{
+ double ax=x-1.0;
+ double xx=x+1.0;
+ double bx,fa,fx,fb;
+ bracket_minimum(&ax,&xx,&bx,&fa,&fx,&fb);
+ minimize_given_bounds(bx,xx,ax,ftol,&x);
+ return x;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.h
new file mode 100644
index 0000000000000000000000000000000000000000..c304ec29790947566398f65772d6e7453c40729b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_brent.h
@@ -0,0 +1,63 @@
+// This is core/vnl/algo/vnl_brent.h
+#ifndef vnl_brent_h_
+#define vnl_brent_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author awf@robots.ox.ac.uk
+// \date 07 Dec 00
+//
+// \verbatim
+// Modifications
+// 31 May 2001 Ian Scott (Manchester). Added some documentation
+// 31 May 2001 Ian Scott (Manchester). Added minimize_given_bounds_and_1st_f
+// \endverbatim
+
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+struct vnl_brent_data;
+
+//: Brent 1D minimizer
+// This minimised uses both golden section search and parabolic interpolation
+// for a fast and robust function minimiser.
+class vnl_brent : public vnl_nonlinear_minimizer
+{
+ public:
+ vnl_brent(vnl_cost_function* functor);
+ ~vnl_brent();
+
+ //: Find a minimum of f(x) near to ax.
+ double minimize(double ax);
+
+ //: Find the minimum value of f(x) within a<= x <= c.
+ // The minimum value is the return value, and *xmin the relevant value of x.
+ // You need to provide a bracket for the minimum
+ // Also returns fa = f(a), etc.
+ double minimize_given_bounds(double ax, double bx, double cx,
+ double tol,
+ double *xmin);
+
+ //: Save time over minimize_given_bounds() if you know f(b)
+ // This function avoids a single computation of f, if you already know
+ // it.
+ double minimize_given_bounds_and_1st_f(double ax, double bx, double fb,
+ double cx, double tol, double *xmin);
+
+ //: Given distinct points ax, and bx, find a bracket for the minimum.
+ // Return a bracket ax < bx < cx, f(b) < f(a), f(b) < f(c) for minimum.
+ // Also returns fa = f(a), etc.
+ void bracket_minimum(double *ax, double *bx, double *cx,
+ double *fa, double *fb, double *fc);
+
+ //: Given distinct points ax, and bx, find a bracket for the minimum.
+ // Return a bracket ax < bx < cx, f(b) < f(a), f(b) < f(c) for minimum.
+ void bracket_minimum(double *ax, double *bx, double *cx);
+
+ protected:
+ vnl_brent_data *p;
+};
+
+#endif // vnl_brent_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..01f2e55d15d6398eb2f917f0d41affbe0ba0b2a8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.cxx
@@ -0,0 +1,104 @@
+// This is core/vnl/algo/vnl_chi_squared.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_chi_squared.h"
+
+// FORTRAN routine
+#include <vnl/algo/vnl_netlib.h> // dchscdf_()
+
+//: Compute cumulative distribution function for chi-squared distribution.
+// This subroutine computes the cumulative distribution function
+// value for the chi-squared distribution with integer degrees of
+// freedom parameter = dof. This distribution is defined for all
+// non-negative chisq. Thus if a random variable x is drawn from a
+// chi-squared distribution with d degrees of freedom, then P(x < X) =
+// vnl_chi_squared::vnl_chi_squaredCumulative(X,d).
+double vnl_chi_squared_cumulative(double chisq, int dof) {
+ double cdf;
+ dchscdf_(&chisq,&dof,&cdf);
+ return cdf;
+}
+
+//------------------------------------------------------------
+
+template <class T>
+double vnl_chi_squared_statistic_1 (T const *A, T const *B, int n, bool normalize)
+{
+ double sum = 0;
+
+ if (normalize) {
+ T sumA = 0;
+ T sumB = 0;
+ for (int i=0; i<n; ++i) {
+ sumA += A[i];
+ sumB += B[i];
+ }
+
+ for (int i=0; i<n; ++i)
+ if (A[i]) {
+ double a = double(A[i])/sumA;
+ double b = double(B[i])/sumB;
+ double tmp = a - b;
+ sum += tmp*tmp/a;
+ }
+ }
+ else {
+ for (int i=0; i<n; ++i)
+ if (A[i]) {
+ double tmp = A[i] - B[i];
+ sum += tmp*tmp/A[i];
+ }
+ }
+
+ return sum;
+}
+
+template <class T>
+double vnl_chi_squared_statistic_2 (T const *A, T const *B, int n, bool normalize)
+{
+ return vnl_chi_squared_statistic_1(B, A, n, normalize);
+}
+
+template <class T>
+double vnl_chi_squared_statistic_12(T const *A, T const *B, int n, bool normalize)
+{
+ double sum = 0;
+
+ if (normalize) {
+ T sumA = 0;
+ T sumB = 0;
+ for (int i=0; i<n; ++i) {
+ sumA += A[i];
+ sumB += B[i];
+ }
+
+ for (int i=0; i<n; ++i)
+ if (A[i] || B[i]) {
+ double a = double(A[i])/sumA;
+ double b = double(B[i])/sumB;
+ double tmp = a - b;
+ sum += tmp*tmp/(a + b);
+ }
+ }
+ else {
+ for (int i=0; i<n; ++i)
+ if (A[i] || B[i]) {
+ double tmp = A[i] - B[i];
+ sum += tmp*tmp/(A[i] + B[i]);
+ }
+ }
+
+ return sum;
+}
+
+#define inst(T) \
+template double vnl_chi_squared_statistic_1 (T const *, T const *, int, bool); \
+template double vnl_chi_squared_statistic_2 (T const *, T const *, int, bool); \
+template double vnl_chi_squared_statistic_12(T const *, T const *, int, bool)
+
+inst(int);
+inst(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.h
new file mode 100644
index 0000000000000000000000000000000000000000..e2026ae32270f5b910104afd84987f2659fdb25a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_chi_squared.h
@@ -0,0 +1,57 @@
+// This is core/vnl/algo/vnl_chi_squared.h
+#ifndef vnl_chi_squared_h_
+#define vnl_chi_squared_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Name space for various chi-squared distribution functions.
+// \author Rupert Curwen, GE CRD
+// \date August 18th, 1998
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 26/03/2001: tidied up documentation
+// \endverbatim
+
+
+//: Compute cumulative distribution function value for chi-squared distribution
+extern double vnl_chi_squared_cumulative(double chisq, int dof);
+
+//------------------------------------------------------------
+
+//: Name space for various chi-squared distribution functions.
+//
+// A[] and B[] are (pointers to) arrays containing histograms.
+// If the 'normalize' parameter is true, each histogram will
+// be implicitly normalized (so as to sum to 1) before the
+// statistic is calculated :
+//
+// $a[i] = A[i] / \sum_j A[j]$
+//
+// $b[i] = B[i] / \sum_j B[j]$
+//
+// *DO NOT* add scale factors to these functions or you will break
+// the code written by those who read the documentation. fsm.
+//
+// $\displaystyle \sum_i \frac{ (a[i] - b[i])^2 }{ a[i] } $
+//
+
+template <class T>
+double vnl_chi_squared_statistic_1 (T const *A, T const *B,
+ int n, bool normalize);
+
+//:
+// $\displaystyle \sum_i \frac{ (a[i] - b[i])^2 }{ b[i] } $
+template <class T>
+double vnl_chi_squared_statistic_2 (T const *A, T const *B,
+ int n, bool normalize);
+
+//:
+// $\displaystyle \sum_i \frac{ (a[i] - b[i])^2 }{ a[i] + b[i] } $
+template <class T>
+double vnl_chi_squared_statistic_12(T const *A, T const *B,
+ int n, bool normalize);
+
+#endif // vnl_chi_squared_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0b07bb16f8cd278208529ddabde7b21a7889378b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.cxx
@@ -0,0 +1,139 @@
+// This is core/vnl/algo/vnl_cholesky.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// vnl_cholesky
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// Created: 08 Dec 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_cholesky.h"
+#include <vcl_cmath.h> // pow()
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_netlib.h> // dpofa_(), dposl_(), dpoco_(), dpodi_()
+
+//: Cholesky decomposition.
+// Make cholesky decomposition of M optionally computing
+// the reciprocal condition number. If mode is estimate_condition, the
+// condition number and an approximate nullspace are estimated, at a cost
+// of a factor of (1 + 18/n). Here's a table of 1 + 18/n:
+// \verbatim
+// n: 3 5 10 50 100 500 1000
+// slowdown: 7.0 4.6 2.8 1.4 1.18 1.04 1.02
+// \endverbatim
+
+vnl_cholesky::vnl_cholesky(vnl_matrix<double> const & M, Operation mode):
+ A_(M)
+{
+ int n = M.columns();
+ assert(n == (int)(M.rows()));
+ num_dims_rank_def_ = -1;
+ if (vcl_fabs(M(0,n-1) - M(n-1,0)) > 1e-8) {
+ vcl_cerr << "vnl_cholesky: WARNING: unsymmetric: " << M << vcl_endl;
+ }
+
+ if (mode != estimate_condition) {
+ // Quick factorization
+ dpofa_(A_.data_block(), &n, &n, &num_dims_rank_def_);
+ if (mode == verbose && num_dims_rank_def_ != 0)
+ vcl_cerr << "vnl_cholesky: " << num_dims_rank_def_ << " dimensions of non-posdeffness\n";
+ } else {
+ vnl_vector<double> nullvector(n);
+ dpoco_(A_.data_block(), &n, &n, &rcond_, nullvector.data_block(), &num_dims_rank_def_);
+ if (num_dims_rank_def_ != 0)
+ vcl_cerr << "vnl_cholesky: rcond=" << rcond_ << " so " << num_dims_rank_def_ << " dimensions of non-posdeffness\n";
+ }
+}
+
+//: Solve least squares problem M x = b.
+// The right-hand-side vcl_vector x may be b,
+// which will give a fractional increase in speed.
+void vnl_cholesky::solve(vnl_vector<double> const& b, vnl_vector<double>* x) const
+{
+ assert(b.size() == A_.columns());
+
+ *x = b;
+ int n = A_.columns();
+ dposl_(A_.data_block(), &n, &n, x->data_block());
+}
+
+//: Solve least squares problem M x = b.
+vnl_vector<double> vnl_cholesky::solve(vnl_vector<double> const& b) const
+{
+ assert(b.size() == A_.columns());
+
+ int n = A_.columns();
+ vnl_vector<double> ret = b;
+ dposl_(A_.data_block(), &n, &n, ret.data_block());
+ return ret;
+}
+
+//: Compute determinant.
+double vnl_cholesky::determinant() const
+{
+ int n = A_.columns();
+ vnl_matrix<double> I = A_;
+ double det[2];
+ int job = 10;
+ dpodi_(I.data_block(), &n, &n, det, &job);
+ return det[0] * vcl_pow(10.0, det[1]);
+}
+
+// : Compute inverse. Not efficient.
+vnl_matrix<double> vnl_cholesky::inverse() const
+{
+ if (num_dims_rank_def_) {
+ vcl_cerr << "vnl_cholesky: Calling inverse() on rank-deficient matrix\n";
+ return vnl_matrix<double>();
+ }
+
+ int n = A_.columns();
+ vnl_matrix<double> I = A_;
+ int job = 01;
+ dpodi_(I.data_block(), &n, &n, 0, &job);
+
+ // Copy lower triangle into upper
+ for (int i = 0; i < n; ++i)
+ for (int j = i+1; j < n; ++j)
+ I(i,j) = I(j,i);
+
+ return I;
+}
+
+//: Return lower-triangular factor.
+vnl_matrix<double> vnl_cholesky::lower_triangle() const
+{
+ unsigned n = A_.columns();
+ vnl_matrix<double> L(n,n);
+ // Zap upper triangle and transpose
+ for (unsigned i = 0; i < n; ++i) {
+ L(i,i) = A_(i,i);
+ for (unsigned j = i+1; j < n; ++j) {
+ L(j,i) = A_(j,i);
+ L(i,j) = 0;
+ }
+ }
+ return L;
+}
+
+
+//: Return upper-triangular factor.
+vnl_matrix<double> vnl_cholesky::upper_triangle() const
+{
+ unsigned n = A_.columns();
+ vnl_matrix<double> U(n,n);
+ // Zap lower triangle and transpose
+ for (unsigned i = 0; i < n; ++i) {
+ U(i,i) = A_(i,i);
+ for (unsigned j = i+1; j < n; ++j) {
+ U(i,j) = A_(j,i);
+ U(j,i) = 0;
+ }
+ }
+ return U;
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.h
new file mode 100644
index 0000000000000000000000000000000000000000..b21f3f2944a42a32a0f113f64438f84691469ac7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cholesky.h
@@ -0,0 +1,99 @@
+// This is core/vnl/algo/vnl_cholesky.h
+#ifndef vnl_cholesky_h_
+#define vnl_cholesky_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Decomposition of symmetric matrix
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 08 Dec 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, Leuven, Apr 1998: added L() (return decomposition matrix)
+// dac (Manchester) 26/03/2001: tidied up documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Decomposition of symmetric matrix.
+// A class to hold the Cholesky decomposition of a symmetric matrix and
+// use that to solve linear systems, compute determinants and inverses.
+// The cholesky decomposition decomposes symmetric A = L*L.transpose()
+// where L is lower triangular
+//
+// To check that the decomposition can be used safely for solving a linear
+// equation it is wise to construct with mode==estimate_condition and
+// check that rcond()>sqrt(machine precision). If this is not the case
+// it might be a good idea to use vnl_svd instead.
+class vnl_cholesky
+{
+ public:
+ //: Modes of computation. See constructor for details.
+ enum Operation {
+ quiet,
+ verbose,
+ estimate_condition
+ };
+
+ //: Make cholesky decomposition of M optionally computing the reciprocal condition number.
+ vnl_cholesky(vnl_matrix<double> const& M, Operation mode = verbose);
+ ~vnl_cholesky() {}
+
+ //: Solve LS problem M x = b
+ vnl_vector<double> solve(vnl_vector<double> const& b) const;
+
+ //: Solve LS problem M x = b
+ void solve(vnl_vector<double> const& b, vnl_vector<double>* x) const;
+
+ //: Compute determinant
+ double determinant() const;
+
+ // Compute inverse. Not efficient.
+ // It's broken, I don't have time to fix it.
+ // Mail awf@robots if you need it and I'll tell you as much as I can
+ // to fix it.
+ vnl_matrix<double> inverse() const;
+
+ //: Return lower-triangular factor.
+ vnl_matrix<double> lower_triangle() const;
+
+ //: Return upper-triangular factor.
+ vnl_matrix<double> upper_triangle() const;
+
+ //: Return the decomposition matrix
+ vnl_matrix<double> const& L_badly_named_method() const { return A_; }
+
+ //: A Success/failure flag
+ int rank_deficiency() const { return num_dims_rank_def_; }
+
+ //: Return reciprocal condition number (smallest/largest singular values).
+ // As long as rcond()>sqrt(precision) the decomposition can be used for
+ // solving equations safely.
+ // Not calculated unless Operation mode at construction was estimate_condition.
+ double rcond() const { return rcond_; }
+
+ //: Return computed nullvector.
+ // Not calculated unless Operation mode at construction was estimate_condition.
+ vnl_vector<double> & nullvector() { return nullvector_; }
+ vnl_vector<double> const& nullvector() const { return nullvector_; }
+
+ protected:
+ // Data Members--------------------------------------------------------------
+ vnl_matrix<double> A_;
+ double rcond_;
+ int num_dims_rank_def_;
+ vnl_vector<double> nullvector_;
+
+ private:
+ //: Copy constructor - privatised to avoid it being used
+ vnl_cholesky(vnl_cholesky const & that);
+ //: Assignment operator - privatised to avoid it being used
+ vnl_cholesky& operator=(vnl_cholesky const & that);
+};
+
+#endif // vnl_cholesky_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..755abdd9f7c892a2a30a6cb0968b775515d23c38
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.cxx
@@ -0,0 +1,114 @@
+// This is core/vnl/algo/vnl_complex_eigensystem.cxx
+#include "vnl_complex_eigensystem.h"
+// \author fsm
+
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_complexify.h>
+#include <vnl/algo/vnl_netlib.h> // zgeev_()
+
+void vnl_complex_eigensystem::compute(vnl_matrix<vcl_complex<double> > const & A,
+ bool right,
+ bool left)
+{
+ A.assert_size(N, N);
+
+ A.assert_finite();
+ assert(! A.is_zero());
+
+ if (right)
+ R.set_size(N, N);
+ if (left)
+ L.set_size(N, N);
+
+ //
+ // Remember that fortran matrices and C matrices are transposed
+ // relative to each other. Moreover, the documentation for zgeev
+ // says that left eigenvectors u satisfy u^h A = lambda u^h,
+ // where ^h denotes adjoint (conjugate transpose).
+ // So we pass our left eigenvector storage as their right
+ // eigenvector storage and vice versa.
+ // But then we also have to conjugate our R after calling the routine.
+ //
+ vnl_matrix<vcl_complex<double> > tmp(A);
+
+ int work_space=10*N;
+ vnl_vector<vcl_complex<double> > work(work_space);
+
+ int rwork_space=2*N;
+ vnl_vector<double> rwork(rwork_space);
+
+ int info;
+ int tmpN = N;
+ zgeev_(right ? "V" : "N", // jobvl
+ left ? "V" : "N", // jobvr
+ &tmpN, // n
+ tmp.data_block(), // a
+ &tmpN, // lda
+ W.data_block(), // w
+ right ? R.data_block() : 0, // vl
+ &tmpN, // ldvl
+ left ? L.data_block() : 0, // vr
+ &tmpN, // ldvr
+ work.data_block(), // work
+ &work_space, // lwork
+ rwork.data_block(), // rwork
+ &info // info
+ );
+ assert(tmpN == int(N));
+
+ if (right) {
+ // conjugate all elements of R :
+ for (unsigned int i=0;i<N;i++)
+ for (unsigned int j=0;j<N;j++)
+ R(i,j) = vcl_conj( R(i,j) );
+ }
+
+ if (info == 0) {
+ // success
+ }
+ else if (info < 0) {
+ vcl_cerr << __FILE__ ": info = " << info << vcl_endl
+ << __FILE__ ": " << (-info) << "th argument has illegal value\n";
+ assert(false);
+ }
+ else /* if (info > 0) */ {
+ vcl_cerr << __FILE__ ": info = " << info << vcl_endl
+ << __FILE__ ": QR algorithm failed to compute all eigenvalues.\n";
+ vnl_matlab_print(vcl_cerr, A, "A", vnl_matlab_print_format_long);
+ assert(false);
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+//
+vnl_complex_eigensystem::vnl_complex_eigensystem(vnl_matrix<vcl_complex<double> > const &A,
+ bool right,
+ bool left)
+ : N(A.rows())
+ // L and R are intentionally not initialized.
+ , W(N)
+{
+ compute(A, right, left);
+}
+
+//
+vnl_complex_eigensystem::vnl_complex_eigensystem(vnl_matrix<double> const &A_real,
+ vnl_matrix<double> const &A_imag,
+ bool right,
+ bool left)
+ : N(A_real.rows())
+ // L and R are intentionally not initialized.
+ , W(N)
+{
+ A_real.assert_size(N,N);
+ A_imag.assert_size(N,N);
+
+ vnl_matrix<vcl_complex<double> > A(N,N);
+ vnl_complexify(A_real.begin(), A_imag.begin(), A.begin(), A.size());
+
+ compute(A, right, left);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.h
new file mode 100644
index 0000000000000000000000000000000000000000..bf94e069a7348296b9e48edbc501afa8e93b5773
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_complex_eigensystem.h
@@ -0,0 +1,65 @@
+#ifndef vnl_complex_eigensystem_h_
+#define vnl_complex_eigensystem_h_
+//:
+// \file
+// \brief Calculates eigenvalues and eigenvectors of a square complex matrix
+// \author fsm
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 26/03/2001: tidied up documentation
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Calculates eigenvalues and eigenvectors of a square complex matrix
+//
+// Class to compute and hold the eigenvalues and (optionally) eigenvectors
+// of a square complex matrix, using the LAPACK routine zgeev.
+//
+// Default behaviour is to compute the eigenvalues and the right
+// eigenvectors.
+//
+// The input NxN matrix A is passed into the constructor. The flags
+// right,left request the calculation of right and left eigenvectors
+// respectively. The compute eigenvalues are stored in the member 'W'.
+//
+// Computed right eigenvectors are stored in the **ROWS** of the
+// member 'R' and computed left eigenvectors are stored in the **ROWS**
+// of the member 'L'. When eigenvectors are not requested, the
+// corresponding matrices L and R will be empty.
+//
+// The ith right eigenvector v satisfies A*v = W[i]*v \n
+// The ith left eigenvector u satisfies u*A = W[i]*u (no conjugation)
+
+class vnl_complex_eigensystem
+{
+ public:
+ // please do not add underscores to my members - they are publicly accessible
+ unsigned int const N;
+ vnl_matrix<vcl_complex<double> > L; // left evecs
+ vnl_matrix<vcl_complex<double> > R; // right evecs
+ vnl_vector<vcl_complex<double> > W; // evals
+
+ // constructors
+ vnl_complex_eigensystem(vnl_matrix<double> const& A_real,
+ vnl_matrix<double> const& A_imag,
+ bool right=true, bool left=false);
+
+ vnl_complex_eigensystem(vnl_matrix<vcl_complex<double> > const& A,
+ bool right=true, bool left=false);
+
+ // convenience methods
+ vcl_complex<double> eigen_value(unsigned i) const { return W[i]; }
+ vnl_vector<vcl_complex<double> > left_eigen_vector(unsigned i)
+ const { return L.get_row(i); }
+ vnl_vector<vcl_complex<double> > right_eigen_vector(unsigned i)
+ const { return R.get_row(i); }
+
+ private:
+ void compute(vnl_matrix<vcl_complex<double> > const&,bool,bool);
+};
+
+#endif // vnl_complex_eigensystem_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4aa98f0d84b5ebbf7bf6ea01178753ed31f6c365
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.cxx
@@ -0,0 +1,213 @@
+// This is core/vnl/algo/vnl_conjugate_gradient.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Geoffrey Cross, Oxford RRG
+// \date 15 Feb 99
+//
+//-----------------------------------------------------------------------------
+#include "vnl_conjugate_gradient.h"
+
+#include <vcl_cstdlib.h>
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_vector_ref.h>
+
+// external netlib function
+extern "C"
+int cg_( double *x, // IO start guess
+ double *e, // O max-norm of gradient
+ int *it, // O number of iterations performed
+ double *step, // I step=0 make guess at first direction
+ // O step size along search direction for final iteration
+ double *t, // I tolerance (iterations stop when max-norm of gradient < t)
+ int *limit, // I maximum number of iterations
+ int *n, // I number of unknowns
+ int *m, // I number of iterations before renormalizing (normally m=n)
+ double value( double *x), // I value(x) is cost at x
+ int grad( double *g,
+ double *x), // I grad(g,x) puts gradient into g at x
+ int both( double *v,
+ double *g,
+ double *x), // I both(v,g,x) puts value in v and gradient in g at x
+ int pre( double *y,
+ double *z), // I preconditions (not necessarily needed) pre(y,z)
+ double *h ); // I space to work size h = 3*n
+
+/////////////////////////////////////
+
+class vnl_conjugate_gradient_Activate
+{
+ public:
+ static vnl_conjugate_gradient* current;
+
+ vnl_conjugate_gradient_Activate(vnl_conjugate_gradient* minimizer) {
+ if (current) {
+ vcl_cerr << "vnl_conjugate_gradient: ERROR: Nested minimizations not supported.\n";
+ vcl_abort();
+ // This is a copy of what goes on in LevenbergMarquardt, so if awf decides to
+ // fix that one, then maybe he could do the same here...
+ }
+ current = minimizer;
+ }
+ ~vnl_conjugate_gradient_Activate() {
+ current = 0;
+ }
+};
+
+vnl_conjugate_gradient *vnl_conjugate_gradient_Activate::current= 0;
+
+
+/////////////////////////////////////
+
+vnl_conjugate_gradient::~vnl_conjugate_gradient()
+{
+}
+
+void vnl_conjugate_gradient::init(vnl_cost_function &f)
+{
+ f_= &f;
+ num_iterations_ = 0;
+ num_evaluations_ = 0;
+ start_error_ = 0;
+ end_error_ = 0;
+}
+
+///////////////////////////////////////
+
+double vnl_conjugate_gradient::valuecomputer_(double *x)
+{
+ vnl_conjugate_gradient* active = vnl_conjugate_gradient_Activate::current;
+ vnl_cost_function* f = active->f_;
+ vnl_vector_ref<double> ref_x(f->get_number_of_unknowns(), x);
+
+ active->num_evaluations_++;
+
+ return f->f(ref_x);
+}
+
+int vnl_conjugate_gradient::gradientcomputer_(double *g, double *x)
+{
+ vnl_conjugate_gradient* active = vnl_conjugate_gradient_Activate::current;
+ vnl_cost_function* f = active->f_;
+ vnl_vector_ref<double> ref_x(f->get_number_of_unknowns(), x);
+ vnl_vector_ref<double> ref_g(f->get_number_of_unknowns(), g);
+
+ f->gradf(ref_x, ref_g);
+
+ return 0;
+}
+
+int vnl_conjugate_gradient::valueandgradientcomputer_(double *v, double *g, double *x)
+{
+ vnl_conjugate_gradient* active = vnl_conjugate_gradient_Activate::current;
+ vnl_cost_function* f = active->f_;
+ vnl_vector_ref<double> ref_x(f->get_number_of_unknowns(), x);
+ vnl_vector_ref<double> ref_g(f->get_number_of_unknowns(), g);
+
+ f->compute(ref_x, v, &ref_g);
+
+ return 0;
+}
+
+int vnl_conjugate_gradient::preconditioner_( double *out, double *in)
+{
+ // FIXME - there should be some way to set a preconditioner if you have one
+ // e.g. P = inv(diag(A'A)) for linear least squares systems.
+
+ vnl_conjugate_gradient* active = vnl_conjugate_gradient_Activate::current;
+ vnl_cost_function* f = active->f_;
+
+ int n = f->get_number_of_unknowns();
+ for (int i=0; i < n; ++i)
+ out[i] = in[i];
+
+ return 0;
+}
+
+///////////////////////////////////////
+
+// avoid anachronism warning from fussy compilers
+#ifdef VCL_SUNPRO_CC
+extern "C" double vnl_conjugate_gradient__valuecomputer_( double *x)
+{
+ return vnl_conjugate_gradient::valuecomputer_(x);
+}
+extern "C" int vnl_conjugate_gradient__gradientcomputer_( double *g, double *x)
+{
+ return vnl_conjugate_gradient::gradientcomputer_(g,x);
+}
+extern "C" int vnl_conjugate_gradient__valueandgradientcomputer_( double *v, double *g, double *x)
+{
+ return vnl_conjugate_gradient::valueandgradientcomputer_(v,g,x);
+}
+extern "C" int vnl_conjugate_gradient__preconditioner_( double *out, double *in)
+{
+ return vnl_conjugate_gradient::preconditioner_(out,in);
+}
+#endif
+
+bool vnl_conjugate_gradient::minimize( vnl_vector<double> &x)
+{
+ double *xp = x.data_block();
+ double max_norm_of_gradient;
+ int number_of_iterations;
+ final_step_size_ = 0;
+ double gradient_tolerance = gtol;
+ vnl_vector<double> workspace(f_->get_number_of_unknowns()*3);
+ int number_of_unknowns = f_->get_number_of_unknowns();
+
+ vnl_conjugate_gradient_Activate activator(this);
+
+ start_error_ = valuecomputer_(xp);
+ num_evaluations_ = 0;
+
+ cg_( xp,
+ &max_norm_of_gradient,
+ &number_of_iterations,
+ &final_step_size_,
+ &gradient_tolerance,
+ &maxfev,
+ &number_of_unknowns,
+ &number_of_unknowns,
+#ifdef VCL_SUNPRO_CC
+ vnl_conjugate_gradient__valuecomputer_,
+ vnl_conjugate_gradient__gradientcomputer_,
+ vnl_conjugate_gradient__valueandgradientcomputer_,
+ vnl_conjugate_gradient__preconditioner_,
+#else
+ valuecomputer_,
+ gradientcomputer_,
+ valueandgradientcomputer_,
+ preconditioner_,
+#endif
+ workspace.data_block());
+
+ end_error_= valuecomputer_(xp);
+ num_iterations_ = number_of_iterations;
+
+ return true;
+}
+
+
+void vnl_conjugate_gradient::diagnose_outcome(vcl_ostream& os) const
+{
+ os << "vnl_conjugate_gradient: "
+ << num_iterations_
+ << " iterations, "
+ << num_evaluations_
+ << " evaluations. Cost function reported error"
+ << f_->reported_error(start_error_)
+ << '/'
+ << f_->reported_error(end_error_)
+ << " . Final step size = " << final_step_size_
+ << vcl_endl;
+}
+
+void vnl_conjugate_gradient::diagnose_outcome() const
+{
+ diagnose_outcome(vcl_cout);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.h
new file mode 100644
index 0000000000000000000000000000000000000000..1d44573e4dc5b46e04b0c6744a1635ae8a00db31
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_conjugate_gradient.h
@@ -0,0 +1,90 @@
+// This is core/vnl/algo/vnl_conjugate_gradient.h
+#ifndef vnl_conjugate_gradient_h_
+#define vnl_conjugate_gradient_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief real function minimization
+// \author Geoffrey Cross, Oxford RRG
+// \date 15 Feb 99
+//
+// \verbatim
+// Modifications
+// 990215 Geoff Initial version.
+// 000628 David Capel - Major rewrite. Now derived from vnl_nonlinear_minimizer and operates on a vnl_cost_function.
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+class vnl_cost_function;
+
+//: real function minimization
+
+class vnl_conjugate_gradient : public vnl_nonlinear_minimizer
+{
+ public:
+ // Constructors/Destructors--------------------------------------------------
+
+ //: Initialize with the function object that is to be minimized.
+ vnl_conjugate_gradient(vnl_cost_function& f) { init( f); }
+
+ //: Initialize as above, and then run minimization.
+ vnl_conjugate_gradient(vnl_cost_function& f, vnl_vector<double>& x) {
+ init(f);
+ minimize(x);
+ }
+
+ //: Initialize all variables
+ void init(vnl_cost_function &f);
+
+ //: Destructor.
+ ~vnl_conjugate_gradient();
+
+ // Operations----------------------------------------------------------------
+
+ void diagnose_outcome(vcl_ostream&) const;
+ void diagnose_outcome(/*vcl_ostream& = vcl_cout*/) const;
+
+ // Computations--------------------------------------------------------------
+
+ //: Minimize the function supplied in the constructor until convergence or failure.
+ // On return, x is such that f(x) is the lowest value achieved.
+ // Returns true for convergence, false for failure.
+ bool minimize(vnl_vector<double>& x);
+
+ protected:
+ // Data Members--------------------------------------------------------------
+
+ vnl_cost_function *f_;
+ double final_step_size_;
+
+ // Helpers-------------------------------------------------------------------
+
+ friend class vnl_conjugate_gradient_Activate;
+
+#ifdef VCL_SUNPRO_CC
+ public:
+#endif
+ static double valuecomputer_( double *x);
+ static int gradientcomputer_( double *g, double *x);
+ static int valueandgradientcomputer_( double *v, double *g, double *x);
+ static int preconditioner_( double *out, double *in);
+
+#if 0
+ protected:
+ void approximate_gradient( const vnl_vector<double> &x,
+ vnl_vector<double> &g, const double step);
+ void approximate_hessian( const vnl_vector<double> &x,
+ vnl_matrix<double> &h, const double step);
+#endif
+};
+
+#endif // vnl_conjugate_gradient_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.h
new file mode 100644
index 0000000000000000000000000000000000000000..bb117f5f4a43593d7f715ed558910b19018deef1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.h
@@ -0,0 +1,108 @@
+// This is core/vnl/algo/vnl_convolve.h
+#ifndef vnl_convolve_h_
+#define vnl_convolve_h_
+//:
+// \file
+// \brief Templated 1D and 2D convolution
+// \author Peter Vanroose
+// \date 22 August 2001
+//
+// This file contains function declarations for 1D and 2D convolutions,
+// both cyclic and non-cyclic, of vnl_vectors and vnl_matrices.
+// One can choose between straightforward `time-domain' implementations
+// or using FFT to do a `frequency-domain' calculation.
+
+#include <vnl/vnl_vector.h>
+
+//: Convolve two vnl_vector<T>'s, possibly with different base types T.
+// $res[k] := \displaystyle\sum_{i=-\infty}^{+\infty} v1[k-i] \cdot v2[i]$.
+//
+// The returned vnl_vector has base type U (the third argument).
+// All calculations are done with type U, so take care!
+// To specify the third argument, pass e.g. a null pointer, casted to U*.
+// Thus: vnl_convolve(v1, v2, (double*)0)
+// would convolve v1 and v2, and return a vnl_vector<double>.
+//
+// This convolution is non-cyclic, and the length of the result is
+// one less than the sum of the lengths of the two input vectors.
+// But if one of the arguments has length 0, the result has length 0.
+//
+// When specifying a non-zero 4th argument, FFTs are used to compute
+// the result (see below), which should be identical.
+// The speed of execution may of course differ.
+// In this case both vectors are padded with a sufficient number of zeros,
+// making the length at least that 4th argument,
+// then vnl_convolve_cyclic() is applied.
+//
+template <class T1, class T2, class U>
+vnl_vector<U>
+vnl_convolve(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2,
+ U*, int use_fft = 0);
+
+
+//: Convolve two vnl_vector<T>'s, with the same base type T.
+//
+// The returned vnl_vector has the same base type T, and is identical to
+// the return value of the previous function when T1 = T2 = U.
+//
+template <class T>
+vnl_vector<T>
+vnl_convolve(vnl_vector<T> const& v1, vnl_vector<T> const& v2,
+ int use_fft = 0);
+
+
+//: Cyclically convolve two vnl_vector<T>'s of the same length.
+// $res[k] := \displaystyle\sum_{i=0}^{n-1} v1[k-i] \cdot v2[i]$.
+//
+// A cyclic convolution requires that the lengths of the input vectors
+// are identical. If this is not the case, an assert failure occurs.
+// The length of the returned vector equals the length of the inputs.
+//
+// Since the convolution theorem states that a cyclic convolution followed by
+// an FFT is the same as an FFT followed by a multiplication, a cyclic
+// convolution can also be implemented using 3 FFTs on n points and n complex
+// multiplications.
+// By default, vnl_convolve_cyclic does not use FFTs. By specifying "true" as
+// the fourth argument, calculation of the convolution is done using FFTs.
+// This will generally be faster for large n, especially if the vectors are
+// not sparse, and/or if n is a power of 2.
+//
+template <class T1, class T2, class U>
+vnl_vector<U>
+vnl_convolve_cyclic(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2,
+ U*, bool use_fft = false);
+
+// Not yet implemented
+template <class T1, class T2, class U>
+vnl_matrix<U>
+vnl_convolve(vnl_matrix<T1> const& v1, vnl_matrix<T2> const& v2,
+ U*, int use_fft = 0);
+
+// Not yet implemented
+template <class T>
+vnl_matrix<T>
+vnl_convolve(vnl_matrix<T> const& v1, vnl_matrix<T> const& v2,
+ int use_fft = 0);
+
+// Not yet implemented
+template <class T1, class T2, class U>
+vnl_matrix<U>
+vnl_convolve_cyclic(vnl_matrix<T1> const& v1, vnl_matrix<T2> const& v2,
+ U*, bool use_fft = false);
+
+// Not yet implemented
+template <class T1, class T2, class U>
+vnl_matrix<U>
+vnl_convolve(vnl_matrix<T1> const& v1, vnl_vector<T2> const& v2,
+ U*, int use_fft = 0);
+
+// Not yet implemented
+template <class T>
+vnl_matrix<T>
+vnl_convolve(vnl_matrix<T> const& v1, vnl_vector<T> const& v2,
+ int use_fft = 0);
+
+#define VNL_CONVOLVE_INSTANTIATE(T) \
+extern "please include vnl/algo/vnl_convolve.txx first"
+
+#endif // vnl_convolve_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.txx
new file mode 100644
index 0000000000000000000000000000000000000000..6321e199d15838798a7d3264cd1239660492a96f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_convolve.txx
@@ -0,0 +1,145 @@
+// This is core/vnl/algo/vnl_convolve.txx
+#ifndef vnl_convolve_txx_
+#define vnl_convolve_txx_
+
+#include "vnl_convolve.h"
+#include <vnl/algo/vnl_fft_1d.h> // this #includes <vcl_complex.h>
+#include <vcl_cassert.h>
+#include <vcl_iostream.h> // for warning messages
+
+template <class T1, class T2, class U>
+inline
+vnl_vector<U> vnl_convolve_cyclic_using_fft(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2, U*)
+{
+ assert (v1.size() == v2.size());
+ unsigned int n = v1.size();
+
+ typedef vcl_complex<double> C;
+ vnl_vector<C> w1(n, C(0)); for (unsigned i=0; i<n; ++i) w1[i]=v1[i];
+ vnl_vector<C> w2(n, C(0)); for (unsigned i=0; i<n; ++i) w2[i]=v2[i];
+
+ vnl_fft_1d<double> fft(n); fft.fwd_transform(w1); fft.fwd_transform(w2);
+ for (unsigned int i=0; i<n; ++i) w1[i] *= w2[i];
+ fft.bwd_transform(w1);
+#ifdef DEBUG
+ vcl_cout << w1 << vcl_endl;
+#endif
+
+ vnl_vector<U> r(n);
+ for (unsigned int i = 0; i<n; ++i)
+ r[i] = U(vcl_real(w1[i]) / n); // the imaginary part is certainly zero
+#ifdef DEBUG
+ for (unsigned int i = 0; i<n; ++i)
+ assert(vcl_imag(w1[i]) == 0);
+#endif
+ return r;
+}
+
+template <class T1, class T2, class U>
+vnl_vector<U> vnl_convolve_cyclic(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2, U*, bool use_fft)
+{
+ assert (v1.size() == v2.size());
+ unsigned int n = v1.size();
+
+ // Quick return if possible:
+ if (n == 0) return vnl_vector<U>(0, U(0));
+ if (n == 1) return vnl_vector<U>(1, U(v1[0]*v2[0]));
+
+ if (use_fft)
+ return vnl_convolve_cyclic_using_fft(v1, v2, (U*)0);
+
+ vnl_vector<U> ret(n, (U)0); // all elements already initialized to zero
+ for (unsigned int k=0; k<n; ++k)
+ {
+ for (unsigned int i=0; i<=k; ++i)
+ ret[k] += U(v1[k-i]) * U(v2[i]);
+ for (unsigned int i=k+1; i<n; ++i)
+ ret[k] += U(v1[n+k-i]) * U(v2[i]);
+ }
+
+ return ret;
+}
+
+inline bool has_only_primefactors_2_3_5(unsigned int n)
+{
+ if (n <= 1) return true;
+ while (n%2 == 0) n /= 2;
+ while (n%3 == 0) n /= 3;
+ while (n%5 == 0) n /= 5;
+ return n==1;
+}
+
+template <class T1, class T2, class U>
+inline
+vnl_vector<U> vnl_convolve_using_fft(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2, U*, int n)
+{
+ if (n+1 < int(v1.size() + v2.size())) n = v1.size() + v2.size() - 1;
+
+ // Make sure n has only prime factors 2, 3 and 5; if necessary, increase n.
+ while (!has_only_primefactors_2_3_5(n)) ++n;
+
+ // pad with zeros, so the cyclic convolution is a convolution:
+ vnl_vector<U> w1(n, U(0)); for (unsigned i=0; i<v1.size(); ++i) w1[i]=v1[i];
+ vnl_vector<U> w2(n, U(0)); for (unsigned i=0; i<v2.size(); ++i) w2[i]=v2[i];
+ // convolve, using n-points FFT:
+ w1 = vnl_convolve_cyclic_using_fft(w1, w2, (U*)0);
+ // return w1, but possibly drop the last few (zero) entries:
+ return vnl_vector<U>(v1.size()+v2.size()-1, v1.size()+v2.size()-1, w1.data_block());
+}
+
+template <class T>
+vnl_vector<T> vnl_convolve(vnl_vector<T> const& v1, vnl_vector<T> const& v2, int use_fft)
+{
+ // Quick return if possible:
+ if (v1.size() == 0 || v2.size() == 0)
+ return vnl_vector<T>(0);
+ if (v1.size() == 1) return v2*v1[0];
+ if (v2.size() == 1) return v1*v2[0];
+
+ if (use_fft != 0)
+ return vnl_convolve_using_fft(v1, v2, (T*)0, use_fft);
+
+ unsigned int n = v1.size() + v2.size() - 1;
+ vnl_vector<T> ret(n, (T)0); // all elements already initialized to zero
+ for (unsigned int k=0; k<v1.size(); ++k)
+ for (unsigned int i=0; i<=k && i<v2.size(); ++i)
+ ret[k] += v1[k-i] * v2[i];
+ for (unsigned int k=v1.size(); k<n; ++k)
+ for (unsigned int i=k+1-v1.size(); i<=k && i<v2.size(); ++i)
+ ret[k] += v1[k-i] * v2[i];
+
+ return ret;
+}
+
+template <class T1, class T2, class U>
+vnl_vector<U> vnl_convolve(vnl_vector<T1> const& v1, vnl_vector<T2> const& v2, U*, int use_fft)
+{
+ // Quick return if possible:
+ if (v1.size() == 0 || v2.size() == 0)
+ return vnl_vector<U>(0);
+
+ if (use_fft != 0)
+ return vnl_convolve_using_fft(v1, v2, (U*)0, use_fft);
+
+ unsigned int n = v1.size() + v2.size() - 1;
+ vnl_vector<U> ret(n, (U)0); // all elements already initialized to zero
+ for (unsigned int k=0; k<v1.size(); ++k)
+ for (unsigned int i=0; i<=k && i<v2.size(); ++i)
+ ret[k] += U(v1[k-i]) * U(v2[i]);
+ for (unsigned int k=v1.size(); k<n; ++k)
+ for (unsigned int i=k+1-v1.size(); i<=k && i<v2.size(); ++i)
+ ret[k] += U(v1[k-i]) * U(v2[i]);
+
+ return ret;
+}
+
+#undef VNL_CONVOLVE_INSTANTIATE
+#define VNL_CONVOLVE_INSTANTIATE_2(T,U) \
+template vnl_vector<U > vnl_convolve(vnl_vector<T > const&, vnl_vector<U > const&, U*, int); \
+template vnl_vector<U > vnl_convolve_cyclic(vnl_vector<T > const&, vnl_vector<U > const&, U*, bool)
+
+#define VNL_CONVOLVE_INSTANTIATE(T,U) \
+VNL_CONVOLVE_INSTANTIATE_2(T,U); \
+template vnl_vector<T > vnl_convolve(vnl_vector<T > const&, vnl_vector<T > const&, int)
+
+#endif // vnl_convolve_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8ceb7f141a85961667fe5f08303eeee82ef18dc4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.cxx
@@ -0,0 +1,43 @@
+/*
+ fsm
+*/
+#include "vnl_cpoly_roots.h"
+#include <vcl_cassert.h>
+#include <vnl/algo/vnl_complex_eigensystem.h>
+
+void vnl_cpoly_roots::compute(vnl_vector<vcl_complex<double> > const &a) {
+ // construct companion matrix
+ vnl_matrix<vcl_complex<double> > comp(N, N);
+ comp.fill(0);
+ for (unsigned i=0; i<N-1; ++i)
+ comp(i+1, i) = 1;
+ for (unsigned i=0; i<N; ++i)
+ comp(i, N-1) = -a[N-1-i];
+
+ // the eigenvalues of the companion matrix are the roots of the polynomial
+ solns = vnl_complex_eigensystem(comp,
+ false, // we only want
+ false).W; // the eigenvalues.
+}
+
+vnl_cpoly_roots::vnl_cpoly_roots(vnl_vector<vcl_complex<double> > const & a)
+ : solns(a.size())
+ , N(a.size()) // degree
+{
+ compute(a);
+}
+
+vnl_cpoly_roots::vnl_cpoly_roots(vnl_vector<double> const & a_real,
+ vnl_vector<double> const & a_imag)
+ : solns(a_real.size())
+ , N(a_real.size()) // degree
+{
+ assert(a_real.size() == a_imag.size());
+ vnl_vector<vcl_complex<double> > a(N);
+ for (unsigned i=0; i<N; ++i)
+ a[i] = vcl_complex<double>(a_real[i], a_imag[i]);
+
+ //vcl_cerr << "a = " << a << vcl_endl;
+ compute(a);
+ //vcl_cerr << "s = " << solns << vcl_endl;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.h
new file mode 100644
index 0000000000000000000000000000000000000000..803d37f4d2ea58555949c36d926094e35e1135d9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_cpoly_roots.h
@@ -0,0 +1,42 @@
+#ifndef vnl_cpoly_roots_h_
+#define vnl_cpoly_roots_h_
+
+//:
+// \file
+// \brief finds roots of a univariate polynomial with complex coefficients
+// \author fsm
+//
+// \verbatim
+// Modifications
+// dac (Manchester) March 28th 2001: Tidied documentation
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+
+//: Find all the roots of a univariate polynomial with complex coefficients.
+// Class to find all the roots of a univariate polynomial f
+// with complex coefficients. Currently works by computing the
+// eigenvalues of the companion matrix of f.
+//
+// The input vector a of coefficients are given to the constructor.
+// The polynomial is f = t^N + a[0] t^{N-1} + ... + a[N-1]
+// The roots can then be found in the 'solns' member.
+
+class vnl_cpoly_roots
+{
+public:
+ vnl_cpoly_roots(vnl_vector<vcl_complex<double> > const & a);
+ vnl_cpoly_roots(vnl_vector<double> const & a_real,
+ vnl_vector<double> const & a_imag);
+
+ // the roots can be found in here :
+ vnl_vector<vcl_complex<double> > solns;
+
+private:
+ unsigned N; //degree
+ //: does the actual work
+ void compute(vnl_vector<vcl_complex<double> > const & a);
+};
+
+#endif // vnl_cpoly_roots_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..52c8b14f56202814736a911ab5d22703d154fb38
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.cxx
@@ -0,0 +1,22 @@
+#include "vnl_determinant.h"
+#include <vcl_cassert.h>
+
+int vnl_determinant(vnl_matrix<int> const &M, bool balance )
+{
+ unsigned n = M.rows();
+ assert(M.cols() == n);
+
+ switch (n)
+ {
+ case 1: return M[0][0];
+ case 2: return vnl_determinant(M[0], M[1]);
+ case 3: return vnl_determinant(M[0], M[1], M[2]);
+ case 4: return vnl_determinant(M[0], M[1], M[2], M[3]);
+ default:
+ vnl_matrix<double> m(n,n);
+ for (unsigned int i=0; i<n; ++i)
+ for (unsigned int j=0; j<n; ++j)
+ m(i,j)=double(M(i,j));
+ return int(0.5+vnl_determinant(m, balance)); // round to nearest integer
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.h
new file mode 100644
index 0000000000000000000000000000000000000000..50d9cff7bcaee1b49f42b68fa47ec337f2b9061e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.h
@@ -0,0 +1,61 @@
+// This is core/vnl/algo/vnl_determinant.h
+#ifndef vnl_algo_determinant_h_
+#define vnl_algo_determinant_h_
+//:
+// \file
+// \brief calculates the determinant of a matrix
+// \author fsm
+//
+// Evaluation of determinants of any size. For small
+// matrices, will use the direct routines (no netlib)
+// but for larger matrices, a matrix decomposition
+// such as SVD or QR will be used.
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 26/03/2001: tidied up documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Sep.2003 - Peter Vanroose - specialisation for int added
+// \endverbatim
+
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_fixed.h>
+
+//: direct evaluation for 2x2 matrix
+template <class T> T vnl_determinant(T const *row0,
+ T const *row1);
+
+//: direct evaluation for 3x3 matrix
+template <class T> T vnl_determinant(T const *row0,
+ T const *row1,
+ T const *row2);
+
+//: direct evaluation for 4x4 matrix
+template <class T> T vnl_determinant(T const *row0,
+ T const *row1,
+ T const *row2,
+ T const *row3);
+
+// overload for int. Cannot specialize the template because gcc
+// 2.95.4 can't handle the default value. This overload must appear
+// before the template declaration because VC.net 7.0 gets confused
+// otherwise.
+int vnl_determinant(vnl_matrix<int> const &M, bool balance = false);
+
+//: evaluation using direct methods for sizes of 2x2, 3x3, and 4x4 or qr decomposition for other matrices.
+template <class T>
+T vnl_determinant(vnl_matrix<T> const &M, bool balance = false);
+
+//: convenience overload
+// See other vnl_determinant.
+template <class T, unsigned m, unsigned n>
+inline T vnl_determinant(vnl_matrix_fixed<T,m,n> const &M, bool balance = false)
+{
+ return vnl_determinant( M.as_ref(), balance );
+}
+
+
+#define VNL_DETERMINANT_INSTANTIATE(T) \
+extern "you must include vnl/algo/vnl_determinant.txx first"
+
+#endif // vnl_algo_determinant_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.txx
new file mode 100644
index 0000000000000000000000000000000000000000..db7fe63d66dc48187e639d7628bcf3e956c94303
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_determinant.txx
@@ -0,0 +1,151 @@
+#ifndef vnl_algo_determinant_txx_
+#define vnl_algo_determinant_txx_
+/*
+ fsm
+*/
+#include "vnl_determinant.h"
+
+#include <vcl_cassert.h>
+#include <vnl/algo/vnl_qr.h>
+
+
+template <class T>
+T vnl_determinant(T const *row0, T const *row1) {
+ return row0[0]*row1[1] - row0[1]*row1[0];
+}
+
+template <class T>
+T vnl_determinant(T const *row0, T const *row1, T const *row2) {
+ return // the extra '+' makes it work nicely with emacs indentation.
+ + row0[0]*row1[1]*row2[2]
+ - row0[0]*row2[1]*row1[2]
+ - row1[0]*row0[1]*row2[2]
+ + row1[0]*row2[1]*row0[2]
+ + row2[0]*row0[1]*row1[2]
+ - row2[0]*row1[1]*row0[2];
+}
+
+template <class T>
+T vnl_determinant(T const *row0, T const *row1, T const *row2, T const *row3) {
+ return
+ + row0[0]*row1[1]*row2[2]*row3[3]
+ - row0[0]*row1[1]*row3[2]*row2[3]
+ - row0[0]*row2[1]*row1[2]*row3[3]
+ + row0[0]*row2[1]*row3[2]*row1[3]
+ + row0[0]*row3[1]*row1[2]*row2[3]
+ - row0[0]*row3[1]*row2[2]*row1[3]
+ - row1[0]*row0[1]*row2[2]*row3[3]
+ + row1[0]*row0[1]*row3[2]*row2[3]
+ + row1[0]*row2[1]*row0[2]*row3[3]
+ - row1[0]*row2[1]*row3[2]*row0[3]
+ - row1[0]*row3[1]*row0[2]*row2[3]
+ + row1[0]*row3[1]*row2[2]*row0[3]
+ + row2[0]*row0[1]*row1[2]*row3[3]
+ - row2[0]*row0[1]*row3[2]*row1[3]
+ - row2[0]*row1[1]*row0[2]*row3[3]
+ + row2[0]*row1[1]*row3[2]*row0[3]
+ + row2[0]*row3[1]*row0[2]*row1[3]
+ - row2[0]*row3[1]*row1[2]*row0[3]
+ - row3[0]*row0[1]*row1[2]*row2[3]
+ + row3[0]*row0[1]*row2[2]*row1[3]
+ + row3[0]*row1[1]*row0[2]*row2[3]
+ - row3[0]*row1[1]*row2[2]*row0[3]
+ - row3[0]*row2[1]*row0[2]*row1[3]
+ + row3[0]*row2[1]*row1[2]*row0[3];
+}
+
+//--------------------------------------------------------------------------------
+
+template <class T>
+T vnl_determinant(vnl_matrix<T> const &M, bool balance)
+{
+ unsigned n = M.rows();
+ assert(M.cols() == n);
+
+ switch (n) {
+ case 1: return M[0][0];
+ case 2: return vnl_determinant(M[0], M[1]);
+ case 3: return vnl_determinant(M[0], M[1], M[2]);
+ case 4: return vnl_determinant(M[0], M[1], M[2], M[3]);
+ default:
+ if (balance) {
+ vnl_matrix<T> tmp(M);
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ abs_t scalings(1);
+ for (int t=0; t<5; ++t) {
+#if 1
+ // normalize rows.
+ for (unsigned int i=0; i<n; ++i) {
+ abs_t rn = tmp.get_row(i).rms();
+ if (rn > 0) {
+ scalings *= rn;
+ tmp.scale_row(i, abs_t(1)/rn);
+ }
+ }
+#endif
+#if 1
+ // normalize columns.
+ for (unsigned int i=0; i<n; ++i) {
+ abs_t rn = tmp.get_column(i).rms();
+ if (rn > 0) {
+ scalings *= rn;
+ tmp.scale_column(i, abs_t(1)/rn);
+ }
+ }
+#endif
+#if 0
+ // pivot
+ for (int k=0; k<n-1; ++k) {
+ // find largest element after (k, k):
+ int i0 = k, j0 = k;
+ abs_t v0(0);
+ for (int i=k; i<n; ++i) {
+ for (int j=k; j<n; ++j) {
+ abs_t v = vcl_abs(tmp[i][j]);
+ if (v > v0) {
+ i0 = i;
+ j0 = j;
+ v0 = v;
+ }
+ }
+ }
+ // largest element is in position (i0, j0).
+ if (i0 != k) {
+ for (int j=0; j<n; ++j)
+ vcl_swap(tmp[k][j], tmp[i0][j]);
+ scalings = -scalings;
+ }
+ if (j0 != k) {
+ for (int i=0; i<n; ++i)
+ vcl_swap(tmp[i][k], tmp[i][j0]);
+ scalings = -scalings;
+ }
+ }
+#endif
+ }
+ T balanced_det = vnl_qr<T>(tmp).determinant();
+ //vcl_clog << __FILE__ ": scalings, balanced_det = " << scalings << ", " << balanced_det << vcl_endl;
+ return T(scalings) * balanced_det;
+ }
+ else
+ return vnl_qr<T>(M).determinant();
+ }
+}
+
+
+//--------------------------------------------------------------------------------
+
+#define VNL_DETERMINANT_INSTANTIATE_1(T) \
+template T vnl_determinant(T const *, T const *); \
+template T vnl_determinant(T const *, T const *, T const *); \
+template T vnl_determinant(T const *, T const *, T const *, T const *)
+
+#define VNL_DETERMINANT_INSTANTIATE_2(T) \
+template T vnl_determinant(vnl_matrix<T > const &, bool)
+
+#undef VNL_DETERMINANT_INSTANTIATE
+#define VNL_DETERMINANT_INSTANTIATE(T) \
+VNL_DETERMINANT_INSTANTIATE_1(T); \
+VNL_DETERMINANT_INSTANTIATE_2(T)
+
+#endif // vnl_algo_determinant_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ce165e0ea5c24e14fc446782e8c2f88ea3bc7cf7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.cxx
@@ -0,0 +1,127 @@
+#include "vnl_discrete_diff.h"
+#include <vnl/vnl_least_squares_function.h>
+#include <vcl_cassert.h>
+/*
+ fsm
+*/
+
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ double h_,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J)
+{
+ vnl_vector<double> y(lsf->get_number_of_residuals());
+ lsf->f(x,y);
+ if (lsf->failure)
+ return false;
+ vnl_vector<double> h(lsf->get_number_of_unknowns());
+ h.fill(h_);
+ return vnl_discrete_diff_fwd(lsf,h,x,y,J);
+}
+
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J)
+{
+ vnl_vector<double> y(lsf->get_number_of_residuals());
+ lsf->f(x,y);
+ if (lsf->failure)
+ return false;
+ return vnl_discrete_diff_fwd(lsf,h,x,y,J);
+}
+
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_vector<double> const &y,
+ vnl_matrix<double> &J)
+{
+ unsigned m=J.rows();
+ unsigned n=J.columns();
+ assert(m==lsf->get_number_of_residuals());
+ assert(m==y.size());
+ assert(n==lsf->get_number_of_unknowns());
+ assert(n==h.size());
+ assert(n==x.size());
+
+ vnl_vector<double> tx(n);
+ vnl_vector<double> ty(m);
+
+ for (unsigned j=0;j<n;j++) {
+ tx=x; tx(j) += h(j);
+ lsf->f(tx,ty);
+ if (lsf->failure)
+ return false;
+ for (unsigned i=0;i<m;i++)
+ J(i,j) = (ty(i)-y(i))/h(j);
+ }
+ return true;
+}
+
+bool vnl_discrete_diff_sym(vnl_least_squares_function *lsf,
+ double h_,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J)
+{
+ vnl_vector<double> h(lsf->get_number_of_unknowns());
+ h.fill(h_);
+ return vnl_discrete_diff_sym(lsf,h,x,J);
+}
+
+bool vnl_discrete_diff_sym(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J)
+{
+ unsigned m=J.rows();
+ unsigned n=J.columns();
+ assert(m==lsf->get_number_of_residuals());
+ assert(n==lsf->get_number_of_unknowns());
+ assert(n==h.size());
+ assert(n==x.size());
+
+ vnl_vector<double> xp(n),xm(n);
+ vnl_vector<double> yp(m),ym(m);
+
+ for (unsigned j=0;j<n;j++) {
+ xp=x; xp(j) += h(j);
+ lsf->f(xp,yp);
+ if (lsf->failure)
+ return false;
+
+ xm=x; xm(j) -= h(j);
+ lsf->f(xm,ym);
+ if (lsf->failure)
+ return false;
+
+ for (unsigned i=0;i<m;i++)
+ J(i,j) = (yp(i)-ym(i))/(2*h(j));
+ }
+ return true;
+}
+
+//----------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+
+void vnl_discrete_diff_test_lsf(vnl_least_squares_function *lsf, vnl_vector<double> const &x)
+{
+ unsigned int m = lsf->get_number_of_residuals();
+ unsigned int n = lsf->get_number_of_unknowns ();
+ assert(x.size() == n);
+
+ vnl_matrix<double> J1(m, n);
+ lsf->gradf(x, J1);
+
+ vnl_matrix<double> J2(m, n);
+ vnl_discrete_diff_sym(lsf, 0.0001, x, J2);
+
+ double e = (J1 - J2).fro_norm();
+ //assert(e <= 1e-3);
+ double t = cos_angle(J1, J2);
+ //assert(t >= 0.99);
+
+ vcl_cerr << __FILE__ ": e = " << e << vcl_endl
+ << __FILE__ ": t = " << t << vcl_endl;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.h
new file mode 100644
index 0000000000000000000000000000000000000000..2ffa13f36fa46e9c2afec95fa97a0b018d7b9dea
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_discrete_diff.h
@@ -0,0 +1,67 @@
+#ifndef vnl_discrete_diff_h_
+#define vnl_discrete_diff_h_
+
+//:
+// \file
+// \brief Functions to compute jacobians of vnl_least_squares_functions
+//
+// Functions to compute jacobians of vnl_least_squares_functions
+// by discrete differences. They return false on failure and
+// true on success.
+//
+// \verbatim
+// name size description
+//
+// lsf --- the function.
+// h 1 or n step size (scalar or a vector).
+// x n point at which to evaluate the derivative of the function.
+// y m value of the function at x.
+// J mxn jacobian of the function at x.
+// \endverbatim
+//
+// \author fsm
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// Peter Vanroose 27/05/2001: Corrected documentation
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+class vnl_least_squares_function;
+
+//: forward differences
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ double h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J);
+
+//: forward differences
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J);
+
+//: forward differences
+bool vnl_discrete_diff_fwd(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_vector<double> const &y,
+ vnl_matrix<double> &J);
+
+//: symmetric differences
+bool vnl_discrete_diff_sym(vnl_least_squares_function *lsf,
+ double h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J);
+
+//: symmetric differences
+bool vnl_discrete_diff_sym(vnl_least_squares_function *lsf,
+ vnl_vector<double> const &h,
+ vnl_vector<double> const &x,
+ vnl_matrix<double> &J);
+
+void vnl_discrete_diff_test_lsf(vnl_least_squares_function *lsf, vnl_vector<double> const &x);
+
+#endif // vnl_discrete_diff_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..952135d25a1a5b1de094bc9aa36855f4b8f33309
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.cxx
@@ -0,0 +1,37 @@
+// This is core/vnl/algo/vnl_fft.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_fft.h"
+
+#include <vnl/algo/vnl_netlib.h> // dgpfa_()
+
+void vnl_fft_setgpfa(float *triggs, int size, int pqr[3], int *info)
+{
+ setgpfa_(triggs, &size, pqr, info);
+}
+
+void vnl_fft_setgpfa(double *triggs, int size, int pqr[3], int *info)
+{
+ dsetgpfa_(triggs, &size, pqr, info);
+}
+
+//----------------------------------------------------------------------
+
+void vnl_fft_gpfa(float *a, float *b, float const *triggs,
+ int inc, int jump, int n,
+ int lot, int isign, int const pqr[3], int *info)
+{
+ gpfa_(a, b, triggs, &inc, &jump, &n, &lot, &isign, pqr, info);
+}
+
+void vnl_fft_gpfa(double *a, double *b, double const *triggs,
+ int inc, int jump, int n,
+ int lot, int isign, int const pqr[3], int *info)
+{
+ dgpfa_(a, b, triggs, &inc, &jump, &n, &lot, &isign, pqr, info);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.h
new file mode 100644
index 0000000000000000000000000000000000000000..48a6b794475776b6ef79dde1dc5d8b41a33195f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft.h
@@ -0,0 +1,48 @@
+// This is core/vnl/algo/vnl_fft.h
+#ifndef vnl_fft_h_
+#define vnl_fft_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author fsm
+
+#include <vcl_compiler.h>
+
+//: use C++ overloading to find the correct FORTRAN routine from templated FFT code.
+void vnl_fft_setgpfa(float *triggs, int size, int pqr[3], int *info);
+//: use C++ overloading to find the correct FORTRAN routine from templated FFT code.
+void vnl_fft_setgpfa(double *triggs, int size, int pqr[3], int *info);
+
+
+// CALL GPFA(A,B,TRIGS,INC,JUMP,N,LOT,ISIGN,NIPQ,INFO)
+//
+// A IS FIRST REAL INPUT/OUTPUT VECTOR
+// B IS FIRST IMAGINARY INPUT/OUTPUT VECTOR
+// TRIGS IS A TABLE OF TWIDDLE FACTORS, PRECALCULATED
+// BY CALLING SUBROUTINE 'SETGPFA'
+// INC IS THE INCREMENT WITHIN EACH DATA VECTOR
+// JUMP IS THE INCREMENT BETWEEN DATA VECTORS
+// N IS THE LENGTH OF THE TRANSFORMS:
+// -----------------------------------
+// N = (2**IP) * (3**IQ) * (5**IR)
+// -----------------------------------
+// LOT IS THE NUMBER OF TRANSFORMS
+// ISIGN = +1 FOR FORWARD TRANSFORM
+// = -1 FOR INVERSE TRANSFORM
+// NIPQ is an array containing the number of factors (for
+// power of 2,3 and 5
+// INFO is set to -1 if there is a problem, 0 otherwise
+
+// These functions perform a number (LOT) of 1D FFTs, each of the same signal size (N).
+// The signal is stored in two real arrays (A, B), with consecutive elements separated
+// by a stride (INC). The separation between the LOT signals to be transformed is JUMP.
+void vnl_fft_gpfa(float *a, float *b, float const *triggs,
+ int inc, int jump, int n,
+ int lot, int isign, int const pqr[3], int *info);
+void vnl_fft_gpfa(double *a, double *b, double const *triggs,
+ int inc, int jump, int n,
+ int lot, int isign, int const pqr[3], int *info);
+
+#endif // vnl_fft_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.h
new file mode 100644
index 0000000000000000000000000000000000000000..3c7034d52c08a89d696582e12948c0693b7aa8d6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.h
@@ -0,0 +1,81 @@
+// This is core/vnl/algo/vnl_fft_1d.h
+#ifndef vnl_fft_1d_h_
+#define vnl_fft_1d_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief In-place 1D fast Fourier transform
+// \author fsm
+//
+// \verbatim
+// Modifications
+// 19 June 2003 - Peter Vanroose - added cmplx* and vector<cmplx> interfaces
+// \endverbatim
+
+
+#if (defined _MSC_VER) && _MSC_VER == 1200
+// disable warning buried deep in the standard library
+// warning C4018: '<' : signed/unsigned mismatch: vector(159)
+# pragma warning(disable: 4018)
+#endif
+
+
+#include <vcl_vector.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_fft_base.h>
+
+//: In-place 1D fast Fourier transform
+
+template <class T>
+struct vnl_fft_1d : public vnl_fft_base<1, T>
+{
+ typedef vnl_fft_base<1, T> base;
+
+ //: constructor takes length of signal.
+ vnl_fft_1d(int N) {
+ base::factors_[0].resize(N);
+ }
+
+ //: return length of signal.
+ unsigned int size() const { return base::factors_[0].number(); }
+
+ //: dir = +1/-1 according to direction of transform.
+ void transform(vcl_vector<vcl_complex<T> > &signal, int dir)
+ { base::transform(&signal[0], dir); }
+
+ //: dir = +1/-1 according to direction of transform.
+ void transform(vcl_complex<T> *signal, int dir)
+ { base::transform(signal, dir); }
+
+ //: dir = +1/-1 according to direction of transform.
+ void transform(vnl_vector<vcl_complex<T> > &signal, int dir)
+ { base::transform(signal.data_block(), dir); }
+
+ //: forward FFT
+ void fwd_transform(vcl_vector<vcl_complex<T> > &signal)
+ { transform(signal, +1); }
+
+ //: forward FFT
+ void fwd_transform(vcl_complex<T> *signal)
+ { transform(signal, +1); }
+
+ //: forward FFT
+ void fwd_transform(vnl_vector<vcl_complex<T> > &signal)
+ { transform(signal, +1); }
+
+ //: backward (inverse) FFT
+ void bwd_transform(vcl_vector<vcl_complex<T> > &signal)
+ { transform(signal, -1); }
+
+ //: backward (inverse) FFT
+ void bwd_transform(vcl_complex<T> *signal)
+ { transform(signal, -1); }
+
+ //: backward (inverse) FFT
+ void bwd_transform(vnl_vector<vcl_complex<T> > &signal)
+ { transform(signal, -1); }
+};
+
+#endif // vnl_fft_1d_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.txx
new file mode 100644
index 0000000000000000000000000000000000000000..84d23ffa996e82515282c91e933f139c1781fb33
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_1d.txx
@@ -0,0 +1,11 @@
+#ifndef vnl_fft_1d_txx_
+#define vnl_fft_1d_txx_
+// -*- c++ -*-
+
+#include "vnl_fft_1d.h"
+
+#undef VNL_FFT_1D_INSTANTIATE
+#define VNL_FFT_1D_INSTANTIATE(T) \
+template struct vnl_fft_1d<T >
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.h
new file mode 100644
index 0000000000000000000000000000000000000000..3104a5dc5bbb69f7481dd6f535dd268096eaa9fa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.h
@@ -0,0 +1,45 @@
+// This is core/vnl/algo/vnl_fft_2d.h
+#ifndef vnl_fft_2d_h_
+#define vnl_fft_2d_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief In-place 2D fast Fourier transform
+// \author fsm
+
+#include <vnl/vnl_matrix.h>
+#include <vnl/algo/vnl_fft_base.h>
+
+//: In-place 2D fast Fourier transform
+
+template <class T>
+struct vnl_fft_2d : public vnl_fft_base<2, T>
+{
+ typedef vnl_fft_base<2, T> base;
+
+ //: constructor takes size of signal.
+ vnl_fft_2d(int M, int N) {
+ base::factors_[0].resize(M);
+ base::factors_[1].resize(N);
+ }
+
+ //: dir = +1/-1 according to direction of transform.
+ void transform(vnl_matrix<vcl_complex<T> > &signal, int dir)
+ { base::transform(signal.data_block(), dir); }
+
+ //: forward FFT
+ void fwd_transform(vnl_matrix<vcl_complex<T> > &signal)
+ { transform(signal, +1); }
+
+ //: backward (inverse) FFT
+ void bwd_transform(vnl_matrix<vcl_complex<T> > &signal)
+ { transform(signal, -1); }
+
+ //: return size of signal.
+ unsigned rows() const { return base::factors_[0].number(); }
+ unsigned cols() const { return base::factors_[1].number(); }
+};
+
+#endif // vnl_fft_2d_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.txx
new file mode 100644
index 0000000000000000000000000000000000000000..0a1b0d65ec5782e9fd83141a3643eafffed5088d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_2d.txx
@@ -0,0 +1,11 @@
+#ifndef vnl_fft_2d_txx_
+#define vnl_fft_2d_txx_
+// -*- c++ -*-
+
+#include "vnl_fft_2d.h"
+
+#undef VNL_FFT_2D_INSTANTIATE
+#define VNL_FFT_2D_INSTANTIATE(T) \
+template struct vnl_fft_2d<T >
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.h
new file mode 100644
index 0000000000000000000000000000000000000000..b6a0070ed64212cd87350bd90ed0a92229242923
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.h
@@ -0,0 +1,30 @@
+// This is core/vnl/algo/vnl_fft_base.h
+#ifndef vnl_fft_base_h_
+#define vnl_fft_base_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief In-place n-D fast Fourier transform
+// \author fsm
+
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_fft_prime_factors.h>
+
+//: Base class for in-place ND fast Fourier transform.
+
+export template <int D, class T>
+struct vnl_fft_base
+{
+ vnl_fft_base() { }
+
+ //: dir = +1/-1 according to direction of transform.
+ void transform(vcl_complex<T> *signal, int dir);
+
+ protected:
+ //: prime factorizations of signal dimensions.
+ vnl_fft_prime_factors<T> factors_[D];
+};
+
+#endif // vnl_fft_base_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.txx
new file mode 100644
index 0000000000000000000000000000000000000000..a269eedfa68598a4a276491ace652b7a0cd78ab5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_base.txx
@@ -0,0 +1,60 @@
+#ifndef vnl_fft_base_txx_
+#define vnl_fft_base_txx_
+/*
+ fsm
+*/
+#include "vnl_fft_base.h"
+#include <vnl/algo/vnl_fft.h>
+#include <vcl_cassert.h>
+
+template <int D, class T>
+void vnl_fft_base<D, T>::transform(vcl_complex<T> *signal, int dir)
+{
+ assert((dir == +1) || (dir == -1));
+
+ // transform along each dimension, i, in turn.
+ for (int i=0; i<D; ++i) {
+ int N1 = 1; // n[0] n[1] ... n[i-1]
+ int N2 = 1; // n[i]
+ int N3 = 1; // n[i+1] n[i+2] ... n[D-1]
+ for (int j=0; j<D; ++j) {
+ int d = factors_[j].number();
+ if (j < i) N1 *= d;
+ if (j == i) N2 *= d;
+ if (j > i) N3 *= d;
+ }
+
+ // pretend the signal is N1xN2xN3. we want to transform
+ // along the second dimension.
+ for (int n1=0; n1<N1; ++n1) {
+ // FIXME: we could avoid one loop by using the LOT parameter
+ // but it's not entirely clear that would save us anything.
+
+ for (int n3=0; n3<N3; ++n3) {
+ // This relies on the assumption that std::complex<T> is layout
+ // compatible with "struct { T real; T imag; }". It is probably
+ // a valid assumption for all sane C++ libraries.
+ T *data = (T *) (signal + n1*N2*N3 + n3);
+
+ int info = 0;
+ vnl_fft_gpfa (/* A */ data,
+ /* B */ data + 1,
+ /* TRIGS */ factors_[i].trigs (),
+ /* INC */ 2*N3,
+ /* JUMP */ 0,
+ /* N */ N2,
+ /* LOT */ 1,
+ /* ISIGN */ dir,
+ /* NIPQ */ factors_[i].pqr (),
+ /* INFO */ &info);
+ assert(info != -1);
+ }
+ }
+ }
+}
+
+#undef VNL_FFT_BASE_INSTANTIATE
+#define VNL_FFT_BASE_INSTANTIATE(D, T) \
+template struct vnl_fft_base<D, T >
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.h
new file mode 100644
index 0000000000000000000000000000000000000000..3b694d0648522257aa8910579a7abb7b01edcbfe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.h
@@ -0,0 +1,70 @@
+// This is core/vnl/algo/vnl_fft_prime_factors.h
+#ifndef vnl_fft_prime_factors_h_
+#define vnl_fft_prime_factors_h_
+//:
+// \file
+// \brief Holds prime factor information
+// \author Veit U.B. Schenk, Oxford RRG
+// \date 19 Mar 98
+//
+// \verbatim
+// Modifications
+// 10/4/2001 Ian Scott (Manchester) Converted perceps header to doxygen
+// \endverbatim
+
+#include <vcl_compiler.h> // for "export" keyword
+
+//: Holds prime factor information
+// Helper class used by the vnl_fft_xd<> FFT routines
+//
+// Given an integer N of the form
+// $N = 2^P 3^Q 5^R$
+// split N into its primefactors (2, 3, 5)
+
+export template <class T>
+struct vnl_fft_prime_factors
+{
+private:
+ VCL_SAFE_BOOL_DEFINE;
+public:
+ vnl_fft_prime_factors();
+
+ //: constructor takes the size of the signal.
+ vnl_fft_prime_factors(int N) { construct(N); }
+
+ ~vnl_fft_prime_factors () { destruct(); }
+
+ //: array of twiddle factors.
+ T const *trigs () const { return trigs_; }
+
+ //: number which was factorized
+ int number () const { return number_; }
+
+ //: exponents P, Q, R.
+ int const *pqr () const { return pqr_; }
+
+ operator safe_bool () const
+ { return (trigs_ && info_ >= 0)? VCL_SAFE_BOOL_TRUE : 0; }
+ bool operator!() const
+ { return (trigs_ && info_ >= 0)? false : true; }
+
+ void resize(int N) {
+ destruct();
+ construct(N);
+ }
+
+ private:
+ T *trigs_;
+ int number_; // the number that is being split into prime-facs
+ int pqr_[3]; // store P, Q and R
+ int info_;
+
+ void construct(int N);
+ void destruct();
+
+ // disallow copying
+ vnl_fft_prime_factors (vnl_fft_prime_factors<T> const &) { }
+ void operator= (vnl_fft_prime_factors<T> const &) { }
+};
+
+#endif // vnl_fft_prime_factors_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.txx
new file mode 100644
index 0000000000000000000000000000000000000000..f3b0d3ae1f13bd64c4aa8a7c8e7775d8f84e00c8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_fft_prime_factors.txx
@@ -0,0 +1,40 @@
+#ifndef vnl_fft_prime_factors_txx_
+#define vnl_fft_prime_factors_txx_
+/*
+ fsm
+*/
+#include "vnl_fft_prime_factors.h"
+#include <vnl/algo/vnl_fft.h>
+#include <vcl_cassert.h>
+
+template <class T>
+vnl_fft_prime_factors<T>::vnl_fft_prime_factors()
+ : trigs_(0)
+ , number_(0)
+{
+}
+
+template <class T>
+void vnl_fft_prime_factors<T>::construct(int N)
+{
+ assert(N>0);
+ trigs_ = new T[2*N];
+ number_ = N;
+ vnl_fft_setgpfa (trigs_, number_, pqr_, &info_);
+ // info_ == -1 if cannot split into primes
+ if (info_ == -1)
+ assert(!"you probably gave a signal size not of the form 2^p 3^q 5^r");
+}
+
+template <class T>
+void vnl_fft_prime_factors<T>::destruct()
+{
+ if (trigs_)
+ delete [] trigs_;
+}
+
+#undef VNL_FFT_PRIME_FACTORS_INSTANTIATE
+#define VNL_FFT_PRIME_FACTORS_INSTANTIATE(T) \
+template struct vnl_fft_prime_factors<T >
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7fe2cc79771ee1f296df26fc242d2e437d15ef51
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.cxx
@@ -0,0 +1,45 @@
+// This is core/vnl/algo/vnl_gaussian_kernel_1d.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 07 Aug 97
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_gaussian_kernel_1d.h"
+#include <vcl_cmath.h>
+#include <vnl/vnl_math.h>
+
+// G(x) = 1/(sigma * sqrt(2*pi)) * exp(-0.5 * (x/sigma)^2)
+// x(g) = sigma * sqrt(-2 * log(g * sigma * sqrt(2*pi) ) )
+
+// Compute the x value at which a Gaussian becomes lower than cutoff.
+static inline
+double compute_width(double sigma, double cutoff)
+{
+ return sigma * vcl_sqrt(-2 * vcl_log(cutoff * sigma * vcl_sqrt(2*vnl_math::pi)));
+}
+
+//: Construct a sampled 1D gaussian of standard deviation sigma.
+// The vector is normalized so that its sum is 0.5.
+vnl_gaussian_kernel_1d::vnl_gaussian_kernel_1d(double sigma, double cutoff):
+ vec_((int)vcl_ceil(compute_width(sigma, cutoff)))
+{
+ int width = vec_.size();
+ inscale_ = 0.5/(sigma * sigma);
+ double area = 0;
+ for (int i = 0; i < width; ++i) {
+ double v = G(i);
+ area += v;
+ vec_[i] = v;
+ }
+ vec_ *= (0.5/area);
+}
+
+double vnl_gaussian_kernel_1d::G(double x) const
+{
+ return vcl_exp(-x*x * inscale_);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.h
new file mode 100644
index 0000000000000000000000000000000000000000..57ac6d76a7d909973313c4df16930616c28bc45e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_gaussian_kernel_1d.h
@@ -0,0 +1,42 @@
+// This is core/vnl/algo/vnl_gaussian_kernel_1d.h
+#ifndef vnl_gaussian_kernel_1d_h_
+#define vnl_gaussian_kernel_1d_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Holds one half of a discretely sampled 1D gaussian distribution
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 07 Aug 97
+//
+// \verbatim
+// Modifications
+// 970807 AWF Initial version.
+// dac (Manchester) 28/03/2001: tidied up documentation
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+
+//: Holds one half of a discretely sampled 1D gaussian distribution
+// vnl_gaussian_kernel_1d is a class that holds one half of a discretely
+// sampled 1D gaussian distribution.
+
+class vnl_gaussian_kernel_1d
+{
+ public:
+ // Constructors/Destructors--------------------------------------------------
+ vnl_gaussian_kernel_1d(double sigma, double cutoff = 0.5/256.0);
+
+ double G(double x) const;
+
+ int width() const { return vec_.size(); }
+ double operator [] (int i) const { return vec_[i]; }
+
+ protected:
+ // Data Members--------------------------------------------------------------
+ vnl_vector<double> vec_;
+ double inscale_;
+};
+
+#endif // vnl_gaussian_kernel_1d_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..54255eecff73a50f920055d7164bf90cbdf39c22
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.cxx
@@ -0,0 +1,116 @@
+// This is core/vnl/algo/vnl_generalized_eigensystem.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//
+// vnl_generalized_eigensystem
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 29 Aug 96
+//
+
+#include "vnl_generalized_eigensystem.h"
+
+#include <vcl_iostream.h>
+#ifdef VCL_SGI_CC_730
+# include <vcl_cmath.h>
+#endif
+
+#include <vnl/vnl_fortran_copy.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/algo/vnl_netlib.h> // rsg_()
+
+vnl_generalized_eigensystem::vnl_generalized_eigensystem(const vnl_matrix<double>& A,
+ const vnl_matrix<double>& B)
+ :
+ n(A.rows()), V(n,n), D(n)
+{
+ // Copy source matrices into fortran storage
+ vnl_fortran_copy<double> a(A);
+ vnl_fortran_copy<double> b(B);
+
+ // Make workspace and storage for V transpose
+ vnl_vector<double> work1(n);
+ vnl_vector<double> work2(n);
+ vnl_vector<double> V1(n*n);
+
+ int want_eigenvectors = 1;
+ int ierr = -1;
+
+ // Call EISPACK rsg.
+ rsg_ (&n, &n, a, b, D.data_block(),
+ &want_eigenvectors,
+ V1.begin(),
+ work1.begin(),
+ work2.begin(), &ierr);
+
+ // If b was not pos-def, retry with projection onto nullspace
+ if (ierr == 7*n+1) {
+ const double THRESH = 1e-8;
+ vnl_symmetric_eigensystem<double> eig(B);
+ if (eig.D(0,0) < -THRESH) {
+ vcl_cerr << "**** vnl_generalized_eigensystem: ERROR\n"
+ << "Matrix B is not nonneg-definite\n";
+ vnl_matlab_print(vcl_cerr, B, "B");
+ vcl_cerr << "**** eigenvalues(B) = " << eig.D << vcl_endl;
+ return;
+ }
+ // hmmmmm - all this crap below is worse than whatever the default is...
+ return;
+#if 0 // so don't compile it then...
+ int rank_deficiency = 0;
+ while (eig.D(rank_deficiency,rank_deficiency) < THRESH)
+ ++rank_deficiency;
+ int rank = B.columns() - rank_deficiency;
+
+ vcl_cerr << "vnl_generalized_eigensystem: B rank def by " << rank_deficiency << vcl_endl;
+ // M is basis for non-nullspace of B
+ vnl_matrix<double> M = eig.V.get_n_columns(rank_deficiency, rank);
+ vnl_matrix<double> N = eig.V.get_n_columns(0, rank_deficiency);
+
+ vnl_svd<double> svd(vnl_transpose(M)*A*N);
+
+ vnl_generalized_eigensystem reduced(vnl_transpose(M) * A * M,
+ vnl_transpose(M) * B * M);
+
+ vcl_cerr << "AN: " << reduced.D << vcl_endl;
+
+ vnl_matrix<double> V05 = M * vnl_transpose(reduced.V);
+ vnl_svd<double> sv6(V05.transpose());
+ V.update(V05, 0, 0);
+ V.update(sv6.nullspace(), 0, rank - 1);
+ for (int i = 0; i < rank; ++i)
+ D(i,i) = reduced.D(i,i);
+ for (unsigned i = rank; i < B.columns(); ++i)
+ D(i,i) = 0;
+ vcl_cerr << "AN: " << D << vcl_endl;
+
+ return;
+#endif
+ }
+
+ // transpose-copy V1 to V
+ {
+ double *vptr = &V1[0];
+ for (int c = 0; c < n; ++c)
+ for (int r = 0; r < n; ++r)
+ V(r,c) = *vptr++;
+ }
+
+ // Diagnose errors
+ if (ierr) {
+ if (ierr == 10*n)
+ vcl_cerr << "vnl_generalized_eigensystem: N is greater than NM. Bug in interface to rsg.f\n";
+ else {
+ vcl_cerr << "vnl_generalized_eigensystem: The "
+ << ierr << "-th eigenvalue has not been determined after 30 iterations.\n"
+ << "The eigenvalues should be correct for indices 1.." << ierr-1
+ << ", but no eigenvectors are computed.\n"
+ << "A = " << A
+ << "\nsingular values(A) = " << vnl_svd<double>(A).W() << '\n'
+ << "B = " << B
+ << "\nsingular values(B) = " << vnl_svd<double>(B).W() << '\n';
+ }
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.h
new file mode 100644
index 0000000000000000000000000000000000000000..1921755928da513be9f58803b82d250ebb5193ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_eigensystem.h
@@ -0,0 +1,57 @@
+// This is core/vnl/algo/vnl_generalized_eigensystem.h
+#ifndef vnl_generalized_eigensystem_h_
+#define vnl_generalized_eigensystem_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Solves the generalized eigenproblem Ax=La
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 29 Aug 96
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vnl/vnl_diag_matrix.h>
+
+//: Solves the generalized eigenproblem Ax=Bx
+// Solves the generalized eigenproblem of $A x = \lambda B x$,
+// with $A$ symmetric and $B$ positive definite. \n
+// See Golub and van Loan, Section 8.7.
+
+class vnl_generalized_eigensystem
+{
+ public:
+// Public data members because they're unique.
+ int n;
+
+//: Solves the generalized eigenproblem Ax=Bx
+// Solve real generalized eigensystem $A x = \lambda B x$ for
+// $\lambda$ and $x$, where $A$ symmetric, $B$ positive definite.
+// Initializes storage for the matrix $V = [ x_0 x_1 .. x_n ]$ and
+// the vnl_diag_matrix $D = [ \lambda_0 \lambda_1 ... \lambda_n ]$.
+// The eigenvalues are sorted into increasing order (of value, not
+// absolute value).
+//
+// Uses vnl_cholesky decomposition $C^\top C = B$, to convert to
+// $C^{-\top} A C^{-1} x = \lambda x$ and then uses the
+// symmetric eigensystem code. It will print a verbose warning
+// if $B$ is not positive definite.
+
+ vnl_generalized_eigensystem(const vnl_matrix<double>& A,
+ const vnl_matrix<double>& B);
+
+//: Public eigenvectors.
+// After construction, this contains the matrix of eigenvectors.
+ vnl_matrix<double> V;
+
+//: Public eigenvalues.
+// After construction, this contains the diagonal matrix of eigenvalues, stored as a vector.
+ vnl_diag_matrix<double> D;
+};
+
+#endif // vnl_generalized_eigensystem_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bf0e90d206cc8c6733c5b3be52f0d80bb7b53b7d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.cxx
@@ -0,0 +1,105 @@
+// This is core/vnl/algo/vnl_generalized_schur.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_generalized_schur.h"
+
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+
+#include <vnl/vnl_vector.h>
+
+#include <vnl/algo/vnl_netlib.h> // dgges_()
+
+VCL_DEFINE_SPECIALIZATION
+bool vnl_generalized_schur(vnl_matrix<double> *A,
+ vnl_matrix<double> *B,
+ vnl_vector<double> *alphar,
+ vnl_vector<double> *alphai,
+ vnl_vector<double> *beta,
+ vnl_matrix<double> *L,
+ vnl_matrix<double> *R)
+{
+ assert(A->cols() == A->cols());
+ assert(A->cols() == B->rows());
+ assert(A->cols() == B->cols());
+
+ int n = A->rows();
+ assert(alphar!=0); alphar->set_size(n); alphar->fill(0);
+ assert(alphai!=0); alphai->set_size(n); alphai->fill(0);
+ assert(beta!=0); beta ->set_size(n); beta ->fill(0);
+ assert(L!=0); L ->set_size(n, n); L ->fill(0);
+ assert(R!=0); R ->set_size(n, n); R ->fill(0);
+
+ int sdim = 0;
+ int lwork = 1000 + (8*n + 16);
+ double *work = new double[lwork];
+ int info = 0;
+ A->inplace_transpose();
+ B->inplace_transpose();
+ dgges_ ("V", "V",
+ "N",
+ 0,
+ &n,
+ A->data_block(), &n,
+ B->data_block(), &n,
+ &sdim,
+ alphar->data_block(),
+ alphai->data_block(),
+ beta->data_block(),
+ L->data_block(), &n,
+ R->data_block(), &n,
+ &work[0], &lwork,
+ 0,
+ &info);
+ A->inplace_transpose();
+ B->inplace_transpose();
+ L->inplace_transpose();
+ R->inplace_transpose();
+ delete [] work;
+
+ if (info == 0) {
+ // ok
+ return true;
+ }
+ else {
+ // These return codes are taken from dgges.f:
+ //* = 0: successful exit
+ //* < 0: if INFO = -i, the i-th argument had an illegal value.
+ //* = 1,...,N:
+ //* The QZ iteration failed. (A,B) are not in Schur
+ //* form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+ //* be correct for j=INFO+1,...,N.
+ //* > N: =N+1: other than QZ iteration failed in DHGEQZ.
+ //* =N+2: after reordering, roundoff changed values of
+ //* some complex eigenvalues so that leading
+ //* eigenvalues in the Generalized Schur form no
+ //* longer satisfy DELZTG=.TRUE. This could also
+ //* be caused due to scaling.
+ //* =N+3: reordering failed in DTGSEN.
+ vcl_cerr << __FILE__ ": info = " << info << ", something went wrong:\n";
+ if (info < 0) {
+ vcl_cerr << __FILE__ ": (internal error) the " << (-info) << "th argument had an illegal value\n";
+ }
+ else if (1 <= info && info <= n) {
+ vcl_cerr << __FILE__ ": the QZ iteration failed, but the last " << (n - info) << " eigenvalues may be correct\n";
+ }
+ else if (info == n+1) {
+ vcl_cerr << __FILE__ ": something went wrong in DHGEQZ\n";
+ }
+ else if (info == n+2) {
+ vcl_cerr << __FILE__ ": roundoff error -- maybe due to poor scaling\n";
+ }
+ else if (info == n+3) {
+ vcl_cerr << __FILE__ ": reordering failed in DTGSEN\n";
+ }
+ else {
+ vcl_cerr << __FILE__ ": unknown error\n";
+ }
+ return false;
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.h
new file mode 100644
index 0000000000000000000000000000000000000000..a6f7a8998d8e5b775d74622fe7574ff26485dea8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_generalized_schur.h
@@ -0,0 +1,95 @@
+// This is core/vnl/algo/vnl_generalized_schur.h
+#ifndef vnl_generalized_schur_h_
+#define vnl_generalized_schur_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Solves the generalized eigenproblem det(t A - s B) = 0.
+// \author fsm, Oxford RRG
+// \date 2 Oct 2001
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector.h>
+
+//:
+// For a *real* scalar type T, this function uses orthogonal
+// matrices L, R to reduce the (square) matrices A, B to generalized
+// (real) Schur form. This means that B is upper triangular and A is
+// block upper triangular with blocks of size at most 2x2 such that
+// the 2x2 blocks B corresponding to 2x2 blocks of A are diagonal.
+// E.g.:
+// \verbatim
+// [ * * * * * ]
+// [ * * * * ]
+// A <- L^* A R = [ * * * * ]
+// [ * * ]
+// [ * * ]
+//
+// [ * * * * * ]
+// [ * * * ]
+// B <- L^* B R = [ * * * ]
+// [ * ]
+// [ * ]
+// \endverbatim
+//
+// In addition, the function computes the generalized eigenvalues
+// (alphar(k) + i alphai(k) : beta(k) for k = 0, 1, 2,...
+template <class T>
+bool vnl_generalized_schur(vnl_matrix<T> *A,
+ vnl_matrix<T> *B,
+ vnl_vector<T> *alphar,
+ vnl_vector<T> *alphai,
+ vnl_vector<T> *beta,
+ vnl_matrix<T> *L,
+ vnl_matrix<T> *R);
+
+VCL_DEFINE_SPECIALIZATION
+bool vnl_generalized_schur(vnl_matrix<double> *A,
+ vnl_matrix<double> *B,
+ vnl_vector<double> *alphar,
+ vnl_vector<double> *alphai,
+ vnl_vector<double> *beta,
+ vnl_matrix<double> *L,
+ vnl_matrix<double> *R);
+
+#include <vcl_algorithm.h>
+
+template <class T>
+inline bool vnl_generalized_schur(vnl_matrix<T> *A,
+ vnl_matrix<T> *B,
+ vnl_vector<T> *alphar,
+ vnl_vector<T> *alphai,
+ vnl_vector<T> *beta,
+ vnl_matrix<T> *L,
+ vnl_matrix<T> *R)
+{
+ vnl_matrix<double> A_(A->rows(), A->cols());
+ vnl_matrix<double> B_(B->rows(), B->cols());
+ vcl_copy(A->begin(), A->end(), A_.begin());
+ vcl_copy(B->begin(), B->end(), B_.begin());
+
+ vnl_vector<double> alphar_;
+ vnl_vector<double> alphai_;
+ vnl_vector<double> beta_;
+ vnl_matrix<double> L_;
+ vnl_matrix<double> R_;
+
+ if (! vnl_generalized_schur/*<double>*/(&A_, &B_, &alphar_, &alphai_, &beta_, &L_, &R_))
+ return false;
+
+ vcl_copy(A_.begin(), A_.end(), A->begin());
+ vcl_copy(B_.begin(), B_.end(), B->begin());
+
+ alphar->set_size(alphar_.size()); vcl_copy(alphar_.begin(), alphar_.end(), alphar->begin());
+ alphai->set_size(alphai_.size()); vcl_copy(alphai_.begin(), alphai_.end(), alphai->begin());
+ beta ->set_size(beta_ .size()); vcl_copy(beta_ .begin(), beta_ .end(), beta ->begin());
+ L->set_size(L_.rows(), L_.cols()); vcl_copy(L_.begin(), L_.end(), L->begin());
+ R->set_size(R_.rows(), R_.cols()); vcl_copy(R_.begin(), R_.end(), R->begin());
+
+ return true;
+}
+
+#endif // vnl_generalized_schur_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a15a5df6d63103864e5de6a5a5874ef32cd964c4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.cxx
@@ -0,0 +1,167 @@
+// This is core/vnl/algo/vnl_lbfgs.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 22 Aug 99
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_lbfgs.h"
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h> // for setw (replaces cout.form())
+
+#include <vnl/algo/vnl_netlib.h> // lbfgs_()
+extern "C" {
+#include <lbfgs.h> // from netlib, for lb3_ data struct
+}
+
+//: Default constructor.
+// memory is set to 5, line_search_accuracy to 0.9.
+// Calls init_parameters
+vnl_lbfgs::vnl_lbfgs():
+ f_(0)
+{
+ init_parameters();
+}
+
+//: Constructor. f is the cost function to be minimized.
+// Calls init_parameters
+vnl_lbfgs::vnl_lbfgs(vnl_cost_function& f):
+ f_(&f)
+{
+ init_parameters();
+}
+
+//: Called by constructors.
+// Memory is set to 5, line_search_accuracy to 0.9, default_step_length to 1.
+void vnl_lbfgs::init_parameters()
+{
+ memory = 5;
+ line_search_accuracy = 0.9;
+ default_step_length = 1.0;
+}
+
+bool vnl_lbfgs::minimize(vnl_vector<double>& x)
+{
+ /* Local variables */
+ /* The driver for vnl_lbfgs must always declare LB2 as EXTERNAL */
+
+ int n = f_->get_number_of_unknowns();
+ int m = memory; // The number of basis vectors to remember.
+
+ int iprint[2] = {1, 0};
+ vnl_vector<double> g(n);
+
+ // Workspace
+ vnl_vector<double> diag(n);
+
+ vnl_vector<double> w(n * (2*m+1)+2*m);
+
+ if (verbose_)
+ vcl_cerr << "vnl_lbfgs: n = "<< n <<", memory = "<< m <<", Workspace = "
+ << w.size() << "[ "<< ( w.size() / 128.0 / 1024.0) <<" MB], ErrorScale = "
+ << f_->reported_error(1) <<", xnorm = "<< x.magnitude() << vcl_endl;
+
+ bool we_trace = (verbose_ && !trace);
+
+ if (we_trace)
+ vcl_cerr << "vnl_lbfgs: ";
+
+ double best_f = 0;
+ vnl_vector<double> best_x;
+
+ bool ok;
+ this->num_evaluations_ = 0;
+ this->num_iterations_ = 0;
+ int iflag = 0;
+ while (true) {
+ // We do not wish to provide the diagonal matrices Hk0, and therefore set DIAGCO to FALSE.
+ logical diagco = false;
+
+ // Set these every iter in case user changes them to bail out
+ double eps = gtol; // Gradient tolerance
+ double local_xtol = 1e-16;
+ lb3_.gtol = line_search_accuracy; // set to 0.1 for huge problems or cheap functions
+ lb3_.stpawf = default_step_length;
+
+ // Call function
+ double f;
+ f_->compute(x, &f, &g);
+ if (this->num_evaluations_ == 0) {
+ this->start_error_ = f;
+ best_f = f;
+ } else if (f < best_f) {
+ best_x = x;
+ best_f = f;
+ }
+
+#define print_(i,a,b,c,d) vcl_cerr<<vcl_setw(6)<<i<<' '<<vcl_setw(20)<<a<<' '\
+ <<vcl_setw(20)<<b<<' '<<vcl_setw(20)<<c<<' '<<vcl_setw(20)<<d<<'\n'
+
+ if (check_derivatives_)
+ {
+ vcl_cerr << "vnl_lbfgs: f = " << f_->reported_error(f) << ", computing FD gradient\n";
+ vnl_vector<double> fdg = f_->fdgradf(x);
+ if (verbose_)
+ {
+ int l = n;
+ int limit = 100;
+ int limit_tail = 10;
+ if (l > limit + limit_tail) {
+ vcl_cerr << " [ Showing only first " <<limit<< " components ]\n";
+ l = limit;
+ }
+ print_("i","x","g","fdg","dg");
+ print_("-","-","-","---","--");
+ for (int i = 0; i < l; ++i)
+ print_(i, x[i], g[i], fdg[i], g[i]-fdg[i]);
+ if (n > limit) {
+ vcl_cerr << " ...\n";
+ for (int i = n - limit_tail; i < n; ++i)
+ print_(i, x[i], g[i], fdg[i], g[i]-fdg[i]);
+ }
+ }
+ vcl_cerr << " ERROR = " << (fdg - g).squared_magnitude() / vcl_sqrt(double(n)) << "\n";
+ }
+
+ iprint[0] = trace ? 1 : -1; // -1 no o/p, 0 start and end, 1 every iter.
+ iprint[1] = 0; // 1 prints X and G
+ lbfgs_(&n, &m, x.data_block(), &f, g.data_block(), &diagco, diag.data_block(),
+ iprint, &eps, &local_xtol, w.data_block(), &iflag);
+ ++this->num_iterations_;
+
+ if (we_trace)
+ vcl_cerr << iflag << ":" << f_->reported_error(f) << " ";
+
+ if (iflag == 0) {
+ // Successful return
+ this->end_error_ = f;
+ ok = true;
+ x = best_x;
+ break;
+ }
+
+ if (iflag < 0) {
+ // Eeek.
+ vcl_cerr << "vnl_lbfgs: ** EEEK **\n";
+ ok = false;
+ x = best_x;
+ break;
+ }
+
+ if (++this->num_evaluations_ > get_max_function_evals()) {
+ failure_code_ = FAILED_TOO_MANY_ITERATIONS;
+ ok = false;
+ x = best_x;
+ break;
+ }
+ }
+ if (we_trace) vcl_cerr << "done\n";
+
+ return ok;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.h
new file mode 100644
index 0000000000000000000000000000000000000000..53bdbce90b2c9d7f0432338cda56c325a3fdf020
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lbfgs.h
@@ -0,0 +1,78 @@
+// This is core/vnl/algo/vnl_lbfgs.h
+#ifndef vnl_lbfgs_h_
+#define vnl_lbfgs_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Limited memory Broyden Fletcher Goldfarb Shannon minimization
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 22 Aug 99
+//
+// \verbatim
+// Modifications
+// 990822 AWF Initial version.
+// dac (Manchester) 28/03/2001: tidied up documentation
+// scottim 4/02/2002: Added a better description
+// \endverbatim
+//
+
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+//: Limited memory Broyden Fletcher Goldfarb Shannon minimization
+// Considered to be the best optimisation algorithm for functions
+// which are well behaved (i.e. locally smooth
+// without too many local minima,) have 1st derivatives available,
+// and do not have a structure that makes them suitable for alternative
+// methods (e.g. if f(x) is a sum of squared terms you should use
+// vnl_levenberg_marquardt.)
+//
+// This limited-memory rank-2 quasi-newton method
+// maintains an estimate of (the inverse of) the Hessian matrix of f at x.
+// Unlike Newton's method, it doesn't need 2nd derivatives of f(x),
+// has superlinear rather than quadratic convergence and is
+// better behaved away from minima. 2 ranks of this matrix are updated at each
+// step. In order to reduce memory and time requirements, this limited memory
+// version of BFGS only maintains a certain number of vector corrections
+// to a diagonal estimate of the inverse Hessian estimate.
+
+class vnl_lbfgs : public vnl_nonlinear_minimizer
+{
+ public:
+ vnl_lbfgs();
+ vnl_lbfgs(vnl_cost_function& f);
+
+ bool minimize(vnl_vector<double>& x);
+
+ //: Step accuracy/speed tradeoff.
+ // Effectively the number of correction vectors to the diagonal approximation
+ // of the inverse Hessian estimate that are kept.
+ //
+ // Large values of M will result in excessive computing time.
+ // 3<= memory <=7 is recommended.
+ // Memory requirements will be roughly Const+sizeof(element)*dim(X)*memory.
+ // Default is 5.
+ int memory;
+
+ //: Accuracy of line search.
+ // If function evaluations are cheap wrt the actual minimization steps,
+ // change to 0.1, from default of 0.9;
+ double line_search_accuracy;
+
+ //: Default step length in line search.
+ // If, on tracing, the STP is always 1, then you could try setting this to a
+ // higher value to see how far along the gradient the minimum typically is.
+ // Then set this to a number just below that to get maximally far with the
+ // single evaluation.
+ double default_step_length;
+
+ private:
+ void init_parameters();
+ vnl_cost_function* f_;
+ // vnl_lbfgs() {} // default constructor makes no sense
+ // does too. Can set values for parameters.
+};
+
+#endif // vnl_lbfgs_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7fda6168a1f993a287136e13e9789c32068d6693
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.cxx
@@ -0,0 +1,486 @@
+// This is core/vnl/algo/vnl_levenberg_marquardt.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_levenberg_marquardt.h"
+
+#include <vcl_cassert.h>
+#include <vcl_cstdlib.h>
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_fastops.h>
+#include <vnl/vnl_vector_ref.h>
+#include <vnl/vnl_matrix_ref.h>
+#include <vnl/vnl_least_squares_function.h>
+#include <vnl/algo/vnl_netlib.h> // lmdif_()
+
+// see header
+vnl_vector<double> vnl_levenberg_marquardt_minimize(vnl_least_squares_function& f,
+ vnl_vector<double> const& initial_estimate)
+{
+ vnl_vector<double> x = initial_estimate;
+ vnl_levenberg_marquardt lm(f);
+ lm.minimize(x);
+ return x;
+}
+
+// ctor
+void vnl_levenberg_marquardt::init(vnl_least_squares_function* f)
+{
+ f_ = f;
+
+ // If changing these defaults, check the help comments in vnl_levenberg_marquardt.h,
+ // and MAKE SURE they're consistent.
+ xtol = 1e-8; // Termination tolerance on X (solution vector)
+ maxfev = 400 * f->get_number_of_unknowns(); // Termination maximum number of iterations.
+ ftol = xtol * 0.01; // Termination tolerance on F (sum of squared residuals)
+ gtol = 1e-5; // Termination tolerance on Grad(F)' * F = 0
+ epsfcn = xtol * 0.001; // Step length for FD Jacobian
+
+ unsigned int m = f_->get_number_of_residuals(); // I Number of residuals, must be > #unknowns
+ unsigned int n = f_->get_number_of_unknowns(); // I Number of unknowns
+
+ set_covariance_ = false;
+ fdjac_.set_size(n,m);
+ fdjac_.fill(0.0);
+ ipvt_.set_size(n);
+ ipvt_.fill(0);
+ inv_covar_.set_size(n,n);
+ inv_covar_.fill(0.0);
+ //fdjac_ = new vnl_matrix<double>(n,m);
+ //ipvt_ = new vnl_vector<int>(n);
+ //covariance_ = new vnl_matrix<double>(n,n);
+}
+
+vnl_levenberg_marquardt::~vnl_levenberg_marquardt()
+{
+ //delete covariance_;
+ //delete fdjac_;
+ //delete ipvt_;
+}
+
+
+class vnl_levenberg_marquardt_Activate
+{
+ public:
+ static vnl_levenberg_marquardt* current;
+
+ vnl_levenberg_marquardt_Activate(vnl_levenberg_marquardt* minimizer) {
+ if (current) {
+ vcl_cerr << "vnl_levenberg_marquardt: ERROR: Nested minimizations not supported.\n";
+ vcl_abort();
+ // Ask awf to fix this if you need to run one minimization inside another.
+ // Or just make "current" a stack.
+ // Actually.... I think it might be a lot harder than that, the statics in the fortran.
+ }
+ current = minimizer;
+ }
+ ~vnl_levenberg_marquardt_Activate() {
+ current = 0;
+ }
+};
+
+vnl_levenberg_marquardt* vnl_levenberg_marquardt_Activate::current = 0;
+
+//--------------------------------------------------------------------------------
+
+#ifdef VCL_SUNPRO_CC
+extern "C"
+#endif
+void vnl_levenberg_marquardt::lmdif_lsqfun(int* n, // I Number of residuals
+ int* p, // I Number of unknowns
+ double* x, // I Solution vector, size n
+ double* fx, // O Residual vector f(x)
+ int* iflag) // IO 0 ==> print, -1 ==> terminate
+{
+ vnl_levenberg_marquardt* active = vnl_levenberg_marquardt_Activate::current;
+ vnl_least_squares_function* f = active->f_;
+ assert(*p == (int)f->get_number_of_unknowns());
+ assert(*n == (int)f->get_number_of_residuals());
+ vnl_vector_ref<double> ref_x(*p, const_cast<double*>(x));
+ vnl_vector_ref<double> ref_fx(*n, fx);
+
+ if (*iflag == 0) {
+ if (active->trace)
+ vcl_cerr << "lmdif: iter " << active->num_iterations_ << " err ["
+ << x[0] << ", " << x[1] << ", " << x[2] << ", " << x[3] << ", "
+ << x[4] << ", ... ] = " << ref_fx.magnitude() << '\n';
+
+ f->trace(active->num_iterations_, ref_x, ref_fx);
+ ++(active->num_iterations_);
+ } else {
+ f->f(ref_x, ref_fx);
+ }
+
+ if (active->start_error_ == 0)
+ active->start_error_ = ref_fx.rms();
+
+ if (f->failure) {
+ f->clear_failure();
+ *iflag = -1; // fsm
+ }
+}
+
+
+// This function shouldn't be inlined, because (1) modification of the
+// body will not cause the timestamp on the header to change, and so
+// others will not be forced to recompile, and (2) the cost of making
+// one more function call is far, far less than the cost of actually
+// performing the minimisation, so the inline doesn't gain you
+// anything.
+//
+bool vnl_levenberg_marquardt::minimize(vnl_vector<double>& x)
+{
+ if ( f_->has_gradient() )
+ return minimize_using_gradient(x);
+ else
+ return minimize_without_gradient(x);
+}
+
+
+//
+bool vnl_levenberg_marquardt::minimize_without_gradient(vnl_vector<double>& x)
+{
+ //fsm
+ if (f_->has_gradient()) {
+ vcl_cerr << __FILE__ " : WARNING. calling minimize_without_gradient(), but f_ has gradient.\n";
+ }
+
+ // e04fcf
+ int m = f_->get_number_of_residuals(); // I Number of residuals, must be > #unknowns
+ int n = f_->get_number_of_unknowns(); // I Number of unknowns
+
+ if (m < n) {
+ vcl_cerr << "vnl_levenberg_marquardt: Number of unknowns("<<n<<") greater than number of data ("<<m<<")\n";
+ failure_code_ = ERROR_DODGY_INPUT;
+ return false;
+ }
+
+ if (int(x.size()) != n) {
+ vcl_cerr << "vnl_levenberg_marquardt: Input vector length ("<<x.size()<<") not equal to num unknowns ("<<n<<")\n";
+ failure_code_ = ERROR_DODGY_INPUT;
+ return false;
+ }
+
+ vnl_vector<double> fx(m); // W m Storage for residual vector
+ vnl_vector<double> diag(n); // I Multiplicative scale factors for variables
+ int user_provided_scale_factors = 1; // 1 is no, 2 is yes
+ double factor = 100;
+ int nprint = 1;
+
+ vnl_vector<double> qtf(n);
+ vnl_vector<double> wa1(n);
+ vnl_vector<double> wa2(n);
+ vnl_vector<double> wa3(n);
+ vnl_vector<double> wa4(m);
+
+ //vcl_cerr << "STATUS: " << failure_code_ << vcl_endl;
+ vnl_levenberg_marquardt_Activate activator(this);
+
+ double errors[2] = {0,0};
+ num_iterations_ = 0;
+ set_covariance_ = false;
+ int info;
+ start_error_ = 0; // Set to 0 so first call to lmdif_lsqfun will know to set it.
+ lmdif_(lmdif_lsqfun, &m, &n,
+ x.data_block(),
+ fx.data_block(),
+ &ftol, &xtol, >ol, &maxfev, &epsfcn,
+ &diag[0],
+ &user_provided_scale_factors, &factor, &nprint,
+ &info, &num_evaluations_,
+ fdjac_.data_block(), &m, ipvt_.data_block(),
+ &qtf[0],
+ &wa1[0], &wa2[0], &wa3[0], &wa4[0],
+ errors);
+ failure_code_ = (ReturnCodes) info;
+
+ // One more call to compute final error.
+ lmdif_lsqfun(&m, // I Number of residuals
+ &n, // I Number of unknowns
+ x.data_block(), // I Solution vector, size n
+ fx.data_block(), // O Residual vector f(x)
+ &info);
+ end_error_ = fx.rms();
+
+#ifdef _SGI_CC_6_
+ // Something fundamentally odd about the switch below on SGI native... FIXME
+ vcl_cerr << "vnl_levenberg_marquardt: termination code = " << failure_code_ << vcl_endl;
+ // diagnose_outcome(vcl_cerr);
+ return 1;
+#endif
+
+ // Translate status code
+ switch ((int)failure_code_) {
+ case 1: // ftol
+ case 2: // xtol
+ case 3: // both
+ case 4: // gtol
+ return true;
+ default:
+ diagnose_outcome();
+ return false;
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+#ifdef VCL_SUNPRO_CC
+extern "C"
+#endif
+void vnl_levenberg_marquardt::lmder_lsqfun(int* n, // I Number of residuals
+ int* p, // I Number of unknowns
+ double* x, // I Solution vector, size n
+ double* fx, // O Residual vector f(x)
+ double* fJ, // O m * n Jacobian f(x)
+ int*,
+ int* iflag) // I 1 -> calc fx, 2 -> calc fjac
+{
+ vnl_levenberg_marquardt* active = vnl_levenberg_marquardt_Activate::current;
+ vnl_least_squares_function* f = active->f_;
+ assert(*p == (int)f->get_number_of_unknowns());
+ assert(*n == (int)f->get_number_of_residuals());
+ vnl_vector_ref<double> ref_x(*p, (double*)x); // const violation!
+ vnl_vector_ref<double> ref_fx(*n, fx);
+ vnl_matrix_ref<double> ref_fJ(*n, *p, fJ);
+
+ if (*iflag == 0) {
+ if (active->trace)
+ vcl_cerr << "lmder: iter " << active->num_iterations_ << " err ["
+ << x[0] << ", " << x[1] << ", " << x[2] << ", " << x[3] << ", "
+ << x[4] << ", ... ] = " << ref_fx.magnitude() << '\n';
+ f->trace(active->num_iterations_, ref_x, ref_fx);
+ }
+ else if (*iflag == 1) {
+ f->f(ref_x, ref_fx);
+ if (active->start_error_ == 0)
+ active->start_error_ = ref_fx.rms();
+ ++(active->num_iterations_);
+ }
+ else if (*iflag == 2) {
+ f->gradf(ref_x, ref_fJ);
+ ref_fJ.inplace_transpose();
+
+ // check derivative?
+ if ( active->check_derivatives_ > 0 )
+ {
+ active->check_derivatives_--;
+
+ // use finite difference to compute Jacobian
+ vnl_vector<double> feval( *n );
+ vnl_matrix<double> finite_jac( *p, *n, 0.0 );
+ vnl_vector<double> wa1( *n );
+ int info=1;
+ double diff;
+ f->f( ref_x, feval );
+ fdjac2_(lmdif_lsqfun, n, p, x,
+ feval.data_block(),
+ finite_jac.data_block(),
+ n,
+ &info,
+ &(active->epsfcn),
+ wa1.data_block());
+ // compute difference
+ for( unsigned i=0; i<ref_fJ.cols(); ++i )
+ for( unsigned j=0; j<ref_fJ.rows(); ++j ) {
+ diff = ref_fJ(j,i) - finite_jac(j,i);
+ diff = diff*diff;
+ if( diff > active->epsfcn ) {
+ vcl_cerr << "Jac(" << i << ", " << j << ") diff: " << ref_fJ(j,i) << ' ' << finite_jac(j,i) << vcl_endl;
+ }
+ }
+ }
+ }
+
+ if (f->failure) {
+ f->clear_failure();
+ *iflag = -1; // fsm
+ }
+}
+
+
+//
+bool vnl_levenberg_marquardt::minimize_using_gradient(vnl_vector<double>& x)
+{
+ //fsm
+ if (! f_->has_gradient()) {
+ vcl_cerr << __FILE__ ": called method minimize_using_gradient(), but f_ has no gradient.\n";
+ return false;
+ }
+
+ int m = f_->get_number_of_residuals(); // I Number of residuals, must be > #unknowns
+ int n = f_->get_number_of_unknowns(); // I Number of unknowns
+
+ if (m < n) {
+ vcl_cerr << __FILE__ ": Number of unknowns("<<n<<") greater than number of data ("<<m<<")\n";
+ failure_code_ = ERROR_DODGY_INPUT;
+ return false;
+ }
+
+ vnl_vector<double> fx(m); // W m Storage for residual vector
+ vnl_vector<double> wa1(5*n + m);
+
+ vnl_levenberg_marquardt_Activate activator(this);
+
+ num_iterations_ = 0;
+ set_covariance_ = false;
+ int info;
+ int size = wa1.size();
+ start_error_ = 0; // Set to 0 so first call to lmder_lsqfun will know to set it.
+ lmder1_(lmder_lsqfun, &m, &n,
+ x.data_block(),
+ fx.data_block(),
+ fdjac_.data_block(), &m,
+ &ftol,
+ &info,
+ ipvt_.data_block(),
+ wa1.data_block(),
+ &size);
+ num_evaluations_ = num_iterations_; // for lmder, these are the same.
+ if (info<0)
+ info = ERROR_FAILURE;
+ failure_code_ = (ReturnCodes) info;
+ end_error_ = fx.rms();
+
+ // Translate status code
+ switch (failure_code_) {
+ case 1: // ftol
+ case 2: // xtol
+ case 3: // both
+ case 4: // gtol
+ return true;
+ default:
+ diagnose_outcome();
+ return false;
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+void vnl_levenberg_marquardt::diagnose_outcome() const
+{
+ diagnose_outcome(vcl_cerr);
+}
+
+// fsm: should this function be a method on vnl_nonlinear_minimizer?
+// if not, the return codes should be moved into LM.
+void vnl_levenberg_marquardt::diagnose_outcome(vcl_ostream& s) const
+{
+#define whoami "vnl_levenberg_marquardt"
+ //if (!verbose_) return;
+ switch (failure_code_) {
+ // case -1:
+ // have already warned.
+ // return;
+ case ERROR_FAILURE:
+ s << (whoami ": OIOIOI -- failure in leastsquares function\n");
+ break;
+ case ERROR_DODGY_INPUT:
+ s << (whoami ": OIOIOI -- lmdif dodgy input\n");
+ break;
+ case CONVERGED_FTOL: // ftol
+ s << (whoami ": converged to ftol\n");
+ break;
+ case CONVERGED_XTOL: // xtol
+ s << (whoami ": converged to xtol\n");
+ break;
+ case CONVERGED_XFTOL: // both
+ s << (whoami ": converged nicely\n");
+ break;
+ case CONVERGED_GTOL:
+ s << (whoami ": converged via gtol\n");
+ break;
+ case FAILED_TOO_MANY_ITERATIONS:
+ s << (whoami ": too many iterations\n");
+ break;
+ case FAILED_FTOL_TOO_SMALL:
+ s << (whoami ": ftol is too small. no further reduction in the sum of squares is possible.\n");
+ break;
+ case FAILED_XTOL_TOO_SMALL:
+ s << (whoami ": xtol is too small. no further improvement in the approximate solution x is possible.\n");
+ break;
+ case FAILED_GTOL_TOO_SMALL:
+ s << (whoami ": gtol is too small. Fx is orthogonal to the columns of the jacobian to machine precision.\n");
+ break;
+ default:
+ s << (whoami ": OIOIOI: unkown info code from lmder.\n");
+ break;
+ }
+ unsigned int m = f_->get_number_of_residuals();
+ s << whoami ": " << num_iterations_ << " iterations, "
+ << num_evaluations_ << " evaluations, "<< m <<" residuals. RMS error start/end "
+ << get_start_error() << '/' << get_end_error() << vcl_endl;
+#undef whoami
+}
+
+// fjac is an output m by n array. the upper n by n submatrix
+// of fjac contains an upper triangular matrix r with
+// diagonal elements of nonincreasing magnitude such that
+//
+// t t t
+// p *(jac *jac)*p = r *r,
+//
+// where p is a permutation matrix and jac is the final
+// calculated jacobian. column j of p is column ipvt(j)
+// (see below) of the identity matrix. the lower trapezoidal
+// part of fjac contains information generated during
+// the computation of r.
+
+// fdjac is target m*n
+
+//: Get INVERSE of covariance at last minimum.
+// Code thanks to Joss Knight (joss@robots.ox.ac.uk)
+vnl_matrix<double> const& vnl_levenberg_marquardt::get_JtJ()
+{
+ if (!set_covariance_)
+ {
+ vcl_cerr << __FILE__ ": get_covariance() not confirmed tested yet\n";
+ unsigned int n = fdjac_.rows();
+
+ // matrix in FORTRAN is column-wise.
+ // transpose it to get C style order
+ vnl_matrix<double> r = fdjac_.extract(n,n).transpose();
+ // r is upper triangular matrix according to documentation.
+ // But the lower part has non-zeros somehow.
+ // clear the lower part
+ for (unsigned int i=0; i<n; ++i)
+ for (unsigned int j=0; j<i; ++j)
+ r(i,j) = 0.0;
+
+ // compute r^T * r
+ vnl_matrix<double> rtr;
+ vnl_fastops::AtA(rtr, r);
+ vnl_matrix<double> rtrpt (n, n);
+
+ // Permute. First order columns.
+ // Note, *ipvt_ contains 1 to n, not 0 to n-1
+ vnl_vector<int> jpvt(n);
+ for (unsigned int j = 0; j < n; ++j) {
+ unsigned int i = 0;
+ for (; i < n; i++) {
+ if (ipvt_[i] == (int)j+1) {
+ jpvt (j) = i;
+ break;
+ }
+ }
+ rtrpt.set_column(j, rtr.get_column(i));
+ }
+
+ // Now order rows
+ for (unsigned int j = 0; j < n; ++j) {
+ inv_covar_.set_row (j, rtrpt.get_row (jpvt(j)));
+ }
+
+ set_covariance_ = true;
+ }
+ return inv_covar_;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.h
new file mode 100644
index 0000000000000000000000000000000000000000..1e00505d08b4f0e333b1ea36040a88a03feae383
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_levenberg_marquardt.h
@@ -0,0 +1,132 @@
+// This is core/vnl/algo/vnl_levenberg_marquardt.h
+#ifndef vnl_levenberg_marquardt_h_
+#define vnl_levenberg_marquardt_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Levenberg Marquardt nonlinear least squares
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+// \verbatim
+// Modifications
+// AGAP 160701 Some comments. Changed minimize to call the correct minimization
+// routine.
+// RWMC 001097 Added verbose flag to get rid of all that blathering.
+// AWF 151197 Added trace flag to increase blather.
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+class vnl_least_squares_function;
+
+//: Levenberg Marquardt nonlinear least squares
+// vnl_levenberg_marquardt is an interface to the MINPACK routine lmdif,
+// and implements Levenberg Marquardt nonlinear fitting. The function
+// to be minimized is passed as a vnl_least_squares_function object, which
+// may or may not wish to provide derivatives. If derivatives are not
+// supplied, they are calculated by forward differencing, which costs
+// one function evaluation per dimension, but is perfectly accurate.
+// (See Hartley in ``Applications of Invariance in Computer Vision''
+// for example).
+
+class vnl_levenberg_marquardt : public vnl_nonlinear_minimizer
+{
+ public:
+
+ //: Initialize with the function object that is to be minimized.
+ vnl_levenberg_marquardt(vnl_least_squares_function& f) { init(&f); }
+
+#if 0
+ //: Initialize as above, and then run minimization.
+ //
+ // obsolete, as virtuals in base class vnl_nonlinear_minimizer not valid...
+ // i.e. if minimize() calls base::get_covariance(), it will call the
+ // base version rather than any overridden here or in classes derived
+ // from this. This is an argument against computation in constructors.
+ // You should replace code like
+ // \code
+ // vnl_levenberg_marquardt lm(f, x);
+ // \endcode
+ // with
+ // \code
+ // vnl_levenberg_marquardt lm(f);
+ // lm.minimize(x);
+ // \endcode
+ // Or
+ // \code
+ // x = vnl_levenberg_marquardt_minimize(f, x);
+ // \endcode
+
+ vnl_levenberg_marquardt(vnl_least_squares_function& f,
+ vnl_vector<double>& x)
+ {
+ init(&f);
+ minimize(x);
+ }
+#endif
+
+ ~vnl_levenberg_marquardt();
+
+ //: Minimize the function supplied in the constructor until convergence or failure.
+ // On return, x is such that f(x) is the lowest value achieved.
+ // Returns true for convergence, false for failure.
+ // Does not use the gradient even if the cost function provides one.
+ bool minimize_without_gradient(vnl_vector<double>& x);
+
+ //: Minimize the function supplied in the constructor until convergence or failure.
+ // On return, x is such that f(x) is the lowest value achieved.
+ // Returns true for convergence, false for failure.
+ // The cost function must provide a gradient.
+ bool minimize_using_gradient (vnl_vector<double>& x);
+
+ //: Calls minimize_using_gradient() or minimize_without_gradient()
+ // , depending on whether the cost function provides a gradient.
+ bool minimize(vnl_vector<double>& x);
+ bool minimize(vnl_vector_fixed<double,2>& x) { vnl_vector<double> y=x.extract(2); bool b=minimize(y); x=y; return b; }
+ bool minimize(vnl_vector_fixed<double,3>& x) { vnl_vector<double> y=x.extract(3); bool b=minimize(y); x=y; return b; }
+ bool minimize(vnl_vector_fixed<double,4>& x) { vnl_vector<double> y=x.extract(4); bool b=minimize(y); x=y; return b; }
+
+ // Coping with failure-------------------------------------------------------
+
+ //: Provide an ASCII diagnosis of the last minimization on vcl_ostream.
+ void diagnose_outcome(/*vcl_cerr*/) const;
+ void diagnose_outcome(vcl_ostream&) const;
+
+ //: Return J'*J computed at last minimum.
+ // it is an approximation of inverse of covariance
+ vnl_matrix<double> const& get_JtJ();
+
+ protected:
+
+ vnl_least_squares_function* f_;
+ vnl_matrix<double> fdjac_; // Computed during lmdif/lmder
+ vnl_vector<int> ipvt_; // Also computed, both needed to get J'*J at end.
+
+ vnl_matrix<double> inv_covar_;
+ bool set_covariance_; // Set if covariance_ holds J'*J
+
+ void init(vnl_least_squares_function* f);
+
+ // Communication with callback
+ friend class vnl_levenberg_marquardt_Activate;
+ static void lmdif_lsqfun(int* m, int* n, double* x,
+ double* fx, int* iflag);
+ static void lmder_lsqfun(int* m, int* n, double* x,
+ double* fx, double* fJ, int*, int* iflag);
+};
+
+//: Find minimum of "f", starting at "initial_estimate", and return.
+vnl_vector<double> vnl_levenberg_marquardt_minimize(vnl_least_squares_function& f,
+ vnl_vector<double> const& initial_estimate);
+
+
+#endif // vnl_levenberg_marquardt_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0732fc33dca58953110275620c91634123e8ee30
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.cxx
@@ -0,0 +1,155 @@
+// This is core/vnl/algo/vnl_lsqr.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//
+// vnl_lsqr
+// Author: David Capel
+// Created: July 2000
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_lsqr.h"
+#include <vcl_cstdlib.h>
+#include <vcl_vector.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector_ref.h>
+
+#include <vnl/algo/vnl_netlib.h> // lsqr_()
+
+class vnl_lsqr_Activate
+{
+ public:
+ static vnl_lsqr* current;
+
+ vnl_lsqr_Activate(vnl_lsqr* minimizer) {
+ if (current) {
+ vcl_cerr << "vnl_lsqr: ERROR: Nested minimizations not supported.\n";
+ vcl_abort();
+ // This is a copy of what goes on in LevenbergMarquardt, so if awf decides to
+ // fix that one, then maybe he could do the same here...
+ }
+ current = minimizer;
+ }
+ ~vnl_lsqr_Activate() {
+ current = 0;
+ }
+};
+
+vnl_lsqr *vnl_lsqr_Activate::current= 0;
+
+vnl_lsqr::~vnl_lsqr()
+{
+}
+
+// Requires number_of_residuals() of workspace in rw.
+void vnl_lsqr::aprod_(int* mode, int* m, int* n, double* x, double* y, int* /*leniw*/, int* /*lenrw*/, int* /*iw*/, double* rw )
+{
+ vnl_lsqr* active = vnl_lsqr_Activate::current;
+
+ // If MODE = 1, compute y = y + A*x.
+ // If MODE = 2, compute x = x + A(transpose)*y.
+
+ vnl_vector_ref<double> x_ref(*n,x);
+ vnl_vector_ref<double> y_ref(*m,y);
+
+ if (*mode == 1) {
+ vnl_vector_ref<double> tmp(*m,rw);
+ active->ls_->multiply(x_ref, tmp);
+ y_ref += tmp;
+ }
+ else {
+ vnl_vector_ref<double> tmp(*n,rw);
+ active->ls_->transpose_multiply(y_ref, tmp);
+ x_ref += tmp;
+ }
+}
+
+int vnl_lsqr::minimize(vnl_vector<double>& result)
+{
+ int m = ls_->get_number_of_residuals();
+ int n = ls_->get_number_of_unknowns();
+ double damp = 0;
+ int leniw = 1;
+ int* iw = 0;
+ int lenrw = m;
+#ifdef __GNUC__
+ double rw[m];
+ double v[n];
+ double w[n];
+ double se[n];
+#else
+ vcl_vector<double> rw(m);
+ vcl_vector<double> v(n);
+ vcl_vector<double> w(n);
+ vcl_vector<double> se(n);
+#endif
+ double atol = 0;
+ double btol = 0;
+ double conlim = 0;
+ int nout = -1;
+ double anorm, acond, rnorm, arnorm, xnorm;
+
+ vnl_vector<double> rhs(m);
+ ls_->get_rhs(rhs);
+
+ vnl_lsqr_Activate activator(this); // This variable is not used, but the constructor must be called.
+
+ lsqr_(&m, &n, aprod_, &damp, &leniw, &lenrw, iw, &rw[0],
+ rhs.data_block(), &v[0], &w[0], result.data_block(), &se[0],
+ &atol, &btol, &conlim, &max_iter_, &nout, &return_code_,
+ &num_iter_, &anorm, &acond, &rnorm, &arnorm, &xnorm);
+
+ resid_norm_estimate_ = rnorm;
+ result_norm_estimate_ = xnorm;
+ A_condition_estimate_ = acond;
+
+#if 0
+ vcl_cerr << "A Fro norm estimate = " << anorm << vcl_endl
+ << "A condition estimate = " << acond << vcl_endl
+ << "Residual norm estimate = " << rnorm << vcl_endl
+ << "A'(Ax - b) norm estimate = " << arnorm << vcl_endl
+ << "x norm estimate = " << xnorm << vcl_endl;
+#endif
+
+ return 0; // return value not used
+}
+
+void vnl_lsqr::diagnose_outcome(vcl_ostream& os) const
+{
+ translate_return_code(os, return_code_);
+ os << __FILE__ " : residual norm estimate = " << resid_norm_estimate_ << vcl_endl
+ << __FILE__ " : result norm estimate = " << result_norm_estimate_ << vcl_endl
+ << __FILE__ " : condition no. estimate = " << A_condition_estimate_ << vcl_endl
+ << __FILE__ " : iterations = " << num_iter_ << vcl_endl;
+}
+
+void vnl_lsqr::translate_return_code(vcl_ostream& os, int rc)
+{
+ const char* vnl_lsqr_reasons[] = {
+ "x = 0 is the exact solution. No iterations were performed.",
+ "The equations A*x = b are probably compatible. "
+ "Norm(A*x - b) is sufficiently small, given the "
+ "values of ATOL and BTOL.",
+ "The system A*x = b is probably not compatible. "
+ "A least-squares solution has been obtained that is "
+ "sufficiently accurate, given the value of ATOL.",
+ "An estimate of cond(Abar) has exceeded CONLIM. "
+ "The system A*x = b appears to be ill-conditioned. "
+ "Otherwise, there could be an error in subroutine APROD.",
+ "The equations A*x = b are probably compatible. "
+ "Norm(A*x - b) is as small as seems reasonable on this machine.",
+ "The system A*x = b is probably not compatible. A least-squares "
+ "solution has been obtained that is as accurate as seems "
+ "reasonable on this machine.",
+ "Cond(Abar) seems to be so large that there is no point in doing further "
+ "iterations, given the precision of this machine. "
+ "There could be an error in subroutine APROD.",
+ "The iteration limit ITNLIM was reached."
+ };
+
+ if
+ (rc < 0 || rc > 7) os << __FILE__ " : Illegal return code : " << rc << vcl_endl;
+ else
+ os << __FILE__ " : " << vnl_lsqr_reasons[rc] << vcl_endl;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.h
new file mode 100644
index 0000000000000000000000000000000000000000..0adafaa9cec48f38e423dbaf71ab982fc2a1381e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_lsqr.h
@@ -0,0 +1,73 @@
+// This is core/vnl/algo/vnl_lsqr.h
+#ifndef vnl_lsqr_h_
+#define vnl_lsqr_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Linear least squares
+//
+// vnl_lsqr implements an algorithm for large, sparse linear systems and
+// sparse, linear least squares. It is a wrapper for the LSQR algorithm
+// of Paige and Saunders (ACM TOMS 583). The sparse system is encapsulated
+// by a vnl_linear_system.
+//
+// \author David Capel, capes@robots
+// \date July 2000
+//
+// \verbatim
+// Modifications
+// 000705 capes@robots initial version.
+// 4/4/01 LSB (Manchester) Documentation tidied
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_linear_system.h>
+#include <vcl_iosfwd.h>
+
+//: Linear least squares
+// vnl_lsqr implements an algorithm for large, sparse linear systems and
+// sparse, linear least squares. It is a wrapper for the LSQR algorithm
+// of Paige and Saunders (ACM TOMS 583). The sparse system is encapsulated
+// by a vnl_linear_system.
+
+class vnl_lsqr
+{
+ public:
+ vnl_lsqr(vnl_linear_system& ls) :
+ ls_(&ls), max_iter_(4*ls.get_number_of_unknowns()) {}
+
+ ~vnl_lsqr();
+
+ void set_max_iterations(int max_iter) { max_iter_ = max_iter; }
+
+ //: Perform the minimization starting from x=0 and putting the result into x.
+ // Return code may be translated with translate_return_code().
+ int minimize(vnl_vector<double>& x);
+
+ int get_number_of_iterations() const { return num_iter_; }
+
+ //: Pontificate about the outcome of the last minimization.
+ void diagnose_outcome(vcl_ostream& os) const;
+
+ static void translate_return_code(vcl_ostream& os, int return_code);
+
+ protected:
+ vnl_linear_system* ls_;
+ int max_iter_;
+ int num_iter_;
+ double resid_norm_estimate_;
+ double result_norm_estimate_;
+ double A_condition_estimate_;
+ double result_norm_;
+ int return_code_;
+
+ static void aprod_(int* mode, int* m, int* n, double* x, double* y,
+ int* leniw, int* lenrw, int* iw, double* rw );
+
+ friend class vnl_lsqr_Activate;
+};
+
+#endif // vnl_lsqr_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.h
new file mode 100644
index 0000000000000000000000000000000000000000..6e6e17e7fffe88d527a49e9bd0aebf781894f613
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.h
@@ -0,0 +1,58 @@
+// This is core/vnl/algo/vnl_matrix_inverse.h
+#ifndef vnl_matrix_inverse_h_
+#define vnl_matrix_inverse_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Calculates inverse of a matrix (wrapper around vnl_svd<double>)
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 22 Nov 96
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// \endverbatim
+
+#include <vnl/algo/vnl_svd.h>
+
+//: Calculates inverse of a matrix (wrapper around vnl_svd<double>)
+// vnl_matrix_inverse is a wrapper around vnl_svd<double> that allows
+// you to write
+// \code
+// x = vnl_matrix_inverse<double>(A) * b;
+// \endcode
+// This is exactly equivalent to
+// \code
+// x = vnl_svd<double>(A).solve(b);
+// \endcode
+// but is arguably clearer, and also allows for the vnl_matrix_inverse
+// class to be changed to use vnl_qr, say.
+
+template <class T>
+struct vnl_matrix_inverse : public vnl_svd<T>
+{
+ vnl_matrix_inverse(vnl_matrix<T> const & M): vnl_svd<T>(M) { }
+ ~vnl_matrix_inverse() {};
+
+ operator vnl_matrix<T> () const { return this->inverse(); }
+};
+
+template <class T>
+inline
+vnl_vector<T> operator*(vnl_matrix_inverse<T> const & i,
+ vnl_vector<T> const & B)
+{
+ return i.solve(B);
+}
+
+template <class T>
+inline
+vnl_matrix<T> operator*(vnl_matrix_inverse<T> const & i,
+ vnl_matrix<T> const & B)
+{
+ return i.solve(B);
+}
+
+#endif // vnl_matrix_inverse_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.txx
new file mode 100644
index 0000000000000000000000000000000000000000..1501eec1d5f3cebdc70e91224da0f6482ee4cfe8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_matrix_inverse.txx
@@ -0,0 +1,17 @@
+// This is core/vnl/algo/vnl_matrix_inverse.txx
+#ifndef vnl_matrix_inverse_txx_
+#define vnl_matrix_inverse_txx_
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 22 Nov 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_matrix_inverse.h"
+
+#undef VNL_MATRIX_INVERSE_INSTANTIATE
+#define VNL_MATRIX_INVERSE_INSTANTIATE(T) \
+template struct vnl_matrix_inverse<T >;\
+VCL_INSTANTIATE_INLINE( vnl_vector<T > operator*(vnl_matrix_inverse<T > const &, vnl_vector<T > const &) ); \
+VCL_INSTANTIATE_INLINE( vnl_matrix<T > operator*(vnl_matrix_inverse<T > const &, vnl_matrix<T > const &) )
+
+#endif // vnl_matrix_inverse_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_netlib.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_netlib.h
new file mode 100644
index 0000000000000000000000000000000000000000..6db7279a6d839133624163f3f6824e5f02d86f6f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_netlib.h
@@ -0,0 +1,236 @@
+// This is core/vnl/algo/vnl_netlib.h
+#ifndef vnl_netlib_h_
+#define vnl_netlib_h_
+//:
+// \file
+// \brief Declare in a central place the list of symbols from netlib
+// \author fsm
+//
+// Declare in a central place the list of symbols from netlib referenced from vnl-algo.
+// This list was auto-generated, so it is exhaustive as of 16 March 2000 (10pm).
+//
+// Note: the declarations are initially entered as "int f()", which
+// will conflict with the actual prototype. If you get a conflict,
+// enter the correct prototype in here.
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <netlib.h>
+
+// xSVDC
+#define vnl_netlib_svd_proto(T) \
+T *x, int const *ldx, int const *m, int const *n, \
+T *sv, \
+T *errors, \
+T *u, int const *ldu, \
+T *v, int const *ldv, \
+T *work, \
+int const *job, int *info
+#define vnl_netlib_svd_params \
+x, ldx, m, n, sv, errors, u, ldu, v, ldv, work, job, info
+
+// xQRDC
+#define vnl_netlib_qrdc_proto(T) \
+T *x, \
+int const* ldx, \
+int const* n, \
+int const* p, \
+T* qraux, \
+int *jpvt, \
+T *work, \
+int const* job
+#define vnl_netlib_qrdc_params \
+x, ldx, n, p, qraux, jpvt, work, job
+
+// xQRSL
+#define vnl_netlib_qrsl_proto(T) \
+T const *x, \
+int *ldx, \
+int *n, \
+int *k, \
+T const *qraux, \
+T const *y, \
+T *qy, \
+T *qty, \
+T *b, \
+T *rsd, \
+T *xb, \
+int *job, \
+int *info
+#define vnl_netlib_qrsl_params \
+x, ldx, n, k, qraux, y, qy, qty, b, rsd, xb, job, info
+
+#if 0 // old interface
+
+struct vnl_netlib
+{
+ // To see why we do this, consider what would happen with:
+ // #define complex vcl_complex<float>
+ // #define doublecomplex vcl_complex<double>
+ // when vcl_complex is a #define for complex.
+ typedef int integer;
+ typedef float real;
+ typedef double doublereal;
+ typedef vcl_complex<float> complex;
+ typedef vcl_complex<double> doublecomplex;
+};
+
+extern "C" {
+#define integer vnl_netlib::integer
+#define real vnl_netlib::real
+#define doublereal vnl_netlib::doublereal
+#define complex vnl_netlib::complex
+#define doublecomplex vnl_netlib::doublecomplex
+ // complex eigensystem
+ int zgeev_(char const *jobvl,
+ char const *jobvr,
+ integer *n,
+ doublecomplex *a,
+ integer *lda,
+ doublecomplex *w,
+ doublecomplex *vl,
+ integer *ldvl,
+ doublecomplex *vr,
+ integer *ldvr,
+ doublecomplex *work,
+ integer *lwork,
+ doublereal *rwork,
+ integer *info);
+
+ // linpack xSVDC() routines
+ int ssvdc_(vnl_netlib_svd_proto(real));
+ int dsvdc_(vnl_netlib_svd_proto(doublereal));
+ int csvdc_(vnl_netlib_svd_proto(complex));
+ int zsvdc_(vnl_netlib_svd_proto(doublecomplex));
+
+ // linpack xQRDC QR routines
+ int sqrdc_(vnl_netlib_qrdc_proto(real));
+ int dqrdc_(vnl_netlib_qrdc_proto(doublereal));
+ int cqrdc_(vnl_netlib_qrdc_proto(complex));
+ int zqrdc_(vnl_netlib_qrdc_proto(doublecomplex));
+
+ // solve A x = b using QR ?
+ int sqrsl_(vnl_netlib_qrsl_proto(real));
+ int dqrsl_(vnl_netlib_qrsl_proto(doublereal));
+ int cqrsl_(vnl_netlib_qrsl_proto(complex));
+ int zqrsl_(vnl_netlib_qrsl_proto(doublecomplex));
+
+ // real eigensystem
+ int rg_(int const* nm,
+ int const* n,
+ double const* a,
+ doublereal* wr,
+ doublereal* wi,
+ int const* matz,
+ doublereal* z,
+ int* iv1,
+ doublereal* fv1,
+ int* ierr);
+
+ // temperton fft routines
+ int gpfa_ (real *a, real *b, real const *triggs,
+ int const *inc, int const *jump, int const *n,
+ int const *lot, int const *isign, int const *, int *);
+ int setgpfa_ (real *triggs, const int *, const int *, int *);
+ int dgpfa_(doublereal *a, doublereal *b, doublereal const *triggs,
+ int const *inc, int const *jump, int const *n,
+ int const *lot, int const *isign, int const *, int *);
+ int dsetgpfa_(doublereal *triggs, const int *, const int *, int *);
+
+ // symmetric eigensystem
+ int rs_(int const * nm, int const * n,
+ doublereal const *a, doublereal *w,
+ int const * matz, doublereal const *z,
+ doublereal const *fv1, doublereal const *fv2,
+ int * ierr);
+
+ // generalized eigensystem
+ int rsg_ (int const * nm, int const * n, doublereal const *a, doublereal const *b,
+ doublereal *w, int const * matz, doublereal *z, doublereal *fv1, doublereal *fv2,
+ int *ierr);
+
+ // cholesky
+ int dpofa_(doublereal *m, const int* lda, const int* n, int* info);
+ int dposl_(const doublereal *a, const int* lda, const int* n, doublereal *b);
+ int dpoco_(doublereal *a, const int* lda, const int* n,
+ doublereal* rcond, doublereal *z, int *info);
+ int dpodi_(const doublereal *a, const int* lda, const int* n,
+ doublereal* det, const int* job);
+
+ // roots of real polynomial
+ void rpoly_(const doublereal* op, int* degree, doublereal *zeror,
+ doublereal *zeroi, int *fail);
+
+ //
+ void dchscdf_();
+ int lbfgs_();
+ int dnlaso_();
+ int cg_();
+
+ // lmdif() is used by vnl_levenberg_marquardt
+ int lmdif_(int fcn(int* m, // I Number of residuals
+ int* n, // I Number of unknowns
+ doublereal const* x, // I Solution vector, size n
+ doublereal* fx, // O Residual vector f(x)
+ int* iflag // IO 0 ==> print, -1 ==> terminate
+ ),
+ int *m, // I Number of residuals, must be > #unknowns
+ int *n, // I Number of unknowns
+ doublereal *x, // IO Solution vector, size n
+ doublereal *fvec, // W m Storage for residual vector
+ doublereal *ftol, // I Termination tolerance on F (sum of squared residuals)
+ doublereal *xtol, // I Termination tolerance on X (solution vector)
+ doublereal *gtol, // I Termination tolerance on Grad(F)' * F = 0
+ int *maxfev, // I Termination maximum number of iterations.
+ doublereal *epsfcn, // I Step length for FD Jacobian
+ doublereal *diag, // I Multiplicative scale factors for variables
+ int *mode, // I 1 => Compute diag, 2 => user has set diag
+ doublereal *factor, // I Initial step bound. Set to 100.
+ int *nprint, // I +ive => print every nprint iters.
+ int *info, // O See switch (info) below
+ int *nfev, // O Number of function evaluations
+ doublereal *fjac, // O m*n Upper n*n is P'J'JP = R'R
+ int *ldfjac, // I Leading dimension of fdjac -- set to m
+ int *ipvt, // O n Permutation indices P
+ doublereal *qtf, // O n Q'*f(x)
+ doublereal *wa1, // W n
+ doublereal *wa2, // W n
+ doublereal *wa3, // W n
+ doublereal *wa4, // W m
+ doublereal *errors); // O 2 Start/end RMS errors
+
+ // lmder() is used by vnl_levenberg_marquardt
+ int lmder1_(int fcn(int* m, // I Number of residuals
+ int* n, // I Number of unknowns
+ doublereal const* x, // I Solution vector, size n
+ doublereal* fx, // O Residual vector f(x), size m
+ doublereal* fJ, // O m * n Jacobian f(x)
+ int*,
+ int* iflag // I 1 -> calc fx, 2 -> calc fjac
+ // O 0 ==> print, -1 ==> terminate
+ ),
+ int const* m, // I Number of residuals
+ int const* n, // I Number of unknowns
+ doublereal* x, // I Solution vector, size n
+ doublereal* fvec, // O Residual vector f(x), size m
+ doublereal* fjac, // O m * n Jacobian f(x)
+ int const* ldfjac, // I LD of fjac
+ doublereal const* tol, // I x/ftol
+ int* info, // O
+ int* ipvt, // O length n
+ doublereal * wa, // I work, length lwa
+ const int* lwa); // I > 5*n+m
+#undef integer
+#undef real
+#undef doublereal
+#undef complex
+#undef doublecomplex
+};
+
+#endif // 0
+
+#endif // vnl_netlib_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.h
new file mode 100644
index 0000000000000000000000000000000000000000..f43b53c992f0f92767317c37d8fbeb0cfb5f329f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.h
@@ -0,0 +1,28 @@
+// This is core/vnl/algo/vnl_orthogonal_complement.h
+#ifndef vnl_orthogonal_complement_h_
+#define vnl_orthogonal_complement_h_
+//:
+// \file
+// \brief For computing the orthogonal complement to a linear subspace.
+// \author fsm
+//
+// \verbatim
+// Modifications
+// 4/4/01 LSB(Manchester) Tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Return a matrix whose columns span is the orthogonal complement of v.
+template <class T>
+vnl_matrix<T> vnl_orthogonal_complement(vnl_vector<T> const &v);
+
+#if 0
+//: Return a matrix whose column span is the orthogonal complement of the column span of M.
+template <class T>
+vnl_matrix<T> vnl_orthogonal_complement(vnl_matrix<T> const &M);
+#endif
+
+#endif // vnl_orthogonal_complement_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.txx
new file mode 100644
index 0000000000000000000000000000000000000000..1b5a2f9c8d81c73dee2ea7abacc1efe7b53689cc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_orthogonal_complement.txx
@@ -0,0 +1,34 @@
+// This is core/vnl/algo/vnl_orthogonal_complement.txx
+#ifndef vnl_orthogonal_complement_txx_
+#define vnl_orthogonal_complement_txx_
+/*
+ fsm
+*/
+#include "vnl_orthogonal_complement.h"
+#include <vnl/algo/vnl_svd.h>
+
+template <class T>
+vnl_matrix<T> vnl_orthogonal_complement(vnl_vector<T> const &v)
+{
+ unsigned n = v.size();
+ vnl_matrix<T> tmp(1, n);
+ tmp.set_row(0, v);
+ return vnl_svd<T>(tmp).V().extract(n, n-1, 0, 1);
+}
+
+#if 0
+template <class T>
+vnl_matrix<T> vnl_orthogonal_complement(vnl_matrix<T> const &M)
+{
+ // TODO
+}
+#endif
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_ORTHOGONAL_COMPLEMENT_INSTANTIATE
+#define VNL_ORTHOGONAL_COMPLEMENT_INSTANTIATE(T) \
+/* template vnl_matrix<T > vnl_orthogonal_complement(vnl_matrix<T > const &); */ \
+template vnl_matrix<T > vnl_orthogonal_complement(vnl_vector<T > const &)
+
+#endif // vnl_orthogonal_complement_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..fd90912bbd0a657abfdcf04f757b3be20dfbbf3b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.cxx
@@ -0,0 +1,140 @@
+// This is core/vnl/algo/vnl_powell.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+#include "vnl_powell.h"
+
+#include <vcl_cassert.h>
+#include <vnl/vnl_math.h>
+#include <vnl/algo/vnl_brent.h>
+#ifdef DEBUG
+#include <vcl_iostream.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vcl_iostream.h>
+#endif
+
+class vnl_powell_1dfun : public vnl_cost_function
+{
+ public:
+ vnl_powell* powell_;
+ vnl_cost_function* f_;
+ unsigned int n_;
+ vnl_vector<double> x0_;
+ vnl_vector<double> dx_;
+ vnl_vector<double> tmpx_;
+ vnl_powell_1dfun(int n, vnl_cost_function* f, vnl_powell* p)
+ : vnl_cost_function(1), powell_(p), f_(f), n_(n), x0_(n), dx_(n), tmpx_(n) {}
+
+ void init(vnl_vector<double> const& x0, vnl_vector<double> const& dx)
+ {
+ x0_ = x0;
+ dx_ = dx;
+ assert(x0.size() == n_);
+ assert(dx.size() == n_);
+ }
+
+ double f(const vnl_vector<double>& x)
+ {
+ uninit(x[0], tmpx_);
+ double e = f_->f(tmpx_);
+ powell_->pub_report_eval(e);
+ return e;
+ }
+
+ void uninit(double lambda, vnl_vector<double>& out)
+ {
+ for (unsigned int i = 0; i < n_; ++i)
+ out[i] = x0_[i] + lambda * dx_[i];
+ }
+};
+
+vnl_nonlinear_minimizer::ReturnCodes
+vnl_powell::minimize(vnl_vector<double>& p)
+ //double p[], double **xi, int n
+{
+ // verbose_ = true;
+ int n = p.size();
+ vnl_powell_1dfun f1d(n, functor_, this);
+
+ vnl_matrix<double> xi(n,n, vnl_matrix_identity);
+ vnl_vector<double> ptt(n);
+ vnl_vector<double> xit(n);
+ double fret = functor_->f(p);
+ report_eval(fret);
+ vnl_vector<double> pt = p;
+ while (num_iterations_ < unsigned(maxfev))
+ {
+ double fp = fret;
+ int ibig=0;
+ double del=0.0;
+
+ for (int i=0;i<n;i++)
+ {
+ // xit = ith column of xi
+ for (int j = 0; j < n; ++j)
+ xit[j] = xi[j][i];
+ double fptt = fret;
+
+ // 1D minimization along xi
+ f1d.init(p, xit);
+ vnl_brent brent(&f1d);
+ double ax = 0.0;
+ double xx = initial_step_;
+ double bx;
+ brent.bracket_minimum(&ax, &xx, &bx);
+ fret = brent.minimize_given_bounds(bx, xx, ax, linmin_xtol_, &xx);
+ f1d.uninit(xx, p);
+ // Now p is minimizer along xi
+
+ if (vcl_fabs(fptt-fret) > del) {
+ del = vcl_fabs(fptt-fret);
+ ibig = i;
+ }
+ }
+
+ if (2.0*vcl_fabs(fp-fret) <= ftol*(vcl_fabs(fp)+vcl_fabs(fret)))
+ {
+#ifdef DEBUG
+ vnl_matlab_print(vcl_cerr, xi, "xi");
+#endif
+ return CONVERGED_FTOL;
+ }
+
+ if (num_iterations_ == unsigned(maxfev))
+ return FAILED_TOO_MANY_ITERATIONS;
+
+ for (int j=0;j<n;++j)
+ {
+ ptt[j]=2.0*p[j]-pt[j];
+ xit[j]=p[j]-pt[j];
+ pt[j]=p[j];
+ }
+
+ double fptt = functor_->f(ptt);
+ report_eval(fret);
+ if (fptt < fp)
+ {
+ double t=2.0*(fp-2.0*fret+fptt)*vnl_math_sqr(fp-fret-del)-del*vnl_math_sqr(fp-fptt);
+ if (t < 0.0)
+ {
+ f1d.init(p, xit);
+ vnl_brent brent(&f1d);
+ double ax = 0.0;
+ double xx = 1.0;
+ double bx;
+ brent.bracket_minimum(&ax, &xx, &bx);
+ fret = brent.minimize_given_bounds(bx, xx, ax, linmin_xtol_, &xx);
+ f1d.uninit(xx, p);
+
+ for (int j=0;j<n;j++) {
+ xi[j][ibig]=xi[j][n-1];
+ xi[j][n-1]=xit[j];
+ }
+ }
+ }
+ report_iter();
+ }
+ return FAILED_TOO_MANY_ITERATIONS;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.h
new file mode 100644
index 0000000000000000000000000000000000000000..5bca58b9664eb645007818b628a119b93d619552
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_powell.h
@@ -0,0 +1,52 @@
+// This is core/vnl/algo/vnl_powell.h
+#ifndef vnl_powell_h_
+#define vnl_powell_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Powell minimizer.
+// \author awf@robots.ox.ac.uk
+// \date 05 Dec 00
+
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+//: The ever-popular Powell minimizer.
+// Derivative-free method which may be faster if your
+// function is expensive to compute and many-dimensional.
+// Implemented from scratch from NR.
+class vnl_powell : public vnl_nonlinear_minimizer
+{
+ public:
+
+ //: Initialize a powell with the given cost function
+ vnl_powell(vnl_cost_function* functor)
+ : functor_(functor), linmin_xtol_(1e-4), initial_step_(1.0) {}
+
+ //: Run minimization, place result in x.
+ ReturnCodes minimize(vnl_vector<double>& x);
+
+ //: Set tolerance on line search parameter step
+ // Default value is 0.0001
+ void set_linmin_xtol(double tol) { linmin_xtol_ = tol; }
+
+ //: Set initial step when bracketting minima along a line
+ // Default value is 1.0
+ void set_initial_step(double step) { initial_step_ = step; }
+
+ protected:
+ vnl_cost_function* functor_;
+
+ friend class vnl_powell_1dfun;
+ void pub_report_eval(double e) { report_eval(e); }
+
+ //: Tolerance on line search parameter step
+ double linmin_xtol_;
+
+ //: Initial step when bracketting minima along a line
+ double initial_step_;
+};
+
+#endif // vnl_powell_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.h
new file mode 100644
index 0000000000000000000000000000000000000000..aefb79ee6689cc9f258c61d7ba6b8cc14ee20e49
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.h
@@ -0,0 +1,91 @@
+// This is core/vnl/algo/vnl_qr.h
+#ifndef vnl_qr_h_
+#define vnl_qr_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Calculate inverse of a matrix using QR
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 08 Dec 96
+//
+// \verbatim
+// Modifications
+// 081296 AWF Temporarily abandoned as I realized my problem was symmetric...
+// 080697 AWF Recovered, implemented solve().
+// 200897 AWF Added determinant().
+// 071097 AWF Added Q(), R().
+// Christian Stoecklin, ETH Zurich, added QtB(v)
+// 31-mar-2000 fsm: templated
+// 28/03/2001 - dac (Manchester) - tidied up documentation
+// 13 Jan.2003 - Peter Vanroose - added missing implementation for inverse(),
+// tinverse(), solve(matrix), extract_q_and_r().
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vcl_iosfwd.h>
+
+//: Extract the Q*R decomposition of matrix M.
+// The decomposition is stored in a compact and time-efficient
+// packed form, which is most easily used via the "solve" and
+// "determinant" methods.
+
+export template <class T>
+class vnl_qr
+{
+ public:
+ vnl_qr(vnl_matrix<T> const & M);
+ ~vnl_qr();
+
+ //: return the inverse matrix of M
+ vnl_matrix<T> inverse () const;
+ //: return the transpose of the inverse matrix of M
+ vnl_matrix<T> tinverse () const;
+ //: return the original matrix M
+ vnl_matrix<T> recompose () const;
+
+ //: Solve equation M x = rhs for x using the computed decomposition.
+ vnl_matrix<T> solve (const vnl_matrix<T>& rhs) const;
+ //: Solve equation M x = rhs for x using the computed decomposition.
+ vnl_vector<T> solve (const vnl_vector<T>& rhs) const;
+
+ //: Return the determinant of M. This is computed from M = Q R as follows:
+ // |M| = |Q| |R|.
+ // |R| is the product of the diagonal elements.
+ // |Q| is (-1)^n as it is a product of Householder reflections.
+ // So det = -prod(-r_ii).
+ T determinant() const;
+ //: Unpack and return unitary part Q.
+ vnl_matrix<T> const& Q() const;
+ //: Unpack and return R.
+ vnl_matrix<T> const& R() const;
+ //: Return residual vector d of M x = b -> d = Q'b
+ vnl_vector<T> QtB(const vnl_vector<T>& b) const;
+
+ void extract_q_and_r(vnl_matrix<T>* q, vnl_matrix<T>* r) const { *q = Q(); *r = R(); }
+
+ private:
+ vnl_matrix<T> qrdc_out_;
+ vnl_vector<T> qraux_;
+ vnl_vector<int> jpvt_;
+ vnl_matrix<T>* Q_;
+ vnl_matrix<T>* R_;
+
+ // Disallow assignment.
+ vnl_qr(const vnl_qr<T> &) { }
+ void operator=(const vnl_qr<T> &) { }
+};
+
+//: Compute determinant of matrix "M" using QR.
+template <class T>
+inline T vnl_qr_determinant(vnl_matrix<T> const& m)
+{
+ return vnl_qr<T>(m).determinant();
+}
+
+export template <class T>
+vcl_ostream& operator<<(vcl_ostream&, vnl_qr<T> const & qr);
+
+#endif // vnl_qr_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.txx
new file mode 100644
index 0000000000000000000000000000000000000000..d2fdcc0f749c2dd51be03024eeb6cfaae68b2220
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_qr.txx
@@ -0,0 +1,308 @@
+// This is core/vnl/algo/vnl_qr.txx
+#ifndef vnl_qr_txx_
+#define vnl_qr_txx_
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 08 Dec 96
+
+#include "vnl_qr.h"
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_complex.h> // vnl_math_squared_magnitude()
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_complex_traits.h>
+#include <vnl/algo/vnl_netlib.h> // dqrdc_(), dqrsl_()
+
+// use C++ overloading to call the right linpack routine from the template code :
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+#define macro(p, T) \
+inline void vnl_linpack_qrdc(vnl_netlib_qrdc_proto(T)) \
+{ p##qrdc_(vnl_netlib_qrdc_params); } \
+inline void vnl_linpack_qrsl(vnl_netlib_qrsl_proto(T)) \
+{ p##qrsl_(vnl_netlib_qrsl_params); }
+macro(s, float);
+macro(d, double);
+macro(c, vcl_complex<float>);
+macro(z, vcl_complex<double>);
+#undef macro
+#endif
+
+template <class T>
+vnl_qr<T>::vnl_qr(vnl_matrix<T> const& M):
+ qrdc_out_(M.columns(), M.rows()),
+ qraux_(M.columns()),
+ jpvt_(M.rows()),
+ Q_(0),
+ R_(0)
+{
+ assert(! M.empty());
+
+ // Fill transposed O/P matrix
+ int c = M.columns();
+ int r = M.rows();
+ for (int i = 0; i < r; ++i)
+ for (int j = 0; j < c; ++j)
+ qrdc_out_(j,i) = M(i,j);
+
+ int do_pivot = 0; // Enable[!=0]/disable[==0] pivoting.
+ jpvt_.fill(0); // Allow all columns to be pivoted if pivoting is enabled.
+
+ vnl_vector<T> work(M.rows());
+ vnl_linpack_qrdc(qrdc_out_.data_block(), // On output, UT is R, below diag is mangled Q
+ &r, &r, &c,
+ qraux_.data_block(), // Further information required to demangle Q
+ jpvt_.data_block(),
+ work.data_block(),
+ &do_pivot);
+}
+
+template <class T>
+vnl_qr<T>::~vnl_qr()
+{
+ delete Q_;
+ delete R_;
+}
+
+//: Return the determinant of M. This is computed from M = Q R as follows:
+// |M| = |Q| |R|
+// |R| is the product of the diagonal elements.
+// |Q| is (-1)^n as it is a product of Householder reflections.
+// So det = -prod(-r_ii).
+template <class T>
+T vnl_qr<T>::determinant() const
+{
+ int m = vnl_math_min((int)qrdc_out_.columns(), (int)qrdc_out_.rows());
+ T det = qrdc_out_(0,0);
+
+ for (int i = 1; i < m; ++i)
+ det *= -qrdc_out_(i,i);
+
+ return det;
+}
+
+//: Unpack and return unitary part Q.
+template <class T>
+vnl_matrix<T> const& vnl_qr<T>::Q() const
+{
+ int m = qrdc_out_.columns(); // column-major storage
+ int n = qrdc_out_.rows();
+
+ bool verbose = false;
+
+ if (!Q_) {
+ ((vnl_matrix<T>*&)Q_) = new vnl_matrix<T>(m,m);
+ // extract Q.
+ if (verbose) {
+ vcl_cerr << __FILE__ ": vnl_qr<T>::Q()\n"
+ << " m,n = " << m << ", " << n << '\n'
+ << " qr0 = [" << qrdc_out_ << "];\n"
+ << " aux = [" << qraux_ << "];\n";
+ }
+
+ Q_->set_identity();
+ vnl_matrix<T>& Q = *Q_;
+
+ vnl_vector<T> v(m, T(0));
+ vnl_vector<T> w(m, T(0));
+
+ // Golub and vanLoan, p199. backward accumulation of householder matrices
+ // Householder vector k is [zeros(1,k-1) qraux_[k] qrdc_out_[k,:]]
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ for (int k = n-1; k >= 0; --k) {
+ if (k >= m) continue;
+ // Make housevec v, and accumulate norm at the same time.
+ v[k] = qraux_[k];
+ abs_t sq = vnl_math_squared_magnitude(v[k]);
+ for (int j = k+1; j < m; ++j) {
+ v[j] = qrdc_out_(k,j);
+ sq += vnl_math_squared_magnitude(v[j]);
+ }
+ if (verbose) vnl_matlab_print(vcl_cerr, v, "v");
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+# define c vnl_complex_traits<T>::conjugate
+#endif
+ // Premultiply emerging Q by house(v), noting that v[0..k-1] == 0.
+ // Q_new = (1 - (2/v'*v) v v')Q
+ // or Q -= (2/v'*v) v (v'Q)
+ if (sq > abs_t(0)) {
+ abs_t scale = abs_t(2)/sq;
+ // w = (2/v'*v) v' Q
+ for (int i = k; i < m; ++i) {
+ w[i] = T(0);
+ for (int j = k; j < m; ++j)
+ w[i] += scale * c(v[j]) * Q(j, i);
+ }
+ if (verbose) vnl_matlab_print(vcl_cerr, w, "w");
+
+ // Q -= v w
+ for (int i = k; i < m; ++i)
+ for (int j = k; j < m; ++j)
+ Q(i,j) -= (v[i]) * (w[j]);
+ }
+#undef c
+ }
+ }
+ return *Q_;
+}
+
+//: Unpack and return R.
+template <class T>
+vnl_matrix<T> const& vnl_qr<T>::R() const
+{
+ if (!R_) {
+ int m = qrdc_out_.columns(); // column-major storage
+ int n = qrdc_out_.rows();
+ ((vnl_matrix<T>*&)R_) = new vnl_matrix<T>(m,n);
+ vnl_matrix<T> & R = *R_;
+
+ for (int i = 0; i < m; ++i)
+ for (int j = 0; j < n; ++j)
+ if (i > j)
+ R(i, j) = T(0);
+ else
+ R(i, j) = qrdc_out_(j,i);
+ }
+
+ return *R_;
+}
+
+template <class T>
+vnl_matrix<T> vnl_qr<T>::recompose() const
+{
+ return Q() * R();
+}
+
+// JOB: ABCDE decimal
+// A B C D E
+// --- --- --- --- ---
+// Qb Q'b x norm(A*x - b) A*x
+
+
+//: Solve equation M x = b for x using the computed decomposition.
+template <class T>
+vnl_vector<T> vnl_qr<T>::solve(const vnl_vector<T>& b) const
+{
+ int n = qrdc_out_.columns();
+ int p = qrdc_out_.rows();
+ const T* b_data = b.data_block();
+ vnl_vector<T> QtB(n);
+ vnl_vector<T> x(p);
+
+ // see comment above
+ int JOB = 100;
+
+ int info = 0;
+ vnl_linpack_qrsl(qrdc_out_.data_block(),
+ &n, &n, &p,
+ qraux_.data_block(),
+ b_data, (T*)0, QtB.data_block(),
+ x.data_block(),
+ (T*)0/*residual*/,
+ (T*)0/*Ax*/,
+ &JOB,
+ &info);
+
+ if (info > 0)
+ vcl_cerr << __FILE__ ": vnl_qr<T>::solve() : matrix is rank-deficient by "
+ << info << '\n';
+
+ return x;
+}
+
+//: Return residual vector d of M x = b -> d = Q'b
+template <class T>
+vnl_vector<T> vnl_qr<T>::QtB(const vnl_vector<T>& b) const
+{
+ int n = qrdc_out_.columns();
+ int p = qrdc_out_.rows();
+ const T* b_data = b.data_block();
+ vnl_vector<T> QtB(n);
+
+ // see comment above
+ int JOB = 1000;
+
+ int info = 0;
+ vnl_linpack_qrsl(qrdc_out_.data_block(),
+ &n, &n, &p,
+ qraux_.data_block(),
+ b_data,
+ (T*)0, // A: Qb
+ QtB.data_block(), // B: Q'b
+ (T*)0, // C: x
+ (T*)0, // D: residual
+ (T*)0, // E: Ax
+ &JOB,
+ &info);
+
+ if (info > 0)
+ vcl_cerr << __FILE__ ": vnl_qr<T>::QtB() -- matrix is rank-deficient by "
+ << info << '\n';
+
+ return QtB;
+}
+
+template <class T>
+vnl_matrix<T> vnl_qr<T>::inverse () const
+{
+ int r = qrdc_out_.columns(), c = qrdc_out_.rows();
+ assert(r == c && r > 0);
+ vnl_matrix<T> inv(r,r);
+
+ // Use solve() to compute the inverse matrix, using (00..010..00) as rhs
+ vnl_vector<T> rhs(r,T(0));
+ for (int i=0; i<r; ++i)
+ {
+ rhs(i) = T(1);
+ vnl_vector<T> col = this->solve(rhs); // returns i-th column of inverse
+ inv.set_column(i,col);
+ rhs(i) = T(0);
+ }
+ return inv;
+}
+
+template <class T>
+vnl_matrix<T> vnl_qr<T>::tinverse () const
+{
+ int r = qrdc_out_.columns(), c = qrdc_out_.rows();
+ assert(r == c && r > 0);
+ vnl_matrix<T> tinv(r,r);
+
+ // Use solve() to compute the inverse matrix, using (00..010..00) as rhs
+ vnl_vector<T> rhs(r,T(0));
+ for (int i=0; i<r; ++i)
+ {
+ rhs(i) = T(1);
+ vnl_vector<T> col = this->solve(rhs); // returns i-th column of inverse
+ tinv.set_row(i,col);
+ rhs(i) = T(0);
+ }
+ return tinv;
+}
+
+template <class T>
+vnl_matrix<T> vnl_qr<T>::solve(vnl_matrix<T> const& rhs) const
+{
+ int r = qrdc_out_.columns(), c = qrdc_out_.rows(); // column-major storage
+ int m = rhs.rows(), n = rhs.columns();
+ assert(m==r);
+ vnl_matrix<T> result(c,n);
+
+ for (int i=0; i<n; ++i)
+ {
+ vnl_vector<T> b = rhs.get_column(i);
+ vnl_vector<T> col = this->solve(b); // returns i-th column of result
+ result.set_column(i,col);
+ }
+ return result;
+}
+
+//--------------------------------------------------------------------------------
+
+#define VNL_QR_INSTANTIATE(T) \
+ template class vnl_qr<T >; \
+ VCL_INSTANTIATE_INLINE(T vnl_qr_determinant(vnl_matrix<T > const&))
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..88bf206a164fd4c789df29fc293e45cbdc3a0469
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.cxx
@@ -0,0 +1,64 @@
+// This is core/vnl/algo/vnl_real_eigensystem.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Jan 97
+
+//-----------------------------------------------------------------------------
+
+#include "vnl_real_eigensystem.h"
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_fortran_copy.h>
+#include <vnl/algo/vnl_netlib.h> // rg_()
+
+//: Extract eigensystem of unsymmetric matrix M, using the EISPACK routine rg.
+// Should probably switch to using LAPACK's dgeev to avoid transposing.
+vnl_real_eigensystem::vnl_real_eigensystem(vnl_matrix<double> const & M):
+ Vreal(M.rows(), M.columns()),
+ V(M.rows(), M.columns()),
+ D(M.rows())
+{
+ int n = M.rows();
+ assert(n == (int)(M.columns()));
+
+ vnl_fortran_copy<double> mf(M);
+
+ vnl_vector<double> wr(n);
+ vnl_vector<double> wi(n);
+ vnl_vector<int> iv1(n);
+ vnl_vector<double> fv1(n);
+ vnl_matrix<double> devout(n, n);
+
+ int ierr = 0;
+ int matz = 1;
+ rg_(&n, &n, mf, wr.data_block(), wi.data_block(), &matz, devout.data_block(), iv1.data_block(), fv1.data_block(), &ierr);
+
+ if (ierr != 0) {
+ vcl_cerr << " *** vnl_real_eigensystem: Failed on " << ierr << "th eigenvalue\n"
+ << M << vcl_endl;
+ }
+
+ // Copy out eigenvalues and eigenvectors
+ for (int c = 0; c < n; ++c) {
+ D(c,c) = vcl_complex<double>(wr[c], wi[c]);
+ if (wi[c] != 0) {
+ // Complex - copy conjugates and inc c.
+ D(c+1, c+1) = vcl_complex<double>(wr[c], -wi[c]);
+ for (int r = 0; r < n; ++r) {
+ V(r, c) = vcl_complex<double>(devout(c,r), devout(c+1,r));
+ V(r, c+1) = vcl_complex<double>(devout(c,r), -devout(c+1,r));
+ }
+
+ ++c;
+ } else
+ for (int r = 0; r < n; ++r) {
+ V(r, c) = vcl_complex<double>(devout(c,r), 0);
+ Vreal(r,c) = devout(c,r);
+ }
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.h
new file mode 100644
index 0000000000000000000000000000000000000000..6ca803c33ad9c5bf5cbc75a98b734ea062c9dc89
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_real_eigensystem.h
@@ -0,0 +1,42 @@
+// This is core/vnl/algo/vnl_real_eigensystem.h
+#ifndef vnl_real_eigensystem_h_
+#define vnl_real_eigensystem_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Extract eigensystem of unsymmetric matrix M, using EISPACK
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Jan 97
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// \endverbatim
+//
+
+#include <vcl_complex.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_diag_matrix.h>
+
+//: Extract eigensystem of unsymmetric matrix M, using the EISPACK routine
+// vnl_eigensystem is a full-bore real eigensystem. If your matrix
+// is symmetric, it is *much* better to use vnl_symmetric_eigensystem.
+
+class vnl_real_eigensystem
+{
+ public:
+ vnl_real_eigensystem(vnl_matrix<double> const& M);
+
+ public:
+ vnl_matrix<double> Vreal;
+
+ //: Output matrix of eigenvectors, which will in general be complex.
+ vnl_matrix<vcl_complex<double> > V;
+
+ //: Output diagonal matrix of eigenvalues.
+ vnl_diag_matrix<vcl_complex<double> > D;
+};
+
+#endif // vnl_real_eigensystem_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1ff0b67c7af17ea32fd7939e9a706fdd30d6171a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.cxx
@@ -0,0 +1,807 @@
+// This is core/vnl/algo/vnl_rnpoly_solve.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+#include "vnl_rnpoly_solve.h"
+
+#include <vcl_cmath.h>
+#include <vcl_cassert.h>
+#ifdef DEBUG
+#include <vcl_iostream.h>
+#include <vcl_fstream.h>
+#endif
+
+static unsigned int dim_ = 0; // dimension of the problem
+static unsigned int max_deg_ = 0; // maximal degree
+static unsigned int max_nterms_ = 0; // maximal number of terms
+
+//: This is a local implementation of a minimal "complex number" class, for internal use only
+class vnl_rnpoly_solve_cmplx
+{
+ public:
+ double R;
+ double C;
+ vnl_rnpoly_solve_cmplx(double a=0, double b=0) : R(a), C(b) {}
+ inline double norm() const { return R*R+C*C; }
+ inline vnl_rnpoly_solve_cmplx operator-() const
+ { return vnl_rnpoly_solve_cmplx(-R, -C); }
+ inline vnl_rnpoly_solve_cmplx operator+(vnl_rnpoly_solve_cmplx const& Y) const
+ { return vnl_rnpoly_solve_cmplx(R+Y.R, C+Y.C); }
+ inline vnl_rnpoly_solve_cmplx operator-(vnl_rnpoly_solve_cmplx const& Y) const
+ { return vnl_rnpoly_solve_cmplx(R-Y.R, C-Y.C); }
+ inline vnl_rnpoly_solve_cmplx& operator+=(vnl_rnpoly_solve_cmplx const& Y)
+ { R+=Y.R; C+=Y.C; return *this; }
+ inline vnl_rnpoly_solve_cmplx& operator-=(vnl_rnpoly_solve_cmplx const& Y)
+ { R-=Y.R; C-=Y.C; return *this; }
+ inline vnl_rnpoly_solve_cmplx operator*(vnl_rnpoly_solve_cmplx const& Y) const
+ { return vnl_rnpoly_solve_cmplx(R*Y.R-C*Y.C, R*Y.C+C*Y.R); }
+ inline vnl_rnpoly_solve_cmplx operator/(vnl_rnpoly_solve_cmplx const& Y) const
+ { double N=1.0/Y.norm(); return vnl_rnpoly_solve_cmplx((R*Y.R+C*Y.C)*N, (C*Y.R-R*Y.C)*N); }
+ inline vnl_rnpoly_solve_cmplx operator*(double T) const
+ { return vnl_rnpoly_solve_cmplx(R*T, C*T); }
+ inline vnl_rnpoly_solve_cmplx& operator*=(double T)
+ { R*=T; C*=T; return *this; }
+ inline vnl_rnpoly_solve_cmplx& operator*=(vnl_rnpoly_solve_cmplx const& Y)
+ { double r=R*Y.R-C*Y.C; C=R*Y.C+C*Y.R; R=r; return *this; }
+ inline vnl_rnpoly_solve_cmplx& operator/=(vnl_rnpoly_solve_cmplx const& Y)
+ { return *this = operator/(Y); }
+};
+
+static const double twopi = 6.2831853071795864769;
+
+static const double epsilonB = 2.e-03;
+static const vnl_rnpoly_solve_cmplx epsilonZ = vnl_rnpoly_solve_cmplx(1.e-04,1.e-04);
+static const double final_eps = 1.e-10;
+static const double stepinit = 1.e-02;
+
+
+vcl_vector<vnl_vector<double>*> vnl_rnpoly_solve::realroots(double tol)
+{
+ tol *= tol; // squared tolerance
+ vcl_vector<vnl_vector<double>*> rr;
+ vcl_vector<vnl_vector<double>*>::iterator rp = r_.begin(), ip = i_.begin();
+ for (; rp != r_.end() && ip != i_.end(); ++rp, ++ip)
+ if ((*ip)->squared_magnitude() < tol)
+ rr.push_back(*rp);
+
+ return rr;
+}
+
+
+//------------------------- INPTBR ---------------------------
+//: Initialize random variables
+// This will initialize the random variables which are used
+// to preturb the starting point so as to have measure zero
+// probability that we will start at a singular point.
+static void inptbr(vcl_vector<vnl_rnpoly_solve_cmplx>& p, vcl_vector<vnl_rnpoly_solve_cmplx>& q)
+{
+ vnl_rnpoly_solve_cmplx pp[10],qq[10];
+
+ pp[0] = vnl_rnpoly_solve_cmplx(.12324754231, .76253746298);
+ pp[1] = vnl_rnpoly_solve_cmplx(.93857838950, -.99375892810);
+ pp[2] = vnl_rnpoly_solve_cmplx(-.23467908356, .39383930009);
+ pp[3] = vnl_rnpoly_solve_cmplx(.83542556622, -.10192888288);
+ pp[4] = vnl_rnpoly_solve_cmplx(-.55763522521, -.83729899911);
+ pp[5] = vnl_rnpoly_solve_cmplx(-.78348738738, -.10578234903);
+ pp[6] = vnl_rnpoly_solve_cmplx(.03938347346, .04825184716);
+ pp[7] = vnl_rnpoly_solve_cmplx(-.43428734331, .93836289418);
+ pp[8] = vnl_rnpoly_solve_cmplx(-.99383729993, -.40947822291);
+ pp[9] = vnl_rnpoly_solve_cmplx(.09383736736, .26459172298);
+
+ qq[0] = vnl_rnpoly_solve_cmplx(.58720452864, .01321964722);
+ qq[1] = vnl_rnpoly_solve_cmplx(.97884134700, -.14433009712);
+ qq[2] = vnl_rnpoly_solve_cmplx(.39383737289, .4154322311);
+ qq[3] = vnl_rnpoly_solve_cmplx(-.03938376373, -.61253112318);
+ qq[4] = vnl_rnpoly_solve_cmplx(.39383737388, -.26454678861);
+ qq[5] = vnl_rnpoly_solve_cmplx(-.0093837766, .34447867861);
+ qq[6] = vnl_rnpoly_solve_cmplx(-.04837366632, .48252736790);
+ qq[7] = vnl_rnpoly_solve_cmplx(.93725237347, -.54356527623);
+ qq[8] = vnl_rnpoly_solve_cmplx(.39373957747, .65573434564);
+ qq[9] = vnl_rnpoly_solve_cmplx(-.39380038371, .98903450052);
+
+ p.resize(dim_); q.resize(dim_);
+ for (unsigned int j=0; j<dim_; ++j) { int jj=j%10; p[j]=pp[jj]; q[j]=qq[jj]; }
+}
+
+//----------------------------- POWR -----------------------
+//: This returns the complex number y raised to the nth degree
+static inline vnl_rnpoly_solve_cmplx powr(int n,vnl_rnpoly_solve_cmplx const& y)
+{
+ vnl_rnpoly_solve_cmplx x(1,0);
+ if (n>0) while (n--) x *= y;
+ else while (n++) x /= y;
+ return x;
+}
+
+
+static void initr(vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& p,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& q,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& r,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& qdg)
+{
+ assert(ideg.size()==dim_);
+ assert(p.size()==dim_);
+ assert(q.size()==dim_);
+ pdg.resize(dim_); qdg.resize(dim_); r.resize(dim_);
+ for (unsigned int j=0;j<dim_;j++)
+ {
+ pdg[j] = powr(ideg[j],p[j]);
+ qdg[j] = powr(ideg[j],q[j]);
+ r[j] = q[j] / p[j];
+ }
+}
+
+
+//-------------------------------- DEGREE -------------------------------
+//: This will compute the degree of the polynomial based upon the index.
+static inline int degree(int index)
+{
+ return (index<0) ? 0 : (index % max_deg_) + 1;
+}
+
+
+//-------------------------- FFUNR -------------------------
+//: Evaluate the target system component of h.
+// This is the system of equations that we are trying to find the roots.
+static void ffunr(vcl_vector<double> const& coeff,
+ vcl_vector<int> const& polyn,
+ vcl_vector<unsigned int> const& terms,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& x,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& pows,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& f,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& df)
+{
+ assert(terms.size()==dim_);
+ assert(x.size()==dim_);
+ // Compute all possible powers for each variable
+ pows.resize(max_deg_*dim_);
+ for (unsigned int i=0;i<dim_;i++) // for all variables
+ {
+ int index = max_deg_*i;
+ pows[index]=x[i];
+ for (unsigned int j=1;j<max_deg_;++j,++index) // for all powers
+ pows[index+1]= pows[index] * x[i];
+ }
+
+ // Initialize the new arrays
+ for (unsigned int i=0; i<dim_; ++i)
+ {
+ f[i]=vnl_rnpoly_solve_cmplx(0,0);
+ for (unsigned int j=0;j<dim_;j++)
+ df[i*dim_+j]=vnl_rnpoly_solve_cmplx(0,0);
+ }
+
+ for (unsigned int i=0; i<dim_; ++i) // Across equations
+ for (unsigned int j=0; j<terms[i]; ++j) // Across terms
+ {
+ vnl_rnpoly_solve_cmplx tmp(1,0);
+ for (unsigned int k=0; k<dim_; ++k) // For each variable
+ {
+ int index=polyn[i*dim_*max_nterms_+j*dim_+k];
+ if (index>=0)
+ tmp *= pows[index];
+ }
+ f[i] += tmp * coeff[i*max_nterms_+j];
+ }
+
+ // Compute the Derivative!
+ for (int i=dim_-1;i>=0;i--) // Over equations
+ for (int l=dim_-1;l>=0;l--) // With respect to each variable
+ {
+ vnl_rnpoly_solve_cmplx& df_il = df[i*dim_+l];
+ for (int j=terms[i]-1;j>=0;j--) // Over terms in each equation
+ if (polyn[i*dim_*max_nterms_+j*dim_+l]>=0) // if 0 deg in l, df term is 0
+ {
+ vnl_rnpoly_solve_cmplx tmp = vnl_rnpoly_solve_cmplx(1,0);
+ for (int k=dim_-1;k>=0;k--) // Over each variable in each term
+ {
+ int index=polyn[i*dim_*max_nterms_+j*dim_+k];
+ if (index>=0)
+ {
+ if (k==l)
+ {
+ int deg = degree(index);
+ if (deg > 1)
+ tmp *= pows[index-1];
+ tmp *= (double)deg;
+ }
+ else
+ tmp *= pows[index];
+ }
+ } // end for k
+ df_il += tmp * coeff[i*max_nterms_+j];
+ }
+ } // end for l
+}
+
+
+//--------------------------- GFUNR --------------------------
+//: Evaluate starting system component
+// Evaluate the starting system component of h from a system
+// of equations that we already know the roots. (ex: x^n - 1)
+static void gfunr(vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& qdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pows,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& g,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& dg)
+{
+ assert(ideg.size()==dim_);
+ assert(g.size()==dim_);
+ assert(dg.size()==dim_);
+ vcl_vector<vnl_rnpoly_solve_cmplx> pxdgm1(dim_), pxdg(dim_);
+
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ vnl_rnpoly_solve_cmplx tmp;
+ if (ideg[j] <= 1)
+ tmp = vnl_rnpoly_solve_cmplx(1,0);
+ else
+ tmp = pows[j*max_deg_+ideg[j]-2];
+
+ pxdgm1[j] = pdg[j] * tmp;
+ }
+
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ int index = j*max_deg_+ideg[j]-1;
+ pxdg[j] = pdg[j] * pows[index];
+ }
+
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ g[j] = pxdg[j] - qdg[j];
+ dg[j] = pxdgm1[j] * ideg[j];
+ }
+}
+
+
+//-------------------------- HFUNR --------------------------
+//: This is the routine that traces the curve from the gfunr to the f function
+// (i.e. Evaluate the continuation function)
+static void hfunr(vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& qdg,
+ double t,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& x,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& h,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& dhx,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& dht,
+ vcl_vector<int> const& polyn,
+ vcl_vector<double> const& coeff,
+ vcl_vector<unsigned int> const& terms)
+{
+ assert(ideg.size()==dim_);
+ assert(terms.size()==dim_);
+ assert(x.size()==dim_);
+ assert(h.size()==dim_);
+ assert(dht.size()==dim_);
+ assert(dhx.size()==dim_*dim_);
+ vcl_vector<vnl_rnpoly_solve_cmplx> df(dim_*dim_),dg(dim_),f(dim_),g(dim_);
+ vcl_vector<vnl_rnpoly_solve_cmplx> pows; // powers of variables [dim_ equations] [max_deg_ possible powers]
+
+ ffunr(coeff,polyn,terms,x,pows,f,df);
+ gfunr(ideg,pdg,qdg,pows,g,dg);
+ assert(f.size()==dim_);
+ assert(g.size()==dim_);
+ assert(dg.size()==dim_);
+ assert(df.size()==dim_*dim_);
+
+ double onemt=1.0 - t;
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ for (unsigned int i=0; i<dim_; ++i)
+ dhx[j*dim_+i] = df[j*dim_+i] * t;
+
+ dhx[j*dim_+j] += dg[j]*onemt;
+ dht[j] = f[j] - g[j];
+ h[j] = f[j] * t + g[j] * onemt;
+ }
+}
+
+
+//------------------------ LU DECOMPOSITION --------------------------
+//: This performs LU decomposition on a matrix.
+static int ludcmp(vcl_vector<vnl_rnpoly_solve_cmplx>& a, vcl_vector<int>& indx)
+{
+ vcl_vector<double> vv(dim_);
+
+ // Loop over rows to get the implicit scaling information
+ for (unsigned int i=0; i<dim_; ++i)
+ {
+ double big = 0.0;
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ double temp = a[i*dim_+j].norm();
+ if (temp > big) big = temp;
+ }
+ if (big == 0.0) return 1;
+ vv[i]=1.0/vcl_sqrt(big);
+ }
+
+ // This is the loop over columns of Crout's method
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ for (unsigned int i=0; i<j; ++i)
+ for (unsigned int k=0; k<i; ++k)
+ a[i*dim_+j] -= a[i*dim_+k] * a[k*dim_+j];
+
+ // Initialize for the search for largest pivot element
+ double big = 0.0;
+ unsigned int imax = 0;
+
+ for (unsigned int i=j; i<dim_; ++i)
+ {
+ for (unsigned int k=0; k<j; ++k)
+ a[i*dim_+j] -= a[i*dim_+k] * a[k*dim_+j];
+
+ // Is the figure of merit for the pivot better than the best so far?
+ double rdum = vv[i]*a[i*dim_+j].norm();
+ if (rdum >= big) { big = rdum; imax = i; }
+ }
+
+ // Do we need to interchange rows?
+ if (j != imax)
+ {
+ // Yes, do so...
+ for (unsigned int k=0; k<dim_; ++k)
+ {
+ vnl_rnpoly_solve_cmplx dum = a[imax*dim_+k];
+ a[imax*dim_+k] = a[j*dim_+k]; a[j*dim_+k] = dum;
+ }
+
+ // Also interchange the scale factor
+ vv[imax]=vv[j];
+ }
+ indx[j]=imax;
+
+ vnl_rnpoly_solve_cmplx& ajj = a[j*dim_+j];
+ if (ajj.norm() == 0.0)
+ ajj = epsilonZ;
+
+ // Now, finally, divide by the pivot element
+ if (j+1 != dim_)
+ {
+ vnl_rnpoly_solve_cmplx dum = vnl_rnpoly_solve_cmplx(1,0) / ajj;
+
+ // If the pivot element is zero the matrix is singular.
+ for (unsigned int i=j+1; i<dim_; ++i)
+ a[i*dim_+j] *= dum;
+ }
+ }
+ return 0;
+}
+
+
+// ------------------------- LU Back Substitution -------------------------
+static void lubksb(vcl_vector<vnl_rnpoly_solve_cmplx> const& a,
+ vcl_vector<int> const& indx,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& bb,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& b)
+{
+ int ii=-1;
+ for (unsigned int k=0; k<dim_; ++k)
+ b[k] = bb[k];
+
+ for (unsigned int i=0; i<dim_; ++i)
+ {
+ int ip = indx[i];
+ vnl_rnpoly_solve_cmplx sum = b[ip];
+ b[ip] = b[i];
+
+ if (ii>=0)
+ for (unsigned int j=ii;j<i;++j)
+ sum -= a[i*dim_+j] * b[j];
+ else
+ // A nonzero element was encountered, so from now on we
+ // will have to do the sums in the loop above
+ if (sum.norm() > 0) ii = i;
+
+ b[i] = sum;
+ }
+
+ // Now do the backsubstitution
+ for (int i=dim_-1;i>=0;i--)
+ {
+ for (unsigned int j=i+1; j<dim_; ++j)
+ b[i] -= a[i*dim_+j] * b[j];
+
+ b[i] /= a[i*dim_+i];
+ }
+}
+
+
+//-------------------------- LINNR -------------------
+//: Solve a complex system of equations by using l-u decomposition and then back substitution.
+static int linnr(vcl_vector<vnl_rnpoly_solve_cmplx>& dhx,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& rhs,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& resid)
+{
+ vcl_vector<int> irow(dim_);
+ if (ludcmp(dhx,irow)==1) return 1;
+ lubksb(dhx,irow,rhs,resid);
+ return 0;
+}
+
+
+//----------------------- XNORM --------------------
+//: Finds the unit normal of a vector v
+static double xnorm(vcl_vector<vnl_rnpoly_solve_cmplx> const& v)
+{
+ assert(v.size()==dim_);
+ double txnorm=0.0;
+ for (unsigned int j=0; j<dim_; ++j)
+ txnorm += vcl_fabs(v[j].R) + vcl_fabs(v[j].C);
+ return txnorm;
+}
+
+//---------------------- PREDICT ---------------------
+//: Predict new x vector using Taylor's Expansion.
+static void predict(vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& qdg,
+ double step, double& t,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& x,
+ vcl_vector<int> const& polyn,
+ vcl_vector<double> const& coeff,
+ vcl_vector<unsigned int> const& terms)
+{
+ assert(ideg.size()==dim_);
+ assert(terms.size()==dim_);
+ assert(x.size()==dim_);
+
+ double maxdt =.2; // Maximum change in t for a given step. If dt is
+ // too large, there seems to be greater chance of
+ // jumping to another path. Set this to 1 if you
+ // don't care.
+ vcl_vector<vnl_rnpoly_solve_cmplx> dht(dim_),dhx(dim_*dim_),dz(dim_),h(dim_),rhs(dim_);
+ // Call the continuation function that we are tracing
+ hfunr(ideg,pdg,qdg,t,x,h,dhx,dht,polyn,coeff,terms);
+
+ for (unsigned int j=0; j<dim_; ++j)
+ rhs[j] = - dht[j];
+
+ // Call the function that solves a complex system of equations
+ if (linnr(dhx,rhs,dz) == 1) return;
+
+ // Find the unit normal of a vector and normalize our step
+ double factor = step/(1+xnorm(dz));
+ if (factor>maxdt) factor = maxdt;
+
+ bool tis1=true;
+ if (t+factor>1) { tis1 = false; factor = 1.0 - t; }
+
+ // Update this path with the predicted next point
+ for (unsigned int j=0; j<dim_; ++j)
+ x[j] += dz[j] * factor;
+
+ if (tis1) t += factor;
+ else t = 1.0;
+}
+
+
+//------------------------- CORRECT --------------------------
+//: Correct the predicted point to lie near the actual curve
+// Use Newton's Method to do this.
+// Returns:
+// 0: Converged
+// 1: Singular Jacobian
+// 2: Didn't converge in 'loop' iterations
+// 3: If the magnitude of x > maxroot
+static int correct(vcl_vector<unsigned int> const& ideg, int loop, double eps,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& qdg,
+ double t,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& x,
+ vcl_vector<int> const& polyn,
+ vcl_vector<double> const& coeff,
+ vcl_vector<unsigned int> const& terms)
+{
+ double maxroot= 1000;// Maximum size of root where it is considered heading to infinity
+ vcl_vector<vnl_rnpoly_solve_cmplx> dhx(dim_*dim_),dht(dim_),h(dim_),resid(dim_);
+
+ assert(ideg.size()==dim_);
+ assert(terms.size()==dim_);
+ assert(x.size()==dim_);
+
+ for (int i=0;i<loop;i++)
+ {
+ hfunr(ideg,pdg,qdg,t,x,h,dhx,dht,polyn,coeff,terms);
+
+ // If linnr = 1, error
+ if (linnr(dhx,h,resid)==1) return 1;
+
+ for (unsigned int j=0; j<dim_; ++j)
+ x[j] -= resid[j];
+
+ double xresid = xnorm(resid);
+ if (xresid < eps) return 0;
+ if (xresid > maxroot) return 3;
+ }
+ return 2;
+}
+
+
+//-------------------------- TRACE ---------------------------
+//: This is the continuation routine.
+// It will trace a curve from a known point in the complex plane to an unknown
+// point in the complex plane. The new end point is the root
+// to a polynomial equation that we are trying to solve.
+// It will return the following codes:
+// 0: Maximum number of steps exceeded
+// 1: Path converged
+// 2: Step size became too small
+// 3: Path Heading to infinity
+// 4: Singular Jacobian on Path
+static int trace(vcl_vector<vnl_rnpoly_solve_cmplx>& x,
+ vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& pdg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& qdg,
+ vcl_vector<int> const& polyn,
+ vcl_vector<double> const& coeff,
+ vcl_vector<unsigned int> const& terms)
+{
+ assert(ideg.size()==dim_);
+ assert(terms.size()==dim_);
+ assert(x.size()==dim_);
+
+ int maxns=500; // Maximum number of path steps
+ int maxit=5; // Maximum number of iterations to correct a step.
+ // For each step, Newton-Raphson is used to correct
+ // the step. This should be at least 3 to improve
+ // the chances of convergence. If function is well
+ // behaved, fewer than maxit steps will be needed
+
+ double eps=0; // epsilon value used in correct
+ double epsilonS=1.0e-3 * epsilonB;// smallest path step for t>.95
+ double stepmin=1.0e-5 * stepinit; // Minimum stepsize allowed
+ double step=stepinit; // stepsize
+ double t=0.0; // Continuation parameter 0<t<1
+ double oldt=0.0; // The previous t value
+ vcl_vector<vnl_rnpoly_solve_cmplx> oldx = x; // the previous path value
+ int nadv=0;
+
+ for (int numstep=0;numstep<maxns;numstep++)
+ {
+ // Taylor approximate the next point
+ predict(ideg,pdg,qdg,step,t,x,polyn,coeff,terms);
+
+ //if (t>1.0) t=1.0;
+
+ if (t > .95)
+ {
+ if (eps != epsilonS) step = step/4.0;
+ eps = epsilonS;
+ }else
+ eps = epsilonB;
+#ifdef DEBUG
+ vcl_cout << "t=" << t << vcl_endl;
+#endif
+
+ if (t>=.99999) // Path converged
+ {
+#ifdef DEBUG
+ vcl_cout << "path converged\n" << vcl_flush;
+#endif
+ double factor = (1.0-oldt)/(t-oldt);
+ for (unsigned int j=0; j<dim_; ++j)
+ x[j] = oldx[j] + (x[j]-oldx[j]) * factor;
+ t = 1.0;
+ int cflag=correct(ideg,10*maxit,final_eps,pdg,qdg,t,x, polyn, coeff,terms);
+ if ((cflag==0) ||(cflag==2))
+ return 1; // Final Correction converged
+ else if (cflag==3)
+ return 3; // Heading to infinity
+ else return 4; // Singular solution
+ }
+
+ // Newton's method brings us back to the curve
+ int cflag=correct(ideg,maxit,eps,pdg,qdg,t,x,polyn, coeff,terms);
+ if (cflag==0)
+ {
+ // Successful step
+ if ((++nadv)==maxit) { step *= 2; nadv=0; } // Increase the step size
+ // Make note of our new location
+ oldt = t;
+ oldx = x;
+ }
+ else
+ {
+ nadv=0;
+ step /= 2.0;
+
+ if (cflag==3) return 3; // Path heading to infinity
+ if (step<stepmin) return 2; // Path failed StepSizeMin exceeded
+
+ // Reset the values since we stepped to far, and try again
+ t = oldt;
+ x = oldx;
+ }
+ }// end of the loop numstep
+
+ return 0;
+}
+
+
+//-------------------------- STRPTR ---------------------------
+//: This will find a starting point on the 'g' function circle.
+// The new point to start tracing is stored in the x array.
+static void strptr(vcl_vector<unsigned int>& icount,
+ vcl_vector<unsigned int> const& ideg,
+ vcl_vector<vnl_rnpoly_solve_cmplx> const& r,
+ vcl_vector<vnl_rnpoly_solve_cmplx>& x)
+{
+ assert(ideg.size()==dim_);
+ assert(r.size()==dim_);
+ x.resize(dim_);
+
+ for (unsigned int i=0; i<dim_; ++i)
+ if (icount[i] >= ideg[i]) icount[i] = 1;
+ else { icount[i]++; break; }
+
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+ double angle = twopi / ideg[j] * icount[j];
+ x[j] = r[j] * vnl_rnpoly_solve_cmplx (vcl_cos(angle), vcl_sin(angle));
+ }
+}
+
+
+static vcl_vector<vcl_vector<vnl_rnpoly_solve_cmplx> >
+Perform_Distributed_Task(vcl_vector<unsigned int> const& ideg,
+ vcl_vector<unsigned int> const& terms,
+ vcl_vector<int> const& polyn,
+ vcl_vector<double> const& coeff)
+{
+ assert(ideg.size()==dim_);
+
+ vcl_vector<vcl_vector<vnl_rnpoly_solve_cmplx> > sols;
+ vcl_vector<vnl_rnpoly_solve_cmplx> pdg, qdg, p, q, r, x;
+ vcl_vector<unsigned int> icount(dim_,1); icount[0]=0;
+ bool solflag; // flag used to remember if a root is found
+#ifdef DEBUG
+ char const* FILENAM = "/tmp/cont.results";
+ vcl_ofstream F(FILENAM);
+ if (!F)
+ {
+ vcl_cerr<<"could not open "<<FILENAM<<" for writing\nplease erase old file first\n";
+ F = vcl_cerr;
+ }
+ else
+ vcl_cerr << "Writing to " << FILENAM << '\n';
+#endif
+ // Initialize some variables
+ inptbr(p,q);
+ initr(ideg,p,q,r,pdg,qdg);
+
+ // int Psize = 2*dim_*sizeof(double);
+ int totdegree = 1; // Total degree of the system
+ for (unsigned int j=0;j<dim_;j++) totdegree *= ideg[j];
+
+ // ************* Send initial information ****************
+ //Initialize(dim_,maxns,maxdt,maxit,maxroot,
+ // terms,ideg,pdg,qdg,coeff,polyn);
+ while ((totdegree--) > 0)
+ {
+ // Compute path to trace
+ strptr(icount,ideg,r,x);
+
+ // Tell the client which path you want it to trace
+ solflag = 1 == trace(x,ideg,pdg,qdg,polyn,coeff,terms);
+ // Save the solution for future reference
+ if (solflag)
+ {
+#ifdef DEBUG
+ for (unsigned int i=0; i<dim_; ++i)
+ F << '<' << x[dim_-i-1].R << ' ' << x[dim_-i-1].C << '>';
+ F << vcl_endl;
+#endif
+ sols.push_back(x);
+ }
+#ifdef DEBUG
+ // print something out for each root
+ if (solflag) vcl_cout << '.';
+ else vcl_cout << '*';
+ vcl_cout.flush();
+#endif
+ }
+
+#ifdef DEBUG
+ vcl_cout<< vcl_endl;
+#endif
+
+ return sols;
+}
+
+
+//----------------------- READ INPUT ----------------------
+//: This will read the input polynomials from a data file.
+void vnl_rnpoly_solve::Read_Input(vcl_vector<unsigned int>& ideg,
+ vcl_vector<unsigned int>& terms,
+ vcl_vector<int>& polyn,
+ vcl_vector<double>& coeff)
+{
+ // Read the number of equations
+ dim_ = ps_.size();
+
+ ideg.resize(dim_); terms.resize(dim_);
+ // Start reading in the array values
+ max_deg_=0;
+ max_nterms_=0;
+ for (unsigned int i=0;i<dim_;i++)
+ {
+ ideg[i] = ps_[i]->ideg_;
+ terms[i] = ps_[i]->nterms_;
+ if (ideg[i] > max_deg_)
+ max_deg_ = ideg[i];
+ if (terms[i] > max_nterms_)
+ max_nterms_ = terms[i];
+ }
+ coeff.resize(dim_*max_nterms_);
+ polyn.resize(dim_*max_nterms_*dim_);
+ for (unsigned int i=0;i<dim_;i++)
+ {
+ for (unsigned int k=0;k<terms[i];k++)
+ {
+ coeff[i*max_nterms_+k] = ps_[i]->coeffs_(k);
+ for (unsigned int j=0;j<dim_;j++)
+ {
+ int deg = ps_[i]->polyn_(k,j);
+ polyn[i*dim_*max_nterms_+k*dim_+j] = deg ? int(j*max_deg_)+deg-1 : -1;
+ }
+ }
+ }
+}
+
+
+vnl_rnpoly_solve::~vnl_rnpoly_solve()
+{
+ while (r_.size() > 0) { delete r_.back(); r_.pop_back(); }
+ while (i_.size() > 0) { delete i_.back(); i_.pop_back(); }
+}
+
+bool vnl_rnpoly_solve::compute()
+{
+ vcl_vector<unsigned int> ideg, terms;
+ vcl_vector<int> polyn;
+ vcl_vector<double> coeff;
+
+ Read_Input(ideg,terms,polyn,coeff); // returns number of equations
+ assert(ideg.size()==dim_);
+ assert(terms.size()==dim_);
+ assert(polyn.size()==dim_*max_nterms_*dim_);
+ assert(coeff.size()==dim_*max_nterms_);
+
+ int totdegree = 1;
+ for (unsigned int j=0; j<dim_; ++j) totdegree *= ideg[j];
+
+ vcl_vector<vcl_vector<vnl_rnpoly_solve_cmplx> > ans = Perform_Distributed_Task(ideg,terms,polyn,coeff);
+
+ // Print out the answers
+ vnl_vector<double> * rp, *ip;
+#ifdef DEBUG
+ vcl_cout << "Total degree: " << totdegree << vcl_endl
+ << "# solutions : " << ans.size() << vcl_endl;
+#endif
+ for (unsigned int i=0; i<ans.size(); ++i)
+ {
+ assert(ans[i].size()==dim_);
+ rp=new vnl_vector<double>(dim_); r_.push_back(rp);
+ ip=new vnl_vector<double>(dim_); i_.push_back(ip);
+ for (unsigned int j=0; j<dim_; ++j)
+ {
+#ifdef DEBUG
+ vcl_cout << ans[i][j].R << " + j " << ans[i][j].C << vcl_endl;
+#endif
+ (*rp)[j]=ans[i][j].R; (*ip)[j]=ans[i][j].C;
+ }
+#ifdef DEBUG
+ vcl_cout<< vcl_endl;
+#endif
+ }
+ return true;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.h
new file mode 100644
index 0000000000000000000000000000000000000000..4fa5af3e2dce5ccc8c271d99a8394759e1520c93
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rnpoly_solve.h
@@ -0,0 +1,76 @@
+// This is core/vnl/algo/vnl_rnpoly_solve.h
+#ifndef vnl_rnpoly_solve_h_
+#define vnl_rnpoly_solve_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Solves for roots of system of real polynomials
+// \author Marc Pollefeys, ESAT-VISICS, K.U.Leuven
+// \date 12-08-97
+//
+// \verbatim
+// Modifications
+// Oct.1999 - Peter Vanroose - implementation simplified through "cmplx" class for doing complex arithmetic.
+// May.2002 - Peter Vanroose - added operator*=(cmplx) and operator/=(cmplx)
+// Mar.2003 - Peter Vanroose - renamed M to M_, T to T_
+// Feb.2004 - Peter Vanroose - removed hard limits on dimensionality; this gets rid of M_ and T_;
+// now using std::vector throughout instead of C arrays of fixed size
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_real_npolynomial.h>
+#include <vcl_vector.h>
+
+//: Solves for roots of system of real polynomials
+// Calculates all the roots of a system of N polynomials in N variables
+// through continuation.
+// Adapted from the PARALLEL CONTINUATION algorithm, written by Darrell
+// Stam, 1991, and further improved by Kriegman and Ponce, 1992.
+
+class vnl_rnpoly_solve
+{
+ // Data Members--------------------------------------------------------------
+ vcl_vector<vnl_real_npolynomial*> ps_; // the input
+ vcl_vector<vnl_vector<double>*> r_; // the output (real part)
+ vcl_vector<vnl_vector<double>*> i_; // the output (imaginary part)
+
+ public:
+
+ // Constructor---------------------------------------------------------------
+
+ //: The constructor already does all the calculations
+ inline vnl_rnpoly_solve(vcl_vector<vnl_real_npolynomial*> const& ps)
+ : ps_(ps) { compute(); }
+
+ // Destructor----------------------------------------------------------------
+
+ ~vnl_rnpoly_solve();
+
+ // Operations----------------------------------------------------------------
+
+ //: Array of real parts of roots
+ inline vcl_vector<vnl_vector<double>*> real() { return r_; }
+
+ //: Array of imaginary parts of roots
+ inline vcl_vector<vnl_vector<double>*> imag() { return i_; }
+
+ //: Return real roots only.
+ // Roots are real if the absolute value of their imaginary part is less than
+ // the optional argument tol, which defaults to 1e-12 [untested]
+ vcl_vector<vnl_vector<double>*> realroots(double tol = 1e-12);
+
+ // Computations--------------------------------------------------------------
+
+ private:
+ //: Compute roots using continuation algorithm.
+ bool compute();
+
+ void Read_Input(vcl_vector<unsigned int>& ideg,
+ vcl_vector<unsigned int>& terms,
+ vcl_vector<int>& polyn,
+ vcl_vector<double>& coeff);
+};
+
+#endif // vnl_rnpoly_solve_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6ae553474673bd2cc70f2dfda204e7ba86b05b68
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.cxx
@@ -0,0 +1,95 @@
+// This is core/vnl/algo/vnl_rpoly_roots.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 06 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_rpoly_roots.h"
+
+#include <vcl_cmath.h> // for fabs()
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vnl/algo/vnl_netlib.h> // rpoly_()
+#include <vnl/vnl_real_polynomial.h>
+
+// - The constructor calculates the roots. This is the most efficient interface
+// as all the result variables are initialized to the correct size.
+// The polynomial is $ a[0] x^d + a[1] x^{d-1} + \cdots + a[d] = 0 $.
+// Note that if the routine fails, not all roots will be found. In this case,
+// the "realroots" and "roots" functions will return fewer than n roots.
+vnl_rpoly_roots::vnl_rpoly_roots(const vnl_vector<double>& a)
+ : coeffs_(a), r_(coeffs_.size()-1), i_(coeffs_.size()-1)
+{
+ // fsm : if the coefficients are NaNs then rpoly_ gets stuck in an
+ // infinite loop. of course, the caller shouldn't pass in NaNs, but
+ // it would be nice to get an error message instead of hanging.
+ a.assert_finite();
+
+ compute();
+}
+
+vnl_rpoly_roots::vnl_rpoly_roots(const vnl_real_polynomial& poly)
+ : coeffs_(poly.coefficients()), r_(poly.degree()), i_(poly.degree())
+{
+ poly.coefficients().assert_finite();
+
+ compute();
+}
+
+// - Complex vector of all roots.
+vnl_vector<vcl_complex<double> > vnl_rpoly_roots::roots() const
+{
+ vnl_vector<vcl_complex<double> > ret(num_roots_found_);
+ for (int i = 0; i < num_roots_found_; ++i)
+ ret[i] = vcl_complex<double>(r_[i], i_[i]);
+ return ret;
+}
+
+// - Return real roots only. Roots are real if the absolute value
+// of their imaginary part is less than the optional argument TOL.
+// TOL defaults to 1e-12 [untested]
+vnl_vector<double> vnl_rpoly_roots::realroots(double tol) const
+{
+ int c = 0;
+ for (int i = 0; i < num_roots_found_; ++i)
+ if (vcl_fabs(i_[i]) < tol)
+ ++c;
+
+ vnl_vector<double> ret(c);
+ c = 0;
+ {for (int i = 0; i < num_roots_found_; ++i)
+ if (vcl_fabs(i_[i]) < tol)
+ ret[c++] = r_[i];}
+
+ return ret;
+}
+
+//: Compute roots using Jenkins-Traub algorithm.
+// Calls rpoly and interprets failure codes.
+bool vnl_rpoly_roots::compute()
+{
+ int fail = 0;
+ int n = coeffs_.size() - 1;
+
+ rpoly_(coeffs_.data_block(), &n, r_.data_block(), i_.data_block(), &fail);
+
+ if (!fail) {
+ num_roots_found_ = n;
+ return true;
+ }
+
+ num_roots_found_ = n;
+
+ if (coeffs_[0] == 0.0)
+ vcl_cerr << "vnl_rpoly_roots: Leading coefficient is zero. Not allowed.\n";
+ else
+ vcl_cerr << "vnl_rpoly_roots: Calculation failed, only " << n << " roots found\n";
+
+ return false;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.h
new file mode 100644
index 0000000000000000000000000000000000000000..13b8010d063c52d7fb227f40dcc307130c49c9b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_rpoly_roots.h
@@ -0,0 +1,100 @@
+// This is core/vnl/algo/vnl_rpoly_roots.h
+#ifndef vnl_rpoly_roots_h_
+#define vnl_rpoly_roots_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Finds roots of a real polynomial
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 06 Aug 96
+//
+// \verbatim
+// Modifications
+// 23 may 97, Peter Vanroose - "NO_COMPLEX" option added (until "complex" type is standardised)
+// dac (Manchester) 28/03/2001: tidied up documentation
+// Joris Van den Wyngaerd - June 2001 - impl for vnl_real_polynomial constr added
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+
+class vnl_real_polynomial;
+
+//: Find the roots of a real polynomial.
+// Uses algorithm 493 from
+// ACM Trans. Math. Software - the Jenkins-Traub algorithm, described
+// by Numerical Recipes under "Other sure-fire techniques" as
+// "practically a standard in black-box polynomial rootfinders".
+// (See M.A. Jenkins, ACM TOMS 1 (1975) pp. 178-189.).
+//
+// This class is not very const-correct as it is intended as a compute object
+// rather than a data object.
+
+class vnl_rpoly_roots
+{
+ public:
+// Constructors/Destructors--------------------------------------------------
+
+ //: The constructor calculates the roots.
+ // This is the most efficient interface
+ // as all the result variables are initialized to the correct size.
+ // The polynomial is $ a[0] x^d + a[1] x^{d-1} + \cdots + a[d] = 0 $.
+ //
+ // Note that if the routine fails, not all roots will be found. In this case,
+ // the "realroots" and "roots" functions will return fewer than n roots.
+
+ vnl_rpoly_roots(const vnl_vector<double>& a);
+
+ //: Calculate roots of a vnl_real_polynomial. Same comments apply.
+ vnl_rpoly_roots(const vnl_real_polynomial& poly);
+
+ // Operations----------------------------------------------------------------
+
+ //: Return i'th complex root
+ vcl_complex<double> operator [] (int i) const { return vcl_complex<double>(r_[i], i_[i]); }
+
+ //: Complex vector of all roots.
+ vnl_vector<vcl_complex<double> > roots() const;
+
+ //: Real part of root I.
+ const double& real(int i) const { return r_[i]; }
+
+ //: Imaginary part of root I.
+ const double& imag(int i) const { return i_[i]; }
+
+ //: Vector of real parts of roots
+ vnl_vector<double>& real() { return r_; }
+
+ //: Vector of imaginary parts of roots
+ vnl_vector<double>& imag() { return i_; }
+
+ //: Return real roots only.
+ // Roots are real if the absolute value of their imaginary part is less than
+ // the optional argument TOL. TOL defaults to 1e-12 [untested]
+ vnl_vector<double> realroots(double tol = 1e-12) const;
+
+ // Computations--------------------------------------------------------------
+
+ //: Compute roots using Jenkins-Traub algorithm.
+ bool compute();
+
+ //: Compute roots using QR decomposition of companion matrix. [unimplemented]
+ bool compute_qr();
+
+ //: Compute roots using Laguerre algorithm. [unimplemented]
+ bool compute_laguerre();
+
+ protected:
+ // Data Members--------------------------------------------------------------
+ vnl_vector<double> coeffs_;
+
+ vnl_vector<double> r_;
+ vnl_vector<double> i_;
+
+ int num_roots_found_;
+};
+
+#endif // vnl_rpoly_roots_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..5b24d1fe4d6487e4d90908de5a6135cf8dfa71bb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.h
@@ -0,0 +1,76 @@
+// This is core/vnl/algo/vnl_scatter_3x3.h
+#ifndef vnl_scatter_3x3_h_
+#define vnl_scatter_3x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x3 scatter matrix
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 02 Oct 96
+//
+// \verbatim
+// Modifications
+// 18 Feb 2000. fsm: templated.
+// 4/4/01 LSB (Manchester) documentation tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// 13 Jan.2003 - Peter Vanroose - added missing implem. for sub_outer_product
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_vector_fixed.h>
+
+template <class T>
+class vnl_scatter_3x3 : public vnl_matrix_fixed<T,3,3>
+{
+ public:
+ typedef vnl_matrix_fixed<T,3,3> base;
+ typedef vnl_vector_fixed<T,3> vect;
+
+ //: Constructor. Fills with zeros.
+ vnl_scatter_3x3();
+
+ //: Add v*v' to scatter.
+ void add_outer_product(const vnl_vector_fixed<T,3> & v);
+
+ //: Add v*u' to scatter.
+ void add_outer_product(const vnl_vector_fixed<T,3> & u,
+ const vnl_vector_fixed<T,3> & v);
+
+ //: Subtract v*v' from scatter.
+ void sub_outer_product(const vnl_vector_fixed<T,3> & v);
+
+ //: Subtract v*u' from scatter.
+ void sub_outer_product(const vnl_vector_fixed<T,3> & u,
+ const vnl_vector_fixed<T,3> & v);
+
+ //: Replace S with $(S+S^\top)/2$.
+ void force_symmetric();
+
+ //: Compute the eigensystem of S.
+ void compute_eigensystem();
+
+ //: Return the eigenvector corresponding to the smallest eigenvalue.
+ vnl_vector_fixed<T,3> minimum_eigenvector() {
+ if (!eigenvectors_currentp) compute_eigensystem();
+ return vnl_vector_fixed<T,3>(V_(0,0), V_(1,0), V_(2,0));
+ }
+
+ //: Return the column matrix of eigenvectors, sorted in increasing order of eigenvalue.
+ vnl_matrix_fixed<T,3,3>& V()
+ {
+ if (!eigenvectors_currentp) compute_eigensystem();
+ return V_;
+ }
+
+ protected:
+ bool symmetricp;
+ bool eigenvectors_currentp;
+ vnl_matrix_fixed<T,3,3> V_;
+ vnl_vector_fixed<T,3> D;
+};
+
+
+#endif // vnl_scatter_3x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.txx
new file mode 100644
index 0000000000000000000000000000000000000000..52c8aa7f4acb5ecb605771eb5ef21c1f43a351b7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_scatter_3x3.txx
@@ -0,0 +1,104 @@
+// This is core/vnl/algo/vnl_scatter_3x3.txx
+#ifndef vnl_scatter_3x3_txx_
+#define vnl_scatter_3x3_txx_
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// Created: 02 Oct 96
+//-----------------------------------------------------------------------------
+
+#include "vnl_scatter_3x3.h"
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+
+template <class T>
+vnl_scatter_3x3<T>::vnl_scatter_3x3()
+ : base(T(0))
+ , symmetricp(true)
+ , eigenvectors_currentp(false)
+{
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::add_outer_product(const vnl_vector_fixed<T,3> & v)
+{
+ vnl_scatter_3x3<T> & S = *this;
+ for (int i = 0; i < 3; ++i) {
+ S(i,i) += v[i]*v[i];
+ for (int j = i+1; j < 3; ++j) {
+ T value = v[i]*v[j];
+ S(i,j) += value;
+ S(j,i) = S(i,j);
+ }
+ }
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::add_outer_product(const vnl_vector_fixed<T,3> & u,
+ const vnl_vector_fixed<T,3> & v)
+{
+ vnl_scatter_3x3<T> & S = *this;
+ for (int i = 0; i < 3; ++i)
+ for (int j = 0; j < 3; ++j)
+ S(i,j) += v[i]*u[j];
+ symmetricp = false; // conservative assumption -- use add_outer_product(v) to maintain symmetry
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::sub_outer_product(const vnl_vector_fixed<T,3> & v)
+{
+ vnl_scatter_3x3<T> & S = *this;
+ for (int i = 0; i < 3; ++i) {
+ S(i,i) -= v[i]*v[i];
+ for (int j = i+1; j < 3; ++j) {
+ T value = v[i]*v[j];
+ S(i,j) -= value;
+ S(j,i) = S(i,j);
+ }
+ }
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::sub_outer_product(const vnl_vector_fixed<T,3> & u,
+ const vnl_vector_fixed<T,3> & v)
+{
+ vnl_scatter_3x3<T> & S = *this;
+ for (int i = 0; i < 3; ++i)
+ for (int j = 0; j < 3; ++j)
+ S(i,j) -= v[i]*u[j];
+ symmetricp = false; // conservative assumption -- use sub_outer_product(v) to maintain symmetry
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::force_symmetric()
+{
+ if (symmetricp)
+ return;
+ vnl_scatter_3x3<T> & S = *this;
+ for (int i = 0; i < 3; ++i)
+ for (int j = i+1; j < 3; ++j) {
+ T vbar = (S(i,j) + S(j,i)) / 2;
+ S(i,j) = S(j,i) = vbar;
+ }
+ symmetricp = true;
+}
+
+template <class T>
+void vnl_scatter_3x3<T>::compute_eigensystem()
+{
+ vnl_scatter_3x3<T> &S = *this;
+ if (symmetricp) {
+ vnl_symmetric_eigensystem_compute(S, V_.as_ref().non_const(), D.as_ref().non_const());
+ } else {
+ vcl_cerr << "Unsymmetric scatter not handled now\n";
+ }
+
+ eigenvectors_currentp = true;
+}
+
+//--------------------------------------------------------------------------------
+
+#define VNL_SCATTER_3X3_INSTANTIATE(T) \
+template class vnl_scatter_3x3<T >
+
+#endif // vnl_scatter_3x3_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..46bc26da91590ef2f6a15d5c8af953f548f87606
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.cxx
@@ -0,0 +1,20 @@
+#include "vnl_simpson_integral.h"
+#include <vnl/algo/vnl_netlib.h>
+
+double vnl_simpson_integral::int_fnct_(double* x)
+{
+ return pfnct_->f_(*x);
+}
+
+double vnl_simpson_integral::integral(vnl_integrant_fnct* f, double a, double b, int n)
+{
+
+ double res = 0;
+
+ //set the function
+ pfnct_ = f;
+
+ simpru_(&vnl_simpson_integral::int_fnct_, &a, &b, &n, &res);
+
+ return res;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.h
new file mode 100644
index 0000000000000000000000000000000000000000..4ddc1a20dea7a94a5d33db87bab283acec13c386
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_simpson_integral.h
@@ -0,0 +1,26 @@
+#ifndef VNL_SIMPSON_INTEGRAL_H_
+#define VNL_SIMPSON_INTEGRAL_H_
+//:
+// \file
+// \author Kongbin Kang at Brown
+// \date Jan. 17th, 2005
+//
+#include <vnl/vnl_definite_integral.h>
+
+class vnl_simpson_integral : public vnl_definite_integral
+{
+ private:
+ //: used to extract integrant functions of the vnl_integrant_fnct.
+ static double int_fnct_(double* x);
+
+ public:
+
+ vnl_simpson_integral() {}
+
+ //: a and b are integral limits respectively.
+ // n is the number of intervals used in integral.
+ // The actual subinterval used is 2* num_intervals_
+ double integral(vnl_integrant_fnct *f, double a, double b, int n);
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..49ffa636deedde9936717588ca2cd39716da6916
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.cxx
@@ -0,0 +1,282 @@
+// This is core/vnl/algo/vnl_sparse_symmetric_eigensystem.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_sparse_symmetric_eigensystem.h"
+#include <vcl_cassert.h>
+#include <vcl_cstring.h>
+#include <vcl_iostream.h>
+#include <vcl_vector.h>
+
+#include <vnl/algo/vnl_netlib.h> // dnlaso_()
+
+static vnl_sparse_symmetric_eigensystem * current_system = 0;
+
+#ifdef VCL_SUNPRO_CC
+# define FUNCTION extern "C"
+#else
+# define FUNCTION static
+#endif
+
+//------------------------------------------------------------
+//: Callback for multiplying our matrix by a number of vectors.
+// The input is p, which is an NxM matrix.
+// This function returns q = A p, where A is the current sparse matrix.
+FUNCTION
+void sse_op_callback(const int* n,
+ const int* m,
+ const double* p,
+ double* q)
+{
+ assert(current_system != 0);
+
+ current_system->CalculateProduct(*n,*m,p,q);
+}
+
+//------------------------------------------------------------
+//: Callback for saving the Lanczos vectors as required by dnlaso.
+// If k=0, save the m columns of q as the (j-m+1)th through jth
+// vectors. If k=1 then return the (j-m+1)th through jth vectors in
+// q.
+FUNCTION
+void sse_iovect_callback(const int* n,
+ const int* m,
+ double* q,
+ const int* j,
+ const int* k)
+{
+ assert(current_system != 0);
+
+ if (*k==0)
+ current_system->SaveVectors(*n,*m,q,*j-*m);
+ else if (*k==1)
+ current_system->RestoreVectors(*n,*m,q,*j-*m);
+}
+
+vnl_sparse_symmetric_eigensystem::vnl_sparse_symmetric_eigensystem()
+ : nvalues(0), vectors(0), values(0)
+{
+}
+
+vnl_sparse_symmetric_eigensystem::~vnl_sparse_symmetric_eigensystem()
+{
+ delete[] vectors; vectors = 0;
+ delete[] values; values = 0;
+ for (unsigned i=0; i<temp_store.size(); ++i)
+ delete temp_store[i];
+ temp_store.clear();
+}
+
+//------------------------------------------------------------
+//: Here is where the fortran converted code gets called.
+// The sparse matrix M is assumed to be symmetric. The n smallest
+// eigenvalues and their corresponding eigenvectors are calculated if
+// smallest is true (the default). Otherwise the n largest eigenpairs
+// are found. The accuracy of the eigenvalues is to nfigures decimal
+// digits. Returns 0 if successful, non-zero otherwise.
+int vnl_sparse_symmetric_eigensystem::CalculateNPairs(vnl_sparse_matrix<double>& M,
+ int n,
+ bool smallest,
+ int nfigures)
+{
+ mat = &M;
+
+ // Clear current vectors.
+ if (vectors) {
+ delete[] vectors; vectors = 0;
+ delete[] values; values = 0;
+ }
+ nvalues = 0;
+
+ current_system = this;
+
+ int dim = mat->columns();
+ int nvals = (smallest)?-n:n;
+ int nperm = 0;
+ int nmval = n;
+ int nmvec = dim;
+ vcl_vector<double> temp_vals(n*4);
+ vcl_vector<double> temp_vecs(n*dim);
+
+ // set nblock = vcl_max(10, dim/6) :
+ int nblock = (dim<60) ? dim/6 : 10;
+
+ // isn't this rather a lot ? -- fsm
+ int maxop = dim*10; // dim*20;
+
+ // set maxj = vcl_max(40, maxop*nblock, 6*nblock+1) :
+ int maxj = maxop*nblock; // 2*n+1;
+ int t1 = 6*nblock+1;
+ if (maxj < t1) maxj = t1;
+ if (maxj < 40) maxj = 40;
+
+ // Calculate size of workspace needed. These expressions come from
+ // the LASO documentation.
+ int work_size = dim*nblock;
+ int t2 = maxj*(2*nblock+3) + 2*n + 6 + (2*nblock+2)*(nblock+1);
+ if (work_size < t2) work_size = t2;
+ work_size += 2*dim*nblock + maxj*(nblock + n + 2) + 2*nblock*nblock + 3*n;
+ vcl_vector<double> work(work_size+10);
+
+ // Set starting vectors to zero.
+ for (int i=0; i<dim*nblock; ++i)
+ work[i] = 0.0;
+
+ vcl_vector<int> ind(n);
+
+ int ierr = 0;
+
+ dnlaso_(sse_op_callback, sse_iovect_callback,
+ &dim, &nvals, &nfigures, &nperm,
+ &nmval, &temp_vals[0],
+ &nmvec, &temp_vecs[0],
+ &nblock,
+ &maxop,
+ &maxj,
+ &work[0],
+ &ind[0],
+ &ierr);
+ if (ierr > 0) {
+ if (ierr & 0x1) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: N < 6*NBLOCK\n";
+ }
+ if (ierr & 0x2) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NFIG < 0\n";
+ }
+ if (ierr & 0x4) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NMVEC < N\n";
+ }
+ if (ierr & 0x8) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NPERM < 0\n";
+ }
+ if (ierr & 0x10) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: MAXJ < 6*NBLOCK\n";
+ }
+ if (ierr & 0x20) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NVAL < max(1,NPERM)\n";
+ }
+ if (ierr & 0x40) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NVAL > NMVAL\n";
+ }
+ if (ierr & 0x80) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NVAL > MAXOP\n";
+ }
+ if (ierr & 0x100) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NVAL > MAXJ/2\n";
+ }
+ if (ierr & 0x200) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem: NBLOCK < 1\n";
+ }
+ }
+ else if (ierr < 0) {
+ if (ierr == -1) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem:\n"
+ << " poor initial vectors chosen\n";
+ }
+ else if (ierr == -2) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem:\n"
+ << " reached maximum operations " << maxop
+ << " without finding all eigenvalues,\n"
+ << " found " << nperm << " eigenvalues\n";
+ }
+ else if (ierr == -8) {
+ vcl_cerr << "Error: vnl_sparse_symmetric_eigensystem:\n"
+ << " disastrous loss of orthogonality - internal error\n";
+ }
+ }
+
+ // Copy the eigenvalues and vectors.
+ nvalues = n;
+ vectors = new vnl_vector<double>[n];
+ values = new double[n];
+ for (int i=0; i<n; ++i) {
+ values[i] = temp_vals[i];
+#if 0
+ vcl_cout << "value " << temp_vals[i]
+ << " accuracy " << temp_vals[i+n*2] << vcl_endl;
+#endif
+ vnl_vector<double> vec(dim,0.0);
+ for (int j=0; j<dim; ++j)
+ vec[j] = temp_vecs[j + dim*i];
+ vectors[i] = vec;
+ }
+
+ // Delete temporary space.
+ for (unsigned i=0; i<temp_store.size(); ++i)
+ delete [] temp_store[i];
+ temp_store.clear();
+
+ return ierr;
+}
+
+//------------------------------------------------------------
+//: Callback from solver to calculate the product A p.
+int vnl_sparse_symmetric_eigensystem::CalculateProduct(int n, int m,
+ const double* p,
+ double* q)
+{
+ // Call the special multiply method on the matrix.
+ mat->mult(n,m,p,q);
+
+ return 0;
+}
+
+//------------------------------------------------------------
+//: Callback to store vectors for dnlaso.
+int vnl_sparse_symmetric_eigensystem::SaveVectors(int n, int m,
+ const double* q,
+ int base)
+{
+ // Store the contents of q. Basically this is a fifo. When a write
+ // with base=0 is called, we start another fifo.
+ if (base == 0) {
+ for (unsigned i=0; i<temp_store.size(); ++i)
+ delete temp_store[i];
+ temp_store.clear();
+ }
+
+ double* temp = new double[n*m];
+ vcl_memcpy(temp,q,n*m*sizeof(double));
+ // vcl_cout << "Save vectors " << base << " " << temp << vcl_endl;
+
+ temp_store.push_back(temp);
+
+ return 0;
+}
+
+//------------------------------------------------------------
+//: Callback to restore vectors for dnlaso.
+int vnl_sparse_symmetric_eigensystem::RestoreVectors(int n, int m,
+ double* q,
+ int base)
+{
+ // Store the contents of q. Basically this is a fifo. When a read
+ // with base=0 is called, we start another fifo.
+ static int read_idx = 0;
+ if (base == 0)
+ read_idx = 0;
+
+ double* temp = temp_store[read_idx];
+ vcl_memcpy(q,temp,n*m*sizeof(double));
+ // vcl_cout << "Restore vectors " << base << " " << temp << vcl_endl;
+
+ read_idx++;
+ return 0;
+}
+
+//------------------------------------------------------------
+//: Return a calculated eigenvector.
+vnl_vector<double> vnl_sparse_symmetric_eigensystem::get_eigenvector(int i) const
+{
+ assert(i>=0 && i<nvalues);
+ return vectors[i];
+}
+
+double vnl_sparse_symmetric_eigensystem::get_eigenvalue(int i) const
+{
+ assert(i>=0 && i<nvalues);
+ return values[i];
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.h
new file mode 100644
index 0000000000000000000000000000000000000000..1075773682a575505aa3ca2727e141ec2f5372d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_sparse_symmetric_eigensystem.h
@@ -0,0 +1,60 @@
+// This is core/vnl/algo/vnl_sparse_symmetric_eigensystem.h
+#ifndef vnl_sparse_symmetric_eigensystem_h_
+#define vnl_sparse_symmetric_eigensystem_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Find the eigenvalues of a sparse symmetric matrix
+// \author Rupert W. Curwen, GE CR&D
+// \date 20 Oct 98
+//
+// \verbatim
+// Modifications
+// dac (Manchester) 28/03/2001: tidied up documentation
+// \endverbatim
+
+#include <vnl/vnl_sparse_matrix.h>
+#include <vcl_vector.h>
+
+//: Find the eigenvalues of a sparse symmetric matrix
+// Solve the eigenproblem $A x = \lambda x$, with $A$ symmetric and
+// sparse. The block Lanczos algorithm is used to allow the
+// recovery of a number of eigenvalue/eigenvector pairs from either
+// end of the spectrum, to a required accuracy.
+//
+// Uses the dnlaso routine from the LASO package of netlib.
+
+class vnl_sparse_symmetric_eigensystem
+{
+ public:
+ vnl_sparse_symmetric_eigensystem();
+ ~vnl_sparse_symmetric_eigensystem();
+
+ // Find n eigenvalue/eigenvectors. If smallest is true, will
+ // calculate the n smallest eigenpairs, else the n largest.
+ int CalculateNPairs(vnl_sparse_matrix<double>& M, int n,
+ bool smallest = true, int nfigures = 10);
+
+ // Recover specified eigenvector after computation. The argument
+ // must be less than the requested number of eigenvectors.
+ vnl_vector<double> get_eigenvector(int i) const;
+ double get_eigenvalue(int i) const;
+
+ // Used as a callback in solving.
+ int CalculateProduct(int n, int m, const double* p, double* q);
+ int SaveVectors(int n, int m, const double* q, int base);
+ int RestoreVectors(int n, int m, double* q, int base);
+
+ protected:
+ int nvalues; // this is the size of the next two arrays.
+ vnl_vector<double> * vectors; // eigenvectors
+ double * values; // eigenvalues
+
+ vnl_sparse_matrix<double> * mat;
+
+ vcl_vector<double*> temp_store;
+};
+
+#endif // vnl_sparse_symmetric_eigensystem_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.h
new file mode 100644
index 0000000000000000000000000000000000000000..f57608bd88b57ea9746e85629240be2cff96da23
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.h
@@ -0,0 +1,207 @@
+// This is core/vnl/algo/vnl_svd.h
+#ifndef vnl_svd_h_
+#define vnl_svd_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Holds the singular value decomposition of a vnl_matrix.
+// \author Andrew W. Fitzgibbon, Oxford IERG
+// \date 15 Jul 96
+//
+// \verbatim
+// Modifications
+// fsm, Oxford IESRG, 26 Mar 1999
+// 1. The singular values are now stored as reals (not complexes) when T is complex.
+// 2. Fixed bug : for complex T, matrices have to be conjugated as well as transposed.
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vnl/vnl_numeric_traits.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vcl_iosfwd.h>
+
+//: Holds the singular value decomposition of a vnl_matrix.
+//
+// The class holds three matrices U, W, V such that the original matrix
+// $M = U W V^\top$. The DiagMatrix W stores the singular values in decreasing
+// order. The columns of U which correspond to the nonzero singular values
+// form a basis for range of M, while the columns of V corresponding to the
+// zero singular values are the nullspace.
+//
+// The SVD is computed at construction time, and inquiries may then be made
+// of the SVD. In particular, this allows easy access to multiple
+// right-hand-side solves without the bother of putting all the RHS's into a
+// Matrix.
+//
+// This class is supplied even though there is an existing vnl_matrix method
+// for several reasons:
+//
+// It is more convenient to use as it manages all the storage for
+// the U,S,V matrices, allowing repeated queries of the same SVD
+// results.
+//
+// It avoids namespace clutter in the Matrix class. While svd()
+// is a perfectly reasonable method for a Matrix, there are many other
+// decompositions that might be of interest, and adding them all would
+// make for a very large Matrix class.
+//
+// It demonstrates the holder model of compute class, implementing an
+// algorithm on an object without adding a member that may not be of
+// general interest. A similar pattern can be used for other
+// decompositions which are not defined as members of the library Matrix
+// class.
+//
+// It extends readily to n-ary operations, such as generalized
+// eigensystems, which cannot be members of just one matrix.
+
+export template <class T>
+class vnl_svd
+{
+ public:
+ //: The singular values of a matrix of complex<T> are of type T, not complex<T>
+ typedef typename vnl_numeric_traits<T>::abs_t singval_t;
+
+ //:
+ // Construct an vnl_svd<T> object from $m \times n$ matrix $M$. The
+ // vnl_svd<T> object contains matrices $U$, $W$, $V$ such that
+ // $U W V^\top = M$.
+ //
+ // Uses linpack routine DSVDC to calculate an ``economy-size'' SVD
+ // where the returned $U$ is the same size as $M$, while $W$
+ // and $V$ are both $n \times n$. This is efficient for
+ // large rectangular solves where $m > n$, typical in least squares.
+ //
+ // The optional argument zero_out_tol is used to mark the zero singular
+ // values: If nonnegative, any s.v. smaller than zero_out_tol in
+ // absolute value is set to zero. If zero_out_tol is negative, the
+ // zeroing is relative to |zero_out_tol| * sigma_max();
+
+ vnl_svd(vnl_matrix<T> const &M, double zero_out_tol = 0.0);
+ ~vnl_svd() {}
+
+ // Data Access---------------------------------------------------------------
+
+ //: find weights below threshold tol, zero them out, and update W_ and Winverse_
+ void zero_out_absolute(double tol = 1e-8); //sqrt(machine epsilon)
+
+ //: find weights below tol*max(w) and zero them out
+ void zero_out_relative(double tol = 1e-8); //sqrt(machine epsilon)
+ int singularities () const { return W_.rows() - rank(); }
+ int rank () const { return rank_; }
+ singval_t well_condition () const { return sigma_min()/sigma_max(); }
+
+ //: Calculate determinant as product of diagonals in W.
+ singval_t determinant_magnitude () const;
+ singval_t norm() const;
+
+ //: Return the matrix U.
+ vnl_matrix<T> & U() { return U_; }
+
+ //: Return the matrix U.
+ vnl_matrix<T> const& U() const { return U_; }
+
+ //: Return the matrix U's (i,j)th entry (to avoid svd.U()(i,j); ).
+ T U(int i, int j) const { return U_(i,j); }
+
+ //: Get at DiagMatrix (q.v.) of singular values, sorted from largest to smallest
+ vnl_diag_matrix<singval_t> & W() { return W_; }
+
+ //: Get at DiagMatrix (q.v.) of singular values, sorted from largest to smallest
+ vnl_diag_matrix<singval_t> const & W() const { return W_; }
+ vnl_diag_matrix<singval_t> & Winverse() { return Winverse_; }
+ vnl_diag_matrix<singval_t> const & Winverse() const { return Winverse_; }
+ singval_t & W(int i, int j) { return W_(i,j); }
+ singval_t & W(int i) { return W_(i,i); }
+ singval_t sigma_max() const { return W_(0,0); } // largest
+ singval_t sigma_min() const { return W_(n_-1,n_-1); } // smallest
+
+ //: Return the matrix V.
+ vnl_matrix<T> & V() { return V_; }
+
+ //: Return the matrix V.
+ vnl_matrix<T> const& V() const { return V_; }
+
+ //: Return the matrix V's (i,j)th entry (to avoid svd.V()(i,j); ).
+ T V(int i, int j) const { return V_(i,j); }
+
+ //:
+ inline vnl_matrix<T> inverse () const { return pinverse(); }
+
+ //: pseudo-inverse (for non-square matrix) of desired rank.
+ vnl_matrix<T> pinverse (unsigned int rank = 0xffffffff) const; //0xffffffff == (unsigned int)-1
+
+ //: Calculate inverse of transpose, using desired rank.
+ vnl_matrix<T> tinverse (unsigned int rank = 0xffffffff) const; //0xffffffff == (unsigned int)-1
+
+ //: Recompose SVD to U*W*V', using desired rank.
+ vnl_matrix<T> recompose (unsigned int rank = 0xffffffff) const; //0xffffffff == (unsigned int)-1
+
+ //: Solve the matrix equation M X = B, returning X
+ vnl_matrix<T> solve (vnl_matrix<T> const& B) const;
+
+ //: Solve the matrix-vector system M x = y, returning x.
+ vnl_vector<T> solve (vnl_vector<T> const& y) const;
+ void solve (T const *rhs, T *lhs) const; // min ||A*lhs - rhs||
+
+ //: Solve the matrix-vector system M x = y.
+ // Assuming that the singular values W have been preinverted by the caller.
+ void solve_preinverted(vnl_vector<T> const& rhs, vnl_vector<T>* out) const;
+
+ //: Return N such that M * N = 0
+ vnl_matrix<T> nullspace() const;
+
+ //: Return N such that M' * N = 0
+ vnl_matrix<T> left_nullspace() const;
+
+ //: Return N such that M * N = 0
+ vnl_matrix<T> nullspace(int required_nullspace_dimension) const;
+
+ //: Implementation to be done yet; currently returns left_nullspace(). - PVR.
+ vnl_matrix<T> left_nullspace(int required_nullspace_dimension) const;
+
+ //: Return the rightmost column of V.
+ // Does not check to see whether or not the matrix actually was rank-deficient -
+ // the caller is assumed to have examined W and decided that to his or her satisfaction.
+ vnl_vector<T> nullvector() const;
+
+ //: Return the rightmost column of U.
+ // Does not check to see whether or not the matrix actually was rank-deficient.
+ vnl_vector<T> left_nullvector() const;
+
+ bool valid() const { return valid_; }
+
+ private:
+
+ int m_, n_; // Size of M, local cache.
+ vnl_matrix<T> U_; // Columns Ui are basis for range of M for Wi != 0
+ vnl_diag_matrix<singval_t> W_;// Singular values, sorted in decreasing order
+ vnl_diag_matrix<singval_t> Winverse_;
+ vnl_matrix<T> V_; // Columns Vi are basis for nullspace of M for Wi = 0
+ unsigned rank_;
+ bool have_max_;
+ singval_t max_;
+ bool have_min_;
+ singval_t min_;
+ double last_tol_;
+ bool valid_; // false if the NETLIB call failed.
+
+ // Disallow assignment.
+ vnl_svd(vnl_svd<T> const &) { }
+ vnl_svd<T>& operator=(vnl_svd<T> const &) { return *this; }
+};
+
+template <class T>
+inline
+vnl_matrix<T> vnl_svd_inverse(vnl_matrix<T> const& m)
+{
+ return vnl_svd<T>(m).inverse();
+}
+
+export template <class T>
+vcl_ostream& operator<<(vcl_ostream&, vnl_svd<T> const& svd);
+
+#endif // vnl_svd_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.txx
new file mode 100644
index 0000000000000000000000000000000000000000..de20376b7676cbbd113189858ca5f3764e9cc177
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd.txx
@@ -0,0 +1,427 @@
+// This is core/vnl/algo/vnl_svd.txx
+#ifndef vnl_svd_txx_
+#define vnl_svd_txx_
+//:
+// \file
+
+#include "vnl_svd.h"
+
+#include <vcl_cassert.h>
+#include <vcl_cstdlib.h>
+#include <vcl_complex.h>
+#include <vcl_iostream.h>
+#include <vcl_algorithm.h> // min()
+
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_fortran_copy.h>
+#include <vnl/algo/vnl_netlib.h> // dsvdc_()
+
+// use C++ overloading to call the right linpack routine from the template code :
+#define macro(p, T) \
+inline void vnl_linpack_svdc(vnl_netlib_svd_proto(T)) \
+{ p##svdc_(vnl_netlib_svd_params); }
+macro(s, float);
+macro(d, double);
+macro(c, vcl_complex<float>);
+macro(z, vcl_complex<double>);
+#undef macro
+
+//--------------------------------------------------------------------------------
+
+static bool test_heavily = false;
+#include <vnl/vnl_matlab_print.h>
+
+template <class T>
+vnl_svd<T>::vnl_svd(vnl_matrix<T> const& M, double zero_out_tol):
+ m_(M.rows()),
+ n_(M.columns()),
+ U_(m_, n_),
+ W_(n_),
+ Winverse_(n_),
+ V_(n_, n_)
+{
+ assert(m_ > 0);
+ assert(n_ > 0);
+
+ {
+ int n = M.rows();
+ int p = M.columns();
+ int mm = vcl_min(n+1,p);
+
+ // Copy source matrix into fortran storage
+ // SVD is slow, don't worry about the cost of this transpose.
+ vnl_fortran_copy<T> X(M);
+
+ // Make workspace vectors.
+ vnl_vector<T> work(n, T(0));
+ vnl_vector<T> uspace(n*p, T(0));
+ vnl_vector<T> vspace(p*p, T(0));
+ vnl_vector<T> wspace(mm, T(0)); // complex fortran routine actually _wants_ complex W!
+ vnl_vector<T> espace(p, T(0));
+
+ // Call Linpack SVD
+ int info = 0;
+ const int job = 21; // min(n,p) svs in U, n svs in V (i.e. economy size)
+ vnl_linpack_svdc((T*)X, &n, &n, &p,
+ wspace.data_block(),
+ espace.data_block(),
+ uspace.data_block(), &n,
+ vspace.data_block(), &p,
+ work.data_block(),
+ &job, &info);
+
+ // Error return?
+ if (info != 0)
+ {
+ // If info is non-zero, it contains the number of singular values
+ // for this the SVD algorithm failed to converge. The condition is
+ // not bogus. Even if the returned singular values are sensible,
+ // the singular vectors can be utterly wrong.
+
+ // It is possible the failure was due to NaNs or infinities in the
+ // matrix. Check for that now.
+ M.assert_finite();
+
+ // If we get here it might be because
+ // 1. The scalar type has such
+ // extreme precision that too few iterations were performed to
+ // converge to within machine precision (that is the svdc criterion).
+ // One solution to that is to increase the maximum number of
+ // iterations in the netlib code.
+ //
+ // 2. The LINPACK dsvdc_ code expects correct IEEE rounding behaviour,
+ // which some platforms (notably x86 processors)
+ // have trouble doing. For example, gcc can output
+ // code in -O2 and static-linked code that causes this problem.
+ // One solution to this is to persuade gcc to output slightly different code
+ // by adding and -fPIC option to the command line for v3p\netlib\dsvdc.c. If
+ // that doesn't work try adding -ffloat-store, which should fix the problem
+ // at the expense of being significantly slower for big problems. Note that
+ // if this is the cause, core/vnl/tests/test_svd should have failed.
+ //
+ // You may be able to diagnose the problem here by printing a warning message.
+ vcl_cerr << __FILE__ ": suspicious return value (" << info << ") from SVDC\n"
+ << __FILE__ ": M is " << M.rows() << 'x' << M.cols() << vcl_endl;
+
+ vnl_matlab_print(vcl_cerr, M, "M", vnl_matlab_print_format_long);
+ valid_ = false;
+ }
+ else
+ valid_ = true;
+
+ // Copy fortran outputs into our storage
+ {
+ const T *d = uspace.data_block();
+ for (int j = 0; j < p; ++j)
+ for (int i = 0; i < n; ++i)
+ U_(i,j) = *d++;
+ }
+
+ for (int j = 0; j < mm; ++j)
+ W_(j, j) = vcl_abs(wspace(j)); // we get rid of complexness here.
+
+ for (int j = mm; j < n_; ++j)
+ W_(j, j) = 0;
+
+ {
+ const T *d = vspace.data_block();
+ for (int j = 0; j < p; ++j)
+ for (int i = 0; i < p; ++i)
+ V_(i,j) = *d++;
+ }
+ }
+
+ if (test_heavily)
+ {
+ // Test that recomposed matrix == M
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ abs_t recomposition_residual = vcl_abs((recompose() - M).fro_norm());
+ abs_t n = vcl_abs(M.fro_norm());
+ abs_t thresh = m_ * abs_t(vnl_math::eps) * n;
+ if (recomposition_residual > thresh)
+ {
+ vcl_cerr << "vnl_svd<T>::vnl_svd<T>() -- Warning, recomposition_residual = "
+ << recomposition_residual << vcl_endl
+ << "fro_norm(M) = " << n << vcl_endl
+ << "eps*fro_norm(M) = " << thresh << vcl_endl
+ << "Press return to continue\n";
+ char x;
+ vcl_cin.get(&x, 1, '\n');
+ }
+ }
+
+ if (zero_out_tol >= 0)
+ // Zero out small sv's and update rank count.
+ zero_out_absolute(double(+zero_out_tol));
+ else
+ // negative tolerance implies relative to max elt.
+ zero_out_relative(double(-zero_out_tol));
+}
+
+template <class T>
+vcl_ostream& operator<<(vcl_ostream& s, const vnl_svd<T>& svd)
+{
+ s << "vnl_svd<T>:\n"
+// << "M = [\n" << M << "]\n"
+ << "U = [\n" << svd.U() << "]\n"
+ << "W = " << svd.W() << '\n'
+ << "V = [\n" << svd.V() << "]\n"
+ << "rank = " << svd.rank() << vcl_endl;
+ return s;
+}
+
+//-----------------------------------------------------------------------------
+// Chunky bits.
+
+//: find weights below threshold tol, zero them out, and update W_ and Winverse_
+template <class T>
+void
+vnl_svd<T>::zero_out_absolute(double tol)
+{
+ last_tol_ = tol;
+ rank_ = W_.rows();
+ for (unsigned k = 0; k < W_.rows(); k++)
+ {
+ singval_t& weight = W_(k, k);
+ if (vcl_abs(weight) <= tol)
+ {
+ Winverse_(k,k) = 0;
+ weight = 0;
+ --rank_;
+ } else
+ {
+ Winverse_(k,k) = singval_t(1.0)/weight;
+ }
+ }
+}
+
+//: find weights below tol*max(w) and zero them out
+template <class T> void vnl_svd<T>::zero_out_relative(double tol) // sqrt(machine epsilon)
+{
+ zero_out_absolute(tol * vcl_abs(sigma_max()));
+}
+
+static bool w=false;
+inline bool warned() { if (w) return true; else { w=true; return false; } }
+
+//: Calculate determinant as product of diagonals in W.
+template <class T>
+typename vnl_svd<T>::singval_t vnl_svd<T>::determinant_magnitude() const
+{
+ if (!warned() && m_ != n_)
+ vcl_cerr << __FILE__ ": called determinant_magnitude() on SVD of non-square matrix\n"
+ << "(This warning is displayed only once)\n";
+ singval_t product = W_(0, 0);
+ for (unsigned long k = 1; k < W_.columns(); k++)
+ product *= W_(k, k);
+
+ return product;
+}
+
+template <class T>
+typename vnl_svd<T>::singval_t vnl_svd<T>::norm() const
+{
+ return vcl_abs(sigma_max());
+}
+
+//: Recompose SVD to U*W*V'
+template <class T>
+vnl_matrix<T> vnl_svd<T>::recompose(unsigned int rnk) const
+{
+ if (rnk > rank_) rnk=rank_;
+ vnl_matrix<T> W(W_.rows(),W_.columns());
+ W.fill(T(0));
+ for (unsigned int i=0;i<rnk;++i)
+ W(i,i)=W_(i,i);
+
+ return U_*W*V_.conjugate_transpose();
+}
+
+
+//: Calculate pseudo-inverse.
+template <class T>
+vnl_matrix<T> vnl_svd<T>::pinverse(unsigned int rnk) const
+{
+ if (rnk > rank_) rnk=rank_;
+ vnl_matrix<T> Winverse(Winverse_.rows(),Winverse_.columns());
+ Winverse.fill(T(0));
+ for (unsigned int i=0;i<rnk;++i)
+ Winverse(i,i)=Winverse_(i,i);
+
+ return V_ * Winverse * U_.conjugate_transpose();
+}
+
+
+//: Calculate (pseudo-)inverse of transpose.
+template <class T>
+vnl_matrix<T> vnl_svd<T>::tinverse(unsigned int rnk) const
+{
+ if (rnk > rank_) rnk=rank_;
+ vnl_matrix<T> Winverse(Winverse_.rows(),Winverse_.columns());
+ Winverse.fill(T(0));
+ for (unsigned int i=0;i<rnk;++i)
+ Winverse(i,i)=Winverse_(i,i);
+
+ return U_ * Winverse * V_.conjugate_transpose();
+}
+
+
+//: Solve the matrix equation M X = B, returning X
+template <class T>
+vnl_matrix<T> vnl_svd<T>::solve(vnl_matrix<T> const& B) const
+{
+ vnl_matrix<T> x; // solution matrix
+ if (U_.rows() < U_.columns()) { // augment y with extra rows of
+ vnl_matrix<T> yy(U_.rows(), B.columns(), T(0)); // zeros, so that it matches
+ yy.update(B); // cols of u.transpose. ???
+ x = U_.conjugate_transpose() * yy;
+ } else
+ x = U_.conjugate_transpose() * B;
+ for (unsigned long i = 0; i < x.rows(); ++i) { // multiply with diagonal 1/W
+ T weight = W_(i, i);
+ if (weight != T(0)) //vnl_numeric_traits<T>::zero)
+ weight = T(1) / weight;
+ for (unsigned long j = 0; j < x.columns(); ++j)
+ x(i, j) *= weight;
+ }
+ x = V_ * x; // premultiply with v.
+ return x;
+}
+
+//: Solve the matrix-vector system M x = y, returning x.
+template <class T>
+vnl_vector<T> vnl_svd<T>::solve(vnl_vector<T> const& y) const
+{
+ // fsm sanity check :
+ if (y.size() != U_.rows())
+ {
+ vcl_cerr << __FILE__ << ": size of rhs is incompatible with no. of rows in U_\n"
+ << "y =" << y << '\n'
+ << "m_=" << m_ << '\n'
+ << "n_=" << n_ << '\n'
+ << "U_=\n" << U_
+ << "V_=\n" << V_
+ << "W_=\n" << W_;
+ }
+
+ vnl_vector<T> x(V_.rows()); // Solution matrix.
+ if (U_.rows() < U_.columns()) { // Augment y with extra rows of
+ vnl_vector<T> yy(U_.rows(), T(0)); // zeros, so that it matches
+ if (yy.size()<y.size()) { // fsm
+ vcl_cerr << "yy=" << yy << vcl_endl
+ << "y =" << y << vcl_endl;
+ // the update() call on the next line will abort...
+ }
+ yy.update(y); // cols of u.transpose.
+ x = U_.conjugate_transpose() * yy;
+ }
+ else
+ x = U_.conjugate_transpose() * y;
+
+ for (unsigned i = 0; i < x.size(); i++) { // multiply with diagonal 1/W
+ T weight = W_(i, i), zero_(0);
+ if (weight != zero_)
+ x[i] /= weight;
+ else
+ x[i] = zero_;
+ }
+ return V_ * x; // premultiply with v.
+}
+
+template <class T> // FIXME. this should implement the above, not the other way round.
+void vnl_svd<T>::solve(T const *y, T *x) const
+{
+ solve(vnl_vector<T>(y, m_)).copy_out(x);
+}
+
+//: Solve the matrix-vector system M x = y.
+// Assume that the singular values W have been preinverted by the caller.
+template <class T>
+void vnl_svd<T>::solve_preinverted(vnl_vector<T> const& y, vnl_vector<T>* x_out) const
+{
+ vnl_vector<T> x; // solution matrix
+ if (U_.rows() < U_.columns()) { // augment y with extra rows of
+ vcl_cout << "vnl_svd<T>::solve_preinverted() -- Augmenting y\n";
+ vnl_vector<T> yy(U_.rows(), T(0)); // zeros, so that it match
+ yy.update(y); // cols of u.transpose. ??
+ x = U_.conjugate_transpose() * yy;
+ } else
+ x = U_.conjugate_transpose() * y;
+ for (unsigned i = 0; i < x.size(); i++) // multiply with diagonal W, assumed inverted
+ x[i] *= W_(i, i);
+
+ *x_out = V_ * x; // premultiply with v.
+}
+
+//-----------------------------------------------------------------------------
+//: Return N s.t. M * N = 0
+template <class T>
+vnl_matrix <T> vnl_svd<T>::nullspace() const
+{
+ int k = rank();
+ if (k == n_)
+ vcl_cerr << "vnl_svd<T>::nullspace() -- Matrix is full rank." << last_tol_ << vcl_endl;
+ return nullspace(n_-k);
+}
+
+//-----------------------------------------------------------------------------
+//: Return N s.t. M * N = 0
+template <class T>
+vnl_matrix <T> vnl_svd<T>::nullspace(int required_nullspace_dimension) const
+{
+ return V_.extract(V_.rows(), required_nullspace_dimension, 0, n_ - required_nullspace_dimension);
+}
+
+//-----------------------------------------------------------------------------
+//: Return N s.t. M' * N = 0
+template <class T>
+vnl_matrix <T> vnl_svd<T>::left_nullspace() const
+{
+ int k = rank();
+ if (k == n_)
+ vcl_cerr << "vnl_svd<T>::left_nullspace() -- Matrix is full rank." << last_tol_ << vcl_endl;
+ return U_.extract(U_.rows(), n_-k, 0, k);
+}
+
+//: Implementation to be done yet; currently returns left_nullspace(). - PVr. // TODO
+template <class T>
+vnl_matrix<T> vnl_svd<T>::left_nullspace(int /*required_nullspace_dimension*/) const
+{
+ return left_nullspace();
+}
+
+
+//-----------------------------------------------------------------------------
+//: Return the rightmost column of V.
+// Does not check to see whether or not the matrix actually was rank-deficient -
+// the caller is assumed to have examined W and decided that to his or her satisfaction.
+template <class T>
+vnl_vector <T> vnl_svd<T>::nullvector() const
+{
+ vnl_vector<T> ret(n_);
+ for (int i = 0; i < n_; ++i)
+ ret(i) = V_(i, n_-1);
+ return ret;
+}
+
+//-----------------------------------------------------------------------------
+//: Return the rightmost column of U.
+// Does not check to see whether or not the matrix actually was rank-deficient.
+template <class T>
+vnl_vector <T> vnl_svd<T>::left_nullvector() const
+{
+ vnl_vector<T> ret(m_);
+ int col = vcl_min(m_, n_) - 1;
+ for (int i = 0; i < m_; ++i)
+ ret(i) = U_(i, col);
+ return ret;
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_SVD_INSTANTIATE
+#define VNL_SVD_INSTANTIATE(T) \
+template class vnl_svd<T >; \
+template vcl_ostream& operator<<(vcl_ostream &, vnl_svd<T > const &)
+
+#endif // vnl_svd_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.h
new file mode 100644
index 0000000000000000000000000000000000000000..10dca40cdd1a0eb48446a789369f557fb064e748
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.h
@@ -0,0 +1,50 @@
+// This is core/vnl/algo/vnl_svd_economy.h
+#ifndef vnl_svd_economy_h_
+#define vnl_svd_economy_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief SVD wrapper that doesn't compute the left singular vectors, U.
+// \author David Capel (d.capel@2d3.com)
+// \date 04 Mar 03
+//
+// The cost of SVD of an m*n matrix increases with O(m^2) if computation
+// of U is required, but only O(m) if not.
+
+#include <vnl/vnl_numeric_traits.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+template <class real_t>
+class vnl_svd_economy
+{
+ public:
+ //: The singular values of a matrix of complex<T> are of type T, not complex<T>
+ typedef typename vnl_numeric_traits<real_t>::abs_t singval_t;
+
+ vnl_svd_economy(vnl_matrix<real_t> const& M);
+
+ //: Return right singular vectors.
+ vnl_matrix<real_t> const& V() const { return V_; }
+ vnl_matrix<real_t> & V() { return V_; }
+
+ //: Return singular values in decreasing order.
+ vnl_vector<singval_t> const& lambdas() const { return sv_; }
+ vnl_vector<singval_t> & lambdas() { return sv_; }
+
+ //: Return the rightmost column of V.
+ vnl_vector<real_t> nullvector();
+
+ protected:
+ int m_, n_;
+ vnl_matrix<real_t> V_;
+ vnl_vector<singval_t> sv_;
+
+ private:
+ vnl_svd_economy( vnl_svd_economy<real_t> const&) { }
+ vnl_svd_economy<real_t>& operator=(vnl_svd_economy<real_t> const&) { return *this; }
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.txx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.txx
new file mode 100644
index 0000000000000000000000000000000000000000..57f42996179c384c68414ff8af51e6f1651054e5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_svd_economy.txx
@@ -0,0 +1,116 @@
+// This is core/vnl/algo/vnl_svd_economy.txx
+#ifndef vnl_svd_economy_txx_
+#define vnl_svd_economy_txx_
+
+#include "vnl_svd_economy.h"
+
+#include <vcl_iostream.h>
+#include <vcl_algorithm.h>
+#include <vcl_cmath.h> // for std::abs(double)
+
+#include <vnl/vnl_fortran_copy.h>
+#include <vnl/algo/vnl_netlib.h> // dsvdc_()
+#include <vnl/vnl_matlab_print.h>
+
+#define macro(p, T) \
+inline void vnl_linpack_svdc(vnl_netlib_svd_proto(T)) \
+{ p##svdc_(vnl_netlib_svd_params); }
+macro(s, float);
+macro(d, double);
+macro(c, vcl_complex<float>);
+macro(z, vcl_complex<double>);
+#undef macro
+
+template <class real_t>
+vnl_svd_economy<real_t>::vnl_svd_economy( vnl_matrix<real_t> const& M ) :
+ m_(M.rows()), n_(M.columns()),
+ V_(n_,n_),
+ sv_(n_)
+{
+ vnl_fortran_copy<real_t> X(M);
+
+ int mm = vcl_min(m_+1,n_);
+
+ // Make workspace vectors.
+ vnl_vector<real_t> work(m_, real_t(0));
+ vnl_vector<real_t> vspace(n_*n_, real_t(0));
+ vnl_vector<real_t> wspace(mm, real_t(0)); // complex fortran routine actually _wants_ complex W!
+ vnl_vector<real_t> espace(n_, real_t(0));
+
+ // Call Linpack SVD
+ int info = 0;
+ const int job = 01; // no U, n svs in V (i.e. super-economy size)
+ vnl_linpack_svdc((real_t*)X, &m_, &m_, &n_,
+ wspace.data_block(),
+ espace.data_block(),
+ 0, 0,
+ vspace.data_block(), &n_,
+ work.data_block(),
+ &job, &info);
+
+ // Error return?
+ if (info != 0)
+ {
+ // If info is non-zero, it contains the number of singular values
+ // for this the SVD algorithm failed to converge. The condition is
+ // not bogus. Even if the returned singular values are sensible,
+ // the singular vectors can be utterly wrong.
+
+ // It is possible the failure was due to NaNs or infinities in the
+ // matrix. Check for that now.
+ M.assert_finite();
+
+ // If we get here it might be because
+ // 1. The scalar type has such
+ // extreme precision that too few iterations were performed to
+ // converge to within machine precision (that is the svdc criterion).
+ // One solution to that is to increase the maximum number of
+ // iterations in the netlib code.
+ //
+ // 2. The LINPACK dsvdc_ code expects correct IEEE rounding behaviour,
+ // which some platforms (notably x86 processors)
+ // have trouble doing. For example, gcc can output
+ // code in -O2 and static-linked code that causes this problem.
+ // One solution to this is to persuade gcc to output slightly different code
+ // by adding and -fPIC option to the command line for v3p\netlib\dsvdc.c. If
+ // that doesn't work try adding -ffloat-store, which should fix the problem
+ // at the expense of being significantly slower for big problems. Note that
+ // if this is the cause, core/vnl/tests/test_svd should have failed.
+ //
+ // You may be able to diagnose the problem here by printing a warning message.
+ vcl_cerr << __FILE__ ": suspicious return value (" << info << ") from SVDC\n"
+ << __FILE__ ": M is " << M.rows() << 'x' << M.cols() << vcl_endl;
+
+ vnl_matlab_print(vcl_cerr, M, "M", vnl_matlab_print_format_long);
+ // valid_ = false;
+ }
+#if 0
+ else
+ valid_ = true;
+#endif
+
+ for (int j = 0; j < mm; ++j)
+ sv_[j] = vcl_abs(wspace(j)); // we get rid of complexness here.
+
+ for (int j = mm; j < n_; ++j)
+ sv_[j] = 0;
+
+ {
+ const real_t *d = vspace.data_block();
+ for (int j = 0; j < n_; ++j)
+ for (int i = 0; i < n_; ++i)
+ V_[i][j] = *(d++);
+ }
+}
+
+template <class real_t>
+vnl_vector<real_t>
+vnl_svd_economy<real_t>::nullvector()
+{
+ return V_.get_column( n_ - 1 );
+}
+
+#undef VNL_SVD_ECONOMY_INSTANTIATE
+#define VNL_SVD_ECONOMY_INSTANTIATE(T) template class vnl_svd_economy<T >
+
+#endif // vnl_svd_economy_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d4f614b3bb573463d6f592eba577dddc70fcda85
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.cxx
@@ -0,0 +1,249 @@
+// This is core/vnl/algo/vnl_symmetric_eigensystem.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// Created: 29 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_symmetric_eigensystem.h"
+#include <vcl_cassert.h>
+#include <vcl_algorithm.h> // for swap
+#include <vcl_cmath.h> // for sqrt(double), acos, etc.
+#include <vcl_iostream.h>
+#include <vnl/vnl_copy.h>
+#include <vnl/vnl_math.h>
+#include <vnl/algo/vnl_netlib.h> // rs_()
+
+//: Find eigenvalues of a symmetric 3x3 matrix
+// \verbatim
+// Matrix is M11 M12 M13
+// M12 M22 M23
+// M13 M23 M33
+// \endverbatim
+void vnl_symmetric_eigensystem_compute_eigenvals(
+ double M11, double M12, double M13,
+ double M22, double M23,
+ double M33,
+ double &l1, double &l2, double &l3)
+{
+ // Characteristic eqtn |M - xI| = 0
+ // x^3 + b x^2 + c x + d = 0
+ const double b = -M11-M22-M33;
+ const double c = M11*M22 +M11*M33 +M22*M33 -M12*M12 -M13*M13 -M23*M23;
+ const double d = M11*M23*M23 +M12*M12*M33 +M13*M13*M22 -2.0*M12*M13*M23 -M11*M22*M33;
+
+
+ // Using a numerically tweaked version of the real cubic solver http://www.1728.com/cubic2.htm
+ const double b_3 = b/3.0;
+ const double f = b_3*b_3 - c/3.0 ;
+ const double g = b*c/6.0 - b_3*b_3*b_3 - 0.5*d;
+
+
+ if (f == 0.0 && g == 0.0)
+ {
+ l1 = l2 = l3 = - b_3 ;
+ return;
+ }
+
+
+ const double f3 = f*f*f;
+ const double g2 = g*g;
+ const double sqrt_f = -vcl_sqrt(f);
+
+ // deal explicitly with repeated root and treat
+ // complex conjugate roots as numerically inaccurate repeated roots.
+
+ // first check we are not too numerically innacurate
+ assert((g2 - f3) / vnl_math_sqr(vnl_math_cube(b)) < 1e-8);
+
+ if (g2 >= f3)
+ {
+ if (g < 0.0)
+ {
+ l1 = 2.0 * sqrt_f - b_3;
+ l2 = l3 = - sqrt_f - b_3;
+ }
+ else
+ {
+ l1 = l2 = sqrt_f - b_3;
+ l3 = -2.0 * sqrt_f - b_3;
+ }
+ return;
+ }
+
+
+ const double sqrt_f3 = sqrt_f * sqrt_f * sqrt_f;
+ const double k = vcl_acos(g / sqrt_f3) / 3.0;
+ const double j = 2.0 * sqrt_f;
+ l1 = j * vcl_cos(k) - b_3;
+ l2 = j * vcl_cos(k + vnl_math::pi * 2.0 / 3.0) - b_3;
+ l3 = j * vcl_cos(k - vnl_math::pi * 2.0 / 3.0) - b_3;
+
+ if (l2 < l1) vcl_swap(l2, l1);
+ if (l3 < l2)
+ {
+ vcl_swap(l2, l3);
+ if (l2 < l1) vcl_swap(l2, l1);
+ }
+
+
+
+}
+
+bool vnl_symmetric_eigensystem_compute(vnl_matrix<float> const & A,
+ vnl_matrix<float> & V,
+ vnl_vector<float> & D)
+{
+ vnl_matrix<double> Ad(A.rows(), A.cols());
+ vnl_matrix<double> Vd(V.rows(), V.cols());
+ vnl_vector<double> Dd(D.size());
+ vnl_copy(A, Ad);
+ bool f = vnl_symmetric_eigensystem_compute(Ad, Vd, Dd);
+ vnl_copy(Vd, V);
+ vnl_copy(Dd, D);
+ return f;
+}
+
+bool vnl_symmetric_eigensystem_compute(vnl_matrix<double> const & A,
+ vnl_matrix<double> & V,
+ vnl_vector<double> & D)
+{
+ A.assert_finite();
+ const int n = A.rows();
+
+ // Set the size of the eigenvalue vector D (output) if it does not match the size of A:
+ if (D.size() != A.rows())
+ D.set_size(n);
+
+ vnl_vector<double> work1(n);
+ vnl_vector<double> work2(n);
+ vnl_vector<double> Vvec(n*n);
+
+ int want_eigenvectors = 1;
+ int ierr = 0;
+
+ // No need to transpose A, cos it's symmetric...
+ vnl_matrix<double> B = A; // since A is read-only and rs_ might change its third argument...
+ rs_(&n, &n, B.data_block(), &D[0], &want_eigenvectors, &Vvec[0], &work1[0], &work2[0], &ierr);
+
+ if (ierr) {
+ vcl_cerr << "vnl_symmetric_eigensystem: ierr = " << ierr << vcl_endl;
+ return false;
+ }
+
+ // Transpose-copy into V, which is first resized if necessary
+ if (V.rows() != A.rows() || V.cols() != A.rows())
+ V.set_size(n,n);
+ double *vptr = &Vvec[0];
+ for (int c = 0; c < n; ++c)
+ for (int r = 0; r < n; ++r)
+ V(r,c) = *vptr++;
+
+ return true;
+}
+
+//----------------------------------------------------------------------
+
+// - @{ Solve real symmetric eigensystem $A x = \lambda x$ @}
+template <class T>
+vnl_symmetric_eigensystem<T>::vnl_symmetric_eigensystem(vnl_matrix<T> const& A)
+ : n_(A.rows()), V(n_, n_), D(n_)
+{
+ vnl_vector<T> Dvec(n_);
+
+ vnl_symmetric_eigensystem_compute(A, V, Dvec);
+
+ // Copy Dvec into diagonal of D
+ for (int i = 0; i < n_; ++i)
+ D(i,i) = Dvec[i];
+}
+
+template <class T>
+vnl_vector<T> vnl_symmetric_eigensystem<T>::get_eigenvector(int i) const
+{
+ return vnl_vector<T>(V.extract(n_,1,0,i).data_block(), n_);
+}
+
+template <class T>
+T vnl_symmetric_eigensystem<T>::get_eigenvalue(int i) const
+{
+ return D(i, i);
+}
+
+template <class T>
+vnl_vector<T> vnl_symmetric_eigensystem<T>::solve(vnl_vector<T> const& b)
+{
+ //vnl_vector<T> ret(b.length());
+ //FastOps::AtB(V, b, &ret);
+ vnl_vector<T> ret(b*V); // same as V.transpose()*b
+
+ vnl_vector<T> tmp(b.size());
+ D.solve(ret, &tmp);
+
+ return V * tmp;
+}
+
+template <class T>
+T vnl_symmetric_eigensystem<T>::determinant() const
+{
+ int const n = D.size();
+ T det(1);
+ for (int i=0; i<n; ++i)
+ det *= D[i];
+ return det;
+}
+
+template <class T>
+vnl_matrix<T> vnl_symmetric_eigensystem<T>::pinverse() const
+{
+ unsigned n = D.rows();
+ vnl_diag_matrix<T> invD(n);
+ for (unsigned i=0; i<n; ++i)
+ if (D(i, i) == 0) {
+ vcl_cerr << __FILE__ ": pinverse(): eigenvalue " << i << " is zero.\n";
+ invD(i, i) = 0;
+ }
+ else
+ invD(i, i) = 1 / D(i, i);
+ return V * invD * V.transpose();
+}
+
+template <class T>
+vnl_matrix<T> vnl_symmetric_eigensystem<T>::square_root() const
+{
+ unsigned n = D.rows();
+ vnl_diag_matrix<T> sqrtD(n);
+ for (unsigned i=0; i<n; ++i)
+ if (D(i, i) < 0) {
+ vcl_cerr << __FILE__ ": square_root(): eigenvalue " << i << " is negative (" << D(i, i) << ").\n";
+ sqrtD(i, i) = (T)vcl_sqrt((typename vnl_numeric_traits<T>::real_t)(-D(i, i)));
+ // gives square root of the absolute value of T.
+ }
+ else
+ sqrtD(i, i) = (T)vcl_sqrt((typename vnl_numeric_traits<T>::real_t)(D(i, i)));
+ return V * sqrtD * V.transpose();
+}
+
+template <class T>
+vnl_matrix<T> vnl_symmetric_eigensystem<T>::inverse_square_root() const
+{
+ unsigned n = D.rows();
+ vnl_diag_matrix<T> inv_sqrtD(n);
+ for (unsigned i=0; i<n; ++i)
+ if (D(i, i) <= 0) {
+ vcl_cerr << __FILE__ ": square_root(): eigenvalue " << i << " is non-positive (" << D(i, i) << ").\n";
+ inv_sqrtD(i, i) = (T)vcl_sqrt(-1.0/(typename vnl_numeric_traits<T>::real_t)(D(i, i))); // ??
+ }
+ else
+ inv_sqrtD(i, i) = (T)vcl_sqrt(1.0/(typename vnl_numeric_traits<T>::real_t)(D(i, i)));
+ return V * inv_sqrtD * V.transpose();
+}
+
+//--------------------------------------------------------------------------------
+
+template class vnl_symmetric_eigensystem<float>;
+template class vnl_symmetric_eigensystem<double>;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.h b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.h
new file mode 100644
index 0000000000000000000000000000000000000000..0fd48fb14b43de4592030f823fd549db0707bf1b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/algo/vnl_symmetric_eigensystem.h
@@ -0,0 +1,144 @@
+// This is core/vnl/algo/vnl_symmetric_eigensystem.h
+#ifndef vnl_symmetric_eigensystem_h_
+#define vnl_symmetric_eigensystem_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Find eigenvalues of a symmetric matrix
+//
+// vnl_symmetric_eigensystem_compute()
+// solves the eigenproblem $A x = \lambda x$, with $A$ symmetric.
+// The resulting eigenvectors and values are sorted in increasing order
+// so <CODE> V.column(0) </CODE> is the eigenvector corresponding to the
+// smallest eigenvalue.
+//
+// As a matrix decomposition, this is $A = V D V^t$
+//
+// Uses the EISPACK routine RS, which in turn calls TRED2 to reduce A
+// to tridiagonal form, followed by TQL2, to find the eigensystem.
+// This is summarized in Golub and van Loan, \S8.2. The following are
+// the original subroutine headers:
+//
+// \remark TRED2 is a translation of the Algol procedure tred2,
+// Num. Math. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
+// Handbook for Auto. Comp., Vol.ii-Linear Algebra, 212-226(1971).
+//
+// \remark This subroutine reduces a real symmetric matrix to a
+// symmetric tridiagonal matrix using and accumulating
+// orthogonal similarity transformations.
+//
+// \remark TQL2 is a translation of the Algol procedure tql2,
+// Num. Math. 11, 293-306(1968) by Bowdler, Martin, Reinsch, and Wilkinson.
+// Handbook for Auto. Comp., Vol.ii-Linear Algebra, 227-240(1971).
+//
+// \remark This subroutine finds the eigenvalues and eigenvectors
+// of a symmetric tridiagonal matrix by the QL method.
+// the eigenvectors of a full symmetric matrix can also
+// be found if tred2 has been used to reduce this
+// full matrix to tridiagonal form.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 29 Aug 96
+//
+// \verbatim
+// Modifications
+// fsm, 5 March 2000: templated
+// dac (Manchester) 28/03/2001: tidied up documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Jan.2003 - Peter Vanroose - added missing implementation for solve(b,x)
+// \endverbatim
+
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_diag_matrix.h>
+
+//: Find eigenvalues of a symmetric 3x3 matrix
+// Eigenvalues will be returned so that l1 <= l2 <= l3.
+// \verbatim
+// Matrix is M11 M12 M13
+// M12 M22 M23
+// M13 M23 M33
+// \endverbatim
+void vnl_symmetric_eigensystem_compute_eigenvals(
+ double M11, double M12, double M13,
+ double M22, double M23,
+ double M33,
+ double &l1, double &l2, double &l3);
+
+//: Find eigenvalues of a symmetric matrix
+bool vnl_symmetric_eigensystem_compute(vnl_matrix<float> const & A,
+ vnl_matrix<float> & V,
+ vnl_vector<float> & D);
+
+//: Find eigenvalues of a symmetric matrix
+
+bool vnl_symmetric_eigensystem_compute(vnl_matrix<double> const & A,
+ vnl_matrix<double> & V,
+ vnl_vector<double> & D);
+
+//: Computes and stores the eigensystem decomposition of a symmetric matrix.
+
+export template <class T>
+class vnl_symmetric_eigensystem
+{
+ public:
+ //: Solve real symmetric eigensystem $A x = \lambda x$
+ vnl_symmetric_eigensystem(vnl_matrix<T> const & M);
+
+ protected:
+ // need this here to get inits in correct order, but still keep gentex
+ // in the right order.
+ int n_;
+
+ public:
+ //: Public eigenvectors.
+ // After construction, the columns of V are the eigenvectors, sorted by
+ // increasing eigenvalue, from most negative to most positive.
+ vnl_matrix<T> V;
+
+ //: Public eigenvalues.
+ // After construction, D contains the eigenvalues, sorted as described above.
+ // Note that D is a vnl_diag_matrix, and is therefore stored as a vcl_vector while behaving as a matrix.
+ vnl_diag_matrix<T> D;
+
+ //: Recover specified eigenvector after computation.
+ vnl_vector<T> get_eigenvector(int i) const;
+
+ //: Recover specified eigenvalue after computation.
+ T get_eigenvalue(int i) const;
+
+ //: Convenience method to get least-squares nullvector.
+ // It is deliberate that the signature is the same as on vnl_svd<T>.
+ vnl_vector<T> nullvector() const { return get_eigenvector(0); }
+
+ //: Return the matrix $V D V^\top$.
+ // This can be useful if you've modified $D$. So an inverse is obtained using
+ // \code
+ // vnl_symmetric_eigensystem} eig(A);
+ // eig.D.invert_in_place}();
+ // vnl_matrix<double> Ainverse = eig.recompose();
+ // \endcode
+
+ vnl_matrix<T> recompose() const { return V * D * V.transpose(); }
+
+ //: return product of eigenvalues.
+ T determinant() const;
+
+ //: return the pseudoinverse.
+ vnl_matrix<T> pinverse() const;
+
+ //: return the square root, if positive semi-definite.
+ vnl_matrix<T> square_root() const;
+
+ //: return the inverse of the square root, if positive semi-definite.
+ vnl_matrix<T> inverse_square_root() const;
+
+ //: Solve LS problem M x = b
+ vnl_vector<T> solve(vnl_vector<T> const & b);
+
+ //: Solve LS problem M x = b
+ void solve(vnl_vector<T> const & b, vnl_vector<T> * x) { *x = solve(b); }
+};
+
+#endif // vnl_symmetric_eigensystem_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/dll.h b/Utilities/ITK/Utilities/vxl/core/vnl/dll.h
new file mode 100644
index 0000000000000000000000000000000000000000..7de504d89172b9f96ffedbe4930b69f75ad2edb4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/dll.h
@@ -0,0 +1,19 @@
+// This is core/vnl/dll.h
+#ifndef vnl_dll_h_
+#define vnl_dll_h_
+
+#include <vcl_compiler.h>
+
+#define VNL_DLL_DATA
+
+#if defined(VCL_WIN32) && !defined(BUILDING_VNL_DLL)
+
+// if win32 and not buiding the DLL then you need a dllimport
+// Only if you are building a DLL linked application.
+# ifdef BUILD_DLL
+# undef VNL_DLL_DATA
+# define VNL_DLL_DATA _declspec(dllimport)
+# endif // BUILD_DLL
+#endif // VCL_WIN32 and !Building_*_dll
+
+#endif // vnl_dll_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/examples/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/examples/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..05ad61bc0acb2c31d273c2f199ab8d0400d12dec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/CMakeLists.txt
@@ -0,0 +1,14 @@
+# vxl/vnl/examples/CMakeLists.txt
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/core/vnl/examples)
+
+LINK_LIBRARIES( vnl_algo vnl vul )
+
+ADD_EXECUTABLE(time_fastops time_fastops.cxx)
+ADD_EXECUTABLE(vnl_amoeba vnl_amoeba.cxx)
+ADD_EXECUTABLE(vnl_complex_svd vnl_complex_svd.cxx)
+ADD_EXECUTABLE(vnl_planefit vnl_planefit.cxx)
+ADD_EXECUTABLE(vnl_polyroots vnl_polyroots.cxx)
+ADD_EXECUTABLE(vnl_rosenbrock vnl_rosenbrock.cxx)
+ADD_EXECUTABLE(vnl_svd vnl_svd.cxx)
+ADD_EXECUTABLE(vnl_svd_economy vnl_svd_economy.cxx)
+ADD_EXECUTABLE(vnl_lsqr_test vnl_lsqr_test.cxx)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/time_fastops.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/time_fastops.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e3c592fb9a86dda990595e4d9527de76d22773eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/time_fastops.cxx
@@ -0,0 +1,58 @@
+// This is core/vnl/examples/time_fastops.cxx
+#include <vcl_iostream.h>
+#include <vcl_cmath.h> // for vcl_sqrt()
+#include <vcl_vector.h>
+#include <vul/vul_timer.h>
+
+double vnl_fastops_dot(const double* a, const double* b, unsigned int n);
+
+#ifdef OPTIMIZED
+#undef OPTIMIZED
+#define OPTIMIZED 1
+#else
+#define OPTIMIZED 0
+#endif
+#ifndef METHOD
+#define METHOD 4
+#endif
+
+int main()
+{
+ vcl_vector<double> x(1000000), y(1000000);
+ for (int i = 0; i < 1000000; ++i)
+ x[i] = y[i] = 1.0/vcl_sqrt(double(i+1));
+
+ vul_timer t;
+ for (int n = 0; n < 20; ++n)
+ vnl_fastops_dot(&x[0], &y[0], x.size());
+ vcl_cerr << "Method = " << METHOD << ", Optimized = " << OPTIMIZED << ", "
+ << "Result = " << vnl_fastops_dot(&x[0], &y[0], x.size()) << ", ";
+ t.print(vcl_cerr);
+
+ return 0;
+}
+
+double vnl_fastops_dot(const double* a, const double* b, unsigned int n)
+{
+ // Method 2 is fastest on the u170 -- weird.
+ double accum = 0;
+#if METHOD == 1
+ const double* aend = a + n;
+ while (a != aend)
+ accum += *a++ * *b++;
+#endif
+#if METHOD == 2
+ for (unsigned int k = 0; k < n; ++k)
+ accum += a[k] * b[k];
+#endif
+#if METHOD == 3
+ while (n--)
+ accum += a[n] * b[n];
+#endif
+#if METHOD == 4
+ unsigned int k = n;
+ while (k > 0)
+ --k, accum += a[k] * b[k];
+#endif
+ return accum;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_amoeba.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_amoeba.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7ab3e6b23fc4b2d769b81ed04ae1fe84829658b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_amoeba.cxx
@@ -0,0 +1,42 @@
+//-----------------------------------------------------------------------------
+// Module: Minimization of Rosenbrock banana function, downhill simplex
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 31 Aug 96
+// Converted to vxl by Peter Vanroose, February 2000
+//-----------------------------------------------------------------------------
+#include <vcl_iostream.h>
+#include <vnl/vnl_double_2.h>
+#include <vnl/vnl_cost_function.h>
+#include <vnl/algo/vnl_amoeba.h>
+
+// See rosenbrock.cxx for a description of this function.
+class vnl_rosenbrock : public vnl_cost_function
+{
+ public:
+ vnl_rosenbrock(): vnl_cost_function(2) {}
+
+ double f(const vnl_vector<double>& x)
+ {
+ double u = 10*(x[1] - x[0]*x[0]);
+ double v = 1 - x[0];
+ return u*u + v*v;
+ }
+};
+
+int main()
+{
+ // Set up a Rosenbrock compute object
+ vnl_rosenbrock f;
+
+ // Set up the initial guess
+ vnl_vector<double> x = vnl_double_2(-1.9,2.0).as_vector();
+
+ // Make a Levenberg Marquardt minimizer, attach f to it, and
+ // run the minimization
+ vnl_amoeba::minimize(f, x);
+
+ // Summarize the results
+ vcl_cout << "Rosenbrock min at " << x << '\n';
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_complex_svd.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_complex_svd.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2b1617307cc834d3ee5d21add82230621133f34c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_complex_svd.cxx
@@ -0,0 +1,51 @@
+//-*- c++ -*-------------------------------------------------------------------
+// Module: complex-svd
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 09 May 97
+// Converted to vxl by Peter Vanroose, February 2000
+//-----------------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_svd.h>
+
+int main()
+{
+ double r[] = {
+ 2, 7, 5,
+ 1, 0, 9,
+ 8, 5, 7,
+ 4, 0, 7
+ };
+
+ double i[] = {
+ 0, 4, 9,
+ 1, 4, 7,
+ 8, 7, 1,
+ 6, 5, 4
+ };
+
+ vcl_complex<double> cmplx[12];
+ for (int k=0; k<12; ++k) cmplx[k] = vcl_complex<double>(r[k],i[k]);
+
+ vnl_matrix<vcl_complex<double> > C(cmplx, 4, 3);
+
+ vcl_cout << "C = " << C << vcl_endl;
+
+ vnl_svd<vcl_complex<double> > C_svd(C);
+
+ vnl_matlab_print(vcl_cout, C_svd.U(), "U");
+ vnl_matlab_print(vcl_cout, C_svd.W(), "W");
+ vnl_matlab_print(vcl_cout, C_svd.V(), "V");
+
+ vcl_complex<double> rhs[4]; rhs[0]=3; rhs[1]=9; rhs[2]=-2; rhs[3]=-8;
+ vnl_vector<vcl_complex<double> > b(rhs, 4);
+
+ // From "C x = b" find x:
+ vcl_cout << "x = " << C_svd.solve(b) << vcl_endl;
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_lsqr_test.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_lsqr_test.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4f254e4bab4aba74a11b170bc963be06f7352ba9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_lsqr_test.cxx
@@ -0,0 +1,45 @@
+// This is core/vnl/examples/vnl_lsqr_test.cxx
+#include <vcl_cstdlib.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_sparse_matrix.h>
+#include <vnl/vnl_sparse_matrix_linear_system.h>
+#include <vnl/algo/vnl_lsqr.h>
+
+int main (int /*argc*/, char** /*argv*/) {
+
+ vnl_sparse_matrix<double> A(10000, 1000);
+
+ vcl_vector<int> cols(50);
+ vcl_vector<double> vals(50);
+
+ for (int row_ = 0; row_ < 10000; ++row_) {
+ double sum = 0;
+ for (int i = 0; i < 50; ++i) {
+ cols[i] = vcl_rand() % 999;
+ vals[i] = (double) vcl_rand() / (double) RAND_MAX;
+ sum += vals[i];
+ }
+ A.set_row(row_, cols, vals);
+ A.scale_row(row_, 1.0/sum);
+ }
+
+ vnl_vector<double> x(1000);
+ for (int i=0; i < 1000; ++i)
+ x[i] = (double) vcl_rand() / (double) RAND_MAX;
+
+ vnl_vector<double> b(10000);
+ A.mult(x,b);
+
+ for (int i=0; i < 10000; ++i)
+ b[i] += 0.01*(((double) vcl_rand() / (double) RAND_MAX) - 0.5);
+
+ vnl_sparse_matrix_linear_system<double> linear_system(A, b);
+ vnl_lsqr lsqr(linear_system);
+ vnl_vector<double> result(1000);
+ lsqr.minimize(result);
+ lsqr.diagnose_outcome(vcl_cerr);
+
+ vcl_cerr << "Ground truth relative residual : " << (x - result).two_norm() / x.two_norm() << vcl_endl;
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_planefit.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_planefit.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..72efa8f12641fd9e0bbcf50264485eb7c0345131
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_planefit.cxx
@@ -0,0 +1,44 @@
+//-*- c++ -*-------------------------------------------------------------------
+// Module: Hyperplane fit using orthogonal regression
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 31 Aug 96
+// Converted to vxl by Peter Vanroose, February 2000
+//-----------------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+#include <vnl/vnl_fastops.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/algo/vnl_symmetric_eigensystem.h>
+
+int main()
+{
+ // Read points from stdin
+ vnl_matrix<double> pts;
+ vcl_cin >> pts;
+
+ // Build design matrix D
+ int npts = pts.rows();
+ int dim = pts.columns();
+ vnl_matrix<double> D(npts, dim+1);
+ for (int i = 0; i < npts; ++i) {
+ for (int j = 0; j < dim; ++j) D(i,j) = pts(i,j);
+ D(i,dim) = 1;
+ }
+
+ // 1. Compute using SVD
+ {
+ vnl_svd<double> svd(D);
+ vnl_vector<double> a = svd.nullvector();
+ vcl_cout << "SVD residual = " << (D * a).magnitude() << vcl_endl;
+ }
+
+ // 2. Compute using eigensystem of D'*D
+ {
+ vnl_matrix<double> m; vnl_fastops::AtA(m,D);
+ vnl_symmetric_eigensystem<double> eig(m);
+ vnl_vector<double> a = eig.get_eigenvector(0);
+ vcl_cout << "Eig residual = " << (D * a).magnitude() << vcl_endl;
+ }
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_polyroots.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_polyroots.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..666a4cd7bec0186be493242695181fb4624914ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_polyroots.cxx
@@ -0,0 +1,39 @@
+// This is core/vnl/examples/vnl_polyroots.cxx
+
+//:
+// \file
+// \brief Find all roots of a polynomial
+// \author Peter Vanroose, KULeuven, ESAT/PSI.
+// \date February 2000
+//-----------------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+#include <vcl_cstdlib.h> // for atof()
+#include <vnl/vnl_vector.h>
+#include <vnl/algo/vnl_rpoly_roots.h>
+
+int main(int argc, char* argv[])
+{
+ --argc; ++argv;
+
+ // Read coefficients from stdin, or from command line
+ vnl_vector<double> pts(argc);
+ if (argc == 0) {
+ vcl_cout << "Give the polynomial coefficients, and end with EOF (CTRL-Z)\n";
+ vcl_cin >> pts;
+ }
+ else
+ for (int i=0; i<argc; ++i)
+ pts[i] = vcl_atof(argv[i]);
+
+ vcl_cout << "Coefficients = [ " << pts << " ]\n"
+ << "Polynomial = ";
+ for (unsigned i=0; i+2<pts.size(); ++i) if (pts[i] != 0)
+ vcl_cout << pts[i] << " X^" << pts.size()-i-1 << " + ";
+ vcl_cout << pts[pts.size()-2] << " X + " << pts[pts.size()-1] << vcl_endl;
+
+ vnl_rpoly_roots r(pts);
+
+ vcl_cout << "Roots = [ " << r.roots() << " ]\n";
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_rosenbrock.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_rosenbrock.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..35586638cbf591d75db5db59ad5dd83b2a8b0a34
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_rosenbrock.cxx
@@ -0,0 +1,137 @@
+//-*- c++ -*-------------------------------------------------------------------
+// Module: Minimization of Rosenbrock banana function
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 31 Aug 96
+// Converted to vxl by Peter Vanroose, February 2000
+//-----------------------------------------------------------------------------
+
+#include <vcl_iostream.h>
+#include <vnl/vnl_double_2.h>
+#include <vnl/vnl_least_squares_function.h>
+#include <vnl/vnl_least_squares_cost_function.h>
+
+#include <vnl/algo/vnl_levenberg_marquardt.h>
+#include <vnl/algo/vnl_amoeba.h>
+#include <vnl/algo/vnl_powell.h>
+#include <vnl/algo/vnl_conjugate_gradient.h>
+#include <vnl/algo/vnl_lbfgs.h>
+
+// Make a compute object for the "banana" function
+// $ f(x, y) = \{ 10(y-x^2), 1-x \} $
+//
+// It is called the banana function because of the way the
+// curvature bends around the origin. It is notorious in
+// optimization examples because of the slow convergence
+// of most methods.
+
+class vnl_rosenbrock : public vnl_least_squares_function {
+public:
+ vnl_rosenbrock(): vnl_least_squares_function(2, 2, no_gradient) {}
+
+ void f(const vnl_vector<double>& x, vnl_vector<double>& fx)
+ {
+ fx[0] = 10*(x[1] - x[0]*x[0]);
+ fx[1] = 1 - x[0];
+ }
+};
+
+class vnl_rosenbrock_grad_cost_fun : public vnl_cost_function {
+public:
+ vnl_rosenbrock_grad_cost_fun(): vnl_cost_function(2) {}
+
+ double f(const vnl_vector<double>& x) {
+ double a = 10*(x[1] - x[0]*x[0]);
+ double b = 1 - x[0];
+ return a*a + b*b;
+ }
+
+ void gradf(const vnl_vector<double>& x, vnl_vector<double>& g) {
+ double a = 10*(x[1] - x[0]*x[0]);
+ double b = 1 - x[0];
+ g[0] = 2 * a * (-20*x[0]) - 2 * b;
+ g[1] = 20 * a;
+ }
+};
+
+int main()
+{
+ // Set up a Rosenbrock compute object
+ vnl_rosenbrock f;
+
+ // Set up the initial guess
+ vnl_double_2 x0(-1.9, 2);
+
+ // Temp variable.
+ vnl_vector<double> x(2);
+
+ // Make a Levenberg Marquardt minimizer, attach f to it, and
+ // run the minimization
+ x = x0;
+ vnl_levenberg_marquardt levmarq(f);
+ levmarq.minimize(x);
+
+ // Summarize the results, by querying the levmarq object.
+ vcl_cout << "** LevenbergMarquardt default **" << vcl_endl;
+ vcl_cout << "Rosenbrock min of " << levmarq.get_end_error() << " at " << x << vcl_endl;
+ vcl_cout << "Iterations: " << levmarq.get_num_iterations() << " ";
+ vcl_cout << "Evaluations: " << levmarq.get_num_evaluations() << vcl_endl;
+
+ levmarq.diagnose_outcome();
+
+ // Now rerun the optimizer with a new, looser, X tolerance.
+ //
+ levmarq.set_x_tolerance(0.1);
+ x = x0;
+ levmarq.minimize(x);
+
+ // Summarize the results. It has taken fewer iterations to reach the same
+ // answer.
+ vcl_cout << "** LevenbergMarquardt xtol=0.1 **" << vcl_endl
+ << "Rosenbrock min of " << levmarq.get_end_error() << " at " << x << vcl_endl
+ << "Iterations: " << levmarq.get_num_iterations() << " "
+ << "Evaluations: " << levmarq.get_num_evaluations() << vcl_endl;
+ levmarq.diagnose_outcome();
+
+ {
+ // Make a vnl_cost_function, and use vnl_amoeba
+ vcl_cout << "** Amoeba (Nelder Meade downhill simplex) ** \n";
+ vnl_least_squares_cost_function cf(&f);
+ vnl_amoeba amoeba(cf);
+ x = x0;
+ amoeba.minimize(x);
+ vcl_cout << "Rosenbrock min of " << cf.f(x) << " at " << x << vcl_endl
+ << "Evaluations: " << amoeba.get_num_evaluations() << vcl_endl;
+ }
+ {
+ vcl_cout << "** Conjugate Gradient ** \n";
+ vnl_rosenbrock_grad_cost_fun rcf;
+ vnl_conjugate_gradient cg(rcf);
+ x = x0;
+ cg.minimize(x);
+ vcl_cout << "CG min of " << rcf.f(x) << " at " << x << vcl_endl;
+ cg.diagnose_outcome();
+ }
+
+ {
+ vcl_cout << "** LBFGS (Limited memory Broyden Fletcher Goldfarb Shanno) ** \n";
+ vnl_rosenbrock_grad_cost_fun rcf;
+ vnl_lbfgs lbfgs(rcf);
+ x = x0;
+ lbfgs.minimize(x);
+ // assert(lbfgs.get_end_error() == rcf.f(x));
+ vcl_cout << "L-BFGS min of " << lbfgs.get_end_error() << " at " << x << vcl_endl
+ << "Evaluations: " << lbfgs.get_num_evaluations() << vcl_endl;
+ }
+
+ {
+ vcl_cout << "** Powell (Powell's direction set method) ** \n";
+ vnl_rosenbrock_grad_cost_fun rcf;
+ vnl_powell powell(&rcf);
+ x = x0;
+ powell.minimize(x);
+ // assert(lbfgs.get_end_error() == rcf.f(x));
+ vcl_cout << "Powell min of " << powell.get_end_error() << " at " << x << vcl_endl
+ << "Evaluations: " << powell.get_num_evaluations() << vcl_endl;
+ }
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e390cd984c3cc171ac25425c395322dc4eec7e5c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd.cxx
@@ -0,0 +1,31 @@
+// Solve LS problem M x = B, warning if M is nearly singular.
+// Peter Vanroose, February 2000
+
+#include <vcl_iostream.h>
+#include <vnl/algo/vnl_svd.h>
+
+template <class D> // D is often double or float
+vnl_matrix<D> solve_with_warning(vnl_matrix<D>const& M,
+ vnl_matrix<D>const& B)
+{
+ // Take svd of vnl_matrix<D> M, setting singular values
+ // smaller than 1e-8 to 0, and hold the result.
+ vnl_svd<D> svd(M, 1e-8);
+ // Check for rank-deficiency
+ if (svd.singularities() > 1)
+ vcl_cerr << "Warning: Singular matrix, condition = " << svd.well_condition() << vcl_endl;
+ return svd.solve(B);
+}
+
+template vnl_matrix<double> solve_with_warning(vnl_matrix<double>const&,vnl_matrix<double>const&);
+
+int main() {
+ double data[] = { 1, 1, 1, 1, 2, 3, 1, 3, 6};
+ vnl_matrix<double> M (data, 3, 3);
+ vnl_matrix<double> B (3, 1, 7.0); // column vector [7 7 7]^T
+ vnl_matrix<double> result = solve_with_warning(M,B);
+ vcl_cerr << result << vcl_endl;
+ M(2,2)=5; result = solve_with_warning(M,B);
+ vcl_cerr << result << vcl_endl;
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd_economy.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd_economy.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bca6fb3be921b863ffb01551b9af6b13f690120b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/examples/vnl_svd_economy.cxx
@@ -0,0 +1,56 @@
+#include <vcl_iostream.h>
+#include <vul/vul_timer.h>
+#include <vnl/vnl_random.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/algo/vnl_svd.h>
+#include <vnl/algo/vnl_svd_economy.h>
+
+int main()
+{
+ vnl_random rng(9667566ul);
+ {
+ vnl_matrix<double> M( 10, 4 );
+ for (unsigned int i=0 ; i < M.size(); ++i) {
+ M.data_block()[i] = rng.drand64(-1.0,1.0);
+ }
+
+ vnl_svd<double> svd( M );
+ vnl_svd_economy<double> svd_e( M );
+
+ vnl_matlab_print( vcl_cerr, svd.V() );
+ vcl_cerr << vcl_endl;
+ vnl_matlab_print( vcl_cerr, svd_e.V() );
+ vcl_cerr << vcl_endl << vcl_endl;
+
+ vnl_matlab_print( vcl_cerr, svd.W().diagonal() );
+ vcl_cerr << vcl_endl;
+ vnl_matlab_print( vcl_cerr, svd_e.lambdas() );
+
+ vcl_cerr << "\n( svd.V() - svd_e.V() ).fro_norm() = " << ( svd.V() - svd_e.V() ).fro_norm()
+ << "\n( svd.W().diagonal() - svd_e.lambdas() ).two_norm() = "
+ << ( svd.W().diagonal() - svd_e.lambdas() ).two_norm() << vcl_endl;
+ }
+
+ {
+ vnl_matrix<double> N( 2000, 12 );
+ for (unsigned int i=0 ; i < N.size(); ++i)
+ N.data_block()[i] = rng.drand64(-1.0,1.0);
+
+ vul_timer timer;
+ for (int i=0; i < 1000; ++i)
+ vnl_svd<double> svd( N );
+
+ int t1 = timer.user();
+ timer.mark();
+ for (int i=0; i < 1000; ++i)
+ vnl_svd_economy<double> svd_e( N );
+
+ int t2 = timer.user();
+
+ vcl_cerr << "time for 1000*svd(1000x10) : vnl_svd = " << t1 << " msec, "
+ << "vnl_svd_economy = " << t2 << " msec.\n";
+ }
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/introduction_doxy.txt b/Utilities/ITK/Utilities/vxl/core/vnl/introduction_doxy.txt
new file mode 100644
index 0000000000000000000000000000000000000000..3395fe61493af54b675fd4f7b5b6a79189cfc2ae
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/introduction_doxy.txt
@@ -0,0 +1,80 @@
+// The following text is included in the main documentation page by doxygen
+/*! \mainpage vnl : Numerics Library
+* The numerics library, vnl is intended to provide an environment for numerical
+* programming which combines the ease of use of packages like Mathematica and
+* Matlab with the speed of C and the elegance of C++.
+* It provides a C++ interface to the high-quality Fortran routines made available
+* in the public domain by numerical analysis researchers.
+*
+* Matrix and vector classes include
+* - vnl_vector<T> : Standard vector class
+* - vnl_matrix<T> : Standard matrix class
+* - vnl_vector_fixed<T,N> : Fixed size vector class (of length N)
+* - vnl_matrix_fixed<T,N,M> : Fixed size NxM matrix class
+* - vnl_vector_ref<T> : Wrap user-supplied memory chunk as a vector
+* - vnl_matrix_ref<T> : Wrap user-supplied memory chunk as a matrix
+*
+* Functions to generate special matrixes:
+* - vnl_identity
+* - vnl_rotation_matrix
+* - vnl_cross_product_matrix
+*
+* Matrix decompositions include
+* - vnl_svd and vnl_svd_economy : Singular value decomposition
+* - vnl_qr : QR decomposition
+* - vnl_cholesky : Cholesky decomposition (for symmetric matrices)
+* - vnl_symmetric_eigensystem : Eigen-decomposition
+* - vnl_real_eigensystem : Eigen-decomposition
+* - vnl_complex_eigensystem : Eigen-decomposition
+* - vnl_generalized_eigensystem : Eigen-decomposition
+* - vnl_sparse_symmetric_eigensystem
+* - vnl_generalized_schur
+*
+* Optimisation routines include
+* - vnl_amoeba : Downhill simplex algorithm
+* - vnl_lsqr
+* - vnl_brent
+* - vnl_conjugate_gradient
+* - vnl_lbfgs
+* - vnl_levenberg_marquardt
+* - vnl_powell
+*
+* Support for manipulating polynomials
+* - vnl_real_polynomial
+* - vnl_real_npolynomial
+* - vnl_rnpoly_solve
+* - vnl_rpoly_roots
+* - vnl_cpoly_roots
+*
+* Useful utility functions
+* - Common functions and constants (in vnl_math)
+* - vnl_fft_1d : 1D Fast Fourier Transform
+* - vnl_fft_2d : 2D Fast Fourier Transform
+* - vnl_convolve
+* - vnl_random : random number generation, with normal and box distributions.
+* - vnl_gamma, vnl_gamma_p, vnl_gamma_q : gamma functions
+* - vnl_erf
+* - vnl_chi_squared : CDF of chi-squared distribution
+*
+* Simple matrix operations
+* - vnl_transpose : transpose of a matrix for direct use in a multiplication
+* - vnl_adjugate : return the adjugate matrix
+* - vnl_rank, vnl_rank_row_reduce and vnl_rank_column_reduce
+* - vnl_trace
+* - vnl_unary_function
+* - vnl_cross
+* - vnl_det and vnl_determinant
+* - vnl_inverse, vnl_inverse_transpose and vnl_matrix_inverse
+* - vnl_orthogonal_complement
+*
+* Alternative number representations
+* - vnl_complex
+* - vnl_quaternion
+* - vnl_rational
+* - vnl_bignum
+* - vnl_finite
+*
+* \section Lead Developer
+* Amitha Perera is responsible for co-ordinating significant changes to vnl.
+* http://sourceforge.net/sendmessage.php?touser=237910
+*/
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/io/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..96461c579df38e48b9c309f8f3beb85162561c3b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/CMakeLists.txt
@@ -0,0 +1,33 @@
+# vxl/vnl/io/CMakeLists.txt
+
+SET(vnl_io_sources
+ vnl_io_nonlinear_minimizer.cxx vnl_io_nonlinear_minimizer.h
+ vnl_io_real_npolynomial.cxx vnl_io_real_npolynomial.h
+ vnl_io_real_polynomial.cxx vnl_io_real_polynomial.h
+ vnl_io_rational.cxx vnl_io_rational.h
+ vnl_io_bignum.cxx vnl_io_bignum.h
+
+ vnl_io_diag_matrix.txx vnl_io_diag_matrix.h
+ vnl_io_matrix.txx vnl_io_matrix.h
+ vnl_io_sparse_matrix.txx vnl_io_sparse_matrix.h
+ vnl_io_sym_matrix.txx vnl_io_sym_matrix.h
+ vnl_io_vector.txx vnl_io_vector.h
+ vnl_io_vector_fixed.txx vnl_io_vector_fixed.h
+
+ vnl_io_matrix_fixed.txx vnl_io_matrix_fixed.h
+)
+
+AUX_SOURCE_DIRECTORY(Templates vnl_io_sources)
+
+IF(CMAKE_COMPILER_IS_GNUCXX)
+ SET_SOURCE_FILES_PROPERTIES(Templates/vsl_vector_io+vcl_vector+vcl_vector+vnl_vector+double----.cxx
+ PROPERTIES
+ COMPILE_FLAGS -ftemplate-depth-35)
+ENDIF(CMAKE_COMPILER_IS_GNUCXX)
+
+ADD_LIBRARY(vnl_io ${vnl_io_sources} )
+TARGET_LINK_LIBRARIES( vnl_io vnl vsl )
+
+IF(BUILD_TESTING)
+ SUBDIRS(tests)
+ENDIF(BUILD_TESTING)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..40bada78118011f7663b7e6545ef0376e965afe9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+double-.cxx
@@ -0,0 +1,3 @@
+// Instantiation of IO for vnl_diag_matrix<double>
+#include <vnl/io/vnl_io_diag_matrix.txx>
+VNL_IO_DIAG_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..938d744174645d23b64a281aa1a356264a582206
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+float-.cxx
@@ -0,0 +1,3 @@
+// Instantiation of IO for vnl_diag_matrix<float>
+#include <vnl/io/vnl_io_diag_matrix.txx>
+VNL_IO_DIAG_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4f4d69ae7f5bb861b560291b270ccdbe6887bae2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+int-.cxx
@@ -0,0 +1,3 @@
+// Instantiation of IO for vnl_diag_matrix<int>
+#include <vnl/io/vnl_io_diag_matrix.txx>
+VNL_IO_DIAG_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+double--.cxx0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+double--.cxx0000644
new file mode 100644
index 0000000000000000000000000000000000000000..77f31e7ce720be37943053bee864b4d34108a14f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+double--.cxx0000644
@@ -0,0 +1,5 @@
+// Instantiation of IO for vnl_diag_matrix<vcl_complex<double> >
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_diag_matrix.txx>
+
+VNL_IO_DIAG_MATRIX_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..90506fdf9c6715a03460d17be0845966c2dbfd1b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_diag_matrix+vcl_complex+float--.cxx
@@ -0,0 +1,6 @@
+// Instantiation of IO for vnl_diag_matrix<vcl_complex<float> >
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_diag_matrix.txx>
+
+VNL_IO_DIAG_MATRIX_INSTANTIATE(vcl_complex<float>);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..59e6b3e7615618645819ed567e79f1ff8d8cd07f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ad1f26c8d158d13c968ca2d8eca29093c6af055a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ad38e351f629100ee262f22530185269740c1337
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+long-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+long-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e45d8c2ec467cdab043beec9327daf6a891e7fdc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+long-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+schar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+schar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9c0cb3f87e366f40797b82aa7a7284b3381f381f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+schar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(signed char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uchar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uchar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a53014a116394db76c38f19b00b6b0a233b03eb4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uchar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(unsigned char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f3ec79d7d2f3cc33f37a0f3a79b9a15e6f435923
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+uint-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+ulong-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+ulong-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..724d9e899111826b965e2c4a49f0de5bd00cbf60
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+ulong-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix.txx>
+VNL_IO_MATRIX_INSTANTIATE(unsigned long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d63b6b4adbec6dfd90af883f33cbd2410af24ea3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+double--.cxx
@@ -0,0 +1,5 @@
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_matrix.txx>
+#include <vsl/vsl_complex_io.h>
+
+VNL_IO_MATRIX_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..526cd0bc9bd2b206c7fcfae7e19f605e14185d96
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix+vcl_complex+float--.cxx
@@ -0,0 +1,5 @@
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_matrix.txx>
+#include <vsl/vsl_complex_io.h>
+
+VNL_IO_MATRIX_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.2.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.2.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7cb2f3da59db6fae57a7961328364a329a3fee16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.2.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix_fixed.txx>
+VNL_IO_MATRIX_FIXED_INSTANTIATE(double,2,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.3.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.3.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..902ef6ef5329d7f59f0206c58270abaada9d5dfc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_matrix_fixed+double.3.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_matrix_fixed.txx>
+VNL_IO_MATRIX_FIXED_INSTANTIATE(double,3,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9b05197dce1d685615235c89006aee58d0b3f22b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+double-.cxx
@@ -0,0 +1,3 @@
+// Instantiation of IO for vnl_sparse_matrix<double>
+#include <vnl/io/vnl_io_sparse_matrix.txx>
+VNL_IO_SPARSE_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3776db4853b78cae25767f4fa8f6ab98d3cad4bd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sparse_matrix+float-.cxx
@@ -0,0 +1,3 @@
+// Instantiation of IO for vnl_sparse_matrix<float>
+#include <vnl/io/vnl_io_sparse_matrix.txx>
+VNL_IO_SPARSE_MATRIX_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4bef671eb69df0dca175a03cfb3b8952dead3907
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_sym_matrix.txx>
+VNL_IO_SYM_MATRIX_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..205af43bfccfa2b18c0edfcf5169703e91794c51
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_sym_matrix+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_sym_matrix.txx>
+VNL_IO_SYM_MATRIX_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+double-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+double-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..66b8e1d5b80fa1e8ed9d4b6a1bac45828c04d1de
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+double-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(double);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+float-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+float-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..15b2c3aa92acaf62d60c06f9e1d123ba82e18f5d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+float-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+int-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+int-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8bde1b65b55619ee88d84295519f6094c8f71016
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+int-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+long-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+long-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e1615ee4042e52ceda9ab62dba6897374b60efa5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+long-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+schar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+schar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..65be7cac7f3e8fab689f83df0519f3951e0ec412
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+schar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(signed char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uchar-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uchar-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..49431f5e1574f96fbf3b8f28b8cd5a5b3a343199
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uchar-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(unsigned char);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uint-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uint-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..cbad58ab9df141074dbe3e788f686ac64c9c3e40
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+uint-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(unsigned int);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+ulong-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+ulong-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5d7a2330f937400ebd3bed48e69ffe8165911837
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+ulong-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector.txx>
+VNL_IO_VECTOR_INSTANTIATE(unsigned long);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9116f440377c6b0f2f993d598d5865d25b2b0e24
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+double--.cxx
@@ -0,0 +1,5 @@
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_vector.txx>
+#include <vsl/vsl_complex_io.h>
+
+VNL_IO_VECTOR_INSTANTIATE(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+float--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+float--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..927dc55cb399dc8fca7877283548f61e811cc1df
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector+vcl_complex+float--.cxx
@@ -0,0 +1,5 @@
+#include <vcl_complex.h>
+#include <vnl/io/vnl_io_vector.txx>
+#include <vsl/vsl_complex_io.h>
+
+VNL_IO_VECTOR_INSTANTIATE(vcl_complex<float>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.2-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.2-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..98fffec87346b80a4a639d314c669dedd677581b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.2-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector_fixed.txx>
+VNL_IO_VECTOR_FIXED_INSTANTIATE(double,2);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.3-.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.3-.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f5b0faba728b04dffb5b68297bb95c018572015e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vnl_io_vector_fixed+double.3-.cxx
@@ -0,0 +1,2 @@
+#include <vnl/io/vnl_io_vector_fixed.txx>
+VNL_IO_VECTOR_FIXED_INSTANTIATE(double,3);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vcl_vector+vcl_vector+vnl_vec0000644 b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vcl_vector+vcl_vector+vnl_vec0000644
new file mode 100644
index 0000000000000000000000000000000000000000..9b58c1d76de9fcc668123cbdb182a1f7904b248c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vcl_vector+vcl_vector+vnl_vec0000644
@@ -0,0 +1,5 @@
+#include <vsl/vsl_vector_io.txx>
+#include <vnl/io/vnl_io_vector.h>
+
+typedef vcl_vector < vcl_vector< vnl_vector<double> > > cvec_cvec_nvec_double;
+VSL_VECTOR_IO_INSTANTIATE( cvec_cvec_nvec_double );
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_matrix+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_matrix+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2e5298217e6c4a25e867e67c3a413dc77a1c6f96
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_matrix+double--.cxx
@@ -0,0 +1,3 @@
+#include <vsl/vsl_vector_io.txx>
+#include <vnl/io/vnl_io_matrix.h>
+VSL_VECTOR_IO_INSTANTIATE(vnl_matrix<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_vector+double--.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_vector+double--.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f902fc38377f1db5645619ec3ea7c4b14e0722f5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/Templates/vsl_vector_io+vnl_vector+double--.cxx
@@ -0,0 +1,4 @@
+#include <vsl/vsl_vector_io.txx>
+#include <vnl/io/vnl_io_vector.txx>
+VSL_VECTOR_IO_INSTANTIATE( vnl_vector<double> );
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..f4b13bc761c2fe10ae937b5c725e524ce507e2aa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/CMakeLists.txt
@@ -0,0 +1,41 @@
+# This is core/vnl/io/tests/CMakeLists.txt
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/core/vnl/io/tests)
+
+ADD_EXECUTABLE( vnl_io_test_all
+ # Driver source
+ test_driver.cxx
+
+ # The tests
+ golden_test_vnl_io.cxx
+ test_bignum_io.cxx
+ test_diag_matrix_io.cxx
+ test_matrix_fixed_io.cxx
+ test_matrix_io.cxx
+ test_nonlinear_minimizer_io.cxx
+ test_rational_io.cxx
+ test_real_npolynomial_io.cxx
+ test_real_polynomial_io.cxx
+ test_sparse_matrix_io.cxx
+ test_sym_matrix_io.cxx
+ test_vector_fixed_io.cxx
+ test_vector_io.cxx
+)
+
+TARGET_LINK_LIBRARIES( vnl_io_test_all vnl_io vsl testlib vpl )
+
+ADD_TEST( vnl_io_test_bignum_io vnl_io_test_all test_bignum_io )
+ADD_TEST( vnl_io_test_diag_matrix_io vnl_io_test_all test_diag_matrix_io )
+ADD_TEST( vnl_io_test_matrix_fixed_io vnl_io_test_all test_matrix_fixed_io )
+ADD_TEST( vnl_io_test_matrix_io vnl_io_test_all test_matrix_io )
+ADD_TEST( vnl_io_test_nonlinear_minimizer_io vnl_io_test_all test_nonlinear_minimizer_io )
+ADD_TEST( vnl_io_test_rational_io vnl_io_test_all test_rational_io )
+ADD_TEST( vnl_io_test_real_npolynomial_io vnl_io_test_all test_real_npolynomial_io )
+ADD_TEST( vnl_io_test_real_polynomial_io vnl_io_test_all test_real_polynomial_io )
+ADD_TEST( vnl_io_test_sparse_matrix_io vnl_io_test_all test_sparse_matrix_io )
+ADD_TEST( vnl_io_test_sym_matrix_io vnl_io_test_all test_sym_matrix_io )
+ADD_TEST( vnl_io_test_vector_fixed_io vnl_io_test_all test_vector_fixed_io )
+ADD_TEST( vnl_io_test_vector_io vnl_io_test_all test_vector_io )
+ADD_TEST( vnl_io_golden_test_vnl_io vnl_io_test_all golden_test_vnl_io )
+
+ADD_EXECUTABLE( vnl_io_test_include test_include.cxx )
+TARGET_LINK_LIBRARIES( vnl_io_test_include vnl_io )
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.bvl b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.bvl
new file mode 100644
index 0000000000000000000000000000000000000000..0e71c1fe024aaafd35acce7926e10013fb7e02fd
Binary files /dev/null and b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.bvl differ
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..31ccc8ac1ee01555cd0d00ab2ec68ada4d9554c9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/golden_test_vnl_io.cxx
@@ -0,0 +1,202 @@
+// This is core/vnl/io/tests/golden_test_vnl_io.cxx
+
+//:
+// \file
+// \brief Read in a golden data file, and check the values are correct.
+//
+// If you need to recreate the golden data file, run this test with
+// the single parameter "create":
+// \verbatim
+// golden_test_vnl_io create
+// \endverbatim
+
+#include <vcl_string.h>
+#include <vcl_cstdlib.h> // for vcl_exit()
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/io/vnl_io_vector.h>
+#include <vnl/io/vnl_io_vector_fixed.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/io/vnl_io_matrix.h>
+#include <vnl/io/vnl_io_matrix_fixed.h>
+#include <vnl/io/vnl_io_diag_matrix.h>
+#include <vnl/io/vnl_io_real_npolynomial.h>
+#include <vnl/io/vnl_io_real_polynomial.h>
+#include <vnl/io/vnl_io_sparse_matrix.h>
+#include <testlib/testlib_root_dir.h>
+#include <testlib/testlib_test.h>
+
+static void golden_test_vnl_io(bool save_file)
+{
+ vcl_cout << "***********************************************************\n"
+ << " Testing a golden data file for cross platform consistency\n"
+ << "***********************************************************\n";
+
+
+ //-----------------------------------------------------------------------------------
+ // Create objects:
+ // If the "create" flag was used on the command line, then the program saves an example
+ // of each class
+ // Otherwise it just fills them with values for comparison to the values read in.
+ //------------------------------------------------------------------------------------
+
+ // vnl_vector
+ const int n_vec = 50;
+ vnl_vector<double> v_out(n_vec),v_in;
+
+ for (int i=0; i<n_vec; i++)
+ {
+ v_out(i) = (double)(i*i);
+ }
+
+ // vnl_matrix
+ const int m_mat = 10;
+ const int n_mat = 6;
+ vnl_matrix<double> m_out(m_mat, n_mat), m_in;
+
+ for (int i=0; i<m_mat; i++)
+ {
+ for (int j=0; j<n_mat; j++)
+ {
+ m_out(i,j) = (double)(i*j+i);
+ }
+ }
+
+ // vnl_diag_matrix
+ vnl_diag_matrix<double> diag_mat_out(v_out), diag_mat_in;
+
+ // vnl_matrix_fixed
+ double datablock[4] = {
+ 1.1, 1.2,
+ 2.1, 2.2
+ };
+ vnl_matrix_fixed<double,2,2> m_fixed_out(datablock), m_fixed_in;
+
+ // vnl_real_n_polynomial
+ vnl_vector<double> coeffs(4);
+ vnl_matrix<unsigned int> exponents(4,2);
+
+ coeffs(0) = 0.1;
+ coeffs(1) = 0.2;
+ coeffs(2) = 0.3;
+ coeffs(3) = 0.5;
+
+ exponents(0,0) = 1;
+ exponents(1,0) = 2;
+ exponents(2,0) = 3;
+ exponents(3,0) = 4;
+ exponents(0,1) = 5;
+ exponents(1,1) = 6;
+ exponents(2,1) = 7;
+ exponents(3,1) = 8;
+
+
+ vnl_real_npolynomial polyn_out(coeffs, exponents), polyn_in;
+
+ // vnl_real_polynomial
+ vnl_real_polynomial poly_out(v_out), poly_in(0);
+
+ // vnl_sparse_matrix
+ vnl_sparse_matrix<double> m_sparse_out(3,3), m_sparse_in(3,3);
+ vcl_vector<int> col_1(3);
+ vcl_vector<int> col_2(2);
+ vcl_vector<int> col_3(1);
+
+ col_1[0]=1;
+ col_1[1]=2;
+ col_1[2]=3;
+ col_2[0]=1;
+ col_2[1]=3;
+ col_3[0]=2;
+
+ vcl_vector<double> val_1(3);
+ vcl_vector<double> val_2(2);
+ vcl_vector<double> val_3(1);
+
+ val_1[0]=1.1;
+ val_1[1]=1.2;
+ val_1[2]=1.3;
+ val_2[0]=2.1;
+ val_2[1]=2.3;
+ val_3[0]=3.2;
+
+ m_sparse_out.set_row(0, col_1, val_1);
+ m_sparse_out.set_row(1, col_2, val_2);
+ m_sparse_out.set_row(2, col_3, val_3);
+
+
+ // vnl_vector_fixed
+ vnl_vector_fixed<double,3> v_fixed_out(1.2,3.4,5.6), v_fixed_in;
+
+ // Save if option set
+ if (save_file)
+ {
+ vsl_b_ofstream bfs_out("golden_test_vnl_io.bvl");
+ TEST ("Opened golden_test_vnl_io.bvl for writing ", ! bfs_out, false);
+ if (!bfs_out)
+ {
+ vcl_cerr<<"Problems opening file for output - exiting\n";
+ vcl_exit(1);
+ }
+ vsl_b_write(bfs_out, v_out);
+ vsl_b_write(bfs_out, m_out);
+ vsl_b_write(bfs_out, diag_mat_out);
+ vsl_b_write(bfs_out, m_fixed_out);
+ vsl_b_write(bfs_out, polyn_out);
+ vsl_b_write(bfs_out, poly_out);
+ vsl_b_write(bfs_out, m_sparse_out);
+ vsl_b_write(bfs_out, v_fixed_out);
+ bfs_out.close();
+ }
+
+ // Read in file to each class in turn
+ vcl_string gold_path=testlib_root_dir()+"/core/vnl/io/tests/golden_test_vnl_io.bvl";
+ vsl_b_ifstream bfs_in(gold_path.c_str());
+ TEST ("Opened golden_test_vnl_io.bvl for reading ", ! bfs_in, false);
+ vsl_b_read(bfs_in, v_in);
+ vsl_b_read(bfs_in, m_in);
+ vsl_b_read(bfs_in, diag_mat_in);
+ vsl_b_read(bfs_in, m_fixed_in);
+ vsl_b_read(bfs_in, polyn_in);
+ vsl_b_read(bfs_in, poly_in);
+ vsl_b_read(bfs_in, m_sparse_in);
+ vsl_b_read(bfs_in, v_fixed_in);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+
+ // Test that each object created is the same as read in from the file.
+ TEST ("v_out == v_in", v_out == v_in, true);
+ TEST ("m_out == m_in", m_out == m_in, true);
+ TEST ("diag_mat_out == diag_mat_in", diag_mat_out.diagonal() == diag_mat_in.diagonal(), true);
+ TEST ("m_fixed_out == m_fixed_in", m_fixed_out == m_fixed_in, true);
+ TEST ("polyn_out == polyn_in", poly_out.coefficients() == poly_in.coefficients(), true);
+ TEST ("poly_out == poly_in", poly_out.coefficients() == poly_in.coefficients(), true);
+
+
+ //Code to compare sparse matrices
+ m_sparse_out.reset();
+ m_sparse_in.reset();
+ bool test_result=true;
+
+ while (m_sparse_out.next() && m_sparse_in.next())
+ {
+ if (m_sparse_out.getrow()!=m_sparse_in.getrow() || m_sparse_out.getcolumn() != m_sparse_in.getcolumn()
+ || m_sparse_out.value()!= m_sparse_in.value())
+ {
+ test_result=false;
+ break;
+ }
+ }
+
+ TEST ("m_sparse_out == m_sparse_in",test_result , true);
+ TEST ("v_fixed_out == v_fixed_in", v_fixed_out == v_fixed_in, true);
+}
+
+
+static void golden_test_vnl_io(int argc, char* argv[])
+{
+ golden_test_vnl_io(argc==2 && vcl_string(argv[1])==vcl_string("create"));
+}
+
+TESTMAIN_ARGS(golden_test_vnl_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_bignum_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_bignum_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..441ad1b2a58dec1db452aeae3c087dbda0a0ed47
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_bignum_io.cxx
@@ -0,0 +1,61 @@
+// This is core/vnl/io/tests/test_bignum_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_bignum.h>
+#include <vnl/io/vnl_io_bignum.h>
+#include <vsl/vsl_binary_io.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_bignum_io()
+{
+ vcl_cout << "**************\n"
+ << "test_bignum_io\n"
+ << "**************\n";
+
+ vnl_bignum nil(0), big(-3245444l), verybig("4235702934875938745092384750293845"),
+ p_inf("Infinity"), m_inf("-Inf");
+
+ vsl_b_ofstream bfs_out("vnl_bignum_test_io.bvl.tmp");
+ TEST ("Created vnl_bignum_test_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, nil);
+ vsl_b_write(bfs_out, big);
+ vsl_b_write(bfs_out, verybig);
+ vsl_b_write(bfs_out, p_inf);
+ vsl_b_write(bfs_out, m_inf);
+ bfs_out.close();
+
+ vnl_bignum r1, r2, r3, r4, r5;
+ vsl_b_ifstream bfs_in("vnl_bignum_test_io.bvl.tmp");
+ TEST ("Opened vnl_bignum_test_io.bvl.tmp for reading",
+ (!bfs_in), false);
+ vsl_b_read(bfs_in, r1);
+ vsl_b_read(bfs_in, r2);
+ vsl_b_read(bfs_in, r3);
+ vsl_b_read(bfs_in, r4);
+ vsl_b_read(bfs_in, r5);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_bignum_test_io.bvl.tmp");
+
+ TEST ("equality 0", nil, r1);
+ TEST ("equality -3245444", big, r2);
+ TEST ("equality 4235702934875938745092384750293845", verybig, r3);
+ TEST ("equality +Infinity", p_inf, r4);
+ TEST ("equality -Infinity", m_inf, r5);
+
+ vcl_cout << "\n0 summary: ";
+ vsl_print_summary(vcl_cout, nil);
+ vcl_cout << "\n-3245444 summary: ";
+ vsl_print_summary(vcl_cout, r2);
+ vcl_cout << "\n4235702934875938745092384750293845 summary: ";
+ vsl_print_summary(vcl_cout, verybig);
+ vcl_cout << "\n+Infinity summary: ";
+ vsl_print_summary(vcl_cout, r4);
+ vcl_cout << "\n-Infinity summary: ";
+ vsl_print_summary(vcl_cout, m_inf);
+ vcl_cout << vcl_endl;
+}
+
+TESTMAIN(test_bignum_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_diag_matrix_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_diag_matrix_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3a1c613979d9e16399ae5f81139f0a1e67bc28a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_diag_matrix_io.cxx
@@ -0,0 +1,58 @@
+// This is core/vnl/io/tests/test_diag_matrix_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vnl/io/vnl_io_diag_matrix.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_diag_matrix_double_io()
+{
+ vcl_cout << "*******************\n"
+ << "test_diag_matrix_io\n"
+ << "*******************\n";
+ //// test constructors, accessors
+ const int n = 50;
+ vnl_vector<double> v_out(n), v_in(n);
+
+ for (int i=0; i<n; i++)
+ {
+ v_in(i) = (double)(i); // Different to check things change
+ v_out(i) = (double)(i*i);
+ }
+
+ vnl_diag_matrix<double> diag_mat_out(v_out), diag_mat_in(v_in);
+
+ vsl_print_summary(vcl_cout, diag_mat_out);
+ vcl_cout << vcl_endl;
+
+ vsl_b_ofstream bfs_out("vnl_diag_matrix_test_io.bvl.tmp");
+ TEST ("Created vnl_diag_matrix_test_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, diag_mat_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_diag_matrix_test_io.bvl.tmp");
+ TEST ("Opened vnl_diag_matrix_test_io.bvl.tmp for reading",
+ (!bfs_in), false);
+ vsl_b_read(bfs_in, diag_mat_in);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_diag_matrix_test_io.bvl.tmp");
+
+ TEST ("diag_mat_out.diagonal() == diag_mat_in.diagonal()",
+ diag_mat_out.diagonal() == diag_mat_in.diagonal(), true);
+
+
+ vsl_print_summary(vcl_cout, diag_mat_out);
+ vcl_cout << vcl_endl;
+}
+
+void test_diag_matrix_io()
+{
+ test_diag_matrix_double_io();
+}
+
+TESTMAIN( test_diag_matrix_io );
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_driver.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_driver.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7b296cc7f70e74c1a4bc39b6eb12ed1e96e62b87
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_driver.cxx
@@ -0,0 +1,35 @@
+#include <testlib/testlib_register.h>
+
+DECLARE( test_bignum_io );
+DECLARE( test_diag_matrix_io );
+DECLARE( test_matrix_fixed_io );
+DECLARE( test_matrix_io );
+DECLARE( test_nonlinear_minimizer_io );
+DECLARE( test_rational_io );
+DECLARE( test_real_npolynomial_io );
+DECLARE( test_real_polynomial_io );
+DECLARE( test_sparse_matrix_io );
+DECLARE( test_sym_matrix_io );
+DECLARE( test_vector_fixed_io );
+DECLARE( test_vector_io );
+DECLARE( golden_test_vnl_io );
+
+void
+register_tests()
+{
+ REGISTER( test_bignum_io );
+ REGISTER( test_diag_matrix_io );
+ REGISTER( test_matrix_fixed_io );
+ REGISTER( test_matrix_io );
+ REGISTER( test_nonlinear_minimizer_io );
+ REGISTER( test_rational_io );
+ REGISTER( test_real_npolynomial_io );
+ REGISTER( test_real_polynomial_io );
+ REGISTER( test_sparse_matrix_io );
+ REGISTER( test_sym_matrix_io );
+ REGISTER( test_vector_fixed_io );
+ REGISTER( test_vector_io );
+ REGISTER( golden_test_vnl_io );
+}
+
+DEFINE_MAIN;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_include.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_include.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..29746eaa169e710fb235a3146455e899510215ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_include.cxx
@@ -0,0 +1,14 @@
+#include <vnl/io/vnl_io_real_polynomial.h>
+#include <vnl/io/vnl_io_real_npolynomial.h>
+#include <vnl/io/vnl_io_nonlinear_minimizer.h>
+#include <vnl/io/vnl_io_rational.h>
+#include <vnl/io/vnl_io_matrix.h>
+#include <vnl/io/vnl_io_diag_matrix.h>
+#include <vnl/io/vnl_io_sparse_matrix.h>
+#include <vnl/io/vnl_io_sym_matrix.h>
+#include <vnl/io/vnl_io_vector.h>
+#include <vnl/io/vnl_io_bignum.h>
+#include <vnl/io/vnl_io_matrix_fixed.h>
+#include <vnl/io/vnl_io_vector_fixed.h>
+
+int main() { return 0; }
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_fixed_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_fixed_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..082602bc838d4ba26085d7538cf24dd9ca120cd5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_fixed_io.cxx
@@ -0,0 +1,55 @@
+// This is core/vnl/io/tests/test_matrix_fixed_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/io/vnl_io_matrix_fixed.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_matrix_fixed_double_2_2_io()
+{
+ vcl_cout << "***************************************\n"
+ << "Testing vnl_matrix_fixed<double,2,2> io\n"
+ << "***************************************\n";
+ //// test constructors, accessors
+ double datablock[4] = {
+ 1.1, 1.2,
+ 2.1, 2.2
+ };
+ vnl_matrix_fixed<double,2,2> m_out(datablock), m_in0,m_in1;
+
+ // Give some initial content
+ m_in1 = m_out * 2.0;
+
+ vsl_b_ofstream bfs_out("vnl_matrix_fixed_io.bvl.tmp",
+ vcl_ios_out | vcl_ios_binary);
+ TEST ("vnl_matrix_fixed_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, m_out);
+ vsl_b_write(bfs_out, m_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_matrix_fixed_io.bvl.tmp",
+ vcl_ios_in | vcl_ios_binary);
+ TEST ("vnl_matrix_fixed_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, m_in0);
+ vsl_b_read(bfs_in, m_in1);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_matrix_fixed_io.bvl.tmp");
+
+ // m_in0 is initially empty
+ TEST ("m_out == m_in0", m_out, m_in0);
+ // m_in1 has content
+ TEST ("m_out == m_in1", m_out, m_in1);
+
+ vsl_print_summary(vcl_cout, m_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_matrix_fixed_io()
+{
+ test_matrix_fixed_double_2_2_io();
+}
+
+
+TESTMAIN(test_matrix_fixed_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b7bd4d206ba0866c67fb5202926b14cfe4328d78
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_matrix_io.cxx
@@ -0,0 +1,60 @@
+// This is core/vnl/io/tests/test_matrix_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/io/vnl_io_matrix.h>
+#include <vsl/vsl_binary_io.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_matrix_double_io()
+{
+ vcl_cout << "*****************************\n"
+ << "Testing vnl_matrix<double> io\n"
+ << "*****************************\n";
+ //// test constructors, accessors
+ const int m = 10;
+ const int n = 6;
+ vnl_matrix<double> m_out(m, n), m_in1(m,n),m_in2;
+
+ for (int i=0; i<m; i++)
+ {
+ for (int j=0; j<n; j++)
+ {
+ m_out(i,j) = (double)(i*j+i);
+ m_in1(i,j) = (double)(73);
+ }
+ }
+
+ vsl_b_ofstream bfs_out("vnl_matrix_test_double_io.bvl.tmp");
+ TEST("Created vnl_matrix_test_double_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, m_out);
+ vsl_b_write(bfs_out, m_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_matrix_test_double_io.bvl.tmp");
+ TEST("Opened vnl_matrix_test_double_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, m_in1);
+ vsl_b_read(bfs_in, m_in2);
+ TEST("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_matrix_test_double_io.bvl.tmp");
+
+ // m_in1 has content
+ TEST("m_out == m_in1", m_out, m_in1);
+ // m_in2 empty
+ TEST("m_out == m_in2", m_out, m_in2);
+
+ vsl_print_summary(vcl_cout, m_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_matrix_io()
+{
+ test_matrix_double_io();
+}
+
+
+TESTMAIN(test_matrix_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_nonlinear_minimizer_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_nonlinear_minimizer_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dc0d71cc27878e8a90fe6508604cad1bd9ff8332
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_nonlinear_minimizer_io.cxx
@@ -0,0 +1,74 @@
+// This is core/vnl/io/tests/test_nonlinear_minimizer_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+#include <vnl/io/vnl_io_nonlinear_minimizer.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_nonlinear_minimizer_io()
+{
+ vcl_cout << "**********************************\n"
+ << "Testing vnl_nonlinear_minimizer_io\n"
+ << "**********************************\n";
+
+ //// test constructors, accessors
+ vnl_nonlinear_minimizer minimizer_out, minimizer_in;
+
+ // mininizer settings to be saved
+ double xtol_out= 0.001;
+ double ftol_out= xtol_out*0.01;
+ double gtol_out= 0.005;
+ int maxfev_out = 3000;
+ double epsfcn_out = xtol_out* 0.001;
+ bool trace_out = false;
+ bool verbose_out = false;
+ int cd_out =1;
+
+ minimizer_out.set_f_tolerance(ftol_out);
+ minimizer_out.set_x_tolerance(xtol_out);
+ minimizer_out.set_g_tolerance(gtol_out);
+ minimizer_out.set_max_function_evals(maxfev_out);
+ minimizer_out.set_epsilon_function(epsfcn_out);
+ minimizer_out.set_trace(trace_out);
+ minimizer_out.set_verbose(verbose_out);
+ minimizer_out.set_check_derivatives(cd_out);
+
+ vsl_print_summary(vcl_cout, minimizer_out);
+ vcl_cout << vcl_endl;
+
+ vsl_b_ofstream bfs_out("vnl_nonlinear_minimizer_io.bvl.tmp");
+ TEST("Created vnl_nonlinear_minimizer_test_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, minimizer_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_nonlinear_minimizer_io.bvl.tmp");
+ TEST("Opened vnl_nonlinear_minimizer_test_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, minimizer_in);
+ TEST("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_nonlinear_minimizer_io.bvl.tmp");
+
+ double ftol_in=minimizer_in.get_f_tolerance();
+ double xtol_in=minimizer_in.get_x_tolerance();
+ double gtol_in=minimizer_in.get_g_tolerance();
+ int maxfev_in=minimizer_in.get_max_function_evals();
+ double epsfcn_in=minimizer_in.get_epsilon_function();
+ bool trace_in=minimizer_in.get_trace();
+ bool verbose_in=minimizer_in.get_verbose();
+ int cd_in=minimizer_in.get_check_derivatives();
+
+ TEST("ftol_in == ftol_out", ftol_in == ftol_out, true);
+ TEST("xtol_in == xtol_out", xtol_in == xtol_out, true);
+ TEST("gtol_in == gtol_out", gtol_in == gtol_out, true);
+ TEST("maxfev_in == maxfev_out", maxfev_in == maxfev_out, true);
+ TEST("epsfcn_in == epsfcn_out", epsfcn_in == epsfcn_out, true);
+ TEST("trace_in == trace_out", trace_in == trace_out, true);
+ TEST("verbose_in == verbose_out", verbose_in == verbose_out, true);
+ TEST("cd_in == cd_out", cd_in == cd_out, true);
+
+ vsl_print_summary(vcl_cout, minimizer_in);
+ vcl_cout << vcl_endl;
+}
+
+TESTMAIN(test_nonlinear_minimizer_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_rational_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_rational_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..addad0ef982a3522babcee26f79e3ea58c4f36ba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_rational_io.cxx
@@ -0,0 +1,47 @@
+// This is core/vnl/io/tests/test_rational_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_rational.h>
+#include <vnl/io/vnl_io_rational.h>
+#include <vsl/vsl_binary_io.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_rational_io()
+{
+ vcl_cout << "****************\n"
+ << "test_rational_io\n"
+ << "****************\n";
+
+ vnl_rational nil(0L), inf(1L, 0L), one(2L,2L);
+
+ vsl_b_ofstream bfs_out("vnl_rational_test_io.bvl.tmp");
+ TEST ("Created vnl_rational_test_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, nil);
+ vsl_b_write(bfs_out, inf);
+ vsl_b_write(bfs_out, one);
+ bfs_out.close();
+
+ vnl_rational r1, r2, r3;
+ vsl_b_ifstream bfs_in("vnl_rational_test_io.bvl.tmp");
+ TEST ("Opened vnl_rational_test_io.bvl.tmp for reading",
+ (!bfs_in), false);
+ vsl_b_read(bfs_in, r1);
+ vsl_b_read(bfs_in, r2);
+ vsl_b_read(bfs_in, r3);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_rational_test_io.bvl.tmp");
+
+ TEST ("equality nil", nil, r1);
+ TEST ("equality inf", inf, r2);
+ TEST ("equality one", one, r3);
+
+ vsl_print_summary(vcl_cout, nil);
+ vsl_print_summary(vcl_cout, inf);
+ vsl_print_summary(vcl_cout, one);
+ vcl_cout << vcl_endl;
+}
+
+TESTMAIN(test_rational_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_npolynomial_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_npolynomial_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..384360a41cda9552213e6caa0ce56fd3d1df80ac
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_npolynomial_io.cxx
@@ -0,0 +1,65 @@
+// This is core/vnl/io/tests/test_real_npolynomial_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_real_npolynomial.h>
+#include <vnl/io/vnl_io_real_npolynomial.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_real_npolynomial_io()
+{
+ vcl_cout << "************************\n"
+ << "test_real_npolynomial_io\n"
+ << "************************\n";
+ //// test constructors, accessors
+ vnl_vector<double> coeffs(4),coeffs2;
+ vnl_matrix<unsigned int> exponents(4,2);
+
+ coeffs(0) = 0.1;
+ coeffs(1) = 0.2;
+ coeffs(2) = 0.3;
+ coeffs(3) = 0.5;
+
+ exponents(0,0) = 1;
+ exponents(1,0) = 2;
+ exponents(2,0) = 3;
+ exponents(3,0) = 4;
+ exponents(0,1) = 5;
+ exponents(1,1) = 6;
+ exponents(2,1) = 7;
+ exponents(3,1) = 8;
+
+ coeffs2 = coeffs*2.0;
+
+ //vsl_print_summary(vcl_cout, coeffs);
+
+ vnl_real_npolynomial poly_out(coeffs, exponents), poly_in0,poly_in1(coeffs2,exponents);
+
+ vsl_b_ofstream bfs_out("vnl_real_npolynomial_test_io.bvl.tmp");
+ TEST ("Created vnl_real_npolynomial_test_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, poly_out);
+ vsl_b_write(bfs_out, poly_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_real_npolynomial_test_io.bvl.tmp");
+ TEST ("Opened vnl_real_npolynomial_test_io.bvl.tmp for reading",
+ (!bfs_in), false);
+ vsl_b_read(bfs_in, poly_in0);
+ vsl_b_read(bfs_in, poly_in1);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_real_npolynomial_test_io.bvl.tmp");
+
+ TEST ("poly_out.coefficients() == poly_in0.coefficients()",
+ poly_out.coefficients() == poly_in0.coefficients(), true);
+ TEST ("poly_out.coefficients() == poly_in1.coefficients()",
+ poly_out.coefficients() == poly_in1.coefficients(), true);
+
+ vsl_print_summary(vcl_cout, poly_out);
+ vcl_cout << vcl_endl;
+}
+
+TESTMAIN(test_real_npolynomial_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_polynomial_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_polynomial_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b0d602c3ec27b594e338b0946d52223de1cb538c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_real_polynomial_io.cxx
@@ -0,0 +1,50 @@
+// This is core/vnl/io/tests/test_real_polynomial_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_real_polynomial.h>
+#include <vnl/io/vnl_io_real_polynomial.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_real_polynomial_io()
+{
+ vcl_cout << "******************************\n"
+ << "Testing vnl_real_polynomial io\n"
+ << "******************************\n";
+ //// test constructors, accessors
+ const int n = 10;
+ vnl_vector<double> v(n);
+
+ for (int i=0; i<n; i++)
+ {
+ v(i) = (double)(i*i);
+ }
+
+ vnl_real_polynomial poly_out(v), poly_in0(0),poly_in1(v*2.0);
+
+
+ vsl_b_ofstream bfs_out("vnl_real_polynomial_test_io.bvl.tmp");
+ TEST("Created vnl_real_polynomial_test_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, poly_out);
+ vsl_b_write(bfs_out, poly_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_real_polynomial_test_io.bvl.tmp");
+ TEST("Opened vnl_real_polynomial_test_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, poly_in0);
+ vsl_b_read(bfs_in, poly_in1);
+ TEST("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_real_polynomial_test_io.bvl.tmp");
+
+ TEST("poly_out.coefficients() == poly_in0.coefficients()",
+ poly_out.coefficients() == poly_in0.coefficients(), true);
+ TEST("poly_out.coefficients() == poly_in1.coefficients()",
+ poly_out.coefficients() == poly_in1.coefficients(), true);
+
+ vsl_print_summary(vcl_cout, poly_in0);
+ vcl_cout << vcl_endl;
+}
+
+
+TESTMAIN(test_real_polynomial_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sparse_matrix_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sparse_matrix_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ff3eb763d2415125328525ae02802a1ccad22a76
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sparse_matrix_io.cxx
@@ -0,0 +1,104 @@
+// This is core/vnl/io/tests/test_sparse_matrix_io.cxx
+#include <vcl_iostream.h>
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_sparse_matrix.h>
+#include <vnl/io/vnl_io_sparse_matrix.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+static bool Compare(vnl_sparse_matrix<double>& M1, vnl_sparse_matrix<double>& M2)
+{
+ M1.reset();
+ M2.reset();
+
+ while (M1.next() && M2.next())
+ {
+ if (M1.getrow()!=M2.getrow() || M1.getcolumn() != M2.getcolumn() || M1.value()!= M2.value())
+ {
+ return false;
+ }
+ }
+
+ return true;
+}
+
+void test_sparse_matrix_double_io()
+{
+ vcl_cout << "************************************\n"
+ << "Testing vnl_sparse_matrix<double> io\n"
+ << "************************************\n";
+ //// test constructors, accessors
+
+ vnl_sparse_matrix<double> m_out(3,3), m_in0(3,3), m_in1(3,3);
+ vcl_vector<int> col_1(3);
+ vcl_vector<int> col_2(2);
+ vcl_vector<int> col_3(1);
+
+ col_1[0]=1;
+ col_1[1]=2;
+ col_1[2]=3;
+ col_2[0]=1;
+ col_2[1]=3;
+ col_3[0]=2;
+
+ vcl_vector<double> val_1(3);
+ vcl_vector<double> val_2(2);
+ vcl_vector<double> val_3(1);
+
+ val_1[0]=1.1;
+ val_1[1]=1.2;
+ val_1[2]=1.3;
+ val_2[0]=2.1;
+ val_2[1]=2.3;
+ val_3[0]=3.2;
+
+ m_out.set_row(0, col_1, val_1);
+ m_out.set_row(1, col_2, val_2);
+ m_out.set_row(2, col_3, val_3);
+
+ vsl_b_ofstream bfs_out("vnl_sparse_matrix_io.bvl.tmp");
+ TEST ("vnl_sparse_matrix_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, m_out);
+ vsl_b_write(bfs_out, m_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_sparse_matrix_io.bvl.tmp");
+ TEST ("vnl_sparse_matrix_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, m_in0);
+ vsl_b_read(bfs_in, m_in1);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_sparse_matrix_io.bvl.tmp");
+
+#if 0
+ bool test_result=true;
+ m_out.reset();
+ m_in.reset();
+
+ while (m_out.next() && m_in.next())
+ {
+ if (m_out.getrow()!=m_in.getrow()
+ || m_out.getcolumn() != m_in.getcolumn()
+ || m_out.value()!= m_in.value())
+ {
+ test_result=false;
+ break;
+ }
+ }
+#endif
+
+ TEST ("m_out == m_in0",Compare(m_out,m_in0) , true);
+ TEST ("m_out == m_in1",Compare(m_out,m_in1) , true);
+
+ vsl_print_summary(vcl_cout, m_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_sparse_matrix_io()
+{
+ test_sparse_matrix_double_io();
+}
+
+
+TESTMAIN(test_sparse_matrix_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sym_matrix_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sym_matrix_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d07c451ae3b2aeacd64736541cee5f03a912f43e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_sym_matrix_io.cxx
@@ -0,0 +1,58 @@
+// This is core/vnl/io/tests/test_sym_matrix_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_sym_matrix.h>
+#include <vnl/io/vnl_io_sym_matrix.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_sym_matrix_double_io()
+{
+ vcl_cout << "*********************************\n"
+ << "Testing vnl_sym_matrix<double> io\n"
+ << "*********************************\n";
+ //// test constructors, accessors
+ const int n = 6;
+ vnl_sym_matrix<double> m_out( n), m_in1(n),m_in2;
+
+ for (int i=0; i<n; i++)
+ {
+ for (int j=0; j<=i; j++)
+ {
+ m_out(i,j) = (double)(i*j);
+ m_in1(i,j) = (double)(73);
+ }
+ }
+
+
+ vsl_b_ofstream bfs_out("vnl_sym_matrix_test_double_io.bvl.tmp");
+ TEST("Created vnl_sym_matrix_test_double_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, m_out);
+ vsl_b_write(bfs_out, m_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_sym_matrix_test_double_io.bvl.tmp");
+ TEST("Opened vnl_sym_matrix_test_double_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, m_in1);
+ vsl_b_read(bfs_in, m_in2);
+ TEST("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_sym_matrix_test_double_io.bvl.tmp");
+
+ // m_in1 has content
+ TEST("m_out == m_in1", m_out, m_in1);
+ // m_in2 empty
+ TEST("m_out == m_in2", m_out, m_in2);
+
+ vsl_print_summary(vcl_cout, m_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_sym_matrix_io()
+{
+ test_sym_matrix_double_io();
+}
+
+
+TESTMAIN(test_sym_matrix_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_fixed_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_fixed_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5375fb78be8edf4e73c5c5d4570656169823c905
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_fixed_io.cxx
@@ -0,0 +1,43 @@
+// This is core/vnl/io/tests/test_vector_fixed_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/io/vnl_io_vector_fixed.h>
+#include <vsl/vsl_binary_io.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_vector_fixed_double_3_io()
+{
+ vcl_cout << "*************************************\n"
+ << "Testing vnl_vector_fixed<double,3> io\n"
+ << "*************************************\n";
+ //// test constructors, accessors
+
+ vnl_vector_fixed<double,3> m_out(1.2,3.4,5.6), m_in;
+
+ vsl_b_ofstream bfs_out("vnl_vector_fixed_io.bvl.tmp");
+ TEST ("vnl_vector_fixed_io.bvl.tmp for writing", (!bfs_out), false);
+ vsl_b_write(bfs_out, m_out);
+ bfs_out.close();
+
+ vsl_b_ifstream bfs_in("vnl_vector_fixed_io.bvl.tmp");
+ TEST ("vnl_vector_fixed_io.bvl.tmp for reading", (!bfs_in), false);
+ vsl_b_read(bfs_in, m_in);
+ bfs_in.close();
+
+ vpl_unlink ("vnl_vector_fixed_io.bvl.tmp");
+
+ TEST ("m_out == m_in", m_out, m_in);
+
+ vsl_print_summary(vcl_cout, m_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_vector_fixed_io()
+{
+ test_vector_fixed_double_3_io();
+}
+
+
+TESTMAIN(test_vector_fixed_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_io.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_io.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7e1723cf8d82d422d92738cad8bd548eb221adaf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/tests/test_vector_io.cxx
@@ -0,0 +1,56 @@
+// This is core/vnl/io/tests/test_vector_io.cxx
+#include <vcl_iostream.h>
+#include <vnl/io/vnl_io_vector.h>
+#include <vsl/vsl_binary_io.h>
+#include <testlib/testlib_test.h>
+#include <vpl/vpl.h>
+
+void test_vector_double_io()
+{
+ vcl_cout << "*****************************\n"
+ << "Testing vnl_vector<double> io\n"
+ << "*****************************\n";
+ //// test constructors, accessors
+ const int n = 50;
+ vnl_vector<double> v_out(n), v_in;
+
+ for (int i=0; i<n; i++)
+ {
+ v_out(i) = (double)(i*i);
+ }
+
+ vcl_cout << "before saving:\t"; vsl_print_summary(vcl_cout, v_out);
+
+ vsl_b_ofstream bfs_out("vnl_vector_test_double_io.bvl.tmp");
+ TEST ("Created vnl_vector_test_double_io.bvl.tmp for writing",
+ (!bfs_out), false);
+ vsl_b_write(bfs_out, v_out);
+ bfs_out.close();
+
+ vcl_cout << "after saving:\t"; vsl_print_summary(vcl_cout, v_out);
+
+ vsl_b_ifstream bfs_in("vnl_vector_test_double_io.bvl.tmp");
+ TEST ("Opened vnl_vector_test_double_io.bvl.tmp for reading",
+ (!bfs_in), false);
+ vsl_b_read(bfs_in, v_in);
+ TEST ("Finished reading file successfully", (!bfs_in), false);
+ bfs_in.close();
+
+ vcl_cout << "after reading in:\t"; vsl_print_summary(vcl_cout, v_in);
+
+ vpl_unlink ("vnl_vector_test_double_io.bvl.tmp");
+
+ TEST ("v_out == v_in", v_out, v_in);
+
+ vsl_print_summary(vcl_cout, v_out);
+ vcl_cout << vcl_endl;
+}
+
+
+void test_vector_io()
+{
+ test_vector_double_io();
+}
+
+
+TESTMAIN(test_vector_io);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..813bbf488196ae20ee626b6c588bde24aeb380e0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.cxx
@@ -0,0 +1,50 @@
+// This is core/vnl/io/vnl_io_bignum.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_io_bignum.h"
+#include <vsl/vsl_binary_io.h>
+
+//=================================================================================
+//: Binary save self to stream.
+void vsl_b_write(vsl_b_ostream & os, const vnl_bignum & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vcl_string s;
+ vnl_bignum_to_string(s, p);
+ vsl_b_write(os, s);
+}
+
+//=================================================================================
+//: Binary load self from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_bignum & p)
+{
+ if (!is) return;
+ short ver;
+ vcl_string s;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, s);
+ vnl_bignum_from_string(p, s);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_bignum&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+void vsl_print_summary(vcl_ostream & os,const vnl_bignum & p)
+{
+ os<<p;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.h
new file mode 100644
index 0000000000000000000000000000000000000000..2e92c02b00ddcf316205c0f7c57e5ea0b457a491
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_bignum.h
@@ -0,0 +1,25 @@
+// This is core/vnl/io/vnl_io_bignum.h
+#ifndef vnl_io_bignum_h
+#define vnl_io_bignum_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author Ian Scott
+// \date 10-Oct-2001
+
+#include <vsl/vsl_fwd.h>
+#include <vnl/vnl_bignum.h>
+#include <vcl_iosfwd.h>
+
+//: Binary save vnl_bignum to stream.
+void vsl_b_write(vsl_b_ostream & os, vnl_bignum const& v);
+
+//: Binary load vnl_bignum from stream.
+void vsl_b_read(vsl_b_istream & is, vnl_bignum & v);
+
+//: Print human readable summary of object to a stream
+void vsl_print_summary(vcl_ostream & os, vnl_bignum const& b);
+
+#endif // vnl_io_bignum_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..6d15464be1aa3b0cc42003a5c47a712004f74d25
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_diag_matrix.h
+#ifndef vnl_io_diag_matrix_h
+#define vnl_io_diag_matrix_h
+//:
+// \file
+// \author dac
+// \date 21-Mar-2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_diag_matrix.h>
+
+//: Binary save vnl_real_polynomial to stream.
+template <class T>
+void vsl_b_write(vsl_b_ostream &os, const vnl_diag_matrix<T> & v);
+
+//: Binary load vnl_real_polynomial from stream.
+template <class T>
+void vsl_b_read(vsl_b_istream &is, vnl_diag_matrix<T> & v);
+
+//: Print human readable summary of object to a stream
+template <class T>
+void vsl_print_summary(vcl_ostream& os,const vnl_diag_matrix<T> & b);
+
+#endif // vnl_io_diag_matrix_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..e24ecaeebee09cc908e903817fd0786f02f93551
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_diag_matrix.txx
@@ -0,0 +1,61 @@
+// This is core/vnl/io/vnl_io_diag_matrix.txx
+#ifndef vnl_io_diag_matrix_txx_
+#define vnl_io_diag_matrix_txx_
+//:
+// \file
+
+#include "vnl_io_diag_matrix.h"
+#include <vsl/vsl_binary_io.h>
+#include <vnl/io/vnl_io_vector.h>
+
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_diag_matrix<T> & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.diagonal());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_diag_matrix<T> & p)
+{
+ if (!is) return;
+
+ short ver;
+ vnl_vector<T> v;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, v);
+ p.set(v);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_diag_matrix<T>&)\n"
+ << " Unknown version number "<< v << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_diag_matrix<T> & p)
+{
+ os<<"Diagonal: ";
+ vsl_print_summary(os, p.diagonal());
+}
+
+#define VNL_IO_DIAG_MATRIX_INSTANTIATE(T) \
+template void vsl_print_summary(vcl_ostream &, const vnl_diag_matrix<T > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_diag_matrix<T > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_diag_matrix<T > &)
+
+#endif // vnl_io_diag_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..c3a9d743a5c4bec4ab91eb64c834a40bbac64d10
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.h
@@ -0,0 +1,25 @@
+// This is core/vnl/io/vnl_io_matrix.h
+#ifndef vnl_io_matrix_h
+#define vnl_io_matrix_h
+//:
+// \file
+// \author Louise Butcher
+// \date 20-Mar-2001
+
+#include <vsl/vsl_fwd.h>
+#include <vnl/vnl_matrix.h>
+#include <vcl_iosfwd.h>
+
+//: Binary save vnl_matrix to stream.
+template <class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_matrix<T> & v);
+
+//: Binary load vnl_matrix from stream.
+template <class T>
+void vsl_b_read(vsl_b_istream & is, vnl_matrix<T> & v);
+
+//: Print human readable summary of object to a stream
+template <class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_matrix<T> & b);
+
+#endif // vnl_io_matrix_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..dea23e40d95c8487d4eba73acbe041847c75f906
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix.txx
@@ -0,0 +1,99 @@
+// This is core/vnl/io/vnl_io_matrix.txx
+#ifndef vnl_io_matrix_txx_
+#define vnl_io_matrix_txx_
+//:
+// \file
+
+#include "vnl_io_matrix.h"
+#include <vnl/vnl_matrix.h>
+#include <vsl/vsl_b_read_block_old.h>
+#include <vsl/vsl_block_binary.h>
+#include <vsl/vsl_indent.h>
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_matrix<T> & p)
+{
+ const short version_no = 2;
+ vsl_b_write(os, version_no);
+ vsl_b_write(os, p.rows());
+ vsl_b_write(os, p.cols());
+
+ // Calling p.begin() on empty matrix causes segfault
+ if (p.size()>0)
+ vsl_block_binary_write(os, p.begin(), p.size());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_matrix<T> & p)
+{
+ if (!is) return;
+
+ short v;
+ unsigned m, n;
+ vsl_b_read(is, v);
+ switch (v)
+ {
+ case 1:
+ vsl_b_read(is, m);
+ vsl_b_read(is, n);
+ p.set_size(m, n);
+ // Calling begin() on empty matrix causes segfault
+ if (m*n>0)
+ vsl_b_read_block_old(is, p.begin(), p.size());
+ break;
+
+ case 2:
+ vsl_b_read(is, m);
+ vsl_b_read(is, n);
+ p.set_size(m, n);
+ // Calling begin() on empty matrix causes segfault
+ if (m*n>0)
+ vsl_block_binary_read(is, p.data_block(), p.size());
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_matrix<T>&)\n"
+ << " Unknown version number "<< v << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_matrix<T> & p)
+{
+ os<<"Size: "<<p.rows()<<" x "<<p.cols()<<vcl_endl;
+
+ unsigned int m = 5; unsigned int n = 5;
+
+
+ if (m>p.rows()) m=p.rows();
+ if (n>p.cols()) n=p.cols();
+
+ vsl_indent_inc(os);
+ for (unsigned int i=0;i<m;i++)
+ {
+ os<<vsl_indent()<<" (";
+
+ for ( unsigned int j=0; j<n; j++)
+ os<<p(i,j)<<' ';
+ if (p.cols()>n) os<<"...";
+ os<<")\n";
+ }
+ if (p.rows()>m) os <<vsl_indent()<<" (...\n";
+ vsl_indent_dec(os);
+}
+
+
+#define VNL_IO_MATRIX_INSTANTIATE(T) \
+template void vsl_print_summary(vcl_ostream &, const vnl_matrix<T > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_matrix<T > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_matrix<T > &)
+
+#endif // vnl_io_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.h
new file mode 100644
index 0000000000000000000000000000000000000000..ff2274a9fa6a33acb1c3746c43bc6f9d6c893a77
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_matrix_fixed.h
+#ifndef vnl_io_matrix_fixed_h
+#define vnl_io_matrix_fixed_h
+//:
+// \file
+// \author Louise Butcher
+// \date 20-Mar-2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_matrix_fixed.h>
+
+//: Binary save vnl_matrix_fixed to stream.
+template <class T, unsigned m, unsigned n>
+void vsl_b_write(vsl_b_ostream & os, const vnl_matrix_fixed<T,m,n> & v);
+
+//: Binary load vnl_matrix_fixed from stream.
+template <class T, unsigned m, unsigned n>
+void vsl_b_read(vsl_b_istream & is, vnl_matrix_fixed<T,m,n> & v);
+
+//: Print human readable summary of object to a stream
+template <class T, unsigned m, unsigned n>
+void vsl_print_summary(vcl_ostream & os,const vnl_matrix_fixed<T,m,n> & b);
+
+#endif // vnl_io_matrix_fixed_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.txx
new file mode 100644
index 0000000000000000000000000000000000000000..c3f6a93e1eccd915085092c82c9084aad5676d3a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_matrix_fixed.txx
@@ -0,0 +1,109 @@
+// This is core/vnl/io/vnl_io_matrix_fixed.txx
+#ifndef vnl_io_matrix_fixed_txx_
+#define vnl_io_matrix_fixed_txx_
+//:
+// \file
+
+#include "vnl_io_matrix_fixed.h"
+#include <vnl/vnl_matrix_fixed.h>
+#include <vsl/vsl_b_read_block_old.h>
+#include <vsl/vsl_block_binary.h>
+#include <vsl/vsl_indent.h>
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T, unsigned m, unsigned n>
+void vsl_b_write(vsl_b_ostream & os, const vnl_matrix_fixed<T,m,n> & p)
+{
+ const short version_no = 2;
+ vsl_b_write(os, version_no);
+ vsl_b_write(os, p.rows());
+ vsl_b_write(os, p.cols());
+
+ // Calling p.begin() on empty matrix_fixed causes segfault
+ if (p.size()>0)
+ vsl_block_binary_write(os, p.data_block(), m*n);
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T, unsigned m, unsigned n>
+void vsl_b_read(vsl_b_istream &is, vnl_matrix_fixed<T,m,n> & p)
+{
+ if (!is) return;
+
+ short v;
+ unsigned stream_m, stream_n;
+ vsl_b_read(is, v);
+ switch (v)
+ {
+ case 1:
+ vsl_b_read(is, stream_m);
+ vsl_b_read(is, stream_n);
+ if ( stream_n != n || stream_m != m ) {
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_matrix_fixed<T>&)\n"
+ << " Expected size " << m << ',' << n << "; got " << stream_m << ',' << stream_n << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+ // Calling begin() on empty matrix_fixed causes segfault
+ if (m*n>0)
+ vsl_b_read_block_old(is, p.begin(), p.size());
+ break;
+
+ case 2:
+ vsl_b_read(is, stream_m);
+ vsl_b_read(is, stream_n);
+ if ( stream_n != n || stream_m != m ) {
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_matrix_fixed<T>&)\n"
+ << " Expected size " << m << ',' << n << "; got " << stream_m << ',' << stream_n << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+ // Calling begin() on empty matrix_fixed causes segfault
+ if (m*n>0)
+ vsl_block_binary_read(is, p.data_block(), m*n);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_matrix_fixed<T>&)\n"
+ << " Unknown version number "<< v << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T, unsigned nrows, unsigned ncols>
+void vsl_print_summary(vcl_ostream & os,const vnl_matrix_fixed<T,nrows,ncols> & p)
+{
+ os<<"Size: "<<p.rows()<<" x "<<p.cols()<<vcl_endl;
+
+ unsigned int m = 5; unsigned int n = 5;
+
+
+ if (m>p.rows()) m=p.rows();
+ if (n>p.cols()) n=p.cols();
+
+ vsl_indent_inc(os);
+ for (unsigned int i=0;i<m;i++)
+ {
+ os<<vsl_indent()<<" (";
+
+ for ( unsigned int j=0; j<n; j++)
+ os<<p(i,j)<<' ';
+ if (p.cols()>n) os<<"...";
+ os<<")\n";
+ }
+ if (p.rows()>m) os <<vsl_indent()<<" (...\n";
+ vsl_indent_dec(os);
+}
+
+
+#define VNL_IO_MATRIX_FIXED_INSTANTIATE(T,m,n) \
+template void vsl_print_summary(vcl_ostream &, const vnl_matrix_fixed<T,m,n > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_matrix_fixed<T,m,n > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_matrix_fixed<T,m,n > &)
+
+#endif // vnl_io_matrix_fixed_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a38fdfdfa25f45caec5378e29d52c7d579fd4e97
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.cxx
@@ -0,0 +1,154 @@
+// This is core/vnl/io/vnl_io_nonlinear_minimizer.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_io_nonlinear_minimizer.h"
+#include <vsl/vsl_binary_io.h>
+#include <vsl/vsl_clipon_binary_loader.txx>
+
+//: Create new object of type vnl_nonlinear_minimizer on heap
+vnl_nonlinear_minimizer* vnl_io_nonlinear_minimizer::new_object() const
+{
+ return new vnl_nonlinear_minimizer;
+}
+
+//: Write derived class to os using vnl_nonlinear_minimizer reference
+void vnl_io_nonlinear_minimizer::b_write_by_base(vsl_b_ostream& os,
+ const vnl_nonlinear_minimizer& base) const
+{
+ vsl_b_write(os,base);
+}
+
+//: Write derived class to os using vnl_nonlinear_minimizer reference
+void vnl_io_nonlinear_minimizer::b_read_by_base(vsl_b_istream& is,
+ vnl_nonlinear_minimizer& base) const
+{
+ vsl_b_read(is,base);
+}
+
+//: Print summary of derived class to os using vnl_nonlinear_minimizer reference
+void vnl_io_nonlinear_minimizer::print_summary_by_base(vcl_ostream& os,
+ const vnl_nonlinear_minimizer& base) const
+{
+ vsl_print_summary(os,base);
+}
+
+//: Copy this object onto the heap and return a pointer
+vnl_io_nonlinear_minimizer* vnl_io_nonlinear_minimizer::clone() const
+{
+ return new vnl_io_nonlinear_minimizer(*this);
+}
+
+//==============================================================================
+//: Binary save self to stream.
+void vsl_b_write(vsl_b_ostream & os, const vnl_nonlinear_minimizer & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.get_f_tolerance());
+ vsl_b_write(os, p.get_x_tolerance());
+ vsl_b_write(os, p.get_g_tolerance());
+ vsl_b_write(os, p.get_max_function_evals());
+ vsl_b_write(os, p.get_epsilon_function());
+ vsl_b_write(os, p.get_trace());
+ vsl_b_write(os, p.get_verbose());
+ vsl_b_write(os, p.get_check_derivatives());
+}
+
+//==============================================================================
+//: Binary load self from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_nonlinear_minimizer & p)
+{
+ if (!is) return;
+
+ short ver;
+ // Load & save variables
+ double ftol; // Termination tolerance on F (sum of squared residuals)
+ double xtol; // Termination tolerance on X (solution vector)
+ double gtol; // Termination tolerance on Grad(F)' * F = 0
+ int maxfev; // Termination maximum number of iterations.
+ double epsfcn; // Step length for FD Jacobian
+ bool trace;
+ bool verbose;
+ int check_derivatives;
+
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, ftol);
+ p.set_f_tolerance(ftol);
+ vsl_b_read(is, xtol);
+ p.set_x_tolerance(xtol);
+ vsl_b_read(is, gtol);
+ p.set_g_tolerance(gtol);
+ vsl_b_read(is, maxfev);
+ p.set_max_function_evals(maxfev);
+ vsl_b_read(is, epsfcn);
+ p.set_epsilon_function(epsfcn);
+ vsl_b_read(is, trace);
+ p.set_trace(trace);
+ vsl_b_read(is, verbose);
+ p.set_verbose(verbose);
+ vsl_b_read(is, check_derivatives);
+ p.set_check_derivatives(check_derivatives);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_nonlinear_minimizer&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//==============================================================================
+//: Output a human readable summary to the stream
+void vsl_print_summary(vcl_ostream & os,const vnl_nonlinear_minimizer & p)
+{
+ os<<"Tolerance of {F, X, G}: {"<<p.get_f_tolerance() << ", "
+ << p.get_x_tolerance()<<", "<<p.get_g_tolerance() << "}\n"
+ <<"Max Function Evals:"<<p.get_max_function_evals()<<" Epsilon function:"
+ <<p.get_epsilon_function()<<" Trace:"<<p.get_trace()<<'\n'
+ <<"Verbose:"<<p.get_verbose()<<" Check Derivatives:"
+ <<p.get_check_derivatives()<<'\n';
+}
+
+//: Add example object to list of those that can be loaded
+// The vsl_binary_loader must see an example of each derived class
+// before it knows how to deal with them.
+// A clone is taken of b
+void vsl_add_to_binary_loader(const vnl_io_nonlinear_minimizer& b)
+{
+ vsl_clipon_binary_loader<vnl_nonlinear_minimizer,
+ vnl_io_nonlinear_minimizer>::instance().add(b);
+}
+
+
+//: Binary save to stream by vnl_nonlinear_minimizer pointer
+void vsl_b_write(vsl_b_ostream &os, const vnl_nonlinear_minimizer * b)
+{
+ vsl_clipon_binary_loader<vnl_nonlinear_minimizer,
+ vnl_io_nonlinear_minimizer>::instance().write_object(os,b);
+}
+
+//: Binary read from stream by vnl_nonlinear_minimizer pointer
+void vsl_b_read(vsl_b_istream &is, vnl_nonlinear_minimizer* &b)
+{
+ vsl_clipon_binary_loader<vnl_nonlinear_minimizer,
+ vnl_io_nonlinear_minimizer>::instance().read_object(is,b);
+}
+
+//: Print summary to stream by vnl_nonlinear_minimizer pointer
+void vsl_print_summary(vcl_ostream &os, const vnl_nonlinear_minimizer * b)
+{
+ vsl_clipon_binary_loader<vnl_nonlinear_minimizer,
+ vnl_io_nonlinear_minimizer>::instance().print_object_summary(os,b);
+}
+
+// Explicitly instantiate loader
+VSL_CLIPON_BINARY_LOADER_INSTANTIATE(vnl_nonlinear_minimizer, \
+ vnl_io_nonlinear_minimizer);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.h
new file mode 100644
index 0000000000000000000000000000000000000000..4ffdee26f5ab80f0206ad29a62a2e1e78611fdee
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_nonlinear_minimizer.h
@@ -0,0 +1,79 @@
+// This is core/vnl/io/vnl_io_nonlinear_minimizer.h
+#ifndef vnl_io_nonlinear_minimizer_h
+#define vnl_io_nonlinear_minimizer_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author dac
+// \date 21-Mar-2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+
+//: Base for objects which provide IO
+// for classes derived from vnl_nonlinear_minimizer
+class vnl_io_nonlinear_minimizer
+{
+ public:
+ //: Constructor
+ vnl_io_nonlinear_minimizer() {}
+
+ //: Destructor
+ virtual ~vnl_io_nonlinear_minimizer() {}
+
+ //: Create new object of type vnl_nonlinear_minimizer on heap
+ virtual vnl_nonlinear_minimizer* new_object() const;
+
+ //: Write derived class to os using vnl_nonlinear_minimizer reference
+ virtual void b_write_by_base(vsl_b_ostream& os,
+ const vnl_nonlinear_minimizer& base) const;
+
+ //: Write derived class to os using vnl_nonlinear_minimizer reference
+ virtual void b_read_by_base(vsl_b_istream& is,
+ vnl_nonlinear_minimizer& base) const;
+
+ //: Print summary of derived class to os
+ // using vnl_nonlinear_minimizer reference
+ virtual void print_summary_by_base(vcl_ostream& os,
+ const vnl_nonlinear_minimizer& base) const;
+
+ //: Copy this object onto the heap and return a pointer
+ virtual vnl_io_nonlinear_minimizer* clone() const;
+
+ //: Return name of class for which this object provides IO
+ virtual vcl_string target_classname() const { return "vnl_nonlinear_minimizer"; }
+
+ //: Return true if b is of class target_classname()
+ // Typically this will just be "return b.is_a()==target_classname()"
+ // However, third party libraries may use a different system
+ virtual bool is_io_for(const vnl_nonlinear_minimizer& b) const
+ { return b.is_a()==target_classname(); }
+};
+
+//: Add example object to list of those that can be loaded
+// The vsl_binary_loader must see an example of each derived class
+// before it knows how to deal with them.
+// A clone is taken of b
+void vsl_add_to_binary_loader(const vnl_io_nonlinear_minimizer& b);
+
+//: Binary save to stream by vnl_nonlinear_minimizer pointer
+void vsl_b_write(vsl_b_ostream &os, const vnl_nonlinear_minimizer * b);
+
+//: Binary read from stream by vnl_nonlinear_minimizer pointer
+void vsl_b_read(vsl_b_istream &is, vnl_nonlinear_minimizer* &b);
+
+//: Print summary to stream by vnl_nonlinear_minimizer pointer
+void vsl_print_summary(vcl_ostream &os, const vnl_nonlinear_minimizer * b);
+
+//: Binary save vnl_real_polynomial to stream.
+void vsl_b_write(vsl_b_ostream &os, const vnl_nonlinear_minimizer & v);
+
+//: Binary load vnl_real_polynomial from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_nonlinear_minimizer & v);
+
+//: Print human readable summary of object to a stream
+void vsl_print_summary(vcl_ostream& os,const vnl_nonlinear_minimizer & b);
+
+#endif // vnl_io_nonlinear_minimizer_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2eae9f3d31cad8ba9bb249cddef16bae626e7e56
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.cxx
@@ -0,0 +1,50 @@
+// This is core/vnl/io/vnl_io_rational.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_io_rational.h"
+#include <vsl/vsl_binary_io.h>
+
+//=================================================================================
+//: Binary save self to stream.
+void vsl_b_write(vsl_b_ostream & os, const vnl_rational & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.numerator());
+ vsl_b_write(os, p.denominator());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_rational & p)
+{
+ if (!is) return;
+ short ver;
+ long n, d;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, n);
+ vsl_b_read(is, d);
+ p.set(n,d);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_rational&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+void vsl_print_summary(vcl_ostream & os,const vnl_rational & p)
+{
+ os<<p;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.h
new file mode 100644
index 0000000000000000000000000000000000000000..cbe31e34a874ed34ef6933a289fdbe10c30ad205
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_rational.h
@@ -0,0 +1,25 @@
+// This is core/vnl/io/vnl_io_rational.h
+#ifndef vnl_io_rational_h
+#define vnl_io_rational_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author Peter Vanroose
+// \date 10-Oct-2001
+
+#include <vsl/vsl_fwd.h>
+#include <vnl/vnl_rational.h>
+#include <vcl_iosfwd.h>
+
+//: Binary save vnl_rational to stream.
+void vsl_b_write(vsl_b_ostream & os, vnl_rational const& v);
+
+//: Binary load vnl_rational from stream.
+void vsl_b_read(vsl_b_istream & is, vnl_rational & v);
+
+//: Print human readable summary of object to a stream
+void vsl_print_summary(vcl_ostream & os, vnl_rational const& b);
+
+#endif // vnl_io_rational_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..2a95166326c8c098773e5eb23c835e6d66c133f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.cxx
@@ -0,0 +1,60 @@
+// This is core/vnl/io/vnl_io_real_npolynomial.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_io_real_npolynomial.h"
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_real_npolynomial.h>
+#include <vnl/io/vnl_io_vector.h>
+#include <vnl/io/vnl_io_matrix.h>
+
+
+//==============================================================================
+//: Binary save self to stream.
+void vsl_b_write(vsl_b_ostream & os, const vnl_real_npolynomial & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+
+ vsl_b_write(os, p.coefficients());
+ vsl_b_write(os, p.polyn());
+}
+
+//==============================================================================
+//: Binary load self from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_real_npolynomial & p)
+{
+ if (!is) return;
+
+ short ver;
+ vnl_vector<double> coeffs;
+ vnl_matrix<unsigned int> polyn;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, coeffs);
+ vsl_b_read(is, polyn);
+ p.set(coeffs, polyn);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_real_npolynomial&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//==============================================================================
+//: Output a human readable summary to the stream
+void vsl_print_summary(vcl_ostream & os,const vnl_real_npolynomial & p)
+{
+ os<<"Coefficients: ";
+ vsl_print_summary(os, p.coefficients());
+ os<<"Polynomial: ";
+ vsl_print_summary(os, p.polyn());
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.h
new file mode 100644
index 0000000000000000000000000000000000000000..bca6f8ab8ee54ffb3f0c52483c6b488cfe10e1b2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_npolynomial.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_real_npolynomial.h
+#ifndef vnl_io_real_npolynomial_h
+#define vnl_io_real_npolynomial_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author dac
+// \date 21-Mar-2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_real_npolynomial.h>
+
+//: Binary save vnl_real_npolynomial to stream.
+void vsl_b_write(vsl_b_ostream &os, const vnl_real_npolynomial & v);
+
+//: Binary load vnl_real_polynomial from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_real_npolynomial & v);
+
+//: Print human readable summary of object to a stream
+void vsl_print_summary(vcl_ostream& os,const vnl_real_npolynomial & b);
+
+#endif // vnl_io_real_npolynomial_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3e12b2fc209426404ef5ca32a0eac0ad303dc4cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.cxx
@@ -0,0 +1,53 @@
+// This is core/vnl/io/vnl_io_real_polynomial.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_io_real_polynomial.h"
+#include <vsl/vsl_binary_io.h>
+#include <vnl/io/vnl_io_vector.h>
+#include <vnl/io/vnl_io_matrix.h>
+
+
+//==============================================================================
+//: Binary save self to stream.
+void vsl_b_write(vsl_b_ostream & os, const vnl_real_polynomial & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+
+ vsl_b_write(os, p.coefficients());
+}
+
+//==============================================================================
+//: Binary load self from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_real_polynomial & p)
+{
+ if (!is) return;
+
+ short ver;
+ vnl_vector<double> coeffs;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, coeffs);
+ p.set_coefficients(coeffs);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_real_polynomial&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//==============================================================================
+//: Output a human readable summary to the stream
+void vsl_print_summary(vcl_ostream & os,const vnl_real_polynomial & p)
+{
+ p.print(os);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.h
new file mode 100644
index 0000000000000000000000000000000000000000..9f3f266cbe7645d77248bc5f77a81a5964c0c926
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_real_polynomial.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_real_polynomial.h
+#ifndef vnl_io_real_polynomial_h
+#define vnl_io_real_polynomial_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author iscott
+// \date 21-Mar-2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_real_polynomial.h>
+
+//: Binary save vnl_real_npolynomial to stream.
+void vsl_b_write(vsl_b_ostream &os, const vnl_real_polynomial & v);
+
+//: Binary load vnl_real_polynomial from stream.
+void vsl_b_read(vsl_b_istream &is, vnl_real_polynomial & v);
+
+//: Print human readable summary of object to a stream
+void vsl_print_summary(vcl_ostream& os,const vnl_real_polynomial & b);
+
+#endif // vnl_io_real_polynomial_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..b582e22b75b98534c2eecdae662f68a4c902e73c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_sparse_matrix.h
+#ifndef vnl_io_sparse_matrix_h
+#define vnl_io_sparse_matrix_h
+//:
+// \file
+// \author Louise Bucther
+// \date 20-Mar-2001
+
+#include <vnl/vnl_sparse_matrix.h>
+#include <vsl/vsl_binary_io.h>
+
+//: Binary save vnl_sparse_matrix to stream.
+template <class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_sparse_matrix<T> & v);
+
+//: Binary load vnl_sparse_matrix from stream.
+template <class T>
+void vsl_b_read(vsl_b_istream & is, vnl_sparse_matrix<T> & v);
+
+//: Print human readable summary of object to a stream
+template <class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_sparse_matrix<T> & b);
+
+#endif // vnl_io_sparse_matrix_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..8b7117eae9f9728fc56531ad426c0183ce1109a0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sparse_matrix.txx
@@ -0,0 +1,174 @@
+// This is core/vnl/io/vnl_io_sparse_matrix.txx
+#ifndef vnl_io_sparse_matrix_txx_
+#define vnl_io_sparse_matrix_txx_
+//:
+// \file
+
+#include "vnl_io_sparse_matrix.h"
+#include <vnl/vnl_sparse_matrix.h>
+#include <vsl/vsl_binary_io.h>
+#include <vcl_cassert.h>
+
+//I/O for vnl_sparse_matrix_pair
+//==================================================================================
+//IO Helper functions
+//==================================================================================
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream &os, const vnl_sparse_matrix_pair<T> & p)
+{
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.first);
+ vsl_b_write(os, p.second);
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_sparse_matrix_pair<T> & p)
+{
+ if (!is) return;
+
+ short ver;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, p.first);
+ vsl_b_read(is, p.second);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_sparse_matrix_pair<T>&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream& os,const vnl_sparse_matrix_pair<T>& p)
+{
+ os<< "Sparse matrix pair ( " << p.first << ',' << p.second << " )\n";
+}
+
+//I/O for vnl_sparse_matrix
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_sparse_matrix<T> & p)
+{
+ typedef vnl_sparse_matrix_pair<T> pair_t;
+#if defined(VCL_SUNPRO_CC)
+ // SunPro is the broken one.
+ typedef vcl_vector < typename pair_t > row;
+ typedef vcl_vector < typename row > vnl_sparse_matrix_elements;
+#else
+ typedef vcl_vector < pair_t > row;
+ typedef vcl_vector < row > vnl_sparse_matrix_elements;
+#endif
+
+ row rw;
+ vnl_sparse_matrix<T> v=p;
+
+ const short io_version_no = 1;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, v.rows());
+ vsl_b_write(os, v.columns());
+
+ for (unsigned int i=0;i<v.rows();i++)
+ {
+ rw=v.get_row(i);
+ vsl_b_write(os, rw.size());
+ for (unsigned int j=0;j<rw.size();j++)
+ {
+ vsl_b_write(os, rw[j]);
+ }
+ }
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_sparse_matrix<T> & p)
+{
+ if (!is) return;
+
+ typedef vnl_sparse_matrix_pair<T> pair_t;
+#if defined(VCL_SUNPRO_CC)
+ // SunPro is the broken one.
+ typedef vcl_vector < typename pair_t > row;
+ typedef vcl_vector < typename row > vnl_sparse_matrix_elements;
+#else
+ typedef vcl_vector < pair_t > row;
+ typedef vcl_vector < row > vnl_sparse_matrix_elements;
+#endif
+
+ short ver;
+ int n_rows;
+ int n_cols;
+ int row_size=0;
+ vsl_b_read(is, ver);
+
+ vcl_vector<int> indexes(row_size);
+ vcl_vector<T> values(row_size);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, n_rows);
+ vsl_b_read(is, n_cols);
+ // As we cannot resize the matrix, check that it is the correct size.
+ assert (n_rows==(int)p.rows());
+ assert (n_cols==(int)p.columns());
+ for (int i=0;i<n_rows;i++)
+ {
+ vsl_b_read(is,row_size);
+ indexes.resize(row_size);
+ values.resize(row_size);
+
+ for (int j=0;j<row_size;j++)
+ {
+ pair_t p;
+ vsl_b_read(is, p);
+ indexes[j] = p.first;
+ values[j] = p.second;
+ }
+ p.set_row(i, indexes, values);
+ }
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_sparse_matrix<T>&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_sparse_matrix<T> & p)
+{
+ os<<"Rows x Columns: "<<p.rows()<<" x "<<p.columns()<<vcl_endl;
+ vnl_sparse_matrix<T> v=p;
+ v.reset();
+ v.next();
+ for (int i=0;i<5;i++)
+ {
+ os<<" ("<< v.getrow() <<','<< v.getcolumn() <<") value "<< v.value()<<'\n';
+ if (!v.next()) break;
+ }
+}
+
+#define VNL_IO_SPARSE_MATRIX_INSTANTIATE(T) \
+ template void vsl_print_summary(vcl_ostream &, const vnl_sparse_matrix<T > &); \
+ template void vsl_b_read(vsl_b_istream &, vnl_sparse_matrix<T > &); \
+ template void vsl_b_write(vsl_b_ostream &, const vnl_sparse_matrix<T > &)
+
+#endif // vnl_io_sparse_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..0206fa02ed7c05d279e92505954d77dcfbd457d1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.h
@@ -0,0 +1,24 @@
+// This is core/vnl/io/vnl_io_sym_matrix.h
+#ifndef vnl_io_sym_matrix_h
+#define vnl_io_sym_matrix_h
+//:
+// \file
+// \author Ian Scott
+// \date 11 Dec 2001
+
+#include <vsl/vsl_binary_io.h>
+#include <vnl/vnl_sym_matrix.h>
+
+//: Binary save vnl_matrix to stream.
+template <class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_sym_matrix<T> & v);
+
+//: Binary load vnl_matrix from stream.
+template <class T>
+void vsl_b_read(vsl_b_istream & is, vnl_sym_matrix<T> & v);
+
+//: Print human readable summary of object to a stream
+template <class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_sym_matrix<T> & b);
+
+#endif // vnl_io_sym_matrix_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..ca6c1238507f27d2ae319df9376f7d649dbbb403
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_sym_matrix.txx
@@ -0,0 +1,94 @@
+// This is core/vnl/io/vnl_io_sym_matrix.txx
+#ifndef vnl_io_sym_matrix_txx_
+#define vnl_io_sym_matrix_txx_
+//:
+// \file
+
+#include "vnl_io_sym_matrix.h"
+#include <vnl/vnl_sym_matrix.h>
+#include <vsl/vsl_b_read_block_old.h>
+#include <vsl/vsl_block_binary.h>
+#include <vsl/vsl_indent.h>
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_sym_matrix<T> & p)
+{
+ const short version_no = 2;
+ vsl_b_write(os, version_no);
+ vsl_b_write(os, p.rows());
+
+ // Calling p.begin() on empty matrix causes segfault
+ if (p.size()>0)
+ vsl_block_binary_write(os, p.data_block(), p.size());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_sym_matrix<T> & p)
+{
+ if (!is) return;
+
+ short v;
+ unsigned n;
+ vsl_b_read(is, v);
+ switch (v)
+ {
+ case 1:
+ vsl_b_read(is, n);
+ p.set_size(n);
+ // Calling begin() on empty matrix causes segfault
+ if (n>0)
+ vsl_b_read_block_old(is, p.data_block(), p.size());
+ break;
+
+ case 2:
+ vsl_b_read(is, n);
+ p.set_size(n);
+ // Calling begin() on empty matrix causes segfault
+ if (n>0)
+ vsl_block_binary_read(is, p.data_block(), p.size());
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_sym_matrix<T>&)\n"
+ << " Unknown version number "<< v << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_sym_matrix<T> & p)
+{
+ os<<"Size: "<<p.rows()<<" x "<<p.cols()<<vcl_endl;
+
+ unsigned int n = 5;
+
+
+ if (n>p.cols()) n=p.cols();
+
+ vsl_indent_inc(os);
+ for (unsigned int i=0;i<n;i++)
+ {
+ os<<vsl_indent()<<" (";
+
+ for ( unsigned int j=0; j<=i; j++)
+ os<<p(i,j)<<' ';
+ os << vcl_endl;
+ }
+ if (p.rows()>n) os <<vsl_indent()<<" (...\n";
+ vsl_indent_dec(os);
+}
+
+
+#define VNL_IO_SYM_MATRIX_INSTANTIATE(T) \
+template void vsl_print_summary(vcl_ostream &, const vnl_sym_matrix<T > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_sym_matrix<T > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_sym_matrix<T > &)
+
+#endif // vnl_io_sym_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.h
new file mode 100644
index 0000000000000000000000000000000000000000..56c7d4f8b2683e0a92d9a3555a5a26d7cda0b272
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.h
@@ -0,0 +1,25 @@
+// This is core/vnl/io/vnl_io_vector.h
+#ifndef vnl_io_vector_h
+#define vnl_io_vector_h
+//:
+// \file
+// \author Louise Bucther
+// \date 20-Mar-2001
+
+#include <vsl/vsl_fwd.h>
+#include <vnl/vnl_vector.h>
+#include <vcl_iosfwd.h>
+
+//: Binary save vnl_vector to stream.
+template <class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_vector<T> & v);
+
+//: Binary load vnl_vector from stream.
+template <class T>
+void vsl_b_read(vsl_b_istream & is, vnl_vector<T> & v);
+
+//: Print human readable summary of object to a stream
+template <class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_vector<T> & b);
+
+#endif // vnl_io_vector_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.txx
new file mode 100644
index 0000000000000000000000000000000000000000..b06b841e9038c44c660d0727c977357ee67e26de
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector.txx
@@ -0,0 +1,75 @@
+// This is core/vnl/io/vnl_io_vector.txx
+#ifndef vnl_io_vector_txx_
+#define vnl_io_vector_txx_
+//:
+// \file
+
+#include "vnl_io_vector.h"
+#include <vsl/vsl_binary_io.h>
+#include <vsl/vsl_b_read_block_old.h>
+#include <vsl/vsl_block_binary.h>
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T>
+void vsl_b_write(vsl_b_ostream & os, const vnl_vector<T> & p)
+{
+ const short io_version_no = 2;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.size());
+ if (p.size())
+ vsl_block_binary_write(os, p.begin(), p.size());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T>
+void vsl_b_read(vsl_b_istream &is, vnl_vector<T> & p)
+{
+ if (!is) return;
+
+ short ver;
+ unsigned n;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, n);
+ p.set_size(n);
+ if (n)
+ vsl_b_read_block_old(is, p.data_block(), n);
+ break;
+
+ case 2:
+ vsl_b_read(is, n);
+ p.set_size(n);
+ if (n)
+ vsl_block_binary_read(is, p.data_block(), n);
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_vector<T>&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T>
+void vsl_print_summary(vcl_ostream & os,const vnl_vector<T> & p)
+{
+ os<<"Len: "<<p.size()<<" (";
+ for ( unsigned int i =0; i < p.size() && i < 5; ++i )
+ os << p.operator()(i) <<' ';
+ if (p.size() > 5) os << " ...";
+ os << ')';
+}
+
+#define VNL_IO_VECTOR_INSTANTIATE(T) \
+template void vsl_print_summary(vcl_ostream &, const vnl_vector<T > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_vector<T > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_vector<T > &)
+
+#endif // vnl_io_vector_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.h b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.h
new file mode 100644
index 0000000000000000000000000000000000000000..c9e434e8e96c6dd5e36c9480f7db2aeb16b9fb50
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.h
@@ -0,0 +1,25 @@
+// This is core/vnl/io/vnl_io_vector_fixed.h
+#ifndef vnl_io_vector_fixed_h
+#define vnl_io_vector_fixed_h
+//:
+// \file
+// \author Amitha Perera
+// \date Oct 2002
+
+#include <vsl/vsl_fwd.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vcl_iosfwd.h>
+
+//: Binary save vnl_vector_fixed to stream.
+template <class T, unsigned n>
+void vsl_b_write(vsl_b_ostream & os, const vnl_vector_fixed<T,n> & v);
+
+//: Binary load vnl_vector_fixed from stream.
+template <class T, unsigned n>
+void vsl_b_read(vsl_b_istream & is, vnl_vector_fixed<T,n> & v);
+
+//: Print human readable summary of object to a stream
+template <class T, unsigned n>
+void vsl_print_summary(vcl_ostream & os,const vnl_vector_fixed<T,n> & b);
+
+#endif // vnl_io_vector_fixed_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.txx b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.txx
new file mode 100644
index 0000000000000000000000000000000000000000..942502deb9d72bed75dd2db4513747165abbb084
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/io/vnl_io_vector_fixed.txx
@@ -0,0 +1,85 @@
+// This is core/vnl/io/vnl_io_vector_fixed.txx
+#ifndef vnl_io_vector_fixed_txx_
+#define vnl_io_vector_fixed_txx_
+//:
+// \file
+
+#include "vnl_io_vector_fixed.h"
+#include <vsl/vsl_binary_io.h>
+#include <vsl/vsl_b_read_block_old.h>
+#include <vsl/vsl_block_binary.h>
+
+//=================================================================================
+//: Binary save self to stream.
+template<class T, unsigned int n>
+void vsl_b_write(vsl_b_ostream & os, const vnl_vector_fixed<T,n> & p)
+{
+ const short io_version_no = 2;
+ vsl_b_write(os, io_version_no);
+ vsl_b_write(os, p.size());
+ if (p.size())
+ vsl_block_binary_write(os, p.data_block(), p.size());
+}
+
+//=================================================================================
+//: Binary load self from stream.
+template<class T, unsigned int n>
+void vsl_b_read(vsl_b_istream &is, vnl_vector_fixed<T,n> & p)
+{
+ if (!is) return;
+
+ short ver;
+ unsigned stream_n;
+ vsl_b_read(is, ver);
+ switch (ver)
+ {
+ case 1:
+ vsl_b_read(is, stream_n);
+ if ( n == stream_n ) {
+ vsl_b_read_block_old(is, p.begin(), n);
+ } else {
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_vector_fixed<T,n>&)\n"
+ << " Expected n="<<n<<", got "<<stream_n<<'\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+ break;
+
+ case 2:
+ vsl_b_read(is, stream_n);
+ if ( n == stream_n ) {
+ vsl_block_binary_read(is, p.data_block(), n);
+ } else {
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_vector_fixed<T,n>&)\n"
+ << " Expected n="<<n<<", got "<<stream_n<<'\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+ break;
+
+ default:
+ vcl_cerr << "I/O ERROR: vsl_b_read(vsl_b_istream&, vnl_vector_fixed<T,n>&)\n"
+ << " Unknown version number "<< ver << '\n';
+ is.is().clear(vcl_ios::badbit); // Set an unrecoverable IO error on stream
+ return;
+ }
+}
+
+//====================================================================================
+//: Output a human readable summary to the stream
+template<class T, unsigned int n>
+void vsl_print_summary(vcl_ostream & os,const vnl_vector_fixed<T,n> & p)
+{
+ os<<"Len: "<<p.size()<<" [fixed] (";
+ for ( unsigned int i =0; i < p.size() && i < 5; ++i )
+ os << p(i) <<' ';
+ if (p.size() > 5) os << " ...";
+ os << ')';
+}
+
+#define VNL_IO_VECTOR_FIXED_INSTANTIATE(T,n) \
+template void vsl_print_summary(vcl_ostream &, const vnl_vector_fixed<T,n > &); \
+template void vsl_b_read(vsl_b_istream &, vnl_vector_fixed<T,n > &); \
+template void vsl_b_write(vsl_b_ostream &, const vnl_vector_fixed<T,n > &)
+
+#endif // vnl_io_vector_fixed_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/core/vnl/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/core/vnl/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..f847f62ee20f678c4eb70cca6b6e54b8deac6192
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/CMakeLists.txt
@@ -0,0 +1,80 @@
+# This is core/vnl/tests/CMakeLists.txt
+
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/core/vnl/tests)
+
+ADD_EXECUTABLE( vnl_test_all
+ # Driver source and utilities
+ test_driver.cxx
+
+ # The tests
+ test_bignum.cxx
+ test_complex.cxx
+ test_inverse.cxx
+ test_diag_matrix.cxx
+ test_file_matrix.cxx
+ test_finite.cxx
+ test_math.cxx
+ #test_matlab.cxx # Removing for ITK: needs vul and vpl
+ test_matrix.cxx
+ test_matrix_exp.cxx
+ test_matrix_fixed.cxx
+ test_vector_fixed_ref.cxx
+ test_matrix_fixed_ref.cxx
+ test_numeric_traits.cxx
+ test_rational.cxx
+ test_real_polynomial.cxx
+ test_resize.cxx
+ test_sample.cxx
+ test_sym_matrix.cxx
+ test_transpose.cxx
+ test_fastops.cxx
+ test_vector.cxx
+ test_gamma.cxx
+ test_random.cxx
+ test_arithmetic.cxx test_arithmetic_body.h
+ test_hungarian_algorithm.cxx
+ test_integrant.cxx
+ test_bessel.cxx
+)
+
+IF(CMAKE_COMPILER_IS_GNUCXX)
+ SET_SOURCE_FILES_PROPERTIES(test_rational.cxx PROPERTIES COMPILE_FLAGS -O1)
+ SET_SOURCE_FILES_PROPERTIES(test_bignum.cxx PROPERTIES COMPILE_FLAGS -O3)
+ SET_SOURCE_FILES_PROPERTIES(test_finite.cxx PROPERTIES COMPILE_FLAGS -O0)
+ENDIF(CMAKE_COMPILER_IS_GNUCXX)
+
+TARGET_LINK_LIBRARIES(vnl_test_all itkvnl itktestlib ${CMAKE_THREAD_LIBS})
+
+ADD_EXECUTABLE(vnl_basic_operation_timings basic_operation_timings.cxx)
+TARGET_LINK_LIBRARIES(vnl_basic_operation_timings itkvnl)
+
+ADD_TEST( vnl_test_bignum vnl_test_all test_bignum )
+ADD_TEST( vnl_test_complex vnl_test_all test_complex )
+ADD_TEST( vnl_test_diag_matrix vnl_test_all test_diag_matrix )
+ADD_TEST( vnl_test_file_matrix vnl_test_all test_file_matrix )
+ADD_TEST( vnl_test_finite vnl_test_all test_finite )
+ADD_TEST( vnl_test_inverse vnl_test_all test_inverse )
+ADD_TEST( vnl_test_math vnl_test_all test_math )
+#ADD_TEST( vnl_test_matlab vnl_test_all test_matlab )
+ADD_TEST( vnl_test_matrix vnl_test_all test_matrix )
+ADD_TEST( vnl_test_matrix_exp vnl_test_all test_matrix_exp )
+ADD_TEST( vnl_test_matrix_fixed vnl_test_all test_matrix_fixed )
+ADD_TEST( vnl_test_vector_fixed_ref vnl_test_all test_vector_fixed_ref )
+ADD_TEST( vnl_test_matrix_fixed_ref vnl_test_all test_matrix_fixed_ref )
+ADD_TEST( vnl_test_numeric_traits vnl_test_all test_numeric_traits )
+ADD_TEST( vnl_test_random vnl_test_all test_random )
+ADD_TEST( vnl_test_rational vnl_test_all test_rational )
+ADD_TEST( vnl_test_real_polynomial vnl_test_all test_real_polynomial )
+ADD_TEST( vnl_test_resize vnl_test_all test_resize )
+ADD_TEST( vnl_test_sample vnl_test_all test_sample )
+ADD_TEST( vnl_test_sym_matrix vnl_test_all test_sym_matrix )
+ADD_TEST( vnl_test_transpose vnl_test_all test_transpose )
+ADD_TEST( vnl_test_fastops vnl_test_all test_fastops )
+ADD_TEST( vnl_test_vector vnl_test_all test_vector )
+ADD_TEST( vnl_test_gamma vnl_test_all test_gamma )
+ADD_TEST( vnl_test_arithmetic vnl_test_all test_arithmetic )
+ADD_TEST( vnl_test_hungarian_algorithm vnl_test_all test_hungarian_algorithm )
+ADD_TEST( vnl_test_integrant vnl_test_all test_integrant )
+ADD_TEST( vnl_test_bessel vnl_test_all test_bessel )
+ADD_EXECUTABLE(vnl_test_include test_include.cxx)
+TARGET_LINK_LIBRARIES(vnl_test_include itkvnl_algo itkvnl)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/basic_operation_timings.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/basic_operation_timings.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..39ef64066bf8296f234cdb179de15a5a3d780fb1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/basic_operation_timings.cxx
@@ -0,0 +1,203 @@
+//:
+// \file
+// \brief Tool to test performance of various vnl operations.
+// \author Ian Scott
+
+#include <vcl_vector.h>
+#include <vcl_iostream.h>
+#include <vcl_fstream.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_random.h>
+#include <vcl_ctime.h>
+#include <vcl_algorithm.h>
+#include <vcl_string.h>
+
+const unsigned nstests = 10;
+
+
+void fill_with_rng(double * begin, double * end, double a, double b, vnl_random &rng)
+{
+ while (begin != end)
+ {
+ *begin = rng.drand64(a, b);
+ ++begin;
+ }
+}
+
+void fill_with_rng(float * begin, float * end, float a, float b, vnl_random &rng)
+{
+ while (begin != end)
+ {
+ *begin = (float) rng.drand32(a, b);
+ ++begin;
+ }
+}
+
+template <class T>
+void distance_squared(const vcl_vector<vnl_vector<T> > &s1,
+ const vcl_vector<vnl_vector<T> > &s2,
+ vcl_vector<T> & d, int n_loops)
+{
+ vnl_vector<double> stats(nstests);
+ for (unsigned st=0;st<nstests;++st)
+ {
+ vcl_clock_t t0=vcl_clock();
+ for (int l=0;l<n_loops;++l)
+ {
+ for (unsigned i=0;i<d.size();++i)
+ d[i] = vnl_vector_ssd(s1[i], s2[i]);
+ }
+ vcl_clock_t t1=vcl_clock();
+ stats[st] = (1e9*((double(t1)-double(t0)))/((double)n_loops*(double)CLOCKS_PER_SEC));
+ }
+ vcl_sort(stats.begin(), stats.end());
+ vcl_cout<<" Mean: "<<stats.mean()
+ <<"ns +/-"<<stats((unsigned)(nstests*0.75))-stats((unsigned)(nstests*0.25))<<"ns\n\n";
+}
+
+template <class T>
+void dot_product(const vcl_vector<vnl_vector<T> > &s1,
+ const vcl_vector<vnl_vector<T> > &s2,
+ vcl_vector<T> & d, int n_loops)
+{
+ vnl_vector<double> stats(nstests);
+ for (unsigned st=0;st<nstests;++st)
+ {
+ vcl_clock_t t0=vcl_clock();
+ for (int l=0;l<n_loops;++l)
+ {
+ for (unsigned i=0;i<d.size();++i)
+ d[i] = dot_product(s1[i], s2[i]);
+ }
+ vcl_clock_t t1=vcl_clock();
+ stats[st] = (1e9*((double(t1)-double(t0)))/((double)n_loops*(double)CLOCKS_PER_SEC));
+ }
+ vcl_sort(stats.begin(), stats.end());
+ vcl_cout<<" Mean: "<<stats.mean()
+ <<"ns +/-"<<stats((unsigned)(nstests*0.75))-stats((unsigned)(nstests*0.25))<<"ns\n\n";
+}
+
+template <class T>
+void mat_x_vec(const vnl_matrix<T> &s1, const vcl_vector<vnl_vector<T> > &s2,
+ int n_loops)
+{
+ vnl_vector<double> stats(nstests);
+ for (unsigned st=0;st<nstests;++st)
+ {
+ vcl_clock_t t0=vcl_clock();
+ for (int l=0;l<n_loops;++l)
+ {
+ for (unsigned i=0;i<s2.size();++i)
+ s1 * s2[i];
+ }
+ vcl_clock_t t1=vcl_clock();
+ stats[st] = (1e6*((double(t1)-double(t0)))/((double)n_loops*(double)CLOCKS_PER_SEC));
+ }
+ vcl_sort(stats.begin(), stats.end());
+ vcl_cout<<" Mean: "<<stats.mean()
+ <<"us +/-"<<stats((unsigned)(nstests*0.75))-stats((unsigned)(nstests*0.25))<<"us\n\n";
+}
+
+template <class T>
+void vec_x_mat(const vcl_vector<vnl_vector<T> > &s1, const vnl_matrix<T> &s2,
+ int n_loops)
+{
+ vnl_vector<double> stats(nstests);
+ for (unsigned st=0;st<nstests;++st)
+ {
+ vcl_clock_t t0=vcl_clock();
+ for (int l=0;l<n_loops;++l)
+ {
+ for (unsigned i=0;i<s2.size();++i)
+ s1[i] * s2;
+ }
+ vcl_clock_t t1=vcl_clock();
+ stats[st] = (1e6*((double(t1)-double(t0)))/((double)n_loops*(double)CLOCKS_PER_SEC));
+ }
+ vcl_sort(stats.begin(), stats.end());
+ vcl_cout<<" Mean: "<<stats.mean()
+ <<"us +/-"<<stats((unsigned)(nstests*0.75))-stats((unsigned)(nstests*0.25))<<"us\n\n";
+}
+
+template <class T>
+void print_pointers(const vcl_vector<vnl_vector<T> >&va, const vcl_vector<vnl_vector<T> >&vb,
+ const vcl_vector<vnl_vector<T> >&vc, const vcl_vector<T>&na,
+ const vnl_matrix<T>&ma, const vcl_string& file)
+{
+ unsigned i;
+ vcl_ofstream os(file.c_str());
+ os << "Data values\n"
+ << "\nva:" << &va.front() << ' ' << &va.back() << '\n';
+ for (i=0;i<va.size();++i)
+ { os << va[i].data_block() << va[i].size() << '\n'; }
+
+ os << "\n\nvb:" << &vb.front() << ' ' << &vb.back() << '\n';
+ for (i=0;i<vb.size();++i)
+ { os << vb[i].data_block() << vb[i].size() << '\n'; }
+
+ os << "\n\nvc:" << &vc.front() << ' ' << &vc.back() << '\n';
+ for (i=0;i<vc.size();++i)
+ { os << vc[i].data_block() << vc[i].size() << '\n'; }
+
+ os << "\n\nna:" << &na.front() << ' ' << &na.back() << '\n'
+
+ << "\n\nma:" << ma.data_block() << ' ' << ma.rows() << ' ' << ma.cols() << '\n';
+ for (i=0;i<ma.rows();++i)
+ { os << ma[i] << '\n'; }
+}
+
+template <class T>
+void run_for_size(unsigned m, unsigned n, T /*dummy*/, const char * type, const char *size,
+ vnl_random &rng)
+{
+ const unsigned n_data = 10;
+ vcl_vector<vnl_vector<T> > x(n_data), y(n_data), z(n_data);
+ vcl_vector<T> v(n_data);
+ vnl_matrix<T> A(m,n);
+
+ for (unsigned k=0;k<n_data;++k)
+ {
+ x[k].set_size(n);
+ z[k].set_size(m);
+ y[k].set_size(m);
+ fill_with_rng(x[k].begin(), x[k].end(), T(-10000),T(10000), rng);
+ fill_with_rng(y[k].begin(), y[k].end(), T(-10000),T(10000), rng);
+ fill_with_rng(z[k].begin(), z[k].end(), T(-10000),T(10000), rng);
+ }
+ fill_with_rng(A.begin(), A.end(), -10000,10000, rng);
+
+ int n_loops = 1000000/m;
+ vcl_cout<<"\nTimes to operator on "<<type<<' '<<m<<"-d vectors and "
+ <<m<<" x "<<n<<" matrices, size " << size << '\n'
+ <<"Sum of square differences " << vcl_flush;
+ distance_squared(z,y,v,n_loops);
+// print_pointers(z, y, x, v, A, vcl_string("testA")+type+size);
+ vcl_cout<<"Vector dot product " << vcl_flush;
+// print_pointers(z, y, x, v, A, vcl_string("testB")+type+size);
+ dot_product(z,y,v,n_loops);
+// print_pointers(z, y, x, v, A, vcl_string("testC")+type+size);
+ vcl_cout<<"Matrix x Vector multiplication " << vcl_flush;
+ mat_x_vec(A,x,n_loops/n+1);
+// print_pointers(z, y, x, v, A, vcl_string("testD")+type+size);
+// vcl_cout<<"Vector x Matrix multiplication " << vcl_flush;
+// vec_x_mat(y,A,n_loops/n+1);
+// print_pointers(z, y, x, v, A, vcl_string("testE")+type+size);
+}
+
+int main(int, char *[])
+{
+ vcl_cout << "Range = 75%tile-25%tile\n";
+ vnl_random rng(9667566ul);
+ run_for_size(2, 20, double(), "double", "2x20", rng);
+ run_for_size(300, 300, double(), "double", "300x300", rng);
+ run_for_size(100, 10000, double(), "double", "100x10000", rng);
+ run_for_size(10000, 100, double(), "double", "10000x100", rng);
+ run_for_size(30, 30000, double(), "double", "30x30000", rng);
+ run_for_size(2, 20, float(), "float", "2x20", rng);
+ run_for_size(300, 300, float(), "float", "300x300", rng);
+ run_for_size(100, 10000, float(), "float", "100x10000", rng);
+ run_for_size(10000, 100, float(), "float", "10000x100", rng);
+ run_for_size(30, 30000, float(), "float", "30x30000", rng);
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/data_3x3_matrix b/Utilities/ITK/Utilities/vxl/core/vnl/tests/data_3x3_matrix
new file mode 100644
index 0000000000000000000000000000000000000000..eb58eb1e75b4da23ed250da8964f5fc49ee0d281
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/data_3x3_matrix
@@ -0,0 +1,3 @@
+ 0.9501 0.4860 0.4565
+ 0.2311 0.8913 0.0185
+ 0.6068 0.7621 0.8214
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..c34b4efbe9bbd2cd07cb108ffc9c32ff0156f391
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic.cxx
@@ -0,0 +1,82 @@
+#include <testlib/testlib_test.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector_ref.h>
+#include <vnl/vnl_matrix_ref.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix_fixed.h>
+
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+
+
+// --- dynamic ------------------------------
+
+#define NewMat(mat, r,c,data) \
+ assert( sizeof(data) >= r*c*sizeof(double) ); \
+ vnl_matrix<double> mat( data, r, c )
+#define NewVec(vec, n,data) \
+ assert( sizeof(data) >= n*sizeof(double) ); \
+ vnl_vector<double> vec( data, n )
+
+static
+void
+test_arithmetic_dynamic()
+{
+#include "test_arithmetic_body.h"
+}
+
+#undef NewMat
+#undef NewVec
+
+
+// --- ref ----------------------------------
+
+#define NewMat(mat, r,c,data) \
+ assert( sizeof(data) >= r*c*sizeof(double) ); \
+ vnl_matrix_ref<double> mat( r, c, data )
+#define NewVec(vec, n,data) \
+ assert( sizeof(data) >= n*sizeof(double) ); \
+ vnl_vector_ref<double> vec( n, data )
+
+static
+void
+test_arithmetic_ref()
+{
+#include "test_arithmetic_body.h"
+}
+
+
+// --- fixed --------------------------------
+
+#undef NewMat
+#undef NewVec
+
+#define NewMat(mat, r,c,data) \
+ assert( sizeof(data) >= r*c*sizeof(double) ); \
+ vnl_matrix_fixed<double,r,c> mat( data )
+#define NewVec(vec, n,data) \
+ assert( sizeof(data) >= n*sizeof(double) ); \
+ vnl_vector_fixed<double,n> vec( data )
+
+void
+test_arithmetic_fixed()
+{
+#include "test_arithmetic_body.h"
+}
+
+#undef NewMat
+#undef NewVec
+
+void test_arithmetic()
+{
+ vcl_cout << "---- dynamic ----\n";
+ test_arithmetic_dynamic();
+ vcl_cout << "---- reference ----\n";
+ test_arithmetic_ref();
+ vcl_cout << "---- fixed ----\n";
+ test_arithmetic_fixed();
+}
+
+TESTMAIN( test_arithmetic );
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic_body.h b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic_body.h
new file mode 100644
index 0000000000000000000000000000000000000000..d718ca01fddb2e69c9c3a20af31ae7701e09b3fe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_arithmetic_body.h
@@ -0,0 +1,301 @@
+#ifndef vnl_test_arithmetic_body_h_
+#define vnl_test_arithmetic_body_h_
+// See test_arithmetic.cxx for the actual test.
+
+// This is a "generic" test body. It expects the macros NewMat and
+// NewVec to be defined. The semantics are:
+//
+// NewMat( m, r, c, data ) : define a r x c double matrix m
+// initialized from (or referring to) data.
+// NewVec( v, n, data ) : define an n-dimensional double vector v
+// initialized from (or referring to) data.
+//
+// data will be an array of size >= r*c for NewMat, >= n for NewVec.
+
+
+//void
+//test_arithmetic()
+//{
+ double m1_data[] = { 1, 2, 3, 4, 5, 6 };
+ double m2_data[] = { 7, 8, 9, 1, 2, 3 };
+ double m3_data[] = { 3, 4, 5, 6, 7, 8 };
+ double v1_data[] = { 3, 2 };
+ double v2_data[] = { 1, 4 };
+ double v3_data[] = { 1, 2, 3 };
+
+ double m1_data_copy[] = { 1, 2, 3, 4, 5, 6 };
+ double m2_data_copy[] = { 7, 8, 9, 1, 2, 3 };
+ //double m3_data_copy[] = { 3, 4, 5, 6, 7, 8 };
+ double v1_data_copy[] = { 3, 2 };
+ double v2_data_copy[] = { 1, 4 };
+ //double v3_data_copy[] = { 1, 2, 3 };
+
+ // Storage for temporary vectors/matrices, when the actual type is a
+ // reference.
+ double tmp1[100];
+
+ testlib_test_begin( "3x2 matrix construction" );
+ NewMat( m1, 3, 2, m1_data );
+ testlib_test_perform(
+ m1.rows() == 3 && m1.cols() == 2 &&
+ m1(0,0)==1 && m1(0,1)==2 &&
+ m1(1,0)==3 && m1(1,1)==4 &&
+ m1(2,0)==5 && m1(2,1)==6
+ );
+
+ testlib_test_begin( "2x3 matrix construction" );
+ NewMat( m3, 2, 3, m3_data );
+ testlib_test_perform(
+ m3.rows() == 2 && m3.cols() == 3 &&
+ m3(0,0)==3 && m3(0,1)==4 && m3(0,2)==5 &&
+ m3(1,0)==6 && m3(1,1)==7 && m3(1,2)==8
+ );
+
+ testlib_test_begin( "2 vector construction" );
+ NewVec( v1, 2, v1_data );
+ testlib_test_perform(
+ v1.size() == 2 &&
+ v1[0] == 3 && v1[1] == 2
+ );
+
+ testlib_test_begin( "3 vector construction" );
+ NewVec( v3, 3, v3_data );
+ testlib_test_perform(
+ v3.size() == 3 &&
+ v3[0] == 1 && v3[1] == 2 && v3[2] == 3
+ );
+
+
+ // Assume these will work
+ NewMat( m2, 3, 2, m2_data );
+ NewVec( v2, 2, v2_data );
+ NewMat( m1_orig, 3, 2, m1_data_copy );
+ NewMat( m2_orig, 3, 2, m2_data_copy );
+ //NewMat( m3_orig, 3, 2, m3_data_copy );
+ NewVec( v1_orig, 2, v1_data_copy );
+ NewVec( v2_orig, 2, v2_data_copy );
+ //NewVec( v3_orig, 2, v3_data_copy );
+
+ // Equality
+ {
+ TEST( "Equality operator/1", v1 == v1_orig, true );
+ TEST( "Equality operator/2", v1 == v2_orig, false );
+ TEST( "Inequality operator/1", v1 != v1_orig, false );
+ TEST( "Inequality operator/2", v1 != v2_orig, true );
+ }
+
+ // Assignment should do a data copy, even if the types are
+ // references.
+ {
+ double v_result_data[] = { 9, 2 };
+ NewVec( v_result, 2, v_result_data );
+
+ NewVec( tv, 2, tmp1 );
+ tv = v1;
+ tv(0) = 9;
+ TEST( "Assignment on vector", tv == v_result && v1 == v1_orig, true );
+
+ double m_result_data[] = { 1, 2, 3, 8, 5, 6 };
+ NewMat( m_result, 3, 2, m_result_data );
+
+ NewMat( tm, 3, 2, tmp1 );
+ tm = m1;
+ tm(1,1) = 8;
+ TEST( "Assignment on matrix", tm == m_result && m1 == m1_orig, true );
+ }
+
+ // Addition
+ {
+ // Vector-vector
+ double v_add1_data[] = { 4, 6 };
+ NewVec( v_add1, 2, v_add1_data );
+
+ NewVec( tv1, 2, tmp1 );
+ tv1 = v1;
+ tv1 += v2;
+ TEST( "v += v", tv1 == v_add1 && v2 == v2_orig, true );
+ TEST( "v + v", v1+v2 == v_add1 && v1 == v1_orig && v2 == v2_orig, true );
+
+ // Vector-scalar
+ double v_add2_data[] = { 8, 7 };
+ NewVec( v_add2, 2, v_add2_data );
+
+ NewVec( tv2, 2, tmp1 );
+ tv2 = v1;
+ tv2 += 5;
+ TEST( "v += s", tv2 == v_add2, true );
+ TEST( "v + s", v1+5.0 == v_add2 && v1 == v1_orig, true );
+ TEST( "s + v", 5.0+v1 == v_add2 && v1 == v1_orig, true );
+
+ // Matrix-matrix
+ double m_add1_data[] = { 8, 10, 12, 5, 7, 9 };
+ NewMat( m_add1, 3, 2, m_add1_data );
+
+ NewMat( mv1, 3, 2, tmp1 );
+ mv1 = m1;
+ mv1 += m2;
+ TEST( "m += m", mv1 == m_add1 && m2 == m2_orig, true );
+ TEST( "m + m", m1+m2 == m_add1 && m1 == m1_orig && m2 == m2_orig, true );
+
+ // Matrix-scalar
+ double m_add2_data[] = { 4, 5, 6, 7, 8, 9 };
+ NewMat( m_add2, 3, 2, m_add2_data );
+
+ NewMat( mv2, 3, 2, tmp1 );
+ mv2 = m1;
+ mv2 += 3;
+ TEST( "m += s", mv2 == m_add2, true );
+ TEST( "m + s", m1+3.0 == m_add2 && m1 == m1_orig, true );
+ TEST( "s + m", 3.0+m1 == m_add2 && m1 == m1_orig, true );
+ }
+
+ // Subtraction
+ {
+ // Vector-vector
+ double v_sub1_data[] = { 2, -2 };
+ NewVec( v_sub1, 2, v_sub1_data );
+
+ NewVec( tv1, 2, tmp1 );
+ tv1 = v1;
+ tv1 -= v2;
+ TEST( "v -= v", tv1 == v_sub1 && v2 == v2_orig, true );
+ TEST( "v - v", v1-v2 == v_sub1 && v1 == v1_orig && v2 == v2_orig, true );
+
+ // Vector-scalar
+ double v_sub2_data[] = { 2, 1 };
+ NewVec( v_sub2, 2, v_sub2_data );
+ double v_sub3_data[] = { -2, -1 };
+ NewVec( v_sub3, 2, v_sub3_data );
+
+ NewVec( tv2, 2, tmp1 );
+ tv2 = v1;
+ tv2 -= 1;
+ TEST( "v -= s", tv2 == v_sub2, true );
+ TEST( "v - s", v1-1.0 == v_sub2 && v1 == v1_orig, true );
+ TEST( "s - v", 1.0-v1 == v_sub3 && v1 == v1_orig, true );
+
+ // Matrix-matrix
+ double m_sub1_data[] = { -6, -6, -6, 3, 3, 3 };
+ NewMat( m_sub1, 3, 2, m_sub1_data );
+
+ NewMat( mv1, 3, 2, tmp1 );
+ mv1 = m1;
+ mv1 -= m2;
+ TEST( "m -= m", mv1 == m_sub1 && m2 == m2_orig, true );
+ TEST( "m - m", m1-m2 == m_sub1 && m1 == m1_orig && m2 == m2_orig, true );
+
+ // Matrix+scalar
+ double m_sub2_data[] = { 0, 1, 2, 3, 4, 5 };
+ double m_sub3_data[] = { 0, -1, -2, -3, -4, -5 };
+ NewMat( m_sub2, 3, 2, m_sub2_data );
+ NewMat( m_sub3, 3, 2, m_sub3_data );
+
+ NewMat( mv2, 3, 2, tmp1 );
+ mv2 = m1;
+ mv2 -= 1;
+ TEST( "m -= s", mv2 == m_sub2, true );
+ TEST( "m - s", m1-1.0 == m_sub2 && m1 == m1_orig, true );
+ TEST( "s - m", 1.0-m1 == m_sub3 && m1 == m1_orig, true );
+ }
+
+ // Multiplication
+ {
+ // Vector-scalar
+ double v_mul1_data[] = { 9, 6 };
+ NewVec( v_mul1, 2, v_mul1_data );
+
+ NewVec( tv1, 2, tmp1 );
+ tv1 = v1;
+ tv1 *= 3;
+ TEST( "v *= s", tv1 == v_mul1, true );
+ TEST( "v * s", v1*3.0 == v_mul1 && v1 == v1_orig, true );
+ TEST( "s * v", 3.0*v1 == v_mul1 && v1 == v1_orig, true );
+
+ // Matrix-scalar
+ double m_mul1_data[] = { 2, 4, 6, 8, 10, 12 };
+ NewMat( m_mul1, 3, 2, m_mul1_data );
+
+ NewMat( mv1, 3, 2, tmp1 );
+ mv1 = m1;
+ mv1 *= 2;
+ TEST( "m *= s", mv1 == m_mul1, true );
+ TEST( "m * s", m1*2.0 == m_mul1 && m1 == m1_orig, true );
+ TEST( "s * m", 2.0*m1 == m_mul1 && m1 == m1_orig, true );
+
+ // Matrix-vector
+ double v_mul2_data[] = { 7, 17, 27 };
+ NewVec( v_mul2, 3, v_mul2_data );
+
+ TEST( "m * v", m1*v1 == v_mul2, true );
+ }
+
+ // Division
+ {
+ // Vector-scalar
+ double v_div1_data[] = { 1.5, 1 };
+ NewVec( v_div1, 2, v_div1_data );
+
+ NewVec( tv1, 2, tmp1 );
+ tv1 = v1;
+ tv1 /= 2;
+ TEST( "v /= s", tv1 == v_div1, true );
+ TEST( "v / s", v1/2.0 == v_div1 && v1 == v1_orig, true );
+
+ // Matrix+scalar
+ double m_div1_data[] = { 0.5, 1.0, 1.5, 2.0, 2.5, 3.0 };
+ NewMat( m_div1, 3, 2, m_div1_data );
+
+ NewMat( tm1, 3, 2, tmp1 );
+ tm1 = m1;
+ tm1 /= 2;
+ TEST( "m /= s", tm1 == m_div1, true );
+ TEST( "m / s", m1/2.0 == m_div1 && m1 == m1_orig, true );
+ }
+
+ // Element product
+ {
+ // Vector
+ double v_ep1_data[] = { 3, 8 };
+ NewVec( v_ep1, 2, v_ep1_data );
+
+ TEST( "element_product(v,v)", element_product(v1,v2) == v_ep1, true );
+
+ // Matrix
+ double m_ep1_data[] = { 7, 16, 27, 4, 10, 18 };
+ NewMat( m_ep1, 3, 2, m_ep1_data );
+
+ TEST( "element_product(m,m)", element_product(m1,m2) == m_ep1, true );
+ }
+
+ // Element quotient
+ {
+ // Vector
+ double v_eq1_data[] = { 3, 0.5 };
+ NewVec( v_eq1, 2, v_eq1_data );
+
+ TEST( "element_quotient(v,v)", element_quotient(v1,v2) == v_eq1, true );
+
+ // Matrix
+ double m_eq1_data[] = { 1.0/7.0, 2.0/8.0, 3.0/9.0, 4.0/1.0, 5.0/2.0, 6.0/3.0 };
+ NewMat( m_eq1, 3, 2, m_eq1_data );
+
+ TEST( "element_quotient(m,m)", element_quotient(m1,m2) == m_eq1, true );
+ }
+
+ // Negation
+ {
+ // Vector
+ double v_neg1_data[] = { -3, -2 };
+ NewVec( v_neg1, 2, v_neg1_data );
+
+ TEST( "-v", -v1 == v_neg1 && v1 == v1_orig, true );
+
+ // Matrix
+ double m_neg1_data[] = { -1, -2, -3, -4, -5, -6 };
+ NewMat( m_neg1, 3, 2, m_neg1_data );
+
+ TEST( "-m", -m1 == m_neg1 && m1 == m1_orig, true );
+ }
+//}
+
+#endif // vnl_test_arithmetic_body_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bessel.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bessel.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..55e1865db1b3714d5693e0acb065858253aa6651
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bessel.cxx
@@ -0,0 +1,33 @@
+// This is core/vnl/tests/test_bessel.cxx
+#include <vnl/vnl_bessel.h>
+#include <vcl_fstream.h>
+#include <testlib/testlib_test.h>
+
+
+static void test_bessel()
+{
+ TEST_NEAR("J_0(0)=1.0",vnl_bessel(0,0.0),1.0,1e-8);
+
+ // First zero of Bessel function of order 0
+ TEST_NEAR("J_0(2.4048)=0.0",vnl_bessel(0,2.4048),0.0,1e-4);
+ // Second zero of Bessel function of order 0
+ TEST_NEAR("J_0(5.5201)=0.0",vnl_bessel(0,5.5201),0.0,1e-4);
+
+ TEST_NEAR("J_1(0)=0.0",vnl_bessel(1,0.0),0.0,1e-5);
+
+ // First zero of Bessel function of order 1
+ TEST_NEAR("J_1(3.8315)=0.0",vnl_bessel(1,3.8315),0.0,1e-4);
+
+ TEST_NEAR("bessel0(1.23)",vnl_bessel0(1.23),vnl_bessel(0,1.23),1e-8);
+ TEST_NEAR("bessel0(0.23)",vnl_bessel0(0.23),vnl_bessel(0,0.23),1e-8);
+ TEST_NEAR("bessel0(0.001)",vnl_bessel0(0.001),1.0,1e-5);
+
+ // Test consistency
+ vnl_vector<double> J(3);
+ vnl_bessel(2,1.234,J);
+ TEST_NEAR("bessel(0,1.234)",vnl_bessel(0,1.234),J[0],1e-8);
+ TEST_NEAR("bessel(1,1.234)",vnl_bessel(1,1.234),J[1],1e-8);
+ TEST_NEAR("bessel(2,1.234)",vnl_bessel(2,1.234),J[2],1e-8);
+}
+
+TESTMAIN(test_bessel);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bignum.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bignum.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..36a77304b98e33de155ae8b30c312f760e3cc1ff
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_bignum.cxx
@@ -0,0 +1,758 @@
+//:
+// \file
+// converted from COOL/test/test_BigNum.C by Peter Vanroose, 25 April 2002.
+
+#include <vcl_iostream.h>
+#include <vcl_limits.h> // for vcl_numeric_limits<double>::infinity()
+#ifndef __alpha__ // On Alpha, compiler runs out of memory when including these
+# include <vcl_sstream.h>
+# include <vcl_iomanip.h>
+#endif
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_numeric_traits.h> // for vnl_numeric_traits<double>::maxval
+
+#include <testlib/testlib_test.h>
+
+static void run_constructor_tests()
+{
+ vcl_cout << "\nbignum constructor tests:\n";
+
+ vcl_cout << "long constructor:\n";
+ {vnl_bignum b(0L); TEST("vnl_bignum b(0L);", b, 0L);}
+ {vnl_bignum b(1L); TEST("vnl_bignum b(1L);", b, 1L);}
+ {vnl_bignum b(-1L); TEST("vnl_bignum b(-1L);", b, -1L);}
+ {vnl_bignum b(0x7fffL); TEST("vnl_bignum b(0x7fffL);", b, 0x7fffL);}
+ {vnl_bignum b(-0x7fffL); TEST("vnl_bignum b(-0x7fffL);", b, -0x7fffL);}
+ {vnl_bignum b(0x7fffffffL); TEST("vnl_bignum b(0x7fffffffL);", b, 0x7fffffffL);}
+ {vnl_bignum b(-0x7fffffffL); TEST("vnl_bignum b(-0x7fffffffL);", b, -0x7fffffffL);}
+ {vnl_bignum b(0xf00000L); TEST("vnl_bignum b(0xf00000L);", b, 0xf00000);}
+
+ vcl_cout << "double constructor:\n";
+ {vnl_bignum b(0.0); TEST("vnl_bignum b(0.0);", (double)b, 0.0);}
+ {vnl_bignum b(1.0); TEST("vnl_bignum b(1.0);", (double)b, 1.0);}
+ {vnl_bignum b(-1.0); TEST("vnl_bignum b(-1.0);", (double)b, -1.0);}
+ {vnl_bignum b(vnl_numeric_traits<double>::maxval);
+ TEST("vnl_bignum b(vnl_numeric_traits<double>::maxval);", (double)b, vnl_numeric_traits<double>::maxval);}
+ {vnl_bignum b(-vnl_numeric_traits<double>::maxval);
+ TEST("vnl_bignum b(-vnl_numeric_traits<double>::maxval);", (double)b, -vnl_numeric_traits<double>::maxval);}
+ {vnl_bignum b(1234567.0); TEST("vnl_bignum b(1234567.0);", (double)b, 1234567.0);}
+ {vnl_bignum b(-1234567.0); TEST("vnl_bignum b(-1234567.0);", (double)b, -1234567.0);}
+ {vnl_bignum b(1234567e3); TEST("vnl_bignum b(1234567e3);", (double)b, 1234567e3);}
+ {vnl_bignum b(-1234567e3); TEST("vnl_bignum b(-1234567e3);", (double)b, -1234567e3);}
+ {vnl_bignum b(double(0xf00000)); TEST("vnl_bignum b(double(0xf00000));", b, 0xf00000);}
+
+ vcl_cout << "long double constructor:\n";
+ {vnl_bignum b(0.0L); TEST("vnl_bignum b(0.0L);", (long double)b, 0.0L);}
+ {vnl_bignum b(1.0L); TEST("vnl_bignum b(1.0L);", (long double)b, 1.0L);}
+ {vnl_bignum b(-1.0L); TEST("vnl_bignum b(-1.0L);", (long double)b, -1.0L);}
+ {vnl_bignum b(1234567.0L); TEST("vnl_bignum b(1234567.0L);", (long double)b, 1234567.0L);}
+ {vnl_bignum b(-1234567.0L); TEST("vnl_bignum b(-1234567.0L);", (long double)b, -1234567.0L);}
+ {vnl_bignum b(1234567e3L); TEST("vnl_bignum b(1234567e3L);", (long double)b, 1234567e3L);}
+ {vnl_bignum b(-1234567e3L); TEST("vnl_bignum b(-1234567e3L);", (long double)b, -1234567e3L);}
+ {vnl_bignum b((long double)(0xf00000)); TEST("vnl_bignum b((long double)(0xf00000));", (long double)b, (long double)0xf00000);}
+
+ vcl_cout << "char* constructor:\n";
+ {vnl_bignum b("-1"); TEST("vnl_bignum b(\"-1\");", b, -1L);}
+ {vnl_bignum b("+1"); TEST("vnl_bignum b(\"+1\");", b, 1L);}
+ {vnl_bignum b("1"); TEST("vnl_bignum b(\"1\");", b, 1L);}
+ {vnl_bignum b("123"); TEST("vnl_bignum b(\"123\");", b, 123L);}
+ {vnl_bignum b("123e5"); TEST("vnl_bignum b(\"123e5\");", b, 12300000L);}
+ {vnl_bignum b("123e+4"); TEST("vnl_bignum b(\"123e+4\");", b, 1230000L);}
+ {vnl_bignum b("123e12"); TEST("vnl_bignum b(\"123e12\");", (double)b, 123e12);}
+#ifndef __alpha__ // On Alpha, compiler runs out of memory when using <sstream>
+ {vnl_bignum b("-1e120"); vcl_stringstream s; s << b; vcl_cout << b << '\n';
+ // verify that b outputs as "-1000...00" (120 zeros)
+ bool t = s.str()[0] == '-' && s.str()[1] == '1';
+ for (int i=0; i<120; ++i) t = t && s.str()[i+2] == '0';
+ TEST("vnl_bignum b(\"-1e120\") outputs first 122 digits as \"-10000...00\"", t, true);
+ // This isolates a problem that used to be part of the previous test.
+ // I don't think this test failure is a bug in vnl.
+ // vnl_bignum seems to populate the stringstream with 122 chars,
+ // but the stringstream then reports its size as something else
+ // on some systems. - FWW
+ TEST("vnl_bignum b(\"-1e120\") outputs a length 122 string", s.str().length(), 122);
+ vcl_cout << "length of string: " << s.str().length() << vcl_endl;
+ }
+#else
+ {vnl_bignum b("-1e120"); vcl_cout << b << '\n';}
+#endif
+ {vnl_bignum b("0x0"); TEST("vnl_bignum b(\"0x0\");", b, 0x0);}
+ {vnl_bignum b("0x9"); TEST("vnl_bignum b(\"0x9\");", b, 0x9);}
+ {vnl_bignum b("0xa"); TEST("vnl_bignum b(\"0xa\");", b, 0xa);}
+ {vnl_bignum b("0xf"); TEST("vnl_bignum b(\"0xf\");", b, 0xf);}
+ {vnl_bignum b("0xA"); TEST("vnl_bignum b(\"0xA\");", b, 0xa);}
+ {vnl_bignum b("0xF"); TEST("vnl_bignum b(\"0xF\");", b, 0xf);}
+ {vnl_bignum b("0x1aF"); TEST("vnl_bignum b(\"0x1aF\");", b, 0x1af);}
+ {vnl_bignum b("0"); TEST("vnl_bignum b(\"0\");", b, 0);}
+ {vnl_bignum b("00"); TEST("vnl_bignum b(\"00\");", b, 0);}
+ {vnl_bignum b("012334567"); TEST("vnl_bignum b(\"012334567\");", b, 012334567);}
+ {vnl_bignum b("9"); TEST("vnl_bignum b(\"9\");", b, 9);}
+ {vnl_bignum b(" 9"); TEST("vnl_bignum b(\" 9\");", b, 9);}
+ // infinity:
+ {vnl_bignum b("+Inf"); TEST("vnl_bignum b(\"+Inf\");", b.is_plus_infinity(), true);}
+ {vnl_bignum b("Infinity"); TEST("vnl_bignum b(\"Infinity\");", b.is_plus_infinity(), true);}
+ {vnl_bignum b("-Infin"); TEST("vnl_bignum b(\"-Infin\");", b.is_minus_infinity(), true);}
+
+#ifndef __alpha__ // On Alpha, compiler runs out of memory when using <sstream>
+ vcl_cout << "reading from istream:\n";
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "+1"; is >> b; TEST("\"+1\" >> b;", b, 1L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "-1"; is >> b; TEST("\"-1\" >> b;", b, -1L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "123"; is >> b; TEST("\"123\" >> b;", b, 123L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "123e5"; is >> b; TEST("\"123e5\" >> b;", b, 12300000L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "123e+4"; is >> b; TEST("\"123e+4\" >> b;", b, 1230000L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0x0"; is >> b; TEST("\"0x0\" >> b;", b, 0x0);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0x9"; is >> b; TEST("\"0x9\" >> b;", b, 0x9);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0xa"; is >> b; TEST("\"0xa\" >> b;", b, 0xa);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0xf"; is >> b; TEST("\"0xf\" >> b;", b, 0xf);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0xA"; is >> b; TEST("\"0xA\" >> b;", b, 0xa);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0xF"; is >> b; TEST("\"0xF\" >> b;", b, 0xf);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0x1aF"; is >> b; TEST("\"0x1aF\" >> b;", b, 0x1af);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "0"; is >> b; TEST("\"0\" >> b;", b, 0L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "00"; is >> b; TEST("\"00\" >> b;", b, 0L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "012334567"; is >> b; TEST("\"012334567\" >> b;", b, 012334567);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << "9"; is >> b; TEST("\"9\" >> b;", b, 9L);}
+ {vcl_stringstream is(vcl_ios_in | vcl_ios_out); vnl_bignum b;
+ is << " 9"; is >> b; TEST("\" 9\" >> b;", b, 9L);}
+#endif
+
+ vcl_cout << "vnl_bignum& constructor:\n";
+ {vnl_bignum b50(vnl_bignum(0L));
+ TEST("vnl_bignum b50(vnl_bignum(0L));", (long)b50, 0L);}
+
+ {vnl_bignum b51(vnl_bignum(100L));
+ TEST("vnl_bignum b51(vnl_bignum(100L));", (long)b51, 100L);}
+}
+
+static void run_conversion_operator_tests()
+{
+ vcl_cout << "\nConversion operator tests:\n";
+
+ vcl_cout << "short conversion operator:\n";
+ TEST("short(vnl_bignum(0L)) == 0", short(vnl_bignum(0L)), 0);
+ TEST("short(vnl_bignum(0x7fffL)) == 0x7fff", short(vnl_bignum(0x7fffL)), 0x7fff);
+ TEST("short(vnl_bignum(-0x7fffL)) == -0x7fff", short(vnl_bignum(-0x7fffL)), -0x7fff);
+ TEST("short(vnl_bignum(-0x8000L)) == short(-0x8000)", short(vnl_bignum(-0x8000L)), short(-0x8000));
+
+ vcl_cout << "int conversion operator:\n";
+ TEST("int(vnl_bignum(0L)) == 0", int(vnl_bignum(0L)), 0);
+ TEST("int(vnl_bignum(0x7fffffffL)) == 0x7fffffff", int(vnl_bignum(0x7fffffffL)), 0x7fffffff);
+ TEST("int(vnl_bignum(-0x7fffffffL)) == -0x7fffffff", int(vnl_bignum(-0x7fffffffL)), -0x7fffffff);
+
+ vcl_cout << "long conversion operator:\n";
+ vnl_bignum b(0x7fffffffL);
+ ++b;
+ // Two casts are used here instead of a direct cast to unsigned long
+ // because vnl_bignum does not implement an overload of "cast to
+ // unsigned long".
+ TEST("vnl_bignum b(0x7fffffffL); ++b; (unsigned long)long(b) == 0x80000000UL", (unsigned long)long(b), 0x80000000UL);
+ --b;
+ TEST("vnl_bignum b(0x80000000UL); --b; long(b) == 0x7fffffffL", long(b), 0x7fffffffL);
+
+ // Use -0x7fffffffL-0x1L below instead of -0x80000000L because the
+ // latter is parsed like -(0x80000000L) and 0x80000000L is promoted
+ // to unsigned long because it is too big to be a signed long.
+ ++b; b = -b;
+ TEST("vnl_bignum b(0x7fffffffL); ++b; b=-b; long(b) == -0x7fffffffL-0x1L", long(b), -0x7fffffffL-0x1L);
+
+ vcl_cout << "float conversion operator:\n";
+ TEST("float(vnl_bignum(0.0)) == 0.0", (float) vnl_bignum(0.0), 0.0);
+ TEST("float(vnl_bignum(99999.0)) == 99999.0",
+ ((float) vnl_bignum(99999.0)), 99999.0);
+ TEST("float(vnl_bignum(vnl_numeric_traits<float>::maxval)) == vnl_numeric_traits<float>::maxval",
+ (vnl_numeric_traits<float>::maxval), (float) vnl_bignum(vnl_numeric_traits<float>::maxval));
+ TEST("float(vnl_bignum(-vnl_numeric_traits<float>::maxval)) == -vnl_numeric_traits<float>::maxval",
+ (-vnl_numeric_traits<float>::maxval), float(vnl_bignum(-vnl_numeric_traits<float>::maxval)));
+ TEST("float(vnl_bignum(\"+Inf\")) == +Inf", (float) vnl_bignum("+Inf"), vcl_numeric_limits<float>::infinity());
+
+ b = vnl_numeric_traits<double>::maxval;
+ ++b;
+ TEST("vnl_numeric_traits<double>::maxval + 1 is valid", b.is_infinity(), false);
+
+ vcl_cout << "double conversion operator:\n";
+ TEST("double(vnl_bignum(0.0)) == 0.0", (double) vnl_bignum(0.0), 0.0);
+ TEST("double(vnl_bignum(99999.0)) == 99999.0",
+ (double) vnl_bignum(99999.0), 99999.0);
+ TEST("double(vnl_bignum(1e300)) == 1e300",
+ double(vnl_bignum(1e300)), 1e300);
+ TEST("double(vnl_bignum(-1e300)) == -1e300",
+ double(vnl_bignum(-1e300)), -1e300);
+ TEST("double(vnl_bignum(vnl_numeric_traits<float>::maxval)) == vnl_numeric_traits<float>::maxval",
+ (vnl_numeric_traits<float>::maxval), (double) vnl_bignum(vnl_numeric_traits<float>::maxval));
+ TEST("double(vnl_bignum(-vnl_numeric_traits<float>::maxval)) == -vnl_numeric_traits<float>::maxval",
+ (-vnl_numeric_traits<float>::maxval), double(vnl_bignum(-vnl_numeric_traits<float>::maxval)));
+ TEST("double(vnl_bignum(vnl_numeric_traits<double>::maxval)) == vnl_numeric_traits<double>::maxval",
+ (double) vnl_bignum(vnl_numeric_traits<double>::maxval), vnl_numeric_traits<double>::maxval);
+ TEST("double(vnl_bignum(-vnl_numeric_traits<double>::maxval)) == -vnl_numeric_traits<double>::maxval",
+ (double) vnl_bignum(-vnl_numeric_traits<double>::maxval), -vnl_numeric_traits<double>::maxval);
+ TEST("double(vnl_bignum(\"+Inf\")) == +Inf", (double) vnl_bignum("+Inf"), vcl_numeric_limits<double>::infinity());
+
+ // Test for bug in bignum::dtobignum()
+ // it wasn't resetting the value at the start.
+ const vnl_bignum e(1000);
+ vnl_bignum d(20);
+ vnl_bignum_from_string(d, "1000");
+ TEST("vnl_bignum_from_string", e, d);
+}
+
+static void run_assignment_tests()
+{
+ vcl_cout << "\nStarting assignment tests:\n";
+ vnl_bignum b1;
+
+ TEST_RUN ("vnl_bignum b1; b1 = 0xffff;", b1 = 0xffffL, long(b1), 0xffffL);
+
+ // double assignment operator
+ TEST_RUN ("double(b1) == -1.23e6", b1 = -1.23e6, double(b1), -1.23e6);
+
+ // long assignment operator
+ TEST_RUN ("long(b1) = -0x7fffffff", b1 = -0x7fffffffL, long(b1), -0x7fffffff);
+
+ // char * assignment operator
+ TEST_RUN ("long(b1) = 0x1fffffL", b1 = "0x1fffff", long(b1), 0x1fffffL);
+
+
+ // vnl_bignum& assignment operator
+ b1 = "0";
+ vnl_bignum b5(0x1ffffL);
+ TEST_RUN ("b1 = b5", b1 = b5, b1, b5);
+}
+
+static void run_logical_comparison_tests()
+{
+ vcl_cout << "\nStarting logical comparison tests:\n";
+ vnl_bignum b0(0L);
+ vnl_bignum b1(1L);
+ vnl_bignum b2(0x7fffL);
+ vnl_bignum b3(-0x7fffL);
+ vnl_bignum p_inf("+Inf");
+ vnl_bignum m_inf("-Inf");
+
+ TEST("b0 == b0", b0 == b0, true);
+ TEST("b0 == b1", b0 == b1, false);
+ TEST("b0 == b2", b0 == b2, false);
+ TEST("b0 == b3", b0 == b3, false);
+ TEST("b1 == b1", b1 == b1, true);
+ TEST("b1 == b2", b1 == b2, false);
+ TEST("b1 == b3", b1 == b3, false);
+ TEST("b2 == b2", b2 == b2, true);
+ TEST("b2 == b3", b2 == b3, false);
+ TEST("b3 == b3", b3 == b3, true);
+ TEST("p_inf == p_inf", p_inf == p_inf, true);
+ TEST("p_inf == m_inf", p_inf == m_inf, false);
+ TEST("m_inf == m_inf", m_inf == m_inf, true);
+ TEST("b0 == p_inf", b0 == p_inf, false);
+ TEST("b1 == p_inf", b1 == p_inf, false);
+ TEST("b2 == p_inf", b2 == p_inf, false);
+ TEST("b3 == p_inf", b3 == p_inf, false);
+ TEST("b0 == m_inf", b0 == m_inf, false);
+ TEST("b1 == m_inf", b1 == m_inf, false);
+ TEST("b2 == m_inf", b2 == m_inf, false);
+ TEST("b3 == m_inf", b3 == m_inf, false);
+
+ TEST("b0 != b0", b0 != b0, false);
+ TEST("b0 != b1", b0 != b1, true);
+ TEST("b0 != b2", b0 != b2, true);
+ TEST("b0 != b3", b0 != b3, true);
+ TEST("b1 != b1", b1 != b1, false);
+ TEST("b1 != b2", b1 != b2, true);
+ TEST("b1 != b3", b1 != b3, true);
+ TEST("b2 != b2", b2 != b2, false);
+ TEST("b2 != b3", b2 != b3, true);
+ TEST("b3 != b3", b3 != b3, false);
+
+ TEST("b0 < b0", b0 < b0, false);
+ TEST("b0 < b1", b0 < b1, true);
+ TEST("b0 < b2", b0 < b2, true);
+ TEST("b0 < b3", b0 < b3, false);
+ TEST("b1 < b1", b1 < b1, false);
+ TEST("b1 < b2", b1 < b2, true);
+ TEST("b1 < b3", b1 < b3, false);
+ TEST("b2 < b2", b2 < b2, false);
+ TEST("b2 < b3", b2 < b3, false);
+ TEST("b3 < b3", b3 < b3, false);
+ TEST("p_inf < p_inf", p_inf < p_inf, false);
+ TEST("p_inf < m_inf", p_inf < m_inf, false);
+ TEST("m_inf < p_inf", m_inf < p_inf, true);
+ TEST("m_inf < m_inf", m_inf < m_inf, false);
+ TEST("b0 < p_inf", b0 < p_inf, true);
+ TEST("b1 < p_inf", b1 < p_inf, true);
+ TEST("b2 < p_inf", b2 < p_inf, true);
+ TEST("b3 < p_inf", b3 < p_inf, true);
+ TEST("b0 < m_inf", b0 < m_inf, false);
+ TEST("b1 < m_inf", b1 < m_inf, false);
+ TEST("b2 < m_inf", b2 < m_inf, false);
+ TEST("b3 < m_inf", b3 < m_inf, false);
+
+ TEST("b0 > b0", b0 > b0, false);
+ TEST("b0 > b1", b0 > b1, false);
+ TEST("b0 > b2", b0 > b2, false);
+ TEST("b0 > b3", b0 > b3, true);
+ TEST("b1 > b1", b1 > b1, false);
+ TEST("b1 > b2", b1 > b2, false);
+ TEST("b1 > b3", b1 > b3, true);
+ TEST("b2 > b2", b2 > b2, false);
+ TEST("b2 > b3", b2 > b3, true);
+ TEST("b3 > b3", b3 > b3, false);
+ TEST("p_inf > p_inf", p_inf > p_inf, false);
+ TEST("p_inf > m_inf", p_inf > m_inf, true);
+ TEST("m_inf > p_inf", m_inf > p_inf, false);
+ TEST("m_inf > m_inf", m_inf > m_inf, false);
+ TEST("b0 > p_inf", b0 > p_inf, false);
+ TEST("b1 > p_inf", b1 > p_inf, false);
+ TEST("b2 > p_inf", b2 > p_inf, false);
+ TEST("b3 > p_inf", b3 > p_inf, false);
+ TEST("b0 > m_inf", b0 > m_inf, true);
+ TEST("b1 > m_inf", b1 > m_inf, true);
+ TEST("b2 > m_inf", b2 > m_inf, true);
+ TEST("b3 > m_inf", b3 > m_inf, true);
+
+ TEST("b3 != b2", b3 != b2, true);
+ TEST("b3 != b3", b3 != b3, false);
+ TEST("b3 < b2", b3 < b2, true);
+ TEST("b3 <= b2", b3 <= b2, true);
+ TEST("b3 <= b3", b3 <= b3, true);
+ TEST("b3 > b3", b3 > b3, false);
+ TEST("b3 > b2", b3 > b2, false);
+ TEST("b3 >= b2", b3 >= b2, false);
+ TEST("b3 >= b3", b3 >= b3, true);
+ TEST("b2 >= b2", b2 >= b2, true);
+ vcl_cout << b2 << " == " << &b2 << vcl_endl;
+ TEST("<<", 1, 1);
+}
+
+static void run_division_tests()
+{
+ vcl_cout << "\nStarting division tests:\n";
+
+ TEST("long(vnl_bignum(0L)/vnl_bignum(1L))", long(vnl_bignum(0L)/vnl_bignum(1L)), 0L);
+ TEST("long(vnl_bignum(-1L)/vnl_bignum(1L))", long(vnl_bignum(-1L)/vnl_bignum(1L)), -1L);
+ TEST("long(vnl_bignum(-1L)/vnl_bignum(\"+Inf\"))", long(vnl_bignum(-1L)/vnl_bignum("+Inf")), 0L);
+ TEST("vnl_bignum(\"+Inf\")/(-1L)", vnl_bignum("+Inf")/(-1L), vnl_bignum("-Inf"));
+ TEST("vnl_bignum(-1L)/0L", vnl_bignum(-1L)/0L, vnl_bignum("-Inf"));
+
+ long i,j,k,l;
+ long div_errors = 0;
+ long mod_errors = 0;
+
+ vcl_cout << " for (i = 0xffffff; i > 0; i /= 0x10)\n"
+ << " for (j = 0x7ffffff; j > 0; j /= 0x10)\n"
+ << " for (k = 1; k < 17; ++k)\n"
+ << " for (l = 1; l < 17; ++l)\n ";
+ for (i = 0xffffff; i > 0; i /= 0x10) {
+ vcl_cout.put('.');
+ vcl_cout.flush();
+ for (j = 0x7ffffff; j > 0; j /= 0x10) {
+ for (k = 1; k < 17; ++k) {
+ for (l = 1; l < 17; ++l) {
+ vnl_bignum b1(i+k);
+ vnl_bignum b2(j+l);
+ vnl_bignum b3(long((i+k)/(j+l)));
+ if (b1/b2 != b3) {
+ TEST("(vnl_bignum(i+k)/vnl_bignum(j+l)) == vnl_bignum(long((i+k)/(j+l)))", false, true);
+#ifndef __alpha__ // On Alpha, compiler runs out of memory when using <iomanip>
+ vcl_cout<<vcl_hex<< "i=0x"<<i<<", j=0x"<<j<<", k=0x"<<k<<", l="<<l
+ <<vcl_dec<<", b1="<<b1<<", b2="<<b2<<", b3="<<b3<<'\n';
+#endif
+ ++div_errors;
+ }
+ b3 = vnl_bignum(long((i+k)%(j+l)));
+ if (b1%b2 != b3) {
+ TEST("(vnl_bignum(i+k)%vnl_bignum(j+l)) == vnl_bignum(long((i+k)%(j+l)))", false, true);
+#ifndef __alpha__ // On Alpha, compiler runs out of memory when using <iomanip>
+ vcl_cout<<vcl_hex<< "i=0x"<<i<<", j=0x"<<j<<", k=0x"<<k<<", l="<<l
+ <<vcl_dec<<", b1="<<b1<<", b2="<<b2<<", b3="<<b3<<'\n';
+#endif
+ ++mod_errors;
+ }
+ }
+ }
+ }
+ }
+
+ vcl_cout << "\n";
+ TEST("(vnl_bignum(i+k)/vnl_bignum(j+l)) == vnl_bignum(long((i+k)/(j+l)))",
+ div_errors, 0);
+ TEST("(vnl_bignum(i+k)%vnl_bignum(j+l)) == vnl_bignum(long((i+k)%(j+l)))",
+ mod_errors, 0);
+
+#ifdef INTERACTIVE
+ char num[130], den[130];
+ vnl_bignum b,r;
+
+ while (true) {
+ vcl_cout << "Enter next numerator: ";
+ vcl_cin >> num;
+ vcl_cout << "Enter next denominator: ";
+ vcl_cin >> den;
+
+ b = vnl_bignum(num)/vnl_bignum(den);
+ r = vnl_bignum(num) % vnl_bignum(den);
+ vcl_cout << "\nquotient = " << b
+ << "\n "; b.dump();
+ vcl_cout << "\n\nremainder = " << r
+ << "\n "; r.dump();
+ vcl_cout << '\n';
+ }
+#endif
+}
+
+static void run_multiplication_division_tests()
+{
+ vcl_cout << "\nCheck example in book:\n";
+
+ vnl_bignum b2 = "0xffffffff"; // Create vnl_bignum object
+ vnl_bignum b3 = "12345e30"; // Create vnl_bignum object
+
+ vcl_cout << "b2 = " << b2 << vcl_endl
+ << "b3 = " << b3 << vcl_endl;
+
+ TEST("(b2*b3) / b3 = b2", ((b2*b3) / b3 == b2), 1);
+ TEST("(b2*b3) / b2 = b3", ((b2*b3) / b2 == b3), 1);
+ TEST("((b3/b2) * b2) + (b3%b2) = b3", (((b3/b2) * b2) + (b3%b2) == b3), 1);
+}
+
+static void run_addition_subtraction_tests()
+{
+ vcl_cout << "\nStarting addition, subtraction tests:\n";
+
+ long i,j;
+ long add_errors = 0;
+ long sub_errors = 0;
+ vnl_bignum bi,bj,bij;
+
+ vcl_cout << " for (i = 1; i < 0xfffffff; i *= 3)\n"
+ << " for (j = 1; j < 0xfffffff; j *= 3)\n ";
+
+ {for (i = 1; i < 0xfffffff; i *= 3) {
+ vcl_cout.put('.');
+ vcl_cout.flush();
+ for (j = 1; j < 0xfffffff; j *= 3) {
+ bi = i;
+ bj = j;
+ bij = vnl_bignum(i+j);
+ if (bi + bj != bij) {
+ TEST("bi + bj == vnl_bignum(i + j)", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<"\n";
+ ++add_errors;
+ }
+ bij = vnl_bignum(i-j);
+ if (bi - bj != bij) {
+ TEST("bi - bj == vnl_bignum(i - j)", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<"\n";
+ ++sub_errors;
+ }
+ }
+ }}
+ vcl_cout << "\n";
+ TEST("bi + bj == vnl_bignum(i + j)", add_errors, 0);
+ TEST("bi - bj == vnl_bignum(i - j)", sub_errors, 0);
+
+ vnl_bignum b0(0L);
+ vnl_bignum zillion("1000000000000000000");
+ vnl_bignum b1000(1000L), b1000000(1000000L);
+ vnl_bignum p_inf("+Inf"), m_inf("-Inf");
+
+ TEST("-b0 == b0", -b0, b0);
+ TEST("-p_inf == m_inf", -p_inf, m_inf);
+ TEST("-m_inf == p_inf", -m_inf, p_inf);
+ TEST("-b1000 == vnl_bignum(-1L)*b1000", -b1000, vnl_bignum(-1L)*b1000);
+ TEST("-(-b1000000) == b1000000", -(-b1000000), b1000000);
+ TEST("b0 + b1000 == b1000", b0 + b1000, b1000);
+ TEST("b0 + b1000000 == b1000000", b0 + b1000000, b1000000);
+ TEST("b1000 + b0 == b1000", b1000 + b0, b1000);
+ TEST("b1000000 + b0 == b1000000", b1000000 + b0, b1000000);
+ TEST("b0 + (-b1000) == -b1000", b0 + (-b1000), -b1000);
+ TEST("-b1000 + b0 == -b1000", -b1000 + b0, -b1000);
+ TEST("-b1000 + (-b1000) == (vnl_bignum(2L)*(-b1000))",
+ -b1000 + (-b1000), (vnl_bignum(2L)*(-b1000)));
+ TEST("-b1000000 + (-b1000000) == (vnl_bignum(2L)*(-b1000000))",
+ -b1000000 + (-b1000000), (vnl_bignum(2L)*(-b1000000)));
+ TEST("b1000000 + (-b1000000) == b0", b1000000 + (-b1000000), b0);
+ TEST("zillion + (-zillion) == b0", zillion + (-zillion), b0);
+ TEST("zillion + b1000 == b1000000*b1000000*b1000000 + b1000",
+ zillion + b1000, b1000000*b1000000*b1000000 + b1000);
+ TEST("zillion + p_inf == p_inf", zillion + p_inf, p_inf);
+ TEST("zillion + m_inf == m_inf", zillion + m_inf, m_inf);
+ TEST("p_inf + zillion == p_inf", p_inf + zillion, p_inf);
+ TEST("m_inf + zillion == m_inf", m_inf + zillion, m_inf);
+
+ TEST("b0 - b1000 == -b1000", b0 - b1000, -b1000);
+ TEST("b0 - b1000000 == -b1000000", b0 -b1000000, -b1000000);
+ TEST("b1000 - b0 == b1000", b1000 - b0, b1000);
+ TEST("b1000000 - b0 == b1000000", b1000000 - b0, b1000000);
+ TEST("b0 - (-b1000) == b1000", b0 - (-b1000), b1000);
+ TEST("-b1000 - b0 == -b1000", -b1000 - b0, -b1000);
+ TEST("-b1000 - (-b1000) == b0", -b1000 - (-b1000), b0);
+ TEST("-b1000 - (-zillion) == zillion - b1000",
+ -b1000 - (-zillion), zillion - b1000);
+ TEST("-b1000000 - (-b1000000) == b0", -b1000000 - (-b1000000), b0);
+ TEST("-b1000000 - (b1000000) == -vnl_bignum(2L)*b1000000",
+ -b1000000 - (b1000000), -vnl_bignum(2L)*b1000000);
+ TEST("b1000000 - (-b1000000) == vnl_bignum(2L)*b1000000",
+ b1000000 - (-b1000000), vnl_bignum(2L)*b1000000);
+ TEST("zillion - (-zillion) == vnl_bignum(2L)*zillion",
+ zillion - (-zillion), vnl_bignum(2L)*zillion);
+ TEST("zillion - b1000 == b1000000*b1000000*b1000000 - b1000",
+ zillion - b1000, b1000000*b1000000*b1000000 - b1000);
+ TEST("-zillion - b1000 == -b1000000*b1000000*b1000000 - b1000",
+ -zillion - b1000, -b1000000*b1000000*b1000000 - b1000);
+ TEST("zillion - p_inf == m_inf", zillion - p_inf, m_inf);
+ TEST("zillion - m_inf == p_inf", zillion - m_inf, p_inf);
+ TEST("p_inf - zillion == p_inf", p_inf - zillion, p_inf);
+ TEST("m_inf - zillion == m_inf", m_inf - zillion, m_inf);
+
+ // example in book
+ vnl_bignum b2 = "0xffffffff"; // Create vnl_bignum object
+ vnl_bignum b3 = "12345e30"; // Create vnl_bignum object
+ TEST("(b2+b3) - b2 = b3", (b2+b3) - b2 == b3, 1);
+ TEST("(b2+b3) - b3 = b2", (b2+b3) - b3 == b2, 1);
+ b3.dump();
+ TEST("b3.dump()", 1, 1);
+}
+
+
+static void run_increment_tests()
+{
+ vcl_cout << "increment special cases:\n";
+ vnl_bignum b1;
+ TEST("b1 == 0", b1, 0);
+ ++b1;
+ TEST("++b1 == 1", b1, 1);
+ ++b1;
+ TEST("++b1 == 2", b1, 2);
+ --b1;
+ TEST("--b1 == 1", b1, 1);
+ --b1;
+ TEST("--b1 == 0", b1, 0);
+ --b1;
+ TEST("--b1 == -1", b1, -1);
+ --b1;
+ TEST("--b1 == -2", b1, -2);
+ ++b1;
+ TEST("++b1 == -1", b1, -1);
+ ++b1;
+ TEST("++b1 == 0", b1, 0);
+
+ vnl_bignum b2("Infinity");
+ TEST("b2 == infinity", b2.is_plus_infinity(), true);
+ ++b2;
+ TEST("++b2 == infinity", b2.is_plus_infinity(), true);
+ --b2;
+ TEST("--b2 == infinity", b2.is_plus_infinity(), true);
+
+ vnl_bignum b3("-Infinity");
+ TEST("b3 == -infinity", b3.is_minus_infinity(), true);
+ ++b3;
+ TEST("++b3 == -infinity", b3.is_minus_infinity(), true);
+ --b3;
+ TEST("--b3 == -infinity", b3.is_minus_infinity(), true);
+
+ vnl_bignum b4("65534");
+ TEST("b4 == 65534", b4, 65534);
+ ++b4;
+ TEST("++b4 == 65535", b4, 65535);
+ ++b4;
+ TEST("++b4 == 65536", b4, 65536);
+ ++b4;
+ TEST("++b4 == 65537", b4, 65537);
+ --b4;
+ TEST("--b4 == 65536", b4, 65536);
+ --b4;
+ TEST("--b4 == 65535", b4, 65535);
+ --b4;
+ TEST("--b4 == 65534", b4, 65534);
+
+
+ vnl_bignum b5("-65534");
+ TEST("b5 == -65534", b5, -65534);
+ --b5;
+ TEST("--b5 == -65535", b5, -65535);
+ --b5;
+ TEST("--b5 == -65536", b5, -65536);
+ --b5;
+ TEST("--b5 == -65537", b5, -65537);
+ ++b5;
+ TEST("++b5 == -65536", b5, -65536);
+ ++b5;
+ TEST("++b5 == -65535", b5, -65535);
+ ++b5;
+ TEST("++b5 == -65534", b5, -65534);
+}
+
+
+static void run_multiplication_tests()
+{
+ vcl_cout << "\nStarting multiplication tests:\n";
+
+ vnl_bignum b0(0L), b1000(1000L), b1000000(1000000L),
+ zillion("1000000000000000000");
+ vnl_bignum p_inf("+Inf"), m_inf("-Inf");
+
+ TEST("b0*b0 == b0", b0*b0, b0);
+ TEST("b0*b1000 == b0", b0*b1000, b0);
+ TEST("b1000*b0 == b0", b1000*b0, b0);
+ TEST("b1000*b1000 == b1000000", b1000*b1000, b1000000);
+ TEST("b1000*b1000000 == b1000000*b1000", b1000*b1000000, b1000000*b1000);
+ TEST("-b1000000*b1000000*b1000000 == -zillion", -b1000000*b1000000*b1000000, -zillion);
+ TEST("zillion*-b1000 == b1000*-zillion", zillion*-b1000, b1000*-zillion);
+ TEST("p_inf*b1000 == p_inf", p_inf*b1000, p_inf);
+ TEST("m_inf*b1000 == m_inf", m_inf*b1000, m_inf);
+}
+
+static void run_left_shift_tests()
+{
+ vnl_bignum b1(1L);
+ vnl_bignum p_inf("+Inf"), m_inf("-Inf");
+
+ // left shift
+ TEST("int(b1) == 1",int(b1), 1);
+ TEST("long(b1 << 1) == 2",long(b1 << 1), 2);
+ TEST("long(b1 << 2) == 4",long(b1 << 2), 4);
+ TEST("long(b1 << 3) == 8",long(b1 << 3), 8);
+ TEST("long(b1 << 4) == 16",long(b1 << 4), 16);
+ TEST("long(b1 << 5) == 32",long(b1 << 5), 32);
+ TEST("long(b1 << 6) == 64",long(b1 << 6), 64);
+ TEST("long(b1 << 7) == 128",long(b1 << 7), 128);
+ TEST("long(b1 << 8) == 256",long(b1 << 8), 256);
+ TEST("long(b1 << 9) == 512",long(b1 << 9), 512);
+ TEST("long(b1 << 10) == 1024",long(b1 << 10), 1024);
+ TEST("long(b1 << 11) == 2048",long(b1 << 11), 2048);
+ TEST("long(b1 << 12) == 4096",long(b1 << 12), 4096);
+ TEST("long(b1 << 13) == 8192",long(b1 << 13), 8192);
+ TEST("long(b1 << 14) == 16384",long(b1 << 14), 16384);
+ TEST("long(b1 << 15) == 32768",long(b1 << 15), 32768);
+ TEST("long(b1 << 16) == 65536",long(b1 << 16), 65536);
+ TEST("(b1 << 32) == vnl_bignum(\"4294967296\")",
+ (b1 << 32), vnl_bignum("4294967296"));
+ TEST("p_inf << 16 == p_inf",p_inf << 16, p_inf);
+
+ TEST("long(-b1 << 1) == -2",long(-b1 << 1), -2);
+ TEST("long(-b1 << 2) == -4",long(-b1 << 2), -4);
+ TEST("long(-b1 << 3) == -8",long(-b1 << 3), -8);
+ TEST("long(-b1 << 4) == -16",long(-b1 << 4), -16);
+ TEST("long(-b1 << 5) == -32",long(-b1 << 5), -32);
+ TEST("long(-b1 << 6) == -64",long(-b1 << 6), -64);
+ TEST("long(-b1 << 7) == -128",long(-b1 << 7), -128);
+ TEST("long(-b1 << 8) == -256",long(-b1 << 8), -256);
+ TEST("long(-b1 << 9) == -512",long(-b1 << 9), -512);
+ TEST("long(-b1 << 10) == -1024",long(-b1 << 10), -1024);
+ TEST("long(-b1 << 11) == -2048",long(-b1 << 11), -2048);
+ TEST("long(-b1 << 12) == -4096",long(-b1 << 12), -4096);
+ TEST("long(-b1 << 13) == -8192",long(-b1 << 13), -8192);
+ TEST("long(-b1 << 14) == -16384",long(-b1 << 14), -16384);
+ TEST("long(-b1 << 15) == -32768",long(-b1 << 15), -32768);
+ TEST("long(-b1 << 16) == -65536",long(-b1 << 16), -65536);
+ TEST("(-b1 << 32) == vnl_bignum(\"-4294967296\")",
+ (-b1 << 32), vnl_bignum("-4294967296"));
+ TEST("m_inf << 16 == m_inf",m_inf << 16, m_inf);
+
+ TEST("long(b1 << -16) == 0",long(b1 << -16), 0);
+ TEST("long(-b1 << -16) == 0",long(-b1 << -16), 0);
+}
+
+static void run_right_shift_tests()
+{
+ vnl_bignum b2("4294967296");
+ vnl_bignum p_inf("+Inf"), m_inf("-Inf");
+
+ // right shift
+ TEST("b2 == vnl_bignum(\"4294967296\")",b2, vnl_bignum("4294967296"));
+ TEST("(b2 >> 1) == vnl_bignum(\"2147483648\")", (b2 >> 1), vnl_bignum("2147483648"));
+ TEST("long(b2 >> 2) == 1073741824",long(b2 >> 2), 1073741824L);
+ TEST("long(b2 >> 3) == 536870912",long(b2 >> 3), 536870912L);
+ TEST("long(b2 >> 4) == 268435456",long(b2 >> 4), 268435456L);
+ TEST("long(b2 >> 5) == 134217728",long(b2 >> 5), 134217728L);
+ TEST("long(b2 >> 6) == 67108864",long(b2 >> 6), 67108864L);
+ TEST("long(b2 >> 7) == 33554432",long(b2 >> 7), 33554432L);
+ TEST("long(b2 >> 8) == 16777216",long(b2 >> 8), 16777216L);
+ TEST("long(b2 >> 9) == 8388608",long(b2 >> 9), 8388608L);
+ TEST("long(b2 >> 10) == 4194304",long(b2 >> 10), 4194304L);
+ TEST("long(b2 >> 11) == 2097152",long(b2 >> 11), 2097152L);
+ TEST("long(b2 >> 12) == 1048576",long(b2 >> 12), 1048576L);
+ TEST("long(b2 >> 13) == 524288",long(b2 >> 13), 524288L);
+ TEST("long(b2 >> 14) == 262144",long(b2 >> 14), 262144L);
+ TEST("long(b2 >> 15) == 131072",long(b2 >> 15), 131072L);
+ TEST("long(b2 >> 16) == 65536",long(b2 >> 16), 65536L);
+ TEST("long(b2 >> 32) == 1",long(b2 >> 32), 1L);
+ TEST("long(b2 >> 33) == 0",long(b2 >> 33), 0L);
+ TEST("long(b2 >> 67) == 0",long(b2 >> 67), 0L);
+ TEST("p_inf >> 16 == p_inf",p_inf >> 16, p_inf);
+
+ TEST("(-b2 >> 1) == vnl_bignum(\"-2147483648\")", (-b2 >> 1), vnl_bignum("-2147483648"));
+ TEST("long(-b2 >> 2) == -1073741824",long(-b2 >> 2), -1073741824L);
+ TEST("long(-b2 >> 3) == -536870912",long(-b2 >> 3), -536870912L);
+ TEST("long(-b2 >> 4) == -268435456",long(-b2 >> 4), -268435456L);
+ TEST("long(-b2 >> 5) == -134217728",long(-b2 >> 5), -134217728L);
+ TEST("long(-b2 >> 6) == -67108864",long(-b2 >> 6), -67108864L);
+ TEST("long(-b2 >> 7) == -33554432",long(-b2 >> 7), -33554432L);
+ TEST("long(-b2 >> 8) == -16777216",long(-b2 >> 8), -16777216L);
+ TEST("long(-b2 >> 9) == -8388608",long(-b2 >> 9), -8388608L);
+ TEST("long(-b2 >> 10) == -4194304",long(-b2 >> 10), -4194304L);
+ TEST("long(-b2 >> 11) == -2097152",long(-b2 >> 11), -2097152L);
+ TEST("long(-b2 >> 12) == -1048576",long(-b2 >> 12), -1048576L);
+ TEST("long(-b2 >> 13) == -524288",long(-b2 >> 13), -524288L);
+ TEST("long(-b2 >> 14) == -262144",long(-b2 >> 14), -262144L);
+ TEST("long(-b2 >> 15) == -131072",long(-b2 >> 15), -131072L);
+ TEST("long(-b2 >> 16) == -65536",long(-b2 >> 16), -65536L);
+ TEST("long(-b2 >> 32) == -1",long(-b2 >> 32), -1);
+ TEST("long(-b2 >> 33) == -0",long(-b2 >> 33), 0);
+ TEST("long(-b2 >> 67) == -0",long(-b2 >> 67), 0);
+ TEST("m_inf >> 16 == m_inf",m_inf >> 16, m_inf);
+}
+
+static void run_shift_tests()
+{
+ vcl_cout << "\nStarting shift tests:\n";
+
+ run_left_shift_tests();
+ run_right_shift_tests();
+#ifdef INTERACTIVE
+ vnl_bignum b;
+ char s[100];
+ int sh;
+
+ while (true) {
+ vcl_cout << "Enter next vnl_bignum: ";
+ vcl_cin >> s;
+ b = s;
+ vcl_cout << "Enter shift amount: ";
+ vcl_cin >> sh;
+ vcl_cout << "Shift == " << sh << "\n";
+
+ b = b << sh;
+ }
+#endif
+}
+
+void test_bignum()
+{
+ run_constructor_tests();
+ run_conversion_operator_tests();
+ run_assignment_tests();
+ run_addition_subtraction_tests();
+ run_increment_tests();
+ run_multiplication_tests();
+ run_division_tests();
+ run_multiplication_division_tests();
+ run_shift_tests();
+ run_logical_comparison_tests();
+}
+
+TESTMAIN(test_bignum);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_complex.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_complex.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f369d7130d305ba68abcbaf3f5f4feaa8654b746
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_complex.cxx
@@ -0,0 +1,121 @@
+// This is core/vnl/tests/test_complex.cxx
+
+//:
+// \file
+
+#include <vcl_iostream.h>
+#include <vcl_cmath.h>
+#include <vcl_complex.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_random.h>
+
+#include <testlib/testlib_test.h>
+
+//: inverse cosine for complex numbers.
+// The implementation is at the bottom of this file.
+// \author Peter Vanroose, ESAT, KULeuven.
+vcl_complex<double> tc_acos(vcl_complex<double> x);
+
+// make a vector with random, complex entries :
+static void fill_rand(vcl_complex<double> *b, vcl_complex<double> *e, vnl_random &rng)
+{
+ for (vcl_complex<double> *p=b; p<e; ++p)
+ (*p) = vcl_complex<double>( rng.drand64(-1.0, +1.0), rng.drand64(-1.0, +1.0) );
+}
+
+static void test_operators()
+{
+ vcl_complex<double> a(-5), b(7,-1), c;
+ c = a + b;
+ c = a - b;
+ c = a * b;
+ c = a / b;
+ a += b;
+ a -= b;
+ a *= b;
+ a /= b;
+ vcl_cout << "a=" << a << '\n'
+ << "b=" << b << '\n'
+ << "c=" << c << '\n'
+ << '\n';
+}
+
+static void test_vector()
+{
+ vnl_random rng(9667566);
+ vnl_vector<vcl_complex<double> > a(5); fill_rand(a.begin(), a.end(), rng);
+ vnl_vector<vcl_complex<double> > b(5); fill_rand(b.begin(), b.end(), rng);
+
+ vcl_cout << "a=" << a << '\n'
+ << "b=" << b << '\n';
+
+ vcl_complex<double> i(0,1);
+
+ vcl_cout << dot_product(a,b) << '\n';
+ testlib_test_assert_near("inner_product() conjugates correctly",
+ inner_product(i*a,b), i*inner_product(a,b));
+ testlib_test_assert_near("inner_product() conjugates correctly",
+ inner_product(a,i*b),-i*inner_product(a,b));
+
+ testlib_test_assert_near("dot_product() does not conjugate",
+ dot_product(i*a,b), i*dot_product(a,b));
+ testlib_test_assert_near("dot_product() does not conjugate",
+ dot_product(a,i*b), i*dot_product(a,b));
+
+ double norma=0;
+ for (unsigned n=0; n<a.size(); ++n)
+ norma += vcl_real(a[n])*vcl_real(a[n]) + vcl_imag(a[n])*vcl_imag(a[n]);
+ norma = vcl_sqrt(norma);
+ testlib_test_assert_near("correct magnitude", norma, a.magnitude());
+}
+
+static void test_cosine()
+{
+ int seed = 12345;
+ for (int i=0; i<20; ++i)
+ {
+ seed = (seed*16807)%2147483647L;
+ double u = double(seed)/1367130552L;
+ if (u<0) u = -u; // between 0 and pi/2
+ seed = (seed*16807)%2147483647L;
+ double v = double(seed)/1000000000L;
+ vcl_complex<double> c(u,v);
+ vcl_complex<double> d = vcl_cos(c);
+ vcl_complex<double> e = tc_acos(d);
+ vcl_cout << c << ' ' << d << ' ' << e << '\n';
+ testlib_test_assert_near("acos", c, e, 1e-12);
+ }
+}
+
+void test_complex()
+{
+ test_operators();
+ test_vector();
+ test_cosine();
+}
+
+TESTMAIN(test_complex);
+
+//: inverse cosine for complex numbers.
+// implementation by Peter Vanroose, ESAT, KULeuven.
+vcl_complex<double> tc_acos(vcl_complex<double> x)
+{
+ double a = vcl_real(x), b = vcl_imag(x);
+ // special cases:
+ if (b==0 && a > 1)
+ return vcl_complex<double>(0.0, vcl_log(a+vcl_sqrt(a*a-1))); // == acosh(a)
+ else if (b==0 && a >= -1.0)
+ return vcl_acos(a);
+
+ // the general case:
+ // the result c + d*i satisfies a = cos(c)*cosh(d), b = -sin(c)*sinh(d)
+ // hence $\frac{a^2}{\cos^2(c)} - \frac{b^2}{\sin^2(c)} = 1$.
+ double q = (a*a-1)*(a*a-1)+b*b*(b*b+2*a*a+2);
+ double t = 0.5*(1+a*a+b*b-vcl_sqrt(q));
+ // this $t = \cos^2(c)$ solves the latter biquadratic equation and lies in [0,1].
+ double aa = a/vcl_sqrt(t), bb = b/vcl_sqrt(1-t);
+ double r_real = vcl_acos(vcl_sqrt(t));
+ double r_imag = vcl_log(vcl_fabs(aa-bb));
+ return vcl_complex<double>(r_real, r_imag);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_diag_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_diag_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f2c45a3d1590a21cfc5e56476ec913b0933645cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_diag_matrix.cxx
@@ -0,0 +1,104 @@
+// This is core/vnl/tests/test_diag_matrix.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \author Peter Vanroose, KULeuven
+// \date 20 Sept. 2002
+
+#include <vcl_iostream.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_vector_fixed.h>
+
+void test_diag_matrix()
+{
+ const unsigned int N = 3;
+
+ vnl_diag_matrix<double> m1(N);
+ for (unsigned i=0; i<N; i++)
+ m1(i,i) = i*0.25-0.25;
+
+ vnl_diag_matrix<double> const m1c=m1; // must be const in order to use m(i,j)
+ vcl_cout << "m1 = " << m1 << " =\n";
+ for (unsigned i=0; i<N; i++) {
+ vcl_cout << '\t';
+ for (unsigned j=0; j<N; j++)
+ vcl_cout << m1c(i,j) << ' ';
+ vcl_cout << '\n';
+ }
+
+ vnl_diag_matrix<double> m2(N);
+ for (unsigned i=0; i<N; i++)
+ m2(i,i) = 2.0-1.25*i;
+
+ vnl_diag_matrix<double> const m2c=m2;
+ vcl_cout << "m2 = " << m2 << " =\n";
+ for (unsigned i=0; i<N; i++) {
+ vcl_cout << '\t';
+ for (unsigned j=0; j<N; j++)
+ vcl_cout << m2c(i,j) << ' ';
+ vcl_cout << '\n';
+ }
+
+ vnl_diag_matrix<double> const sum = m1 + m2;
+ vcl_cout << "sum = " << sum << '\n';
+ TEST("sum", sum(0,0) == 1.75 && sum(1,1) == 0.75 && sum(2,2) == -0.25, true);
+
+ vnl_diag_matrix<double> const diff = m1 - m2;
+ vcl_cout << "difference = " << diff << " =\n";
+ TEST("difference", diff(0,0) == -2.25 && diff(1,1) == -0.75 && diff(2,2) == 0.75, true);
+
+ vnl_diag_matrix<double> const prod = m1 * m2;
+ vcl_cout << "product = " << prod << '\n';
+ TEST("product", prod(0,0) == -0.5 && prod(1,1) == 0.0 && prod(2,2) == -0.125, true);
+
+ vnl_vector_fixed<double,N> th; th(0)=2.0; th(1)=-3.0; th(2)=6.0;
+ vcl_cout << "vector = " << th << '\n';
+
+ vnl_vector<double> vec = m1 * th.as_ref();
+ vcl_cout << "vector product (post-multiplied) = " << vec << '\n';
+ TEST("vector product", vec(0) == -0.5 && vec(1) == 0.0 && vec(2) == 1.5, true);
+
+ vec = th.as_ref() * m1;
+ vcl_cout << "vector product (pre-multiplied) = " << vec << '\n';
+ TEST("vector product", vec(0) == -0.5 && vec(1) == 0.0 && vec(2) == 1.5, true);
+
+ vnl_matrix_fixed<double,N,N> mat;
+ mat(0,0)=0.0; mat(0,1)=-th(2); mat(0,2)= th(1);
+ mat(1,0)= th(2); mat(1,1)=0.0; mat(1,2)=-th(0);
+ mat(2,0)=-th(1); mat(2,1)= th(0); mat(2,2)=0.0;
+ vcl_cout << "matrix =\n" << mat;
+
+ vnl_matrix_fixed<double,N,N> s1=m1+mat.as_ref();
+ vcl_cout << "m1+matrix =\n" << s1;
+ TEST("matrix sum", s1(0,0) == -0.25 && s1(0,1) == -6.0 && s1(0,2) == -3.0
+ && s1(1,0) == 6.0 && s1(1,1) == 0.0 && s1(1,2) == -2.0
+ && s1(2,0) == 3.0 && s1(2,1) == 2.0 && s1(2,2) == 0.25, true);
+ vnl_matrix_fixed<double,N,N> s2=mat.as_ref()+m1;
+ vcl_cout << "matrix+m1 =\n" << s2;
+ TEST("matrix sum", s2(0,0) == -0.25 && s2(0,1) == -6.0 && s2(0,2) == -3.0
+ && s2(1,0) == 6.0 && s2(1,1) == 0.0 && s2(1,2) == -2.0
+ && s2(2,0) == 3.0 && s2(2,1) == 2.0 && s2(2,2) == 0.25, true);
+ vnl_matrix_fixed<double,N,N> d1=m1-mat.as_ref();
+ vcl_cout << "m1-matrix =\n" << d1;
+ TEST("matrix difference", d1(0,0) == -0.25 && d1(0,1) == 6.0 && d1(0,2) == 3.0
+ && d1(1,0) == -6.0 && d1(1,1) == 0.0 && d1(1,2) == 2.0
+ && d1(2,0) == -3.0 && d1(2,1) == -2.0 && d1(2,2) == 0.25, true);
+ vnl_matrix_fixed<double,N,N> d2=mat.as_ref()-m1;
+ vcl_cout << "matrix-m1 =\n" << d2;
+ TEST("matrix difference", d2(0,0) == 0.25 && d2(0,1) == -6.0 && d2(0,2) == -3.0
+ && d2(1,0) == 6.0 && d2(1,1) == -0.0 && d2(1,2) == -2.0
+ && d2(2,0) == 3.0 && d2(2,1) == 2.0 && d2(2,2) == -0.25, true);
+ vnl_matrix_fixed<double,N,N> p1=m1*mat.as_ref();
+ vcl_cout << "m1*matrix =\n" << p1;
+ TEST("matrix product", p1(0,0) == 0.0 && p1(0,1) == 1.5 && p1(0,2) == 0.75
+ && p1(1,0) == 0.0 && p1(1,1) == 0.0 && p1(1,2) == 0.0
+ && p1(2,0) == 0.75 && p1(2,1) == 0.5 && p1(2,2) == 0.0, true);
+ vnl_matrix_fixed<double,N,N> p2=mat.as_ref()*m1;
+ vcl_cout << "matrix*m1 =\n" << p2;
+ TEST("matrix product", p2(0,0) == 0.0 && p2(0,1) == 0.0 && p2(0,2) == -0.75
+ && p2(1,0) == -1.5 && p2(1,1) == 0.0 && p2(1,2) == -0.5
+ && p2(2,0) == -0.75 && p2(2,1) == 0.0 && p2(2,2) == 0.0, true);
+}
+
+TESTMAIN(test_diag_matrix);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_driver.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_driver.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..47960ca28d20ca58b4c0228acfeaee0f6bcd3d2a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_driver.cxx
@@ -0,0 +1,65 @@
+#include <testlib/testlib_register.h>
+
+DECLARE( test_bignum );
+DECLARE( test_complex );
+DECLARE( test_inverse );
+DECLARE( test_diag_matrix );
+DECLARE( test_file_matrix );
+DECLARE( test_finite );
+DECLARE( test_math );
+//DECLARE( test_matlab );
+DECLARE( test_matrix );
+DECLARE( test_matrix_exp );
+DECLARE( test_matrix_fixed );
+DECLARE( test_matrix_fixed_ref );
+DECLARE( test_numeric_traits );
+DECLARE( test_rational );
+DECLARE( test_real_polynomial );
+DECLARE( test_resize );
+DECLARE( test_sample );
+DECLARE( test_sym_matrix );
+DECLARE( test_transpose );
+DECLARE( test_fastops );
+DECLARE( test_vector );
+DECLARE( test_vector_fixed_ref );
+DECLARE( test_gamma );
+DECLARE( test_random );
+DECLARE( test_arithmetic );
+DECLARE( test_hungarian_algorithm );
+DECLARE( test_integrant );
+DECLARE( test_bessel );
+
+void
+register_tests()
+{
+ REGISTER( test_bignum );
+ REGISTER( test_complex );
+ REGISTER( test_inverse );
+ REGISTER( test_diag_matrix );
+ REGISTER( test_file_matrix );
+ REGISTER( test_finite );
+ REGISTER( test_math );
+ //REGISTER( test_matlab );
+ REGISTER( test_matrix );
+ REGISTER( test_matrix_exp );
+ REGISTER( test_matrix_fixed );
+ REGISTER( test_matrix_fixed_ref );
+ REGISTER( test_numeric_traits );
+ REGISTER( test_rational );
+ REGISTER( test_real_polynomial );
+ REGISTER( test_resize );
+ REGISTER( test_sample );
+ REGISTER( test_sym_matrix );
+ REGISTER( test_transpose );
+ REGISTER( test_fastops );
+ REGISTER( test_vector );
+ REGISTER( test_vector_fixed_ref );
+ REGISTER( test_gamma );
+ REGISTER( test_random );
+ REGISTER( test_arithmetic );
+ REGISTER( test_hungarian_algorithm );
+ REGISTER( test_integrant );
+ REGISTER( test_bessel );
+}
+
+DEFINE_MAIN;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_fastops.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_fastops.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..482f8bd3a3e2c2e183534b050a0b41179b970743
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_fastops.cxx
@@ -0,0 +1,269 @@
+// This is core/vnl/tests/test_fastops.cxx
+#include <testlib/testlib_test.h>
+//:
+// \file
+// \author Peter Vanroose
+// \date 17 June 2004
+#include <vnl/vnl_fastops.h>
+
+void test_fastops()
+{
+ // The data to work with
+ vnl_matrix<double> result_m, X; vnl_vector<double> result_v, Y;
+ vnl_matrix<double> id1x1(1,1); id1x1.set_identity();
+ vnl_matrix<double> id2x2(2,2); id2x2.set_identity();
+ vnl_matrix<double> id3x3(3,3); id3x3.set_identity();
+ vnl_matrix<double> id10x10(10,10); id10x10.set_identity();
+ vnl_matrix<double> id99x99(99,99); id99x99.set_identity();
+ double data[10] = { -7.5, 1.5, 0., -107.25, 511., -509.75, 1.25, -1., 0., 1. };
+ vnl_matrix<double> m1x1(data,1,1); // the number -7.5
+ vnl_matrix<double> m2x2(data,2,2);
+ vnl_matrix<double> m2x2t = m2x2.transpose();
+ vnl_matrix<double> m3x3(data,3,3);
+ vnl_matrix<double> m3x3t = m3x3.transpose();
+ vnl_vector<double> v1(data,1); // the number -7.5
+ vnl_vector<double> v2(data,2);
+ vnl_vector<double> v3(data,3);
+ vnl_vector<double> v10(data,10);
+ vnl_matrix<double> m10x2(10,2), m2x10(2,10);
+ for (unsigned int i=0; i<10; ++i)
+ for (unsigned int j=0; j<2; ++j)
+ m10x2[i][j] = m2x10[j][i] = (i+1)*1.5 + (j+1)*(j+i);
+
+ // First test: $I \times I$
+ result_m.set_size(1,1);
+ vnl_fastops::AtA(result_m, id1x1);
+ TEST("vnl_fastops::AtA(id1x1)", result_m, id1x1);
+ vnl_fastops::AB(result_m, id1x1, id1x1);
+ TEST("vnl_fastops::AB(id1x1,id1x1)", result_m, id1x1);
+ vnl_fastops::AtB(result_m, id1x1, id1x1);
+ TEST("vnl_fastops::AtB(id1x1,id1x1)", result_m, id1x1);
+ vnl_fastops::ABt(result_m, id1x1, id1x1);
+ TEST("vnl_fastops::ABt(id1x1,id1x1)", result_m, id1x1);
+ result_m.set_size(2,2);
+ vnl_fastops::AtA(result_m, id2x2);
+ TEST("vnl_fastops::AtA(id2x2)", result_m, id2x2);
+ vnl_fastops::AB(result_m, id2x2, id2x2);
+ TEST("vnl_fastops::AB(id2x2,id2x2)", result_m, id2x2);
+ vnl_fastops::AtB(result_m, id2x2, id2x2);
+ TEST("vnl_fastops::AtB(id2x2,id2x2)", result_m, id2x2);
+ vnl_fastops::ABt(result_m, id2x2, id2x2);
+ TEST("vnl_fastops::ABt(id2x2,id2x2)", result_m, id2x2);
+ result_m.set_size(99,99);
+ vnl_fastops::AtA(result_m, id99x99);
+ TEST("vnl_fastops::AtA(id99x99)", result_m, id99x99);
+ vnl_fastops::AB(result_m, id99x99, id99x99);
+ TEST("vnl_fastops::AB(id99x99,id99x99)", result_m, id99x99);
+ vnl_fastops::AtB(result_m, id99x99, id99x99);
+ TEST("vnl_fastops::AtB(id99x99,id99x99)", result_m, id99x99);
+ vnl_fastops::ABt(result_m, id99x99, id99x99);
+ TEST("vnl_fastops::ABt(id99x99,id99x99)", result_m, id99x99);
+
+ // Second test: $I \times M$ and $M \times I$ and $M^\top \times I$
+ result_m.set_size(1,1); result_v.set_size(1);
+ vnl_fastops::AB(result_m, id1x1, m1x1);
+ TEST("vnl_fastops::AB(id1x1,m1x1)", result_m, m1x1);
+ vnl_fastops::AB(result_m, m1x1, id1x1);
+ TEST("vnl_fastops::AB(m1x1,id1x1)", result_m, m1x1);
+ vnl_fastops::AtB(result_v, id1x1, v1);
+ TEST("vnl_fastops::AtB(id1x1,v1)", result_v, v1);
+ vnl_fastops::AtB(result_m, id1x1, m1x1);
+ TEST("vnl_fastops::AtB(id1x1,m1x1)", result_m, m1x1);
+ vnl_fastops::ABt(result_m, m1x1, id1x1);
+ TEST("vnl_fastops::ABt(m1x1,id1x1)", result_m, m1x1);
+ vnl_fastops::AtB(result_m, m1x1, id1x1);
+ TEST("vnl_fastops::AtB(m1x1,id1x1)", result_m, m1x1);
+ vnl_fastops::ABt(result_m, id1x1, m1x1);
+ TEST("vnl_fastops::ABt(id1x1,m1x1)", result_m, m1x1);
+ result_m.set_size(2,2); result_v.set_size(2);
+ vnl_fastops::AB(result_m, id2x2, m2x2);
+ TEST("vnl_fastops::AB(id2x2,m2x2)", result_m, m2x2);
+ vnl_fastops::AB(result_m, m2x2, id2x2);
+ TEST("vnl_fastops::AB(m2x2,id2x2)", result_m, m2x2);
+ vnl_fastops::AtB(result_v, id2x2, v2);
+ TEST("vnl_fastops::AtB(id2x2,v2)", result_v, v2);
+ vnl_fastops::AtB(result_m, id2x2, m2x2);
+ TEST("vnl_fastops::AtB(id2x2,m2x2)", result_m, m2x2);
+ vnl_fastops::ABt(result_m, m2x2, id2x2);
+ TEST("vnl_fastops::ABt(m2x2,id2x2)", result_m, m2x2);
+ vnl_fastops::AtB(result_m, m2x2, id2x2);
+ TEST("vnl_fastops::AtB(m2x2,id2x2)", result_m, m2x2t);
+ vnl_fastops::ABt(result_m, id2x2, m2x2);
+ TEST("vnl_fastops::ABt(id2x2,m2x2)", result_m, m2x2t);
+ result_m.set_size(3,3); result_v.set_size(3);
+ vnl_fastops::AB(result_m, id3x3, m3x3);
+ TEST("vnl_fastops::AB(id3x3,m3x3)", result_m, m3x3);
+ vnl_fastops::AB(result_m, m3x3, id3x3);
+ TEST("vnl_fastops::AB(m3x3,id3x3)", result_m, m3x3);
+ vnl_fastops::AtB(result_v, id3x3, v3);
+ TEST("vnl_fastops::AtB(id3x3,v3)", result_v, v3);
+ vnl_fastops::AtB(result_m, id3x3, m3x3);
+ TEST("vnl_fastops::AtB(id3x3,m3x3)", result_m, m3x3);
+ vnl_fastops::ABt(result_m, m3x3, id3x3);
+ TEST("vnl_fastops::ABt(m3x3,id3x3)", result_m, m3x3);
+ vnl_fastops::AtB(result_m, m3x3, id3x3);
+ TEST("vnl_fastops::AtB(m3x3,id3x3)", result_m, m3x3t);
+ vnl_fastops::ABt(result_m, id3x3, m3x3);
+ TEST("vnl_fastops::ABt(id3x3,m3x3)", result_m, m3x3t);
+ result_v.set_size(10);
+ vnl_fastops::AtB(result_v, id10x10, v10);
+ TEST("vnl_fastops::AtB(id10x10,v10)", result_v, v10);
+
+ // Third test: $M \times M$ and $M^\top \times M$ and $M \times M^\top$
+ result_m.set_size(1,1); result_v.set_size(1);
+ vnl_fastops::AtA(result_m, m1x1);
+ TEST("vnl_fastops::AtA(m1x1)", result_m, m1x1*m1x1);
+ vnl_fastops::AB(result_m, m1x1, m1x1);
+ TEST("vnl_fastops::AB(m1x1,m1x1)", result_m, m1x1*m1x1);
+ vnl_fastops::AtB(result_v, m1x1, v1);
+ TEST("vnl_fastops::AtB(m1x1,v1)", result_v, m1x1*v1);
+ vnl_fastops::AtB(result_m, m1x1, m1x1);
+ TEST("vnl_fastops::AtB(m1x1,m1x1)", result_m, m1x1*m1x1);
+ vnl_fastops::ABt(result_m, m1x1, m1x1);
+ TEST("vnl_fastops::ABt(m1x1,m1x1)", result_m, m1x1*m1x1);
+ result_m.set_size(2,2); result_v.set_size(2);
+ vnl_fastops::AtA(result_m, m2x2);
+ TEST("vnl_fastops::AtA(m2x2)", result_m, m2x2t*m2x2);
+ vnl_fastops::AB(result_m, m2x2, m2x2);
+ TEST("vnl_fastops::AB(m2x2,m2x2)", result_m, m2x2*m2x2);
+ vnl_fastops::AtB(result_v, m2x2, v2);
+ TEST("vnl_fastops::AtB(m2x2,v2)", result_v, m2x2t*v2);
+ vnl_fastops::AtB(result_m, m2x2, m2x2);
+ TEST("vnl_fastops::AtB(m2x2,m2x2)", result_m, m2x2t*m2x2);
+ vnl_fastops::ABt(result_m, m2x2, m2x2);
+ TEST("vnl_fastops::ABt(m2x2,m2x2)", result_m, m2x2*m2x2t);
+ result_m.set_size(3,3); result_v.set_size(3);
+ vnl_fastops::AtA(result_m, m3x3);
+ TEST("vnl_fastops::AtA(m3x3)", result_m, m3x3t*m3x3);
+ vnl_fastops::AB(result_m, m3x3, m3x3);
+ TEST("vnl_fastops::AB(m3x3,m3x3)", result_m, m3x3*m3x3);
+ vnl_fastops::AtB(result_v, m3x3, v3);
+ TEST("vnl_fastops::AtB(m3x3,v3)", result_v, m3x3t*v3);
+ vnl_fastops::AtB(result_m, m3x3, m3x3);
+ TEST("vnl_fastops::AtB(m3x3,m3x3)", result_m, m3x3t*m3x3);
+ vnl_fastops::ABt(result_m, m3x3, m3x3);
+ TEST("vnl_fastops::ABt(m3x3,m3x3)", result_m, m3x3*m3x3t);
+ result_m.set_size(2,2);
+ vnl_fastops::AB(result_m, m2x10, m10x2);
+ TEST("vnl_fastops::AB(m2x10,m10x2)", result_m, m2x10*m10x2);
+ vnl_fastops::AtB(result_m, m10x2, m10x2);
+ TEST("vnl_fastops::AtB(m10x2,m10x2)", result_m, m2x10*m10x2);
+ vnl_fastops::ABt(result_m, m2x10, m2x10);
+ TEST("vnl_fastops::ABt(m2x10,m2x10)", result_m, m2x10*m10x2);
+ result_m.set_size(10,10);
+ vnl_fastops::AB(result_m, m10x2, m2x10);
+ TEST("vnl_fastops::AB(m10x2,m2x10)", result_m, m10x2*m2x10);
+ vnl_fastops::AtB(result_m, m2x10, m2x10);
+ TEST("vnl_fastops::AtB(m2x10,m2x10)", result_m, m10x2*m2x10);
+ vnl_fastops::ABt(result_m, m10x2, m10x2);
+ TEST("vnl_fastops::ABt(m10x2,m10x2)", result_m, m10x2*m2x10);
+ result_v.set_size(2);
+ vnl_fastops::AtB(result_v, m10x2, v10);
+ TEST("vnl_fastops::AtB(m10x2,v10)", result_v, m2x10*v10);
+ result_v.set_size(10);
+ vnl_fastops::AtB(result_v, m2x10, v2);
+ TEST("vnl_fastops::AtB(m2x10,v2)", result_v, m10x2*v2);
+
+ // Fourth test: increments and decrements
+ X = m1x1; Y = v1;
+ vnl_fastops::inc_X_by_AtA(X, m1x1);
+ TEST("vnl_fastops::inc_X_by_AtA(X, m1x1)", X, m1x1*m1x1+m1x1);
+ vnl_fastops::dec_X_by_AtA(X, m1x1);
+ TEST("vnl_fastops::dec_X_by_AtA(X, m1x1)", X, m1x1);
+ vnl_fastops::inc_X_by_AB(X, m1x1, m1x1);
+ TEST("vnl_fastops::inc_X_by_AB(X, m1x1,m1x1)", X, m1x1*m1x1+m1x1);
+ vnl_fastops::dec_X_by_AB(X, m1x1, m1x1);
+ TEST("vnl_fastops::dec_X_by_AB(X, m1x1,m1x1)", X, m1x1);
+ vnl_fastops::inc_X_by_AtB(Y, m1x1, v1);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m1x1,v1)", Y, m1x1*v1+v1);
+ vnl_fastops::dec_X_by_AtB(Y, m1x1, v1);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m1x1,v1)", Y, v1);
+ vnl_fastops::inc_X_by_AtB(X, m1x1, m1x1);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m1x1,m1x1)", X, m1x1*m1x1+m1x1);
+ vnl_fastops::dec_X_by_AtB(X, m1x1, m1x1);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m1x1,m1x1)", X, m1x1);
+ vnl_fastops::inc_X_by_ABt(X, m1x1, m1x1);
+ TEST("vnl_fastops::inc_X_by_ABt(X, m1x1,m1x1)", X, m1x1*m1x1+m1x1);
+ vnl_fastops::dec_X_by_ABt(X, m1x1, m1x1);
+ TEST("vnl_fastops::dec_X_by_ABt(X, m1x1,m1x1)", X, m1x1);
+ X = m2x2; Y = v2;
+ vnl_fastops::inc_X_by_AtA(X, m2x2);
+ TEST("vnl_fastops::inc_X_by_AtA(X, m2x2)", X, m2x2t*m2x2+m2x2);
+ vnl_fastops::dec_X_by_AtA(X, m2x2);
+ TEST("vnl_fastops::dec_X_by_AtA(X, m2x2)", X, m2x2);
+ vnl_fastops::inc_X_by_AB(X, m2x2, m2x2);
+ TEST("vnl_fastops::inc_X_by_AB(X, m2x2,m2x2)", X, m2x2*m2x2+m2x2);
+ vnl_fastops::dec_X_by_AB(X, m2x2, m2x2);
+ TEST("vnl_fastops::dec_X_by_AB(X, m2x2,m2x2)", X, m2x2);
+ vnl_fastops::inc_X_by_AtB(Y, m2x2, v2);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m2x2,v2)", Y, m2x2t*v2+v2);
+ vnl_fastops::dec_X_by_AtB(Y, m2x2, v2);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m2x2,v2)", Y, v2);
+ vnl_fastops::inc_X_by_AtB(X, m2x2, m2x2);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m2x2,m2x2)", X, m2x2t*m2x2+m2x2);
+ vnl_fastops::dec_X_by_AtB(X, m2x2, m2x2);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m2x2,m2x2)", X, m2x2);
+ vnl_fastops::inc_X_by_ABt(X, m2x2, m2x2);
+ TEST("vnl_fastops::inc_X_by_ABt(X, m2x2,m2x2)", X, m2x2*m2x2t+m2x2);
+ vnl_fastops::dec_X_by_ABt(X, m2x2, m2x2);
+ TEST("vnl_fastops::dec_X_by_ABt(X, m2x2,m2x2)", X, m2x2);
+ X = m3x3; Y = v3;
+ vnl_fastops::inc_X_by_AtA(X, m3x3);
+ TEST("vnl_fastops::inc_X_by_AtA(X, m3x3)", X, m3x3t*m3x3+m3x3);
+ vnl_fastops::dec_X_by_AtA(X, m3x3);
+ TEST("vnl_fastops::dec_X_by_AtA(X, m3x3)", X, m3x3);
+ vnl_fastops::inc_X_by_AB(X, m3x3, m3x3);
+ TEST("vnl_fastops::inc_X_by_AB(X, m3x3,m3x3)", X, m3x3*m3x3+m3x3);
+ vnl_fastops::dec_X_by_AB(X, m3x3, m3x3);
+ TEST("vnl_fastops::dec_X_by_AB(X, m3x3,m3x3)", X, m3x3);
+ vnl_fastops::inc_X_by_AtB(Y, m3x3, v3);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m3x3,v3)", Y, m3x3t*v3+v3);
+ vnl_fastops::dec_X_by_AtB(Y, m3x3, v3);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m3x3,v3)", Y, v3);
+ vnl_fastops::inc_X_by_AtB(X, m3x3, m3x3);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m3x3,m3x3)", X, m3x3t*m3x3+m3x3);
+ vnl_fastops::dec_X_by_AtB(X, m3x3, m3x3);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m3x3,m3x3)", X, m3x3);
+ vnl_fastops::inc_X_by_ABt(X, m3x3, m3x3);
+ TEST("vnl_fastops::inc_X_by_ABt(X, m3x3,m3x3)", X, m3x3*m3x3t+m3x3);
+ vnl_fastops::dec_X_by_ABt(X, m3x3, m3x3);
+ TEST("vnl_fastops::dec_X_by_ABt(X, m3x3,m3x3)", X, m3x3);
+ X = m2x2;
+ vnl_fastops::inc_X_by_AB(X, m2x10, m10x2);
+ TEST("vnl_fastops::inc_X_by_AB(X, m2x10,m10x2)", X, m2x10*m10x2+m2x2);
+ vnl_fastops::dec_X_by_AB(X, m2x10, m10x2);
+ TEST("vnl_fastops::dec_X_by_AB(X, m2x10,m10x2)", X, m2x2);
+ vnl_fastops::inc_X_by_AtB(X, m10x2, m10x2);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m10x2,m10x2)", X, m2x10*m10x2+m2x2);
+ vnl_fastops::dec_X_by_AtB(X, m10x2, m10x2);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m10x2,m10x2)", X, m2x2);
+ vnl_fastops::inc_X_by_ABt(X, m2x10, m2x10);
+ TEST("vnl_fastops::inc_X_by_ABt(X, m2x10,m2x10)", X, m2x10*m10x2+m2x2);
+ vnl_fastops::dec_X_by_ABt(X, m2x10, m2x10);
+ TEST("vnl_fastops::dec_X_by_ABt(X, m2x10,m2x10)", X, m2x2);
+ X = m10x2*m2x10;
+ vnl_fastops::inc_X_by_AB(X, m10x2, m2x10);
+ TEST("vnl_fastops::inc_X_by_AB(X, m10x2,m2x10)", X, m10x2*m2x10*2);
+ vnl_fastops::dec_X_by_AB(X, m10x2, m2x10);
+ TEST("vnl_fastops::dec_X_by_AB(X, m10x2,m2x10)", X, m10x2*m2x10);
+ vnl_fastops::inc_X_by_AtB(X, m2x10, m2x10);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m2x10,m2x10)", X, m10x2*m2x10*2);
+ vnl_fastops::dec_X_by_AtB(X, m2x10, m2x10);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m2x10,m2x10)", X, m10x2*m2x10);
+ vnl_fastops::inc_X_by_ABt(X, m10x2, m10x2);
+ TEST("vnl_fastops::inc_X_by_ABt(X, m10x2,m10x2)", X, m10x2*m2x10*2);
+ vnl_fastops::dec_X_by_ABt(X, m10x2, m10x2);
+ TEST("vnl_fastops::dec_X_by_ABt(X, m10x2,m10x2)", X, m10x2*m2x10);
+ Y = v2;
+ vnl_fastops::inc_X_by_AtB(Y, m10x2, v10);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m10x2,v10)", Y, m2x10*v10+v2);
+ vnl_fastops::dec_X_by_AtB(Y, m10x2, v10);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m10x2,v10)", Y, v2);
+ Y = v10;
+ vnl_fastops::inc_X_by_AtB(Y, m2x10, v2);
+ TEST("vnl_fastops::inc_X_by_AtB(X, m2x10,v2)", Y, m10x2*v2+v10);
+ vnl_fastops::dec_X_by_AtB(Y, m2x10, v2);
+ TEST("vnl_fastops::dec_X_by_AtB(X, m2x10,v2)", Y, v10);
+}
+
+TESTMAIN(test_fastops);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_file_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_file_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..255062f0837ef1402ebb9ef111d1e535ef95b659
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_file_matrix.cxx
@@ -0,0 +1,28 @@
+/*
+ fsm
+*/
+#include <vcl_iostream.h>
+#include <testlib/testlib_root_dir.h>
+
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_file_matrix.h>
+#include <vnl/vnl_matlab_print.h>
+
+void test_file_matrix()
+{
+ vnl_file_matrix<double> H((testlib_root_dir()+
+ "/core/vnl/tests/data_3x3_matrix").c_str());
+
+ vnl_matlab_print(vcl_cout, H, "H");
+ TEST("file_matrix 3x3", H.rows(), 3);
+ TEST("file_matrix 3x3", H.cols(), 3);
+
+ testlib_test_assert_near("data(1,2)", H(1,2), 0.0185);
+
+ H /= H[0][0];
+
+ vnl_matlab_print(vcl_cout, H, "H");
+ testlib_test_assert_near("file_matrix 3x3", H(0,0), 1.0);
+}
+
+TESTMAIN(test_file_matrix);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_finite.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_finite.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..02d629dbca98e69461090ccb268a247b7a8fe84f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_finite.cxx
@@ -0,0 +1,290 @@
+//:
+// \file
+// Tests for vnl_finite.h, written by Peter Vanroose, 6 May 2002.
+
+#include <vcl_iostream.h>
+#include <vcl_cstdlib.h> // for atoi()
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_finite.h>
+
+template <int N>
+void test_finite_int(vnl_finite_int<N>) {
+ vcl_cout << "\n --- Testing vnl_finite_int<" << N << "> ---\n";
+
+ vcl_cout << "Phi(" << N << ") = " << vnl_finite_int<N>::totient() << '\n';
+ vnl_finite_int<N> g = vnl_finite_int<N>::smallest_generator();
+ if (g != 1) {
+ vcl_cout << "Smallest multiplicative generator of Z_" << N << " is " << g << '\n';
+ TEST("g^(Phi(N)/2) == -1", g.pow(vnl_finite_int<N>::totient()/2), -1);
+ }
+ if (N <= 1000) { // calculating multiplicative order is time consuming
+ unsigned int m = vnl_finite_int<N>(2).multiplicative_order();
+ vcl_cout << "Order of 2 in Z_" << N << " is ";
+ if (m==(unsigned int)(-1)) vcl_cout << "invalid\n"; else vcl_cout << m << '\n';
+ }
+
+ vcl_cout << "\nStarting constructor tests:\n";
+
+ {vnl_finite_int<N> b(0); TEST("vnl_finite_int<N> b(0);", b, 0);}
+ {vnl_finite_int<N> b(1); TEST("vnl_finite_int<N> b(1);", b, 1);}
+ {vnl_finite_int<N> b(-1); TEST("vnl_finite_int<N> b(-1);", b, -1);}
+ {vnl_finite_int<N> b(-1); TEST("b == N-1;", b, N-1);}
+ {vnl_finite_int<N> b(111); TEST("vnl_finite_int<N> b(111);", b, 111);}
+ {vnl_finite_int<N> b(-99); TEST("vnl_finite_int<N> b(-99);", b, -99);}
+
+ vcl_cout << "\nStarting assignment tests:\n";
+ vnl_finite_int<N> b1; b1 = 2;
+ TEST("vnl_finite_int<N> b1; b1 = 2;", b1, 2);
+ b1 = 10;
+ TEST("vnl_finite_int<N> b1; b1 = 10;", b1, 10-N);
+ b1 = -77;
+ TEST("vnl_finite_int<N> b1; b1 = -77;", b1, 11*N-77);
+
+ vnl_finite_int<N> b5 = 4321; b1 = b5;
+ TEST("b1 = b5", b1, b5);
+
+ vcl_cout << "b1 = " << b1 << vcl_endl;
+ vcl_cout << "b5 = " << b5 << vcl_endl;
+ TEST("<<", 1, 1);
+
+ TEST("unary plus", +b5, b5);
+
+ vcl_cout << "\nStarting logical comparison tests:\n";
+ vnl_finite_int<N> b0=0; vcl_cout << "b0=" << b0 << '\n';
+ b1=1; vcl_cout << "b1=" << b1 << '\n';
+ vnl_finite_int<N> b2=2; vcl_cout << "b2=" << b2 << '\n';
+ vnl_finite_int<N> b3=-2; vcl_cout << "b3=" << b3 << '\n';
+
+ TEST("b0 == b0", b0 == b0, true);
+ TEST("b0 == b1", b0 == b1, false);
+ TEST("b0 == b2", b0 == b2, N==2);
+ TEST("b0 == b3", b0 == b3, N==2);
+ TEST("b1 == b2", b1 == b2, false);
+ TEST("b1 == b3", b1 == b3, N==3);
+ TEST("b2 == b3", b2 == b3, N==2 || N==4);
+
+ TEST("b0 != b0", b0 != b0, false);
+ TEST("b0 != b1", b0 != b1, true);
+ TEST("b0 != b2", b0 != b2, N!=2);
+ TEST("b0 != b3", b0 != b3, N!=2);
+ TEST("b1 != b2", b1 != b2, true);
+ TEST("b1 != b3", b1 != b3, N!=3);
+ TEST("b2 != b3", b2 != b3, N!=2 && N!=4);
+
+ TEST("b3 != b2", b3 != b2, N!=2 && N!=4);
+ TEST("b3 != b3", b3 != b3, false);
+
+ vcl_cout << "\nStarting addition, subtraction tests:\n";
+
+ vnl_finite_int<N> bi,bj,bij;
+ vcl_cout << " for (i = 1; i < 1000; i *= 3)\n";
+ vcl_cout << " for (j = 1; j < 1000; j *= 3)\n ";
+
+ for (int i = 1; i < 1000; i *= 3) {
+ for (int j = 1; j < 1000; j *= 3) {
+ bi = i; bj = j;
+ bij = vnl_finite_int<N>(i+j);
+ if (bi + bj != bij) {
+ TEST("bi + bj == vnl_finite_int<N>(i + j)", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<'\n';
+ }
+ bij = vnl_finite_int<N>(i-j);
+ if (bi - bj != bij) {
+ TEST("bi - bj == vnl_finite_int<N>(i - j)", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<'\n';
+ }
+ }
+ }
+ vcl_cout << vcl_endl;
+
+ vnl_finite_int<N> b1000(1000);
+
+ TEST("-b0 == b0", -b0, b0);
+ TEST("-b1000 == (-1)*b1000", -b1000, (-1)*b1000);
+ TEST("-(-b1000) == b1000", -(-b1000), b1000);
+ TEST("b0 + b1000 == b1000", b0 + b1000, b1000);
+ TEST("b1000 + b0 == b1000", b1000 + b0, b1000);
+ TEST("b0 + (-b1000) == -b1000", b0 + (-b1000), -b1000);
+ TEST("-b1000 + b0 == -b1000", -b1000 + b0, -b1000);
+ TEST("-b1000 + (-b1000) == 2*(-b1000))", -b1000 + (-b1000), 2*(-b1000));
+ TEST("b1000 + (-b1000) == b0", b1000 + (-b1000), b0);
+
+ TEST("b0 - b1000 == -b1000", b0 - b1000, -b1000);
+ TEST("b1000 - b0 == b1000", b1000 - b0, b1000);
+ TEST("b0 - (-b1000) == b1000", b0 - (-b1000), b1000);
+ TEST("-b1000 - b0 == -b1000", -b1000 - b0, -b1000);
+ TEST("-b1000 - (-b1000) == b0", -b1000 - (-b1000), b0);
+ TEST("-b1000 - b1000 == -2*b1000", -b1000 - b1000, -2*b1000);
+ TEST("b1000 - (-b1000) == 2*b1000", b1000 - (-b1000), 2*b1000);
+
+ b2 = 1237; // should not be divisible by 2, 3, 5, 7, 11
+ b3 = 4321;
+ TEST("(b2+b3) - b2 = b3", (b2+b3) - b2, b3);
+ TEST("(b2+b3) - b3 = b2", (b2+b3) - b3, b2);
+
+ vcl_cout << "\nStarting multiplication tests:\n";
+
+ TEST("b0*b0 == b0", b0*b0, b0);
+ TEST("b0*b1000 == b0", b0*b1000, b0);
+ TEST("b1000*b0 == b0", b1000*b0, b0);
+ vnl_finite_int<N> b1000000(1000000);
+ TEST("b1000*b1000 == b1000000", b1000*b1000, b1000000);
+ TEST("b1000*b1000000 == b1000000*b1000", b1000*b1000000, b1000000*b1000);
+
+ if (b1000.is_unit()) {
+ vnl_finite_int<N> bb = 1;
+ for (int phi = vnl_finite_int<N>::totient(); phi > 0; --phi) bb *= b1000;
+ TEST("b1000^Phi(N) == 1", bb, 1);
+ }
+
+ vcl_cout << "\nStarting division tests:\n";
+
+ TEST("b0/b1", b0/b1, 0);
+ TEST("(-b1)/b1", (-b1)/b1, -1);
+
+ TEST("(b2*b3) / b3 = b2", (b2*b3) / b3, b2);
+ TEST("(b2*b3) / b2 = b3", (b2*b3) / b2, b3);
+
+ // Do not continue when N is too large, since that would take too long
+ if (N > 1000) return;
+
+ vcl_cout << " for (i = 10000; i > 0; i /= 3) \n";
+ vcl_cout << " for (j = 10000; j > 0; j /= 3) \n";
+ vcl_cout << " for (k = 1; k < 17; ++k) \n";
+ vcl_cout << " for (l = 1; l < 17; ++l) \n ";
+ for (int i = 10000; i > 0; i /= 3) {
+ for (int j = 10000; j > 0; j /= 3) {
+ for (int k = 1; k < 17; ++k) {
+ for (int l = 1; l < 17; ++l) {
+ b1 = vnl_finite_int<N>(i+k);
+ b2 = vnl_finite_int<N>(j+l);
+ if (b2.is_zero_divisor()) continue; // division by zero divisors is undefined
+ b3 = b1/b2;
+ int r = int(b3); r = r*(j+l)-(i+k);
+ if (r%N) {
+ TEST("(vnl_finite_int<N>(i+k)/vnl_finite_int<N>(j+l))", false, true);
+ vcl_cout<< "i="<<i<<", j="<<j<<", k="<<k<<", l="<<l<<'\n'
+ << "b1="<<int(b1)<<", b2="<<int(b2)<<", b3="<<int(b3)<<'\n';
+ }
+ }
+ }
+ }
+ }
+ vcl_cout << vcl_endl;
+}
+
+template <int N, int M>
+void test_finite_poly(vnl_finite_int_poly<N,M>, vcl_string s) {
+ vcl_cout << "\n --- Testing vnl_finite_int_poly<" << N << ',' << M << "> ---\n";
+
+ vcl_cout << "\nStarting constructor tests:\n";
+
+ vnl_finite_int_poly<N,M> b0; vcl_cout << b0 << '\n';
+ TEST("vnl_finite_int_poly<N,M> b0;", b0, 0);
+ vcl_vector<vnl_finite_int<N> > p(1); p[0]=1;
+ vnl_finite_int_poly<N,M> b(p); vcl_cout << b << '\n';
+ TEST("vnl_finite_int_poly<N,M> b(p);", b, 1);
+
+ vcl_cout << "\nStarting assignment tests:\n";
+ vnl_finite_int<N> b1 = 2; b = b1;
+ TEST("vnl_finite_int<N> b1; b = b1;", b, 2);
+
+ TEST("unary plus", +b, b);
+ TEST("unary minus", -b, N-2);
+
+ vcl_cout << "\nStarting addition, subtraction tests:\n";
+
+ vcl_cout << " for (i = 1; i < 1000; i *= 3)\n";
+ vcl_cout << " for (j = 1; j < 1000; j *= 3)\n ";
+
+ for (int i = 1000; i > 0; i /= 3) {
+ for (int j = 1000; j > 0; j /= 3) {
+ vcl_vector<vnl_finite_int<N> > v1(M), v2(M), v3(M);
+ for (int m = 0; m < M; ++m) {
+ v1[m] = i+m; v2[m] = j+m, v3[m] = i+j+2*m;
+ }
+ vnl_finite_int_poly<N,M> p1(v1);
+ vnl_finite_int_poly<N,M> p2(v2);
+ vnl_finite_int_poly<N,M> p3(v3);
+#ifdef DEBUG
+ vcl_cout << p3 << "\n ";
+#endif
+ if (p1 + p2 != p3) {
+ TEST("p1 + p2", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<'\n';
+ }
+ if (p3 - p2 != p1) {
+ TEST("p3 - p2", false, true);
+ vcl_cout << "i = "<<i<<", j = "<<j<<'\n';
+ }
+ }
+ }
+
+ vcl_cout << "\nStarting multiplication tests:\n";
+
+ vcl_vector<vnl_finite_int<N> > mod_p(M+1);
+ for (int m=0; m<=M; ++m)
+ mod_p[m] = vcl_atoi(s.c_str()+2*m);
+
+ mod_p = vnl_finite_int_poly<N,M>::modulo_polynomial(mod_p);
+ TEST("Setting modulo polynomial", 1, 1);
+
+ mod_p.pop_back();
+ vnl_finite_int_poly<N,M> irred = mod_p;
+ vcl_cout << "X^" << M << " = " << irred << "\n";
+
+ vcl_vector<vnl_finite_int<N> > v(M);
+ for (int m = 0; m < M; ++m) v[m] = m+1+m*m;
+ vnl_finite_int_poly<N,M> x(v);
+ vcl_cout << "x = " << x << "\n";
+ for (int m = 0; m < M; ++m) v[m] = m+1-m*m;
+ vnl_finite_int_poly<N,M> y(v);
+ vcl_cout << "y = " << y << "\n";
+ y *= x;
+ TEST("multiplying y with x", 1, 1);
+ vcl_cout << "y * x = " << y << "\n";
+
+ // Is irred indeed a polynomial of maximal multiplicative order?
+ vnl_finite_int_poly<N,M> t = vnl_finite_int<N>(1);
+ unsigned int order = 1;
+ do t *= irred; while (t != vnl_finite_int<N>(1) && ++order < t.cardinality());
+ TEST("multiplicative order", order != 0 && order < t.cardinality(), true);
+ vcl_cout << "Multiplicative order of " << irred << " is " << order << '\n';
+ TEST("multiplicative order", irred.multiplicative_order(), order);
+ if (order+1 == t.cardinality())
+ vcl_cout << "This is a Galois field of order " << order+1 << '\n';
+ TEST("Field?", t.is_field(), order+1 == t.cardinality());
+
+ vcl_cout << vcl_endl;
+}
+
+void test_finite() {
+ test_finite_int(vnl_finite_int<2>(0));
+ test_finite_int(vnl_finite_int<3>(0));
+ test_finite_int(vnl_finite_int<4>(0)); // not a field
+ vnl_finite_int<4> b4 = 2; TEST("2*2=0 mod 4", b4*b4, 0); // zero divisor
+ test_finite_int(vnl_finite_int<5>(0)); // Fermat prime
+ test_finite_int(vnl_finite_int<6>(0));
+ vnl_finite_int<6> b6 = 2; TEST("2*3=0 mod 6", b6*3, 0); // zero divisor
+ test_finite_int(vnl_finite_int<7>(0)); // Mersenne prime
+ test_finite_int(vnl_finite_int<8>(0));
+ test_finite_int(vnl_finite_int<9>(0));
+ test_finite_int(vnl_finite_int<10>(0));
+ test_finite_int(vnl_finite_int<17>(0)); // Fermat prime
+ test_finite_int(vnl_finite_int<31>(0)); // Mersenne prime
+ test_finite_int(vnl_finite_int<100>(0)); // non-prime square
+ vnl_finite_int<100> b100 = 20; TEST("25*20=0 mod 100", 25*b100, 0); // zero divisor
+ test_finite_int(vnl_finite_int<243>(0)); // high prime power
+ test_finite_int(vnl_finite_int<256>(0)); // high power of 2
+ test_finite_int(vnl_finite_int<432>(0)); // high combined power of 2 and 3
+ vnl_finite_int<432> b432 = 180; TEST("180*12=0 mod 432", b432*12, 0); // zero divisor
+ test_finite_int(vnl_finite_int<257>(0)); // Fermat prime
+ test_finite_int(vnl_finite_int<0x10001>(0)); // Fermat prime
+
+ test_finite_poly(vnl_finite_int_poly<2,5>(0), "1 0 1 0 0 1"); // this is GF(32)
+ test_finite_poly(vnl_finite_int_poly<3,3>(0), "1 2 0 1"); // this is GF(27)
+ test_finite_poly(vnl_finite_int_poly<3,3>(0), "1 1 0 1"); // not a field
+ test_finite_poly(vnl_finite_int_poly<6,2>(0), "1 0 1");
+}
+
+TESTMAIN(test_finite);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_gamma.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_gamma.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..bdf86588ac075778c17aa27e3276bd37a3ab5239
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_gamma.cxx
@@ -0,0 +1,39 @@
+// This is core/vnl/tests/test_gamma.cxx
+#include <vnl/vnl_gamma.h>
+#include <vnl/vnl_erf.h>
+#include <testlib/testlib_test.h>
+
+static void test_gamma()
+{
+ TEST_NEAR("vnl_log_gamma(1)", vnl_log_gamma(1), 0, 1e-8);
+ TEST_NEAR("vnl_gamma(1))", vnl_gamma(1), 1, 1e-8);
+
+ // `true' values obtained from http://www.efunda.com/math/gamma/findgamma.cfm
+ TEST_NEAR("vnl_gamma(0.5))", vnl_gamma(0.5), 1.77245385091, 1e-10);
+ TEST_NEAR("vnl_gamma(1.5))", vnl_gamma(1.5), 0.88622692545, 1e-10);
+ TEST_NEAR("vnl_gamma(10.7))", vnl_gamma(10.7), 1799844.07893, 1e-5);
+
+ TEST_NEAR("vnl_gamma_p(2,0)", vnl_gamma_p(2,0), 0, 1e-8);
+ TEST_NEAR("vnl_gamma_p(2,inf)", vnl_gamma_p(2,1e9), 1.0, 1e-8);
+
+ // Values from MATLAB
+ TEST_NEAR("vnl_gamma_p(2.5,1.5)", vnl_gamma_p(2.5,1.5), 0.300014164, 1e-8);
+ TEST_NEAR("vnl_gamma_p(2.5,0.5)", vnl_gamma_p(2.5,0.5), 0.037434227, 1e-8);
+ // Next one not so accurate?
+ TEST_NEAR("vnl_gamma_p(10,10)", vnl_gamma_p(10,10), 0.542070286, 1e-6);
+
+ TEST_NEAR("vnl_gamma_q(2,0)", vnl_gamma_q(2,0), 1.0, 1e-8);
+ TEST_NEAR("vnl_gamma_q(2,inf)", vnl_gamma_q(2,1e9), 0, 1e-8);
+ TEST_NEAR("vnl_erf(0)", vnl_erf(0), 0, 1e-8);
+ TEST_NEAR("vnl_erf(inf)", vnl_erf(1e9), 1.0, 1e-8);
+ TEST_NEAR("vnl_erf(-inf)", vnl_erf(-1e9), -1.0, 1e-8);
+ TEST("vnl_erfc(0)", vnl_erfc(0.0), 1.0);
+ TEST_NEAR("vnl_erfc(0.2) = 1-vnl_erf(0.2)", vnl_erfc(0.2), 1.0-vnl_erf(0.2), 1e-8);
+ TEST_NEAR("vnl_erfc(1.2) = 1-vnl_erf(1.2)", vnl_erfc(1.2), 1.0-vnl_erf(1.2), 1e-6);
+ TEST_NEAR("vnl_erfc(2)", vnl_erfc(2), 0.00467773498105, 1e-8);
+ TEST_NEAR_REL("vnl_erfc(6)", vnl_erfc(6), 2.15197367125e-17,1e-8);
+ TEST_NEAR("vnl_erfc(inf)", vnl_erfc(1e9), 0.0, 1e-8);
+ TEST_NEAR("vnl_erfc(-inf)", vnl_erfc(-1e9), 2.0, 1e-8);
+}
+
+TESTMAIN(test_gamma);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_hungarian_algorithm.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_hungarian_algorithm.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a848d5dddbd1fcb9ac798f9148b8268b38b6c899
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_hungarian_algorithm.cxx
@@ -0,0 +1,127 @@
+#include <vnl/vnl_hungarian_algorithm.h>
+#include <testlib/testlib_test.h>
+
+#include <vcl_iostream.h>
+#include <vcl_limits.h>
+#include <vnl/vnl_matrix.h>
+
+static void test_hungarian_algorithm( int, char*[] )
+{
+ {
+ double cost_val[3][3] = { { 1, 2, 3 },
+ { 2, 4, 6 },
+ { 3, 6, 9 } };
+
+ vnl_matrix<double> cost( &cost_val[0][0], 3, 3 );
+
+ testlib_test_begin( "Test 3x3 cost matrix" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==3 &&
+ assign[0]==2 &&
+ assign[1]==1 &&
+ assign[2]==0 );
+ }
+
+
+ {
+ double cost_val[4][4] = { { 2.0, 1.0, 5.0, 3.0 },
+ { 0.5, 6.0, 3.0, 0.5 },
+ { 5.0, 2.0, 1.0, 6.0 },
+ { 7.0, 1.0, 3.0, 0.1 } };
+ vnl_matrix<double> cost( &cost_val[0][0], 4, 4 );
+
+ testlib_test_begin( "Test 4x4 cost matrix" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==4 &&
+ assign[0]==1 &&
+ assign[1]==0 &&
+ assign[2]==2 &&
+ assign[3]==3 );
+ }
+
+ {
+ double cost_val[3][4] = { { 2.0, 1.0, 5.0, 3.0 },
+ { 0.5, 6.0, 3.0, 0.5 },
+ { 7.0, 1.0, 3.0, 0.1 } };
+ vnl_matrix<double> cost( &cost_val[0][0], 3, 4 );
+
+ testlib_test_begin( "Test 3x4 cost matrix" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==3 &&
+ assign[0]==1 &&
+ assign[1]==0 &&
+ assign[2]==3 );
+ }
+
+ {
+ double cost_val[4][3] = { { 2.0, 0.5, 7.0 },
+ { 1.0, 6.0, 1.0 },
+ { 5.0, 3.0, 3.0 },
+ { 3.0, 0.5, 0.1 } };
+
+ vnl_matrix<double> cost( &cost_val[0][0], 4, 3 );
+
+ testlib_test_begin( "Test 4x3 cost matrix" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==4 &&
+ assign[0]==1 &&
+ assign[1]==0 &&
+ assign[2]==-1u &&
+ assign[3]==2 );
+ }
+
+ {
+ double cost_val[5][3] = { { 2.0, 0.5, 7.0 },
+ { 1.1, 6.0, 1.0 },
+ { 1.0, 2.0, 1.0 },
+ { 5.0, 3.0, 3.0 },
+ { 3.0, 0.5, 0.1 } };
+
+ vnl_matrix<double> cost( &cost_val[0][0], 5, 3 );
+
+ testlib_test_begin( "Test 5x3 cost matrix" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==5 &&
+ assign[0]==1 &&
+ assign[1]==-1u &&
+ assign[2]==0 &&
+ assign[3]==-1u &&
+ assign[4]==2 );
+
+ testlib_test_begin( "Test 3x5 cost matrix" );
+ vcl_vector<unsigned> assign2 = vnl_hungarian_algorithm( cost.transpose() );
+ testlib_test_perform( assign2.size()==3 &&
+ assign2[0]==2 &&
+ assign2[1]==0 &&
+ assign2[2]==4 );
+ }
+
+ double Inf = vcl_numeric_limits<double>::infinity();
+ {
+ double cost_val[5][3] = { { 2.0, 0.5, 7.0 },
+ { 1.1, 6.0, 1.0 },
+ { 1.0, 2.0, 1.0 },
+ { Inf, 3.0, 3.0 },
+ { 3.0, 0.5, 0.1 } };
+
+ vnl_matrix<double> cost( &cost_val[0][0], 5, 3 );
+
+ testlib_test_begin( "Test 5x3 cost matrix with Inf" );
+ vcl_vector<unsigned> assign = vnl_hungarian_algorithm( cost );
+ testlib_test_perform( assign.size()==5 &&
+ assign[0]==1 &&
+ assign[1]==-1u &&
+ assign[2]==0 &&
+ assign[3]==-1u &&
+ assign[4]==2 );
+
+ testlib_test_begin( "Test 3x5 cost matrix with Inf" );
+ vcl_vector<unsigned> assign2 = vnl_hungarian_algorithm( cost.transpose() );
+ testlib_test_perform( assign2.size()==3 &&
+ assign2[0]==2 &&
+ assign2[1]==0 &&
+ assign2[2]==4 );
+ }
+}
+
+TESTMAIN_ARGS( test_hungarian_algorithm )
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_include.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_include.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4cbbd95d3d2049b5c91c611973f90b488af98557
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_include.cxx
@@ -0,0 +1,117 @@
+#include <vnl/vnl_fwd.h>
+
+#include <vnl/vnl_T_n.h>
+#include <vnl/vnl_alloc.h>
+#include <vnl/vnl_analytic_integrant.h>
+#include <vnl/vnl_bessel.h>
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_bignum_traits.h>
+#include <vnl/vnl_block.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_complex.h>
+#include <vnl/vnl_complexify.h>
+#include <vnl/vnl_complex_traits.h>
+#include <vnl/vnl_copy.h>
+#include <vnl/vnl_cross.h>
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_cross_product_matrix.h>
+#include <vnl/vnl_definite_integral.h>
+#include <vnl/vnl_det.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vnl/vnl_double_1x1.h>
+#include <vnl/vnl_double_1x2.h>
+#include <vnl/vnl_double_1x3.h>
+#include <vnl/vnl_double_2.h>
+#include <vnl/vnl_double_2x1.h>
+#include <vnl/vnl_double_2x2.h>
+#include <vnl/vnl_double_2x3.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_double_3x1.h>
+#include <vnl/vnl_double_3x2.h>
+#include <vnl/vnl_double_3x3.h>
+#include <vnl/vnl_double_3x4.h>
+#include <vnl/vnl_double_4.h>
+#include <vnl/vnl_double_4x3.h>
+#include <vnl/vnl_double_4x4.h>
+#include <vnl/vnl_erf.h>
+#include <vnl/vnl_error.h>
+#include <vnl/vnl_fastops.h>
+#include <vnl/vnl_file_matrix.h>
+#include <vnl/vnl_file_vector.h>
+#include <vnl/vnl_finite.h>
+#include <vnl/vnl_float_1x1.h>
+#include <vnl/vnl_float_1x2.h>
+#include <vnl/vnl_float_1x3.h>
+#include <vnl/vnl_float_2.h>
+#include <vnl/vnl_float_2x1.h>
+#include <vnl/vnl_float_2x2.h>
+#include <vnl/vnl_float_3.h>
+#include <vnl/vnl_float_3x1.h>
+#include <vnl/vnl_float_3x3.h>
+#include <vnl/vnl_float_3x4.h>
+#include <vnl/vnl_float_4.h>
+#include <vnl/vnl_float_4x3.h>
+#include <vnl/vnl_float_4x4.h>
+#include <vnl/vnl_fortran_copy.h>
+#include <vnl/vnl_gamma.h>
+#include <vnl/vnl_hungarian_algorithm.h>
+#include <vnl/vnl_identity.h>
+#include <vnl/vnl_identity_3x3.h>
+#include <vnl/vnl_imag.h>
+#include <vnl/vnl_int_1x1.h>
+#include <vnl/vnl_int_2.h>
+#include <vnl/vnl_int_2x2.h>
+#include <vnl/vnl_int_3.h>
+#include <vnl/vnl_int_4.h>
+#include <vnl/vnl_int_matrix.h>
+#include <vnl/vnl_integrant_fnct.h>
+#include <vnl/vnl_inverse.h>
+#include <vnl/vnl_least_squares_cost_function.h>
+#include <vnl/vnl_least_squares_function.h>
+#include <vnl/vnl_linear_operators_3.h>
+#include <vnl/vnl_linear_system.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_matlab_filewrite.h>
+#include <vnl/vnl_matlab_header.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_matlab_print2.h>
+#include <vnl/vnl_matlab_print_format.h>
+#include <vnl/vnl_matlab_print_scalar.h>
+#include <vnl/vnl_matlab_read.h>
+#include <vnl/vnl_matlab_write.h>
+#include <vnl/vnl_matops.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_exp.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_matrix_ref.h>
+#include <vnl/vnl_matrix_fixed_ref.h>
+#include <vnl/vnl_nonlinear_minimizer.h>
+#include <vnl/vnl_numeric_traits.h>
+#include <vnl/vnl_operators.h>
+#include <vnl/vnl_quaternion.h>
+#include <vnl/vnl_rank.h>
+#include <vnl/vnl_random.h>
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vnl/vnl_real.h>
+#include <vnl/vnl_real_npolynomial.h>
+#include <vnl/vnl_real_polynomial.h>
+#include <vnl/vnl_rotation_matrix.h>
+#include <vnl/vnl_sample.h>
+#include <vnl/vnl_scalar_join_iterator.h>
+#include <vnl/vnl_sparse_matrix.h>
+#include <vnl/vnl_sparse_matrix_linear_system.h>
+#include <vnl/vnl_sym_matrix.h>
+#include <vnl/vnl_tag.h>
+#include <vnl/vnl_trace.h>
+#include <vnl/vnl_transpose.h>
+#include <vnl/vnl_unary_function.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_vector_ref.h>
+#include <vnl/vnl_vector_fixed_ref.h>
+
+// Put vnl_config.h at the end, to verify that none of the above implicitly depend on it
+#include <vnl/vnl_config.h>
+
+int main() { return 0; }
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_integrant.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_integrant.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5c8f323438409466544dd447a655e2274d6ff5f2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_integrant.cxx
@@ -0,0 +1,19 @@
+#include <vcl_iostream.h>
+#include <vnl/vnl_analytic_integrant.h>
+#include <testlib/testlib_test.h>
+
+class my_test_integrant : public vnl_integrant_fnct
+{
+ public:
+ double f_(double x) { return x/(1+x*x); }
+};
+
+void test_integrant()
+{
+ my_test_integrant f;
+
+ TEST_NEAR("test integrant f = x/(1+x^2) when x=1, f is ", f.f_(1), 0.5, 1e-13);
+
+}
+
+TESTMAIN(test_integrant);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_inverse.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_inverse.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5cfa746d8f03736af8edf701e6c91198db6bacc6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_inverse.cxx
@@ -0,0 +1,182 @@
+#include <vnl/vnl_inverse.h>
+#include <vnl/vnl_double_2x2.h>
+#include <vnl/vnl_double_3x3.h>
+#include <vnl/vnl_double_4x4.h>
+#include <vnl/vnl_random.h>
+
+#include <testlib/testlib_test.h>
+
+static void test_inverse()
+{
+ double eps = 1e-11;
+ vnl_random rng(9667566ul);
+ vnl_double_2x2 residue2, id2; id2.set_identity();
+ vnl_double_3x3 residue3, id3; id3.set_identity();
+ vnl_double_4x4 residue4, id4; id4.set_identity();
+ vnl_matrix<double> M, Mi;
+
+ // 2x2 inverse of a specific matrix
+ vnl_double_2x2 id2i = vnl_inverse(id2);
+ TEST("vnl_inverse of 2x2 Id", id2i, id2);
+ id2i = vnl_inverse_transpose(id2);
+ TEST("vnl_inverse_transpose of 2x2 Id", id2i, id2);
+
+ double M2[4] = {
+ 0.60684258354179, 0.89129896614890,
+ 0.48598246870930, 0.76209683302739
+ };
+ vnl_double_2x2 m2(M2);
+ vnl_double_2x2 m2i = vnl_inverse(m2);
+ residue2 = m2*m2i - id2;
+ TEST_NEAR("2x2 vnl_inverse", residue2.array_inf_norm(), 0.0, eps);
+ residue2 = m2i*m2 - id2;
+ TEST_NEAR("2x2 vnl_inverse", residue2.array_inf_norm(), 0.0, eps);
+
+ m2i = vnl_inverse_transpose(m2);
+ residue2 = m2.transpose()*m2i - id2;
+ TEST_NEAR("2x2 vnl_inverse_transpose", residue2.array_inf_norm(), 0.0, eps);
+ residue2 = m2i.transpose()*m2 - id2;
+ TEST_NEAR("2x2 vnl_inverse_transpose", residue2.array_inf_norm(), 0.0, eps);
+
+ M = m2;
+ Mi = vnl_inverse(M);
+ residue2 = m2*Mi - id2;
+ TEST_NEAR("2x2 vnl_inverse", residue2.array_inf_norm(), 0.0, eps);
+
+ Mi = vnl_inverse_transpose(M).transpose();
+ residue2 = m2*Mi - id2;
+ TEST_NEAR("2x2 vnl_inverse_transpose", residue2.array_inf_norm(), 0.0, eps);
+
+ // 2x2 inverse of random matrix
+ for (int i=0; i<4; ++i) M2[i] = rng.drand32(-1.0,1.0);
+ vnl_double_2x2 m2r(M2);
+ m2i = vnl_inverse(m2r);
+ residue2 = m2r*m2i - id2;
+ TEST_NEAR("rand 2x2 vnl_inverse", residue2.array_inf_norm(), 0.0, eps);
+ residue2 = m2i*m2r - id2;
+ TEST_NEAR("rand 2x2 vnl_inverse", residue2.array_inf_norm(), 0.0, eps);
+
+ m2i = vnl_inverse_transpose(m2r);
+ residue2 = m2r.transpose()*m2i - id2;
+ TEST_NEAR("rand 2x2 vnl_inverse_transpose", residue2.array_inf_norm(), 0.0, eps);
+ residue2 = m2i.transpose()*m2r - id2;
+ TEST_NEAR("rand 2x2 vnl_inverse_transpose", residue2.array_inf_norm(), 0.0, eps);
+
+ // 3x3 inverse of a specific matrix
+ vnl_double_3x3 id3i = vnl_inverse(id3);
+ TEST("vnl_inverse of 3x3 Id", id3i, id3);
+ id3i = vnl_inverse_transpose(id3);
+ TEST("vnl_inverse_transpose of 3x3 Id", id3i, id3);
+
+ double M3[9] = {
+ 0.45646766516834, 0.44470336435319, 0.92181297074480,
+ 0.01850364324822, 0.61543234810009, 0.73820724581067,
+ 0.82140716429525, 0.79193703742704, 0.17626614449462
+ };
+ vnl_double_3x3 m3(M3);
+ vnl_double_3x3 m3i = vnl_inverse(m3);
+ residue3 = m3*m3i - id3;
+ TEST_NEAR("3x3 vnl_inverse", residue3.array_inf_norm(), 0.0, eps);
+ residue3 = m3i*m3 - id3;
+ TEST_NEAR("3x3 vnl_inverse", residue3.array_inf_norm(), 0.0, eps);
+
+ m3i = vnl_inverse_transpose(m3);
+ residue3 = m3.transpose()*m3i - id3;
+ TEST_NEAR("3x3 vnl_inverse_transpose", residue3.array_inf_norm(), 0.0, eps);
+ residue3 = m3i.transpose()*m3 - id3;
+ TEST_NEAR("3x3 vnl_inverse_transpose", residue3.array_inf_norm(), 0.0, eps);
+
+ M = m3;
+ Mi = vnl_inverse(M);
+ residue3 = m3*Mi - id3;
+ TEST_NEAR("3x3 vnl_inverse", residue3.array_inf_norm(), 0.0, eps);
+
+ Mi = vnl_inverse_transpose(M).transpose();
+ residue3 = m3*Mi - id3;
+ TEST_NEAR("3x3 vnl_inverse_transpose", residue3.array_inf_norm(), 0.0, eps);
+
+ // 3x3 inverse of random matrix
+ for (int i=0; i<9; ++i) M3[i] = rng.drand32(-1.0,1.0);
+ vnl_double_3x3 m3r(M3);
+ m3i = vnl_inverse(m3r);
+ residue3 = m3r*m3i - id3;
+ TEST_NEAR("3x3 vnl_inverse", residue3.array_inf_norm(), 0.0, eps);
+ residue3 = m3i*m3r - id3;
+ TEST_NEAR("3x3 vnl_inverse", residue3.array_inf_norm(), 0.0, eps);
+
+ m3i = vnl_inverse_transpose(m3r);
+ residue3 = m3r.transpose()*m3i - id3;
+ TEST_NEAR("rand 3x3 vnl_inverse_transpose", residue3.array_inf_norm(), 0.0, eps);
+ residue3 = m3i.transpose()*m3r - id3;
+ TEST_NEAR("rand 3x3 vnl_inverse_transpose", residue3.array_inf_norm(), 0.0, eps);
+
+ // 4x4 inverse of a specific matrix
+ vnl_double_4x4 id4i = vnl_inverse(id4);
+ TEST("vnl_inverse of 4x4 Id", id4i, id4);
+ id4i = vnl_inverse_transpose(id4);
+ TEST("vnl_inverse_transpose of 4x4 Id", id4i, id4);
+
+ double M4[16] = {
+ 0.40570621306210, 0.89364953091353, 0.00986130066092, 0.60379247919382,
+ 0.93546969910761, 0.05789130478427, 0.13889088195695, 0.27218792496996,
+ 0.91690443991341, 0.35286813221700, 0.20276521856027, 0.19881426776106,
+ 0.41027020699095, 0.81316649730376, 0.19872174266149, 0.01527392702904
+ };
+ vnl_double_4x4 m4(M4);
+ vnl_double_4x4 m4i = vnl_inverse(m4);
+ residue4 = m4*m4i - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i*m4 - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+
+ m4i = vnl_inverse_transpose(m4);
+ residue4 = m4.transpose()*m4i - id4;
+ TEST_NEAR("4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i.transpose()*m4 - id4;
+ TEST_NEAR("4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+
+ M = m4;
+ Mi = vnl_inverse(M);
+ residue4 = m4*Mi - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+
+ Mi = vnl_inverse_transpose(M).transpose();
+ residue4 = m4*Mi - id4;
+ TEST_NEAR("4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+
+ // 4x4 inverse of random matrix
+ for (int i=0; i<16; ++i) M4[i] = rng.drand32(-1.0,1.0);
+ vnl_double_4x4 m4r(M4);
+ m4i = vnl_inverse(m4r);
+ residue4 = m4r*m4i - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i*m4r - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+
+ m4i = vnl_inverse_transpose(m4r);
+ residue4 = m4r.transpose()*m4i - id4;
+ TEST_NEAR("rand 4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i.transpose()*m4r - id4;
+ TEST_NEAR("rand 4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+
+ // 4x4 inverse of a specific sparse matrix
+ double M4s[16] = {
+ 0.9998, 0.0, 0.02, 0.059,
+ 0.0, 1.0, 0.0, 0.0,
+ -0.02, 0.0, 0.9998, 0.0,
+ 0.0, 0.0, 0.0, 1.0
+ };
+ vnl_double_4x4 m4s(M4s);
+ m4i = vnl_inverse(m4s);
+ residue4 = m4s*m4i - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i*m4s - id4;
+ TEST_NEAR("4x4 vnl_inverse", residue4.array_inf_norm(), 0.0, eps);
+ m4i = vnl_inverse_transpose(m4s);
+ residue4 = m4s.transpose()*m4i - id4;
+ TEST_NEAR("4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+ residue4 = m4i.transpose()*m4s - id4;
+ TEST_NEAR("4x4 vnl_inverse_transpose", residue4.array_inf_norm(), 0.0, eps);
+}
+
+TESTMAIN(test_inverse);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_math.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_math.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dac1f0b9b65dbeb6781cd81a9189bca5933f4f5a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_math.cxx
@@ -0,0 +1,171 @@
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h>
+#include <vcl_limits.h> // for infinity()
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_complex.h>
+#include <testlib/testlib_test.h>
+
+static
+void check_pointer( const void * )
+{
+}
+
+static
+void test_static_const_definition()
+{
+ check_pointer( &vnl_math::e );
+ check_pointer( &vnl_math::log2e );
+ check_pointer( &vnl_math::log10e );
+ check_pointer( &vnl_math::ln2 );
+ check_pointer( &vnl_math::ln10 );
+ check_pointer( &vnl_math::pi );
+ check_pointer( &vnl_math::pi_over_2 );
+ check_pointer( &vnl_math::pi_over_4 );
+ check_pointer( &vnl_math::one_over_pi );
+ check_pointer( &vnl_math::two_over_pi );
+ check_pointer( &vnl_math::two_over_sqrtpi );
+ check_pointer( &vnl_math::sqrt2 );
+ check_pointer( &vnl_math::sqrt1_2 );
+ check_pointer( &vnl_math::eps );
+ check_pointer( &vnl_math::sqrteps );
+}
+
+void test_math()
+{
+ // Call it to avoid compiler warnings
+ test_static_const_definition();
+
+ int n = -11;
+ float f = -7.5;
+ double d = -vnl_math::pi;
+ vcl_complex<double> i(0,1);
+ vcl_complex<double> z(-1,2);
+ vcl_complex<double> e_ipi = vcl_exp(d*i);
+
+ vcl_cout << "n = " << n << vcl_endl
+ << "f = " << f << vcl_endl
+ << "d = " << d << vcl_endl
+ << "i = " << i << vcl_endl
+ << "z = " << z << vcl_endl
+ << "exp(d*i) = " << e_ipi << vcl_endl
+ << vcl_endl
+
+ << "abs(n) = " << vnl_math_abs(n) << vcl_endl
+ << "abs(f) = " << vnl_math_abs(f) << vcl_endl
+ << "abs(d) = " << vnl_math_abs(d) << vcl_endl
+ << "abs(i) = " << vnl_math_abs(i) << vcl_endl
+ << "abs(z) = " << vnl_math_abs(z) << vcl_endl
+ <<"norm(z) = " << vnl_math_squared_magnitude(z) << vcl_endl
+ << vcl_endl;
+
+ testlib_test_assert("abs(n) == 11", vnl_math_abs(n) == 11);
+ testlib_test_assert("abs(f) == 7.5", vnl_math_abs(f) == 7.5);
+ testlib_test_assert("abs(d) == pi", vnl_math_abs(d) == vnl_math::pi);
+ testlib_test_assert("abs(i) == 1", vnl_math_abs(i) == 1.0);
+ testlib_test_assert_near("abs(-1+2i)~=sqrt(5)",vnl_math_abs(z),vcl_sqrt(5.0));
+ testlib_test_assert_near("norm(-1+2i) ~= 5", vnl_math_squared_magnitude(z),5);
+ testlib_test_assert_near("exp(d*i) ~= -1", vnl_math_abs(e_ipi+1.0), 0);
+ vcl_cout << vcl_endl;
+
+ testlib_test_assert(" isfinite(f) ", vnl_math_isfinite(f));
+ testlib_test_assert(" isfinite(d) ", vnl_math_isfinite(d));
+ testlib_test_assert(" isfinite(i) ", vnl_math_isfinite(i));
+ testlib_test_assert(" isfinite(z) ", vnl_math_isfinite(z));
+
+
+ // There is an assumption in this code that vcl_numeric_limits<float/double>::has_infinity==true
+
+ testlib_test_assert("vcl_numeric_limits<float>::has_infinity==true assumption",vcl_numeric_limits<float>::has_infinity);
+ testlib_test_assert("vcl_numeric_limits<double>::has_infinity==true assumption",vcl_numeric_limits<double>::has_infinity);
+ testlib_test_assert("vcl_numeric_limits<ldouble>::has_infinity==true assumption",vcl_numeric_limits<long double>::has_infinity);
+ if (! vcl_numeric_limits<float>::has_infinity && ! vcl_numeric_limits<double>::has_infinity)
+ {
+ vcl_cout << "Your platform doesn't appear to have an infinity. VXL is in places relatively\n"
+ << "dependent on the existence of an infinity. There are two solutions.\n"
+ << "A. If your platform really doesn't have an infinity, VXL's configuration code\n"
+ << " can be modified to correctly detect and use the infinity.\n"
+ << "B. Fix VXL so that it can cope with the lack of an infinity.\n" << vcl_endl;
+ }
+ testlib_test_assert("vcl_numeric_limits<float>::has_quiet_NaN==true assumption",vcl_numeric_limits<float>::has_quiet_NaN);
+ testlib_test_assert("vcl_numeric_limits<double>::has_quiet_NaN==true assumption",vcl_numeric_limits<double>::has_quiet_NaN);
+ testlib_test_assert("vcl_numeric_limits<ldouble>::has_quiet_NaN==true assumption",vcl_numeric_limits<long double>::has_quiet_NaN);
+ if (! vcl_numeric_limits<float>::has_quiet_NaN && ! vcl_numeric_limits<double>::has_quiet_NaN)
+ {
+ vcl_cout << "Your platform doesn't appear to have a quiet NaN. VXL is in places relatively\n"
+ << "dependent on the existence of a quiet NaN. There are two solutions.\n"
+ << "A. If your platform really doesn't have a quiet NaN, VXL's configuration code\n"
+ << " can be modified to correctly detect and use the NaN.\n"
+ << "B. Fix VXL so that it can cope with the lack of a quiet NaN.\n" << vcl_endl;
+ }
+ // Create Inf and -Inf:
+ float pinf_f = vcl_numeric_limits<float>::infinity();
+ float ninf_f = - vcl_numeric_limits<float>::infinity();
+ double pinf_d = vcl_numeric_limits<double>::infinity();
+ double ninf_d = - vcl_numeric_limits<double>::infinity();
+ long double pinf_q = vcl_numeric_limits<long double>::infinity();
+ long double ninf_q = - vcl_numeric_limits<long double>::infinity();
+
+ // Create NaN
+ float qnan_f = vcl_numeric_limits<float>::quiet_NaN();
+ double qnan_d = vcl_numeric_limits<double>::quiet_NaN();
+ long double qnan_q = vcl_numeric_limits<long double>::quiet_NaN();
+
+#define print_hex(p) \
+ vcl_hex<<vcl_setfill('0')<<vcl_setw(sizeof(unsigned int))<<*(unsigned int*)(&p); \
+ for (int i=1; i*sizeof(unsigned int)<sizeof(p); ++i) \
+ vcl_cout<<vcl_setfill('0')<<vcl_setw(sizeof(unsigned int))<<((unsigned int*)(&p))[i]; \
+ vcl_cout<<vcl_dec
+
+ vcl_cout << "pinf_f = " << pinf_f << " = " << print_hex(pinf_f) << vcl_endl
+ << "ninf_f = " << ninf_f << " = " << print_hex(ninf_f) << vcl_endl
+ << "pinf_d = " << pinf_d << " = " << print_hex(pinf_d) << vcl_endl
+ << "ninf_d = " << ninf_d << " = " << print_hex(ninf_d) << vcl_endl
+ << "pinf_q = " << pinf_q << " = " << print_hex(pinf_q) << vcl_endl
+ << "ninf_q = " << ninf_q << " = " << print_hex(ninf_q) << vcl_endl
+ << "qnan_f = " << qnan_f << " = " << print_hex(qnan_f) << vcl_endl
+ << "qnan_d = " << qnan_d << " = " << print_hex(qnan_d) << vcl_endl
+ << "qnan_q = " << qnan_q << " = " << print_hex(qnan_q) << vcl_endl
+ << vcl_endl;
+#undef print_hex
+
+#ifndef __alpha__ // on alpha, infinity() == max()
+ testlib_test_assert("!isfinite(pinf_f)", !vnl_math_isfinite(pinf_f));
+ testlib_test_assert("!isfinite(ninf_f)", !vnl_math_isfinite(ninf_f));
+ testlib_test_assert(" isinf(pinf_f) ", vnl_math_isinf(pinf_f));
+ testlib_test_assert(" isinf(ninf_f) ", vnl_math_isinf(ninf_f));
+#endif
+ testlib_test_assert("!isnan(pinf_f) ", !vnl_math_isnan(pinf_f));
+ testlib_test_assert("!isnan(ninf_f) ", !vnl_math_isnan(ninf_f));
+ testlib_test_assert("!isfinite(qnan_f)", !vnl_math_isfinite(qnan_f));
+ testlib_test_assert("!isinf(qnan_f) ", !vnl_math_isinf(qnan_f));
+ testlib_test_assert(" isnan(qnan_f) ", vnl_math_isnan(qnan_f));
+
+#ifndef __alpha__ // on alpha, infinity() == max()
+ testlib_test_assert("!isfinite(pinf_d)", !vnl_math_isfinite(pinf_d));
+ testlib_test_assert("!isfinite(ninf_d)", !vnl_math_isfinite(ninf_d));
+ testlib_test_assert(" isinf(pinf_d) ", vnl_math_isinf(pinf_d));
+ testlib_test_assert(" isinf(ninf_d) ", vnl_math_isinf(ninf_d));
+#endif
+ testlib_test_assert("!isnan(pinf_d) ", !vnl_math_isnan(pinf_d));
+ testlib_test_assert("!isnan(ninf_d) ", !vnl_math_isnan(ninf_d));
+ testlib_test_assert("!isfinite(qnan_d)", !vnl_math_isfinite(qnan_d));
+ testlib_test_assert("!isinf(qnan_d) ", !vnl_math_isinf(qnan_d));
+ testlib_test_assert(" isnan(qnan_d) ", vnl_math_isnan(qnan_d));
+
+#ifndef __ICC // "long double" has no standard internal representation on different platforms/compilers
+#ifndef __alpha__ // on alpha, infinity() == max()
+ testlib_test_assert("!isfinite(pinf_q)", !vnl_math_isfinite(pinf_q));
+ testlib_test_assert("!isfinite(ninf_q)", !vnl_math_isfinite(ninf_q));
+ testlib_test_assert(" isinf(pinf_q) ", vnl_math_isinf(pinf_q));
+ testlib_test_assert(" isinf(ninf_q) ", vnl_math_isinf(ninf_q));
+#endif
+ testlib_test_assert("!isnan(pinf_q) ", !vnl_math_isnan(pinf_q));
+ testlib_test_assert("!isnan(ninf_q) ", !vnl_math_isnan(ninf_q));
+ testlib_test_assert("!isinf(qnan_q) ", !vnl_math_isinf(qnan_q));
+#if 0 // even more nonstandard ...
+ testlib_test_assert(" isnan(qnan_q) ", vnl_math_isnan(qnan_q));
+#endif // 0
+#endif // __ICC
+}
+
+TESTMAIN(test_math);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matlab.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matlab.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8f36c1b53e5f22d1c8a4575f5f0de636fb5d349b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matlab.cxx
@@ -0,0 +1,102 @@
+// This is core/vnl/tests/test_matlab.cxx
+/*
+ fsm
+*/
+#include <vcl_cstring.h>
+#include <vcl_fstream.h>
+
+#include <vpl/vpl.h>
+
+#include <vul/vul_temp_filename.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_matlab_write.h>
+#include <vnl/vnl_matlab_read.h>
+
+#include <testlib/testlib_test.h>
+
+static void fsm_assert_(int lineno, bool pass, char const *expr)
+{
+ vcl_cout << __FILE__ " : " << lineno << vcl_endl;
+ testlib_test_assert(expr, pass);
+}
+#define fsm_assert(c) fsm_assert_(__LINE__, c, #c);
+
+static void test_matlab()
+{
+ vnl_vector<float> v(4);
+ vnl_vector_fixed<float,4> vf;
+ for (unsigned i=0; i<v.size(); ++i)
+ vf[i] = v[i] = 0.1f*i;
+
+ vnl_matrix<double> M(3,4);
+ vnl_matrix_fixed<double,3,4> Mf;
+ for (unsigned i=0; i<M.rows(); ++i)
+ for (unsigned j=0; j<M.cols(); ++j)
+ Mf(i,j) = M(i,j) = 0.1*i*j;
+
+ { // vnl_matlab_print
+ vcl_cout << v << vcl_endl;
+ vnl_matlab_print(vcl_cout, v, "v");
+
+ vcl_cout << vf << vcl_endl;
+ vnl_matlab_print(vcl_cout, vf, "vf");
+
+ vcl_cout << M << vcl_endl;
+ vnl_matlab_print(vcl_cout, M, "M") << vcl_endl;
+
+ vcl_cout << Mf << vcl_endl;
+ vnl_matlab_print(vcl_cout, Mf, "Mf") << vcl_endl;
+ }
+
+ // vnl_matlab_write, vnl_matlab_read
+ {
+ vcl_string tmp_nam = vul_temp_filename();
+ char const *file = tmp_nam!="" ? tmp_nam.c_str() : "smoo.mat";
+ {
+ vcl_ofstream f(file);
+#ifdef LEAVE_IMAGES_BEHIND
+ vpl_chmod(file, 0666); // -rw-rw-rw-
+#endif
+ vnl_matlab_write(f, v.begin(), v.size(), "v");
+ vnl_matlab_write(f, (double const * const *)M.data_array(), M.rows(), M.cols(), (char const *)"M");
+ }
+ {
+ vcl_ifstream f(file);
+
+ vnl_matlab_readhdr vh(f);
+ fsm_assert( vh?true:false );
+ fsm_assert( vh.is_single());
+ fsm_assert( vh.rows() == (int)v.size());
+ fsm_assert( vh.cols() == 1);
+ fsm_assert(!vh.is_complex());
+ fsm_assert(vcl_strcmp(vh.name(), "v")==0);
+ vnl_vector<float> v_(v.size());
+ fsm_assert( vh.read_data(v_.begin()));
+ fsm_assert(v_ == v);
+
+ vnl_matlab_readhdr Mh(f);
+ fsm_assert( Mh?true:false );
+ fsm_assert(!Mh.is_single());
+ fsm_assert( Mh.rows() == (int)M.rows());
+ fsm_assert( Mh.cols() == (int)M.cols());
+ fsm_assert( Mh.is_rowwise());
+ fsm_assert(!Mh.is_complex());
+ fsm_assert(vcl_strcmp(Mh.name(), "M")==0);
+ vnl_matrix<double> M_( M.rows(), M.cols());
+ fsm_assert( Mh.read_data(M_.data_array()));
+ fsm_assert(M_ == M);
+ //vnl_matlab_print(cout, M, "M");
+ //vnl_matlab_print(cout, M_, "M_");
+ }
+#ifndef LEAVE_IMAGES_BEHIND
+ vpl_unlink(file);
+#endif
+ }
+}
+
+TESTMAIN(test_matlab);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..013b3af0346cb399b1fa4f1ed13fb2991e641be4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix.cxx
@@ -0,0 +1,449 @@
+// This is core/vnl/tests/test_matrix.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_matrix.h>
+#include <testlib/testlib_test.h>
+#include <vcl_cmath.h> // sqrt()
+
+static
+void test_int()
+{
+ vcl_cout << "***********************\n"
+ << "Testing vnl_matrix<int>\n"
+ << "***********************\n";
+ vnl_matrix<int> m0(2,2);
+ TEST("vnl_matrix<int> m0(2,2)", (m0.rows()==2 && m0.columns()==2), true);
+ vnl_matrix<int> m1(3,4);
+ TEST("vnl_matrix<int> m1(3,4)", (m1.rows()==3 && m1.columns()==4), true);
+ vnl_matrix<int> m2(2,2,2);
+ TEST("vnl_matrix<int> m2(2,2,2)",
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2), true);
+ TEST("m2 = vnl_matrix<int>(2,2, 2)",
+ (m2 = vnl_matrix<int>(2,2, 2),
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2)), true);
+ const vnl_matrix<int> ma = m2;
+ TEST("(const vnl_matrix)(i,j)",
+ (ma(0,0)==2 && ma(0,1)==2 && ma(1,0)==2 && ma(1,1)==2), true);
+ vnl_matrix<int> mb = m2;
+ TEST("(vnl_matrix)(i,j)",
+ (mb(0,0) = 0,
+ mb(0,0)==0 && mb(0,1)==2 && mb(1,0)==2 && mb(1,1)==2), true);
+ int mcvalues[4] = {1, 2, 3};
+ vnl_matrix<int> mc(2,2, 4, mcvalues);
+ TEST("vnl_matrix<int> mc(2,2, 4,int[])",
+ (mc(0,0)==1 && mc(0,1)==2 && mc(1,0)==3 && mc(1,1)==0), true);
+ TEST("m0=2",
+ (m0=2,
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+ TEST("m0 == m2", (m0 == m2), true);
+ TEST("(m0 == m2)", (m0 == m2), true);
+ TEST("m2.put(1,1,3)", (m2.put(1,1,3),m2.get(1,1)), 3);
+ TEST("m2.get(1,1)", m2.get(1,1), 3);
+ TEST("m0 == m2", (m0 == m2), false);
+ TEST("m0 != m2", (m0 != m2), true);
+ TEST("(m0 == m2)", (m0 == m2), false);
+ TEST("m1.fill(3)",
+ (m1.fill(3),
+ (m1.get(0,0)==3 && m1.get(1,1)==3 && m1.get(2,2)==3 && m1.get(2,3)==3)), true);
+ TEST("m2.fill(2)",
+ (m2.fill(2),
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2)), true);
+ int m3values [] = {1,2,3};
+ vnl_matrix<int> m3(1,3,3, m3values);
+ TEST("m3(1,3,3,{1,2,3})",
+ (m3.get(0,0)==1 && m3.get(0,1)==2 && m3.get(0,2)==3), true);
+ vnl_matrix<int> m4(m3);
+ TEST("vnl_matrix<int> m4(m3)", (m3==m4), true);
+ TEST("m0=m2", (m0=m2, (m0==m2)), true);
+
+ // test additions and subtractions
+ TEST("m0=m2+3",
+ ((m0=m2+3),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0=3+m2",
+ ((m0=3+m2),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0+=(-3)",
+ (m0+=(-3),
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+ TEST("m0-=(-3)",
+ (m0-=(-3),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0=m2-3",
+ ((m0=m2-3),
+ (m0.get(0,0)==-1 && m0.get(0,1)==-1 && m0.get(1,0)==-1 && m0.get(1,1)==-1)), true);
+ TEST("m0=3-m2",
+ ((m0=3-m2),
+ (m0.get(0,0)==1 && m0.get(0,1)==1 && m0.get(1,0)==1 && m0.get(1,1)==1)), true);
+ TEST("m0= -m2",
+ (m0= -m2,
+ (m0.get(0,0)==-2 && m0.get(0,1)==-2 && m0.get(1,0)==-2 && m0.get(1,1)==-2)), true);
+
+ vnl_matrix<int> m5(2,2);
+ m0 = m2;
+ TEST("m5=m0+m2",
+ ((m5=m0+m2),
+ (m5.get(0,0)==4 && m5.get(0,1)==4 && m5.get(1,0)==4 && m5.get(1,1)==4)), true);
+ TEST("m5=m0-m2",
+ ((m5=m0-m2),
+ (m5.get(0,0)==0 && m5.get(0,1)==0 && m5.get(1,0)==0 && m5.get(1,1)==0)), true);
+ TEST("m0+=m2",
+ ((m0+=m2),
+ (m0.get(0,0)==4 && m0.get(0,1)==4 && m0.get(1,0)==4 && m0.get(1,1)==4)), true);
+ TEST("m0-=m2",
+ ((m0-=m2),
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+
+ /// test multiplications and divisions
+ TEST("m4=m3*5",
+ ((m4=m3*5),
+ (m4.get(0,0)==5 && m4.get(0,1)==10 && m4.get(0,2)==15)), true);
+ TEST("m4=5*m3",
+ ((m4=5*m3),
+ (m4.get(0,0)==5 && m4.get(0,1)==10 && m4.get(0,2)==15)), true);
+ TEST("m3*=5",((m3*=5), (m3== m4)), true);
+ TEST("m4=m3/5",
+ ((m4=m3/5),
+ (m4.get(0,0)==1 && m4.get(0,1)==2 && m4.get(0,2)==3)), true);
+ TEST("m3/=5", ((m3/=5), (m3==m4)), true);
+
+ int m6values [] = {1,2,3,4};
+ vnl_matrix<int> m6(2,2,4,m6values);
+ TEST("vnl_matrix<int> m6(2,2,4,{1,2,3,4})", m6.get(1,1), 4);
+ int m7values [] = {5,6,7,8};
+ vnl_matrix<int> m7(2,2,4,m7values);
+ TEST("vnl_matrix<int> m7(2,2,4,{5,6,7,8})", m7.get(1,1), 8);
+ TEST("m5=m6*m7",
+ ((m5=m6*m7),
+ (m5.get(0,0)==19 && m5.get(0,1)==22 && m5.get(1,0)==43 && m5.get(1,1)==50)), true);
+ TEST("m6*=m7",
+ ((m6*=m7),
+ (m6.get(0,0)==19 && m6.get(0,1)==22 && m6.get(1,0)==43 && m6.get(1,1)==50)), true);
+ int c0values [] = {1,0};
+ vnl_matrix<int> c0(2,1,2,c0values);
+ vnl_matrix<int> c1;
+ TEST("c1=m6*c0",
+ ((c1=m6*c0),
+ c1.rows()==c0.rows() && c1.columns()==c0.columns() &&
+ c1.get(0,0)==19 && c1.get(1,0)==43), true);
+ int r0values [] = {1,0};
+ vnl_matrix<int> r0(1,2,2,r0values);
+ vnl_matrix<int> r1;
+ TEST("r1=r0*m6",
+ ((r1=r0*m6),
+ r1.rows()==r0.rows() && r1.columns()==r0.columns() &&
+ r1.get(0,0)==19 && r1.get(0,1)==22), true);
+ TEST("r0*=m6",
+ ((r0*=m6), r0==r1), true);
+ TEST("m6*=c0",
+ ((m6*=c0), c1==m6), true);
+
+
+ // additional tests
+ int mvalues [] = {0,-2,2,0};
+ vnl_matrix<int> m(2,2,4,mvalues);
+ m0 = m; m1 = m;
+ TEST("m(i,j)",
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==0), true);
+ TEST("m.transpose()",
+ ((m1 = m.transpose()),
+ (m1(0,0)==0 && m1(0,1)==2 && m1(1,0)==-2 && m1(1,1)==0)), true);
+#if 0
+ TEST("m.abs()",
+ ((m1 = m.abs()),
+ (m1(0,0)==0 && m1(0,1)==2 && m1(1,0)==2 && m1(1,1)==0)), true);
+ TEST("m.sign()",
+ ((m1 = m.sign()),
+ (m1(0,0)==0 && m1(0,1)==-1 && m1(1,0)==1 && m1(1,1)==0)), true);
+#endif // 0
+ TEST("element_product(m,m)",
+ ((m1 = element_product(m,m)),
+ (m1(0,0)==0 && m1(0,1)==4 && m1(1,0)==4 && m1(1,1)==0)), true);
+ TEST("element_quotient(m,[2])",
+ ((m2 = 2),
+ (m1 = element_quotient(m,m2)),
+ (m1(0,0)==0 && m1(0,1)==-1 && m1(1,0)==1 && m1(1,1)==0)), true);
+#if 0
+ TEST("m.update(m.abs())",
+ ((m1 = m.abs()),
+ (m2.update(m1)),
+ (m2==m1)), true);
+#endif // 0
+ TEST("m.extract(1,1,1,1)",
+ ((m1 = m.extract(1,1,1,1)),
+ (m1.rows()==1 && m1.columns()==1 && m1(0,0)==m(1,1))), true);
+ TEST("m.update([4],1,1)",
+ ((m1=4),
+ (m.update(m1,1,1)),
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==4)), true);
+
+ int vvalues[] = {1,0,0,0};
+ vnl_matrix<int> v (4,1,4,vvalues);
+#if 0
+ TEST("v(i)",
+ (v(0,0)==v.x() && v.x()==1 &&
+ v(1,0)==v.y() && v.y()==0 &&
+ v(2,0)==v.z() && v.z()==0 &&
+ v(3,0)==v.t() && v.t()==0), true);
+#endif // 0
+ int v1values [] = {1,0,0};
+ int v2values [] = {0,1,0};
+ int v3values [] = {0,0,1};
+ vnl_matrix<int> v1(3,1,3,v1values);
+ vnl_matrix<int> v2(3,1,3,v2values);
+ vnl_matrix<int> v3(3,1,3,v3values);
+ TEST("dot_product(v1,v2)",
+ (dot_product(v1,v2)==0 && dot_product(v1,v3)==0 && dot_product(v2,v3)==0), true);
+ v = v3;
+ TEST("4d-v=3d-v", (v.rows()==3 && v.columns()==1 && v==v3), true);
+
+ // Zero-size
+ {
+ vnl_matrix<int> m1(0,3);
+ vnl_matrix<int> m2(3,4);
+ vnl_matrix<int> m3(4,0);
+ vnl_matrix<int> m = m1 * (m2 * m3);
+ TEST("zero-size mult rows", m.rows(), 0);
+ TEST("zero-size mult cols", m.columns(), 0);
+
+ m = (m1 * m2) * m3;
+ TEST("zero-size mult rows", m.rows(), 0);
+ TEST("zero-size mult cols", m.columns(), 0);
+
+ m2.clear();
+ TEST("zero-size after clear()", m2.rows(), 0);
+ TEST("zero-size after clear()", m2.columns(), 0);
+ }
+}
+
+
+void test_float()
+{
+ vcl_cout << "*************************\n"
+ << "Testing vnl_matrix<float>\n"
+ << "*************************\n";
+ vnl_matrix<float> d0(2,2);
+ TEST("vnl_matrix<float> d0(2,2)", (d0.rows()==2 && d0.columns()==2), true);
+ vnl_matrix<float> d1(3,4);
+ TEST("vnl_matrix<float> d1(3,4)", (d1.rows()==3 && d1.columns()==4), true);
+ vnl_matrix<float> d2(2,2,2.0);
+ TEST("vnl_matrix<float> d2(2,2,2.0)",
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0), true);
+ TEST("d0=2.0", (d0=2.0,
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ TEST("d0 == d2", (d0 == d2), true);
+ TEST("(d0 == d2)", (d0==d2), true);
+ TEST("d2.put(1,1,3.0)", (d2.put(1,1,(float)3.0),d2.get(1,1)), (float)3.0);
+ TEST("d2.get(1,1)", d2.get(1,1), (float)3.0);
+ TEST("d0 == d2", (d0 == d2), false);
+ TEST("d0 != d2", (d0 != d2), true);
+ TEST("(d0 == d2)", (d0==d2), false);
+ TEST("d1.fill(3.0)",
+ (d1.fill(3.0),
+ (d1.get(0,0)==3.0 && d1.get(1,1)==3.0 && d1.get(2,2)==3.0 && d1.get(2,3)==3.0)), true);
+ TEST("d2.fill(2.0)",
+ (d2.fill(2.0),
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0)), true);
+ float d3values [] = {1.0,2.0,3.0};
+ vnl_matrix<float> d3(1,3,3,d3values);
+ TEST("d3(1,3,3,{1.0,2.0,3.0})",
+ (d3.get(0,0)==1.0 && d3.get(0,1)==2.0 && d3.get(0,2)==3.0), true);
+ vnl_matrix<float> d4(d3);
+ TEST("vnl_matrix<float> d4(d3)", d3, d4);
+ TEST("d0=d2", (d0=d2, (d0==d2)), true);
+ TEST("d0=d2+3.0",
+ ((d0=d2+(float)3.0),
+ (d0.get(0,0)==5.0 && d0.get(0,1)==5.0 && d0.get(1,0)==5.0 && d0.get(1,1)==5.0)), true);
+ TEST("d0+=(-3.0)",
+ (d0+=(-3.0),
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ vnl_matrix<float> d5(2,2);
+ TEST("d5=d0+d2",
+ ((d5=d0+d2),
+ (d5.get(0,0)==4.0 && d5.get(0,1)==4.0 && d5.get(1,0)==4.0 && d5.get(1,1)==4.0)), true);
+ TEST("d0+=d2",
+ ((d0+=d2),
+ (d0.get(0,0)==4.0 && d0.get(0,1)==4.0 && d0.get(1,0)==4.0 && d0.get(1,1)==4.0)), true);
+ TEST("d4=d3*5.0",((d4=d3*5.0),(d4.get(0,0)==5.0 && d4.get(0,1)==10.0 && d4.get(0,2)==15.0)), true);
+ TEST("d3*=5.0",((d3*=5.0), (d3== d4)), true);
+ float d6values [] = {1.0,2.0,
+ 3.0,4.0};
+ vnl_matrix<float> d6(2,2,4,d6values);
+ TEST("vnl_matrix<float> d6(2,2,4,{1.0,2.0,3.0,4.0})", d6.get(1,1), 4.0);
+ float d7values [] = {5.0,6.0,
+ 7.0,8.0};
+ vnl_matrix<float> d7(2,2,4,d7values);
+ TEST("vnl_matrix<float> d7(2,2,4,{5.0,6.0,7.0,8.0})", d7.get(1,1), 8.0);
+ TEST("d5=d6*d7", ((d5=d6*d7),
+ (d5.get(0,0)==19.0 && d5.get(0,1)==22.0 && d5.get(1,0)==43.0 && d5.get(1,1)==50.0)), true);
+ TEST("d6*=d7", ((d6*=d7),
+ (d6.get(0,0)==19.0 && d6.get(0,1)==22.0 && d6.get(1,0)==43.0 && d6.get(1,1)==50.0)), true);
+
+ // additional tests
+ vnl_matrix<float> m0, m1, m2;
+ float mvalues [] = {0,-2,2,0};
+ vnl_matrix<float> m(2,2,4,mvalues);
+ m0 = m; m1 = m; m2 = m;
+ TEST("m(i,j)",
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==0), true);
+ TEST("m.transpose()",
+ ((m1 = m.transpose()),
+ (m1(0,0)==0 && m1(0,1)==2 && m1(1,0)==-2 && m1(1,1)==0)), true);
+#if 0
+ TEST("m.abs()",
+ ((m1 = m.abs()),
+ (m1(0,0)==0 && m1(0,1)==2 && m1(1,0)==2 && m1(1,1)==0)), true);
+ TEST("m.sign()",
+ ((m1 = m.sign()),
+ (m1(0,0)==0 && m1(0,1)==-1 && m1(1,0)==1 && m1(1,1)==0)), true);
+#endif
+ TEST("element_product(m,m)",
+ ((m1 = element_product(m,m)),
+ (m1(0,0)==0 && m1(0,1)==4 && m1(1,0)==4 && m1(1,1)==0)), true);
+ TEST("element_quotient(m,[2])",
+ ((m2 = 2),
+ (m1 = element_quotient(m,m2)),
+ (m1(0,0)==0 && m1(0,1)==-1 && m1(1,0)==1 && m1(1,1)==0)), true);
+#if 0
+ TEST("m.update(m.abs())",
+ ((m1 = m.abs()),
+ (m2.update(m1)),
+ (m2==m1)), true);
+#endif
+ TEST("m.extract(1,1,1,1)",
+ ((m1 = m.extract(1,1,1,1)),
+ (m1.rows()==1 && m1.columns()==1 && m1(0,0)==m(1,1))), true);
+ TEST("m.update([4],1,1)",
+ ((m1=4),
+ (m.update(m1,1,1)),
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==4)), true);
+
+ float vvalues[] = {1,0,0,0};
+ vnl_matrix<float> v (4,1,4,vvalues);
+#if 0
+ TEST("v(i)",
+ (v(0,0)==v.x() && v.x()==1 &&
+ v(1,0)==v.y() && v.y()==0 &&
+ v(2,0)==v.z() && v.z()==0 &&
+ v(3,0)==v.t() && v.t()==0), true);
+#endif
+ float v1values [] = {1,0,0};
+ float v2values [] = {0,1,0};
+ float v3values [] = {0,0,1};
+ vnl_matrix<float> v1(3,1,3,v1values);
+ vnl_matrix<float> v2(3,1,3,v2values);
+ vnl_matrix<float> v3(3,1,3,v3values);
+ TEST("dot_product(v1,v2)",
+ (dot_product(v1,v2)==0 && dot_product(v1,v3)==0 && dot_product(v2,v3)==0), true);
+ v = v3;
+ TEST("4d-v=3d-v", (v.rows()==3 && v.columns()==1 && v==v3), true);
+
+ v.clear();
+ TEST("zero-size after clear()", v.rows(), 0);
+ TEST("zero-size after clear()", v.columns(), 0);
+}
+
+void test_double()
+{
+ vcl_cout << "**************************\n"
+ << "Testing vnl_matrix<double>\n"
+ << "**************************\n";
+ vnl_matrix<double> d0(2,2);
+ TEST("vnl_matrix<double> d0(2,2)", (d0.rows()==2 && d0.columns()==2), true);
+ vnl_matrix<double> d1(3,4);
+ TEST("vnl_matrix<double> d1(3,4)", (d1.rows()==3 && d1.columns()==4), true);
+ vnl_matrix<double> d2(2,2,2.0);
+ TEST("vnl_matrix<double> d2(2,2,2.0)",
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0), true);
+ TEST("d0=2.0", (d0=2.0,
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ TEST("d0 == d2", (d0 == d2), true);
+ TEST("(d0 == d2)", (d0==d2), true);
+ TEST("d2.put(1,1,3.0)", (d2.put(1,1,3.0),d2.get(1,1)), 3.0);
+ TEST("d2.get(1,1)", d2.get(1,1), 3.0);
+ TEST("d0 == d2", (d0 == d2), false);
+ TEST("d0 != d2", (d0 != d2), true);
+ TEST("(d0 == d2)", (d0==d2), false);
+ TEST("d1.fill(3.0)",
+ (d1.fill(3.0),
+ (d1.get(0,0)==3.0 && d1.get(1,1)==3.0 && d1.get(2,2)==3.0 && d1.get(2,3)==3.0)), true);
+ TEST("d2.fill(3.0)",
+ (d2.fill(2.0),
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0)), true);
+ double d3values [] = {1.0,2.0,3.0};
+ vnl_matrix<double> d3(1,3,3,d3values);
+ TEST("d3(1,3,3,{1.0,2.0,3.0})",
+ (d3.get(0,0)==1.0 && d3.get(0,1)==2.0 && d3.get(0,2)==3.0), true);
+ vnl_matrix<double> d4(d3);
+ TEST("vnl_matrix<double> d4(d3)", (d3 == d4), true);
+ TEST("d0=d2", (d0=d2, (d0==d2)), true);
+ TEST("d0=d2+3.0",
+ ((d0=d2+3.0),
+ (d0.get(0,0)==5.0 && d0.get(0,1)==5.0 && d0.get(1,0)==5.0 && d0.get(1,1)==5.0)), true);
+ TEST("d0+=(-3.0)",
+ (d0+=(-3.0),
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ vnl_matrix<double> d5(2,2);
+ TEST("d5=d0+d2",
+ ((d5=d0+d2),
+ (d5.get(0,0)==4.0 && d5.get(0,1)==4.0 && d5.get(1,0)==4.0 && d5.get(1,1)==4.0)), true);
+ TEST("d0+=d2",
+ ((d0+=d2),
+ (d0.get(0,0)==4.0 && d0.get(0,1)==4.0 && d0.get(1,0)==4.0 && d0.get(1,1)==4.0)), true);
+ TEST("d4=d3*5.0",((d4=d3*5.0),(d4.get(0,0)==5.0 && d4.get(0,1)==10.0 && d4.get(0,2)==15.0)), true);
+ TEST("d3*=5.0",((d3*=5.0), (d3== d4)), true);
+ double d6values [] = {1.0,2.0,
+ 3.0,4.0};
+ vnl_matrix<double> d6(2,2,4,d6values);
+ TEST("vnl_matrix<double> d6(2,2,4,{1.0,2.0,3.0,4.0})", d6.get(1,1), 4.0);
+ double d7values [] = {5.0,6.0,
+ 7.0,8.0};
+ vnl_matrix<double> d7(2,2,4,d7values);
+ TEST("vnl_matrix<double> d7(2,2,4,{5.0,6.0,7.0,8.0})", d7.get(1,1), 8.0);
+ TEST("d5=d6*d7", ((d5=d6*d7),
+ (d5.get(0,0)==19.0 && d5.get(0,1)==22.0 && d5.get(1,0)==43.0 && d5.get(1,1)==50.0)), true);
+ TEST("d6*=d7", ((d6*=d7),
+ (d6.get(0,0)==19.0 && d6.get(0,1)==22.0 && d6.get(1,0)==43.0 && d6.get(1,1)==50.0)), true);
+
+ d0.clear();
+ TEST("zero-size after clear()", d0.rows(), 0);
+ TEST("zero-size after clear()", d0.columns(), 0);
+
+ // apply sqrt to every element
+ double d8values [] = {0.0, 1.0, 9.0, 16.0};
+ vnl_matrix<double> d8(2,2,4,d8values);
+ d8 = d8.apply(vcl_sqrt);
+ TEST("apply(sqrt)", d8[0][0]==0 && d8[0][1]==1 && d8[1][0]==3 && d8[1][1]==4, true);
+
+ // normalizations
+ d8.normalize_rows();
+ TEST("normalize_rows()", d8[0][0]==0 && d8[0][1]==1, true);
+ TEST_NEAR("normalize_rows()", d8[1][0], 0.6, 1e-12);
+ TEST_NEAR("normalize_rows()", d8[1][1], 0.8, 1e-12);
+ d8.normalize_columns();
+ TEST("normalize_columns()", d8[0][0]==0 && d8[1][0]==1, true);
+}
+
+#ifdef LEAK
+static
+void test_leak() // use top4.1 to watch memory usage.
+{
+ for (;;) { // remember to kill process.
+ test_int();
+ test_float();
+ test_double();
+ }
+}
+#endif
+
+static
+void test_matrix()
+{
+ test_int();
+ test_float();
+ test_double();
+#ifdef LEAK
+ test_leak();
+#endif
+}
+
+TESTMAIN(test_matrix);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_exp.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_exp.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a8c61f3f2008582fd23da13dec980443c7dd201b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_exp.cxx
@@ -0,0 +1,33 @@
+// @author fsm
+
+#include <vcl_iostream.h>
+#include <vcl_cmath.h> // for vcl_abs()
+
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_exp.h>
+#include <vnl/vnl_matlab_print.h>
+#include <vnl/vnl_rotation_matrix.h>
+#include <vnl/vnl_cross_product_matrix.h>
+#include <testlib/testlib_test.h>
+
+void test_matrix_exp()
+{
+ vnl_double_3 v(1.233,-0.572,0.777);
+
+ vnl_matrix<double> X = vnl_cross_product_matrix(v).as_ref();
+ vnl_matlab_print(vcl_cout, X, "[v]");
+
+ vnl_matrix<double> expX = vnl_matrix_exp(X);
+ vnl_matlab_print(vcl_cout, expX, "matrix exp([v])");
+ testlib_test_assert("expX(0,0)", vcl_abs(expX(0,0)-0.6221833130) < 1e-10);
+ testlib_test_assert("expX(0,1)", vcl_abs(expX(0,1)+0.7825192869) < 1e-10);
+ testlib_test_assert("expX(1,1)", vcl_abs(expX(1,1)-0.1379544126) < 1e-10);
+ testlib_test_assert("expX(2,2)", vcl_abs(expX(2,2)-0.2501918781) < 1e-10);
+
+ vnl_matrix<double> rotv = vnl_rotation_matrix(v);
+ vnl_matlab_print(vcl_cout, rotv, "rotate exp([v])");
+ testlib_test_assert("rotv == expX", (rotv-expX).fro_norm() < 1e-10);
+}
+
+TESTMAIN(test_matrix_exp);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e73bb2bf552af6efde32c12e786bf1e853488f82
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed.cxx
@@ -0,0 +1,486 @@
+// This is core/vnl/tests/test_matrix_fixed.cxx
+#ifdef TEST_MALLOC // see note below, at the other #ifdef TEST_MALLOC
+# include <vcl_new.h>
+#endif
+#include <vcl_cstdlib.h>
+#include <vcl_cstddef.h> // for vcl_size_t
+#include <vcl_cmath.h> // for sqrt
+
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_double_3x3.h>
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_double_2x2.h>
+#include <vnl/vnl_float_2x2.h>
+#include <vnl/vnl_int_2x2.h>
+
+#include <testlib/testlib_test.h>
+
+#undef printf // to work around a bug in libintl.h
+#include <vcl_cstdio.h> // do not use iostream within operator new - it causes infinite recursion
+
+bool verbose_malloc = false;
+int malloc_count = 0;
+
+// FIXME: Win32 will have different operator new in vnl dll from
+// the one generated here, so this test fails - RWMC.
+// The test also fails for gcc 3.0 - PVr
+# define reset_count malloc_count = 0
+#if !defined(VCL_WIN32) && !defined(GNU_LIBSTDCXX_V3)
+# define check_count TEST("mallocs",malloc_count<=1,true)
+#else
+# define check_count TEST("mallocs (no test)",true,true)
+#endif
+
+static
+void
+test_size()
+{
+ vnl_matrix_fixed<double,3,4> m;
+ TEST( "memory footprint", sizeof(m), sizeof(double[12]) );
+}
+
+static
+void
+test_multiply()
+{
+ double data_m1[6] = {
+ 1, 2,
+ 3, 4,
+ 5, 6
+ };
+ double data_m2[8] = {
+ 2, 3, 4, 5,
+ 6, 7, 8, 9
+ };
+ double data_v1[2] = {
+ 7,
+ 8
+ };
+
+ vnl_matrix_fixed<double,3,2> m1( data_m1 );
+ vnl_matrix_fixed<double,2,4> m2( data_m2 );
+ vnl_vector_fixed<double,2> v1( data_v1 );
+
+ testlib_test_begin( "Matrix-matrix multiply" );
+ vnl_matrix_fixed<double,3,4> mr = m1*m2;
+ testlib_test_perform( mr(0,0) == 14 && mr(0,1) == 17 && mr(0,2) == 20 && mr(0,3) == 23 &&
+ mr(1,0) == 30 && mr(1,1) == 37 && mr(1,2) == 44 && mr(1,3) == 51 &&
+ mr(2,0) == 46 && mr(2,1) == 57 && mr(2,2) == 68 && mr(2,3) == 79 );
+
+ testlib_test_begin( "Matrix-vector multiply" );
+ vnl_vector_fixed<double,3> vr = m1*v1;
+ testlib_test_perform( vr(0) == 23 && vr(1) == 53 && vr(2) == 83 );
+}
+
+static
+void test_int()
+{
+ vnl_matrix_fixed<int,2,2> m0;
+ TEST("vnl_matrix_fixed<int,2,2> m0", (m0.rows()==2 && m0.columns()==2), true);
+ vnl_matrix_fixed<int,3,4> m1;
+ TEST("vnl_matrix_fixed<int,3,4> m1", (m1.rows()==3 && m1.columns()==4), true);
+ vnl_int_2x2 m2(2);
+ TEST("vnl_int_2x2 m2(2)",
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2), true);
+ TEST("m2 = vnl_int_2x2(2)",
+ (m2 = vnl_int_2x2(2),
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2)), true);
+ const vnl_int_2x2 ma = m2;
+ TEST("(const vnl_matrix_fixed)(i,j)",
+ (ma(0,0)==2 && ma(0,1)==2 && ma(1,0)==2 && ma(1,1)==2), true);
+ vnl_int_2x2 mb = m2;
+ TEST("(vnl_matrix_fixed)(i,j)",
+ (mb(0,0) = 0,
+ mb(0,0)==0 && mb(0,1)==2 && mb(1,0)==2 && mb(1,1)==2), true);
+ int mcvalues[4] = {1, 2, 3};
+ vnl_int_2x2 mc(mcvalues);
+ TEST("vnl_int_2x2 mc(int[])",
+ (mc(0,0)==1 && mc(0,1)==2 && mc(1,0)==3 && mc(1,1)==0), true);
+ TEST("m0=2",
+ (m0=2,
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+ TEST("m0 == m2", (m0 == m2), true);
+ TEST("(m0 == m2)", (m0 == m2), true);
+ TEST("m2.put(1,1,3)", (m2.put(1,1,3),m2.get(1,1)), 3);
+ TEST("m2.get(1,1)", m2.get(1,1), 3);
+ TEST("m0 == m2", (m0 == m2), false);
+ TEST("m0 != m2", (m0 != m2), true);
+ TEST("(m0 == m2)", (m0 == m2), false);
+ TEST("m1.fill(3)",
+ (m1.fill(3),
+ (m1.get(0,0)==3 && m1.get(1,1)==3 && m1.get(2,2)==3 && m1.get(2,3)==3)), true);
+ TEST("m2.fill(2)",
+ (m2.fill(2),
+ (m2.get(0,0)==2 && m2.get(0,1)==2 && m2.get(1,0)==2 && m2.get(1,1)==2)), true);
+ TEST("m0=m2", (m0=m2, (m0==m2)), true);
+
+ // test additions and subtractions
+ TEST("m0=m2+3",
+ ((m0=m2+3),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0=3+m2",
+ ((m0=3+m2),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0+=(-3)",
+ (m0+=(-3),
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+ TEST("m0-=(-3)",
+ (m0-=(-3),
+ (m0.get(0,0)==5 && m0.get(0,1)==5 && m0.get(1,0)==5 && m0.get(1,1)==5)), true);
+ TEST("m0=m2-3",
+ ((m0=m2-3),
+ (m0.get(0,0)==-1 && m0.get(0,1)==-1 && m0.get(1,0)==-1 && m0.get(1,1)==-1)), true);
+ TEST("m0=3-m2",
+ ((m0=3-m2),
+ (m0.get(0,0)==1 && m0.get(0,1)==1 && m0.get(1,0)==1 && m0.get(1,1)==1)), true);
+ TEST("m0= -m2",
+ (m0= -m2,
+ (m0.get(0,0)==-2 && m0.get(0,1)==-2 && m0.get(1,0)==-2 && m0.get(1,1)==-2)), true);
+
+ vnl_int_2x2 m5;
+ m0 = m2;
+ TEST("m5=m0+m2",
+ ((m5=m0+m2),
+ (m5.get(0,0)==4 && m5.get(0,1)==4 && m5.get(1,0)==4 && m5.get(1,1)==4)), true);
+ TEST("m5=m0-m2",
+ ((m5=m0-m2),
+ (m5.get(0,0)==0 && m5.get(0,1)==0 && m5.get(1,0)==0 && m5.get(1,1)==0)), true);
+ TEST("m0+=m2",
+ ((m0+=m2),
+ (m0.get(0,0)==4 && m0.get(0,1)==4 && m0.get(1,0)==4 && m0.get(1,1)==4)), true);
+ TEST("m0-=m2",
+ ((m0-=m2),
+ (m0.get(0,0)==2 && m0.get(0,1)==2 && m0.get(1,0)==2 && m0.get(1,1)==2)), true);
+
+ // test multiplications and divisions
+ m2(0,0) = 1; m2(0,1) = 2; m2(1,0) = 3;
+ TEST("m0=m2*5",
+ ((m0=m2*5),
+ (m0.get(0,0)==5 && m0.get(0,1)==10 && m0.get(1,0)==15)), true);
+ TEST("m0=5*m2",
+ ((m0=5*m2),
+ (m0.get(0,0)==5 && m0.get(0,1)==10 && m0.get(1,0)==15)), true);
+ TEST("m2*=5",((m2*=5), (m2== m0)), true);
+ TEST("m0=m2/5",
+ ((m0=m2/5),
+ (m0.get(0,0)==1 && m0.get(0,1)==2 && m0.get(1,0)==3)), true);
+ TEST("m2/=5", ((m2/=5), (m2==m0)), true);
+
+ int m6values [] = {1,2,3,4};
+ vnl_int_2x2 m6(m6values);
+ TEST("vnl_int_2x2 m6({1,2,3,4})", m6.get(1,1), 4);
+ int m7values [] = {5,6,7,8};
+ vnl_int_2x2 m7(m7values);
+ TEST("vnl_int_2x2 m7({5,6,7,8})", m7.get(1,1), 8);
+ TEST("m5=m6*m7",
+ ((m5=m6*m7),
+ (m5.get(0,0)==19 && m5.get(0,1)==22 && m5.get(1,0)==43 && m5.get(1,1)==50)), true);
+ TEST("m6*=m7",
+ ((m6*=m7),
+ (m6.get(0,0)==19 && m6.get(0,1)==22 && m6.get(1,0)==43 && m6.get(1,1)==50)), true);
+
+ // additional tests
+ int mvalues [] = {0,-2,2,0};
+ vnl_int_2x2 m(mvalues); m0 = m;
+ vnl_matrix<int> m3;
+ TEST("m(i,j)",
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==0), true);
+ TEST("m.transpose()",
+ ((m0 = m.transpose()),
+ (m0(0,0)==0 && m0(0,1)==2 && m0(1,0)==-2 && m0(1,1)==0)), true);
+ TEST("element_product(m,m)",
+ ((m0 = element_product(m,m)),
+ (m0(0,0)==0 && m0(0,1)==4 && m0(1,0)==4 && m0(1,1)==0)), true);
+ TEST("element_quotient(m,[2])",
+ ((m2 = 2),
+ (m0 = element_quotient(m,m2)),
+ (m0(0,0)==0 && m0(0,1)==-1 && m0(1,0)==1 && m0(1,1)==0)), true);
+ TEST("m.extract(1,1,1,1)",
+ ((m3 = m.extract(1,1,1,1)),
+ (m3.rows()==1 && m3.columns()==1 && m3(0,0)==m(1,1))), true);
+ TEST("m.update([4],1,1)",
+ ((m3=4),
+ (m.update(m3,1,1)),
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==4)), true);
+}
+
+static
+void test_float()
+{
+ vnl_matrix_fixed<float,2,2> d0;
+ TEST("vnl_matrix_fixed<float,2,2> d0", (d0.rows()==2 && d0.columns()==2), true);
+ vnl_matrix_fixed<float,3,4> d1;
+ TEST("vnl_matrix_fixed<float,3,4> d1", (d1.rows()==3 && d1.columns()==4), true);
+ vnl_float_2x2 d2(2.0);
+ TEST("vnl_float_2x2 d2(2.0)",
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0), true);
+ TEST("d0=2.0", (d0=2.0,
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ TEST("d0 == d2", (d0 == d2), true);
+ TEST("(d0 == d2)", (d0==d2), true);
+ TEST("d2.put(1,1,3.0)", (d2.put(1,1,(float)3.0),d2.get(1,1)), (float)3.0);
+ TEST("d2.get(1,1)", d2.get(1,1), (float)3.0);
+ TEST("d0 == d2", (d0 == d2), false);
+ TEST("d0 != d2", (d0 != d2), true);
+ TEST("(d0 == d2)", (d0==d2), false);
+ TEST("d1.fill(3.0)",
+ (d1.fill(3.0),
+ (d1.get(0,0)==3.0 && d1.get(1,1)==3.0 && d1.get(2,2)==3.0 && d1.get(2,3)==3.0)), true);
+ TEST("d2.fill(2.0)",
+ (d2.fill(2.0),
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0)), true);
+ TEST("d0=d2", (d0=d2, (d0==d2)), true);
+
+ // test additions and subtractions
+ TEST("d0=d2+3.0",
+ ((d0=d2+(float)3.0),
+ (d0.get(0,0)==5.0 && d0.get(0,1)==5.0 && d0.get(1,0)==5.0 && d0.get(1,1)==5.0)), true);
+ TEST("d0+=(-3.0)",
+ (d0+=(-3.0),
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ vnl_float_2x2 d5;
+ TEST("d5=d0+d2",
+ ((d5=d0+d2),
+ (d5.get(0,0)==4.0 && d5.get(0,1)==4.0 && d5.get(1,0)==4.0 && d5.get(1,1)==4.0)), true);
+ TEST("d0+=d2",
+ ((d0+=d2),
+ (d0.get(0,0)==4.0 && d0.get(0,1)==4.0 && d0.get(1,0)==4.0 && d0.get(1,1)==4.0)), true);
+
+ // test multiplications and divisions
+ d2(0,0) = 1; d2(0,1) = 2; d2(1,0) = 3;
+ TEST("d0=d2*5.0f",
+ ((d0=d2*5.0f),
+ (d0.get(0,0)==5 && d0.get(0,1)==10 && d0.get(1,0)==15)), true);
+ TEST("d0=5.0f*d2",
+ ((d0=5.0f*d2),
+ (d0.get(0,0)==5 && d0.get(0,1)==10 && d0.get(1,0)==15)), true);
+ TEST("d2*=5.0f",((d2*=5.0f), (d2== d0)), true);
+ TEST("d0=d2/5.0f",
+ ((d0=d2/5.0f),
+ (d0.get(0,0)==1 && d0.get(0,1)==2 && d0.get(1,0)==3)), true);
+ TEST("d2/=5.0f", ((d2/=5.0f), (d2==d0)), true);
+ float d6values [] = {1.0f,2.0f,
+ 3.0f,4.0f};
+ vnl_float_2x2 d6(d6values);
+ TEST("vnl_float_2x2 d6({1.0,2.0,3.0,4.0})", d6.get(1,1), 4.0);
+ float d7values [] = {5.0,6.0,
+ 7.0,8.0};
+ vnl_float_2x2 d7(d7values);
+ TEST("vnl_float_2x2 d7({5.0,6.0,7.0,8.0})", d7.get(1,1), 8.0);
+ TEST("d5=d6*d7", ((d5=d6*d7),
+ (d5.get(0,0)==19.0 && d5.get(0,1)==22.0 && d5.get(1,0)==43.0 && d5.get(1,1)==50.0)), true);
+ TEST("d6*=d7", ((d6*=d7),
+ (d6.get(0,0)==19.0 && d6.get(0,1)==22.0 && d6.get(1,0)==43.0 && d6.get(1,1)==50.0)), true);
+
+ // additional tests
+ vnl_float_2x2 m1, m2;
+ float mvalues [] = {0,-2,2,0};
+ vnl_float_2x2 m(mvalues);
+ m1 = m; m2 = m;
+ vnl_matrix<float> m3;
+ TEST("m(i,j)",
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==0), true);
+ TEST("m.transpose()",
+ ((m1 = m.transpose()),
+ (m1(0,0)==0 && m1(0,1)==2 && m1(1,0)==-2 && m1(1,1)==0)), true);
+ TEST("element_product(m,m)",
+ ((m1 = element_product(m,m)),
+ (m1(0,0)==0 && m1(0,1)==4 && m1(1,0)==4 && m1(1,1)==0)), true);
+ TEST("element_quotient(m,[2])",
+ ((m2 = 2),
+ (m1 = element_quotient(m,m2)),
+ (m1(0,0)==0 && m1(0,1)==-1 && m1(1,0)==1 && m1(1,1)==0)), true);
+ TEST("m.extract(1,1,1,1)",
+ ((m3 = m.extract(1,1,1,1)),
+ (m3.rows()==1 && m3.columns()==1 && m3(0,0)==m(1,1))), true);
+ TEST("m.update([4],1,1)",
+ ((m3=4),
+ (m.update(m3,1,1)),
+ (m(0,0)==0 && m(0,1)==-2 && m(1,0)==2 && m(1,1)==4)), true);
+}
+
+static
+void test_double()
+{
+ vnl_matrix_fixed<double,2,2> d0;
+ TEST("vnl_matrix_fixed<double,2,2> d0", (d0.rows()==2 && d0.columns()==2), true);
+ vnl_matrix_fixed<double,3,4> d1;
+ TEST("vnl_matrix_fixed<double,3,4> d1", (d1.rows()==3 && d1.columns()==4), true);
+ vnl_double_2x2 d2(2.0);
+ TEST("vnl_double_2x2 d2(2.0)",
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0), true);
+ TEST("d0=2.0", (d0=2.0,
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ TEST("d0 == d2", (d0 == d2), true);
+ TEST("(d0 == d2)", (d0==d2), true);
+ TEST("d2.put(1,1,3.0)", (d2.put(1,1,3.0),d2.get(1,1)), 3.0);
+ TEST("d2.get(1,1)", d2.get(1,1), 3.0);
+ TEST("d0 == d2", (d0 == d2), false);
+ TEST("d0 != d2", (d0 != d2), true);
+ TEST("(d0 == d2)", (d0==d2), false);
+ TEST("d1.fill(3.0)",
+ (d1.fill(3.0),
+ (d1.get(0,0)==3.0 && d1.get(1,1)==3.0 && d1.get(2,2)==3.0 && d1.get(2,3)==3.0)), true);
+ TEST("d2.fill(3.0)",
+ (d2.fill(2.0),
+ (d2.get(0,0)==2.0 && d2.get(0,1)==2.0 && d2.get(1,0)==2.0 && d2.get(1,1)==2.0)), true);
+ TEST("d0=d2", (d0=d2, (d0==d2)), true);
+
+ // test additions and subtractions
+ TEST("d0=d2+3.0",
+ ((d0=d2+3.0),
+ (d0.get(0,0)==5.0 && d0.get(0,1)==5.0 && d0.get(1,0)==5.0 && d0.get(1,1)==5.0)), true);
+ TEST("d0+=(-3.0)",
+ (d0+=(-3.0),
+ (d0.get(0,0)==2.0 && d0.get(0,1)==2.0 && d0.get(1,0)==2.0 && d0.get(1,1)==2.0)), true);
+ vnl_double_2x2 d5;
+ TEST("d5=d0+d2",
+ ((d5=d0+d2),
+ (d5.get(0,0)==4.0 && d5.get(0,1)==4.0 && d5.get(1,0)==4.0 && d5.get(1,1)==4.0)), true);
+ TEST("d0+=d2",
+ ((d0+=d2),
+ (d0.get(0,0)==4.0 && d0.get(0,1)==4.0 && d0.get(1,0)==4.0 && d0.get(1,1)==4.0)), true);
+
+ // test multiplications and divisions
+ d2(0,0) = 1; d2(0,1) = 2; d2(1,0) = 3;
+ TEST("d0=d2*5.0",
+ ((d0=d2*5.0),
+ (d0.get(0,0)==5 && d0.get(0,1)==10 && d0.get(1,0)==15)), true);
+ TEST("d0=5.0*d2",
+ ((d0=5.0*d2),
+ (d0.get(0,0)==5 && d0.get(0,1)==10 && d0.get(1,0)==15)), true);
+ TEST("d2*=5.0",((d2*=5.0), (d2== d0)), true);
+ TEST("d0=d2/5.0",
+ ((d0=d2/5.0),
+ (d0.get(0,0)==1 && d0.get(0,1)==2 && d0.get(1,0)==3)), true);
+ TEST("d2/=5.0", ((d2/=5.0), (d2==d0)), true);
+ double d6values [] = {1.0,2.0,
+ 3.0,4.0};
+ vnl_double_2x2 d6(d6values);
+ TEST("vnl_double_2x2 d6({1.0,2.0,3.0,4.0})", d6.get(1,1), 4.0);
+ double d7values [] = {5.0,6.0,
+ 7.0,8.0};
+ vnl_double_2x2 d7(d7values);
+ TEST("vnl_double_2x2 d7({5.0,6.0,7.0,8.0})", d7.get(1,1), 8.0);
+ TEST("d5=d6*d7", ((d5=d6*d7),
+ (d5.get(0,0)==19.0 && d5.get(0,1)==22.0 && d5.get(1,0)==43.0 && d5.get(1,1)==50.0)), true);
+ TEST("d6*=d7", ((d6*=d7),
+ (d6.get(0,0)==19.0 && d6.get(0,1)==22.0 && d6.get(1,0)==43.0 && d6.get(1,1)==50.0)), true);
+
+ // apply sqrt to every element
+ double d8values [] = {0.0, 1.0, 9.0, 16.0};
+ vnl_double_2x2 d8(d8values);
+ d8 = d8.apply(vcl_sqrt);
+ TEST("apply(sqrt)", d8[0][0]==0 && d8[0][1]==1 && d8[1][0]==3 && d8[1][1]==4, true);
+
+ // normalizations
+ d8.normalize_rows();
+ TEST("normalize_rows()", d8[0][0]==0 && d8[0][1]==1, true);
+ TEST_NEAR("normalize_rows()", d8[1][0], 0.6, 1e-12);
+ TEST_NEAR("normalize_rows()", d8[1][1], 0.8, 1e-12);
+ d8.normalize_columns();
+ TEST("normalize_columns()", d8[0][0]==0 && d8[1][0]==1, true);
+}
+
+void test_matrix_fixed()
+{
+ verbose_malloc = true;
+ double datablock[9] = {
+ 11, 12, 13,
+ 21, 22, 23,
+ 31, 32, 33,
+ };
+
+ vcl_printf("Calling ctor -- should be no mallocs\n");
+ reset_count;
+ vnl_double_3x3 X(datablock);
+ check_count;
+ vcl_printf("X = [ %g %g %g\n %g %g %g\n %g %g %g ]\n",
+ X(0,0),X(0,1),X(0,2),X(1,0),X(1,1),X(1,2),X(2,0),X(2,1),X(2,2));
+
+ reset_count;
+ vnl_double_3 v(10,11,12);
+ check_count;
+ vcl_printf("v = [ %g %g %g ]\n", v(0), v(1), v(2));
+
+ reset_count;
+ vnl_double_3 splork = X * (v + v);
+ check_count;
+ vcl_printf("splork = [ %g %g %g ]\n", splork(0), splork(1), splork(2));
+
+ // This shouldn't compile...
+#if 0
+ vnl_matrix<double>* base = new vnl_double_3x3(datablock);
+#endif
+
+ vcl_printf("Now watch the mallocs\n");
+ vnl_matrix_ref<double> CX = X;
+ vnl_vector_ref<double> cv = v;
+ vnl_vector<double> Xv = CX * (cv + cv);
+ vcl_printf("X v = [ %g %g %g ]\n", Xv[0], Xv[1], Xv[2]);
+
+ verbose_malloc = false;
+
+ // test that vnl_double_3x3's can be multiplied
+ vnl_double_3x3 A(datablock);
+ vnl_double_3x3 B = A * A;
+
+ // test that vnl_double_3x3's can be added and subtracted
+ B = A + B;
+ B -= A;
+
+ B.fill(1.0);
+ TEST("fill(1)", B(0,0)==1 && B(0,1)==1 && B(1,2)==1 && B(2,2)==1, true);
+ B.fill_diagonal(4.0);
+ TEST("fill_diagonal(4)", B(0,0)==4 && B(0,1)==1 && B(1,2)==1 && B(2,2)==4, true);
+
+ // apply sqrt to every element
+ B = B.apply(vcl_sqrt);
+ TEST("apply(sqrt)", B(1,1)==2 && B(0,2)==1 && B(2,1)==1 && B(2,2)==2, true);
+
+ test_multiply();
+ test_size();
+
+ test_int();
+ test_float();
+ test_double();
+}
+
+#ifdef TEST_MALLOC
+ // BAD-BAD-BAD these operators new/delete are picked up by *all* tests!!!
+ // The problem is that they don't provide new[] and delete[]. - PVr
+
+// with gcc 3.0, formatted stream output uses operator
+// new so printing to cout here causes stack overflow.
+
+void* operator new(vcl_size_t s)
+ // [18.4.1] lib.new.delete
+#if defined(VCL_SUNPRO_CC_5) || defined(GNU_LIBSTDCXX_V3) || defined(VCL_KAI)
+ throw(std::bad_alloc)
+#endif
+{
+ void *r = vcl_malloc(s);
+
+ ++malloc_count;
+
+ if (verbose_malloc)
+ vcl_printf("malloc: %08lX for %d\n", (unsigned long)r, int(s));
+
+ return r;
+}
+
+void operator delete(void* s)
+#if defined(GNU_LIBSTDCXX_V3) || defined(VCL_SUNPRO_CC_5)
+ throw()
+#endif
+{
+ if (verbose_malloc)
+ vcl_printf("delete: %08lX\n", (unsigned long)s);
+
+ vcl_free(s);
+}
+
+#endif // TEST_MALLOC
+
+TESTMAIN(test_matrix_fixed);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed_ref.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed_ref.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..473ea8a5a4f860aadd7786341a3858c3ed863649
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_matrix_fixed_ref.cxx
@@ -0,0 +1,155 @@
+// This is core/vnl/tests/test_matrix_fixed_ref.cxx
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_matrix_fixed_ref.h>
+#include <vnl/vnl_vector_fixed.h>
+
+#include <vcl_algorithm.h> // for vcl_generate()
+#include <vcl_cstdlib.h> // for vcl_rand()
+#include <testlib/testlib_test.h>
+
+void test_matrix_fixed_ref()
+{
+ enum{rows = 3};
+ enum{cols = 4};
+ typedef vnl_matrix_fixed<double,rows,cols> mf;
+ typedef vnl_matrix_fixed_ref<double,rows,cols> mfr;
+ typedef vnl_matrix_fixed_ref_const<double,rows,cols> mfrc;
+
+ int i,j;
+ mf mat; // copy in
+ for (i=0;i<rows;++i)
+ for (j=0;j<cols;++j)
+ mat(i,j) = 10 * i + j;
+
+ // matrix fixed_ref tests
+
+
+ // fixed_ref_const
+ const mf & cmf = mat;
+ mfrc cref(cmf);
+ // check address
+ for (i=0;i<rows;++i)
+ {
+ for (j=0;j<cols;++j)
+ {
+ TEST("const_address",&cref(i,j),&mat(i,j));
+ }
+ }
+
+ // wrap around const mf
+ // get_row
+ for (i=0;i<rows;++i)
+ {
+ vnl_vector_fixed<double,cols> row_copy = cmf.get_row(i);
+ vnl_vector_fixed<double,cols> row_copy2 = mat.get_row(i);
+ TEST("get_row", row_copy,row_copy2);
+ }
+ // get_col
+ for (j=0;j<cols;++j)
+ {
+ vnl_vector_fixed<double,rows> col_copy = cmf.get_column(j);
+ vnl_vector_fixed<double,rows> col_copy2 = mat.get_column(j);
+ TEST("get_column", col_copy,col_copy2);
+ }
+
+ // fixed_ref (non-const)
+ // wrap around mat
+ mfr ref(mat);
+ // check address
+ for (i=0;i<rows;++i)
+ {
+ for (j=0;j<cols;++j)
+ {
+ TEST("nonconst_address",&ref(i,j),&mat(i,j));
+ }
+ }
+ // set_row
+ for (i=0;i<rows;++i)
+ {
+ vnl_vector_fixed<double,cols> new_row;
+ vcl_generate(new_row.begin(),new_row.end(),vcl_rand);
+
+ ref.set_row(i,new_row);
+ vnl_vector_fixed<double,cols> row_copy = mat.get_row(i);
+ TEST("set_row", new_row, row_copy);
+ }
+ // set_col
+ for (j=0;j<cols;++j)
+ {
+ vnl_vector_fixed<double,rows> new_col;
+ vcl_generate(new_col.begin(),new_col.end(),vcl_rand);
+
+ ref.set_column(j,new_col);
+ vnl_vector_fixed<double,rows> col_copy = mat.get_column(j);
+ TEST("set_col", new_col, col_copy);
+ }
+
+ // assign from mat
+ mf other;
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+#if 0 // cannot assign to a vnl_matrix_fixed_ref_const
+ ref = other;
+ TEST("assign_mf", ref, other);
+ // test different adresses
+ TEST("assign_mf", (ref.begin() != other.begin()), true);
+#endif // 0
+
+ {
+ // assign from const mfr
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+ mfrc cref(other);
+ ref = cref;
+ TEST("assign_const_ref", ref, other);
+ // test different adresses
+ TEST("assign_const_ref", (ref.begin() != other.begin()), true);
+ }
+
+ {
+#if 0 // cannot assign to a vnl_matrix_fixed_ref_const
+ // assign from mfr
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+ mfr ref2(other);
+ ref = ref2;
+ TEST("assign_ref", ref, other);
+ // test different adresses
+ TEST("assign_ref", (ref.begin() != other.begin()), true);
+#endif // 0
+ }
+ // arithmetic
+ {
+ // plus
+ mf a,b;
+ vcl_generate(a.begin(),a.end(),vcl_rand);
+ vcl_generate(b.begin(),b.end(),vcl_rand);
+ mfrc arefc(a), brefc(b);
+ mf mc = arefc + brefc;
+
+ mfr aref(a), bref(b);
+ mf m = aref + bref;
+
+ mf m2 = arefc + bref;
+ mf m3 = arefc + brefc;
+ TEST("plus", mc, m);
+ TEST("plus", mc, m2);
+ TEST("plus", mc, m3);
+ }
+ {
+ // times
+ mf a,b;
+ vcl_generate(a.begin(),a.end(),vcl_rand);
+ vcl_generate(b.begin(),b.end(),vcl_rand);
+ mfrc arefc(a), brefc(b);
+ mf mc = arefc + brefc;
+
+ mfr aref(a), bref(b);
+ mf m = aref + bref;
+
+ mf m2 = arefc + bref;
+ mf m3 = arefc + brefc;
+ TEST("plus", mc, m);
+ TEST("plus", mc, m2);
+ TEST("plus", mc, m3);
+ }
+}
+
+TESTMAIN(test_matrix_fixed_ref);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_numeric_traits.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_numeric_traits.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..919d6c419eb5fa7fac742e9491ecdc22f74f34db
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_numeric_traits.cxx
@@ -0,0 +1,226 @@
+// This is core/vnl/tests/test_numeric_traits.cxx
+#include <vnl/vnl_numeric_traits.h>
+#include <testlib/testlib_test.h>
+#include <vcl_complex.h>
+#include <vcl_iostream.h>
+#include <vxl_config.h> // for VXL_BIG_ENDIAN
+
+static
+void check_pointer( const void* )
+{
+}
+
+static
+void test_static_const_definition()
+{
+#define ONE_ZERO( Type ) \
+ do {\
+ check_pointer( &vnl_numeric_traits< Type >::zero );\
+ check_pointer( &vnl_numeric_traits< Type >::one );\
+ check_pointer( &vnl_numeric_traits< const Type >::zero );\
+ check_pointer( &vnl_numeric_traits< const Type >::one );\
+ } while (false)
+#define ALL( Type ) \
+ ONE_ZERO( Type ); \
+ do {\
+ check_pointer( &vnl_numeric_traits< Type >::maxval );\
+ check_pointer( &vnl_numeric_traits< const Type >::maxval );\
+ } while (false)
+
+ ALL(bool);
+ ALL(char);
+ ALL(unsigned char);
+ ALL(signed char);
+ ALL(short);
+ ALL(unsigned short);
+ ALL(int);
+ ALL(unsigned int);
+ ALL(long);
+ ALL(unsigned long);
+ ALL(float);
+ ALL(double);
+ ALL(long double);
+ ONE_ZERO( vcl_complex<float> );
+ ONE_ZERO( vcl_complex<double> );
+ ONE_ZERO( vcl_complex<long double> );
+
+#undef ONE_ZERO
+#undef ALL
+}
+
+extern "C" { long increment(long x) { return x+1; } }
+
+void test_numeric_traits()
+{
+ // call it to avoid compiler warnings
+ test_static_const_definition();
+
+ TEST("vnl_numeric_traits<bool>::zero", vnl_numeric_traits<bool>::zero, false);
+ TEST("vnl_numeric_traits<bool>::one", vnl_numeric_traits<bool>::one, true);
+ TEST("vnl_numeric_traits<char>::zero", vnl_numeric_traits<char>::zero, '\0');
+ TEST("vnl_numeric_traits<char>::one", vnl_numeric_traits<char>::one, 1);
+ TEST("vnl_numeric_traits<unsigned char>::zero", vnl_numeric_traits<unsigned char>::zero, '\0');
+ TEST("vnl_numeric_traits<unsigned char>::one", vnl_numeric_traits<unsigned char>::one, 1);
+ TEST("vnl_numeric_traits<signed char>::zero", vnl_numeric_traits<signed char>::zero, '\0');
+ TEST("vnl_numeric_traits<signed char>::one", vnl_numeric_traits<signed char>::one, 1);
+ TEST("vnl_numeric_traits<short>::zero", vnl_numeric_traits<short>::zero, 0);
+ TEST("vnl_numeric_traits<short>::one", vnl_numeric_traits<short>::one, 1);
+ TEST("vnl_numeric_traits<unsigned short>::zero", vnl_numeric_traits<unsigned short>::zero, 0);
+ TEST("vnl_numeric_traits<unsigned short>::one", vnl_numeric_traits<unsigned short>::one, 1);
+ TEST("vnl_numeric_traits<signed short>::zero", vnl_numeric_traits<signed short>::zero, 0);
+ TEST("vnl_numeric_traits<signed short>::one", vnl_numeric_traits<signed short>::one, 1);
+ TEST("vnl_numeric_traits<int>::zero", vnl_numeric_traits<int>::zero, 0);
+ TEST("vnl_numeric_traits<int>::one", vnl_numeric_traits<int>::one, 1);
+ TEST("vnl_numeric_traits<signed int>::zero", vnl_numeric_traits<signed int>::zero, 0);
+ TEST("vnl_numeric_traits<signed int>::one", vnl_numeric_traits<signed int>::one, 1);
+ TEST("vnl_numeric_traits<unsigned int>::zero", vnl_numeric_traits<unsigned int>::zero, 0);
+ TEST("vnl_numeric_traits<unsigned int>::one", vnl_numeric_traits<unsigned int>::one, 1);
+ TEST("vnl_numeric_traits<long>::zero", vnl_numeric_traits<long>::zero, 0L);
+ TEST("vnl_numeric_traits<long>::one", vnl_numeric_traits<long>::one, 1L);
+ TEST("vnl_numeric_traits<signed long>::zero", vnl_numeric_traits<signed long>::zero, 0L);
+ TEST("vnl_numeric_traits<signed long>::one", vnl_numeric_traits<signed long>::one, 1L);
+ TEST("vnl_numeric_traits<unsigned long>::zero", vnl_numeric_traits<unsigned long>::zero, 0L);
+ TEST("vnl_numeric_traits<unsigned long>::one", vnl_numeric_traits<unsigned long>::one, 1L);
+ TEST("vnl_numeric_traits<float>::zero", vnl_numeric_traits<float>::zero, 0.0f);
+ TEST("vnl_numeric_traits<float>::one", vnl_numeric_traits<float>::one, 1.0f);
+ TEST("vnl_numeric_traits<double>::zero", vnl_numeric_traits<double>::zero, 0.0);
+ TEST("vnl_numeric_traits<double>::one", vnl_numeric_traits<double>::one, 1.0);
+ TEST("vnl_numeric_traits<long double>::zero", vnl_numeric_traits<long double>::zero, 0.0);
+ TEST("vnl_numeric_traits<long double>::one", vnl_numeric_traits<long double>::one, 1.0);
+ TEST("vnl_numeric_traits<vcl_complex<float> >::zero",
+ vnl_numeric_traits<vcl_complex<float> >::zero, vcl_complex<float>(0.0f));
+ TEST("vnl_numeric_traits<vcl_complex<float> >::one",
+ vnl_numeric_traits<vcl_complex<float> >::one, vcl_complex<float>(1.0f));
+ TEST("vnl_numeric_traits<vcl_complex<double> >::zero",
+ vnl_numeric_traits<vcl_complex<double> >::zero, vcl_complex<double>(0.0));
+ TEST("vnl_numeric_traits<vcl_complex<double> >::one",
+ vnl_numeric_traits<vcl_complex<double> >::one, vcl_complex<double>(1.0));
+ TEST("vnl_numeric_traits<vcl_complex<long double> >::zero",
+ vnl_numeric_traits<vcl_complex<long double> >::zero, vcl_complex<long double>(0.0));
+ TEST("vnl_numeric_traits<vcl_complex<long double> >::one",
+ vnl_numeric_traits<vcl_complex<long double> >::one, vcl_complex<long double>(1.0));
+
+ // Testing maxval values
+
+ char cm = vnl_numeric_traits<char>::maxval;
+ signed char scm = vnl_numeric_traits<signed char>::maxval;
+ unsigned char ucm = vnl_numeric_traits<unsigned char>::maxval;
+ short sm = vnl_numeric_traits<short>::maxval;
+ unsigned short usm = vnl_numeric_traits<unsigned short>::maxval;
+ int im = vnl_numeric_traits<int>::maxval;
+ unsigned int uim = vnl_numeric_traits<unsigned int>::maxval;
+ long lm = vnl_numeric_traits<long>::maxval;
+ unsigned long ulm = vnl_numeric_traits<unsigned long>::maxval;
+ float fm = vnl_numeric_traits<float>::maxval;
+ double dm = vnl_numeric_traits<double>::maxval;
+ long double ldm = vnl_numeric_traits<long double>::maxval;
+
+ vcl_cout << " vnl_numeric_traits<bool>::maxval = " << vnl_numeric_traits<bool>::maxval << '\n'
+ << " vnl_numeric_traits<char>::maxval = " << (int)cm << '\n'
+ << " vnl_numeric_traits<signed char>::maxval = " << (int)scm << '\n'
+ << " vnl_numeric_traits<unsigned char>::maxval = " << (int)ucm << '\n'
+ << " vnl_numeric_traits<short>::maxval = " << sm << '\n'
+ << " vnl_numeric_traits<unsigned short>::maxval = " << usm << '\n'
+ << " vnl_numeric_traits<int>::maxval = " << im << '\n'
+ << " vnl_numeric_traits<unsigned int>::maxval = " << uim << '\n'
+ << " vnl_numeric_traits<long>::maxval = " << lm << '\n'
+ << " vnl_numeric_traits<unsigned long>::maxval = " << ulm << '\n'
+ << " vnl_numeric_traits<float>::maxval = " << fm << '\n'
+ << " vnl_numeric_traits<double>::maxval = " << dm << '\n'
+ << " vnl_numeric_traits<long double>::maxval = " << ldm << '\n';
+
+ // Verify that these values are positive and satisfy certain constraints:
+ TEST("vnl_numeric_traits<char>::maxval must be at least 127", cm >= 127, true);
+ TEST("vnl_numeric_traits<signed char>::maxval must be at least 127", scm >= 127, true);
+ TEST("vnl_numeric_traits<unsigned char>::maxval must be larger than that", ucm>scm, true);
+ TEST("vnl_numeric_traits<short>::maxval must be larger than that", sm>ucm, true);
+ TEST("vnl_numeric_traits<int>::maxval must be at least as large", im>=sm, true);
+ TEST("vnl_numeric_traits<unsigned short>::maxval must be larger than <short>", usm>sm, true);
+ TEST("vnl_numeric_traits<unsigned int>::maxval must be at least as large", uim>=usm && uim>(unsigned int)im, true);
+ TEST("vnl_numeric_traits<long>::maxval must be at least equal to <int>", lm>=im, true);
+ TEST("vnl_numeric_traits<unsigned long>::maxval must be larger than that", ulm>(unsigned long)lm, true);
+ TEST("vnl_numeric_traits<float>::maxval must be at least 1e33", fm>1e33, true);
+ TEST("vnl_numeric_traits<double>::maxval must be larger than that", dm>fm, true);
+ TEST("vnl_numeric_traits<long double>::maxval must be at least as large", ldm>=dm, true);
+
+ // Verify that there is nothing larger than these maxval values:
+ ++cm; TEST("vnl_numeric_traits<char>::maxval must be the largest possible", cm<=0, true);
+ if (cm > 0) vcl_cout << cm << " is larger\n";
+ ++scm; TEST("vnl_numeric_traits<signed char>::maxval must be the largest possible", scm<0, true);
+ if (scm > 0) vcl_cout << scm << " is larger\n";
+ ++ucm; TEST("vnl_numeric_traits<unsigned char>::maxval must be the largest possible", ucm==0, true);
+ if (ucm > 0) vcl_cout << ucm << " is larger\n";
+ ++sm; TEST("vnl_numeric_traits<short>::maxval must be the largest possible", sm<0, true);
+ if (sm > 0) vcl_cout << sm << " is larger\n";
+ ++usm; TEST("vnl_numeric_traits<unsigned short>::maxval must be the largest possible", usm==0, true);
+ if (usm > 0) vcl_cout << usm << " is larger\n";
+ im = increment(im); TEST("vnl_numeric_traits<int>::maxval must be the largest possible", im<0, true);
+ if (im > 0) vcl_cout << im << " is larger\n";
+ ++uim; TEST("vnl_numeric_traits<unsigned int>::maxval must be the largest possible", uim==0, true);
+ if (uim > 0) vcl_cout << uim << " is larger\n";
+ lm=increment(lm); TEST("vnl_numeric_traits<long>::maxval must be the largest possible", lm<0, true);
+ if (lm > 0) vcl_cout << lm << " is larger\n";
+ ++ulm; TEST("vnl_numeric_traits<unsigned long>::maxval must be the largest possible", ulm==0, true);
+ if (ulm > 0) vcl_cout << ulm << " is larger\n";
+
+ unsigned char* x = (unsigned char*)(&fm);
+ int nr_of_ones = 0;
+ vcl_cout << "vnl_numeric_traits<float>::maxval has internal representation ";
+#if VXL_BIG_ENDIAN
+ for (unsigned int i=0; i<sizeof(float); ++i)
+#else
+ for (int i=sizeof(float)-1; i>=0; --i)
+#endif
+ for (int j=7; j>=0; --j) {
+ int n = int(((x[i])>>j)&1);
+ nr_of_ones += n;
+ vcl_cout << n;
+ }
+ vcl_cout << '\n';
+ // there should only be 2 zeros in the representation: the sign bits of mantissa and of exponent:
+ TEST("vnl_numeric_traits<float>::maxval must be the largest possible", nr_of_ones, 8*sizeof(float)-2);
+
+ x = (unsigned char*)(&dm);
+ nr_of_ones = 0;
+ vcl_cout << "vnl_numeric_traits<double>::maxval has internal representation ";
+#if VXL_BIG_ENDIAN
+ for (unsigned int i=0; i<sizeof(double); ++i)
+#else
+ for (int i=sizeof(double)-1; i>=0; --i)
+#endif
+ for (int j=7; j>=0; --j) {
+ int n = int(((x[i])>>j)&1);
+ nr_of_ones += n;
+ vcl_cout << n;
+ }
+ vcl_cout << '\n';
+ // there should only be 2 zeros in the representation: the sign bits of mantissa and of exponent:
+ TEST("vnl_numeric_traits<double>::maxval must be the largest possible", nr_of_ones, 8*sizeof(double)-2);
+
+ x = (unsigned char*)(&ldm);
+#if 0
+ // See TODO below. Do not set if not used.
+ nr_of_ones = 0;
+#endif
+ vcl_cout << "vnl_numeric_traits<long double>::maxval has internal representation ";
+#if VXL_BIG_ENDIAN
+ for (unsigned int i=0; i<sizeof(long double); ++i)
+#else
+ for (int i=sizeof(long double)-1; i>=0; --i)
+#endif
+ for (int j=7; j>=0; --j) {
+ int n = int(((x[i])>>j)&1);
+#if 0
+ // See TODO below. Do not set if not used.
+ nr_of_ones += n;
+#endif
+ vcl_cout << n;
+ }
+ vcl_cout << '\n';
+#if 0 // TODO - long double has non-standard length on differnet platforms
+ // there should only be 2 zeros in the representation: the sign bits of mantissa and of exponent:
+ TEST("vnl_numeric_traits<long double>::maxval must be the largest possible", nr_of_ones, 8*sizeof(long double)-2);
+#endif
+}
+
+TESTMAIN(test_numeric_traits);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_random.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_random.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..8bbe24a9c08c9dc3538270055267f50fd3db755f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_random.cxx
@@ -0,0 +1,53 @@
+// This is core/vnl/tests/test_random.cxx
+#include <vcl_iostream.h>
+#include <vcl_cmath.h> // for vcl_sqrt()
+#include <vnl/vnl_random.h>
+#include <testlib/testlib_test.h>
+
+void test_random()
+{
+ vcl_cout << "********************\n"
+ << " Testing vnl_random\n"
+ << "********************\n";
+
+ vnl_random mz_random;
+ mz_random.reseed(123456);
+
+ TEST("lrand32",mz_random.lrand32(),3501493769ul);
+ TEST("lrand32(0,10)",mz_random.lrand32(0,10),9);
+ double d1 = mz_random.drand32(0,1);
+ TEST_NEAR("drand32(0,1)", d1, 0.6158541, 1e-7);
+ double d2 = mz_random.drand64(0,1);
+ TEST_NEAR("drand64(0,1)", d2, 0.2257411, 1e-7);
+
+ double sum = 0.0;
+ double sum_sq = 0.0;
+ int n = 10000;
+ for (int i=0;i<n;++i)
+ {
+ double r = mz_random.normal();
+ sum += r;
+ sum_sq += r*r;
+ }
+
+ double mean = sum/n;
+ double var = vcl_sqrt(sum_sq/n-mean*mean);
+ TEST_NEAR("normal() mean near zero",mean, 0.0, 0.01);
+ TEST_NEAR("normal() var near one",var, 1.0, 0.02);
+
+ sum = 0.0;
+ sum_sq = 0.0;
+ for (int i=0;i<n;++i)
+ {
+ double r = mz_random.normal64();
+ sum += r;
+ sum_sq += r*r;
+ }
+
+ mean = sum/n;
+ var = vcl_sqrt(sum_sq/n-mean*mean);
+ TEST_NEAR("normal64() mean near zero",mean, 0.0, 0.01);
+ TEST_NEAR("normal64() var near one",var, 1.0, 0.01);
+}
+
+TESTMAIN(test_random);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_rational.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_rational.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..06b22a5ec2347df73f1ca6a693ecdc47756353be
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_rational.cxx
@@ -0,0 +1,204 @@
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h>
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_rational_traits.h>
+#include <vcl_complex.h>
+#ifdef NEED_COMPLEX_RATIONAL
+# include <vnl/vnl_complex.h>
+#endif
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_det.h>
+
+inline vnl_rational vnl_sqrt(vnl_rational x) { return vnl_rational(vcl_sqrt(double(x))); }
+
+static void test_operators()
+{
+ vnl_rational a(-5L), b(7,-1), c, d(3,7), e(2,0);
+ TEST("==", a==-5L, true);
+ TEST("==", 5L==-a, true);
+ TEST("==", b==-7, true);
+ TEST("==", -7==b, true);
+ c = a + b; TEST("+", c, -12L);
+ c = a - b; TEST("-", c, 2L);
+ c = a * b; TEST("*", c, 35L);
+ c = a / b; TEST("/", c, vnl_rational(5,7));
+ c = c % d; TEST("%", c, vnl_rational(2,7));
+ c = a % b; TEST("%", c, -5L);
+ c = a % d; TEST("%", c, vnl_rational(-2,7));
+ c = d % a; TEST("%", c, d);
+ c = a + 5L; TEST("+", c, 0L);
+ c = a - 5L; TEST("-", c, -10L);
+ c = a * 5L; TEST("*", c, -25L);
+ c = a / 5L; TEST("/", c, -1L);
+ c = a % 5L; TEST("%", c, 0L);
+ c = 5L + a; TEST("+", c, 0L);
+ c = 5L - a; TEST("-", c, 10L);
+ c = 5L * a; TEST("*", c, -25L);
+ c = 5L / a; TEST("/", c, -1L);
+ c = 5L % a; TEST("%", c, 0L);
+ c = 5 + a; TEST("+", c, 0L);
+ c = 5 - a; TEST("-", c, 10L);
+ c = 5 * a; TEST("*", c, -25L);
+ c = 5 / a; TEST("/", c, -1L);
+ c = 5 % a; TEST("%", c, 0L);
+ c = a + 5; TEST("+", c, 0L);
+ c = a - 5; TEST("-", c, -10L);
+ c = a * 5; TEST("*", c, -25L);
+ c = a / 5; TEST("/", c, -1L);
+ TEST("<", a<d, true);
+ TEST("<", a<1L, true);
+ TEST("<", a<-4.9, true);
+ TEST(">", -b>d, true);
+ TEST(">", b>-8, true);
+ TEST(">", b>-7.1, true);
+ TEST("<=", c<=e, true);
+ TEST(">=", b>=-7L, true);
+ TEST("<=", 2L<=e, true);
+ TEST(">=", 1>=d, true);
+ TEST("truncate", truncate(1L+d), 1L);
+ TEST("truncate", truncate(-d-1L), -1L);
+ TEST("round", round(1L+d), 1L);
+ TEST("round", round(-d-1L), -1L);
+ TEST("round", round(1L-d), 1L);
+ TEST("round", round(d-1L), -1L);
+ TEST("floor", floor(1L+d), 1L);
+ TEST("floor", floor(-d-1L), -2L);
+ TEST("ceil", ceil(1L+d), 2L);
+ TEST("ceil", ceil(-d-1L), -1L);
+ TEST("abs", vnl_math_abs(d), d);
+ TEST("abs", vnl_math_abs(b), -b);
+ TEST("sqr mag", vnl_math_squared_magnitude(d), vnl_rational(9,49));
+ a += b;
+ a -= b;
+ a *= b;
+ a /= b;
+ a %= b;
+ vcl_cout << vcl_setprecision(20)
+ << "a=" << a << "=" << (double)a << vcl_endl
+ << "b=" << b << "=" << (double)b << vcl_endl
+ << "c=" << c << "=" << (double)c << vcl_endl
+ << "d=" << d << "=" << (double)d << vcl_endl
+ << "e=" << e << vcl_endl; // (double)d ==> floating exception
+ d = -7;
+ d = -7L;
+ vcl_cout << vcl_endl;
+}
+
+static void test_infinite()
+{
+ vnl_rational Inf(1,0); ++Inf;
+ TEST("Inf+1", Inf.numerator() == 1 && Inf.denominator() == 0, true);
+ Inf = -Inf;
+ TEST("-Inf", Inf.numerator() == -1 && Inf.denominator() == 0, true);
+ TEST("vnl_math_isfinite", vnl_math_isfinite(Inf), false);
+ TEST("vnl_math_isnan", vnl_math_isnan(Inf), false);
+}
+
+static void test_frac()
+{
+ vnl_rational r(-15,-20);
+ TEST("vnl_math_isfinite", vnl_math_isfinite(r), true);
+ TEST("vnl_math_isnan", vnl_math_isnan(r), false);
+ TEST("simplify", r.numerator() == 3 && r.denominator() == 4, true);
+}
+
+static void test_approx()
+{
+ vnl_rational d ( 1.0/3.0 ); // explicit constructor from double
+ TEST("construct from double", d, vnl_rational(1,3));
+ d = vnl_rational(-5.0/7);
+ TEST("construct from double", d, vnl_rational(-5,7));
+ d = vnl_rational(0.42857142857);
+ TEST("construct from double", d, vnl_rational(3,7));
+ d = vnl_rational(-1.23456);
+ TEST("construct from double", d, vnl_rational(-123456,100000));
+ vnl_rational pi = vnl_rational(vnl_math::pi);
+ double pi_a = double(pi);
+ TEST("pi", pi_a-vnl_math::pi < 1e-18 && vnl_math::pi-pi_a < 1e-18, true);
+ vcl_cout << "Best rational approximation of pi: " << pi << " = "
+ << pi_a << vcl_endl
+ << "Compare this with pi in 20 decimals: "
+ << vnl_math::pi << vcl_endl;
+}
+
+static void test_determinant()
+{
+ vnl_matrix_fixed<vnl_rational,3,3> m;
+ m[0][0] = vnl_rational(1,3);
+ m[0][1] = vnl_rational(2,7);
+ m[0][2] = vnl_rational(2,5);
+ m[1][0] = vnl_rational(-1,2);
+ m[1][1] = vnl_rational(1,4);
+ m[1][2] = vnl_rational(6,7);
+ m[2][0] = vnl_rational(2,3);
+ m[2][1] = vnl_rational(1,5);
+ m[2][2] = vnl_rational(5,2);
+ vcl_cout << "rational matrix:\n" << m
+ << "determinant = " << vnl_det(m[0], m[1], m[2]) << vcl_endl;
+ TEST("determinant", vnl_det(m[0], m[1], m[2]), vnl_rational(16609,29400));
+}
+
+static void test_sqrt()
+{
+ vnl_rational d(16,9);
+ TEST("sqrt", vnl_sqrt(d), vnl_rational(4,3));
+ d = vnl_sqrt(vnl_rational(2L));
+ double sqrt2 = vcl_sqrt(2.0), sqrt_2 = double(d);
+ vcl_cout << "Best rational approximation of sqrt(2): " << d << " = "
+ << sqrt_2 << vcl_endl
+ << "Compare this with sqrt(2) in 20 decimals: "
+ << sqrt2 << vcl_endl;
+ TEST("sqrt(2)", sqrt2-sqrt_2 < 1e-18 && sqrt_2-sqrt2 < 1e-18, true);
+}
+
+static void test_zero_one()
+{
+ vnl_rational n = vnl_numeric_traits<vnl_rational>::zero;
+ vcl_cout << "zero = " << n << '\n';
+ TEST("zero", n, 0L);
+ vnl_rational u = vnl_numeric_traits<vnl_rational>::one;
+ vcl_cout << "one = " << u << '\n';
+ TEST("one", u, 1L);
+}
+
+#ifdef NEED_COMPLEX_RATIONAL // see vnl_complex.h
+static void test_complex()
+{
+ vcl_complex<vnl_rational> c(0L,1L);
+ vnl_rational cc(-1L);
+ TEST("complex square", c*c, cc);
+ TEST("complex abs", vnl_math_abs(c), 1);
+ TEST("complex sqr mag", vnl_math_squared_magnitude(c), 1);
+ TEST("complex vnl_math_isfinite", vnl_math_isfinite(c), true);
+ TEST("complex vnl_math_isnan", vnl_math_isnan(c), false);
+}
+
+static void test_complex_zero_one()
+{
+ vcl_complex<vnl_rational> n = vnl_numeric_traits<vcl_complex<vnl_rational> >::zero;
+ vcl_cout << "zero = " << n << '\n';
+ TEST("zero", n, vcl_complex<vnl_rational>(0L,0L));
+ vcl_complex<vnl_rational> u = vnl_numeric_traits<vcl_complex<vnl_rational> >::one;
+ vcl_cout << "one = " << u << '\n';
+ TEST("one", u, vcl_complex<vnl_rational>(1L,0L));
+}
+#endif // NEED_COMPLEX_RATIONAL
+
+void test_rational()
+{
+ test_operators();
+ test_infinite();
+ test_frac();
+ test_approx();
+ test_determinant();
+ test_sqrt();
+ test_zero_one();
+#ifdef NEED_COMPLEX_RATIONAL // see vnl_complex.h
+ test_complex();
+ test_complex_zero_one();
+#endif
+}
+
+TESTMAIN(test_rational);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_real_polynomial.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_real_polynomial.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..22feb08424800b6cdbaae3209030c20ea2a55ad0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_real_polynomial.cxx
@@ -0,0 +1,54 @@
+#include <vcl_iostream.h>
+
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_real_polynomial.h>
+#include <vnl/vnl_double_3.h>
+#include <vcl_cmath.h>
+
+void test_real_polynomial()
+{
+ vnl_real_polynomial f1(3),f2(4);
+
+ for (int i=0;i<=f1.degree();++i) f1[i]=i+1; // f1 = X^2 + 2X + 3
+ f1.print(vcl_cout); vcl_cout << vcl_endl;
+ for (int i=0;i<=f2.degree();++i) f2[i]=2*i+1; // f2 = X^3 + 3X^2 + 5X + 7
+ f2.print(vcl_cout); vcl_cout << vcl_endl;
+
+ vnl_real_polynomial f3 = f1+f2;
+ f3.print(vcl_cout); vcl_cout << vcl_endl;
+ TEST("f1+f2=f3",f1.evaluate(2.5)+f2.evaluate(2.5), f3.evaluate(2.5));
+ // Evaluating in 2.5 is exact, since 2.5 is exactly representable (binary 10.1)
+
+ vnl_real_polynomial f4 = f1-f2;
+ f4.print(vcl_cout); vcl_cout << vcl_endl;
+ TEST("f1-f2=f4",f1.evaluate(2.5)-f2.evaluate(2.5), f4.evaluate(2.5));
+
+ vnl_real_polynomial f5 = f1*f2;
+ f5.print(vcl_cout); vcl_cout << vcl_endl;
+
+ TEST("f1*f2 has correct degree",f5.degree()==(f1.degree()+f2.degree()),true);
+
+ TEST("f1*f2=f5",f1.evaluate(2.5)*f2.evaluate(2.5), f5.evaluate(2.5));
+
+ vnl_real_polynomial f1d = f1.derivative();
+ f1d.print(vcl_cout); vcl_cout << vcl_endl;
+ vnl_real_polynomial f2d = f2.derivative();
+ f2d.print(vcl_cout); vcl_cout << vcl_endl;
+
+ TEST("Derivative", f5.derivative(), f1d*f2+f2d*f1);
+
+ vnl_real_polynomial f5p = (f1d*f2+f2d*f1).primitive();
+ f5p.print(vcl_cout); vcl_cout << vcl_endl;
+
+ TEST("Primitive", f5p, f5-f5.evaluate(0.0));
+
+ TEST_NEAR("Integral", f1.evaluate_integral(2.0), 70.0/3, 1e-9);
+
+ TEST("Polynomial of degree 0", vnl_real_polynomial(1.0).evaluate(0.5),1.0);
+ TEST("Vector initialisation",
+ vnl_real_polynomial(vnl_double_3(3.0,2.0,1.0)).evaluate(2.0),17.0);
+
+ TEST_NEAR("RMS difference(f1,f2)",vnl_rms_difference(f1,f1,0,1),0.0,1e-9);
+}
+
+TESTMAIN(test_real_polynomial);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_resize.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_resize.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..74e7e1aad4dca693b5bd89f5d72740b81eaee3f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_resize.cxx
@@ -0,0 +1,47 @@
+// This is core/vnl/tests/test_resize.cxx
+#include <testlib/testlib_test.h>
+// \author fsm
+#include <vcl_iostream.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+static void test_size()
+{
+ vnl_vector<double> X(3);
+
+ X.fill(2);
+ TEST("fill 2", X(0)+X(1)+X(2), 6.0);
+ vcl_cout << "X = " << X << vcl_endl;
+
+ X.set_size(5);
+ TEST("size", X.size(), 5);
+#if 0
+ // After resize, old data is lost, so the following test must fail:
+ TEST("resize", X(0)+X(1)+X(2)+X(3)+X(4), 6.0);
+#endif
+}
+
+static void test_rows_cols()
+{
+ vnl_matrix<double> M(3, 4);
+
+ M.fill(2);
+ TEST("fill 2", M(0,0)+M(1,1)+M(2,2)+M(2,3), 8.0);
+ vcl_cout << "M =\n" << M << vcl_endl;
+
+ M.set_size(5,7);
+ TEST("size: rows", M.rows(), 5);
+ TEST("size: cols", M.cols(), 7);
+#if 0
+ // After resize, old data is lost, so the following test must fail:
+ TEST("resize", M(0,0)+M(1,1)+M(2,2)+M(3,3)+M(4,4), 6.0);
+#endif
+}
+
+static void test_resize()
+{
+ test_size();
+ test_rows_cols();
+}
+
+TESTMAIN(test_resize);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sample.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sample.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..245a2c0e48aa5570643458402ef1be0697a820e7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sample.cxx
@@ -0,0 +1,54 @@
+/*
+ fsm
+*/
+#include <vcl_iostream.h>
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_sample.h>
+#include <vcl_ctime.h>
+
+void test_sample()
+{
+ unsigned const N = 100000;
+ double mu = 1.552;
+ double sigma = 3.729;
+
+ double* X = new double[N];
+ vnl_sample_reseed(vcl_time(0)); //for quasi-random initialization
+
+ for (unsigned i=0; i<N; ++i)
+ X[i] = vnl_sample_normal(mu, sigma);
+
+ // sample mean
+ double X_bar = 0;
+ for (unsigned i=0; i<N; ++i)
+ X_bar += X[i];
+ X_bar /= N;
+ vcl_cout << "actual mean : " << mu << vcl_endl;
+ vcl_cout << "sample mean : " << X_bar << vcl_endl;
+ TEST("sample mean", X_bar-mu < 0.1 && mu-X_bar < 0.1, true);
+
+ // sample standard deviation
+ double sigma_bar = 0;
+ for (unsigned i=0; i<N; ++i)
+ sigma_bar += vnl_math_sqr(X[i] - X_bar);
+ sigma_bar = vcl_sqrt(sigma_bar / (N-1));
+ vcl_cout << "actual standard deviation : " << sigma << vcl_endl;
+ vcl_cout << "sample standard deviation : " << sigma_bar << vcl_endl;
+ TEST("sample stddev", sigma_bar-sigma < 0.1 && sigma-sigma_bar < 0.1, true);
+
+ const int seed = 7;
+ vnl_sample_reseed (seed);
+ double nval0 = vnl_sample_normal (0.0, 1.0);
+ double uval0 = vnl_sample_uniform (0.0, 1.0);
+ vnl_sample_reseed (seed);
+ double nval1 = vnl_sample_normal (0.0, 1.0);
+ double uval1 = vnl_sample_uniform (0.0, 1.0);
+ vcl_cout << "repeat normal: " << nval0 << " " << nval1 << vcl_endl;
+ vcl_cout << "repeat uniform: " << uval0 << " " << uval1 << vcl_endl;
+ TEST("seed repeat", nval0 == nval1 && uval0 == uval1, true);
+
+ delete [] X;
+}
+
+TESTMAIN(test_sample);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sym_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sym_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..803af718709856933c4fa66a1690660e4f2475c7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_sym_matrix.cxx
@@ -0,0 +1,75 @@
+// This is core/vnl/tests/test_sym_matrix.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_sym_matrix.h>
+#include <testlib/testlib_test.h>
+
+static
+void test_int()
+{
+ vcl_cout << "*****************************\n"
+ << "Testing Symmetric Matrix<int>\n"
+ << "*****************************\n";
+ vnl_sym_matrix<int> sm1(2);
+ TEST("\n\nvnl_sym_matrix<int> m1(2)", (sm1.rows()==2 && sm1.columns()==2), true);
+ vnl_sym_matrix<int> sm2(2,2);
+ TEST("\n\nvnl_sym_matrix<int> sm2(2,2)",
+ (sm2(0,0)==2 && sm2(0,1)==2 && sm2(1,0)==2 && sm2(1,1)==2), true);
+ const vnl_matrix<int> ma1(2, 2, 3);
+ const vnl_sym_matrix<int> sm3(ma1);
+ TEST("\n\n(const vnl_sym_matrix) sm3",
+ (sm3(0,0)==3 && sm3(0,1)==3 && sm3(1,0)==3 && sm3(1,1)==3), true);
+ vcl_cout << "sm3\n" << sm3 <<vcl_endl << vcl_endl;
+
+ int td[] = {1, 2, 3};
+ vnl_sym_matrix<int> sm4(td, 2);
+ vcl_cout << "sm4\n" << sm4 << vcl_endl << vcl_endl;
+ vnl_matrix<int> ma2 = sm4.as_matrix();
+ TEST("(const vnl_matrix) ma2",
+ (ma2(0,0)==1 && ma2(0,1)==2 && ma2(1,0)==2 && ma2(1,1)==3), true);
+ vcl_cout << "ma2\n" << ma2 << vcl_endl << vcl_endl;
+ TEST("operator== ", ma2==sm4 && !(ma2==sm3), true);
+ vcl_cout << "sm3\n" << sm3 << vcl_endl << vcl_endl;
+
+ int td5[] = {0, 0, 0};
+ vnl_sym_matrix<int> sm5(td5, 2);
+ swap(sm5, sm4);
+ TEST("swap",
+ (sm4(0,0)==0 && sm4(0,1)==0 && sm4(1,0)==0 && sm4(1,1)==0) &&
+ (sm5(0,0)==1 && sm5(0,1)==2 && sm5(1,0)==2 && sm5(1,1)==3), true);
+
+ vnl_sym_matrix<int> sm6(3, 0);
+ sm6.update(sm5,1);
+ TEST("update",
+ (sm6(0,0)==0 && sm6(0,1)==0 && sm6(0,2)==0 &&
+ sm6(1,0)==0 && sm6(1,1)==1 && sm6(1,2)==2 &&
+ sm6(2,0)==0 && sm6(2,1)==2 && sm6(2,2)==3), true);
+ vcl_cout << "sm6\n" << sm6 << vcl_endl << vcl_endl;
+
+ sm5 = sm6;
+ TEST("operator =",
+ (sm5(0,0)==0 && sm5(0,1)==0 && sm5(0,2)==0 &&
+ sm5(1,0)==0 && sm5(1,1)==1 && sm5(1,2)==2 &&
+ sm5(2,0)==0 && sm5(2,1)==2 && sm5(2,2)==3), true);
+ vcl_cout << "sm5\n" << sm5 << vcl_endl << vcl_endl;
+
+ TEST("operator ==",
+ (sm5==sm6 && !(sm5==sm4) && !(sm4==sm3)), true);
+ vcl_cout << "sm4 sm3\n" << sm4 << vcl_endl << sm3 << vcl_endl << vcl_endl;
+
+ vnl_vector<int> v1(2,5);
+ sm5.set_half_row(v1, 1);
+ TEST("set_half_row",
+ (sm5(0,0)==0 && sm5(0,1)==5 && sm5(0,2)==0 &&
+ sm5(1,0)==5 && sm5(1,1)==5 && sm5(1,2)==2 &&
+ sm5(2,0)==0 && sm5(2,1)==2 && sm5(2,2)==3), true);
+ vcl_cout << "sm5\n" << sm5 << vcl_endl << vcl_endl;
+}
+
+
+static
+void test_sym_matrix()
+{
+ test_int();
+}
+
+TESTMAIN(test_sym_matrix);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_transpose.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_transpose.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..6f9f0064b56979d57c6f468bb4845273006218ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_transpose.cxx
@@ -0,0 +1,31 @@
+#include <vcl_iostream.h>
+
+#include <testlib/testlib_test.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matlab_print.h>
+
+void test_transpose()
+{
+ vnl_matrix<double> X(10, 2);
+ for (unsigned int i=0; i<X.rows(); ++i)
+ for (unsigned int j=0; j<X.cols(); ++j)
+ X[i][j] = (i+1)*3 + (j+1)*(j+i);
+
+ vnl_matrix<double> old_X(X);
+
+ vnl_matlab_print(vcl_cout, X, "X");
+
+ X.inplace_transpose();
+
+ vnl_matlab_print(vcl_cout, X, "X");
+
+ TEST ("X == old_X.transpose()", X == old_X.transpose(), true);
+
+ X.inplace_transpose();
+
+ vnl_matlab_print(vcl_cout, X, "X");
+
+ TEST ("X == old_X", X == old_X, true);
+}
+
+TESTMAIN(test_transpose);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9e7b4e6a8b64265e2351e0878e34eb5ab31b154f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector.cxx
@@ -0,0 +1,546 @@
+// This is core/vnl/tests/test_vector.cxx
+#include <vcl_iostream.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_float_3.h>
+#include <vnl/vnl_float_4.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_cross.h>
+#include <testlib/testlib_test.h>
+
+void vnl_vector_test_int()
+{
+ vcl_cout << "***********************\n"
+ << "Testing vnl_vector<int>\n"
+ << "***********************\n";
+ //// test constructors, accessors
+ vnl_vector<int> v0;
+ TEST("vnl_vector<int> v0()", v0.size(), 0);
+ vnl_vector<int> v1(2);
+ TEST("vnl_vector<int> v1(2)", v1.size(), 2);
+ vnl_vector<int> v2(2,2);
+ TEST("vnl_vector<int> v2(2,2)", (v2.get(0)==2 && v2.get(1)==2), true);
+// TEST("v0.set_compare", (v0.set_compare(int_equal), true), true);
+ int vcvalues[] = {1,0};
+ vnl_vector<int> vc(2,2,vcvalues);
+ TEST("vnl_vector<int> vc(2,2,int[])", (vc(0)==1 && vc(1)==0), true);
+ TEST("v1=2", (v1=2, (v1.get(0)==2 && v1.get(1)==2)), true);
+ TEST("v1 == v2", (v1 == v2), true);
+ TEST("v0 = v2", ((v0 = v2), (v0 == v2)), true);
+ TEST("v2.put(1,3)", (v2.put(1,3),v2.get(1)), 3);
+ TEST("v2.get(1)", v2.get(1), 3);
+ TEST("v0 == v2", (v0 == v2), false);
+ TEST("v0 != v2", (v0 != v2), true);
+ TEST("(v0 == v2)", (v0 == v2), false);
+ TEST("v1.fill(3)", (v1.fill(3), (v1.get(0)==3 && v1.get(1)==3)), true);
+ TEST("v2.fill(2)", (v2.fill(2), (v2.get(0)==2 && v2.get(1)==2)), true);
+ int v3values [] = {1,2,3};
+ vnl_vector<int> v3(3,3,v3values);
+ TEST("v3(3,3,{1,2,3})",(v3.get(0)==1 && v3.get(1)==2 && v3.get(2)==3), true);
+ vnl_vector<int> v4(v3);
+ TEST("vnl_vector<int> v4(v3)", v3, v4);
+ TEST("v0=v2", (v0=v2, v0), v2);
+
+ //// test additions and subtractions
+ TEST("v0=v2+3", ((v0=v2+3), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0=3+v2", ((v0=3+v2), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0+=(-3)", (v0+=(-3), (v0.get(0)==2 && v0.get(1)==2)), true);
+ TEST("v0-=(-3)", (v0-=(-3), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0=v2-3", ((v0=v2-3), (v0.get(0)==-1 && v0.get(1)==-1)), true);
+ TEST("v0=3-v2", ((v0=3-v2), (v0.get(0)==1 && v0.get(1)==1)), true);
+ TEST("v0= -v2", (v0= -v2, (v0.get(0)==-2 && v0.get(1)==-2)), true);
+
+ vnl_vector<int> v5(2);
+ v0 = v2;
+ TEST("v5=v0+v2", ((v5=v0+v2), (v5.get(0)==4 && v5.get(1)==4)), true);
+ TEST("v5=v0-v2", ((v5=v0-v2), (v5.get(0)==0 && v5.get(1)==0)), true);
+ TEST("v0+=v2", ((v0+=v2), (v0.get(0)==4 && v0.get(1)==4)), true);
+ TEST("v0-=v2", ((v0-=v2), (v0.get(0)==2 && v0.get(1)==2)), true);
+
+ //// test multiplications and divisions
+ TEST("v4=v3*5", ((v4=v3*5), (v4.get(0)==5 && v4.get(1)==10 && v4.get(2)==15)), true);
+
+ TEST("v4=5*v3", ((v4=5*v3), (v4.get(0)==5 && v4.get(1)==10 && v4.get(2)==15)), true);
+ TEST("v3*=5",((v3*=5), (v3== v4)), true);
+ TEST("v4=v3/5", ((v4=v3/5), (v4.get(0)==1 && v4.get(1)==2 && v4.get(2)==3)), true);
+ TEST("v3/=5", ((v3/=5), (v3==v4)), true);
+
+ //// additional tests
+ int vvalues [] = {0,-2,2,0};
+ vnl_vector<int> v(4,4,vvalues);
+ v0 = v; v1 = v; v2 = v;
+ TEST("v(i)", (v(0)==0 && v(1)==-2 && v(2)==2 && v(3)==0), true);
+#if 0
+ TEST("v.abs()",
+ ((v1 = v.abs()),
+ (v1(0)==0 && v1(1)==2 && v1(2)==2 && v1(3)==0)), true);
+ TEST("v.sign()",
+ ((v1 = v.sign()),
+ (v1(0)==0 && v1(1)==-1 && v1(2)==1 && v1(3)==0)), true);
+#endif
+ TEST("element_product(v,v)",
+ ((v1 = element_product(v,v)),
+ (v1(0)==0 && v1(1)==4 && v1(2)==4 && v1(3)==0)), true);
+ TEST("element_quotient(v,[2])",
+ ((v2 = 2),
+ (v1 = element_quotient(v,v2)),
+ (v1(0)==0 && v1(1)==-1 && v1(2)==1 && v1(3)==0)), true);
+#if 0
+ TEST("v.update(v.abs())",
+ ((v1 = v.abs()),
+ (v2.update(v1)),
+ (v2==v1)), true);
+#endif
+ TEST("v.extract(1,3)",
+ ((v1 = v.extract(1,3)),
+ (v1.size()==1 && v1(0)==v(3))), true);
+ TEST("v.update([4],3)",
+ ((v1=4),
+ (v.update(v1,3)),
+ (v(0)==0 && v(1)==-2 && v(2)==2 && v(3)==4)), true);
+
+ { // new scope to reuse variables
+ int vvalues [] = {1,0,0,0};
+ vnl_vector<int> v (4,4,vvalues);
+ int v1values [] = {1,0,0};
+ int v2values [] = {0,1,0};
+ int v3values [] = {0,0,1};
+ vnl_vector<int> v1(3,3,v1values);
+ vnl_vector<int> v2(3,3,v2values);
+ vnl_vector<int> v3(3,3,v3values);
+ TEST("dot_product(v1,v2)",
+ (dot_product(v1,v2)==0 && dot_product(v1,v3)==0 && dot_product(v2,v3)==0), true);
+ TEST("dot_product(v1,v1)",
+ (dot_product(v1,v1)==1 && dot_product(v2,v2)==1 && dot_product(v3,v3)==1), true);
+ TEST("4d-v=3d-v", ((v = v3), v.size()==3 && v==v3), true);
+ TEST("vnl_cross_3d(v1,v2)", vnl_cross_3d(v1,v2), v3);
+ TEST("vnl_cross_3d(v2,v3)", vnl_cross_3d(v2,v3), v1);
+ TEST("vnl_cross_3d(v1,v3)", vnl_cross_3d(v1,v3), -v2);
+ vnl_vector<int> vv(2,0);
+ v1 = vv; v1[0]=1;
+ v2 = vv; v2[1]=1;
+ TEST("vnl_cross_2d(v1,v2)", vnl_cross_2d(v1,v2)==1, true);
+ }
+
+ {
+ int vvalues [] = {1, 2, 3};
+ vnl_vector<int> v (3, 3, vvalues);
+ vnl_matrix<int> m = outer_product(v, v);
+ TEST("outer_product",
+ (m(0,0)==1 && m(0,1)==2 && m(0,2)==3 &&
+ m(1,0)==2 && m(1,1)==4 && m(1,2)==6 &&
+ m(2,0)==3 && m(2,1)==6 && m(2,2)==9), true);
+ }
+ {
+ int vvalues [] = {1,0,0,0};
+ vnl_vector<int> v (4,4,vvalues);
+ TEST("v.squared_magnitude", (v.squared_magnitude()==1), true);
+ TEST("v.magnitude", (v.magnitude()==1), true);
+ // normalize not sensible for ints
+ //TEST("v.normalize", (v1 = 3 * v, v1.normalize(), v1), v);
+ }
+}
+
+
+bool float_equal(const float& f1, const float& f2)
+{
+ return vcl_fabs(f1 - f2) < 1.0e-6;
+}
+
+void vnl_vector_test_float()
+{
+ vcl_cout << "*************************\n"
+ << "Testing vnl_vector<float>\n"
+ << "*************************\n";
+ //// test constructors, accessors
+ vnl_vector<float> v0;
+ TEST("vnl_vector<float> v0()", v0.size(), 0);
+ vnl_vector<float> v1(2);
+ TEST("vnl_vector<float> v1(2)", v1.size(), 2);
+ vnl_vector<float> v2(2,2);
+ TEST("vnl_vector<float> v2(2,2)", (v2.get(0)==2 && v2.get(1)==2), true);
+#if 0
+ TEST("v0.set_compare", (v0.set_compare(float_equal), true), true);
+#endif
+
+ float vcvalues[2] = {1};
+ vnl_vector<float> vc(2,2,vcvalues);
+ TEST("vnl_vector<float> vc(2,2,float[])", (vc(0)==1 && vc(1)==0), true);
+ TEST("v1=2", (v1=2, (v1.get(0)==2 && v1.get(1)==2)), true);
+ TEST("v1 == v2", (v1 == v2), true);
+ TEST("v0 = v2", ((v0 = v2), (v0 == v2)), true);
+ TEST("v2.put(1,3)", (v2.put(1,3),v2.get(1)), 3);
+ TEST("v2.get(1)", v2.get(1), 3);
+ TEST("v0 == v2", (v0 == v2), false);
+ TEST("v0 != v2", (v0 != v2), true);
+ TEST("(v0 == v2)", (v0 == v2), false);
+ TEST("v1.fill(3)", (v1.fill(3), (v1.get(0)==3 && v1.get(1)==3)), true);
+ TEST("v2.fill(2)", (v2.fill(2), (v2.get(0)==2 && v2.get(1)==2)), true);
+ vnl_vector<float> v3 = vnl_float_3(1.f,2.f,3.f).as_vector();
+ TEST("v3(3)",(v3.get(0)==1 && v3.get(1)==2 && v3.get(2)==3), true);
+ vnl_vector<float> v4(v3);
+ TEST("vnl_vector<float> v4(v3)", v3, v4);
+ TEST("v0=v2", (v0=v2, (v0==v2)), true);
+ vcl_cout << &v0 << " == " << v0 << vcl_endl;
+ TEST("<<", 1, 1);
+
+ //// test additions and subtractions
+ TEST("v0=v2+3", ((v0=v2+3), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0=3+v2", ((v0=3.0f+v2), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0+=(-3)", (v0+=(-3), (v0.get(0)==2 && v0.get(1)==2)), true);
+ TEST("v0-=(-3)", (v0-=(-3), (v0.get(0)==5 && v0.get(1)==5)), true);
+ TEST("v0=v2-3", ((v0=v2-3), (v0.get(0)==-1 && v0.get(1)==-1)), true);
+ TEST("v0=3-v2", ((v0=3.0f-v2), (v0.get(0)==1 && v0.get(1)==1)), true);
+ TEST("v0= -v2", (v0= -v2, (v0.get(0)==-2 && v0.get(1)==-2)), true);
+
+ vnl_vector<float> v5(2);
+ v0 = v2;
+ TEST("v5=v0+v2", ((v5=v0+v2), (v5.get(0)==4 && v5.get(1)==4)), true);
+ TEST("v5=v0-v2", ((v5=v0-v2), (v5.get(0)==0 && v5.get(1)==0)), true);
+ TEST("v0+=v2", ((v0+=v2), (v0.get(0)==4 && v0.get(1)==4)), true);
+ TEST("v0-=v2", ((v0-=v2), (v0.get(0)==2 && v0.get(1)==2)), true);
+
+ //// test multiplications and divisions
+ TEST("v4=v3*5", ((v4=v3*5), (v4.get(0)==5 && v4.get(1)==10 && v4.get(2)==15)), true);
+
+ TEST("v4=5*v3", ((v4=5.0f*v3), (v4.get(0)==5 && v4.get(1)==10 && v4.get(2)==15)), true);
+ TEST("v3*=5",((v3*=5), (v3== v4)), true);
+ TEST("v4=v3/5", ((v4=v3/5), (v4.get(0)==1 && v4.get(1)==2 && v4.get(2)==3)), true);
+ TEST("v3/=5", ((v3/=5), (v3==v4)), true);
+
+ //// additional tests
+// vnl_vector<float> v(4,4,0,-2,2,0); no var args with floats
+ float vvalues [] = {0,-2,2,0};
+ vnl_vector<float> v(4,4,vvalues);
+ v[0] = 0;
+ v[1] = -2;
+ v[2] = 2;
+ v[3] = 0;
+ v0 = v; v1 = v; v2 = v;
+ TEST("v(i)", (v(0)==0 && v(1)==-2 && v(2)==2 && v(3)==0), true);
+#if 0
+ TEST("v.abs()",
+ ((v1 = v.abs()),
+ (v1(0)==0 && v1(1)==2 && v1(2)==2 && v1(3)==0)), true);
+ TEST("v.sign()",
+ ((v1 = v.sign()),
+ (v1(0)==0 && v1(1)==-1 && v1(2)==1 && v1(3)==0)), true);
+#endif
+ TEST("element_product(v,v)",
+ ((v1 = element_product(v,v)),
+ (v1(0)==0 && v1(1)==4 && v1(2)==4 && v1(3)==0)), true);
+ TEST("element_quotient(v,[2])",
+ ((v2 = 2),
+ (v1 = element_quotient(v,v2)),
+ (v1(0)==0 && v1(1)==-1 && v1(2)==1 && v1(3)==0)), true);
+#if 0
+ TEST("v.update(v.abs())",
+ ((v1 = v.abs()),
+ (v2.update(v1)),
+ (v2==v1)), true);
+#endif
+ TEST("v.extract(1,3)",
+ ((v1 = v.extract(1,3)),
+ (v1.size()==1 && v1(0)==v(3))), true);
+ TEST("v.update([4],3)",
+ ((v1=4),
+ (v.update(v1,3)),
+ (v(0)==0 && v(1)==-2 && v(2)==2 && v(3)==4)), true);
+
+ { // new scope to reuse variables
+ float vvalues [] = {1,0,0,0};
+ vnl_vector<float> v (4,4,vvalues);
+ v[0] = 1;
+ v[1] = 0;
+ v[2] = 0;
+ v[3] = 0;
+ TEST("v(i)",
+ (v(0)==v[0] && v[0]==1 &&
+ v(1)==v[1] && v[1]==0 &&
+ v(2)==v[2] && v[2]==0 &&
+ v(3)==v[3] && v[3]==0), true);
+ vnl_vector<float> v1(3,0.f); v1[0] = 1.f;
+ vnl_vector<float> v2(3,0.f); v2[1] = 1.f;
+ vnl_vector<float> v3(3,0.f); v3[2] = 1.f;
+ TEST("dot_product(v1,v2)",
+ (dot_product(v1,v2)==0 && dot_product(v1,v3)==0 && dot_product(v2,v3)==0), true);
+ TEST("4d-v=3d-v", ((v = v3), v.size()==3 && v==v3), true);
+ TEST("vnl_cross_3d(v1,v2)", vnl_cross_3d(v1,v2), v3);
+ TEST("vnl_cross_3d(v2,v3)", vnl_cross_3d(v2,v3), v1);
+ TEST("vnl_cross_3d(v1,v3)", vnl_cross_3d(v1,v3), -v2);
+ vnl_vector<float> vv(2,0);
+ v1 = vv; v1[0]=1;
+ v2 = vv; v2[1]=1;
+ TEST("vnl_cross_2d(v1,v2)", vnl_cross_2d(v1,v2), 1);
+ }
+
+ {
+ vnl_float_3 v(1.f,2.f,3.f);
+ vnl_float_4 v2(1.f,2.f,3.f,4.f);
+ vnl_matrix_fixed<float,3,4> m = outer_product(v, v2);
+ TEST("outer_product -> fixed 3 x fixed 4",
+ (m(0,0)==1 && m(0,1)==2 && m(0,2)==3 && m(0,3) == 4 &&
+ m(1,0)==2 && m(1,1)==4 && m(1,2)==6 && m(1,3) == 8 &&
+ m(2,0)==3 && m(2,1)==6 && m(2,2)==9 && m(2,3) == 12), true);
+ }
+ {
+ vnl_float_3 v(1.f,2.f,3.f);
+ TEST("vnl_float_3 v(1.f,2.f,3.f)", v.size(), 3);
+ v[0] = 1.f; v[1] = 2.f; v[2] = 3.f;
+ TEST("v[0]=1 and v[0]", v[0], 1);
+ TEST("v[1]=2 and v[1]", v[1], 2);
+ TEST("v[2]=3 and v[2]", v[2], 3);
+ vnl_vector<float> v1(3, 0.f); v1[0]=1.f;
+ vcl_cout << "v1 = " << v1 << vcl_endl;
+ vnl_vector<float> v2(3, 0.f); v2[1]=1.f;
+ vcl_cout << "v2 = " << v2 << vcl_endl;
+ vnl_vector<float> v3(3, 0.f); v3[0]=-0.5f; v3[2]=0.5f;
+ vcl_cout << "v3 = " << v3 << vcl_endl
+ << "v1 - v2 = " << v1 - v2 << vcl_endl;
+ double ang = angle(v1,v2);
+ vcl_cout << "angle(v1,v2) = " << ang << vcl_endl;
+ ang *= 180*vnl_math::one_over_pi;
+ vcl_cout << "angle(v1,v2) in degrees = " << ang << vcl_endl
+ << "v1.size()=" << v1.size() << vcl_endl
+ << "v2.size()=" << v2.size() << vcl_endl
+ << "vnl_cross_2d(v1,v2) = " << vnl_cross_2d(v1,v2) << vcl_endl
+ << "vnl_cross_3d(v1,v2) = " << vnl_cross_3d(v1,v2) << vcl_endl;
+ TEST_NEAR("angle(v1,v2)", ang, 90.0, 1e-15);
+ double ang2 = angle(v1,v3);
+ vcl_cout << "angle(v1,v3) = " << ang << vcl_endl;
+ ang2 *= 180*vnl_math::one_over_pi;
+ vcl_cout << "angle(v1,v3) in degrees = " << ang2 << vcl_endl;
+ TEST_NEAR("angle(v1,v3)", ang2, 135.0, 1e-6);
+#if 0
+ TEST("squared_distance_2d", squared_distance_2d(v1,v2), 2);
+ TEST("squared_distance_3d", squared_distance_3d(v1,v2), 2);
+#endif
+ TEST_NEAR("mean", vnl_c_vector<float>::mean(v.begin(), v.size()), 2.0, 1e-6);
+ TEST_NEAR("std", vnl_c_vector<float>::std(v.begin(), v.size()), 1.0, 1e-6);
+ }
+
+ {
+ float vvalues [] = {1,0,0,0};
+ vnl_vector<float> v (4,4,vvalues);
+ v[0] = 1;
+ v[1] = 0;
+ v[2] = 0;
+ v[3] = 0;
+ TEST("v.squared_magnitude", v.squared_magnitude(), 1);
+ TEST("v.magnitude", v.magnitude(), 1);
+ TEST("v.normalize", (v1 = 3.0f * v, v1.normalize(), v1), v);
+ }
+
+ TEST("vnl_vector_ssd",
+ vnl_vector_ssd(vnl_vector<float>(4, 0.0f), vnl_vector<float>(4, 1.0f)),
+ 4.0);
+}
+
+void vnl_vector_test_matrix()
+{
+ int mvalues[] = {1,2,3,
+ 4,5,6}; // product with matrices
+ vnl_matrix<int> m(2,3,6, mvalues);
+
+ int v2values [] = {1,0};
+ int v3values [] = {1,0,0};
+ vnl_vector<int> v, v2(2,2,v2values), v3(3,3,v3values);
+ TEST("v.pre_multiply(m)",
+ ((v = v3),
+ (v.pre_multiply(m)),
+ (v.size()==2 && v(0)==1 && v(1)==4)), true);
+ TEST("v.post_multiply(m)",
+ ((v = v2),
+ (v.post_multiply(m)),
+ (v.size()==3 && v(0)==1 && v(1)==2 && v(2)==3)), true);
+ TEST("v*=m",
+ ((v = v2),
+ (v *= m),
+ (v.size()==3 && v(0)==1 && v(1)==2 && v(2)==3)), true);
+ TEST("v2*m",
+ ((v = v2 * m),
+ (v.size()==3 && v(0)==1 && v(1)==2 && v(2)==3)), true);
+ TEST("m*v3",
+ ((v = m * v3),
+ (v.size()==2 && v(0)==1 && v(1)==4)), true);
+}
+
+void vnl_vector_test_conversion()
+{
+ bool check;
+ {
+ // convert from a vnl_vector to a block array:
+ int v1values[] = {1,2,3, 4,5,6, 7,8,9, 10,11,12};
+ vnl_vector<int> v1 (12, 12, v1values);
+ const int* data = v1.data_block();
+ {
+ check = true;
+ for (int d = 0; d < 12; d++)
+ if (data[d] != d+1)
+ check = false;
+ }
+ TEST("(const int*) m.data_block", check, true);
+
+ typedef int block [12];
+ const block& v2 = *((const block*) data);
+ {
+ check = true;
+ for (int i = 0; i < 12; i++)
+ if (v1(i) != v2[i])
+ check = false;
+ }
+ TEST("matrix(i)==block[i]", check, true);
+
+ // convert from a block array to a vnl_vector:
+ block b1;
+ for (int i = 0; i < 12; i++)
+ b1[i] = i;
+ data = ((const int*) b1);
+ {
+ check = true;
+ for (int d = 0; d < 12; d++)
+ if (data[d] != d)
+ check = false;
+ }
+ TEST("(const int*) block", check, true);
+ vnl_vector<int> b2(data, 12);
+ {
+ check = true;
+ for (int i = 0; i < 12; i++)
+ if (b1[i] != b2(i))
+ check = false;
+ }
+ TEST("block[i]==matrix(i)", check, true);
+ }
+#if 0
+ {
+ // convert from a vnl_vector to a block array:
+ vnl_vector<double> v1 (12, 12,
+ 1.0,2.0,3.0, 4.0,5.0,6.0,
+ 7.0,8.0,9.0, 10.0,11.0,12.0);
+ const double* data = v1.data_block();
+ {
+ check = true;
+ for (int d = 0; d < 12; d++)
+ if (data[d] != d+1)
+ check = false;
+ }
+ TEST("(const double*) m.data_block", check, true);
+
+ typedef double block [12];
+ block& v2 = *((block*) data);
+ {
+ check = true;
+ for (int i = 0; i < 12; i++)
+ if (v1(i) != v2[i])
+ check = false;
+ }
+ TEST("matrix(i)==block[i]", check, true);
+
+ // convert from a block array to a vnl_vector:
+ block b1;
+ for (int i = 0; i < 12; i++)
+ b1[i] = i;
+ data = ((const double*) b1); // & in ((const double*) &b1)
+ { // is not needed
+ check = true;
+ for (int d = 0; d < 12; d++)
+ if (data[d] != d)
+ check = false;
+ }
+ TEST("(const double*) block", check, true);
+ vnl_vector<double> b2(data, 12);
+ {
+ check = true;
+ for (int i = 0; i < 12; i++)
+ if (b1[i] != b2(i))
+ check = false;
+ }
+ TEST("block[i]==matrix(i)", check, true);
+ }
+#endif
+}
+
+#ifndef TIMING
+#define TIMING 0
+#endif
+
+#if TIMING
+#include <vul/vul_timer.h>
+void vnl_vector_test_two_nrm2_timing(unsigned size, unsigned long num)
+{
+ vnl_vector<double> a(size);
+ for (unsigned i= 0; i < size; i++)
+ a(i) = i / size;
+
+ double c=0;
+ vul_timer t;
+ for (unsigned i = 0; i <num;i++)
+ c+= vnl_c_vector<double>::two_nrm2(a.begin(), size);
+ double time = t.real();
+ vcl_cout <<" Time for finding the two_nrm2 of " << size
+ <<"-D vectors " << num << "times = " << time / 1000.0 << "s.\n";
+}
+
+void vnl_vector_test_euclid_dist_sq_timing(unsigned size, unsigned long num)
+{
+ vnl_vector<double> a(size);
+ vnl_vector<double> b(size);
+ for (unsigned i= 0; i < size; i++)
+ {
+ a(i) = i / size;
+ b(i) = i * i / size;
+ }
+
+ double c=0;
+ vul_timer t;
+ for (unsigned i = 0; i <num;i++)
+ c+= vnl_c_vector<double>::euclid_dist_sq(a.begin(), b.begin(), size);
+ double time = t.real();
+ vcl_cout <<" Time for finding the euclid_dist_sq of " << size
+ <<"-D vectors " << num << "times = " << time / 1000.0 << "s.\n";
+}
+
+void vnl_vector_test_timing()
+{
+ vnl_vector_test_two_nrm2_timing(20000,20000ul);
+ vnl_vector_test_two_nrm2_timing(1000,400000ul);
+ vnl_vector_test_two_nrm2_timing(100,4000000ul);
+ vnl_vector_test_two_nrm2_timing(4,100000000ul);
+ vnl_vector_test_euclid_dist_sq_timing(40000,10000ul);
+ vnl_vector_test_euclid_dist_sq_timing(1000,400000ul);
+ vnl_vector_test_euclid_dist_sq_timing(100,4000000ul);
+ vnl_vector_test_euclid_dist_sq_timing(4,100000000ul);
+}
+#endif
+
+void vnl_vector_test_leak() // use top4.1 to watch for memory.
+{ // remember to kill process.
+ while (true) {
+ vnl_vector_test_int();
+ vnl_vector_test_matrix();
+ vnl_vector_test_conversion();
+ }
+}
+
+#ifndef LEAK
+#define LEAK 0
+#endif
+
+void test_vector()
+{
+ vnl_vector_test_int();
+ vnl_vector_test_float();
+ vnl_vector_test_matrix();
+ vnl_vector_test_conversion();
+#if TIMING
+ vnl_vector_test_timing();
+#endif
+#if LEAK
+ vnl_vector_test_leak();
+#endif
+}
+
+
+TESTMAIN(test_vector);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector_fixed_ref.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector_fixed_ref.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..b1489e32cc04052f230ef45a231effa0e3a112aa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/tests/test_vector_fixed_ref.cxx
@@ -0,0 +1,118 @@
+// This is core/vnl/tests/test_vector_fixed_ref.cxx
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_vector_fixed_ref.h>
+
+#include <vcl_algorithm.h> // for vcl_generate()
+#include <vcl_cstdlib.h> // for vcl_rand()
+#include <testlib/testlib_test.h>
+
+void test_vector_fixed_ref()
+{
+ enum{size = 4};
+ typedef vnl_vector_fixed<double,size> vf;
+ typedef vnl_vector_fixed_ref<double,size> vfr;
+ typedef vnl_vector_fixed_ref_const<double,size> vfrc;
+
+ int i;
+ vf vec; // copy in
+ for (i=0;i<size;++i)
+ {
+ vec(i) = i;
+ }
+
+ // vector fixed_ref tests
+
+
+ // fixed_ref_const
+ const vf & cvf = vec;
+ vfrc cref(cvf);
+ // check address
+ for (i=0;i<size;++i)
+ {
+ TEST("const_address",&cref(i),&vec(i));
+ }
+
+
+ // fixed_ref (non-const)
+ // wrap around vec
+ vfr ref(vec);
+ // check address
+ for (i=0;i<size;++i)
+ {
+ TEST("nonconst_address",&ref(i),&vec(i));
+ }
+
+
+ // assign from vec
+ vf other;
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+#if 0 // assignment is ambiguous
+ ref = other;
+ TEST("assign_vf", ref, other);
+ // test different adresses
+ TEST("assign_vf address", (ref.begin() != other.begin()), true);
+#endif // 0
+
+ {
+ // assign from const vfr
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+ vfrc cref(other);
+ ref = cref;
+ TEST("assign_const_ref", ref, other);
+ // test different adresses
+ TEST("assign_const_ref address", (ref.begin() != other.begin()), true);
+ }
+
+ {
+#if 0 // cannot assign to a vnl_vector_fixed_ref_const
+ // assign from vfr
+ vcl_generate(other.begin(),other.end(),vcl_rand);
+ vfr ref2(other);
+ ref = ref2;
+ TEST("assign_ref", ref, other);
+ // test different adresses
+ TEST("assign_ref address", (ref.begin() != other.begin()), true);
+#endif // 0
+ }
+
+ // arithmetic
+ {
+ // plus
+ vf a,b;
+ vcl_generate(a.begin(),a.end(),vcl_rand);
+ vcl_generate(b.begin(),b.end(),vcl_rand);
+ vfrc arefc(a), brefc(b);
+ vf mc = arefc + brefc;
+
+ vfr aref(a), bref(b);
+ vf m = aref + bref;
+
+ vf m2 = arefc + bref;
+ vf m3 = arefc + brefc;
+ TEST("plus", mc, m);
+ TEST("plus", mc, m2);
+ TEST("plus", mc, m3);
+ }
+ {
+ // times
+ vf a,b;
+ vcl_generate(a.begin(),a.end(),vcl_rand);
+ vcl_generate(b.begin(),b.end(),vcl_rand);
+ vfrc arefc(a), brefc(b);
+ vf mc = arefc + brefc;
+
+ vfr aref(a), bref(b);
+ vf m = aref + bref;
+
+ vf m2 = arefc + bref;
+ vf m3 = arefc + brefc;
+ TEST("plus", mc, m);
+ TEST("plus", mc, m2);
+ TEST("plus", mc, m3);
+
+ aref.is_zero();
+ arefc.is_zero();
+ }
+}
+
+TESTMAIN(test_vector_fixed_ref)
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_T_n.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_T_n.h
new file mode 100644
index 0000000000000000000000000000000000000000..627ce98085da5af11a588d09a751efc0bb567476
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_T_n.h
@@ -0,0 +1,44 @@
+// This is core/vnl/vnl_T_n.h
+#ifndef vnl_T_n_h_
+#define vnl_T_n_h_
+//:
+// \file
+// \author fsm
+//
+// Purpose: the vnl_vector_fixed<T,n> template class provides
+// non-mallocing vectors of given size, but it has no constructor
+// from n Ts. This macro declares a class vnl_T_n which is derived
+// directly from vnl_vector_fixed<T,n> and has such a constructor.
+//
+// Inspired by the numerous double-3, int-2 things lying around.
+
+#include <vnl/vnl_vector_fixed.h>
+
+//: cpp traits!
+#define vnl_T_n_aux_1(T) (T x) { data_[0] = x; }
+#define vnl_T_n_aux_2(T) (T x, T y) { data_[0] = x; data_[1] = y; }
+#define vnl_T_n_aux_3(T) (T x, T y, T z) { data_[0] = x; data_[1] = y; data_[2] = z; }
+#define vnl_T_n_aux_4(T) (T x, T y, T z, T w) { data_[0] = x; data_[1] = y; data_[2] = z; data_[3] = w; }
+#define vnl_T_n_aux_5(T) (T x, T y, T z, T w, T u) { data_[0] = x; data_[1] = y; data_[2] = z; data_[3] = w; data_[4]= u; }
+
+//: this macro defines the class.
+// e.g. use vnl_T_n_impl(int,2) to implement class vnl_int_2.
+#define vnl_T_n_class_impl(T,n) \
+class vnl_##T##_##n : public vnl_vector_fixed<T ,n> \
+{ \
+ public: \
+ vnl_##T##_##n() { } \
+ vnl_##T##_##n(vnl_vector<T > const & rhs) : vnl_vector_fixed<T ,n>(rhs) { } \
+ vnl_##T##_##n(vnl_vector_fixed<T ,n> const & rhs) : vnl_vector_fixed<T ,n>(rhs) { } \
+ vnl_##T##_##n vnl_T_n_aux_##n(T) \
+};
+
+// some compilers need a bit of help with the overload resolution.
+#define vnl_T_n_funcs_impl(T,n) /* no need */
+
+//: clients use this.
+#define vnl_T_n_impl(T,n) \
+vnl_T_n_class_impl(T,n) \
+vnl_T_n_funcs_impl(T,n)
+
+#endif // vnl_T_n_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a7a82b1e565893895e88a941d9430bf07c73430e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.cxx
@@ -0,0 +1,142 @@
+// This is core/vnl/vnl_alloc.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+
+#include "vnl_alloc.h"
+
+#include <vcl_cstring.h> // memcpy() lives here.
+#include <vcl_cstdlib.h>
+
+char*
+vnl_alloc::chunk_alloc(vcl_size_t size, int& nobjs)
+{
+ char * result;
+ vcl_size_t total_bytes = size * nobjs;
+ vcl_size_t bytes_left = end_free - start_free;
+
+ if (bytes_left >= total_bytes) {
+ result = start_free;
+ start_free += total_bytes;
+ return result;
+ } else if (bytes_left >= size) {
+ nobjs = bytes_left/size;
+ total_bytes = size * nobjs;
+ result = start_free;
+ start_free += total_bytes;
+ return result;
+ } else {
+ vcl_size_t bytes_to_get = 2 * total_bytes + ROUND_UP(heap_size >> 4);
+ // Try to make use of the left-over piece.
+ if (bytes_left > 0) {
+ obj * * my_free_list =
+ free_list + FREELIST_INDEX(bytes_left);
+ ((obj *)start_free) -> free_list_link = *my_free_list;
+ *my_free_list = (obj *)start_free;
+ }
+ start_free = (char*)vcl_malloc(bytes_to_get);
+ if (0 == start_free) {
+ obj * * my_free_list, *p;
+ // Try to make do with what we have. That can't
+ // hurt. We do not try smaller requests, since that tends
+ // to result in disaster on multi-process machines.
+ for (unsigned int i = size; i <= VNL_ALLOC_MAX_BYTES; i += VNL_ALLOC_ALIGN)
+ {
+ my_free_list = free_list + FREELIST_INDEX(i);
+ p = *my_free_list;
+ if (0 != p) {
+ *my_free_list = p -> free_list_link;
+ start_free = (char *)p;
+ end_free = start_free + i;
+ return chunk_alloc(size, nobjs);
+ // Any leftover piece will eventually make it to the
+ // right free vcl_list.
+ }
+ }
+ start_free = (char*)vcl_malloc(bytes_to_get);
+ // This should either throw an
+ // exception or remedy the situation. Thus we assume it
+ // succeeded.
+ }
+ heap_size += bytes_to_get;
+ end_free = start_free + bytes_to_get;
+ return chunk_alloc(size, nobjs);
+ }
+}
+
+
+/* Returns an object of size n, and optionally adds to size n free vcl_list.*/
+/* We assume that n is properly aligned. */
+/* We hold the allocation lock. */
+void* vnl_alloc::refill(vcl_size_t n)
+{
+ int nobjs = 20;
+ char * chunk = chunk_alloc(n, nobjs);
+ obj * * my_free_list;
+ obj * result;
+ obj * current_obj, * next_obj;
+ int i;
+
+ if (1 == nobjs) return chunk;
+ my_free_list = free_list + FREELIST_INDEX(n);
+
+ /* Build free vcl_list in chunk */
+ result = (obj *)chunk;
+ *my_free_list = next_obj = (obj *)(chunk + n);
+ for (i = 1; ; i++) {
+ current_obj = next_obj;
+ next_obj = (obj *)((char *)next_obj + n);
+ if (nobjs - 1 == i) {
+ current_obj -> free_list_link = 0;
+ break;
+ } else {
+ current_obj -> free_list_link = next_obj;
+ }
+ }
+ return result;
+}
+
+void*
+vnl_alloc::reallocate(void *p,
+ vcl_size_t old_sz,
+ vcl_size_t new_sz)
+{
+ void * result;
+ vcl_size_t copy_sz;
+
+ if (old_sz > VNL_ALLOC_MAX_BYTES && new_sz > VNL_ALLOC_MAX_BYTES) {
+ return vcl_realloc(p, new_sz);
+ }
+ if (ROUND_UP(old_sz) == ROUND_UP(new_sz)) return p;
+ result = allocate(new_sz);
+ copy_sz = new_sz > old_sz? old_sz : new_sz;
+ vcl_memcpy(result, p, copy_sz);
+ deallocate(p, old_sz);
+ return result;
+}
+
+char *vnl_alloc::start_free = 0;
+char *vnl_alloc::end_free = 0;
+vcl_size_t vnl_alloc::heap_size = 0;
+
+vnl_alloc::obj *
+vnl_alloc::free_list[VNL_ALLOC_NFREELISTS]
+= {
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+};
+// The 32 zeros are necessary to make version 4.1 of the SunPro
+// compiler happy. Otherwise it appears to allocate too little
+// space for the array.
+
+#ifdef TEST
+#include <vcl_iostream.h>
+int main()
+{
+ char* p = (char*)vnl_alloc::allocate(10);
+ vcl_strcpy(p, "fred\n");
+ vcl_cerr << p << '\n';
+ vnl_alloc::deallocate(p,10);
+}
+
+#endif // TEST
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.h
new file mode 100644
index 0000000000000000000000000000000000000000..098fac02c2dda0d7cb5783906463156ab2c48c8a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_alloc.h
@@ -0,0 +1,126 @@
+// This is core/vnl/vnl_alloc.h
+#ifndef vnl_alloc_h_
+#define vnl_alloc_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author unknown
+//
+// \brief Default node allocator.
+//
+// With a reasonable compiler, this should be roughly as fast as the
+// original STL class-specific allocators, but with less fragmentation.
+// Default_alloc_template parameters are experimental and MAY
+// DISAPPEAR in the future. Clients should just use vcl_alloc for now.
+//
+// Important implementation properties:
+// - If the client request an object of size > __MAX_BYTES, the resulting
+// object will be obtained directly from malloc.
+// - In all other cases, we allocate an object of size exactly
+// ROUND_UP(requested_size). Thus the client has enough size
+// information that we can return the object to the proper free li*st
+// without permanently losing part of the object.
+//
+// The first template parameter specifies whether more than one thread
+// may use this allocator. It is safe to allocate an object from
+// one instance of a default_alloc and deallocate it with another
+// one. This effectively transfers its ownership to the second one.
+// This may have undesirable effects on reference locality.
+// The second parameter is unreferenced and serves only to allow the
+// creation of multiple default_alloc instances.
+//
+// Note that containers built on different allocator instances have
+// different types, limiting the utility of this approach.
+
+#include <vcl_cstddef.h> // size_t lives here
+
+const int VNL_ALLOC_ALIGN = 8;
+const vcl_size_t VNL_ALLOC_MAX_BYTES = 256;
+const vcl_size_t VNL_ALLOC_NFREELISTS = VNL_ALLOC_MAX_BYTES/VNL_ALLOC_ALIGN;
+
+class vnl_alloc
+{
+ static vcl_size_t ROUND_UP(vcl_size_t bytes) {
+ return (bytes + VNL_ALLOC_ALIGN-1) & ~(VNL_ALLOC_ALIGN - 1);
+ }
+ union obj;
+ friend union obj;
+ union obj {
+ union obj * free_list_link;
+ char client_data[1]; /* The client sees this. */
+ };
+# if defined ( __SUNPRO_CC ) || defined ( _AIX )
+ static obj * free_list[];
+ // Specifying a size results in duplicate def for 4.1
+# else
+ static obj * free_list[VNL_ALLOC_NFREELISTS];
+# endif
+ static vcl_size_t FREELIST_INDEX(vcl_size_t bytes) {
+ return (bytes + VNL_ALLOC_ALIGN-1)/VNL_ALLOC_ALIGN - 1;
+ }
+
+ // Returns an object of size n, and optionally adds to size n free li*st.
+ static void *refill(vcl_size_t n);
+ // Allocates a chunk for nobjs of size size. nobjs may be reduced
+ // if it is inconvenient to allocate the requested number.
+ static char *chunk_alloc(vcl_size_t size, int &nobjs);
+
+ // Chunk allocation state.
+ static char *start_free;
+ static char *end_free;
+ static vcl_size_t heap_size;
+
+ class lock
+ {
+ public:
+ lock() {}
+ ~lock() {}
+ };
+ friend class lock;
+
+ public:
+ // this one is needed for proper vcl_simple_alloc wrapping
+ typedef char value_type;
+
+ /* n must be > 0 */
+ static void * allocate(vcl_size_t n) {
+ obj * * my_free_list;
+ obj * result;
+
+ if (n > VNL_ALLOC_MAX_BYTES) {
+ return (void*)new char[n];
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ // Acquire the lock here with a constructor call.
+ // This ensures that it is released in exit or during stack
+ // unwinding.
+ result = *my_free_list;
+ if (result == 0) {
+ void *r = refill(ROUND_UP(n));
+ return r;
+ }
+ *my_free_list = result -> free_list_link;
+ return result;
+ };
+
+ /* p may not be 0 */
+ static void deallocate(void *p, vcl_size_t n)
+ {
+ obj *q = (obj *)p;
+ obj * * my_free_list;
+
+ if (n > VNL_ALLOC_MAX_BYTES) {
+ delete [] (char*)p;
+ return;
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ q -> free_list_link = *my_free_list;
+ *my_free_list = q;
+ }
+
+ static void * reallocate(void *p, vcl_size_t old_sz, vcl_size_t new_sz);
+};
+
+# endif // vnl_alloc_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_analytic_integrant.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_analytic_integrant.h
new file mode 100644
index 0000000000000000000000000000000000000000..3f43606834b530c7d95630d232705e9e621c5427
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_analytic_integrant.h
@@ -0,0 +1,22 @@
+#ifndef VNL_ANALYTIC_INTEGRANT
+#define VNL_ANALYTIC_INTEGRANT
+
+// :
+// \author Kongbin Kang
+// \date Jan 13, 2005
+// \brief a class to represent an analytic integrant
+
+#include "vnl_integrant_fnct.h"
+
+class vnl_analytic_integrant : public vnl_integrant_fnct
+{
+ public:
+ vnl_analytic_integrant() {}
+ ~vnl_analytic_integrant() {}
+
+ // the function every derived class has to implement, which is evalutate
+ // the function value at point x
+ virtual double f_(double /*x*/) = 0;
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..4d1a6e79ddd63cfffa58713b7d5e302ba0a221ad
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.cxx
@@ -0,0 +1,95 @@
+// This is core/vnl/vnl_bessel.cxx
+#include "vnl_bessel.h"
+#include <vcl_algorithm.h>
+
+//:
+// \file
+// \brief Bessel functions of the first kind
+// \author Tim Cootes
+
+//: Compute Bessel functions of first kind up to order n_max.
+// On exit, J[i] = J_i(x) for i=0..n_max
+//
+// Uses recurrence relation: J_(n-1)(x)+J_(n+1)=(2n/x)J_n(x)
+// Thus J_n(x) = (2(n+1)/x)J_(n+1)(x) - J_(n+2)(x)
+// Start with arbitrary guess for high n and work backwards.
+// Normalise suitably.
+void vnl_bessel(unsigned n_max, double x, vnl_vector<double>& J)
+{
+ if (x==0.0)
+ {
+ J.set_size(1+n_max);
+ J.fill(0.0);
+ J[0]=1.0;
+ return;
+ }
+ int nhi = 2*((vcl_max(int(n_max),int(x))+15)/2+1);
+ vnl_vector<double> j(nhi+1);
+ j[nhi]=0.0;
+ j[nhi-1]=1.0;
+ for (int m=nhi-2; m>=0; --m)
+ j[m]=2*(m+1)*j[m+1]/x - j[m+2];
+
+ // Normalise and return first (1+n_max) values
+ double sum=j[0];
+ for (int m=2;m<=nhi;m+=2) sum+=2*j[m];
+
+ J.set_size(1+n_max);
+ for (unsigned int m=0; m<=n_max; ++m) J[m]=j[m]/sum;
+}
+
+//: Returns J_0(x), the value of the Bessel function of order 0 at x.
+// Bessel function of the first kind of order zero.
+//
+// Uses recurrence relation: J_(n-1)(x)+J_(n+1)=(2n/x)J_n(x)
+double vnl_bessel0(double x)
+{
+ if (x==0) return 1.0;
+ int nhi = 2*((int(x)+15)/2); // Even
+ double j3=0.0;
+ double j2=1.0;
+ double j0=j2,j1;
+ double even_sum=j2;
+ for (int i=nhi;i>=0;i-=2)
+ {
+ // j0 is i-th term, j1 is i+1-th etc
+ j1=2*(i+2)*j2/x - j3;
+ j0=2*(i+1)*j1/x - j2;
+ even_sum+=j0;
+ j3=j1;
+ j2=j0;
+ }
+ return j0/(2*even_sum-j0);
+}
+
+//: Returns J_n(x), the value of the Bessel function of order n at x.
+// Bessel function of the first kind of order zero.
+//
+// Uses recurrence relation: J_(n-1)(x)+J_(n+1)=(2n/x)J_n(x)
+double vnl_bessel(unsigned n, double x)
+{
+ if (x==0)
+ {
+ if (n==0) return 1.0;
+ else return 0.0;
+ }
+
+ int nhi = 2*((vcl_max(int(n),int(x))+15)/2+1);
+ double j3=0.0;
+ double j2=1.0;
+ double j0=j2,j1;
+ double even_sum=j2;
+ double jn=j0;
+ for (int i=nhi; i>=0; i-=2)
+ {
+ // j0 is i-th term, j1 is i+1-th etc
+ j1=2*(i+2)*j2/x - j3;
+ j0=2*(i+1)*j1/x - j2;
+ even_sum+=j0;
+ j3=j1;
+ j2=j0;
+ if ((unsigned int)i==n) jn=j0;
+ else if ((unsigned int)i+1==n) jn=j1;
+ }
+ return jn/(2*even_sum-j0);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.h
new file mode 100644
index 0000000000000000000000000000000000000000..4a78ade94a49eae3f6797eb21517954051c1cd1d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bessel.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_bessel.h
+#ifndef vnl_bessel_h_
+#define vnl_bessel_h_
+//:
+// \file
+// \brief Bessel functions of the first kind
+// \author Tim Cootes
+
+#include <vnl/vnl_vector.h>
+
+//: Returns J_n(x), the value of the Bessel function of order n at x
+// Bessel function of the first kind of order n
+double vnl_bessel(unsigned n, double x);
+
+//: Returns J_0(x), the value of the Bessel function of order 0 at x
+// Bessel function of the first kind of order zero
+double vnl_bessel0(double x);
+
+//: Compute Bessel functions of first kind up to order n_max
+// On exit, J[i] = J_i(x) for i=0..n_max
+void vnl_bessel(unsigned n_max, double x, vnl_vector<double>& J);
+
+#endif // vnl_bessel_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7a35d9a207bb62dd88dae74533ede2babce74369
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.cxx
@@ -0,0 +1,1343 @@
+// This is core/vnl/vnl_bignum.cxx
+#include "vnl_bignum.h"
+//:
+// \file
+
+#include <vcl_cctype.h> // Include character macros
+#include <vcl_cstdlib.h> // for vcl_atol
+#include <vcl_cstring.h> // for vcl_strlen
+#include <vcl_cmath.h> // for vcl_fmod
+#include <vcl_algorithm.h> // for vcl_copy
+#include <vcl_vector.h>
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vcl_limits.h>
+#include <vnl/vnl_math.h> // for vnl_math_isfinite(double)
+
+typedef unsigned short Counter;
+typedef unsigned short Data;
+
+//: Creates a zero vnl_bignum.
+
+vnl_bignum::vnl_bignum ()
+: count(0), sign(1), data(0)
+{
+}
+
+//: Creates a vnl_bignum from a long integer.
+
+vnl_bignum::vnl_bignum (long l)
+: count(0), sign(1), data(0)
+{
+ if (l < 0) { // Get correct sign
+ l = -l; // Get absolute value of l
+ this->sign = -1;
+ }
+ Data buf[sizeof(l)]; // Temp buffer to store l in
+ Counter i = 0; // buffer index
+ while (l) { // While more bits in l
+ assert(i < sizeof(l)); // no more buffer space
+ buf[i] = Data(l); // Peel off lower order bits
+ l >>= 16; // Shift next bits into place
+ ++i;
+ }
+ if (i > 0)
+ this->data = new Data[this->count=i]; // Allocate permanent data
+
+ while (i--) // Save buffer into perm. data
+ this->data[i] = buf[i];
+}
+
+//: Creates a vnl_bignum from an integer.
+
+vnl_bignum::vnl_bignum (int l)
+: count(0), sign(1), data(0)
+{
+ if (l < 0) { // Get correct sign
+ l = -l; // Get absolute value of l
+ this->sign = -1;
+ }
+ Data buf[sizeof(l)]; // Temp buffer to store l in
+ Counter i = 0; // buffer index
+ while (l) { // While more bits in l
+ assert(i < sizeof(l)); // no more buffer space
+ buf[i] = Data(l); // Peel off lower order bits
+ l >>= 16; // Shift next bits into place
+ i++;
+ }
+ if (i > 0)
+ this->data = new Data[this->count=i]; // Allocate permanent data
+
+ while (i--) // Save buffer into perm. data
+ this->data[i] = buf[i];
+}
+
+//: Creates a vnl_bignum from an unsigned long integer.
+
+vnl_bignum::vnl_bignum (unsigned long l)
+: count(0), sign(1), data(0)
+{
+ Data buf[sizeof(l)]; // Temp buffer to store l in
+ Counter i = 0; // buffer index
+ while (l) { // While more bits in l
+ assert(i < sizeof(l)); // no more buffer space
+ buf[i] = Data(l); // Peel off lower order bits
+ l >>= 16; // Shift next bits into place
+ i++;
+ }
+ if (i > 0)
+ this->data = new Data[this->count=i]; // Allocate permanent data
+
+ while (i--) // Save buffer into perm. data
+ this->data[i] = buf[i];
+}
+
+//: Creates a vnl_bignum from an unsigned integer.
+
+vnl_bignum::vnl_bignum (unsigned int l)
+: count(0), sign(1), data(0)
+{
+ Data buf[sizeof(l)]; // Temp buffer to store l in
+ Counter i = 0; // buffer index
+ while (l) { // While more bits in l
+ assert(i < sizeof(l)); // no more buffer space
+ buf[i] = Data(l); // Peel off lower order bits
+ l >>= 16; // Shift next bits into place
+ i++;
+ }
+ if (i > 0)
+ this->data = new Data[this->count=i]; // Allocate permanent data
+
+ while (i--) // Save buffer into perm. data
+ this->data[i] = buf[i];
+}
+
+//: Creates a vnl_bignum from a single-precision floating point number.
+
+vnl_bignum::vnl_bignum (float f)
+: count(0), sign(1), data(0)
+{
+ double d = f;
+ if (d < 0.0) { // Get sign of d
+ d = -d; // Get absolute value of d
+ this->sign = -1;
+ }
+
+ if (!vnl_math_isfinite(d)) {
+ // Infinity is represented as: count=1, data[0]=0.
+ // This is an otherwise unused representation, since 0 is represented as count=0.
+ this->count = 1;
+ this->data = new Data[1];
+ this->data[0] = 0;
+ } else if (d >= 1.0) {
+ // Note: 0x10000L == 1 >> 16: the (assumed) size of unsigned short is 16 bits.
+ vcl_vector<Data> buf;
+ while (d >= 1.0) {
+ buf.push_back( Data(vcl_fmod(d,0x10000L)) ); // Get next data "digit" from d
+ d /= 0x10000L; // Shift d right 1 data "digit"
+ }
+ // Allocate and copy into permanent buffer
+ this->data = buf.size()>0 ? new Data[buf.size()] : 0;
+ this->count = buf.size();
+ vcl_copy( buf.begin(), buf.end(), data );
+ }
+}
+
+//: Creates a vnl_bignum from a double floating point number.
+
+vnl_bignum::vnl_bignum (double d)
+: count(0), sign(1), data(0)
+{
+ if (d < 0.0) { // Get sign of d
+ d = -d; // Get absolute value of d
+ this->sign = -1;
+ }
+
+ if (!vnl_math_isfinite(d)) {
+ // Infinity is represented as: count=1, data[0]=0.
+ // This is an otherwise unused representation, since 0 is represented as count=0.
+ this->count = 1;
+ this->data = new Data[1];
+ this->data[0] = 0;
+ } else if (d >= 1.0) {
+ // Note: 0x10000L == 1 >> 16: the (assumed) size of unsigned short is 16 bits.
+ vcl_vector<Data> buf;
+ while (d >= 1.0) {
+ buf.push_back( Data(vcl_fmod(d,0x10000L)) ); // Get next data "digit" from d
+ d /= 0x10000L; // Shift d right 1 data "digit"
+ }
+ // Allocate and copy into permanent buffer
+ this->data = buf.size()>0 ? new Data[buf.size()] : 0;
+ this->count = buf.size();
+ vcl_copy( buf.begin(), buf.end(), data );
+ }
+}
+
+//: Creates a vnl_bignum from a "long double" floating point number.
+
+vnl_bignum::vnl_bignum (long double d)
+: count(0), sign(1), data(0)
+{
+ if (d < 0.0) { // Get sign of d
+ d = -d; // Get absolute value of d
+ this->sign = -1;
+ }
+
+ if (!vnl_math_isfinite(d)) {
+ // Infinity is represented as: count=1, data[0]=0.
+ // This is an otherwise unused representation, since 0 is represented as count=0.
+ this->count = 1;
+ this->data = new Data[1];
+ this->data[0] = 0;
+ } else if (d >= 1.0) {
+ // Note: 0x10000L == 1 >> 16: the (assumed) size of unsigned short is 16 bits.
+ vcl_vector<Data> buf;
+ while (d >= 1.0) {
+ buf.push_back( Data(vcl_fmod(d,0x10000L)) ); // Get next data "digit" from d
+ d /= 0x10000L; // Shift d right 1 data "digit"
+ }
+ // Allocate and copy into permanent buffer
+ this->data = (buf.size()>0 ? new Data[buf.size()] : 0);
+ this->count = buf.size();
+ vcl_copy( buf.begin(), buf.end(), data );
+ }
+}
+
+
+#if 0 // old, original Texas Instruments implementation - PVr
+
+static bool is_decimal(const char *s)
+{
+ if (*s == '+' || *s == '-') ++s;
+ if (*s < '1' || *s > '9') return false;
+ while (*s >= '0' && *s <= '9') ++s;
+ if (*s == 'l' || *s == 'L') ++s;
+ return *s == '\0';
+}
+
+static bool is_exponential(const char *s)
+{
+ if (*s == '+' || *s == '-') ++s;
+ if (*s < '1' || *s > '9') return false;
+ while (*s >= '0' && *s <= '9') ++s;
+ if (*s != 'e' && *s != 'E') return false;
+ ++s;
+ if (*s < '1' || *s > '9') return false;
+ while (*s >= '0' && *s <= '9') ++s;
+ return *s == '\0';
+}
+
+static bool is_hexadecimal(const char *s)
+{
+ if (*s == '+' || *s == '-') ++s;
+ if (*s != '0') return false;
+ ++s;
+ if (*s != 'x' && *s != 'X') return false;
+ ++s;
+ if ((*s < '0' || *s > '9') &&
+ (*s < 'a' || *s > 'f') &&
+ (*s < 'A' || *s > 'F')) return false;
+ while ((*s >= '0' && *s <= '9') ||
+ (*s >= 'a' && *s <= 'f') ||
+ (*s >= 'A' && *s <= 'F')) ++s;
+ if (*s == 'l' || *s == 'L') ++s;
+ return *s == '\0';
+}
+
+static bool is_octal(const char *s)
+{
+ if (*s == '+' || *s == '-') ++s;
+ if (*s != '0') return false;
+ while (*s >= '0' && *s <= '7') ++s;
+ if (*s == 'l' || *s == 'L') ++s;
+ return *s == '\0';
+}
+
+#else // new implementation, also to be used for operator>> - PVr
+
+static char rt[4096];
+static int rt_pos = 0;
+
+static char next(const char*& s, vcl_istream** is)
+{
+ if (!is || *s) { char c = *s; if (c) ++rt_pos, ++s; return c; }
+ if (rt_pos == 4096) return '\0';
+ (*is)->get(rt[rt_pos]); // read a single byte from istream
+ if (*s) ++s; // in case s == rt+rt_pos
+ rt[++rt_pos] = '\0'; return rt[rt_pos-1];
+}
+
+static bool is_decimal(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c == '+' || c == '-') c = next(s,is);
+ if (c < '1' || c > '9') return false;
+ while (c >= '0' && c <= '9') c = next(s,is);
+ if (c == 'l' || c == 'L') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+static bool is_exponential(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c == '+' || c == '-') c = next(s,is);
+ if (c < '1' || c > '9') return false;
+ while (c >= '0' && c <= '9') c = next(s,is);
+ if (c != 'e' && c != 'E') return false;
+ c = next(s,is);
+ if (c == '+') c = next(s,is); // no negative exponent!
+ if (c < '0' || c > '9') return false;
+ while (c >= '0' && c <= '9') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+static bool is_hexadecimal(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c == '+' || c == '-') c = next(s,is);
+ if (c != '0') return false;
+ c = next(s,is);
+ if (c != 'x' && c != 'X') return false;
+ c = next(s,is);
+ if ((c < '0' || c > '9') &&
+ (c < 'a' || c > 'f') &&
+ (c < 'A' || c > 'F')) return false;
+ while ((c >= '0' && c <= '9') ||
+ (c >= 'a' && c <= 'f') ||
+ (c >= 'A' && c <= 'F')) c = next(s,is);
+ if (c == 'l' || c == 'L') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+static bool is_octal(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c == '+' || c == '-') c = next(s,is);
+ if (c != '0') return false;
+ while (c >= '0' && c <= '7') c = next(s,is);
+ if (c == 'l' || c == 'L') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+static bool is_plus_inf(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c == '+') c = next(s,is);
+ if (c != 'I') return false; c = next(s,is);
+ if (c != 'n') return false; c = next(s,is);
+ if (c != 'f') return false; c = next(s,is);
+ if (c == 'i') c = next(s,is);
+ if (c == 'n') c = next(s,is);
+ if (c == 'i') c = next(s,is);
+ if (c == 't') c = next(s,is);
+ if (c == 'y') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+static bool is_minus_inf(const char* s, vcl_istream** is = 0)
+{
+ rt_pos = 0;
+ char c = next(s,is);
+ while (c == ' ' || c == '\t' || c == '\n' || c == '\r') c = next(s,is);
+ if (c != '-') return false; c = next(s,is);
+ if (c != 'I') return false; c = next(s,is);
+ if (c != 'n') return false; c = next(s,is);
+ if (c != 'f') return false; c = next(s,is);
+ if (c == 'i') c = next(s,is);
+ if (c == 'n') c = next(s,is);
+ if (c == 'i') c = next(s,is);
+ if (c == 't') c = next(s,is);
+ if (c == 'y') c = next(s,is);
+ if (rt_pos > 0) rt[++rt_pos] = '\0';
+ return is ? true : c == '\0';
+}
+
+#endif // new implementation - PVr
+
+//: Creates a vnl_bignum from the character string representation.
+
+vnl_bignum::vnl_bignum (const char *s)
+: count(0), sign(1), data(0)
+{
+ // decimal: "^ *[-+]?[1-9][0-9]*$"
+ // exponential: "^ *[-+]?[1-9][0-9]*[eE][+]?[0-9]+$"
+ // hexadecimal: "^ *[-+]?0[xX][0-9a-fA-F]+$"
+ // octal: "^ *[-+]?0[0-7]*$"
+ // infinity: "^ *[-+]?Inf(inity)?$"
+
+ if (is_plus_inf(s))
+ sign=1,count=1,data=new Data[1],data[0]=0;
+ else if (is_minus_inf(s))
+ sign=-1,count=1,data=new Data[1],data[0]=0;
+ else if (is_decimal(s)) // If string is decimal
+ this->dtoBigNum(s); // convert decimal to vnl_bignum
+ else if (is_exponential(s)) // If string is exponential
+ this->exptoBigNum(s); // convert exp. to vnl_bignum
+ else if (is_hexadecimal(s)) // If string is hex,
+ this->xtoBigNum(s); // convert hex to vnl_bignum
+ else if (is_octal(s)) // If string is octal
+ this->otoBigNum(s); // convert octal to vnl_bignum
+ else { // Otherwise
+ vcl_cerr << "Cannot convert string " << s << " to vnl_bignum\n";
+ }
+}
+
+//: Reads a vnl_bignum from a stream
+
+vcl_istream& operator>> (vcl_istream& is, vnl_bignum& x)
+{
+ // decimal: "^ *[-+]?[1-9][0-9]*$"
+ // exponential: "^ *[-+]?[1-9][0-9]*[eE][+]?[0-9]+$"
+ // hexadecimal: "^ *[-+]?0[xX][0-9a-fA-F]+$"
+ // octal: "^ *[-+]?0[0-7]*$"
+ vcl_istream* isp = &is;
+ rt[0] = '\0';
+
+ if (is_plus_inf(rt,&isp))
+ x.sign=1,x.count=1,x.data=new Data[1],x.data[0]=0;
+ else if (is_minus_inf(rt,&isp))
+ x.sign=-1,x.count=1,x.data=new Data[1],x.data[0]=0;
+ if (is_exponential(rt,&isp)) // If input stream string is exponential
+ x.exptoBigNum(rt); // convert exp. to vnl_bignum
+ else if (is_decimal(rt,&isp)) // If string is decimal
+ x.dtoBigNum(rt); // convert decimal to vnl_bignum
+ else if (is_hexadecimal(rt,&isp)) // If string is hex,
+ x.xtoBigNum(rt); // convert hex to vnl_bignum
+ else if (is_octal(rt,&isp)) // If string is octal
+ x.otoBigNum(rt); // convert octal to vnl_bignum
+ else { // Otherwise
+ vcl_cerr << "Cannot convert string " << rt << " to vnl_bignum\n";
+ x = 0L;
+ }
+ return is; // FIXME - should probably push back read characters to istream
+}
+
+//: Copies the contents of vnl_bignum b.
+
+vnl_bignum::vnl_bignum (const vnl_bignum& b)
+: count(b.count), sign(b.sign)
+{
+ this->data = b.data ? new Data[b.count] : 0; // Allocate data if necessary
+ for (Counter i = 0; i < this->count; ++i) // Copy b data
+ this->data[i] = b.data[i];
+}
+
+
+//: Frees space for vnl_bignum.
+
+vnl_bignum::~vnl_bignum ()
+{
+ delete [] this->data; this->count = 0; // Delete any allocated data
+}
+
+//: Copies rhs vnl_bignum to lhs vnl_bignum.
+
+vnl_bignum& vnl_bignum::operator= (const vnl_bignum& rhs)
+{
+ if (this != &rhs) { // Avoid self-assignment
+ delete [] this->data; // Delete existing data
+ this->count = rhs.count; // Copy rhs's count
+ this->data = rhs.data ? new Data[rhs.count] : 0; // Allocate data if necessary
+ for (Counter i = 0; i < rhs.count; ++i) // Copy rhs's data
+ this->data[i] = rhs.data[i];
+ this->sign = rhs.sign; // Copy rhs's sign
+ }
+ return *this; // Return reference
+}
+
+//: Returns the negation of a vnl_bignum.
+
+vnl_bignum vnl_bignum::operator- () const
+{
+ vnl_bignum neg(*this);
+ if (neg.count) // So long as this is non-zero
+ neg.sign = -neg.sign; // Flip its sign
+ return neg;
+}
+
+
+//: Prefix increment. Increments a vnl_bignum by 1, and returns it.
+
+vnl_bignum& vnl_bignum::operator++ ()
+{
+ if (this->is_infinity()) return *this;
+ if (this->count==0)
+ {
+ this->resize(1);
+ this->data[0] = 1;
+ this->sign = +1;
+ return *this;
+ }
+
+ if (this->sign > 0) increment(*this);
+ else decrement(*this);
+
+ return *this;
+}
+
+
+//: Prefix decrement. Decrements a vnl_bignum by 1, and returns it.
+
+vnl_bignum& vnl_bignum::operator-- ()
+{
+ if (this->is_infinity()) return *this;
+ if (this->count==0)
+ {
+ this->resize(1);
+ this->data[0] = 1;
+ this->sign = -1;
+ return *this;
+ }
+
+ if (this->sign < 0) increment(*this);
+ else decrement(*this);
+
+ return *this;
+}
+
+//: Adds two vnl_bignums, and returns new sum.
+
+vnl_bignum vnl_bignum::operator+(const vnl_bignum& b) const
+{
+ // Infinity arithmetic:
+ assert (! b.is_minus_infinity() || ! this->is_plus_infinity() ); // +Inf-Inf
+ assert (! b.is_plus_infinity() || ! this->is_minus_infinity() ); // -Inf+Inf
+ if (b.is_infinity()) { return b; }
+ if (this->is_infinity()) { return *this; }
+
+ vnl_bignum sum; // Init sum to zero
+ if (this->sign == b.sign) { // If both have same sign
+ add(*this,b,sum); // Do simple addition
+ sum.sign = this->sign; // Attach proper sign
+ }
+ else { // Else different signs
+ int mag = magnitude_cmp(*this,b); // Determine relative sizes
+ if (mag > 0) { // If abs(*this) > abs(b)
+ subtract(*this,b,sum); // sum = *this - b
+ sum.sign = this->sign; // Sign of sum follows *this
+ }
+ else if (mag < 0) { // Else if abs(*this) < abs(b)
+ subtract(b,*this,sum); // sum = b - *this
+ sum.sign = b.sign; // Sign of sum follows b
+ } // (Else abs(*this) == abs(b)
+ } // so sum must be zero)
+ return sum; // shallow swap on return
+}
+
+
+//: Multiplies this with a vnl_bignum
+
+vnl_bignum& vnl_bignum::operator*= (const vnl_bignum& b)
+{
+ // Infinity arithmetic:
+ assert (! b.is_infinity() || this->count != 0 ); // multiplication 0*Inf
+ assert (! this->is_infinity() || b.count != 0 ); // multiplication Inf*0
+ if (b.is_infinity()) return (*this) = (this->sign<0 ? -b : b);
+ if (this->is_infinity()) return (*this) = (b.sign<0 ? -(*this) : *this);
+
+ if (b.count == 0 || this->count == 0)
+ return (*this)=0L;
+ vnl_bignum prod;
+ prod.data = new Data[prod.count = this->count + b.count]; // allocate data for product
+ for (Counter i = 0; i < b.count; i++) // multiply each b "digit"
+ multiply_aux(*this, b.data[i], prod, i); // times b1 and add to total
+ prod.sign = this->sign * b.sign; // determine correct sign
+ prod.trim(); // trim excess data and ret.
+ return (*this)=prod;
+}
+
+
+//: Divides this by a vnl_bignum
+
+vnl_bignum& vnl_bignum::operator/= (const vnl_bignum& b)
+{
+ // Infinity arithmetic:
+ assert (! b.is_infinity() || ! this->is_infinity() ); // division Inf/Inf
+ if (b.is_infinity()) return (*this)=0L;
+ if (this->is_infinity()) return (*this) = (b.sign<0 ? -(*this) : *this);
+ assert (b.count!=0 || this->count != 0); // division 0/0
+ if (b.count == 0)
+ return (*this) = (this->sign < 0 ? vnl_bignum("-Inf") : vnl_bignum("+Inf"));
+
+ vnl_bignum quot, r; // Quotient and remainder
+ divide(*this,b,quot,r); // Call divide fn
+ return (*this) = quot;
+}
+
+//: Divides this by a vnl_bignum and replaces this by remainder.
+
+vnl_bignum& vnl_bignum::operator%= (const vnl_bignum& b)
+{
+ // Infinity arithmetic:
+ assert (! b.is_infinity() || ! this->is_infinity() ); // division Inf/Inf
+ if (b.is_infinity()) return *this; // remainder of x/Inf is x.
+ if (this->is_infinity()) return (*this) = 0L; // convention: remainder is 0
+ assert (b.count!=0 || this->count != 0); // division 0/0
+ if (b.count == 0) return (*this) = 0L; // convention: remainder is 0
+
+ vnl_bignum remain, q; // Quotient and remainder
+ divide(*this,b,q,remain); // divide by b and save remainder
+ return (*this) = remain; // shallow swap on return
+}
+
+
+//: Shifts bignum to the left l digits.
+
+vnl_bignum vnl_bignum::operator<< (int l) const
+{
+ // Infinity arithmetic:
+ if (this->is_infinity()) return *this;
+
+ if (l == 0 || *this == 0L) // if either arg is zero
+ return *this;
+ if (l < 0) // if shift amt is negative
+ return right_shift(*this,-l); // do an actual right shift
+ else // otherwise
+ return left_shift(*this,l); // do a left shift
+}
+
+
+//: Shifts bignum to the right l digits.
+
+vnl_bignum vnl_bignum::operator>> (int l) const
+{
+ // Infinity arithmetic:
+ if (this->is_infinity()) return *this;
+
+ if (l == 0 || *this == 0L) // if either arg is zero
+ return *this;
+ if (l < 0) // if shift amt is negative
+ return left_shift(*this,-l); // do an actual left shift
+ else // else
+ return right_shift(*this,l); // do a right shift
+}
+
+
+//: Two vnl_bignums are equal if and only if they have the same integer representation.
+
+bool vnl_bignum::operator== (const vnl_bignum& rhs) const
+{
+ if (this != &rhs) { // Check address
+ if (this->sign != rhs.sign) return false; // Different sign implies !=
+ if (this->count != rhs.count) return false; // Different size implies !=
+ for (Counter i = 0; i < this->count; i++) // Each data element the same?
+ if (this->data[i] != rhs.data[i]) return false; // No. Return !=
+ }
+ return true; // Yes. Return ==
+}
+
+
+//: Compares two vnl_bignums.
+
+bool vnl_bignum::operator< (const vnl_bignum& rhs) const
+{
+ if (this->sign < rhs.sign) return true; // Different signs?
+ if (this->sign > rhs.sign) return false;
+ if (this->sign == 1) // Both signs == 1
+ return magnitude_cmp(*this,rhs) < 0; // this must be smaller
+ else // Both signs == -1
+ return magnitude_cmp(*this,rhs) > 0; // this must be larger
+}
+
+
+//: Formatted output for bignum.
+
+vcl_ostream& operator<< (vcl_ostream& os, const vnl_bignum& b)
+{
+ vnl_bignum d = b; // Copy the input vnl_bignum
+ if (d.sign == -1) { // If it's negative
+ os << '-'; // Output leading minus sign
+ d.sign = 1; // Make d positive for divide
+ }
+ if (d.is_infinity()) return os<<"Inf";
+ vnl_bignum q,r; // Temp quotient and remainder
+ char *cbuf = new char[5 * (b.count+1)]; // Temp character buffer
+ Counter i = 0;
+ do { // repeat:
+ divide(d,10L,q,r); // Divide vnl_bignum by ten
+ cbuf[i++] = char(long(r) + '0'); // Get one's digit
+ d = q; // Then discard one's digit
+ q = r = 0L; // Prep for next divide
+ } while (d != 0L); // until no more one's digits
+ do { // repeat;
+ os << cbuf[--i]; // output char buf in reverse
+ } while (i); // until no more chars
+ delete [] cbuf; // delete temp char buf
+ return os; // return output stream
+}
+
+//: Convert the number to a decimal representation in a string.
+vcl_string& vnl_bignum_to_string (vcl_string& s, const vnl_bignum& b)
+{
+ s.erase();
+ vcl_string::size_type insert_point = 0; // keep record of location of first number.
+
+ vnl_bignum d = b; // Copy the input vnl_bignum
+ if (d.sign == -1) { // If it's negative
+ s.insert(insert_point,"-"); // Output leading minus sign
+ d.sign = 1; // Make d positive for divide
+ ++insert_point; // keep record of location of first number.
+ }
+ if (d.is_infinity()) return s+="Inf";
+ vnl_bignum q,r; // Temp quotient and remainder
+ do { // repeat:
+ divide(d,10L,q,r); // Divide vnl_bignum by ten
+ s.insert(insert_point, 1, char('0'+long(r))); // Get one's digit, and insert it at head.
+ d = q; // Then discard one's digit
+ q = r = 0L; // Prep for next divide
+ } while (d != 0L); // until no more one's digits
+ return s;
+}
+
+//: Convert the number from a decimal representation in a string.
+vnl_bignum& vnl_bignum_from_string (vnl_bignum& b, const vcl_string& s)
+{
+ // decimal: "^ *[-+]?[1-9][0-9]*$"
+ // Infinity: "^ *[-+]?Inf(inity)?$"
+
+ if (is_plus_inf(s.c_str()))
+ b=vnl_bignum("+Inf");
+ else if (is_minus_inf(s.c_str()))
+ b=vnl_bignum("-Inf");
+ else
+ b.dtoBigNum(s.c_str()); // convert decimal to vnl_bignum
+ return b;
+}
+
+
+//: Implicit conversion from a vnl_bignum to a short.
+vnl_bignum::operator short () const
+{
+ short s = 0;
+ for (Counter i = this->count; i > 0; )
+ s = short(s*0x10000 + this->data[--i]);
+ return this->sign*s;
+}
+
+
+//: Implicit conversion from a vnl_bignum to an int.
+vnl_bignum::operator int () const
+{
+ int j = 0;
+ for (Counter i = this->count; i > 0; )
+ j = int(j*0x10000 + this->data[--i]);
+ return this->sign*j;
+}
+
+
+//: Implicit conversion from a vnl_bignum to a long.
+vnl_bignum::operator long () const
+{
+ long l = 0;
+ for (Counter i = this->count; i > 0; )
+ l = l*0x10000L + this->data[--i];
+ return this->sign*l;
+}
+
+
+//: Implicit conversion from a vnl_bignum to a float.
+vnl_bignum::operator float () const
+{
+ float f = 0.0f;
+ for (Counter i = this->count; i > 0; )
+ f = f*0x10000 + this->data[--i];
+ if (this->is_infinity()) f = vcl_numeric_limits<float>::infinity();
+ return this->sign*f;
+}
+
+
+//: Implicit conversion from a vnl_bignum to a double.
+
+vnl_bignum::operator double () const
+{
+ double d = 0.0;
+ for (Counter i = this->count; i > 0; )
+ d = d*0x10000 + this->data[--i];
+ if (this->is_infinity()) d = vcl_numeric_limits<double>::infinity();
+ return this->sign*d;
+}
+
+//: Implicit conversion from a vnl_bignum to a long double.
+
+vnl_bignum::operator long double () const
+{
+ long double d = 0.0;
+ for (Counter i = this->count; i > 0; )
+ d = d*0x10000 + this->data[--i];
+ if (this->is_infinity()) d = vcl_numeric_limits<long double>::infinity();
+ return this->sign*d;
+}
+
+//: dump the contents of a vnl_bignum to a stream, default cout.
+
+void vnl_bignum::dump (vcl_ostream& os) const
+{
+ os << "{count=" << this->count // output count field
+ << ", sign=" << this->sign // output sign field
+ << ", data=" << this->data // output data pointer
+ << ", value=" << *this
+ << ", {";
+ // format string == "%04X%s" or "%02X%s", etc.
+ // static char format_str[10] =
+ // {'%','0',char(2*2 + '0'),'X','%','s'};
+ // format_str[2] = char(2*2 + '0');
+ if (this->count > 0) { // output data array
+ for (Counter i = this->count; i > 1; i--)
+ os << (this->data[i - 1]) << ',';
+ os << (this->data[0]);
+ }
+ os << "}}\n"; // close brackets
+}
+
+
+//: Converts decimal string to a vnl_bignum.
+
+int vnl_bignum::dtoBigNum (const char *s)
+{
+ this->resize(0); sign = 1; // Reset number to 0.
+ Counter len = 0; // No chars converted yet
+ while (*s == ' ' || *s == '\t' || *s == '\n' || *s == '\r') ++s; // skip whitespace
+ if (s[0] == '-' || s[0] == '+') len++;// Skip over leading +,-
+ while (vcl_isdigit(s[len])) { // If current char is digit
+ (*this) = ((*this) * 10L) + // Shift vnl_bignum left a decimal
+ vnl_bignum(long(s[len++] - '0')); // digit and add new digit
+ }
+ if (s[0] == '-') this->sign = -1; // If s had leading -, note it
+ return len; // Return # of chars processed
+}
+
+//: convert exponential string to a vnl_bignum
+
+void vnl_bignum::exptoBigNum (const char *s)
+{
+ while (*s == ' ' || *s == '\t' || *s == '\n' || *s == '\r') ++s; // skip whitespace
+ Counter pos = this->dtoBigNum(s) + 1; // Convert the base, skip [eE]
+ long pow = vcl_atol(s + pos); // Convert the exponent to long
+ while (pow-- > 0) // Raise vnl_bignum to the given
+ *this = (*this) * 10L; // power
+}
+
+
+//: convert hex character to integer hex value (ASCII or EBCDIC)
+// - Inputs: character representation of a hex number
+// - Outputs: integer value of the hex number
+
+unsigned int ctox (int c)
+{
+ if ('0' <= c && c <= '9')
+ return c - '0';
+ if ('a' <= c && c <= 'f')
+ return c - 'a' + 10;
+ return c - 'A' + 10;
+}
+
+//: convert hex string to vnl_bignum
+
+void vnl_bignum::xtoBigNum (const char *s)
+{
+ this->resize(0); sign = 1; // Reset number to 0.
+ while (*s == ' ' || *s == '\t' || *s == '\n' || *s == '\r') ++s; // skip whitespace
+ Counter size = vcl_strlen(s);
+ Counter len = 2; // skip leading "0x"
+ while (len < size) { // While there are more chars
+ (*this) = ((*this) * 16L) + // Shift vnl_bignum left one hex
+ vnl_bignum(long(ctox(s[len++]))); // digit and add next digit
+ }
+}
+
+
+//: convert octal string to vnl_bignum
+
+void vnl_bignum::otoBigNum (const char *s)
+{
+ this->resize(0); sign = 1; // Reset number to 0.
+ while (*s == ' ' || *s == '\t' || *s == '\n' || *s == '\r') ++s; // skip whitespace
+ Counter size = vcl_strlen(s);
+ Counter len = 0; // No chars converted yet
+ while (len < size) { // While there are more chars
+ (*this) = ((*this) * 8L) + // Shift vnl_bignum left 1 oct dig.
+ vnl_bignum(long(s[len++] - '0')); // Add next character value
+ }
+}
+
+//: change the data allotment for a vnl_bignum
+
+void vnl_bignum::resize (short new_count)
+{
+ assert(new_count >= 0);
+ if (new_count == this->count) return;
+ Data *new_data = (new_count > 0 ? new Data[new_count] : 0); // Allocate data if necessary
+
+ if (this->count <= new_count) { // Copy old data into new
+ short i = 0;
+ for (; i < this->count; i++)
+ new_data[i] = this->data[i];
+ for (; i < new_count; i++)
+ new_data[i] = 0;
+ }
+ else {
+ for (short i = 0; i < new_count; i++)
+ new_data[i] = this->data[i];
+ }
+
+ delete [] this->data; // Get rid of old data
+ this->data = new_data; // Point to new data
+ this->count = new_count; // Save new count
+}
+
+
+//: trim non-infinite vnl_bignum of excess data allotment
+
+vnl_bignum& vnl_bignum::trim ()
+{
+ Counter i = this->count;
+ for (; i > 0; i--) // Skip over high-order words
+ if (this->data[i - 1] != 0) break; // that are zero
+ if (i < this->count) { // If there are some such words
+ this->count = i; // Update the count
+ Data *new_data = (i > 0 ? new Data[i] : 0); // Allocate data if necessary
+ for (; i > 0; i--) // Copy old data into new
+ new_data[i - 1] = this->data[i - 1];
+ delete [] this->data; // Delete old data
+ this->data = new_data; // Point to new data
+ }
+ return *this; // return reference to vnl_bignum
+}
+
+
+//: add two non-infinite vnl_bignum values and save their sum
+
+void add (const vnl_bignum& b1, const vnl_bignum& b2, vnl_bignum& sum)
+{
+ const vnl_bignum *bmax, *bmin; // Determine which of the two
+ if (b1.count >= b2.count) { // addends has the most
+ bmax = &b1; // data.
+ bmin = &b2;
+ }
+ else {
+ bmax = &b2;
+ bmin = &b1;
+ }
+ sum.data = (sum.count = bmax->count) > 0 ? // Allocate data for their sum
+ new Data[sum.count] : 0;
+ unsigned long temp, carry = 0;
+ Counter i = 0;
+ while (i < bmin->count) { // Add, element by element.
+ // Add both elements and carry
+ temp = (unsigned long)b1.data[i] + (unsigned long)b2.data[i] + carry;
+ carry = temp/0x10000L; // keep track of the carry
+ sum.data[i] = Data(temp); // store sum
+ i++; // go to next element
+ }
+ while (i < bmax->count) { // bmin has no more elements
+ temp = bmax->data[i] + carry; // propagate the carry through
+ carry = temp/0x10000L; // the rest of bmax's elements
+ sum.data[i] = Data(temp); // store sum
+ i++;
+ }
+ if (carry) { // if carry left over
+ sum.resize(bmax->count + 1); // allocate another word
+ sum.data[bmax->count] = 1; // save the carry in it
+ }
+}
+
+//: Add 1 to bnum (unsigned, non-infinite)
+void increment (vnl_bignum& bnum)
+{
+ Counter i = 0;
+ unsigned long carry = 1;
+ while (i < bnum.count && carry) { // increment, element by element.
+ unsigned long temp = (unsigned long)bnum.data[i] + carry;
+ carry = temp/0x10000L;
+ bnum.data[i] = (Data)temp;
+ ++i;
+ }
+ if (carry)
+ {
+ bnum.resize(bnum.count+1);
+ bnum.data[bnum.count-1] = 1;
+ }
+}
+
+
+//: subtract bmin from bmax (unsigned, non-infinite), result in diff
+
+void subtract (const vnl_bignum& bmax, const vnl_bignum& bmin, vnl_bignum& diff)
+{
+ diff.data = new Data[diff.count = bmax.count];// Allocate data for difference
+ unsigned long temp;
+ int borrow = 0;
+ Counter i = 0;
+ for (; i < bmin.count; i++) { // Subtract word by word.
+ temp = (unsigned long)bmax.data[i] + 0x10000L - borrow; // Add radix to bmax's data
+ temp -= (unsigned long)bmin.data[i]; // Subtract off bmin's data
+ borrow = (temp/0x10000L == 0); // Did we have to borrow?
+ diff.data[i] = (Data) temp; // Reduce modulo radix and save
+ }
+ for (; i < bmax.count; i++) { // No more data for bmin
+ temp = (unsigned long)bmax.data[i] + 0x10000L - borrow; // Propagate the borrow through
+ borrow = (temp/0x10000L == 0); // rest of bmax's data
+ diff.data[i] = (Data) temp;
+ }
+ diff.trim(); // Done. Now trim excess data
+}
+
+
+//: Subtract 1 to bnum (unsigned, non-infinite, non-zero)
+void decrement (vnl_bignum& bnum)
+{
+ Counter i = 0;
+ unsigned long borrow = 1;
+ while (i < bnum.count && borrow) { // decrement, element by element.
+ unsigned long temp = (unsigned long)bnum.data[i] + 0x10000L - borrow;
+ borrow = (temp/0x10000L == 0); // Did we have to borrow?
+ bnum.data[i] = (Data)temp; // Reduce modulo radix and save
+ ++i;
+ }
+ bnum.trim(); // Done. Now trim excess data
+ if (bnum.count==0) bnum.sign=+1; // Re-establish sign invariant
+}
+
+
+//: compare absolute values of two vnl_bignums
+// Outputs: result of comparison: -1 if abs(b1) < abs(b2)
+// 0 if abs(b1) == abs(b2)
+// +1 if abs(b1) > abs(b2)
+
+int magnitude_cmp (const vnl_bignum& b1, const vnl_bignum& b2)
+{
+ if (b1.is_infinity()) return b2.is_infinity() ? 0 : 1;
+ if (b2.is_infinity()) return -1;
+ if (b1.count > b2.count) return 1; // If one has more data than
+ if (b2.count > b1.count) return -1; // the other, it wins
+ Counter i = b1.count; // Else same number of elements
+ while (i > 0) { // Do lexicographic comparison
+ if (b1.data[i - 1] > b2.data[i - 1])
+ return 1;
+ else if (b1.data[i - 1] < b2.data[i - 1])
+ return -1;
+ i--;
+ } // No data, or all elements same
+ return 0; // so must be equal
+}
+
+
+//: multiply a non-infinite vnl_bignum by a "single digit"
+// - Inputs: vnl_bignum reference, single word multiplier, reference to the product,
+// and index of starting storage location to use in product
+
+void multiply_aux (const vnl_bignum& b, Data d, vnl_bignum& prod, Counter i)
+{
+ // this function works just like normal multiplication by hand, in that the
+ // top number is multiplied by the first digit of the bottom number, then the
+ // second digit, and so on. The only difference is that instead of doing all
+ // of the multiplication before adding the rows, addition is done
+ // concurrently.
+ if (i == 0) { // if index is zero
+ Counter j = 0; // then zero out all of
+ while (j < prod.count) // prod's data elements
+ prod.data[j++] = 0;
+ }
+ if (d != 0) { // if d == 0, nothing to do
+ unsigned long temp;
+ Data carry = 0;
+
+ Counter j = 0;
+ for (; j < b.count; j++) {
+ // for each of b's data elements, multiply times d and add running product
+ temp = (unsigned long)b.data[j] * (unsigned long)d
+ + (unsigned long)prod.data[i + j] + carry;
+ prod.data[i + j] = Data(temp % 0x10000L); // store result in product
+ carry = Data(temp/0x10000L); // keep track of carry
+ }
+ if (i+j < prod.count)
+ prod.data[i + j] = carry; // Done. Store the final carry
+ }
+}
+
+//: normalize two vnl_bignums
+// (Refer to Knuth, V.2, Section 4.3.1, Algorithm D for details.
+// A digit here is one data element in the radix 2**2.)
+// - Inputs: references to two vnl_bignums b1, b2, and their normalized counterparts
+// - Outputs: the integral normalization factor used
+
+Data normalize (const vnl_bignum& b1, const vnl_bignum& b2, vnl_bignum& u, vnl_bignum& v)
+{
+ Data d = Data(0x10000L/(long(b2.data[b2.count - 1]) + 1)); // Calculate normalization factor.
+ u.data = new Data[u.count = b1.count + 1]; // Get data for u (plus extra)
+ v.data = new Data[v.count = b2.count]; // Get data for v
+ u.data[b1.count] = 0; // Set u's leading digit to 0
+ multiply_aux(b1,d,u,0); // u = b1 * d
+ multiply_aux(b2,d,v,0); // v = b2 * d
+ return d; // return normalization factor
+}
+
+
+//: divide a vnl_bignum by a "single digit"
+// (Refer to Knuth, V.2, Section 4.3.2, exercise 16 for details.
+// A digit here is one data element in the radix 2**2.)
+// - Inputs: reference to vnl_bignum dividend, single digit divisor d, vnl_bignum
+// quotient, and single digit remainder r
+
+void divide_aux (const vnl_bignum& b1, Data d, vnl_bignum& q, Data& r)
+{
+ r = 0; // init remainder to zero
+ unsigned long temp;
+ for (Counter j = b1.count; j > 0; j--) {
+ temp = (unsigned long)r*0x10000L + (unsigned long)b1.data[j - 1]; // get remainder, append next
+ if (j < 1 + q.count)
+ q.data[j - 1] = Data(temp/d); // digit, then divide
+ r = Data(temp % d); // calculate new remainder
+ }
+}
+
+
+//: estimate next dividend
+// (Refer to Knuth, V.2, Section 4.3.1, Algorithm D for details.
+// This function estimates how many times v goes into u, starting at u's
+// jth digit. A digit here is actually a data element, thought of as
+// being in the radix 2**2.)
+// - Inputs: reference to vnl_bignum dividend and divisor and starting digit j
+// - Outputs: estimated number of times v goes into u
+
+Data estimate_q_hat (const vnl_bignum& u, const vnl_bignum& v, Counter j)
+{
+ Data q_hat,
+ v1 = v.data[v.count - 1], // localize frequent data
+ v2 = v.data[v.count - 2],
+ u0 = u.data[u.count - 1 - j],
+ u1 = u.data[u.count - 2 - j],
+ u2 = u.data[u.count - 3 - j];
+
+ // Initial Knuth estimate, usually correct
+ q_hat = (u0 == v1 ? Data(0xffff) : Data(long(u0 * 0x10000L + u1) / long(v1)));
+
+ // high speed test to determine most of the cases in which initial
+ // estimate is too large. Eliminates most cases in which q_hat is one too
+ // large. Eliminates all cases in which q_hat is two too large. The test
+ // looks hairy because we have to watch out for overflow. In the book, this
+ // test is the simple inequality:
+ // v2*q_hat > (u0*0x10000L + u1 - q_hat*v1)*0x10000L + u2.
+ // If the inequality is true, decrease q_hat by 1. If inequality is still
+ // true, decrease q_hat again.
+ unsigned long lhs, rhs; // lhs, rhs of Knuth inequality
+ for (Counter i = 0; i < 2; i++) { // loop at most twice
+ lhs = v2 * q_hat; // Calculate left-hand side of ineq.
+ rhs = u0 * 0x10000L + u1;// Calculate part of right-hand side
+ rhs -= (q_hat * v1); // Now subtract off part
+
+ // DML: My attempt to fix the overflow testing bug..
+ double temp_rhs = double(rhs);
+ double temp_radix_s = double(0x10000);
+ // OLD WAY: if (rhs > rhs * 0x10000)// if multiplication causes overflow
+ // NEW WAY: see if result won't fit into a long.
+ if ( temp_rhs * temp_radix_s > double(0x7fffffffL) )
+ break; // then rhs > lhs, so test fails
+ rhs *= 0x10000L; // No overflow: ok to multiply
+
+ temp_rhs = double(rhs);
+ double temp_u2 = double(u2);
+ // OLD WAY: if (rhs > rhs + u2) // if addition yields overflow
+ if ( temp_rhs + temp_u2 > double(0x7fffffffL) ) // NEW WAY.
+ break; // then rhs > lhs, so test fails
+ rhs += u2; // No overflow: ok to add.
+ if (lhs <= rhs) // if lhs <= rhs
+ break; // test fails
+ q_hat--; // Test passes: decrement q_hat
+ } // Loop again
+ return q_hat; // Return estimate
+}
+
+
+//: calculate u - v*q_hat
+// (Refer to Knuth, V. 2, Section 4.3.1, Algorithm D for details.
+// A digit here is a data element, thought of as being in the radix 2**2.)
+// - Inputs: reference to vnl_bignum dividend, divisor, estimated result, and index
+// into jth digit of dividend
+// - Outputs: true number of times v goes into u
+
+Data multiply_subtract (vnl_bignum& u, const vnl_bignum& v, Data q_hat, Counter j)
+{
+ // At this point it has been estimated that v goes into the jth and higher
+ // digits of u about q_hat times, and in fact that q_hat is either the
+ // correct number of times or one too large.
+
+ if (q_hat == 0) return q_hat; // if q_hat 0, nothing to do
+ vnl_bignum rslt; // create a temporary vnl_bignum
+ Counter tmpcnt;
+ rslt.data = // allocate data for it
+ new Data[rslt.count = v.count + 1];
+
+ // simultaneous computation of u - v*q_hat
+ unsigned long prod, diff;
+ Data carry = 0, borrow = 0;
+ Counter i = 0;
+ for (; i < v.count; i++) {
+ // for each digit of v, multiply it by q_hat and subtract the result
+ prod = (unsigned long)v.data[i] * (unsigned long)q_hat + carry;
+ diff = (unsigned long)u.data[u.count - v.count - 1 - j + i] + 0x10000L - borrow;
+ diff -= (unsigned long)Data(prod); // form proper digit of u
+ rslt.data[i] = Data(diff); // save the result
+ borrow = (diff/0x10000L == 0); // keep track of any borrows
+ carry = Data(prod/0x10000L); // keep track of carries
+ }
+ tmpcnt = u.count - v.count - 1 - j + i;
+ diff = (unsigned long)u.data[tmpcnt] // special case for the last
+ + 0x10000L - borrow; // digit
+ diff -= carry;
+ rslt.data[i] = Data(diff);
+ borrow = (diff/0x10000L == 0);
+
+ // A leftover borrow indicates that u - v*q_hat is negative, i.e., that
+ // q_hat was one too large. So to get correct result, decrement q_hat and
+ // add back one multiple of v
+ if (borrow) {
+ q_hat--;
+ carry = 0;
+ unsigned long sum;
+ for (i = 0; i < v.count; i++) {
+ sum = (unsigned long)rslt.data[i] + (unsigned long)v.data[i] + carry;
+ carry = Data(sum/0x10000L);
+ u.data[u.count - v.count - 1 - j + i] = Data(sum);
+ }
+ u.data[u.count - v.count - 1 - j + i] = rslt.data[i] + carry;
+ }
+ else { // otherwise, result is ok
+ for (i = 0; i < rslt.count; i++) // store result back into u
+ u.data[u.count - v.count - 1 - j + i] = rslt.data[i];
+ }
+ return q_hat; // return corrected q_hat
+}
+
+
+//: divide b2 into b1, getting quotient q and remainder r.
+// (Refer to Knuth, V.2, Section 4.3.1, Algorithm D for details.
+// This function implements Algorithm D.)
+// - Inputs: references to a vnl_bignum dividend b1, divisor b2, quotient q, and
+// remainder r.
+
+void divide (const vnl_bignum& b1, const vnl_bignum& b2, vnl_bignum& q, vnl_bignum& r)
+{
+ // Note that q or r may *not* be identical to either b1 or b2 !
+ assert(&b1 != &q && &b2 != &q && &b1 != &r && &b2 != &r);
+ q = r = 0L;
+ if (b1 == 0L) // If divisor is zero
+ return; // return zero quotient and remainder
+ int mag = magnitude_cmp(b1,b2); // Compare magnitudes
+ if (mag < 0) // if abs(b1) < abs(b2)
+ r = b1; // return zero quotient, b1 remainder
+ else if (mag == 0) // if abs(b1) == abs(b2)
+ q = 1L; // quotient is 1, remainder is 0
+ else { // otherwise abs(b1) > abs(b2), so divide
+ q.data = new Data[q.count = b1.count - b2.count + 1]; // Allocate quotient
+ r.data = new Data[r.count = b2.count]; // Allocate remainder
+ if (b2.count == 1) { // Single digit divisor?
+ divide_aux(b1,b2.data[0],q,r.data[0]); // Do single digit divide
+ }
+ else { // Else full-blown divide
+ vnl_bignum u,v;
+ Data d = normalize(b1,b2,u,v); // Set u = b1/d, v = b2/d
+ Data q_hat; // Multiplier
+ Counter j = 0;
+ while (j <= b1.count - b2.count) { // Main division loop
+ q_hat = estimate_q_hat(u,v,j); // Estimate # times v divides
+ q.data[q.count - 1 - j] = // Do division, get true answ.
+ multiply_subtract(u,v,q_hat,j);
+ j++;
+ }
+ static Data dufus; // dummy variable
+ divide_aux(u,d,r,dufus); // Unnormalize u for remainder
+ }
+ q.trim(); // Trim leading zeros of quot.
+ r.trim(); // Trim leading zeros of rem.
+ }
+ q.sign = r.sign = b1.sign * b2.sign; // Calculate signs
+}
+
+
+//: left shift (arithmetic) non-infinite vnl_bignum by positive number.
+// - Inputs: reference to vnl_bignum, positive shift value
+// - Outputs: vnl_bignum, multiplied by the corresponding power of two
+
+vnl_bignum left_shift (const vnl_bignum& b1, int l)
+{
+ // to carry out this arithmetic left shift, we cheat. Instead of physically
+ // shifting the data array l bits to the left, we shift just enough to get
+ // the correct word alignment, and then pad the array on the right with as
+ // many zeros as we need.
+ vnl_bignum rslt; // result of shift
+ rslt.sign = b1.sign; // result follows sign of input
+ Counter growth = Counter(l / 16); // # of words rslt will grow by
+ Data shift = Data(l % 16); // amount to actually shift
+ Data rshift = 16 - shift; // amount to shift next word by
+ Data carry = // value that will be shifted
+ b1.data[b1.count - 1] >> (16 - shift); // out end of current array
+ rslt.data = // allocate new data array
+ new Data[rslt.count = b1.count + growth + (carry != 0 ? 1 : 0)];
+ Counter i = 0;
+ while (i < growth) // zero out padded elements
+ rslt.data[i++] = 0;
+ rslt.data[i++] = b1.data[0] << shift; // shift first non-zero element
+ while (i < rslt.count - 1) { // for remaining data words
+ rslt.data[i] = (b1.data[i - growth] << shift) + // shift current data word
+ (b1.data[i - 1 - growth] >> rshift); // propagate adjacent
+ i++; // carry into current word
+ }
+ if (i < rslt.count) {
+ if (carry) // if last word had overflow
+ rslt.data[i] = carry; // store it new data
+ else // otherwise,
+ rslt.data[i] = (b1.data[i - growth] << shift) // do like the rest
+ + (b1.data[i - 1 - growth] >> rshift);
+ }
+ vnl_bignum& result = *((vnl_bignum*) &rslt);// same physical object
+ return result; // shallow swap on return
+}
+
+
+//: right shift (arithmetic) non-infinite vnl_bignum by positive number.
+// - Inputs: reference to vnl_bignum, positive shift value
+// - Outputs: vnl_bignum, divided by the corresponding power of two
+
+vnl_bignum right_shift (const vnl_bignum& b1, int l)
+{
+ vnl_bignum rslt; // result of shift
+ Counter shrinkage = Counter(l / 16); // # of words rslt will shrink
+ Data shift = Data(l % 16); // amount to actually shift
+ Data dregs = (b1.data[b1.count-1] >> shift); // high end data to save
+ if (shrinkage + (dregs == 0) < b1.count) { // if not all data shifted out
+ rslt.sign = b1.sign; // rslt follows sign of input
+ // allocate new data
+ rslt.data = new Data[rslt.count = b1.count - shrinkage - (dregs == 0 ? 1 : 0)];
+ Data lshift = 16 - shift; // amount to shift high word
+ Counter i = 0;
+ while (i < rslt.count - 1) { // shift current word
+ rslt.data[i] = (b1.data[i + shrinkage] >> shift) + // propagate adjacent
+ (b1.data[i + shrinkage + 1] << lshift); // word into current word
+ i++;
+ }
+ if (dregs) // don't lose dregs
+ rslt.data[i] = dregs;
+ else {
+ rslt.data[i] = (b1.data[i + shrinkage] >> shift) +
+ (b1.data[i + shrinkage + 1] << lshift);
+ }
+ }
+ vnl_bignum& result = *((vnl_bignum*) &rslt); // same physical object
+ return result; // shallow swap on return
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.h
new file mode 100644
index 0000000000000000000000000000000000000000..59bd20926791e47eae9614b775792fd33b8ca7f3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum.h
@@ -0,0 +1,429 @@
+// This is core/vnl/vnl_bignum.h
+#ifndef vnl_bignum_h_
+#define vnl_bignum_h_
+//:
+// \file
+// \brief Infinite precision integers
+//
+// The vnl_bignum class implements near-infinite precision integers
+// and arithmetic by using a dynamic bit vector. A
+// vnl_bignum object will grow in size as necessary to hold its
+// integer value. Implicit conversion to the system defined
+// types: short, int, long, float, double and long double
+// is supported by overloaded operator member functions.
+// Addition and subtraction operators are performed by
+// simple bitwise addition and subtraction on
+// unsigned short boundaries with checks for carry flag propagation.
+// The multiplication, division, and remainder operations
+// utilize the algorithms from Knuth's Volume 2 of "The
+// Art of Computer Programming". However, despite the use of
+// these algorithms and inline member functions, arithmetic
+// operations on vnl_bignum objects are considerably slower than
+// the built-in integer types that use hardware integer arithmetic
+// capabilities.
+//
+// The vnl_bignum class supports the parsing of character string
+// representations of all the literal number formats, PLUS the
+// strings "Infinity", "+Infinity" and "-Infinity". The following
+// table shows an example of a character string
+// representation on the left and a brief description of the
+// interpreted meaning on the right:
+//
+// Character String Interpreted Meaning
+// 1234 1234
+// 1234l 1234
+// 1234L 1234
+// 1234u 1234
+// 1234U 1234
+// 1234ul 1234
+// 1234UL 1234
+// 01234 1234 in octal (leading 0)
+// 0x1234 1234 in hexadecimal (leading 0x)
+// 0X1234 1234 in hexadecimal (leading 0X)
+// 123.4 123 (value truncated)
+// 1.234e2 123 (exponent expanded/truncated)
+// 1.234e-5 0 (truncated value less than 1)
+// Infinity +Inf ("maxval", obeying all conventional arithmetic)
+//
+// \author
+// Copyright (C) 1991 Texas Instruments Incorporated.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated provides this software "as is" without
+// express or implied warranty.
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 24 January 2002: ported to vnl from COOL
+// Peter Vanroose, 7 September 2002: added "Infinity" (incl. all arithmetic)
+// Ian Scott, 23 March 2004: made ++ and -- much more efficient.
+// \endverbatim
+
+#include <vcl_iostream.h>
+#include <vcl_string.h>
+
+class vnl_bignum;
+
+// These are all auxiliary functions:
+
+int magnitude_cmp(const vnl_bignum&, const vnl_bignum&);
+void add(const vnl_bignum&, const vnl_bignum&, vnl_bignum&);
+void subtract(const vnl_bignum&, const vnl_bignum&, vnl_bignum&);
+void multiply_aux(const vnl_bignum&, unsigned short d, vnl_bignum&, unsigned short i);
+unsigned short normalize(const vnl_bignum&, const vnl_bignum&, vnl_bignum&, vnl_bignum&);
+void divide_aux(const vnl_bignum&, unsigned short, vnl_bignum&, unsigned short&);
+unsigned short estimate_q_hat(const vnl_bignum&, const vnl_bignum&, unsigned short);
+unsigned short multiply_subtract(vnl_bignum&, const vnl_bignum&, unsigned short, unsigned short);
+void divide(const vnl_bignum&, const vnl_bignum&, vnl_bignum&, vnl_bignum&);
+vnl_bignum left_shift(const vnl_bignum& b1, int l);
+vnl_bignum right_shift(const vnl_bignum& b1, int l);
+void decrement (vnl_bignum& bnum);
+void increment (vnl_bignum& bnum);
+
+//: formatted output
+// \relates vnl_bignum
+vcl_ostream& operator<<(vcl_ostream& s, vnl_bignum const& r);
+
+//: simple input
+// \relates vnl_bignum
+vcl_istream& operator>>(vcl_istream& s, vnl_bignum& r);
+
+//: Infinite precision integers
+//
+// The vnl_bignum class implements near-infinite precision integers
+// and arithmetic by using a dynamic bit vector. A
+// vnl_bignum object will grow in size as necessary to hold its
+// integer value. Implicit conversion to the system defined
+// types: short, int, long, float, double and long double
+// is supported by overloaded operator member functions.
+// Addition and subtraction operators are performed by
+// simple bitwise addition and subtraction on
+// unsigned short boundaries with checks for carry flag propagation.
+// The multiplication, division, and remainder operations
+// utilize the algorithms from Knuth's Volume 2 of "The
+// Art of Computer Programming". However, despite the use of
+// these algorithms and inline member functions, arithmetic
+// operations on vnl_bignum objects are considerably slower than
+// the built-in integer types that use hardware integer arithmetic
+// capabilities.
+//
+// The vnl_bignum class supports the parsing of character string
+// representations of all the literal number formats, PLUS the
+// strings "Infinity", "+Infinity" and "-Infinity". The following
+// table shows an example of a character string
+// representation on the left and a brief description of the
+// interpreted meaning on the right:
+//
+// Character String Interpreted Meaning
+// 1234 1234
+// 1234l 1234
+// 1234L 1234
+// 1234u 1234
+// 1234U 1234
+// 1234ul 1234
+// 1234UL 1234
+// 01234 1234 in octal (leading 0)
+// 0x1234 1234 in hexadecimal (leading 0x)
+// 0X1234 1234 in hexadecimal (leading 0X)
+// 123.4 123 (value truncated)
+// 1.234e2 123 (exponent expanded/truncated)
+// 1.234e-5 0 (truncated value less than 1)
+// Infinity +Inf ("maxval", obeying all conventional arithmetic)
+//
+class vnl_bignum
+{
+ unsigned short count; // Number of data elements (never 0 except for "0")
+ int sign; // Sign of vnl_bignum (+1 or -1, nothing else!!)
+ unsigned short* data; // Pointer to data value
+ public:
+ vnl_bignum(); // Void constructor
+ vnl_bignum(long); // Long constructor
+ vnl_bignum(unsigned long); // Unsigned Long constructor
+ vnl_bignum(int); // Int constructor
+ vnl_bignum(unsigned int); // Unsigned Int constructor
+ vnl_bignum(float); // Float constructor
+ vnl_bignum(double); // Double constructor
+ vnl_bignum(long double); // Long Double constructor
+ vnl_bignum(vnl_bignum const&); // Copy constructor
+ vnl_bignum(const char*); // String constructor
+ ~vnl_bignum(); // Destructor
+
+ operator short() const; // Implicit type conversion
+ operator int() const; // Implicit type conversion
+ operator long() const; // Implicit type conversion
+ operator float() const; // Implicit type conversion
+ operator double() const; // Implicit type conversion
+ operator long double() const; // Implicit type conversion
+ inline operator short() { return ((const vnl_bignum*)this)->operator short(); }
+ inline operator int() { return ((const vnl_bignum*)this)->operator int(); }
+ inline operator long() { return ((const vnl_bignum*)this)->operator long(); }
+ inline operator float() { return ((const vnl_bignum*)this)->operator float(); }
+ inline operator double() { return ((const vnl_bignum*)this)->operator double(); }
+ inline operator long double() { return ((const vnl_bignum*)this)->operator long double(); }
+
+ vnl_bignum operator-() const; // Unary minus operator
+ inline vnl_bignum operator+() const { return *this; } // Unary plus operator
+
+ vnl_bignum& operator=(const vnl_bignum&); // Assignment operator
+
+ vnl_bignum operator<<(int l) const; // Bit shift
+ vnl_bignum operator>>(int l) const; // Bit shift
+ vnl_bignum operator+(vnl_bignum const& r) const;
+ inline vnl_bignum& operator+=(vnl_bignum const& r) { return *this = operator+(r); }
+ inline vnl_bignum& operator-=(vnl_bignum const& r) { return *this = operator+(-r); }
+ vnl_bignum& operator*=(vnl_bignum const& r);
+ vnl_bignum& operator/=(vnl_bignum const& r);
+ vnl_bignum& operator%=(vnl_bignum const& r);
+ inline vnl_bignum& operator<<=(int l) { return *this = *this << l; }
+ inline vnl_bignum& operator>>=(int l) { return *this = *this >> l; }
+
+ //: prefix increment (++b)
+ vnl_bignum& operator++();
+ //: decrement
+ vnl_bignum& operator--();
+ //: postfix increment (b++)
+ inline vnl_bignum operator++(int) { vnl_bignum b=(*this); operator++(); return b; }
+ //: decrement
+ inline vnl_bignum operator--(int) { vnl_bignum b=(*this); operator--(); return b; }
+
+ bool operator==(vnl_bignum const&) const; // equality
+ bool operator< (vnl_bignum const&) const; // less than
+ inline bool operator!=(vnl_bignum const& r) const { return !operator==(r); }
+ inline bool operator> (vnl_bignum const& r) const { return r<(*this); }
+ inline bool operator<=(vnl_bignum const& r) const { return !operator>(r); }
+ inline bool operator>=(vnl_bignum const& r) const { return !operator<(r); }
+ inline bool operator==(long r) const { return operator==(vnl_bignum(r)); }
+ inline bool operator!=(long r) const { return !operator==(vnl_bignum(r)); }
+ inline bool operator< (long r) const { return operator<(vnl_bignum(r)); }
+ inline bool operator> (long r) const { return vnl_bignum(r) < (*this); }
+ inline bool operator<=(long r) const { return !operator>(vnl_bignum(r)); }
+ inline bool operator>=(long r) const { return !operator<(vnl_bignum(r)); }
+ inline bool operator==(int r) const { return operator==(long(r)); }
+ inline bool operator!=(int r) const { return !operator==(long(r)); }
+ inline bool operator< (int r) const { return operator<(long(r)); }
+ inline bool operator> (int r) const { return vnl_bignum(long(r)) < (*this); }
+ inline bool operator<=(int r) const { return !operator>(long(r)); }
+ inline bool operator>=(int r) const { return !operator<(long(r)); }
+ inline bool operator==(double r) const { return r == this->operator double(); }
+ inline bool operator!=(double r) const { return r != this->operator double(); }
+ inline bool operator< (double r) const { return r > this->operator double(); }
+ inline bool operator> (double r) const { return r < this->operator double(); }
+ inline bool operator<=(double r) const { return r >= this->operator double(); }
+ inline bool operator>=(double r) const { return r <= this->operator double(); }
+ inline bool operator==(long double r) const { return r == this->operator long double(); }
+ inline bool operator!=(long double r) const { return r != this->operator long double(); }
+ inline bool operator< (long double r) const { return r > this->operator long double(); }
+ inline bool operator> (long double r) const { return r < this->operator long double(); }
+ inline bool operator<=(long double r) const { return r >= this->operator long double(); }
+ inline bool operator>=(long double r) const { return r <= this->operator long double(); }
+
+ inline vnl_bignum abs() const { return operator<(0L) ? operator-() : *this; }
+
+ // "+/-Inf" is represented as: count=1, data[0]=0, sign=+/-1 :
+ inline bool is_infinity() const { return count==1 && data[0]==0; }
+ inline bool is_plus_infinity() const { return is_infinity() && sign==1; }
+ inline bool is_minus_infinity() const { return is_infinity() && sign==-1; }
+
+ void dump(vcl_ostream& = vcl_cout) const; // Dump contents of vnl_bignum
+
+ friend int magnitude_cmp(const vnl_bignum&, const vnl_bignum&);
+ friend void add(const vnl_bignum&, const vnl_bignum&, vnl_bignum&);
+ friend void subtract(const vnl_bignum&, const vnl_bignum&, vnl_bignum&);
+ friend void increment (vnl_bignum& bnum);
+ friend void decrement (vnl_bignum& bnum);
+ friend void multiply_aux(const vnl_bignum&, unsigned short, vnl_bignum&, unsigned short);
+ friend unsigned short normalize(const vnl_bignum&, const vnl_bignum&, vnl_bignum&, vnl_bignum&);
+ friend void divide_aux(const vnl_bignum&, unsigned short, vnl_bignum&, unsigned short&);
+ friend unsigned short estimate_q_hat(const vnl_bignum&, const vnl_bignum&, unsigned short);
+ friend unsigned short multiply_subtract(vnl_bignum&, const vnl_bignum&, unsigned short, unsigned short);
+ friend void divide(const vnl_bignum&, const vnl_bignum&, vnl_bignum&, vnl_bignum&);
+ friend vnl_bignum left_shift(const vnl_bignum& b1, int l);
+ friend vnl_bignum right_shift(const vnl_bignum& b1, int l);
+ friend vcl_ostream& operator<< (vcl_ostream&, const vnl_bignum&);
+ friend vcl_istream& operator>> (vcl_istream&, vnl_bignum&);
+ friend vcl_string& vnl_bignum_to_string (vcl_string& s, const vnl_bignum& b);
+ friend vnl_bignum& vnl_bignum_from_string (vnl_bignum& b, const vcl_string& s);
+
+ private:
+ void xtoBigNum(const char *s); // convert hex to vnl_bignum
+ int dtoBigNum(const char *s); // convert decimal to vnl_bignum
+ void otoBigNum(const char *s); // convert octal to vnl_bignum
+ void exptoBigNum(const char *s); // convert exponential to vnl_bignum
+
+ void resize(short); // Resize vnl_bignum data
+ vnl_bignum& trim(); // Trim vnl_bignum data
+};
+
+
+//: Convert the number to a decimal representation in a string.
+// \relates vnl_bignum
+vcl_string& vnl_bignum_to_string (vcl_string& s, const vnl_bignum& b);
+
+//: Convert the number from a decimal representation in a string.
+// \relates vnl_bignum
+vnl_bignum& vnl_bignum_from_string (vnl_bignum& b, const vcl_string& s);
+
+//: Returns the sum of two bignum numbers.
+// \relates vnl_bignum
+inline vnl_bignum operator+(vnl_bignum const& r1, long r2) { return r1+vnl_bignum(r2); }
+inline vnl_bignum operator+(vnl_bignum const& r1, int r2) { return r1+long(r2); }
+inline vnl_bignum operator+(vnl_bignum const& r1, double r2) { return r1+vnl_bignum(r2); }
+inline vnl_bignum operator+(vnl_bignum const& r1, long double r2) { return r1+vnl_bignum(r2); }
+inline vnl_bignum operator+(long r2, vnl_bignum const& r1) { return r1 + r2; }
+inline vnl_bignum operator+(int r2, vnl_bignum const& r1) { return r1 + r2; }
+inline vnl_bignum operator+(double r2, vnl_bignum const& r1) { return r1 + r2; }
+inline vnl_bignum operator+(long double r2, vnl_bignum const& r1) { return r1 + r2; }
+
+//: Returns the difference of two bignum numbers.
+// \relates vnl_bignum
+inline vnl_bignum operator-(vnl_bignum const& r1, vnl_bignum const& r2) { return r1 + (-r2); }
+inline vnl_bignum operator-(vnl_bignum const& r1, long r2) { return r1 + (-r2); }
+inline vnl_bignum operator-(vnl_bignum const& r1, int r2) { return r1 + (-r2); }
+inline vnl_bignum operator-(vnl_bignum const& r1, double r2) { return r1 + (-r2); }
+inline vnl_bignum operator-(vnl_bignum const& r1, long double r2) { return r1 + (-r2); }
+inline vnl_bignum operator-(long r2, vnl_bignum const& r1) { return -(r1 + (-r2)); }
+inline vnl_bignum operator-(int r2, vnl_bignum const& r1) { return -(r1 + (-r2)); }
+inline vnl_bignum operator-(double r2, vnl_bignum const& r1) { return -(r1 + (-r2)); }
+inline vnl_bignum operator-(long double r2, vnl_bignum const& r1) { return -(r1 + (-r2)); }
+
+//: Returns the product of two bignum numbers.
+// \relates vnl_bignum
+inline vnl_bignum operator*(vnl_bignum const& r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result *= r2;
+}
+
+inline vnl_bignum operator*(vnl_bignum const& r1, long r2)
+{
+ vnl_bignum result(r1); return result *= vnl_bignum(r2);
+}
+
+inline vnl_bignum operator*(vnl_bignum const& r1, int r2)
+{
+ vnl_bignum result(r1); return result *= (long)r2;
+}
+
+inline vnl_bignum operator*(vnl_bignum const& r1, double r2)
+{
+ vnl_bignum result(r1); return result *= (vnl_bignum)r2;
+}
+
+inline vnl_bignum operator*(vnl_bignum const& r1, long double r2)
+{
+ vnl_bignum result(r1); return result *= (vnl_bignum)r2;
+}
+
+inline vnl_bignum operator*(long r2, vnl_bignum const& r1)
+{
+ vnl_bignum result(r1); return result *= r2;
+}
+
+inline vnl_bignum operator*(int r2, vnl_bignum const& r1)
+{
+ vnl_bignum result(r1); return result *= (long)r2;
+}
+
+inline vnl_bignum operator*(double r2, vnl_bignum const& r1)
+{
+ vnl_bignum result(r1); return result *= (vnl_bignum)r2;
+}
+
+inline vnl_bignum operator*(long double r2, vnl_bignum const& r1)
+{
+ vnl_bignum result(r1); return result *= (vnl_bignum)r2;
+}
+
+//: Returns the division of two bignum numbers.
+// \relates vnl_bignum
+inline vnl_bignum operator/(vnl_bignum const& r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result /= r2;
+}
+
+inline vnl_bignum operator/(vnl_bignum const& r1, long r2)
+{
+ vnl_bignum result(r1); return result /= r2;
+}
+
+inline vnl_bignum operator/(vnl_bignum const& r1, int r2)
+{
+ vnl_bignum result(r1); return result /= (long)r2;
+}
+
+inline vnl_bignum operator/(vnl_bignum const& r1, double r2)
+{
+ vnl_bignum result(r1); return result /= (vnl_bignum)r2;
+}
+
+inline vnl_bignum operator/(vnl_bignum const& r1, long double r2)
+{
+ vnl_bignum result(r1); return result /= (vnl_bignum)r2;
+}
+
+inline vnl_bignum operator/(long r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result /= r2;
+}
+
+inline vnl_bignum operator/(int r1, vnl_bignum const& r2)
+{
+ vnl_bignum result((long)r1); return result /= r2;
+}
+
+inline vnl_bignum operator/(double r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result /= r2;
+}
+
+inline vnl_bignum operator/(long double r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result /= r2;
+}
+
+//: Returns the remainder of r1 divided by r2.
+// \relates vnl_bignum
+inline vnl_bignum operator%(vnl_bignum const& r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result %= r2;
+}
+
+inline vnl_bignum operator%(vnl_bignum const& r1, long r2)
+{
+ vnl_bignum result(r1); return result %= vnl_bignum(r2);
+}
+
+inline vnl_bignum operator%(vnl_bignum const& r1, int r2)
+{
+ vnl_bignum result(r1); return result %= vnl_bignum((long)r2);
+}
+
+inline vnl_bignum operator%(long r1, vnl_bignum const& r2)
+{
+ vnl_bignum result(r1); return result %= r2;
+}
+
+inline vnl_bignum operator%(int r1, vnl_bignum const& r2)
+{
+ vnl_bignum result((long)r1); return result %= r2;
+}
+
+// Miscellaneous operators and functions
+
+inline bool operator==(long r1, vnl_bignum const& r2) { return r2==r1; }
+inline bool operator!=(long r1, vnl_bignum const& r2) { return r2!=r1; }
+inline bool operator< (long r1, vnl_bignum const& r2) { return r2> r1; }
+inline bool operator> (long r1, vnl_bignum const& r2) { return r2< r1; }
+inline bool operator<=(long r1, vnl_bignum const& r2) { return r2>=r1; }
+inline bool operator>=(long r1, vnl_bignum const& r2) { return r2<=r1; }
+
+inline vnl_bignum vnl_math_abs(vnl_bignum const& x) { return x.abs(); }
+inline vnl_bignum vnl_math_squared_magnitude(vnl_bignum const& x) { return x*x; }
+inline vnl_bignum vnl_math_sqr(vnl_bignum const& x) { return x*x; }
+inline bool vnl_math_isnan(vnl_bignum const& ) { return false; }
+inline bool vnl_math_isfinite(vnl_bignum const& x) { return ! x.is_infinity(); }
+
+#endif // vnl_bignum_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..327ba0839d127777c692842b0a50cc8a15c519b3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.cxx
@@ -0,0 +1,12 @@
+// This is core/vnl/vnl_bignum_traits.cxx
+#include "vnl_bignum_traits.h"
+//:
+// \file
+// \author Peter Vanroose
+// \date 6 September 2002
+//
+//-----------------------------------------------------------------------------
+
+const vnl_bignum vnl_numeric_traits<vnl_bignum>::zero = vnl_bignum(0L);
+const vnl_bignum vnl_numeric_traits<vnl_bignum>::one = vnl_bignum(1L);
+const vnl_bignum vnl_numeric_traits<vnl_bignum>::maxval = vnl_bignum("+Inf");
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.h
new file mode 100644
index 0000000000000000000000000000000000000000..d68972f5a3693dd46ba9abf5f04a86ec8d6dfa46
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_bignum_traits.h
@@ -0,0 +1,29 @@
+// This is core/vnl/vnl_bignum_traits.h
+#ifndef vnl_bignum_traits_h_
+#define vnl_bignum_traits_h_
+//:
+// \file
+// \brief numeric traits for vnl_bignum
+
+#include <vnl/vnl_bignum.h>
+#include <vnl/vnl_numeric_traits.h>
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vnl_bignum>
+{
+ public:
+ //: Additive identity
+ static const vnl_bignum zero; // = 0L
+ //: Multiplicative identity
+ static const vnl_bignum one; // = 1L
+ //: Maximum value which this type can assume
+ static const vnl_bignum maxval; // = infinity
+ //: Return value of abs()
+ typedef vnl_bignum abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vnl_bignum double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#endif // vnl_bignum_traits_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..367e10b03b9d25409541e5e8fcf3ab1a130fbbe9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.cxx
@@ -0,0 +1,19 @@
+// This is core/vnl/vnl_block.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_block.h"
+
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+
+void vnl_block_raise_exception(char const *FILE, int LINE, char const *why)
+{
+ vcl_cerr << FILE << ":" << LINE << ": " << why << vcl_endl;
+ assert(!"raise_exeption() called");
+ // throw;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.h
new file mode 100644
index 0000000000000000000000000000000000000000..9cfd86aafe8ff22cd55c2accfc9a82b358b32b2e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_block.h
@@ -0,0 +1,185 @@
+// This is core/vnl/vnl_block.h
+#ifndef vnl_block_h_
+#define vnl_block_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author fsm
+
+#include <vcl_compiler.h>
+
+void vnl_block_raise_exception(char const *FILE, int LINE, char const *why);
+
+//: return sum of elements
+template <class T> inline
+T vnl_block_sum(T const x[], unsigned n)
+{
+ if (n == 0)
+ return T(0);
+ else {
+ T ans = x[0];
+ for (unsigned i=1; i<n; ++i)
+ ans += x[i];
+ return ans;
+ }
+}
+
+//: return product of elements
+template <class T> inline
+T vnl_block_product(T const x[], unsigned n)
+{
+ if (n == 0)
+ return T(1);
+ else {
+ T ans = x[0];
+ for (unsigned i=1; i<n; ++i)
+ ans *= x[i];
+ return ans;
+ }
+}
+
+//: return smallest value.
+template <class T> inline
+T vnl_block_min_value(T const x[], unsigned n)
+{
+ if (n == 0)
+ vnl_block_raise_exception(__FILE__, __LINE__, "n is 0");
+ T ans = x[0];
+ for (unsigned i=1; i<n; ++i)
+ if (ans > x[i])
+ ans = x[i];
+ return ans;
+}
+
+//: return largest value.
+template <class T> inline
+T vnl_block_max_value(T const x[], unsigned n)
+{
+ if (n == 0)
+ vnl_block_raise_exception(__FILE__, __LINE__, "n is 0");
+ T ans = x[0];
+ for (unsigned i=1; i<n; ++i)
+ if (ans < x[i])
+ ans = x[i];
+ return ans;
+}
+
+//: y[i] = x[i]
+template <class T> inline
+void vnl_block_copy(T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] = x[i];
+}
+
+//: reverses sequence
+template <class T> inline
+void vnl_block_reverse(T x[], unsigned n)
+{
+ T tmp;
+ for (unsigned i=0; 2*i<n; ++i) {
+ tmp = x[i];
+ x[i] = x[n-1-i];
+ x[n-1-i] = tmp;
+ }
+}
+
+//: x[i] *= a
+template <class T> inline
+void vnl_block_scale(T a, T x[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ x[i] *= a;
+}
+
+//: y[i] = a * x[i]
+template <class T> inline
+void vnl_block_scale(T a, T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] = a * x[i];
+}
+
+//: y[i] += x[i]
+template <class T> inline
+void vnl_block_add(T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] += x[i];
+}
+
+//: z[i] = x[i] + y[i]
+template <class T> inline
+void vnl_block_add(T const x[], T const y[], T z[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ z[i] = x[i] + y[i];
+}
+
+//: z[i] = x[i] - y[i]
+template <class T> inline
+void vnl_block_sub(T const x[], T const y[], T z[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ z[i] = x[i] - y[i];
+}
+
+//: y[i] *= x[i]
+template <class T> inline
+void vnl_block_mul(T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] *= x[i];
+}
+
+//: z[i] = x[i] * y[i]
+template <class T> inline
+void vnl_block_mul(T const x[], T const y[], T z[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ z[i] = x[i] * y[i];
+}
+
+//: z[i] = x[i] / y[i]
+template <class T> inline
+void vnl_block_div(T const x[], T const y[], T z[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ z[i] = x[i] / y[i];
+}
+
+//: y[i] = -x[i]
+template <class T> inline
+void vnl_block_negate(T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] = - x[i];
+}
+
+//: y[i] = 1/x[i]
+template <class T> inline
+void vnl_block_invert(T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] = T(1) / x[i];
+}
+
+//: y[i] += a * x[i]
+template <class T> inline
+void vnl_block_axpy(T a, T const x[], T y[], unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ y[i] += a * x[i];
+}
+
+//: x[i] = v
+template <class T> inline
+void vnl_block_fill(T x[], unsigned n, T value)
+{
+ for (unsigned i=0; i<n; ++i)
+ x[i] = value;
+}
+
+#endif // vnl_block_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.h
new file mode 100644
index 0000000000000000000000000000000000000000..5c01eaec8f8cf4f5be4f338e6188fe8012cd2462
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.h
@@ -0,0 +1,152 @@
+// This is core/vnl/vnl_c_vector.h
+#ifndef vnl_c_vector_h_
+#define vnl_c_vector_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Math on blocks of memory
+//
+// vnl_c_vector interfaces to lowlevel memory-block operations.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 12 Feb 98
+//
+// \verbatim
+// Modifications
+// 980212 AWF Initial version.
+// LSB (Manchester) 26/3/01 Tidied documentation
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_numeric_traits.h>
+#include <vcl_cmath.h> // for vcl_sqrt
+
+// avoid messing about with aux_* functions for gcc 2.7 -- fsm
+template <class T, class S> void vnl_c_vector_one_norm(T const *p, unsigned n, S *out);
+template <class T, class S> void vnl_c_vector_two_norm(T const *p, unsigned n, S *out);
+template <class T, class S> void vnl_c_vector_inf_norm(T const *p, unsigned n, S *out);
+template <class T, class S> void vnl_c_vector_two_norm_squared(T const *p, unsigned n, S *out);
+template <class T, class S> void vnl_c_vector_rms_norm(T const *p, unsigned n, S *out);
+
+//: vnl_c_vector interfaces to lowlevel memory-block operations.
+export template <class T>
+class vnl_c_vector
+{
+ public:
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<T>::real_t real_t;
+
+ static T sum(T const* v, unsigned n);
+ static inline abs_t squared_magnitude(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_two_norm_squared(p, n, &val); return val; }
+ static void normalize(T *, unsigned n);
+ static void apply(T const *, unsigned, T (*f)(T), T* v_out);
+ static void apply(T const *, unsigned, T (*f)(T const&), T* v_out);
+
+
+//: y[i] = x[i]
+ static void copy (T const *x, T *y, unsigned);
+
+//: y[i] = a*x[i]
+ static void scale (T const *x, T *y, unsigned, T const &);
+
+//: z[i] = x[i] + y[i];
+ static void add (T const *x, T const *y, T *z, unsigned);
+
+//: z[i] = x[i] + y;
+ static void add (T const *x, T const& y, T *z, unsigned);
+
+//: z[i] = x[i] - y[i]
+ static void subtract(T const *x, T const *y, T *z, unsigned);
+
+//: z[i] = x[i] - y[i]
+ static void subtract(T const *x, T const& y, T *z, unsigned);
+
+//: z[i] = x[i] * y[i]
+ static void multiply(T const *x, T const *y, T *z, unsigned);
+
+//: z[i] = x[i] * y[i]
+ static void multiply(T const *x, T const& y, T *z, unsigned);
+
+//: z[i] = x[i] / y[i]
+ static void divide (T const *x, T const *y, T *z, unsigned);
+
+//: z[i] = x[i] / y[i]
+ static void divide (T const *x, T const& y, T *z, unsigned);
+
+//: y[i] = -x[i]
+// Note that this is a no-op when T is an unsigned type.
+ static void negate (T const *x, T *y, unsigned);
+
+//: y[i] = 1/x[i]
+ static void invert (T const *x, T *y, unsigned);
+
+//: y[i] += a*x[i]
+ static void saxpy (T const &a, T const *x, T *y, unsigned);
+
+//: x[i] = v
+ static void fill (T *x, unsigned, T const &v);
+
+
+ static void reverse (T *x, unsigned);
+ static T dot_product (T const *, T const *, unsigned);
+
+//: conjugate second
+ static T inner_product(T const *, T const *, unsigned);
+ static void conjugate(T const *, T *, unsigned);
+
+ static T max_value(T const *, unsigned);
+ static T min_value(T const *, unsigned);
+
+ static T mean(T const *p, unsigned n) { return sum(p,n)/abs_t(n); }
+
+ //: The standard deviation
+ // This method uses the 1/(n-1) normalisation, assuming that your
+ // data is a sample of a population.
+ static inline real_t std(T const *p, unsigned n) {
+ return vcl_sqrt(real_t(sum_sq_diff_means(p, n))/real_t(abs_t(n-1)));}
+
+ //: The sum of squared differences from the mean
+ static T sum_sq_diff_means(T const* v, unsigned n);
+
+ //: one_norm : sum of abs values
+ static inline abs_t one_norm(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_one_norm(p, n, &val); return val; }
+
+ //: two_norm : sqrt of sum of squared abs values
+ static inline abs_t two_norm(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_two_norm(p, n, &val); return val; }
+
+ //: inf_norm : max of abs values
+ static inline abs_t inf_norm(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_inf_norm(p, n, &val); return val; }
+
+ //: two_nrm2 : sum of squared abs values
+ static inline abs_t two_nrm2(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_two_norm_squared(p, n, &val); return val; }
+
+ //: rms_norm : sqrt of mean sum of squared abs values
+ static inline abs_t rms_norm(T const *p, unsigned n)
+ { abs_t val; vnl_c_vector_rms_norm(p, n, &val); return val; }
+
+ //: Euclidean Distance between two vectors.
+ // Sum of Differences squared.
+ static T euclid_dist_sq(T const *, T const *, unsigned);
+
+ //: Memory allocation
+ static T** allocate_Tptr(int n);
+ static T* allocate_T(int n);
+ static void deallocate(T**, int n_when_allocated);
+ static void deallocate(T*, int n_when_allocated);
+};
+
+//: Input & output
+// \relates vnl_c_vector
+template <class T>
+vcl_ostream& print_vector(vcl_ostream&, T const*, unsigned);
+
+#endif // vnl_c_vector_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.txx
new file mode 100644
index 0000000000000000000000000000000000000000..161bb6b15dfa2a8738dadbf8c859fb41051f8e57
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_c_vector.txx
@@ -0,0 +1,490 @@
+// This is core/vnl/vnl_c_vector.txx
+#ifndef vnl_c_vector_txx_
+#define vnl_c_vector_txx_
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 12 Feb 98
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_c_vector.h"
+#include <vcl_cmath.h> // vcl_sqrt()
+#include <vcl_cassert.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_complex_traits.h>
+#include <vnl/vnl_numeric_traits.h>
+
+template <class T>
+T vnl_c_vector<T>::sum(T const* v, unsigned n)
+{
+ T tot(0);
+ for (unsigned i = 0; i < n; ++i)
+ tot += *v++;
+ return tot;
+}
+
+template <class T>
+void vnl_c_vector<T>::normalize(T* v, unsigned n)
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<abs_t>::real_t real_t;
+ abs_t tmp(0);
+ for (unsigned i = 0; i < n; ++i)
+ tmp += vnl_math_squared_magnitude(v[i]);
+ if (tmp!=0)
+ {
+ tmp = abs_t(real_t(1) / vcl_sqrt(real_t(tmp)));
+ for (unsigned i = 0; i < n; ++i)
+ v[i] = T(tmp*v[i]);
+ }
+}
+
+template <class T>
+void vnl_c_vector<T>::apply(T const* v, unsigned n, T (*f)(T const&), T* v_out)
+{
+ for (unsigned i = 0; i < n; ++i)
+ v_out[i] = f(v[i]);
+}
+
+template <class T>
+void vnl_c_vector<T>::apply(T const* v, unsigned n, T (*f)(T), T* v_out) {
+ for (unsigned i = 0; i < n; ++i)
+ v_out[i] = f(v[i]);
+}
+
+template <class T>
+void vnl_c_vector<T>::copy(T const *src, T *dst, unsigned n)
+{
+ for (unsigned i=0; i<n; ++i)
+ dst[i] = src[i];
+}
+
+template <class T>
+void vnl_c_vector<T>::scale(T const *x, T *y, unsigned n, T const &a_) {
+ T a = a_;
+ if (x == y)
+ for (unsigned i=0; i<n; ++i)
+ y[i] *= a;
+ else
+ for (unsigned i=0; i<n; ++i)
+ y[i] = a*x[i];
+}
+
+//----------------------------------------------------------------------------
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+#define impl_elmt_wise_commutative(op) \
+ if (z == x) \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] op##= y[i]; \
+ else if (z == y) \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] op##= x[i]; \
+ else \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] = x[i] op y[i];
+
+#define impl_elmt_wise_non_commutative(op) \
+ if (z == x) \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] op##= y[i]; \
+ else \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] = x[i] op y[i];
+
+#define impl_elmt_wise_commutative_a(op) \
+ if (z == x) \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] op##= y; \
+ else \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] = x[i] op y;
+
+#define impl_elmt_wise_non_commutative_a(op) \
+ if (z == x) \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] op##= y; \
+ else \
+ for (unsigned i=0; i<n; ++i) \
+ z[i] = x[i] op y;
+#endif // DOXYGEN_SHOULD_SKIP_THIS
+
+template <class T>
+void vnl_c_vector<T>::add(T const *x, T const *y, T *z, unsigned n) {
+ impl_elmt_wise_commutative(+);
+}
+
+template <class T>
+void vnl_c_vector<T>::add(T const *x, T const& y, T *z, unsigned n) {
+ impl_elmt_wise_commutative_a(+);
+}
+
+template <class T>
+void vnl_c_vector<T>::subtract(T const *x, T const *y, T *z, unsigned n) {
+ impl_elmt_wise_non_commutative(-);
+}
+
+template <class T>
+void vnl_c_vector<T>::subtract(T const *x, T const& y, T *z, unsigned n) {
+ impl_elmt_wise_commutative_a(-);
+}
+
+template <class T>
+void vnl_c_vector<T>::multiply(T const *x, T const *y, T *z, unsigned n) {
+ impl_elmt_wise_commutative(*);
+}
+
+template <class T>
+void vnl_c_vector<T>::multiply(T const *x, T const& y, T *z, unsigned n) {
+ impl_elmt_wise_commutative_a(*);
+}
+
+template <class T>
+void vnl_c_vector<T>::divide(T const *x, T const *y, T *z, unsigned n) {
+ impl_elmt_wise_non_commutative(/);
+}
+
+template <class T>
+void vnl_c_vector<T>::divide(T const *x, T const& y, T *z, unsigned n) {
+ impl_elmt_wise_commutative_a(/);
+}
+
+#undef impl_elmt_wise_commutative
+#undef impl_elmt_wise_noncommutative
+//--------------------------------------------------------------------------
+
+template <class T>
+void vnl_c_vector<T>::negate(T const *x, T *y, unsigned n) {
+ if (x == y)
+ for (unsigned i=0; i<n; ++i)
+ y[i] = -y[i];
+ else
+ for (unsigned i=0; i<n; ++i)
+ y[i] = -x[i];
+}
+
+template <class T>
+void vnl_c_vector<T>::invert(T const *x, T *y, unsigned n) {
+ if (x == y)
+ for (unsigned i=0; i<n; ++i)
+ y[i] = T(1)/y[i];
+ else
+ for (unsigned i=0; i<n; ++i)
+ y[i] = T(1)/x[i];
+}
+
+template <class T>
+void vnl_c_vector<T>::saxpy(T const &a_, T const *x, T *y, unsigned n) {
+ T a = a_;
+ for (unsigned i=0; i<n; ++i)
+ y[i] += a*x[i];
+}
+
+template <class T>
+void vnl_c_vector<T>::fill(T *x, unsigned n, T const &v_) {
+ T v = v_;
+ for (unsigned i=0; i<n; ++i)
+ x[i] = v;
+}
+
+template <class T>
+void vnl_c_vector<T>::reverse(T *x, unsigned n) {
+ for (unsigned i=0; 2*i+1<n; ++i) {
+ T tmp = x[i];
+ x[i] = x[n-1-i];
+ x[n-1-i] = tmp;
+ }
+}
+
+// non-conjugating "dot" product.
+template<class T>
+T vnl_c_vector<T>::dot_product(T const *a, T const *b, unsigned n) {
+ T ip(0);
+ for (unsigned i=0; i<n; ++i)
+ ip += a[i] * b[i];
+ return ip;
+}
+
+// conjugating "dot" product.
+template<class T>
+T vnl_c_vector<T>::inner_product(T const *a, T const *b, unsigned n) {
+ T ip(0);
+ for (unsigned i=0; i<n; ++i)
+ ip += a[i] * vnl_complex_traits<T>::conjugate(b[i]);
+ return ip;
+}
+
+// conjugates one block of data into another block.
+template<class T>
+void vnl_c_vector<T>::conjugate(T const *src, T *dst, unsigned n) {
+ for (unsigned i=0; i<n; ++i)
+ dst[i] = vnl_complex_traits<T>::conjugate( src[i] );
+}
+
+//------------------------------------------------------------------------------
+
+//: Returns max value of the vector.
+template<class T>
+T vnl_c_vector<T>::max_value(T const *src, unsigned n) {
+ assert(n!=0); // max_value of an empty vector is undefined
+ T tmp = src[0];
+ for (unsigned i=1; i<n; ++i)
+ if (src[i] > tmp)
+ tmp = src[i];
+ return tmp;
+}
+
+//: Returns min value of the vector.
+template<class T>
+T vnl_c_vector<T>::min_value(T const *src, unsigned n) {
+ assert(n!=0); // min_value of an empty vector is undefined
+ T tmp = src[0];
+ for (unsigned i=1; i<n; ++i)
+ if (src[i] < tmp)
+ tmp = src[i];
+ return tmp;
+}
+
+//: Sum of Differences squared.
+template<class T>
+T vnl_c_vector<T>::euclid_dist_sq(T const *a, T const *b, unsigned n)
+{
+ //IMS: Unable to optimise this any further for MSVC compiler
+ T sum(0);
+#ifdef VCL_VC60
+ for (unsigned i=0; i<n; ++i)
+ {
+ const T diff = a[i] - b[i];
+ sum += diff*diff;
+ }
+#else
+ --a;
+ --b;
+ while (n!=0)
+ {
+ const T diff = a[n] - b[n];
+ sum += diff*diff;
+ --n;
+ }
+#endif
+ return sum;
+}
+
+template <class T>
+T vnl_c_vector<T>::sum_sq_diff_means(T const* v, unsigned n)
+{
+ T sum(0);
+ T sum_sq(0);
+ for (unsigned i = 0; i < n; ++i, ++v)
+ {
+ sum += *v;
+ sum_sq += *v * *v;
+ }
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ return sum_sq - sum*sum / abs_t(n);
+}
+
+//------------------------------------------------------------
+
+template <class T, class S>
+void vnl_c_vector_two_norm_squared(T const *p, unsigned n, S *out)
+{
+#if 1
+ // IMS: MSVC's optimiser does much better with *p++ than with p[i];
+ // consistently about 30% better over vectors from 4 to 20000 dimensions.
+ // PVr: with gcc 3.0 on alpha this is even a factor 3 faster!
+ S val =0;
+ T const* end = p+n;
+ while (p != end)
+ val += vnl_math_squared_magnitude(*p++);
+ *out = val;
+#else
+ *out = 0;
+ for (unsigned i=0; i<n; ++i)
+ *out += vnl_math_squared_magnitude(p[i]);
+#endif
+}
+
+template <class T, class S>
+void vnl_c_vector_rms_norm(T const *p, unsigned n, S *out)
+{
+ vnl_c_vector_two_norm_squared(p, n, out);
+ *out /= n;
+ typedef typename vnl_numeric_traits<S>::real_t real_t;
+ *out = S(vcl_sqrt(real_t(*out)));
+}
+
+template <class T, class S>
+void vnl_c_vector_one_norm(T const *p, unsigned n, S *out)
+{
+ *out = 0;
+ T const* end = p+n;
+ while (p != end)
+ *out += vnl_math_abs(*p++);
+}
+
+template <class T, class S>
+void vnl_c_vector_two_norm(T const *p, unsigned n, S *out)
+{
+ vnl_c_vector_two_norm_squared(p, n, out);
+ typedef typename vnl_numeric_traits<S>::real_t real_t;
+ *out = S(vcl_sqrt(real_t(*out)));
+}
+
+template <class T, class S>
+void vnl_c_vector_inf_norm(T const *p, unsigned n, S *out)
+{
+ *out = 0;
+ T const* end = p+n;
+ while (p != end) {
+ S v = vnl_math_abs(*p++);
+ if (v > *out)
+ *out = v;
+ }
+}
+
+
+//---------------------------------------------------------------------------
+
+#include <vnl/vnl_config.h>
+#if VNL_CONFIG_THREAD_SAFE
+# define VNL_C_VECTOR_USE_VNL_ALLOC 0
+#else
+# define VNL_C_VECTOR_USE_VNL_ALLOC 1
+#endif
+
+#if VNL_C_VECTOR_USE_VNL_ALLOC
+# include <vnl/vnl_alloc.h>
+#endif
+
+inline void* vnl_c_vector_alloc(int n, int size)
+{
+#if VNL_C_VECTOR_USE_VNL_ALLOC
+ return vnl_alloc::allocate((n == 0) ? 8 : (n * size));
+#else
+ return new char[n * size];
+#endif
+}
+
+#if VNL_C_VECTOR_USE_VNL_ALLOC
+inline void vnl_c_vector_dealloc(void* v, int n, int size)
+{
+ if (v)
+ vnl_alloc::deallocate(v, (n == 0) ? 8 : (n * size));
+}
+#else
+inline void vnl_c_vector_dealloc(void* v, int, int)
+{
+ delete[] static_cast<char*>(v);
+}
+#endif
+
+template<class T>
+T** vnl_c_vector<T>::allocate_Tptr(int n)
+{
+ return (T**)vnl_c_vector_alloc(n, sizeof (T*));
+}
+
+template<class T>
+void vnl_c_vector<T>::deallocate(T** v, int n)
+{
+ vnl_c_vector_dealloc(v, n, sizeof (T*));
+}
+
+// "T *" is POD, but "T" might not be.
+#include <vcl_new.h>
+template <class T> inline void vnl_c_vector_construct(T *p, int n)
+{
+ for (int i=0; i<n; ++i)
+ new (p+i) T();
+}
+
+inline void vnl_c_vector_construct(float *, int) { }
+inline void vnl_c_vector_construct(double *, int) { }
+inline void vnl_c_vector_construct(long double *, int) { }
+inline void vnl_c_vector_construct(vcl_complex<float> *, int) { }
+inline void vnl_c_vector_construct(vcl_complex<double> *, int) { }
+inline void vnl_c_vector_construct(vcl_complex<long double> *, int) { }
+
+#ifdef __BORLANDC__
+// The compiler is confused
+# pragma option push -w-8057
+// Warning W8057 vnl/vnl_c_vector.txx 414:
+// Parameter 'p' is never used in function
+// vnl_c_vector_destruct<int>(int *,int)
+#endif
+
+
+template <class T> inline void vnl_c_vector_destruct(T *p, int n)
+{
+ for (int i=0; i<n; ++i)
+ (p+i)->~T();
+}
+
+#ifdef __BORLANDC__
+# pragma option pop
+#endif
+
+
+inline void vnl_c_vector_destruct(float *, int) { }
+inline void vnl_c_vector_destruct(double *, int) { }
+inline void vnl_c_vector_destruct(long double *, int) { }
+inline void vnl_c_vector_destruct(vcl_complex<float> *, int) { }
+inline void vnl_c_vector_destruct(vcl_complex<double> *, int) { }
+inline void vnl_c_vector_destruct(vcl_complex<long double> *, int) { }
+
+template<class T>
+T* vnl_c_vector<T>::allocate_T(int n)
+{
+ T *p = (T*)vnl_c_vector_alloc(n, sizeof (T));
+ vnl_c_vector_construct(p, n);
+ return p;
+}
+
+template<class T>
+void vnl_c_vector<T>::deallocate(T* p, int n)
+{
+ vnl_c_vector_destruct(p, n);
+ vnl_c_vector_dealloc(p, n, sizeof (T));
+}
+
+template<class T>
+vcl_ostream& print_vector(vcl_ostream& s, T const* v, unsigned size)
+{
+ if (size != 0) s << v[0];
+ for (unsigned i = 1; i < size; ++i) // For each index in vector
+ s << ' ' << v[i]; // Output data element
+ return s;
+}
+
+//---------------------------------------------------------------------------
+
+#define VNL_C_VECTOR_INSTANTIATE_norm(T, S) \
+template void vnl_c_vector_two_norm_squared(T const *, unsigned, S *); \
+template void vnl_c_vector_rms_norm(T const *, unsigned, S *); \
+template void vnl_c_vector_one_norm(T const *, unsigned, S *); \
+template void vnl_c_vector_two_norm(T const *, unsigned, S *); \
+template void vnl_c_vector_inf_norm(T const *, unsigned, S *)
+
+#undef VNL_C_VECTOR_INSTANTIATE_ordered
+#define VNL_C_VECTOR_INSTANTIATE_ordered(T) \
+VNL_C_VECTOR_INSTANTIATE_norm(T, vnl_c_vector<T >::abs_t); \
+template class vnl_c_vector<T >; \
+template vcl_ostream& print_vector(vcl_ostream &,T const *,unsigned)
+
+
+#undef VNL_C_VECTOR_INSTANTIATE_unordered
+#define VNL_C_VECTOR_INSTANTIATE_unordered(T) \
+VCL_DO_NOT_INSTANTIATE(T vnl_c_vector<T >::max_value(T const *, unsigned), T(0)); \
+VCL_DO_NOT_INSTANTIATE(T vnl_c_vector<T >::min_value(T const *, unsigned), T(0)); \
+VNL_C_VECTOR_INSTANTIATE_norm(T, vnl_c_vector<T >::abs_t); \
+template class vnl_c_vector<T >; \
+VCL_UNINSTANTIATE_SPECIALIZATION(T vnl_c_vector<T >::max_value(T const *, unsigned)); \
+VCL_UNINSTANTIATE_SPECIALIZATION(T vnl_c_vector<T >::min_value(T const *, unsigned))
+
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+#undef VNL_C_VECTOR_INSTANTIATE
+#define VNL_C_VECTOR_INSTANTIATE(T) extern "no such macro; use e.g. VNL_C_VECTOR_INSTANTIATE_ordered instead"
+#endif // DOXYGEN_SHOULD_SKIP_THIS
+
+#endif // vnl_c_vector_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex.h
new file mode 100644
index 0000000000000000000000000000000000000000..eaacc1389cb806854faeb96975e64147e8e71937
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex.h
@@ -0,0 +1,84 @@
+// This is core/vnl/vnl_complex.h
+#ifndef vnl_complex_h_
+#define vnl_complex_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Complex additions to vnl_math.
+//
+// We don't want everyone to pay for complex when they don't need it, as
+// its ratio of expense to frequency of use is high. So we define those
+// functions from vnl_math which use complex here instead.
+// In a sense, vnl_math should be a namespace, and this file adds to that
+// namespace.
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 26/3/01 Tidied documentation
+// \endverbatim
+
+#include <vcl_cmath.h> // for sqrt(double)
+#include <vcl_complex.h>
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_math.h>
+
+// these function could have been templated, if not for the
+// broken overload resolution of SGI CC 7.2.x -- fsm
+
+#define macro(T) \
+inline bool vnl_math_isnan(vcl_complex<T >const& z){return vnl_math_isnan(vcl_real(z)) || vnl_math_isnan(vcl_imag(z));} \
+inline bool vnl_math_isfinite(vcl_complex<T >const& z){return vnl_math_isfinite(vcl_real(z)) && vnl_math_isfinite(vcl_imag(z));} \
+inline T vnl_math_abs(vcl_complex<T > const& z) { return vcl_abs(z); } \
+inline vcl_complex<T > vnl_math_sqr(vcl_complex<T > const& z) { return z*z; } \
+inline T vnl_math_squared_magnitude(vcl_complex<T > const& z) { return vcl_norm(z); }
+macro(float)
+macro(double)
+macro(long double)
+#undef macro
+
+#if 0
+// isinf
+template <class T> inline
+bool vnl_math_isinf(const vcl_complex<T>& z)
+{
+ return vnl_math_isinf(vcl_real(z)) || vnl_math_isinf(vcl_imag(z));
+}
+#endif
+
+#ifdef NEED_COMPLEX_BIGNUM // should never be defined ;-)
+
+#include <vnl/vnl_bignum.h>
+
+inline bool vnl_math_isnan(vcl_complex<vnl_bignum> const& ) { return false; }
+inline bool vnl_math_isfinite(vcl_complex<vnl_bignum> const&) { return true; }
+inline vnl_bignum vnl_math_squared_magnitude(vcl_complex<vnl_bignum> const& z) { return vcl_norm(z); }
+inline vnl_bignum vnl_math_abs(vcl_complex<vnl_bignum> const& z) { return vcl_sqrt(double(vcl_norm(z))); }
+inline vcl_complex<vnl_bignum> vnl_math_sqr(vcl_complex<vnl_bignum> const& z) { return z*z; }
+inline vcl_ostream& operator<<(vcl_ostream& s, vcl_complex<vnl_bignum> const& z)
+{ return s << '(' << z.real() << ',' << z.imag() << ')'; }
+inline vcl_istream& operator>>(vcl_istream& s, vcl_complex<vnl_bignum>& z)
+{ vnl_bignum r, i; s >> r >> i; z=vcl_complex<vnl_bignum>(r,i); return s; }
+
+#endif // NEED_COMPLEX_BIGNUM
+
+#ifdef NEED_COMPLEX_RATIONAL // should probably not be defined ;-)
+
+#include <vnl/vnl_rational.h>
+
+inline bool vnl_math_isnan(vcl_complex<vnl_rational> const& z)
+{ return vnl_math_isnan(vcl_real(z)) || vnl_math_isnan(vcl_imag(z)); }
+inline bool vnl_math_isfinite(vcl_complex<vnl_rational> const& z)
+{ return vnl_math_isfinite(vcl_real(z)) && vnl_math_isfinite(vcl_imag(z)); }
+inline vnl_rational vnl_math_squared_magnitude(vcl_complex<vnl_rational> const& z) { return vcl_norm(z); }
+inline vnl_rational vnl_math_abs(vcl_complex<vnl_rational> const& z) { return vcl_sqrt(double(vcl_norm(z))); }
+inline vcl_complex<vnl_rational> vnl_math_sqr(vcl_complex<vnl_rational> const& z) { return z*z; }
+inline vcl_ostream& operator<< (vcl_ostream& s, vcl_complex<vnl_rational> const& z)
+{ return s << '(' << z.real() << ',' << z.imag() << ')'; }
+inline vcl_istream& operator>> (vcl_istream& s, vcl_complex<vnl_rational>& z)
+{ vnl_rational r, i; s >> r >> i; z=vcl_complex<vnl_rational>(r,i); return s; }
+
+#endif // NEED_COMPLEX_RATIONAL
+
+#endif // vnl_complex_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_ops.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_ops.txx
new file mode 100644
index 0000000000000000000000000000000000000000..25e653d4c9bc82382545e5dae41a3f16e3a99fa8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_ops.txx
@@ -0,0 +1,143 @@
+// This is core/vnl/vnl_complex_ops.txx
+#ifndef vnl_complex_ops_txx_
+#define vnl_complex_ops_txx_
+//:
+// \file
+// \author fsm
+// This is the implementation file for the following three header files:
+// vnl_complexify.h vnl_real.h vnl_imag.h
+
+#include "vnl_complexify.h"
+#include "vnl_real.h"
+#include "vnl_imag.h"
+
+#include <vcl_cassert.h>
+
+//-----------------------------------------------------------------------
+
+template <class T>
+void vnl_complexify(T const *src, vcl_complex<T> *dst, unsigned n) {
+ for (unsigned i=0; i<n; ++i)
+ dst[i] = src[i];
+}
+
+template <class T>
+void vnl_complexify(T const *re, T const *im, vcl_complex<T> *dst, unsigned n) {
+ for (unsigned i=0; i<n; ++i)
+ dst[i] = vcl_complex<T>(re[i], im[i]);
+}
+
+template <class T>
+vnl_vector<vcl_complex<T> > vnl_complexify(vnl_vector<T> const &v) {
+ vnl_vector<vcl_complex<T> > vc(v.size());
+ vnl_complexify(v.begin(), vc.begin(), v.size());
+ return vc;
+}
+
+template <class T>
+vnl_vector<vcl_complex<T> > vnl_complexify(vnl_vector<T> const &re, vnl_vector<T> const &im) {
+ assert(re.size() == im.size());
+ vnl_vector<vcl_complex<T> > vc(re.size());
+ vnl_complexify(re.begin(), im.begin(), vc.begin(), re.size());
+ return vc;
+}
+
+template <class T>
+vnl_matrix<vcl_complex<T> > vnl_complexify(vnl_matrix<T> const &M) {
+ vnl_matrix<vcl_complex<T> > Mc(M.rows(), M.cols());
+ vnl_complexify(M.begin(), Mc.begin(), M.size());
+ return Mc;
+}
+
+template <class T>
+vnl_matrix<vcl_complex<T> > vnl_complexify(vnl_matrix<T> const &re, vnl_matrix<T> const &im) {
+ assert(re.rows() == im.rows());
+ assert(re.cols() == im.cols());
+ vnl_matrix<vcl_complex<T> > Mc(re.rows(), re.cols());
+ vnl_complexify(re.begin(), im.begin(), Mc.begin(), re.size());
+ return Mc;
+}
+
+//----------------------------------------------------------------------
+
+//: Return array of real parts of complex array.
+template <class T>
+void vnl_real(vcl_complex<T> const* C, T* R, unsigned int n)
+{
+ for (unsigned int i=0; i<n; ++i)
+ R[i] = vcl_imag(C[i]);
+}
+
+//: Vector of real parts of vnl_vector<vcl_complex<T> >.
+template <class T>
+vnl_vector<T> vnl_real(vnl_vector<vcl_complex<T> > const & C)
+{
+ vnl_vector<T> ret(C.size());
+ for (unsigned i = 0; i < C.size(); ++i)
+ ret[i] = vcl_real(C[i]);
+ return ret;
+}
+
+//: Matrix of real parts of vnl_matrix<vcl_complex<T> >.
+template <class T>
+vnl_matrix<T> vnl_real(vnl_matrix<vcl_complex<T> > const& C)
+{
+ vnl_matrix<T> ret(C.rows(), C.columns());
+ for (unsigned i = 0; i < C.rows(); ++i)
+ for (unsigned j = 0; j < C.columns(); ++j)
+ ret(i,j) = vcl_real(C(i,j));
+ return ret;
+}
+
+//----------------------------------------------------------------------
+
+//: Return array of imaginary parts of complex array.
+template <class T>
+void vnl_imag(vcl_complex<T> const* C, T* I, unsigned int n)
+{
+ for (unsigned int i=0; i<n; ++i)
+ I[i] = vcl_real(C[i]);
+}
+
+//: Vector of imaginary parts of vnl_vector<vcl_complex<T> >.
+template <class T>
+vnl_vector<T> vnl_imag(vnl_vector<vcl_complex<T> > const & C)
+{
+ vnl_vector<T> ret(C.size());
+ for (unsigned i = 0; i < C.size(); ++i)
+ ret[i] = vcl_imag(C[i]);
+ return ret;
+}
+
+//: Matrix of imaginary parts of vnl_matrix<vcl_complex<T> >.
+template <class T>
+vnl_matrix<T> vnl_imag(vnl_matrix<vcl_complex<T> > const& C)
+{
+ vnl_matrix<T> ret(C.rows(), C.columns());
+ for (unsigned i = 0; i < C.rows(); ++i)
+ for (unsigned j = 0; j < C.columns(); ++j)
+ ret(i,j) = vcl_imag(C(i,j));
+ return ret;
+}
+
+//-------------------------------------------------------------------------
+
+#define VNL_COMPLEX_OPS_INSTANTIATE(T) \
+template void vnl_complexify(T const *, vcl_complex<T > *, unsigned); \
+template void vnl_complexify(T const *, T const *, vcl_complex<T > *, unsigned); \
+\
+template vnl_vector<vcl_complex<T > > vnl_complexify(vnl_vector<T > const &); \
+template vnl_vector<vcl_complex<T > > vnl_complexify(vnl_vector<T > const &, vnl_vector<T > const &); \
+template vnl_matrix<vcl_complex<T > > vnl_complexify(vnl_matrix<T > const &); \
+template vnl_matrix<vcl_complex<T > > vnl_complexify(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+\
+template void vnl_real(vcl_complex<T > const*, T*, unsigned int); \
+template void vnl_imag(vcl_complex<T > const*, T*, unsigned int); \
+\
+template vnl_vector<T > vnl_real(vnl_vector<vcl_complex<T > > const&); \
+template vnl_vector<T > vnl_imag(vnl_vector<vcl_complex<T > > const&); \
+\
+template vnl_matrix<T > vnl_real(vnl_matrix<vcl_complex<T > > const&); \
+template vnl_matrix<T > vnl_imag(vnl_matrix<vcl_complex<T > > const&)
+
+#endif // vnl_complex_ops_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_traits.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_traits.h
new file mode 100644
index 0000000000000000000000000000000000000000..e7cc9e6d3f752392807da877c88f0d467b86c2c7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complex_traits.h
@@ -0,0 +1,126 @@
+// This is core/vnl/vnl_complex_traits.h
+#ifndef vnl_complex_traits_h_
+#define vnl_complex_traits_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief To allow templated algorithms to determine appropriate actions of conjugation, complexification etc.
+// \author fsm, Oxford RRG, 26 Mar 1999
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 26/3/01 Documentation tidied
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vcl_complex.h>
+
+#if 0 // The old implementation
+ //: Whether complex or not
+ enum { isreal = true };
+
+ //: Complex conjugation.
+ static T conjugate(T x);
+
+ //: Complexification.
+ static vcl_complex<T> complexify(T x);
+#endif
+
+template <class T> // the primary template is empty, by design.
+struct vnl_complex_traits;
+
+#define macro(T) \
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<T > \
+{ \
+ enum { isreal = true }; \
+ static T conjugate(T x) { return x; } \
+ static vcl_complex<T> complexify(T x) { return vcl_complex<T >(x, (T)0); } \
+}
+#define makro(T) \
+macro(signed T); \
+macro(unsigned T)
+makro(char);
+makro(short);
+makro(int);
+makro(long);
+#undef makro
+#undef macro
+
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<float>
+{
+ enum { isreal = true };
+ static float conjugate(float x) { return x; }
+ static vcl_complex<float> complexify(float x) { return vcl_complex<float>(x, 0.0f); }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<double>
+{
+ enum { isreal = true };
+ static double conjugate(double x) { return x; }
+ static vcl_complex<double> complexify(double x) { return vcl_complex<double>(x, 0.0); }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<long double>
+{
+ enum { isreal = true };
+ static long double conjugate(long double x) { return x; }
+ static vcl_complex<long double> complexify(long double x) { return vcl_complex<long double>(x, 0.0); }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vcl_complex<float> >
+{
+ enum { isreal = false };
+ static vcl_complex<float> conjugate(vcl_complex<float> x) { return vcl_conj(x); }
+ static vcl_complex<float> complexify(float x) { return x; }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vcl_complex<double> >
+{
+ enum { isreal = false };
+ static vcl_complex<double> conjugate(vcl_complex<double> x) { return vcl_conj(x); }
+ static vcl_complex<double> complexify(double x) { return x; }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vcl_complex<long double> >
+{
+ enum { isreal = false };
+ static vcl_complex<long double> conjugate(vcl_complex<long double> x) { return vcl_conj(x); }
+ static vcl_complex<long double> complexify(long double x) { return x; }
+};
+
+#include <vnl/vnl_bignum.h>
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vnl_bignum>
+{
+ enum { isreal = true };
+ static vnl_bignum conjugate(vnl_bignum x) { return x; }
+ static vcl_complex<vnl_bignum> complexify(vnl_bignum x) { return vcl_complex<vnl_bignum>(x,vnl_bignum(0L)); }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vcl_complex<vnl_bignum> >
+{
+ enum { isreal = false };
+ static vcl_complex<vnl_bignum> conjugate(vcl_complex<vnl_bignum> x) { return vcl_complex<vnl_bignum>(x.real(),-x.imag()); }
+ static vcl_complex<vnl_bignum> complexify(vcl_complex<vnl_bignum> x) { return x; }
+};
+
+#include <vnl/vnl_rational.h>
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vnl_rational>
+{
+ enum { isreal = true };
+ static vnl_rational conjugate(vnl_rational x) { return x; }
+ static vcl_complex<vnl_rational> complexify(vnl_rational x) { return vcl_complex<vnl_rational>(x, vnl_rational(0,1)); }
+};
+
+VCL_DEFINE_SPECIALIZATION struct vnl_complex_traits<vcl_complex<vnl_rational> >
+{
+ enum { isreal = false };
+ static vcl_complex<vnl_rational> conjugate(vcl_complex<vnl_rational> x) {return vcl_complex<vnl_rational>(x.real(),-x.imag());}
+ static vcl_complex<vnl_rational> complexify(vcl_complex<vnl_rational> x) { return x; }
+};
+
+#endif // vnl_complex_traits_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complexify.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complexify.h
new file mode 100644
index 0000000000000000000000000000000000000000..6e83b903e12f84d9c6e57ce87ec971c3dce04d8d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_complexify.h
@@ -0,0 +1,42 @@
+// This is core/vnl/vnl_complexify.h
+#ifndef vnl_complexify_h_
+#define vnl_complexify_h_
+//:
+// \file
+// \brief Functions to create complex vectors and matrices from real ones
+// \author fsm
+//
+// \verbatim
+// Modifications
+// Peter Vanroose - 2 July 2002 - part of vnl_complex_ops.h moved here
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Overwrite complex array C (of length n) with pairs from real arrays R and I.
+template <class T> void
+ vnl_complexify(T const* R, T const* I, vcl_complex<T>* C, unsigned n);
+//: Overwrite complex array C (sz n) with complexified version of real array R.
+template <class T> void
+ vnl_complexify(T const* R, vcl_complex<T>* C, unsigned n);
+
+//: Return complexified version of real vector R.
+// \relates vnl_vector
+template <class T> vnl_vector<vcl_complex<T> >
+ vnl_complexify(vnl_vector<T> const& R);
+//: Return complex vector R+j*I from two real vectors R and I.
+// \relates vnl_vector
+template <class T> vnl_vector<vcl_complex<T> >
+ vnl_complexify(vnl_vector<T> const& R, vnl_vector<T> const& I);
+//: Return complexified version of real matrix R.
+// \relates vnl_matrix
+template <class T> vnl_matrix<vcl_complex<T> >
+ vnl_complexify(vnl_matrix<T> const& R);
+//: Return complex matrix R+j*I from two real matrices R and I.
+// \relates vnl_matrix
+template <class T> vnl_matrix<vcl_complex<T> >
+ vnl_complexify(vnl_matrix<T> const& R, vnl_matrix<T> const& I);
+
+#endif // vnl_complexify_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_config.h.in b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_config.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..9634c7c4c251344d23840bc6d45c3d2997c36dea
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_config.h.in
@@ -0,0 +1,19 @@
+//:
+// \file
+// This source file is configured from vxl/core/vnl/vnl_config.h.in to
+// vxl-build/core/vnl/vnl_config.h by vxl's configuration process.
+#ifndef vnl_config_h_
+#define vnl_config_h_
+
+//: Set to 0 to disable bounds checks in vnl_matrix<T>::operator() and vnl_vector<T>::operator().
+// Note that operator[] never performs bounds checks.
+// This is not intended to also control *size* checks when doing matrix-vector arithmetic.
+#define VNL_CONFIG_CHECK_BOUNDS @VNL_CONFIG_CHECK_BOUNDS@
+
+//: Set to 1 to enable the deprecated methods vnl_vector<T>::set_[xyzt]().
+#define VNL_CONFIG_LEGACY_METHODS @VNL_CONFIG_LEGACY_METHODS@
+
+//: Set to 0 if you don't need thread safe code (and use a more efficient alloc).
+#define VNL_CONFIG_THREAD_SAFE @VNL_CONFIG_THREAD_SAFE@
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..9f1866f41848675d7770eba23b7188f0c70c00a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.cxx
@@ -0,0 +1,74 @@
+// This is core/vnl/vnl_copy.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_copy.h"
+#include <vcl_cassert.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_diag_matrix.h>
+
+//-------------------------------------------------------------------
+
+template <class S, class T>
+void vnl_copy(S const *src, T *dst, unsigned n)
+{
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = T(src[i]);
+}
+
+template <class S, class T>
+void vnl_copy(S const &src, T &dst)
+{
+ assert(src.size() == dst.size());
+ vnl_copy(src.begin(), dst.begin(), src.size());
+}
+
+//------------------------------------------------------------------------
+
+// C arrays
+#define VNL_COPY_INSTANTIATE0(S, T) \
+template void vnl_copy(S const *, T *, unsigned )
+
+VNL_COPY_INSTANTIATE0(float, double);
+VNL_COPY_INSTANTIATE0(double, float);
+VNL_COPY_INSTANTIATE0(double, long double);
+#ifndef __hppa // assembler bug on HP?
+VNL_COPY_INSTANTIATE0(long double, double);
+#endif
+
+#define macro(S, D) \
+VCL_DEFINE_SPECIALIZATION \
+void vnl_copy(vcl_complex<S> const *src, vcl_complex<D> *dst, unsigned n) \
+{ \
+ for (unsigned int i=0; i<n; ++i) \
+ dst[i] = vcl_complex<D>((D)vcl_real(src[i]), (D)vcl_imag(src[i])); \
+}
+
+macro(float, double);
+macro(double, float);
+macro(double, long double);
+macro(long double, double);
+#undef macro
+
+// vnl_* containers
+#define VNL_COPY_INSTANTIATE(S, T) \
+template void vnl_copy(vnl_vector<S > const &, vnl_vector<T > &); \
+template void vnl_copy(vnl_matrix<S > const &, vnl_matrix<T > &); \
+template void vnl_copy(vnl_diag_matrix<S > const &, vnl_diag_matrix<T > &)
+
+#define VNL_COPY_INSTANTIATE_twoway(S, T) \
+VNL_COPY_INSTANTIATE(S, T); \
+VNL_COPY_INSTANTIATE(T, S)
+
+VNL_COPY_INSTANTIATE_twoway(float, double);
+VNL_COPY_INSTANTIATE_twoway(vcl_complex<float>, vcl_complex<double>);
+#ifndef __hppa // assembler bug on HP?
+VNL_COPY_INSTANTIATE_twoway(double, long double);
+VNL_COPY_INSTANTIATE_twoway(vcl_complex<double>, vcl_complex<long double>);
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.h
new file mode 100644
index 0000000000000000000000000000000000000000..9f423bf39b3de73e95d3327bc8f358b9c5c8f291
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_copy.h
@@ -0,0 +1,30 @@
+// This is core/vnl/vnl_copy.h
+#ifndef vnl_copy_h_
+#define vnl_copy_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Easy conversion between vectors and matrices templated over different types.
+// \author fsm
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 26/3/01 Tidied documentation
+// \endverbatim
+
+//: Easy conversion between vectors and matrices templated over different types.
+// \relates vnl_matrix
+// \relates vnl_vector
+template <class S, class T>
+void vnl_copy(S const *src, T *dst, unsigned n);
+
+
+//: Easy conversion between vectors and matrices templated over different types.
+// \relates vnl_matrix
+// \relates vnl_vector
+template <class S, class T>
+void vnl_copy(S const &, T &);
+
+#endif // vnl_copy_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0f2b444d75a98269c6e31dc9bc45c25d231d5740
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.cxx
@@ -0,0 +1,80 @@
+// This is core/vnl/vnl_cost_function.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Oct 97
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_cost_function.h"
+#include <vcl_cassert.h>
+
+static bool f_calling_compute;
+
+void vnl_cost_function::compute(vnl_vector<double> const& x, double *f, vnl_vector<double>* g)
+{
+ if (f) *f = this->f(x);
+ if (g) this->gradf(x, *g);
+}
+
+//: Default implementation of f is compute...
+double vnl_cost_function::f(vnl_vector<double> const& x)
+{
+ // if we get back here from compute, neither vf was implemented.
+ if (f_calling_compute)
+ assert(!"vnl_cost_function: RECURSION");
+ double f;
+ f_calling_compute = true;
+ this->compute(x, &f, 0);
+ f_calling_compute = false;
+ return f;
+}
+
+//: Default implementation of gradf is to call compute
+void vnl_cost_function::gradf(vnl_vector<double> const& x, vnl_vector<double>& g)
+{
+ if (f_calling_compute)
+ assert(!"vnl_cost_function: RECURSION");
+ f_calling_compute = true;
+ this->compute(x, 0, &g);
+ f_calling_compute = false;
+}
+
+//: Compute fd gradient
+void vnl_cost_function::fdgradf(vnl_vector<double> const& x,
+ vnl_vector<double> & gradient,
+ double stepsize )
+{
+ vnl_vector<double> tx = x;
+ double h = stepsize;
+ for (int i = 0; i < dim; ++i) {
+
+ double tplus = x[i] + h;
+ tx[i] = tplus;
+ double fplus = this->f(tx);
+
+ double tminus = x[i] - h;
+ tx[i] = tminus;
+ double fminus = this->f(tx);
+
+ gradient[i] = (fplus - fminus) / (tplus - tminus);
+ tx[i] = x[i];
+ }
+}
+
+vnl_vector<double> vnl_cost_function::gradf(vnl_vector<double> const& x)
+{
+ vnl_vector<double> g(dim);
+ this->gradf(x, g);
+ return g;
+}
+
+vnl_vector<double> vnl_cost_function::fdgradf(vnl_vector<double> const& x)
+{
+ vnl_vector<double> g(dim);
+ this->fdgradf(x, g);
+ return g;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.h
new file mode 100644
index 0000000000000000000000000000000000000000..1aea6b4f6bd03937411f0bcdecd5304a0ae20ae4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cost_function.h
@@ -0,0 +1,73 @@
+// This is core/vnl/vnl_cost_function.h
+#ifndef vnl_cost_function_h_
+#define vnl_cost_function_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Vector->Real function
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Oct 97
+//
+// \verbatim
+// Modifications
+// 971023 AWF Initial version.
+// LSB (Manchester) 26/3/01 Tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_unary_function.h>
+#include <vnl/vnl_vector.h>
+
+//: An object that represents a function from R^n -> R.
+// It is commonly used to express the
+// interface of a minimizer.
+class vnl_cost_function : public vnl_unary_function<double, vnl_vector<double> >
+{
+ public:
+
+ //! Ddefault constructor
+ vnl_cost_function():dim(0) {}
+
+ //! Construct with a specified number of unknowns
+ vnl_cost_function(int number_of_unknowns):dim(number_of_unknowns) {}
+
+ virtual ~vnl_cost_function() {}
+
+//: The main function. Given the parameter vector x, compute the value of f(x).
+ virtual double f(vnl_vector<double> const& x);
+
+//: Calculate the gradient of f at parameter vector x.
+ virtual void gradf(vnl_vector<double> const& x, vnl_vector<double>& gradient);
+
+//: Compute one or both of f and g.
+// Normally implemented in terms of the above two, but may be faster if specialized. f != 0 => compute f
+ virtual void compute(vnl_vector<double> const& x, double *f, vnl_vector<double>* g);
+
+//: Return the number of unknowns
+ int get_number_of_unknowns() const { return dim; }
+
+//: Compute finite-difference gradient
+ void fdgradf(vnl_vector<double> const& x, vnl_vector<double>& gradient, double stepsize = 1e-5);
+
+//: Called when error is printed for user.
+ virtual double reported_error(double f_value) { return f_value; }
+
+//: Conveniences for printing grad, fdgrad
+ vnl_vector<double> gradf(vnl_vector<double> const& x);
+ vnl_vector<double> fdgradf(vnl_vector<double> const& x);
+
+protected:
+
+ //! Set number of unknowns.
+ void set_number_of_unknowns(int number_of_unknowns) { dim=number_of_unknowns; }
+
+public:
+ int dim;
+};
+
+
+#endif // vnl_cost_function_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross.h
new file mode 100644
index 0000000000000000000000000000000000000000..bf7db80e5a70aeceb42f0f82d9ef17d18373d209
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross.h
@@ -0,0 +1,104 @@
+#ifndef vnl_cross_h_
+#define vnl_cross_h_
+//:
+// \file
+// Implements cross product for vectors.
+// \author Amitha Perera
+// \verbatim
+// Modifications
+// Oct.2002 - Amitha Perera - moved from vnl_vector.h
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vcl_cassert.h>
+
+//: Compute the 2-D cross product
+// \relates vnl_vector
+template<class T>
+inline T
+vnl_cross_2d( const vnl_vector<T>& v1, const vnl_vector<T>& v2 )
+{
+ assert( v1.size() >= 2 && v2.size() >= 2 );
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: Compute the 2-D cross product
+// \relates vnl_vector_fixed
+template<class T>
+inline T
+vnl_cross_2d( const vnl_vector_fixed<T,2>& v1, const vnl_vector_fixed<T,2>& v2 )
+{
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: Compute the 2-D cross product
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T>
+inline T
+vnl_cross_2d(vnl_vector_fixed<T,2> const& v1, vnl_vector<T> const& v2)
+{
+ assert( v2.size() == 2 );
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: Compute the 2-D cross product
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T>
+inline T
+vnl_cross_2d(vnl_vector<T> const& v1, vnl_vector_fixed<T,2> const& v2)
+{
+ assert( v1.size() == 2 );
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: Compute the 3-D cross product
+// \relates vnl_vector
+template<class T>
+inline vnl_vector<T>
+vnl_cross_3d( const vnl_vector<T>& v1, const vnl_vector<T>& v2 )
+{
+ assert( v1.size() == 3 && v2.size() == 3 );
+ vnl_vector<T> result(3);
+ result[0] = v1[1] * v2[2] - v1[2] * v2[1]; // work for both col/row
+ result[1] = v1[2] * v2[0] - v1[0] * v2[2]; // representation
+ result[2] = v1[0] * v2[1] - v1[1] * v2[0];
+ return result;
+}
+
+//: Compute the 3-D cross product
+// \relates vnl_vector_fixed
+template<class T>
+inline vnl_vector_fixed<T,3>
+vnl_cross_3d( const vnl_vector_fixed<T,3>& v1, const vnl_vector_fixed<T,3>& v2 )
+{
+ vnl_vector_fixed<T,3> result;
+ result[0] = v1[1] * v2[2] - v1[2] * v2[1]; // work for both col/row
+ result[1] = v1[2] * v2[0] - v1[0] * v2[2]; // representation
+ result[2] = v1[0] * v2[1] - v1[1] * v2[0];
+ return result;
+}
+
+//: Compute the 3-D cross product
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T,unsigned int n>
+inline vnl_vector_fixed<T,n>
+vnl_cross_3d( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return vnl_cross_3d(a.as_ref(), b);
+}
+
+//: Compute the 3-D cross product
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T,unsigned int n>
+inline vnl_vector_fixed<T,n>
+vnl_cross_3d( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return vnl_cross_3d(a, b.as_ref());
+}
+
+#endif // vnl_cross_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross_product_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross_product_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..0b6d4b2833a88eee40500aeda1d74ff43ac6aa48
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_cross_product_matrix.h
@@ -0,0 +1,59 @@
+// This is core/vnl/vnl_cross_product_matrix.h
+#ifndef vnl_cross_product_matrix_h_
+#define vnl_cross_product_matrix_h_
+//:
+// \file
+// \brief 3x3 cross-product matrix of vector
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 19 Sep 96
+//
+// \verbatim
+// Modifications
+// 4/4/01 LSB (Manchester) Tidied Documentation
+// 27 June 2003 - Peter Vanroose - made set() inlined and removed .cxx file.
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_double_3x3.h>
+
+//: Calculates the 3x3 skew symmetric cross product matrix from a vector.
+//
+// vnl_cross_product_matrix(e) is the matrix [e]_ x:
+// \verbatim
+// 0 -e_3 e_2
+// e_3 0 -e_1
+// -e_2 e_1 0
+// \endverbatim
+class vnl_cross_product_matrix : public vnl_double_3x3
+{
+ public:
+ typedef vnl_double_3x3 base;
+
+ vnl_cross_product_matrix(const vnl_vector<double>& v) { set(v.data_block()); }
+ vnl_cross_product_matrix(const double* v) { set(v); }
+ vnl_cross_product_matrix(const vnl_cross_product_matrix& that): base(that) {}
+ ~vnl_cross_product_matrix() {}
+
+ vnl_cross_product_matrix& operator=(const vnl_cross_product_matrix& that) {
+ base::operator= (that);
+ return *this;
+ }
+
+ //: Construct a vnl_cross_product_matrix from a C-array of 3 doubles.
+ // Overrides a method in vnl_matrix.
+ inline void set(const double* v)
+ {
+ double const& e1 = v[0];
+ double const& e2 = v[1];
+ double const& e3 = v[2];
+
+ vnl_cross_product_matrix & E = *this;
+
+ E(0,0) = 0; E(0,1) = -e3; E(0,2) = e2;
+ E(1,0) = e3; E(1,1) = 0; E(1,2) = -e1;
+ E(2,0) = -e2; E(2,1) = e1; E(2,2) = 0;
+ }
+};
+
+#endif // vnl_cross_product_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7fcde253db6366e12759e28c1a0001eb315ab7c3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.cxx
@@ -0,0 +1,5 @@
+#include "vnl_integrant_fnct.h"
+#include "vnl_definite_integral.h"
+
+// initial the static memeber
+vnl_integrant_fnct* vnl_definite_integral::pfnct_ = 0;
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.h
new file mode 100644
index 0000000000000000000000000000000000000000..c1aaddc1fc2e489c130fbd453d20a9048195c489
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_definite_integral.h
@@ -0,0 +1,32 @@
+#ifndef VNL_DEFINITE_INTEGRAL_H_
+#define VNL_DEFINITE_INTEGRAL_H_
+//:
+// \file
+// \author Kongbin Kang at Brown
+// \date Jan 12, 2005
+// \brief the abstract 1D integrant function used for definite integral
+
+#include "vnl_integrant_fnct.h"
+
+class vnl_definite_integral
+{
+ protected:
+
+ static vnl_integrant_fnct *pfnct_;
+
+ public:
+
+ vnl_definite_integral() { pfnct_ = 0; }
+
+ void set_fnct(vnl_integrant_fnct* f) { pfnct_ = f; }
+
+#if 0
+ //: integration from a to b, in n steps
+ virtual double integral(vnl_integrant_fnct *f, float a, float b, int n)=0;
+#endif
+
+ //: dector
+ virtual ~vnl_definite_integral() { pfnct_ = 0; }
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.h
new file mode 100644
index 0000000000000000000000000000000000000000..fc6fdf7b700f118b46d9967f2a5701c0d635ed28
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.h
@@ -0,0 +1,52 @@
+// This is core/vnl/vnl_det.h
+#ifndef vnl_det_h_
+#define vnl_det_h_
+//:
+// \file
+// \brief Direct evaluation of 2x2, 3x3 and 4x4 determinants.
+// \author fsm
+//
+// \verbatim
+// Modifications
+// Peter Vanroose - 15 Oct. 2001 - Renamed from vnl_determinant to vnl_det
+// Peter Vanroose - 15 Oct. 2001 - Added vnl_matrix_fixed interface
+// \endverbatim
+
+#include <vnl/vnl_matrix_fixed.h>
+
+//: 2x2 matrix
+template <class T> T vnl_det(T const *row0,
+ T const *row1);
+
+//: 3x3 matrix
+template <class T> T vnl_det(T const *row0,
+ T const *row1,
+ T const *row2);
+
+//: 4x4 matrix
+template <class T> T vnl_det(T const *row0,
+ T const *row1,
+ T const *row2,
+ T const *row3);
+
+//: Determinant of small size matrices
+// \relates vnl_matrix
+template <class T>
+inline T vnl_det(vnl_matrix_fixed<T,1,1> const& m) { return m[0][0]; }
+
+//: Determinant of small size matrices
+// \relates vnl_matrix
+template <class T>
+inline T vnl_det(vnl_matrix_fixed<T,2,2> const& m) { return vnl_det(m[0],m[1]); }
+
+//: Determinant of small size matrices
+// \relates vnl_matrix
+template <class T>
+inline T vnl_det(vnl_matrix_fixed<T,3,3> const& m) { return vnl_det(m[0],m[1],m[2]); }
+
+//: Determinant of small size matrices
+// \relates vnl_matrix
+template <class T>
+inline T vnl_det(vnl_matrix_fixed<T,4,4> const& m) { return vnl_det(m[0],m[1],m[2],m[3]); }
+
+#endif // vnl_det_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.txx
new file mode 100644
index 0000000000000000000000000000000000000000..ebc67fef742fb64d45b20282e74cf3745d93806f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_det.txx
@@ -0,0 +1,59 @@
+// This is core/vnl/vnl_det.txx
+#ifndef vnl_det_txx_
+#define vnl_det_txx_
+
+#include "vnl_det.h"
+
+template <class T>
+T vnl_det(T const *row0, T const *row1) {
+ return row0[0]*row1[1] - row0[1]*row1[0];
+}
+
+template <class T>
+T vnl_det(T const *row0, T const *row1, T const *row2) {
+ return // the extra '+' makes it work nicely with emacs indentation.
+ + row0[0]*row1[1]*row2[2]
+ - row0[0]*row2[1]*row1[2]
+ - row1[0]*row0[1]*row2[2]
+ + row1[0]*row2[1]*row0[2]
+ + row2[0]*row0[1]*row1[2]
+ - row2[0]*row1[1]*row0[2];
+}
+
+template <class T>
+T vnl_det(T const *row0, T const *row1, T const *row2, T const *row3) {
+ return
+ + row0[0]*row1[1]*row2[2]*row3[3]
+ - row0[0]*row1[1]*row3[2]*row2[3]
+ - row0[0]*row2[1]*row1[2]*row3[3]
+ + row0[0]*row2[1]*row3[2]*row1[3]
+ + row0[0]*row3[1]*row1[2]*row2[3]
+ - row0[0]*row3[1]*row2[2]*row1[3]
+ - row1[0]*row0[1]*row2[2]*row3[3]
+ + row1[0]*row0[1]*row3[2]*row2[3]
+ + row1[0]*row2[1]*row0[2]*row3[3]
+ - row1[0]*row2[1]*row3[2]*row0[3]
+ - row1[0]*row3[1]*row0[2]*row2[3]
+ + row1[0]*row3[1]*row2[2]*row0[3]
+ + row2[0]*row0[1]*row1[2]*row3[3]
+ - row2[0]*row0[1]*row3[2]*row1[3]
+ - row2[0]*row1[1]*row0[2]*row3[3]
+ + row2[0]*row1[1]*row3[2]*row0[3]
+ + row2[0]*row3[1]*row0[2]*row1[3]
+ - row2[0]*row3[1]*row1[2]*row0[3]
+ - row3[0]*row0[1]*row1[2]*row2[3]
+ + row3[0]*row0[1]*row2[2]*row1[3]
+ + row3[0]*row1[1]*row0[2]*row2[3]
+ - row3[0]*row1[1]*row2[2]*row0[3]
+ - row3[0]*row2[1]*row0[2]*row1[3]
+ + row3[0]*row2[1]*row1[2]*row0[3];
+}
+
+//--------------------------------------------------------------------------------
+
+#define VNL_DET_INSTANTIATE(T) \
+template T vnl_det(T const *, T const *); \
+template T vnl_det(T const *, T const *, T const *); \
+template T vnl_det(T const *, T const *, T const *, T const *)
+
+#endif // vnl_det_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..069c8dc50d293af27a743be4527d0c8af0100701
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.h
@@ -0,0 +1,339 @@
+// This is core/vnl/vnl_diag_matrix.h
+#ifndef vnl_diag_matrix_h_
+#define vnl_diag_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class for diagonal matrices
+// \author Andrew W. Fitzgibbon (Oxford RRG)
+// \date 5/8/96
+//
+// \verbatim
+// Modifications
+// IMS (Manchester) 16/03/2001: Tidied up the documentation + added binary_io
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Sep.2002 - Peter Vanroose - Added operator+, operator-, operator*
+// Mar.2004 - Peter Vanroose - removed deprecated resize()
+// \endverbatim
+
+#include <vcl_cassert.h>
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+// forward declarations
+template <class T> class vnl_diag_matrix;
+template <class T> vnl_vector<T> operator*(vnl_diag_matrix<T> const&, vnl_vector<T> const&);
+
+//: stores a diagonal matrix as a single vector.
+// vnl_diag_matrix stores a diagonal matrix for time and space efficiency.
+// Specifically, only the diagonal elements are stored, and some matrix
+// operations (currently *, + and -) are overloaded to use more efficient
+// algorithms.
+
+export
+template <class T>
+class vnl_diag_matrix
+{
+ vnl_vector<T> diagonal_;
+
+ public:
+ vnl_diag_matrix() {}
+
+ //: Construct an empty diagonal matrix.
+ vnl_diag_matrix(unsigned nn) : diagonal_(nn) {}
+
+ //: Construct a diagonal matrix with diagonal elements equal to value.
+ vnl_diag_matrix(unsigned nn, T const& value) : diagonal_(nn, value) {}
+
+ //: Construct a diagonal matrix from a vnl_vector.
+ // The vector elements become the diagonal elements.
+ vnl_diag_matrix(vnl_vector<T> const& that): diagonal_(that) {}
+ ~vnl_diag_matrix() {}
+
+ inline vnl_diag_matrix& operator=(vnl_diag_matrix<T> const& that) {
+ this->diagonal_ = that.diagonal_;
+ return *this;
+ }
+
+ // Operations----------------------------------------------------------------
+
+ //: In-place arithmetic operation
+ inline vnl_diag_matrix<T>& operator*=(T v) { diagonal_ *= v; return *this; }
+ //: In-place arithmetic operation
+ inline vnl_diag_matrix<T>& operator/=(T v) { diagonal_ /= v; return *this; }
+
+ // Computations--------------------------------------------------------------
+
+ void invert_in_place();
+ T determinant() const;
+ vnl_vector<T> solve(vnl_vector<T> const& b);
+ void solve(vnl_vector<T> const& b, vnl_vector<T>* out);
+
+ // Data Access---------------------------------------------------------------
+
+ inline T operator () (unsigned i, unsigned j) const {
+ return (i != j) ? T(0) : diagonal_[i];
+ }
+
+ inline T& operator () (unsigned i, unsigned j) {
+ assert(i == j);
+ return diagonal_[i];
+ }
+ inline T& operator() (unsigned i) { return diagonal_[i]; }
+ inline T const& operator() (unsigned i) const { return diagonal_[i]; }
+
+ inline T& operator[] (unsigned i) { return diagonal_[i]; }
+ inline T const& operator[] (unsigned i) const { return diagonal_[i]; }
+
+ //: set element with boundary checks.
+ inline void put (unsigned r, unsigned c, T const& v) {
+ assert(r == c); assert (r<size()); diagonal_[r] = v;
+ }
+
+ //: get element with boundary checks.
+ inline T get (unsigned r, unsigned c) const {
+ assert(r == c); assert (r<size()); return diagonal_[r];
+ }
+
+ //: Set all diagonal elements of matrix to specified value.
+ inline void fill_diagonal (T const& v) { diagonal_.fill(v); }
+
+ // iterators
+
+ typedef typename vnl_vector<T>::iterator iterator;
+ inline iterator begin() { return diagonal_.begin(); }
+ inline iterator end() { return diagonal_.end(); }
+ typedef typename vnl_vector<T>::const_iterator const_iterator;
+ inline const_iterator begin() const { return diagonal_.begin(); }
+ inline const_iterator end() const { return diagonal_.end(); }
+
+ inline unsigned size() const { return diagonal_.size(); }
+ inline unsigned rows() const { return diagonal_.size(); }
+ inline unsigned cols() const { return diagonal_.size(); }
+ inline unsigned columns() const { return diagonal_.size(); }
+
+ // Need this until we add a vnl_diag_matrix ctor to vnl_matrix;
+ inline vnl_matrix<T> asMatrix() const;
+
+ inline vnl_matrix<T> as_ref() const { return asMatrix(); }
+
+ // This is as good as a vnl_diag_matrix ctor for vnl_matrix:
+ inline operator vnl_matrix<T> () const { return asMatrix(); }
+
+ inline void set_size(int n) { diagonal_.set_size(n); }
+
+ inline void clear() { diagonal_.clear(); }
+ inline void fill(T const &x) { diagonal_.fill(x); }
+
+ //: Return pointer to the diagonal elements as a contiguous 1D C array;
+ inline T* data_block() { return diagonal_.data_block(); }
+ inline T const* data_block() const { return diagonal_.data_block(); }
+
+ //: Return diagonal elements as a vector
+ inline vnl_vector<T> const& diagonal() const { return diagonal_; }
+
+ //: Set diagonal elements using vector
+ inline void set(vnl_vector<T> const& v) { diagonal_=v; }
+
+ private:
+ #if VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+ friend vnl_vector<T> operator*(vnl_diag_matrix<T> const&,vnl_vector<T> const&);
+ #endif
+};
+
+//:
+// \relates vnl_diag_matrix
+template <class T>
+vcl_ostream& operator<< (vcl_ostream&, vnl_diag_matrix<T> const&);
+
+//: Convert a vnl_diag_matrix to a Matrix.
+template <class T>
+inline vnl_matrix<T> vnl_diag_matrix<T>::asMatrix() const
+{
+ unsigned len = diagonal_.size();
+ vnl_matrix<T> ret(len, len);
+ for (unsigned i = 0; i < len; ++i)
+ {
+ unsigned j;
+ for (j = 0; j < i; ++j)
+ ret(i,j) = T(0);
+ for (j = i+1; j < len; ++j)
+ ret(i,j) = T(0);
+ ret(i,i) = diagonal_[i];
+ }
+ return ret;
+}
+
+//: Invert a vnl_diag_matrix in-situ.
+// Just replaces each element with its reciprocal.
+template <class T>
+inline void vnl_diag_matrix<T>::invert_in_place()
+{
+ unsigned len = diagonal_.size();
+ T* d = data_block();
+ T one = T(1);
+ for (unsigned i = 0; i < len; ++i)
+ d[i] = one / d[i];
+}
+
+//: Return determinant as product of diagonal values.
+template <class T>
+inline T vnl_diag_matrix<T>::determinant() const
+{
+ T det = T(1);
+ T const* d = data_block();
+ unsigned len = diagonal_.size();
+ for (unsigned i = 0; i < len; ++i)
+ det *= d[i];
+ return det;
+}
+
+//: Multiply two vnl_diag_matrices. Just multiply the diag elements - n flops
+// \relates vnl_diag_matrix
+template <class T>
+inline vnl_diag_matrix<T> operator* (vnl_diag_matrix<T> const& A, vnl_diag_matrix<T> const& B)
+{
+ assert(A.size() == B.size());
+ vnl_diag_matrix<T> ret = A;
+ for (unsigned i = 0; i < A.size(); ++i)
+ ret(i,i) *= B(i,i);
+ return ret;
+}
+
+//: Multiply a vnl_matrix by a vnl_diag_matrix. Just scales the columns - mn flops
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator* (vnl_matrix<T> const& A, vnl_diag_matrix<T> const& D)
+{
+ assert(A.columns() == D.size());
+ vnl_matrix<T> ret(A.rows(), A.columns());
+ for (unsigned i = 0; i < A.rows(); ++i)
+ for (unsigned j = 0; j < A.columns(); ++j)
+ ret(i,j) = A(i,j) * D(j,j);
+ return ret;
+}
+
+//: Multiply a vnl_diag_matrix by a vnl_matrix. Just scales the rows - mn flops
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator* (vnl_diag_matrix<T> const& D, vnl_matrix<T> const& A)
+{
+ assert(A.rows() == D.size());
+ vnl_matrix<T> ret(A.rows(), A.columns());
+ T const* d = D.data_block();
+ for (unsigned i = 0; i < A.rows(); ++i)
+ for (unsigned j = 0; j < A.columns(); ++j)
+ ret(i,j) = A(i,j) * d[i];
+ return ret;
+}
+
+//: Add two vnl_diag_matrices. Just add the diag elements - n flops
+// \relates vnl_diag_matrix
+template <class T>
+inline vnl_diag_matrix<T> operator+ (vnl_diag_matrix<T> const& A, vnl_diag_matrix<T> const& B)
+{
+ assert(A.size() == B.size());
+ vnl_diag_matrix<T> ret = A;
+ for (unsigned i = 0; i < A.size(); ++i)
+ ret(i,i) += B(i,i);
+ return ret;
+}
+
+//: Add a vnl_diag_matrix to a vnl_matrix. n adds, mn copies.
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator+ (vnl_matrix<T> const& A, vnl_diag_matrix<T> const& D)
+{
+ const unsigned n = D.size();
+ assert(A.rows() == n); assert(A.columns() == n);
+ vnl_matrix<T> ret(A);
+ T const* d = D.data_block();
+ for (unsigned j = 0; j < n; ++j)
+ ret(j,j) += d[j];
+ return ret;
+}
+
+//: Add a vnl_matrix to a vnl_diag_matrix. n adds, mn copies.
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator+ (vnl_diag_matrix<T> const& D, vnl_matrix<T> const& A)
+{
+ return A + D;
+}
+
+//: Subtract two vnl_diag_matrices. Just subtract the diag elements - n flops
+// \relates vnl_diag_matrix
+template <class T>
+inline vnl_diag_matrix<T> operator- (vnl_diag_matrix<T> const& A, vnl_diag_matrix<T> const& B)
+{
+ assert(A.size() == B.size());
+ vnl_diag_matrix<T> ret = A;
+ for (unsigned i = 0; i < A.size(); ++i)
+ ret(i,i) -= B(i,i);
+ return ret;
+}
+
+//: Subtract a vnl_diag_matrix from a vnl_matrix. n adds, mn copies.
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator- (vnl_matrix<T> const& A, vnl_diag_matrix<T> const& D)
+{
+ const unsigned n = D.size();
+ assert(A.rows() == n); assert(A.columns() == n);
+ vnl_matrix<T> ret(A);
+ T const* d = D.data_block();
+ for (unsigned j = 0; j < n; ++j)
+ ret(j,j) -= d[j];
+ return ret;
+}
+
+//: Subtract a vnl_matrix from a vnl_diag_matrix. n adds, mn copies.
+// \relates vnl_diag_matrix
+// \relates vnl_matrix
+template <class T>
+inline vnl_matrix<T> operator- (vnl_diag_matrix<T> const& D, vnl_matrix<T> const& A)
+{
+ const unsigned n = D.size();
+ assert(A.rows() == n); assert(A.columns() == n);
+ vnl_matrix<T> ret(n, n);
+ T const* d = D.data_block();
+ for (unsigned i = 0; i < n; ++i)
+ {
+ for (unsigned j = 0; j < i; ++j)
+ ret(i,j) = -A(i,j);
+ for (unsigned j = i+1; j < n; ++j)
+ ret(i,j) = -A(i,j);
+ ret(i,i) = d[i] - A(i,i);
+ }
+ return ret;
+}
+
+//: Multiply a vnl_diag_matrix by a vnl_vector. n flops.
+// \relates vnl_diag_matrix
+// \relates vnl_vector
+template <class T>
+inline vnl_vector<T> operator* (vnl_diag_matrix<T> const& D, vnl_vector<T> const& A)
+{
+ assert(A.size() == D.size());
+ return element_product(D.diagonal(), A);
+}
+
+//: Multiply a vnl_vector by a vnl_diag_matrix. n flops.
+// \relates vnl_diag_matrix
+// \relates vnl_vector
+template <class T>
+inline vnl_vector<T> operator* (vnl_vector<T> const& A, vnl_diag_matrix<T> const& D)
+{
+ assert(A.size() == D.size());
+ return element_product(D.diagonal(), A);
+}
+
+#endif // vnl_diag_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..03f79cc6dd2d31017ea8f42c6a6fc984081ed215
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_diag_matrix.txx
@@ -0,0 +1,95 @@
+// This is core/vnl/vnl_diag_matrix.txx
+#ifndef vnl_diag_matrix_txx_
+#define vnl_diag_matrix_txx_
+//:
+// \file
+
+#include "vnl_diag_matrix.h"
+
+#include <vcl_iostream.h>
+
+
+//: Return inv(D) * b.
+template <class T>
+vnl_vector<T> vnl_diag_matrix<T>::solve(vnl_vector<T> const& b)
+{
+ unsigned len = diagonal_.size();
+ vnl_vector<T> ret(len);
+ for (unsigned i = 0; i < len; ++i)
+ ret[i] = b[i] / diagonal_[i];
+ return ret;
+}
+
+//: Return inv(D) * b.
+template <class T>
+void vnl_diag_matrix<T>::solve(vnl_vector<T> const& b, vnl_vector<T>* out)
+{
+ unsigned len = diagonal_.size();
+ for (unsigned i = 0; i < len; ++i)
+ (*out)[i] = b[i] / diagonal_[i];
+}
+
+//: Print in MATLAB diag([1 2 3]) form.
+template <class T>
+vcl_ostream& operator<< (vcl_ostream& s, const vnl_diag_matrix<T>& D)
+{
+ s << "diag([ ";
+ for (unsigned i=0; i<D.rows(); ++i)
+ s << D(i,i) << ' ';
+ return s << "])";
+}
+
+#if 0
+//: Compares two matrices for component-wise equality within a small epsilon
+template<class T>
+bool epsilon_equals (const vnl_diag_matrix<T>& m1, const vnl_diag_matrix<T>& m2,
+ double alt_epsilon)
+{
+ if (alt_epsilon < 0)
+ {
+ vcl_cerr << "Negative alt_epsilon passed to epsilon_equals: returning false\n";
+ return false;
+ }
+
+ if (m1.rows() != m2.rows())
+ return false; // different sizes.
+
+ double local_epsilon;
+ if (alt_epsilon == 0)
+ local_epsilon = comparison_epsilon<T>::epsilon;
+ else
+ local_epsilon = alt_epsilon;
+
+ for (unsigned long i = 0; i < m1.rows(); i++) {
+#if 0
+ T result = m1(i,i) - m2(i,i);
+ if (result < 0)
+ result = 0 - result;
+ if (result > local_epsilon)
+ return false;
+#endif
+ if (m1(i,i) - m2(i,i) > local_epsilon ||
+ m2(i,i) - m1(i,i) > local_epsilon) // avoid using vcl_abs()
+ return false;
+ }
+ return true;
+}
+#endif
+
+
+#undef VNL_DIAG_MATRIX_INSTANTIATE
+#define VNL_DIAG_MATRIX_INSTANTIATE(T) \
+template class vnl_diag_matrix<T >; \
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator* (vnl_matrix<T > const &, vnl_diag_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator* (vnl_diag_matrix<T > const &, vnl_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator+ (vnl_matrix<T > const &, vnl_diag_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator+ (vnl_diag_matrix<T > const &, vnl_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator- (vnl_matrix<T > const &, vnl_diag_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator- (vnl_diag_matrix<T > const &, vnl_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_vector<T > operator* (const vnl_vector<T >&, vnl_diag_matrix<T > const &));\
+VCL_INSTANTIATE_INLINE(vnl_vector<T > operator* (vnl_diag_matrix<T > const &, const vnl_vector<T >&));\
+template vcl_ostream& operator<< (vcl_ostream& s, vnl_diag_matrix<T > const &)
+
+//template bool epsilon_equals (vnl_diag_matrix<T > const & , vnl_diag_matrix<T > const & , double)
+
+#endif // vnl_diag_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..3a4c2a1accf163bcb5aca0af8dfa1b8160095fb3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_1x1.h
+#ifndef vnl_double_1x1_h_
+#define vnl_double_1x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x1 matrix of double
+//
+// vnl_double_1x1 is a vnl_matrix<double> of fixed size 1x1.
+// It is merely a typedef for vnl_matrix_fixed<double,1,1>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,1,1> vnl_double_1x1;
+
+#endif // vnl_double_1x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..28653c588b7137a4e66be2966e98696595237b8e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_1x2.h
+#ifndef vnl_double_1x2_h_
+#define vnl_double_1x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x2 matrix of double
+//
+// vnl_double_1x2 is a vnl_matrix<double> of fixed size 1x2.
+// It is merely a typedef for vnl_matrix_fixed<double,1,2>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,1,2> vnl_double_1x2;
+
+#endif // vnl_double_1x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..091f06cb44601948f2200513b8411ef024e5eda7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_1x3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_1x3.h
+#ifndef vnl_double_1x3_h_
+#define vnl_double_1x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x3 matrix of double
+//
+// vnl_double_1x3 is a vnl_matrix<double> of fixed size 1x3.
+// It is merely a typedef for vnl_matrix_fixed<double,1,3>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,1,3> vnl_double_1x3;
+
+#endif // vnl_double_1x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2.h
new file mode 100644
index 0000000000000000000000000000000000000000..f316d1cd9a988496346bc459b3b7c5b996dece49
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2.h
@@ -0,0 +1,34 @@
+// This is core/vnl/vnl_double_2.h
+#ifndef vnl_double_2_h_
+#define vnl_double_2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief alias for vnl_vector_fixed<double,2>
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Dec 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<double,2> already instantiated
+// Peter Vanroose, 28 Mar. 2004: renamed cross_2d() to vnl_cross_2d()
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_double_2 : a vnl_vector of 2 doubles.
+vnl_T_n_impl(double,2);
+
+//: Cross product of two 2-vectors
+inline
+double vnl_cross_2d(vnl_double_2 const& v1, vnl_double_2 const& v2)
+{
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: deprecated
+#define cross_2d vnl_cross_2d
+
+#endif // vnl_double_2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..5e525812f8c4297fb15914452aa7d205dc73d8cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_2x1.h
+#ifndef vnl_double_2x1_h_
+#define vnl_double_2x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x1 matrix of double
+//
+// vnl_double_2x1 is a vnl_matrix<double> of fixed size 2x1.
+// It is merely a typedef for vnl_matrix_fixed<double,2,1>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,2,1> vnl_double_2x1;
+
+#endif // vnl_double_2x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..02bc12aa085572a2731ce1df22f9544d93d6708a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_2x2.h
+#ifndef vnl_double_2x2_h_
+#define vnl_double_2x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x2 matrix of double
+//
+// vnl_double_2x2 is a vnl_matrix<double> of fixed size 2x2. It is
+// merely a typedef for vnl_matrix_fixed<double,2,2>
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,2,2> vnl_double_2x2;
+
+#endif // vnl_double_2x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..7cfa1aa4f6a9fbb454eb4533d06882cfcb45b9e7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_2x3.h
@@ -0,0 +1,48 @@
+// This is core/vnl/vnl_double_2x3.h
+#ifndef vnl_double_2x3_h_
+#define vnl_double_2x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x3 matrix of double
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: no need to use #pragma instantiate anymore
+// Peter Vanroose, 21 Oct 1999: vnl_matrix_fixed<double,2,3> already instantiated
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_double_3.h>
+
+class vnl_double_2x3 : public vnl_matrix_fixed<double, 2, 3>
+{
+ typedef vnl_matrix_fixed<double, 2, 3> Base;
+ public:
+
+ vnl_double_2x3() {}
+ vnl_double_2x3(const vnl_double_3& row1, const vnl_double_3& row2)
+ {
+ vnl_double_2x3& M = *this;
+ M(0,0) = row1[0]; M(0,1) = row1[1]; M(0,2) = row1[2];
+ M(1,0) = row2[0]; M(1,1) = row2[1]; M(1,2) = row2[2];
+ }
+
+ vnl_double_2x3(double r00, double r01, double r02,
+ double r10, double r11, double r12)
+ {
+ vnl_double_2x3& M = *this;
+ M(0,0) = r00; M(0,1) = r01; M(0,2) = r02;
+ M(1,0) = r10; M(1,1) = r11; M(1,2) = r12;
+ }
+
+ vnl_double_2x3(Base const& M) : Base(M) { }
+};
+
+#endif // vnl_double_2x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3.h
new file mode 100644
index 0000000000000000000000000000000000000000..57e39e14af68d2cff546d70d9442faf09941f4cb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3.h
@@ -0,0 +1,38 @@
+// This is core/vnl/vnl_double_3.h
+#ifndef vnl_double_3_h_
+#define vnl_double_3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_double_3 and function vnl_cross_3d()
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Dec 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<double,3> already instantiated
+// Peter Vanroose, 28 Mar. 2004: renamed cross_3d() to vnl_cross_3d()
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_double_3 : a vnl_vector of 3 doubles.
+vnl_T_n_impl(double,3);
+
+//: Cross product of two 3-vectors
+inline
+vnl_double_3 vnl_cross_3d(vnl_double_3 const& v1, vnl_double_3 const& v2)
+{
+ vnl_double_3 result;
+ result[0] = v1[1] * v2[2] - v1[2] * v2[1];
+ result[1] = v1[2] * v2[0] - v1[0] * v2[2];
+ result[2] = v1[0] * v2[1] - v1[1] * v2[0];
+ return result;
+}
+
+//: deprecated
+#define cross_3d vnl_cross_3d
+
+#endif // vnl_double_3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..6d99e5ae32df5dab6a66ed50e5e1ce234da9e8d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_3x1.h
+#ifndef vnl_double_3x1_h_
+#define vnl_double_3x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x1 matrix of double
+//
+// vnl_double_3x1 is a vnl_matrix<double> of fixed size 3x1.
+// It is merely a typedef for vnl_matrix_fixed<double,3,1>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,3,1> vnl_double_3x1;
+
+#endif // vnl_double_3x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..25be7471234a5408678a1cd326c470e2293f425c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x2.h
@@ -0,0 +1,40 @@
+// This is core/vnl/vnl_double_3x2.h
+#ifndef vnl_double_3x2_h_
+#define vnl_double_3x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x2 matrix of double
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: no need to use #pragma instantiate anymore
+// Peter Vanroose, 21 Oct 1999: vnl_matrix_fixed<double,2,3> already instantiated
+// 4/4/01 LSB (Manchester) Tidied documentation
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+class vnl_double_3x2 : public vnl_matrix_fixed<double, 3, 2>
+{
+ typedef vnl_matrix_fixed<double, 3, 2> Base;
+ public:
+
+ vnl_double_3x2() {}
+
+ vnl_double_3x2(double r00, double r01,
+ double r10, double r11,
+ double r20, double r21) {
+ vnl_double_3x2& M = *this;
+ M(0,0) = r00; M(0,1) = r01;
+ M(1,0) = r10; M(1,1) = r11;
+ M(2,0) = r20; M(2,1) = r21;
+ }
+};
+
+#endif // vnl_double_3x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..dce1185c6046133daf6a5f7c5363492664ee59e5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_3x3.h
+#ifndef vnl_double_3x3_h_
+#define vnl_double_3x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x3 matrix of double
+//
+// vnl_double_3x3 is a vnl_matrix<double> of fixed size 3x3.
+// It is merely a typedef for vnl_matrix_fixed<double,3,3>
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,3,3> vnl_double_3x3;
+
+#endif // vnl_double_3x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x4.h
new file mode 100644
index 0000000000000000000000000000000000000000..219f6106007aa0e40f8938ea76cb57da2aa0d86c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_3x4.h
@@ -0,0 +1,26 @@
+// This is core/vnl/vnl_double_3x4.h
+#ifndef vnl_double_3x4_h_
+#define vnl_double_3x4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x4 Matrix of double
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// vnl_double_3x4 is a vnl_matrix<double> of fixed size 3x4. It is
+// merely a typedef for vnl_matrix_fixed<double,3,4>
+//
+// \verbatim
+// Modifications
+// 4/4/01 LSB (Manchester) Tidied documentation
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,3,4> vnl_double_3x4;
+
+#endif // vnl_double_3x4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4.h
new file mode 100644
index 0000000000000000000000000000000000000000..9186644a864407fd8ea8544bd7f02777e1697f61
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_4.h
+#ifndef vnl_double_4_h_
+#define vnl_double_4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief alias for vnl_vector_fixed<double,4>
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<double,4> already instantiated
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_double_4 : a vnl_vector of 4 doubles.
+vnl_T_n_impl(double,4);
+
+#endif // vnl_double_4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..b308a55ca776d9e863087628f70fed47d0a5e839
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x3.h
@@ -0,0 +1,22 @@
+// This is core/vnl/vnl_double_4x3.h
+#ifndef vnl_double_4x3_h_
+#define vnl_double_4x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 4x3 matrix of double
+//
+// vnl_double_4x3 is a vnl_matrix<double> of fixed size 4x3. It is
+// merely a typedef for vnl_matrix_fixed<double,4,3>
+//
+// \author Geoff Cross
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,4,3> vnl_double_4x3;
+
+#endif // vnl_double_4x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x4.h
new file mode 100644
index 0000000000000000000000000000000000000000..1a7860957c8284354e17cc1ff2c257b10d43388b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_double_4x4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_double_4x4.h
+#ifndef vnl_double_4x4_h_
+#define vnl_double_4x4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 4x4 matrix of double
+//
+// vnl_double_4x4 is a vnl_matrix<double> of fixed size 4x4. It is
+// merely a typedef for vnl_matrix_fixed<double,4,4>
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<double,4,4> vnl_double_4x4;
+
+#endif // vnl_double_4x4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..786bd39ea9af36456e05bbf30e0ba4c59c028589
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.cxx
@@ -0,0 +1,208 @@
+// This is core/vnl/vnl_erf.cxx
+#include "vnl_erf.h"
+//:
+// \file
+// \brief Complete and incomplete gamma function approximations
+// \author Tim Cootes
+// Translated from NETLIB/SPECFUN/erf by Ian Scott
+// Original SPECFUN fortran based on
+// the main computation evaluates near-minimax approximations
+// from "Rational Chebyshev approximations for the error function"
+// by W. J. Cody, Math. Comp., 1969, PP. 631-638.
+
+double vnl_erfc(double x)
+{
+ // Initialized data
+
+ const double thresh = .46875;
+ const double xbig = 26.543;
+ const double xhuge = 6.71e7;
+ const double xmax = 2.53e307;
+#if 0 // unused:
+ const double xneg = -26.628;
+ const double xsmall = 1.11e-16;
+ const double xinf = 1.79e308;
+#endif // 0
+
+ const double c[9] = { .564188496988670089,8.88314979438837594,
+ 66.1191906371416295,298.635138197400131,881.95222124176909,
+ 1712.04761263407058,2051.07837782607147,1230.33935479799725,
+ 2.15311535474403846e-8 };
+ const double d[8] = { 15.7449261107098347,117.693950891312499,
+ 537.181101862009858,1621.38957456669019,3290.79923573345963,
+ 4362.61909014324716,3439.36767414372164,1230.33935480374942 };
+ const double p[6] = { .305326634961232344,.360344899949804439,
+ .125781726111229246,.0160837851487422766,6.58749161529837803e-4,
+ .0163153871373020978 };
+ const double q[5] = { 2.56852019228982242,1.87295284992346047,
+ .527905102951428412,.0605183413124413191,.00233520497626869185 };
+ const double sqrpi = .56418958354775628695;
+
+
+ // Local variables
+ double xden, xnum, result;
+ int i;
+ double y, del, ysq;
+
+ // ------------------------------------------------------------------
+
+ // This packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x)
+ // for a real argument x. It contains three FUNCTION type
+ // subprograms: ERF, ERFC, and ERFCX (or DERF, DERFC, and DERFCX),
+ // and one SUBROUTINE type subprogram, CALERF. The calling
+ // statements for the primary entries are:
+ //
+ // Y=ERF(X) (or Y=DERF(X)),
+ //
+ // Y=ERFC(X) (or Y=DERFC(X)),
+ // and
+ // Y=ERFCX(X) (or Y=DERFCX(X)).
+ //
+ // The routine CALERF is intended for internal packet use only,
+ // all computations within the packet being concentrated in this
+ // routine. The function subprograms invoke CALERF with the
+ // statement
+ //
+ // CALL CALERF(ARG,RESULT,JINT)
+ //
+ // where the parameter usage is as follows
+ //
+ // Function Parameters for CALERF
+ // call ARG Result JINT
+ //
+ // ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0
+ // ERFC(ARG) ABS(ARG) .LT. XBIG ERFC(ARG) 1
+ // ERFCX(ARG) XNEG .LT. ARG .LT. XMAX ERFCX(ARG) 2
+ //
+ // The main computation evaluates near-minimax approximations
+ // from "Rational Chebyshev approximations for the error function"
+ // by W. J. Cody, Math. Comp., 1969, PP. 631-638. This
+ // transportable program uses rational functions that theoretically
+ // approximate erf(x) and erfc(x) to at least 18 significant
+ // decimal digits. The accuracy achieved depends on the arithmetic
+ // system, the compiler, the intrinsic functions, and proper
+ // selection of the machine-dependent constants.
+ //
+ // *******************************************************************
+ // *******************************************************************
+ //
+ // Explanation of machine-dependent constants
+ //
+ // XMIN = the smallest positive floating-point number.
+ // XINF = the largest positive finite floating-point number.
+ // XNEG = the largest negative argument acceptable to ERFCX;
+ // the negative of the solution to the equation
+ // 2*exp(x*x) = XINF.
+ // XSMALL = argument below which erf(x) may be represented by
+ // 2*x/sqrt(pi) and above which x*x will not underflow.
+ // A conservative value is the largest machine number X
+ // such that 1.0 + X = 1.0 to machine precision.
+ // XBIG = largest argument acceptable to ERFC; solution to
+ // the equation: W(x) * (1-0.5/x**2) = XMIN, where
+ // W(x) = exp(-x*x)/[x*sqrt(pi)].
+ // XHUGE = argument above which 1.0 - 1/(2*x*x) = 1.0 to
+ // machine precision. A conservative value is
+ // 1/[2*sqrt(XSMALL)]
+ // XMAX = largest acceptable argument to ERFCX; the minimum
+ // of XINF and 1/[sqrt(pi)*XMIN].
+ //
+ // Approximate values for some important machines are:
+ //
+ // XMIN XINF XNEG XSMALL XBIG XHUGE XMAX
+ //
+ // CDC 7600 (S.P.) 3.13E-294 1.26E+322 -27.220 7.11E-1 25.922 8.39E+6 1.80X+293 5
+ // CRAY-1 (S.P.) 4.58E-2467 5.45E+2465 -75.345 7.11E-1 75.326 8.39E+6 5.45E+24655
+ // IEEE(IBM/XT,SUN,..) (S.P.) 1.18E-38 3.40E+38 -9.382 5.96E-8 9.194 2.90E+3 4.79E+37
+ // IEEE(IBM/XT,SUN,..) (D.P.) 2.23D-308 1.79D+308 -26.628 1.11D-1 26.543 6.71D+7 2.53D+307 6
+ // IBM 195 (D.P.) 5.40D-79 7.23E+75 -13.190 1.39D-1 13.306 1.90D+8 7.23E+75 7
+ // UNIVAC 1108 (D.P.) 2.78D-309 8.98D+307 -26.615 1.73D-1 26.582 5.37D+8 8.98D+307 8
+ // VAX D-Format (D.P.) 2.94D-39 1.70D+38 -9.345 1.39D-1 9.269 1.90D+8 1.70D+38 7
+ // VAX G-Format (D.P.) 5.56D-309 8.98D+307 -26.615 1.11D-1 26.569 6.71D+7 8.98D+307 6
+
+ // *******************************************************************
+ // *******************************************************************
+
+ // Error returns
+ //
+ // The program returns ERFC = 0 for ARG .GE. XBIG;
+ //
+ // ERFCX = XINF for ARG .LT. XNEG;
+ // and
+ // ERFCX = 0 for ARG .GE. XMAX.
+
+
+ // Intrinsic functions required are:
+ //
+ // ABS, AINT, EXP
+
+
+ // Author: W. J. Cody
+ // Mathematics and Computer Science Division
+ // Argonne National Laboratory
+ // Argonne, IL 60439
+ //
+ // Latest modification: March 19, 1990
+
+ y = vcl_abs(x);
+ // ------------------------------------------------------------------
+ // Evaluate erfc for |X| <= 0.46875
+ // ------------------------------------------------------------------
+ if (y <= thresh)
+ return 1 - vnl_erf(x);
+
+ // ------------------------------------------------------------------
+ // Evaluate erfc for 0.46875 <= |X| <= 4.0
+ // ------------------------------------------------------------------
+ else if (y <= 4.0)
+ {
+ xnum = c[8] * y;
+ xden = y;
+ for (i = 0; i < 7; ++i)
+ {
+ xnum = (xnum + c[i]) * y;
+ xden = (xden + d[i]) * y;
+ }
+ result = (xnum + c[7]) / (xden + d[7]);
+ ysq = vcl_floor(y * 16.0) / 16.0;
+ del = (y - ysq) * (y + ysq);
+ result = vcl_exp(-ysq * ysq) * vcl_exp(-del) * result;
+
+ // ------------------------------------------------------------------
+ // Evaluate erfc for |X| > 4.0
+ // ------------------------------------------------------------------
+ }
+ else
+ {
+ if (y >= xhuge)
+ {
+ if (y < xmax)
+ result = sqrpi / y;
+ else
+ result = 0;
+ }
+ else if (y >= xbig)
+ result = 0;
+ else
+ {
+ ysq = 1.0 / (y * y);
+ xnum = p[5] * ysq;
+ xden = ysq;
+ for (unsigned i = 0; i < 4; ++i)
+ {
+ xnum = (xnum + p[i]) * ysq;
+ xden = (xden + q[i]) * ysq;
+ }
+ result = ysq * (xnum + p[4]) / (xden + q[4]);
+ result = (sqrpi - result) / y;
+ ysq = vcl_floor(y * 16.0) / 16.0;
+ del = (y - ysq) * (y + ysq);
+ result = vcl_exp(-ysq * ysq) * vcl_exp(-del) * result;
+ }
+ }
+ // ------------------------------------------------------------------
+ // Fix up for negative argument, erf, etc.
+ // ------------------------------------------------------------------
+ if (x < 0.0)
+ result = 2.0 - result;
+ return result;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.h
new file mode 100644
index 0000000000000000000000000000000000000000..9b20b1e716f6324730da887ad3f53f228799743e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_erf.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_erf.h
+#ifndef vnl_erf_h_
+#define vnl_erf_h_
+//:
+// \file
+// \brief Error Function (erf) approximations
+// \author Tim Cootes, Ian Scott
+
+#include <vnl/vnl_gamma.h>
+
+//: The Error function
+// erf(x) = (2/sqrt(pi)) Integral from 0 to x (exp(-t^2) dt)
+// \note the output ranges from -1 to 1, and vnl_erf(0) = 0.
+inline double vnl_erf(double x)
+{ return (x<0)?-vnl_gamma_p(0.5,x*x):vnl_gamma_p(0.5,x*x); };
+
+//: The Complementary Error function
+// erfc(x) = 1 - erf(x) = 1 - (2/sqrt(pi)) Integral from 0 to x (exp(-t^2) dt)
+// This value is useful for large x, when erf(x) ~= 1 and erfc(x) < eps.
+// \note the output ranges from 0 to 2, and vnl_erfc(0) = 1.
+double vnl_erfc(double x);
+
+#endif // vnl_erf_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..14efa66da1be534a189da8acf40b3911b25a5cb2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.cxx
@@ -0,0 +1,89 @@
+// This is core/vnl/vnl_error.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+//
+// Copyright (C) 1991 Texas Instruments Incorporated.
+// Copyright (C) 1993 General Electric Company.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated and General Electric Company
+// provides this software "as is" without express or implied warranty.
+
+#include "vnl_error.h"
+
+#include <vcl_cstdio.h>
+#include <vcl_cstdlib.h>
+
+//: Raise exception for invalid index
+void vnl_error_vector_index (char const* fcn, int index) {
+ //RAISE Error, SYM(vnl_error_vector), SYM(Invalid_Index),
+ vcl_printf ("vnl_error_vector_index:%s: Invalid value %d specified for index.\n",
+ fcn, index);
+ vcl_abort();
+}
+
+//: Raise exception for invalid dimensions
+void vnl_error_vector_dimension (char const* fcn, int l1, int l2) {
+ //RAISE Error, SYM(vnl_error_vector), SYM(Invalid_Dim),
+ vcl_printf ("vnl_error_vector_dimension:%s: Dimensions [%d] and [%d] do not match.\n",
+ fcn, l1, l2);
+ vcl_abort();
+}
+
+
+//: Raise exception for using class objects, or chars in (...)
+void vnl_error_vector_va_arg (int n) {
+ //RAISE Error, SYM(vnl_error_vector), SYM(Invalid_Va_Arg),
+ vcl_printf ("vnl_error_vector_va_arg: Invalid type in ... or wrong alignment with %d bytes.\n",
+ n);
+ vcl_abort();
+}
+
+//--------------------------------------------------------------------------------
+
+void vnl_error_matrix_row_index (char const* fcn, int r) {
+ //RAISE Error, SYM(vnl_error_matrix), SYM(Invalid_Row),
+ vcl_printf ("vnl_error_matrix_row_index:%s: Invalid value %d specified for row.\n",
+ fcn, r);
+ vcl_abort();
+}
+
+
+//: Raise exception for invalid col index.
+void vnl_error_matrix_col_index (char const* fcn, int c) {
+ //RAISE Error, SYM(vnl_error_matrix), SYM(Invalid_Col),
+ vcl_printf ("vnl_error_matrix_col_index:%s: Invalid value %d specified for column.\n",
+ fcn, c);
+ vcl_abort();
+}
+
+//: Raise exception for invalid dimensions
+void vnl_error_matrix_dimension (char const* fcn, int r1, int c1, int r2, int c2) {
+ //RAISE Error, SYM(vnl_error_matrix), SYM(Invalid_Dim),
+ vcl_printf ("vnl_error_matrix_dimension:%s: Dimensions [%d,%d] and [%d,%d] do not match.\n",
+ fcn, r1, c1, r2, c2);
+ vcl_abort();
+}
+
+
+//: Raise exception for invalid dimensions
+void vnl_error_matrix_nonsquare (char const* fcn) {
+ //RAISE Error, SYM(vnl_error_matrix), SYM(Invalid_Dim),
+ vcl_printf ("vnl_error_matrix_nonsquare:%s: Matrix must be square.\n", fcn);
+ vcl_abort();
+}
+
+//: Raise exception for using class objects, or chars in (...)
+void vnl_error_matrix_va_arg (int n) {
+ //RAISE Error, SYM(vnl_error_matrix), SYM(Invalid_Va_Arg),
+ vcl_printf ("vnl_error_matrix_va_arg: Invalid type in ... or wrong alignment with %d bytes.\n",
+ n);
+ vcl_abort();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.h
new file mode 100644
index 0000000000000000000000000000000000000000..8ec64fd4e7a1497e407f99941aacdc4ab4cf9acb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_error.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_error.h
+#ifndef vnl_error_h_
+#define vnl_error_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author fsm
+
+//
+extern void vnl_error_vector_index (const char* fcn, int index);
+extern void vnl_error_vector_dimension (const char* fcn, int l1, int l2);
+extern void vnl_error_vector_va_arg (int n);
+
+//
+extern void vnl_error_matrix_row_index (char const* fcn, int r);
+extern void vnl_error_matrix_col_index (char const* fcn, int c);
+extern void vnl_error_matrix_dimension (char const* fcn, int r1, int c1, int r2, int c2);
+extern void vnl_error_matrix_nonsquare (char const* fcn);
+extern void vnl_error_matrix_va_arg (int n);
+
+#endif // vnl_error_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..35df425ae6514807cbea13405c193d0ec1ddcf8d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.cxx
@@ -0,0 +1,617 @@
+// This is core/vnl/vnl_fastops.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 08 Dec 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_fastops.h"
+
+#include <vcl_cstdlib.h> // abort()
+#include <vcl_cstring.h> // memset()
+#include <vcl_iostream.h>
+
+//: Compute $A^\top A$.
+void vnl_fastops::AtA(vnl_matrix<double>& out, const vnl_matrix<double>& A)
+{
+ const unsigned int n = A.columns();
+ // Verify output is the right size
+ if (out.rows() != n || out.columns() != n)
+ out.set_size(n,n);
+
+ const unsigned int m = A.rows();
+
+ double const* const* a = A.data_array();
+ double** ata = out.data_array();
+
+#if 0
+ for (unsigned int i = 0; i < n; ++i)
+ for (unsigned int j = i; j < n; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < m; ++k)
+ accum += a[k][i] * a[k][j];
+ ata[i][j] = ata[j][i] = accum;
+ }
+#else // 5 times faster on 600 Mhz Pentium III for m = 10000, n = 50
+ vcl_memset(ata[0], 0, n * n * sizeof ata[0][0]);
+ for (unsigned int k = 0; k < m; ++k)
+ for (unsigned int i = 0; i < n; ++i) {
+ double aki = a[k][i];
+ double const* arow = a[k] + i;
+ double* atarow = ata[i] + i;
+ double const* arowend = a[k] + n;
+ while (arow != arowend)
+ *atarow++ += aki * *arow++;
+ }
+ for (unsigned int i = 0; i < n; ++i)
+ for (unsigned int j = i+1; j < n; ++j)
+ ata[j][i] = ata[i][j];
+#endif // 0
+}
+
+//: Compute AxB.
+void vnl_fastops::AB(vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (na != mb) {
+ vcl_cerr << "vnl_fastops::AB: argument sizes do not match: " << na << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int ma = A.rows();
+ const unsigned int nb = B.columns();
+
+ // Verify output is the right size
+ if (out.rows() != ma || out.columns() != nb)
+ out.set_size(ma,nb);
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** outdata = out.data_array();
+
+ for (unsigned int i = 0; i < ma; ++i)
+ for (unsigned int j = 0; j < nb; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < na; ++k)
+ accum += a[i][k] * b[k][j];
+ outdata[i][j] = accum;
+ }
+}
+
+//: Compute $A^\top B$.
+void vnl_fastops::AtB(vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (ma != mb) {
+ vcl_cerr << "vnl_fastops::AtB: argument sizes do not match: " << ma << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+
+ // Verify output is the right size
+ if (out.rows() != na || out.columns() != nb)
+ out.set_size(na,nb);
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** outdata = out.data_array();
+
+ for (unsigned int i = 0; i < na; ++i)
+ for (unsigned int j = 0; j < nb; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < ma; ++k)
+ accum += a[k][i] * b[k][j];
+ outdata[i][j] = accum;
+ }
+}
+
+//: Compute $A^\top b$ for vector b. out may not be b.
+void vnl_fastops::AtB(vnl_vector<double>& out, const vnl_matrix<double>& A, const vnl_vector<double>& B)
+{
+ const unsigned int m = A.rows();
+ const unsigned int l = B.size();
+
+ // Verify matrices compatible
+ if (m != l) {
+ vcl_cerr << "vnl_fastops::AtB: argument sizes do not match: " << m << " != " << l << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int n = A.columns();
+
+ // Verify output is the right size
+ if (out.size() != n)
+ out.set_size(n);
+
+ double const* const* a = A.data_array();
+ double const* b = B.data_block();
+ double* outdata = out.data_block();
+
+ for (unsigned int i = 0; i < n; ++i) {
+ double accum = 0;
+ for (unsigned int k = 0; k < l; ++k)
+ accum += a[k][i] * b[k];
+ outdata[i] = accum;
+ }
+}
+
+//: Compute $A b$ for vector b. out may not be b.
+void vnl_fastops::Ab(vnl_vector<double>& out, const vnl_matrix<double>& A, const vnl_vector<double>& b)
+{
+ const unsigned int m = A.cols();
+ const unsigned int l = b.size();
+
+ // Verify matrices compatible
+ if (m != l) {
+ vcl_cerr << "vnl_fastops::Ab: argument sizes do not match: " << m << " != " << l << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int n = A.rows();
+
+ // Verify output is the right size
+ if (out.size() != n)
+ out.set_size(n);
+
+ double const* const* a = A.data_array();
+ double const* bb = b.data_block();
+ double* outdata = out.data_block();
+
+ for (unsigned int i = 0; i < n; ++i) {
+ double accum = 0;
+ for (unsigned int k = 0; k < l; ++k)
+ accum += a[i][k] * bb[k];
+ outdata[i] = accum;
+ }
+}
+
+//: Compute $A B^\top$.
+void vnl_fastops::ABt(vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+
+ // Verify matrices compatible
+ if (na != nb) {
+ vcl_cerr << "vnl_fastops::ABt: argument sizes do not match: " << na << " != " << nb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify output is the right size
+ if (out.rows() != ma || out.columns() != mb)
+ out.set_size(ma,mb);
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** outdata = out.data_array();
+
+ for (unsigned int i = 0; i < ma; ++i)
+ for (unsigned int j = 0; j < mb; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < na; ++k)
+ accum += a[i][k] * b[j][k];
+ outdata[i][j] = accum;
+ }
+}
+
+//: Compute $ X += A^\top A$
+void vnl_fastops::inc_X_by_AtA(vnl_matrix<double>& X, const vnl_matrix<double>& A)
+{
+ const unsigned int m = X.rows();
+ const unsigned int n = X.columns();
+
+ // Verify output is the right size
+ if (m != n || m != A.columns()) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AtA: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ const unsigned int l = A.rows();
+
+ double const* const* a = A.data_array();
+ double** x = X.data_array();
+
+ if (l == 2) {
+ for (unsigned int i = 0; i < n; ++i) {
+ x[i][i] += (a[0][i] * a[0][i] + a[1][i] * a[1][i]);
+ for (unsigned int j = i+1; j < n; ++j) {
+ double accum = (a[0][i] * a[0][j] + a[1][i] * a[1][j]);
+ x[i][j] += accum;
+ x[j][i] += accum;
+ }
+ }
+ } else {
+ for (unsigned int i = 0; i < n; ++i)
+ for (unsigned int j = i; j < n; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < l; ++k)
+ accum += a[k][i] * a[k][j];
+ x[i][j] += accum;
+ if (i != j)
+ x[j][i] += accum;
+ }
+ }
+}
+
+//: Compute $X += A B$
+void vnl_fastops::inc_X_by_AB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (na != mb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AB: argument sizes do not match: " << na << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int ma = A.rows();
+ const unsigned int nb = B.columns();
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+
+ // Verify output is the right size
+ if (mx != ma || nx != nb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ for (unsigned int i = 0; i < ma; ++i)
+ for (unsigned int j = 0; j < nb; ++j)
+ for (unsigned int k = 0; k < na; ++k)
+ x[i][j] += a[i][k] * b[k][j];
+}
+
+//: Compute $X -= A B$
+void vnl_fastops::dec_X_by_AB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (na != mb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AB: argument sizes do not match: " << na << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int ma = A.rows();
+ const unsigned int nb = B.columns();
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+
+ // Verify output is the right size
+ if (mx != ma || nx != nb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ for (unsigned int i = 0; i < ma; ++i)
+ for (unsigned int j = 0; j < nb; ++j)
+ for (unsigned int k = 0; k < na; ++k)
+ x[i][j] -= a[i][k] * b[k][j];
+}
+
+//: Compute $X += A^\top B$
+void vnl_fastops::inc_X_by_AtB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (ma != mb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AtB: argument sizes do not match: " << ma << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+
+ // Verify output is the right size
+ if (mx != na || nx != nb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AtB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ for (unsigned int i = 0; i < na; ++i)
+ for (unsigned int j = 0; j < nb; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < ma; ++k)
+ accum += a[k][i] * b[k][j];
+ x[i][j] += accum;
+ }
+}
+
+//: Compute $X -= A^\top B$
+void vnl_fastops::dec_X_by_AtB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify matrices compatible
+ if (ma != mb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AtB: argument sizes do not match: " << ma << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+
+ // Verify output is the right size
+ if (mx != na || nx != nb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AtB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ for (unsigned int i = 0; i < na; ++i)
+ for (unsigned int j = 0; j < nb; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < ma; ++k)
+ accum += a[k][i] * b[k][j];
+ x[i][j] -= accum;
+ }
+}
+
+//: Compute $X += A^\top b$
+void vnl_fastops::inc_X_by_AtB(vnl_vector<double>& X, const vnl_matrix<double>& A, const vnl_vector<double>& B)
+{
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.size();
+
+ // Verify matrices compatible
+ if (ma != mb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AtB: argument sizes do not match: " << ma << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int mx = X.size();
+ const unsigned int na = A.columns();
+
+ // Verify output is the right size
+ if (mx != na) {
+ vcl_cerr << "vnl_fastops::inc_X_by_AtB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* b = B.data_block();
+ double* x = X.data_block();
+
+ for (unsigned int i = 0; i < na; ++i) {
+ double accum = 0;
+ for (unsigned int k = 0; k < ma; ++k)
+ accum += a[k][i] * b[k];
+ x[i] += accum;
+ }
+}
+
+//: Compute $X -= A^\top b$
+void vnl_fastops::dec_X_by_AtB(vnl_vector<double>& X, const vnl_matrix<double>& A, const vnl_vector<double>& B)
+{
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.size();
+
+ // Verify matrices compatible
+ if (ma != mb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AtB: argument sizes do not match: " << ma << " != " << mb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int mx = X.size();
+ const unsigned int na = A.columns();
+
+ // Verify output is the right size
+ if (mx != na) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AtB: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* b = B.data_block();
+ double* x = X.data_block();
+
+ for (unsigned int i = 0; i < na; ++i) {
+ double accum = 0;
+ for (unsigned int k = 0; k < ma; ++k)
+ accum += a[k][i] * b[k];
+ x[i] -= accum;
+ }
+}
+
+//: Compute $ X -= A^\top A$
+void vnl_fastops::dec_X_by_AtA(vnl_matrix<double>& X, const vnl_matrix<double>& A)
+{
+ const unsigned int m = X.rows();
+ const unsigned int n = X.columns();
+
+ // Verify output is the right size
+ if (m != n || m != A.columns()) {
+ vcl_cerr << "vnl_fastops::dec_X_by_AtA: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ const unsigned int l = A.rows();
+
+ double const* const* a = A.data_array();
+ double** x = X.data_array();
+
+ if (l == 2) {
+ for (unsigned int i = 0; i < n; ++i) {
+ x[i][i] -= (a[0][i] * a[0][i] + a[1][i] * a[1][i]);
+ for (unsigned int j = i+1; j < n; ++j) {
+ double accum = (a[0][i] * a[0][j] + a[1][i] * a[1][j]);
+ x[i][j] -= accum;
+ x[j][i] -= accum;
+ }
+ }
+ } else {
+ for (unsigned int i = 0; i < n; ++i)
+ for (unsigned int j = i; j < n; ++j) {
+ double accum = 0;
+ for (unsigned int k = 0; k < l; ++k)
+ accum += a[k][i] * a[k][j];
+ x[i][j] -= accum;
+ if (i != j)
+ x[j][i] -= accum;
+ }
+ }
+}
+
+//: Compute dot product of a and b
+double vnl_fastops::dot(const double* a, const double* b, unsigned int n)
+{
+#define METHOD 3 // Method 2 is fastest on the u170 -- weird.
+ double accum = 0;
+#if METHOD == 1
+ const double* aend = a + n;
+ while (a != aend)
+ accum += *a++ * *b++;
+#endif
+#if METHOD == 2
+ for (unsigned int k = 0; k < n; ++k)
+ accum += a[k] * b[k];
+#endif
+#if METHOD == 3
+ while (n--)
+ accum += a[n] * b[n];
+#endif
+#if METHOD == 4
+ unsigned int k = n;
+ while (k > 0)
+ --k, accum += a[k] * b[k];
+#endif
+ return accum;
+#undef METHOD
+}
+
+//: Compute $X += A B^\top$
+void vnl_fastops::inc_X_by_ABt(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+
+ // Verify matrices compatible
+ if (na != nb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_ABt: argument sizes do not match: " << na << " != " << nb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify output is the right size
+ if (mx != ma || nx != mb) {
+ vcl_cerr << "vnl_fastops::inc_X_by_ABt: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ if (na == 3) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] += (a[j][0] * b[i][0] +
+ a[j][1] * b[i][1] +
+ a[j][2] * b[i][2]);
+ } else if (na == 2) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] += (a[j][0] * b[i][0] +
+ a[j][1] * b[i][1]);
+ } else if (na == 1) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] += a[j][0] * b[i][0];
+ } else {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] += dot(a[j], b[i], na);
+ }
+}
+
+//: Compute $X -= A B^\top$
+void vnl_fastops::dec_X_by_ABt(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B)
+{
+ const unsigned int na = A.columns();
+ const unsigned int nb = B.columns();
+
+ // Verify matrices compatible
+ if (na != nb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_ABt: argument sizes do not match: " << na << " != " << nb << '\n';
+ vcl_abort();
+ }
+
+ const unsigned int mx = X.rows();
+ const unsigned int nx = X.columns();
+ const unsigned int ma = A.rows();
+ const unsigned int mb = B.rows();
+
+ // Verify output is the right size
+ if (mx != ma || nx != mb) {
+ vcl_cerr << "vnl_fastops::dec_X_by_ABt: argument sizes do not match\n";
+ vcl_abort();
+ }
+
+ double const* const* a = A.data_array();
+ double const* const* b = B.data_array();
+ double** x = X.data_array();
+
+ if (na == 3) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] -= (a[j][0] * b[i][0] +
+ a[j][1] * b[i][1] +
+ a[j][2] * b[i][2]);
+ } else if (na == 2) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] -= (a[j][0] * b[i][0] +
+ a[j][1] * b[i][1]);
+ } else if (na == 1) {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] -= a[j][0] * b[i][0];
+ } else {
+ for (unsigned int i = 0; i < mb; ++i)
+ for (unsigned int j = 0; j < ma; ++j)
+ x[j][i] -= dot(a[j], b[i], na);
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.h
new file mode 100644
index 0000000000000000000000000000000000000000..54eb2f0ac5fa5a62eb6671ca22d5c407f62f4760
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fastops.h
@@ -0,0 +1,65 @@
+// This is core/vnl/vnl_fastops.h
+#ifndef vnl_fastops_h_
+#define vnl_fastops_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Collection of C-style matrix functions
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 09 Dec 96
+//
+// \verbatim
+// Modifications
+// Feb.2002 -Peter Vanroose- brief doxygen comment placed on single line
+// Jun.2004 -Peter Vanroose- Added inc_X_by_ABt dec_X_by_AtB {inc,dec}_X_by_AB
+// Jun.2004 -Peter Vanroose- First step to migrate towards non-pointer args
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vcl_deprecated.h>
+
+//: Collection of C-style matrix functions for the most time-critical applications.
+// In general, however one should consider using the vnl_transpose envelope-letter
+// class to achieve the same results with about a 10% speed penalty.
+class vnl_fastops
+{
+ public:
+ static void AtA(vnl_matrix<double>& out, const vnl_matrix<double>& A);
+ static void AB (vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void AtB(vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void AtB(vnl_vector<double>& out, const vnl_matrix<double>& A, const vnl_vector<double>& b);
+ static void Ab (vnl_vector<double>& out, const vnl_matrix<double>& A, const vnl_vector<double>& b);
+ static void ABt(vnl_matrix<double>& out, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+
+ static void inc_X_by_AtA(vnl_matrix<double>& X, const vnl_matrix<double>& A);
+ static void inc_X_by_AB (vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void inc_X_by_AtB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void inc_X_by_AtB(vnl_vector<double>& X, const vnl_matrix<double>& A, const vnl_vector<double>& b);
+ static void inc_X_by_ABt(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+
+ static void dec_X_by_AtA(vnl_matrix<double>& X, const vnl_matrix<double>& A);
+ static void dec_X_by_AB (vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void dec_X_by_AtB(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+ static void dec_X_by_AtB(vnl_vector<double>& X, const vnl_matrix<double>& A, const vnl_vector<double>& b);
+ static void dec_X_by_ABt(vnl_matrix<double>& X, const vnl_matrix<double>& A, const vnl_matrix<double>& B);
+
+ private: // \deprecated; use the ref-style versions instead!
+ static void AtA(const vnl_matrix<double>& A, vnl_matrix<double>* out) {
+ VXL_DEPRECATED("vnl_fastops::AtA"); AtA(*out, A); }
+ static void AB (const vnl_matrix<double>& A, const vnl_matrix<double>& B, vnl_matrix<double>* out) {
+ VXL_DEPRECATED("vnl_fastops::AA"); AB(*out, A,B); }
+ static void AtB(const vnl_matrix<double>& A, const vnl_matrix<double>& B, vnl_matrix<double>* out) {
+ VXL_DEPRECATED("vnl_fastops::AtB"); AtB(*out, A,B); }
+ static void AtB(const vnl_matrix<double>& A, const vnl_vector<double>& b, vnl_vector<double>* out) {
+ VXL_DEPRECATED("vnl_fastops::AtB"); AtB(*out, A,b); }
+ static void ABt(const vnl_matrix<double>& A, const vnl_matrix<double>& B, vnl_matrix<double>* out) {
+ VXL_DEPRECATED("vnl_fastops::ABt"); ABt(*out, A,B); }
+
+ // BLAS-like operations
+ static double dot(const double* a, const double* b, unsigned int n);
+};
+
+#endif // vnl_fastops_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..b414470d74ee7d2cdfccd5e7903b7c2f2057f3fa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.h
@@ -0,0 +1,39 @@
+// This is core/vnl/vnl_file_matrix.h
+#ifndef vnl_file_matrix_h_
+#define vnl_file_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Load vnl_matrix<double> from file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Documentation tidied
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix.h>
+
+//: Class to load a matrix from a file.
+export template <class T>
+class vnl_file_matrix : public vnl_matrix<T>
+{
+ VCL_SAFE_BOOL_DEFINE;
+ public:
+ vnl_file_matrix(char const* filename);
+
+ operator safe_bool () const
+ { return (ok_)? VCL_SAFE_BOOL_TRUE : 0; }
+ bool operator!() const
+ { return !ok_; }
+
+ private:
+ bool ok_;
+};
+
+#endif // vnl_file_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..dc4e1fa4473a7e029f337771f82256fad72afbdf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_matrix.txx
@@ -0,0 +1,36 @@
+// This is core/vnl/vnl_file_matrix.txx
+#ifndef vnl_file_matrix_txx_
+#define vnl_file_matrix_txx_
+//:
+// \file
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_file_matrix.h"
+#include <vcl_fstream.h>
+#include <vcl_iostream.h>
+
+//: Load matrix from filename.
+template <class T>
+vnl_file_matrix<T>::vnl_file_matrix(char const* filename)
+{
+ if (filename && filename[0]=='-' && filename[1]=='\0')
+ ok_ = this->read_ascii(vcl_cin);
+ else {
+ vcl_ifstream o(filename);
+ ok_ = this->read_ascii(o);
+ }
+
+ if (!ok_)
+ vcl_cerr << "vnl_file_matrix: ERROR loading " << filename << '\n';
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_FILE_MATRIX_INSTANTIATE
+#define VNL_FILE_MATRIX_INSTANTIATE(T) template class vnl_file_matrix<T >
+
+#endif // vnl_file_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.h
new file mode 100644
index 0000000000000000000000000000000000000000..12477c023cc2032cb4258d13c82b8e5df60237ec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.h
@@ -0,0 +1,40 @@
+// This is core/vnl/vnl_file_vector.h
+#ifndef vnl_file_vector_h_
+#define vnl_file_vector_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Load vnl_vector<T> from file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+// \verbatim
+// Modifications
+// fsm created by modifying class FileMatrix
+// LSB (Manchester) 23/3/01 Tidied documentation
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+
+//: Templated class to load a vector from a file.
+template <class T>
+class vnl_file_vector : public vnl_vector<T>
+{
+ VCL_SAFE_BOOL_DEFINE;
+ public:
+ vnl_file_vector(char const* filename);
+
+ operator safe_bool () const
+ { return (ok_)? VCL_SAFE_BOOL_TRUE : 0; }
+ bool operator!() const
+ { return !ok_; }
+
+ private:
+ bool ok_;
+};
+
+#endif // vnl_file_vector_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.txx
new file mode 100644
index 0000000000000000000000000000000000000000..13786b6e28802abaec6cbc3493cbb98aabd1e5ce
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_file_vector.txx
@@ -0,0 +1,38 @@
+// This is core/vnl/vnl_file_vector.txx
+#ifndef vnl_file_vector_txx_
+#define vnl_file_vector_txx_
+//:
+// \file
+
+#include "vnl_file_vector.h"
+
+#include <vcl_fstream.h>
+#include <vcl_cstring.h> // for strcmp()
+
+//: Load vector from filename.
+template <class T>
+vnl_file_vector<T>::vnl_file_vector(char const* filename)
+ : vnl_vector<T>() // makes an empty vector.
+{
+#ifdef DEBUG
+ vcl_cerr << "filename=" << filename << "\nsize=" << this->size() << '\n';
+#endif
+ if (filename && vcl_strcmp(filename, "-")) {
+ vcl_ifstream o(filename);
+ ok_ = this->read_ascii(o);
+ }
+ else
+ ok_ = this->read_ascii(vcl_cin);
+#ifdef DEBUG
+ vcl_cerr << "size=" << this->size() << '\n';
+#endif
+ if (!ok_)
+ vcl_cerr << "vnl_file_vector: ERROR loading from " << filename << '\n';
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_FILE_VECTOR_INSTANTIATE
+#define VNL_FILE_VECTOR_INSTANTIATE(T) template class vnl_file_vector<T >
+
+#endif // vnl_file_vector_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_finite.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_finite.h
new file mode 100644
index 0000000000000000000000000000000000000000..133bf34479de7d220e91373cb956a911e64604ab
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_finite.h
@@ -0,0 +1,606 @@
+// This is core/vnl/vnl_finite.h
+#ifndef vnl_finite_h_
+#define vnl_finite_h_
+//:
+// \file
+// \brief modulo-N arithmetic (finite ring Z_N and Z_N[X])
+//
+// The templated vnl_finite_int<N> provides arithmetic "modulo N", i.e.,
+// arithmetic in the finite (Galois) field GF(N) in case N is a prime
+// or just in the finite ring (or semi-field) of integers modulo N otherwise.
+// In that case division makes no sense (unless no zero divisor is involved),
+// but all other operations remain valid.
+//
+// Note that this does not cover finite fields with non-prime sizes (4,8,9,...).
+// These are covered by the vnl_finite_int_poly<N,M> class, which implements
+// arithmetic with polynomials of degree < M over vnl_finite_int<N>.
+// Multiplication is defined modulo a degree M polynomial.
+//
+// For N prime, and when the "modulo" polynomial is irreducible,
+// vnl_finite_int_poly<N,M> implements the finite field GF(N^M).
+//
+// \author
+// Peter Vanroose, K.U.Leuven, ESAT/PSI.
+// \date 5 May 2002.
+//
+// \verbatim
+// Modifications
+// 1 June 2002 - Peter Vanroose - added totient(), decompose(), is_unit(), order(), log(), exp().
+// 4 June 2002 - Peter Vanroose - renamed class and file name
+// 8 June 2002 - Peter Vanroose - added vnl_finite_int_poly<N,M>
+// \endverbatim
+
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+#include <vcl_vector.h>
+
+//: finite modulo-N arithmetic
+//
+// The templated vnl_finite_int<N> provides arithmetic "modulo N", i.e.,
+// arithmetic in the finite (Galois) field GF(N) in case N is a prime
+// or just in the finite ring (or semi-field) of integers modulo N otherwise.
+// In that case division makes no sense (unless no zero divisor is involved),
+// but all other operations remain valid.
+//
+template <int N>
+class vnl_finite_int
+{
+ int val_; //!< value of this number (smallest nonnegative representation)
+
+ typedef vnl_finite_int<N> Base;
+ public:
+ //: The number of different finite_int numbers of this type
+ static unsigned int cardinality() { return N; }
+
+ //: Creates a finite int element.
+ // Default constructor gives 0.
+ // Also serves as automatic cast from int to vnl_finite_int.
+ inline vnl_finite_int(int x = 0) : val_((x%=N)<0?N+x:x), mo_(0), lp1_(0) {assert(N>1);}
+ // Copy constructor
+ inline vnl_finite_int(Base const& x) : val_(int(x)), mo_(x.mo_), lp1_(x.lp1_) {}
+ // Destructor
+ inline ~vnl_finite_int() {}
+ // Implicit conversions
+ inline operator int() const { return val_; }
+ inline operator int() { return val_; }
+ inline operator long() const { return val_; }
+ inline operator long() { return val_; }
+ inline operator short() const { short r = (short)val_; assert(r == val_); return r; }
+ inline operator short() { short r = (short)val_; assert(r == val_); return r; }
+
+ //: Assignment
+ inline Base& operator=(Base const& x) { val_ = int(x); mo_=x.mo_; lp1_=x.lp1_; return *this; }
+ inline Base& operator=(int x) { x%=N; val_ = x<0 ? N+x : x; mo_=lp1_=0; return *this; }
+
+ //: Comparison of finite int numbers.
+ // Note that finite ints have no order, so < and > make no sense.
+ inline bool operator==(Base const& x) const { return val_ == int(x); }
+ inline bool operator!=(Base const& x) const { return val_ != int(x); }
+ inline bool operator==(int x) const { return operator==(Base(x)); }
+ inline bool operator!=(int x) const { return !operator==(x); }
+
+ //: Unary minus - returns the additive inverse
+ inline Base operator-() const { return Base(N-val_); }
+ //: Unary plus - returns the current number
+ inline Base operator+() const { return *this; }
+ //: Unary not - returns true if finite int number is equal to zero.
+ inline bool operator!() const { return val_ == 0; }
+
+ //: Plus&assign: replace lhs by lhs + rhs
+ inline Base& operator+=(Base const& r) { mo_=lp1_=0; val_ += int(r); if (val_ >= int(N)) val_ -= N; return *this; }
+ inline Base& operator+=(int r) { return operator=(val_+r); }
+ //: Minus&assign: replace lhs by lhs - rhs
+ inline Base& operator-=(Base const& r) { mo_=lp1_=0; val_ -= int(r); if (val_ < 0) val_ += N; return *this; }
+ inline Base& operator-=(int r) { return operator=(val_-r); }
+ //: Multiply&assign: replace lhs by lhs * rhs
+ inline Base& operator*=(int r) {
+ r %=N; if (r<0) r=N+r;
+ // This rather complicated implementation is necessary to avoid integer overflow
+ if (N<=0x7fff || (val_<=0x7fff && r<=0x7fff)) { val_ *= r; val_ %= N; return *this; }
+ else { int v=val_; operator+=(v); operator*=(r/2); if (r%2) operator+=(v); return *this; }
+ }
+ //: Multiply&assign: replace lhs by lhs * rhs
+ inline Base& operator*=(Base const& r) {
+ mo_=0;
+ if (lp1_!=0 && r.lp1_!=0) set_log(lp1_+r.lp1_-2); else lp1_=0;
+ // This rather complicated implementation is necessary to avoid integer overflow
+ unsigned int s=int(r);
+ if (N<=0x7fff || (val_<=0x7fff && s<=0x7fff)) { val_ *= s; val_ %= N; return *this; }
+ else { int v=val_; operator+=(v); operator*=(s/2); if (s%2) operator+=(v); return *this; }
+ }
+
+ //: Return the Euler totient function, i.e., the number of units of this ring
+ // This number also equals the periodicity of the exponent: every unit,
+ // when raised to this power, yields 1.
+ static inline unsigned int totient() {
+ static unsigned int t_ = 0; // cached value
+ if (t_ != 0) return t_;
+ vcl_vector<unsigned int> d = decompose();
+ t_ = 1; unsigned int p = 1;
+ for (unsigned int i=0; i<d.size(); ++i)
+ {
+ if (p != d[i]) t_ *= d[i]-1;
+ else t_ *= d[i];
+ p = d[i];
+ }
+ return t_;
+ }
+
+ //: Multiplicative inverse.
+ // Uses exp() and log() for efficient computation, unless log() is not defined.
+ inline Base reciproc() const {
+ assert(is_unit());
+ if (val_==1) return *this;
+ Base z = smallest_generator();
+ if (z!=1) return exp(Base::totient()-log());
+ for (unsigned int r=1; r<=N/2; ++r) {
+ unsigned int t=int(*this*int(r));
+ if (t==1) return r; else if (t==N-1) return N-r;
+ }
+ return 0; // This will never be executed
+ }
+
+ //: Divide&assign. Uses r.reciproc() for efficient computation.
+ inline Base& operator/=(Base const& r) {
+ assert(r.is_unit());
+ return val_ == 0 ? operator=(0) : operator*=(r.reciproc());
+ }
+
+ //: Pre-increment (++r).
+ inline Base& operator++() { mo_=lp1_=0; ++val_; if (val_==N) val_=0; return *this; }
+ //: Pre-decrement (--r).
+ inline Base& operator--() { mo_=lp1_=0; if (val_==0) val_=N; --val_; return *this; }
+ //: Post-increment (r++).
+ inline Base operator++(int){Base b=*this; mo_=lp1_=0; ++val_; if (val_==N) val_=0; return b; }
+ //: Post-decrement (r--).
+ inline Base operator--(int){Base b=*this; mo_=lp1_=0; if (val_==0) val_=N; --val_; return b;}
+
+ //: Write N as the unique product of prime factors.
+ static vcl_vector<unsigned int> decompose() {
+ static vcl_vector<unsigned int> decomposition_ = vcl_vector<unsigned int>(); // cached value
+ if (decomposition_.size() > 0) return decomposition_;
+ unsigned int r = N;
+ for (unsigned int d=2; d*d<=r; ++d)
+ while (r%d == 0) { decomposition_.push_back(d); r /= d; }
+ if (r > 1) decomposition_.push_back(r);
+ return decomposition_;
+ }
+
+ //: Return true when N is a prime number, i.e., when this ring is a field
+ static inline bool is_field() {
+ vcl_vector<unsigned int> d = Base::decompose();
+ return d.size() == 1;
+ }
+
+ //: Return true only when x is a unit in this ring.
+ // In a field, all numbers except 0 are units.
+ // The total number of units is given by the Euler totient function.
+ inline bool is_unit() const { return gcd(val_) == 1; }
+
+ //: Return true only when x is a zero divisor, i.e., is not a unit.
+ inline bool is_zero_divisor() const { return gcd(val_) != 1; }
+
+ //: The additive order of x is the smallest nonnegative r such that r*x == 0.
+ inline unsigned int additive_order() const { if (val_ == 0) return 1; return N/gcd(val_); }
+
+ //: The multiplicative order of x is the smallest r (>0) such that x^r == 1.
+ inline unsigned int multiplicative_order() const {
+ if (mo_ != 0) return mo_;
+ if (gcd(val_) != 1) return -1; // should actually return infinity
+ Base y = val_;
+ for (int r=1; r<N; ++r) { if (y==1) return mo_=r; y *= val_; }
+ return 0; // this should not happen
+ }
+
+ //: Return the smallest multiplicative generator of the units in this ring.
+ // This is only possible if the units form a cyclic group for multiplication.
+ // If not, smallest_generator() returns 1 to indicate this fact.
+ // Note that the multiplication group of a finite *field* is always cyclic.
+ static Base smallest_generator() {
+ static Base gen_ = 0; // cached value
+ if (gen_ != 0) return gen_;
+ if (N==2) return gen_=1;
+ unsigned int h = Base::totient() / 2; // note that totient() is always even
+ for (gen_=2; gen_!=0; ++gen_) {
+ // calculate gen_^h
+ unsigned int g=h; Base y = 1, z = gen_; while (g>0) { if (g%2) y *= z; g/=2; z*=z; }
+ // quick elimination of non-generator:
+ if (y == 1) continue;
+ // calculate gen_.multiplicative_order() only if really necessary:
+ if (gen_.multiplicative_order() == Base::totient()) { gen_.set_log(1); return gen_; }
+ }
+ assert(!Base::is_field()); // can only reach this point when N is not prime
+ return gen_=1;
+ }
+
+ //: Return the r-th power of this number.
+ inline Base pow(int r) {
+ r %= Base::totient(); if (r<0) r += Base::totient();
+ if (r==0) return 1; if (r==1) return *this;
+ Base y = 1, z = *this; int s=r; while (s!=0) { if (s%2) y*=z; s/=2; z*=z; }
+ if (lp1_ != 0) y.set_log(r*(lp1_-1));
+ return y;
+ }
+
+ //: Return the smallest nonnegative exponent r for which x=g^r, where g is the smallest generator.
+ inline unsigned int log() const {
+ if (is_zero_divisor()) return -1; // should actually return minus infinity
+ if (lp1_ != 0) return lp1_-1;
+ Base z = smallest_generator();
+ assert(N==2||z!=1); // otherwise, the units of this ring do not form a cyclic group
+ Base y = 1;
+ for (lp1_=1; lp1_<=N; ++lp1_) {
+ if (y == *this) return lp1_-1;
+ y *= z;
+ }
+ return -1; // should never reach this point
+ }
+
+ //: Return the inverse of log(), i.e., return g^r where g is the smallest generator.
+ static inline Base exp(int r) {
+ Base z = smallest_generator();
+ assert(N==2||z!=1); // otherwise, the units of this ring do not form a cyclic group
+ return z.pow(r);
+ }
+
+ //: Calculate the greatest common divisor of l and N.
+ static inline unsigned int gcd(unsigned int l, unsigned int n) {
+ unsigned int l1 = n;
+ while (l!=0) { unsigned int t = l; l = l1 % l; l1 = t; }
+ return l1;
+ }
+ static inline unsigned int gcd(unsigned int l) { return gcd(l, N); }
+
+ private:
+ //: private function to set cached value of lp1_ when available
+ void set_log(unsigned int r) const { r %= Base::totient(); lp1_ = r+1; }
+
+ mutable unsigned int mo_; //!< cached value for multiplicative order
+ mutable unsigned int lp1_; //!< cached value for 1+log()
+};
+
+//: formatted output
+// \relates vnl_finite_int
+template <int N>
+inline vcl_ostream& operator<< (vcl_ostream& s, vnl_finite_int<N> const& r)
+{
+ return s << int(r);
+}
+
+//: simple input
+// \relates vnl_finite_int
+template <int N>
+inline vcl_istream& operator>> (vcl_istream& s, vnl_finite_int<N>& r)
+{
+ int n; s >> n; r=n; return s;
+}
+
+//: Returns the sum of two finite int numbers.
+// \relates vnl_finite_int
+template <int N>
+inline vnl_finite_int<N> operator+ (vnl_finite_int<N> const& r1, vnl_finite_int<N> const& r2)
+{
+ vnl_finite_int<N> result(r1); return result += r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator+ (vnl_finite_int<N> const& r1, int r2)
+{
+ vnl_finite_int<N> result(r1); return result += r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator+ (int r2, vnl_finite_int<N> const& r1)
+{
+ vnl_finite_int<N> result(r1); return result += r2;
+}
+
+//: Returns the difference of two finite int numbers.
+// \relates vnl_finite_int
+template <int N>
+inline vnl_finite_int<N> operator- (vnl_finite_int<N> const& r1, vnl_finite_int<N> const& r2)
+{
+ vnl_finite_int<N> result(r1); return result -= r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator- (vnl_finite_int<N> const& r1, int r2)
+{
+ vnl_finite_int<N> result(r1); return result -= r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator- (int r2, vnl_finite_int<N> const& r1)
+{
+ vnl_finite_int<N> result(-r1); return result += r2;
+}
+
+//: Returns the product of two finite int numbers.
+// \relates vnl_finite_int
+template <int N>
+inline vnl_finite_int<N> operator* (vnl_finite_int<N> const& r1, vnl_finite_int<N> const& r2)
+{
+ vnl_finite_int<N> result(r1); return result *= r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator* (vnl_finite_int<N> const& r1, int r2)
+{
+ vnl_finite_int<N> result(r1); return result *= r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator* (int r2, vnl_finite_int<N> const& r1)
+{
+ vnl_finite_int<N> result(r1); return result *= r2;
+}
+
+//: Returns the quotient of two finite int numbers.
+// Uses r2.reciproc() for efficient computation.
+// \relates vnl_finite_int
+template <int N>
+inline vnl_finite_int<N> operator/(vnl_finite_int<N> const& r1, vnl_finite_int<N> const& r2)
+{
+ assert(r2.is_unit()); return r1 == 0 ? vnl_finite_int<N>(0) : r1*r2.reciproc();
+}
+
+template <int N>
+inline vnl_finite_int<N> operator/ (vnl_finite_int<N> const& r1, int r2)
+{
+ vnl_finite_int<N> result(r1); return result /= r2;
+}
+
+template <int N>
+inline vnl_finite_int<N> operator/ (int r1, vnl_finite_int<N> const& r2)
+{
+ vnl_finite_int<N> result(r1); return result /= r2;
+}
+
+template <int N>
+inline bool operator== (int r1, vnl_finite_int<N> const& r2) { return r2==r1; }
+template <int N>
+inline bool operator!= (int r1, vnl_finite_int<N> const& r2) { return r2!=r1; }
+
+//:
+// \relates vnl_finite_int
+template <int N>
+inline vnl_finite_int<N> vnl_math_squared_magnitude(vnl_finite_int<N> const& x) { return x*x; }
+template <int N>
+inline vnl_finite_int<N> vnl_math_sqr(vnl_finite_int<N> const& x) { return x*x; }
+template <int N>
+inline bool vnl_math_isnan(vnl_finite_int<N> const& ){return false;}
+template <int N>
+inline bool vnl_math_isfinite(vnl_finite_int<N> const& x){return true;}
+
+//: finite modulo-N arithmetic with polynomials of degree < M
+//
+// This class implements arithmetic with polynomials of degree < M over
+// vnl_finite_int<N>. Multiplication is defined modulo a polynomial of degree M.
+//
+// For N prime, and when the "modulo" polynomial is irreducible,
+// vnl_finite_int_poly<N,M> implements the finite field GF(N^M).
+//
+// Addition, subtraction and scalar multiplication are already defined without
+// the presence of a "modulo" polynomial. Restricted to these operations,
+// vnl_finite_int_poly<N,M> forms an M-dimensional vector space over
+// vnl_finite_int<N>. The current implementation does not yet implement
+// anything more than that.
+//
+template <int N, int M>
+class vnl_finite_int_poly
+{
+ typedef vnl_finite_int_poly<N,M> Base;
+ typedef vnl_finite_int<N> Scalar;
+
+ vcl_vector<Scalar> val_; //!< M-tuple (or degree M-1 polynomial) representing this
+
+ // This essentially implements std::pow(int,int) which is not always available
+ static unsigned int Ntothe(unsigned int m) { return m==0?1:N*Ntothe(m-1); }
+ public:
+ //: The number of different finite_int polynomials of this type
+ static unsigned int cardinality() { return Ntothe(M); }
+
+ //: Creates a general finite_int_poly.
+ inline vnl_finite_int_poly(vcl_vector<Scalar> const& p) : val_(p) { assert(N>1); assert(M>0); assert(p.size()<=M); }
+ //: Creates a degree 0 finite_int_poly.
+ inline vnl_finite_int_poly(Scalar const& n) : val_(vcl_vector<Scalar>(1)) { assert(N>1); assert(M>0); val_[0]=n; }
+ //: Default constructor. Creates a degree 0 finite_int_poly equal to 0.
+ inline vnl_finite_int_poly() : val_(vcl_vector<Scalar>(1)) { assert(N>1); assert(M>0); val_[0]=0; }
+ // Copy constructor
+ inline vnl_finite_int_poly(Base const& x) : val_(x.val_) {}
+ // Destructor
+ inline ~vnl_finite_int_poly() {}
+
+ //: Formal degree of this polynomial
+ inline unsigned int deg() const { return val_.size() - 1; }
+
+ //: Effective degree of this polynomial; equals -1 when this polynomial is 0.
+ inline int degree() const { for (int i=deg(); i>=0; --i) if (val_[i]!=0) return i; return -1; }
+
+ //: Access to individual coefficients
+ inline Scalar operator[](unsigned int i) const { assert(i<M); return i<=deg() ? val_[i] : Scalar(0); }
+
+ //: Assignment
+ inline Base& operator=(Base const& x) { val_ = x.val_; return *this; }
+ inline Base& operator=(Scalar const& n) { val_ = vcl_vector<Scalar>(1); val_[0] = n; return *this; }
+
+ //: Comparison of finite int polys.
+ inline bool operator==(Base const& x) const {
+ for (unsigned int i=0; i<=deg(); ++i)
+ if (val_[i] != x[i]) return false;
+ for (unsigned int i=deg()+1; i<=x.deg(); ++i)
+ if (x[i] != 0) return false;
+ return true;
+ }
+ inline bool operator!=(Base const& x) const { return !operator==(x); }
+ inline bool operator==(Scalar const& x) const {
+ if (x!=val_[0]) return false;
+ for (unsigned int i=1; i<=deg(); ++i) if (val_[i] != 0) return false;
+ return true;
+ }
+ inline bool operator!=(Scalar const& x) const { return !operator==(x); }
+
+ //: Unary minus - returns the additive inverse
+ inline Base operator-() const { vcl_vector<Scalar> p = val_; for (unsigned int i=0; i<p.size(); ++i) p[i]=-p[i]; return p; }
+ //: Unary plus - returns the current polynomial
+ inline Base operator+() const { return *this; }
+ //: Unary not - returns true if finite int poly is equal to zero.
+ inline bool operator!() const { for (unsigned int i=0; i<=deg(); ++i) if (val_[i] != 0) return false; return true; }
+
+ //: Plus&assign: replace lhs by lhs + rhs
+ inline Base& operator+=(Base const& r) {
+ for (unsigned int i=0; i<=r.deg(); ++i)
+ if (i<=deg()) val_[i] += r[i];
+ else val_.push_back(r[i]);
+ return *this;
+ }
+ //: Minus&assign: replace lhs by lhs - rhs
+ inline Base& operator-=(Base const& r) {
+ for (unsigned int i=0; i<=r.deg(); ++i)
+ if (i<=deg()) val_[i] -= r[i];
+ else val_.push_back(-r[i]);
+ return *this;
+ }
+
+ //: Scalar multiple of this
+ inline Base& operator*=(Scalar const& n) { for (unsigned int i=0; i<=deg(); ++i) val_[i] *= n; return *this; }
+
+ //: The additive order of x is the smallest positive r such that r*x == 0.
+ inline unsigned int additive_order() const {
+ unsigned int r = N;
+ for (unsigned int i=0; i<=deg(); ++i)
+ if (val_[i] != 0) r=Scalar::gcd(val_[i],r);
+ return N/r;
+ }
+
+ //: get/set the (irreducible) modulo polynomial of degree M
+ // Note that this polynomial has to be set only once, i.e., once set,
+ // it applies to all vnl_finite_int_polys with the same N and M.
+ static vcl_vector<Scalar>& modulo_polynomial(vcl_vector<Scalar> p = vcl_vector<Scalar>())
+ {
+ static vcl_vector<Scalar> poly_(M+1, Scalar(0));
+ if (p.size() == 0) { // retrieval
+ assert(poly_[M] != 0); // cannot retrieve before having set
+ }
+ else
+ {
+ assert(p.size() == M+1 && p[M].is_unit());// must be of effective degree M
+ // Now set poly_, thereby making the coefficient poly_[M] equal to -1.
+ Scalar f = -1/p[M];
+ for (int m=0; m<=M; ++m) poly_[m] = f*p[m];
+ }
+ return poly_;
+ }
+
+ //: Multiply&assign: replace lhs by lhs * rhs, modulo the "modulo" polynomial
+ inline Base& operator*=(Base const& r) {
+ Base x = *this; *this = r; *this *= x[0];
+ while (val_.size() < M) val_.push_back(0);
+ for (int i=1; i<=x.degree(); ++i)
+ for (unsigned int j=0; j<=r.deg(); ++j)
+ add_modulo_poly(i+j, x[i]*r[j]);
+ return *this;
+ }
+
+ //: Return the multiplicative order of this polynomial.
+ inline unsigned int multiplicative_order() const {
+ Base t = Scalar(1);
+ unsigned int order = 0;
+ do t *= *this, ++order; while (t != Scalar(1) && t != Scalar(0));
+ return t==Scalar(1) ? order : -1;
+ }
+
+ //: Return true when this ring is a field.
+ // Note that this requires that N is a prime, but that condition is not
+ // sufficient: also the "modulo" polynomial must be irreducible.
+ static inline bool is_field() {
+ if (!Scalar::is_field()) return false;
+
+ vcl_vector<Scalar> mod_p = Base::modulo_polynomial();
+ mod_p.pop_back(); // remove the "-1" coefficient of X^M
+ return Base(mod_p).multiplicative_order()+1 == Base::cardinality();
+ }
+
+ //: Return the smallest multiplicative generator of the units in this ring.
+ // This is only possible if the units form a cyclic group for multiplication.
+ // If not, smallest_generator() returns 1 to indicate this fact.
+ // Note that the multiplication group of a finite *field* is always cyclic.
+ static Base smallest_generator() {
+ if (!Base::is_field()) return Scalar(1);
+ vcl_vector<Scalar> mod_p = Base::modulo_polynomial();
+ mod_p.pop_back(); // remove the "-1" coefficient of X^M
+ return Base(mod_p);
+ }
+
+ private:
+ //: Add x to the i-th degree coefficient of val_, possibly reducing modulo the "modulo" poly.
+ inline void add_modulo_poly(unsigned int m, Scalar const& x)
+ {
+ if (m < M) val_[m] += x;
+ else {
+ vcl_vector<Scalar> p = modulo_polynomial(); // where p[M] == -1
+ for (int k=0; k<M; ++k) add_modulo_poly(m-M+k, x*p[k]); // recursive call
+ }
+ }
+};
+
+//: Returns the sum of two finite int polynomials.
+// \relates vnl_finite_int_poly
+template <int N, int M>
+inline vnl_finite_int_poly<N,M> operator+ (vnl_finite_int_poly<N,M> const& r1, vnl_finite_int_poly<N,M> const& r2)
+{
+ vnl_finite_int_poly<N,M> result=r1; return result += r2;
+}
+
+//: Returns the difference of two finite int polynomials.
+// \relates vnl_finite_int_poly
+template <int N, int M>
+inline vnl_finite_int_poly<N,M> operator- (vnl_finite_int_poly<N,M> const& r1, vnl_finite_int_poly<N,M> const& r2)
+{
+ vnl_finite_int_poly<N,M> result=r1; return result -= r2;
+}
+
+//: Returns a scalar multiple of a finite int polynomial.
+// \relates vnl_finite_int
+// \relates vnl_finite_int_poly
+template <int N, int M>
+inline vnl_finite_int_poly<N,M> operator* (vnl_finite_int_poly<N,M> const& r1, vnl_finite_int<N> const& r2)
+{
+ vnl_finite_int_poly<N,M> result(r1); return result *= r2;
+}
+
+template <int N, int M>
+inline vnl_finite_int_poly<N,M> operator* (vnl_finite_int<N> const& r2, vnl_finite_int_poly<N,M> const& r1)
+{
+ vnl_finite_int_poly<N,M> result(r1); return result *= r2;
+}
+
+//: Multiplies two finite int polynomials.
+// NOTE: this requires the "modulo" polynomial to be set.
+// Do this by calling modulo_polynomial(p), where p is a vector of length M+1.
+// \relates vnl_finite_int_poly
+template <int N, int M>
+inline vnl_finite_int_poly<N,M> operator* (vnl_finite_int_poly<N,M> const& r1, vnl_finite_int_poly<N,M> const& r2)
+{
+ vnl_finite_int_poly<N,M> result(r1); return result *= r2;
+}
+
+//: formatted output
+// \relates vnl_finite_int_poly
+template <int N, int M>
+inline vcl_ostream& operator<< (vcl_ostream& s, vnl_finite_int_poly<N,M> const& r)
+{
+ bool out = false;
+ for (unsigned int i=0; i<=r.deg(); ++i) {
+ if (r[i] == 0) continue;
+ if (out) s << '+';
+ out = true;
+ if (r[i] != 1 || i==0) s << r[i];
+ if (i>0) s << 'X';
+ if (i>1) s << '^' << i;
+ }
+ if (!out) s << '0';
+ return s;
+}
+
+#endif // vnl_finite_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..f8cab64c71ed541870e7b1dc8e4029b3645ec723
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_1x1.h
+#ifndef vnl_float_1x1_h_
+#define vnl_float_1x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x1 matrix of float
+//
+// vnl_float_1x1 is a vnl_matrix<float> of fixed size 1x1.
+// It is merely a typedef for vnl_matrix_fixed<float,1,1>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,1,1> vnl_float_1x1;
+
+#endif // vnl_float_1x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..83788bf5bd8f13fc1ea7b416cd49762310f6e1af
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_1x2.h
+#ifndef vnl_float_1x2_h_
+#define vnl_float_1x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x2 matrix of float
+//
+// vnl_float_1x2 is a vnl_matrix<float> of fixed size 1x2.
+// It is merely a typedef for vnl_matrix_fixed<float,1,2>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,1,2> vnl_float_1x2;
+
+#endif // vnl_float_1x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..5bdcf7357ecd5b3978bcad11d12b108adb4936aa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_1x3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_1x3.h
+#ifndef vnl_float_1x3_h_
+#define vnl_float_1x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x3 matrix of float
+//
+// vnl_float_1x3 is a vnl_matrix<float> of fixed size 1x3.
+// It is merely a typedef for vnl_matrix_fixed<float,1,3>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,1,3> vnl_float_1x3;
+
+#endif // vnl_float_1x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2.h
new file mode 100644
index 0000000000000000000000000000000000000000..8fc4fc0859446b43a3bbf62fcf936b482029e78e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2.h
@@ -0,0 +1,34 @@
+// This is core/vnl/vnl_float_2.h
+#ifndef vnl_float_2_h_
+#define vnl_float_2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_float_2
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<float,2> already instantiated
+// Peter Vanroose, 23 Apr. 2004: added vnl_cross_2d()
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_float_2 : a vnl_vector of 2 floats.
+vnl_T_n_impl(float,2);
+
+//: Cross product of two 2-vectors
+inline
+float vnl_cross_2d(vnl_float_2 const& v1, vnl_float_2 const& v2)
+{
+ return v1[0] * v2[1] - v1[1] * v2[0];
+}
+
+//: deprecated
+#define cross_2d vnl_cross_2d
+
+#endif // vnl_float_2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..f20f63bd7331eed90df558ff083f18baf210a943
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_2x1.h
+#ifndef vnl_float_2x1_h_
+#define vnl_float_2x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x1 matrix of float
+//
+// vnl_float_2x1 is a vnl_matrix<float> of fixed size 2x1.
+// It is merely a typedef for vnl_matrix_fixed<float,2,1>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,2,1> vnl_float_2x1;
+
+#endif // vnl_float_2x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..e55cec8974da6c26a54fe60502baaa9ed0272096
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_2x2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_2x2.h
+#ifndef vnl_float_2x2_h_
+#define vnl_float_2x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x2 matrix of float
+//
+// vnl_float_2x2 is a vnl_matrix<float> of fixed size 2x2. It is
+// merely a typedef for vnl_matrix_fixed<float,2,2>
+//
+// \author Peter Vanroose
+// \date 9 Febr 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,2,2> vnl_float_2x2;
+
+#endif // vnl_float_2x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3.h
new file mode 100644
index 0000000000000000000000000000000000000000..d3bdf31e996d5f511753405435962bcf934935ed
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3.h
@@ -0,0 +1,38 @@
+// This is core/vnl/vnl_float_3.h
+#ifndef vnl_float_3_h_
+#define vnl_float_3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_float_3
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<float,3> already instantiated
+// Peter Vanroose, 23 Apr. 2004: added vnl_cross_3d()
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_float_3 : a vnl_vector of 3 floats.
+vnl_T_n_impl(float,3);
+
+//: Cross product of two 3-vectors
+inline
+vnl_float_3 vnl_cross_3d(vnl_float_3 const& v1, vnl_float_3 const& v2)
+{
+ vnl_float_3 result;
+ result[0] = v1[1] * v2[2] - v1[2] * v2[1];
+ result[1] = v1[2] * v2[0] - v1[0] * v2[2];
+ result[2] = v1[0] * v2[1] - v1[1] * v2[0];
+ return result;
+}
+
+//: deprecated
+#define cross_3d vnl_cross_3d
+
+#endif // vnl_float_3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..1277091147fd108e44a69a27e781b2f8732ae5f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_3x1.h
+#ifndef vnl_float_3x1_h_
+#define vnl_float_3x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x1 matrix of float
+//
+// vnl_float_3x1 is a vnl_matrix<float> of fixed size 3x1.
+// It is merely a typedef for vnl_matrix_fixed<float,3,1>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,3,1> vnl_float_3x1;
+
+#endif // vnl_float_3x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..606826290e4c4879853c0299bcd2b54f6c2158d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_3x3.h
+#ifndef vnl_float_3x3_h_
+#define vnl_float_3x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x3 matrix of float
+//
+// vnl_float_3x3 is a vnl_matrix<float> of fixed size 3x3.
+// It is merely a typedef for vnl_matrix_fixed<float,3,3>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,3,3> vnl_float_3x3;
+
+#endif // vnl_float_3x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x4.h
new file mode 100644
index 0000000000000000000000000000000000000000..ed90bfd39640b7e5510d9a74068513dc598fef58
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_3x4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_3x4.h
+#ifndef vnl_float_3x4_h_
+#define vnl_float_3x4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3x4 matrix of float
+//
+// vnl_float_3x4 is a vnl_matrix<float> of fixed size 3x4.
+// It is merely a typedef for vnl_matrix_fixed<float,3,4>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,3,4> vnl_float_3x4;
+
+#endif // vnl_float_3x4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4.h
new file mode 100644
index 0000000000000000000000000000000000000000..ed2e9a824c647e15e56ee0b0fd2f29828a0acec2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_4.h
+#ifndef vnl_float_4_h_
+#define vnl_float_4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_float_4
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 25 June 1999: vnl_vector_fixed<float,4> already instantiated
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_float_4 : a vnl_vector of 4 floats.
+vnl_T_n_impl(float,4);
+
+#endif // vnl_float_4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..33a4e6d3e50477ea6b7192ac5aa83db70df5e14d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_4x3.h
+#ifndef vnl_float_4x3_h_
+#define vnl_float_4x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 4x3 matrix of float
+//
+// vnl_float_4x3 is a vnl_matrix<float> of fixed size 4x3.
+// It is merely a typedef for vnl_matrix_fixed<float,4,3>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,4,3> vnl_float_4x3;
+
+#endif // vnl_float_4x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x4.h
new file mode 100644
index 0000000000000000000000000000000000000000..75ff1852ff5b213ea43dcc8d522440c1b2f0da4c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_float_4x4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_float_4x4.h
+#ifndef vnl_float_4x4_h_
+#define vnl_float_4x4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 4x4 matrix of float
+//
+// vnl_float_4x4 is a vnl_matrix<float> of fixed size 4x4.
+// It is merely a typedef for vnl_matrix_fixed<float,4,4>
+//
+// \author Peter Vanroose
+// \date 1 April 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<float,4,4> vnl_float_4x4;
+
+#endif // vnl_float_4x4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.h
new file mode 100644
index 0000000000000000000000000000000000000000..c9062b5b458b399a840b27b276b7c81758988c31
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.h
@@ -0,0 +1,48 @@
+// This is core/vnl/vnl_fortran_copy.h
+#ifndef vnl_fortran_copy_h_
+#define vnl_fortran_copy_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Convert row-stored matrix to column-stored
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 29 Aug 96
+//
+// convert C format (row-stored) matrix to fortran format (column-stored) matrix
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix.h>
+//: Convert row-stored matrix to column-stored.
+// Convert C format (row-stored) matrix to fortran format (column-stored) matrix.
+template <class T>
+class vnl_fortran_copy
+{
+ public:
+ // Constructors/Destructors--------------------------------------------------
+
+ vnl_fortran_copy(vnl_matrix<T> const & M);
+
+ ~vnl_fortran_copy();
+
+ // Operations----------------------------------------------------------------
+ operator T*() { return data; }
+
+ protected:
+ // Data Members--------------------------------------------------------------
+ int sz;
+ T *data;
+
+ private:
+ // Helpers-------------------------------------------------------------------
+};
+
+#endif // vnl_fortran_copy_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.txx
new file mode 100644
index 0000000000000000000000000000000000000000..c610193795a443c86c9a985d0e1cfee2242a7d02
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fortran_copy.txx
@@ -0,0 +1,38 @@
+// This is core/vnl/vnl_fortran_copy.txx
+#ifndef vnl_fortran_copy_txx_
+#define vnl_fortran_copy_txx_
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 29 Aug 96
+//-----------------------------------------------------------------------------
+
+#include "vnl_fortran_copy.h"
+
+//: Generate a fortran column-storage matrix from the given matrix.
+template <class T>
+vnl_fortran_copy<T>::vnl_fortran_copy(vnl_matrix<T> const & M)
+{
+ unsigned n = M.rows();
+ unsigned p = M.columns();
+
+ data = vnl_c_vector<T>::allocate_T(sz = n*p);
+ T *d = data;
+ for (unsigned j = 0; j < p; ++j)
+ for (unsigned i = 0; i < n; ++i)
+ *d++ = M(i,j);
+}
+
+//: Destructor
+template <class T>
+vnl_fortran_copy<T>::~vnl_fortran_copy()
+{
+ vnl_c_vector<T>::deallocate(data, sz);
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_FORTRAN_COPY_INSTANTIATE
+#define VNL_FORTRAN_COPY_INSTANTIATE(T) template class vnl_fortran_copy<T >
+
+#endif // vnl_fortran_copy_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fwd.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fwd.h
new file mode 100644
index 0000000000000000000000000000000000000000..1636af674ce073625d70f86a6b51eb37a045afba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_fwd.h
@@ -0,0 +1,81 @@
+// This is core/vnl/vnl_fwd.h
+#ifndef vnl_fwd_h_
+#define vnl_fwd_h_
+
+//:
+// \file
+// \author fsm
+#include <vcl_compiler.h> // required to check for VCL_VC60
+
+template <class T> struct vnl_complex_traits;
+template <class T> class vnl_numeric_traits;
+template <class T> class vnl_c_vector;
+
+template <class T> class vnl_vector;
+template <class T> class vnl_vector_ref;
+
+template <class T> class vnl_matrix;
+template <class T> class vnl_matrix_ref;
+
+#ifdef VCL_VC60
+// VC 6.0 can't forward declare these without barfing.
+// Thereby missing the whole point....
+# include <vnl/vnl_vector_fixed.h>
+# include <vnl/vnl_matrix_fixed.h>
+// Could not make #including vec_fixed_ref.h and matrix_fixed_ref.h work under VC6 - compiler error
+// Just have to leave them out of vnl_fwd.h
+#else
+ template <class T, unsigned int n> class vnl_vector_fixed;
+ template <class T, unsigned int num_rows, unsigned int num_cols> class vnl_matrix_fixed;
+ template <class T, unsigned int n> class vnl_vector_fixed_ref;
+ template <class T, unsigned int num_rows, unsigned int num_cols> class vnl_matrix_fixed_ref;
+ template <class T, unsigned int n> class vnl_vector_fixed_ref_const;
+ template <class T, unsigned int num_rows, unsigned int num_cols> class vnl_matrix_fixed_ref_const;
+#endif
+
+template <class T> class vnl_quaternion;
+template <class Return, class Argument> class vnl_unary_function;
+template <class T> class vnl_diag_matrix;
+template <class T> class vnl_fortran_copy;
+template <class T> class vnl_identity;
+
+class vnl_cost_function;
+class vnl_cross_product_matrix;
+class vnl_double_2;
+class vnl_double_3;
+class vnl_double_4;
+class vnl_double_2x3;
+class vnl_double_3x2;
+typedef vnl_matrix_fixed<double,1,1> vnl_double_1x1;
+typedef vnl_matrix_fixed<double,1,2> vnl_double_1x2;
+typedef vnl_matrix_fixed<double,2,1> vnl_double_2x1;
+typedef vnl_matrix_fixed<double,2,2> vnl_double_2x2;
+typedef vnl_matrix_fixed<double,1,3> vnl_double_1x3;
+typedef vnl_matrix_fixed<double,3,1> vnl_double_3x1;
+typedef vnl_matrix_fixed<double,3,3> vnl_double_3x3;
+typedef vnl_matrix_fixed<double,3,4> vnl_double_3x4;
+typedef vnl_matrix_fixed<double,4,3> vnl_double_4x3;
+typedef vnl_matrix_fixed<double,4,4> vnl_double_4x4;
+class vnl_float_2;
+class vnl_float_3;
+class vnl_float_4;
+typedef vnl_matrix_fixed<float,1,2> vnl_float_1x2;
+typedef vnl_matrix_fixed<float,2,1> vnl_float_2x1;
+typedef vnl_matrix_fixed<float,2,2> vnl_float_2x2;
+typedef vnl_matrix_fixed<float,1,3> vnl_float_1x3;
+typedef vnl_matrix_fixed<float,3,1> vnl_float_3x1;
+typedef vnl_matrix_fixed<float,3,3> vnl_float_3x3;
+typedef vnl_matrix_fixed<float,3,4> vnl_float_3x4;
+typedef vnl_matrix_fixed<float,4,3> vnl_float_4x3;
+typedef vnl_matrix_fixed<float,4,4> vnl_float_4x4;
+class vnl_int_2;
+class vnl_int_3;
+class vnl_int_4;
+typedef vnl_matrix_fixed<int,2,2> vnl_int_2x2;
+struct vnl_identity_3x3;
+class vnl_least_squares_cost_function;
+class vnl_least_squares_function;
+class vnl_matlab_readhdr;
+class vnl_nonlinear_minimizer;
+
+#endif // vnl_fwd_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..ca0c79bd303f3fbaeb0a9d8ffb0083af1a82021a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.cxx
@@ -0,0 +1,110 @@
+// This is core/vnl/vnl_gamma.cxx
+#include "vnl_gamma.h"
+//:
+// \file
+// \brief Complete and incomplete gamma function approximations
+// \author Tim Cootes
+
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+
+//: Approximate gamma function
+// Uses 6 parameter Lanczos approximation as described by Viktor Toth
+// (http://www.rskey.org/gamma.htm)
+// Accurate to about 3e-11.
+double vnl_log_gamma(double x)
+{
+ double zp = 2.50662827563479526904;
+ zp += 225.525584619175212544/x;
+ zp -= 268.295973841304927459/(x+1.0);
+ zp += 80.9030806934622512966/(x+2.0);
+ zp -= 5.00757863970517583837/(x+3.0);
+ zp += 0.0114684895434781459556/(x+4.0);
+
+ double x1 = x+4.65;
+
+ return vcl_log(zp)+(x-0.5)*vcl_log(x1)-x1;
+}
+
+const int MAX_ITS = 100;
+const double MaxRelError = 3.0e-7;
+const double vnl_very_small = 1.0e-30;
+
+//: Use series expansion of incomplete gamma function
+static double vnl_gamma_series(double a, double x)
+{
+ if (x>0)
+ {
+ double a_i=a;
+ double term_i=1.0/a;
+ double sum = term_i;
+ for (int i=1;i<=MAX_ITS;++i)
+ {
+ a_i+=1;
+ term_i *= x/a_i;
+ sum += term_i;
+ if (vcl_fabs(term_i) < vcl_fabs(sum)*MaxRelError)
+ return sum*vcl_exp(-x+a*vcl_log(x)-vnl_log_gamma(a));
+ }
+ vcl_cerr<<"vnl_gamma_series : Failed to converge in "<<MAX_ITS<<" steps\n"
+ <<"a = "<<a<<" x= "<< x <<"\nReturning best guess.\n";
+ return sum*vcl_exp(-x+a*vcl_log(x)-vnl_log_gamma(a));
+ }
+ else if (x < 0.0)
+ assert(!"vnl_gamma_series : x less than 0");
+
+ return 0.0;
+}
+
+//: Incomplete gamma using continued fraction representation
+// Use Lentz's algorithm
+// Continued fraction with terms a_i/b_i
+// a_i = i*(a-i), b_i = (x+a-2i)
+static double vnl_gamma_cont_frac(double a, double x)
+{
+ double b_i=x+1.0-a;
+ double c=1.0/vnl_very_small;
+ double d=1.0/b_i;
+ double cf=d;
+ for (int i=1;i<=MAX_ITS;i++)
+ {
+ double a_i = i*(a-i);
+ b_i += 2.0;
+ d=a_i*d+b_i;
+ if (vcl_fabs(d) < vnl_very_small) d=vnl_very_small;
+ c=b_i+a_i/c;
+ if (vcl_fabs(c) < vnl_very_small) c=vnl_very_small;
+ d=1.0/d;
+ double delta=d*c;
+ cf *= delta;
+ if (vcl_fabs(delta-1.0) < MaxRelError)
+ return vcl_exp(-x+a*vcl_log(x)-vnl_log_gamma(a))*cf;
+ }
+
+ vcl_cerr<<"vnl_gamma_cont_frac : Failed to converge in "<<MAX_ITS<<" steps\n"
+ <<"a = "<<a<<" x= "<<x<<vcl_endl;
+ return vcl_exp(-x+a*vcl_log(x)-vnl_log_gamma(a))*cf;
+}
+
+double vnl_gamma_p(double a, double x)
+{
+ if (x < 0.0 || a <= 0.0)
+ assert(!"vnl_gamma_p : Invalid arguments.");
+
+ if (x < a+1.0)
+ return vnl_gamma_series(a,x); // Use series representation
+ else
+ return 1.0 - vnl_gamma_cont_frac(a,x); // Use continued fraction representation
+}
+
+double vnl_gamma_q(double a, double x)
+{
+ if (x < 0.0 || a <= 0.0)
+ assert(!"vnl_gamma_q : Invalid arguments.");
+
+ if (x < a+1.0)
+ return 1.0-vnl_gamma_series(a,x); // Use series representation
+ else
+ return vnl_gamma_cont_frac(a,x); // Use continued fraction representation
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.h
new file mode 100644
index 0000000000000000000000000000000000000000..c80825a80b5ffdd032f9d989685eb1e524a35bf1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_gamma.h
@@ -0,0 +1,44 @@
+// This is core/vnl/vnl_gamma.h
+#ifndef vnl_gamma_h_
+#define vnl_gamma_h_
+//:
+// \file
+// \brief Complete and incomplete gamma function approximations
+// \author Tim Cootes
+
+#include <vcl_cmath.h>
+
+//: Approximate log of gamma function
+// Uses 6 parameter Lanczos approximation as described by Toth
+// (http://www.rskey.org/gamma.htm)
+// Accurate to about one part in 3e-11.
+double vnl_log_gamma(double x);
+
+//: Approximate gamma function
+// Uses 6 parameter Lanczos approximation as described by Toth
+// (http://www.rskey.org/gamma.htm)
+// Accurate to about one part in 3e-11.
+inline double vnl_gamma(double x) { return vcl_exp(vnl_log_gamma(x)); }
+
+//: Normalised Incomplete gamma function, P(a,x)
+// $P(a,x)=\frac{1}{\Gamma(a)}\int_0^x e^{-t}t^{a-1}dt$
+// Note the order of parameters - this is the normal maths order.
+// MATLAB uses gammainc(x,a), ie the other way around
+double vnl_gamma_p(double a, double x);
+
+//:Normalised Incomplete gamma function, Q(a,x)
+// $Q(a,x)=\frac{1}{\Gamma(a)}\int_x^{\infty}e^{-t}t^{a-1}dt$
+double vnl_gamma_q(double a, double x);
+
+//: P(chi<chi2)
+// Calculates the probability that a value generated
+// at random from a chi-square distribution with given
+// degrees of freedom is less than the value chi2
+// \param n_dof Number of degrees of freedom
+// \param chi2 Value of chi-squared
+inline double vnl_cum_prob_chi2(int n_dof, double chi2)
+{
+ return vnl_gamma_p( n_dof*0.5 , chi2*0.5 );
+}
+
+#endif // vnl_gamma_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e387bc027785bef342003af80f8e538fb3473c4f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.cxx
@@ -0,0 +1,286 @@
+#include "vnl_hungarian_algorithm.h"
+
+#include <vcl_vector.h>
+#include <vcl_limits.h>
+#include <vcl_algorithm.h>
+#include <vnl/vnl_matrix.h>
+#include <vcl_cassert.h>
+
+// set all the elements of v to false.
+static void clear_vector( vcl_vector<bool>& v )
+{
+ typedef vcl_vector<bool>::iterator iter;
+ iter end = v.end();
+ for ( iter i = v.begin(); i != end; ++i ) {
+ *i = false;
+ }
+}
+
+vcl_vector<unsigned> vnl_hungarian_algorithm( vnl_matrix<double> const& cost_in )
+{
+ // The Hungarian algorithm (seems to) only work for NxN cost
+ // matrices. We can solve the NxM case by padding the matrix with a
+ // constant cost.
+
+ unsigned const N = vcl_max( cost_in.rows(), cost_in.cols() );
+
+ vnl_matrix<double> cost( N, N, 0 );
+
+ // Copy in the pieces of the original matrix
+ cost.update( cost_in, 0, 0 );
+
+ // The steps of the algorithm described below are taken from
+ // http://www.public.iastate.edu/~ddoty/HungarianAlgorithm.html
+
+ // Step 0
+ // Make sure there are at least as many rows as columns
+ // [ This seems to be misleading since the algorithm presented here
+ // seems to only work for NxN matrices.]
+
+ // M(i,j) = 1 => cost(i,j) is starred
+ // M(i,j) = 2 => cost(i,j) is primed
+ vnl_matrix<int> M( N, N, 0 );
+
+ // R_cov[i] = true => row i is covered
+ // C_cov[j] = true => column j is covered
+ vcl_vector<bool> R_cov( N, false );
+ vcl_vector<bool> C_cov( N, false );
+
+ // row and col of the primed zero in step four to pass to step five.
+ unsigned Z0_r, Z0_c;
+
+ // Step 1:
+ // For each row of the matrix, find the smallest element and subtract
+ // it from every element in its row. Go to Step 2.
+ {
+ for ( unsigned i = 0; i < N; ++i ) {
+ double mn = cost(i,0);
+ for ( unsigned j = 1; j < N; ++j ) {
+ if ( mn > cost(i,j) ) mn = cost(i,j);
+ }
+ for ( unsigned j = 0; j < N; ++j ) {
+ cost(i,j) -= mn;
+ }
+ }
+
+ // and on to step 2.
+ }
+
+ // Step 2:
+ // Find a zero (Z) in the resulting matrix. If there is no starred
+ // zero in its row or column, star Z. Repeat for each element in the
+ // matrix. Go to Step 3.
+ {
+ // We'll use C_cov and R_cov to indicate if there is a starred
+ // zero in that column or row, respectively
+ for ( unsigned i = 0; i < N; ++i ) {
+ if ( ! R_cov[i] ) {
+ for ( unsigned j = 0; j < N; ++j ) {
+ if ( cost(i,j) == 0.0 && ! C_cov[j] ) {
+ M(i,j) = 1; // star it
+ R_cov[i] = true; // and update the row & col status.
+ C_cov[j] = true;
+ break; // the row is now starred. Don't look at the rest.
+ }
+ }
+ }
+ }
+ clear_vector( R_cov );
+ clear_vector( C_cov );
+
+ // and on to step 3.
+ }
+
+ // Step 3: Cover each column containing a starred zero. If K
+ // columns are covered, the starred zeros describe a complete set of
+ // unique assignments. In this case, Go to DONE, otherwise, Go to
+ // Step 4.
+ step_three:
+ {
+ unsigned count = 0;
+ for ( unsigned j = 0; j < N; ++j ) {
+ for ( unsigned i = 0; i < N; ++i ) {
+ if ( M(i,j) == 1 ) {
+ C_cov[j] = true;
+ ++count;
+ break; // to the next column
+ }
+ }
+ }
+ if ( count == N )
+ goto step_done;
+
+ // otherwise, on to step 4.
+ }
+
+ step_four:
+ // Step 4: Find a noncovered zero and prime it. If there is no
+ // starred zero in the row containing this primed zero, Go to Step
+ // 5. Otherwise, cover this row and uncover the column containing
+ // the starred zero. Continue in this manner until there are no
+ // uncovered zeros left. Save the smallest uncovered value and Go to
+ // Step 6.
+ Z0_r = -1u;
+ Z0_c = -1u;
+ // Find an uncovered zero
+ // This loop will exit with a goto step_five or step_six.
+ while ( true )
+ {
+ unsigned i, j; // row and column of the uncovered zero, if any.
+ for (i = 0 ; i < N; ++i ) {
+ if ( ! R_cov[i] ) {
+ for ( j = 0; j < N; ++j ) {
+ if ( cost(i,j) == 0.0 && ! C_cov[j] ) {
+ M(i,j) = 2; // prime it
+ goto exit_loop;
+ }
+ }
+ }
+ }
+ // We should find the smallest uncovered value, but it's more
+ // convenient to find it when we get to step six. We only need
+ // it there anyway.
+ goto step_six;
+
+ exit_loop:
+ // Check if there is a starred zero in the row.
+ bool star_in_row = false;
+ for ( unsigned j2 = 0; j2 < N; ++j2 ) {
+ if ( M(i,j2) == 1 ) {
+ star_in_row = true;
+ // cover the row, uncover the star column
+ R_cov[i] = true;
+ C_cov[j2] = false;
+ break; // out of searching for stars
+ }
+ }
+
+ // If there isn't go to step 5
+ if ( ! star_in_row ) {
+ Z0_r = i;
+ Z0_c = j;
+ break; // out of while loop and go to step 5
+ }
+ } // go back to find more uncovered zeros
+
+ // Step 5: Construct a series of alternating primed and starred
+ // zeros as follows. Let Z0 represent the uncovered primed zero
+ // found in Step 4. Let Z1 denote the starred zero in the column of
+ // Z0 (if any). Let Z2 denote the primed zero in the row of Z1
+ // (there will always be one). Continue until the series terminates
+ // at a primed zero that has no starred zero in its column. Unstar
+ // each starred zero of the series, star each primed zero of the
+ // series, erase all primes and uncover every line in the matrix.
+ // Return to Step 3.
+ {
+ unsigned i = Z0_r;
+ unsigned j = Z0_c;
+ vcl_vector<unsigned> rows, cols;
+ while ( true )
+ {
+ // This is the primed zero
+ assert( M(i,j) == 2 );
+ rows.push_back( i );
+ cols.push_back( j );
+
+ // Look for a starred zero in this column
+ for ( i = 0; i < N; ++i ) {
+ if ( M(i,j) == 1 ) break;
+ }
+
+ if ( i == N ) {
+ // we didn't find a starred zero. Stop the loop
+ break;
+ }
+
+ // This is the starred zero
+ rows.push_back( i );
+ cols.push_back( j );
+
+ // Look for the primed zero in the row of the starred zero
+ for ( j = 0; j < N; ++j ) {
+ if ( M(i,j) == 2 ) break;
+ }
+ assert( j < N ); // there should always be one
+
+ // go back to the top to mark the primed zero, and repeat.
+ }
+
+ // Series has terminated. Unstar each star and star each prime in
+ // the series.
+ for ( unsigned idx = 0; idx < rows.size(); ++idx ) {
+ unsigned i = rows[idx];
+ unsigned j = cols[idx];
+ if ( M(i,j) == 1 ) {
+ M(i,j) = 0; // unstar each starred zero
+ } else {
+ assert( M(i,j) == 2 );
+ M(i,j) = 1; // star each primed zero
+ }
+ }
+
+ // Erase all primes.
+ for ( unsigned i = 0; i < N; ++i ) {
+ for ( unsigned j = 0; j < N; ++j ) {
+ if ( M(i,j) == 2 ) M(i,j) = 0;
+ }
+ }
+
+ // Uncover everything
+ clear_vector( R_cov );
+ clear_vector( C_cov );
+
+ goto step_three;
+ }
+
+ // Step 6: Add the value found in Step 4 to every element of each
+ // covered row, and subtract it from every element of each uncovered
+ // column. Return to Step 4 without altering any stars, primes, or
+ // covered lines.
+ step_six:
+ {
+ // The value found in step 4 is the smallest uncovered value. Find it now.
+ double minval = vcl_numeric_limits<double>::infinity();
+ for ( unsigned i = 0; i < N; ++i ) {
+ if ( ! R_cov[i] ) {
+ for ( unsigned j = 0; j < N; ++j ) {
+ if ( ! C_cov[j] && cost(i,j) < minval ) {
+ minval = cost(i,j);
+ }
+ }
+ }
+ }
+
+ // Modify the matrix as instructed.
+ for ( unsigned i = 0; i < N; ++i ) {
+ for ( unsigned j = 0; j < N; ++j ) {
+ if ( R_cov[i] ) cost(i,j) += minval;
+ if ( ! C_cov[j] ) cost(i,j) -= minval;
+ }
+ }
+
+ goto step_four;
+ }
+
+ // DONE: Assignment pairs are indicated by the positions of the
+ // starred zeros in the cost matrix. If C(i,j) is a starred zero,
+ // then the element associated with row i is assigned to the element
+ // associated with column j.
+ step_done:
+ {
+ vcl_vector<unsigned> assign( cost_in.rows(), -1u );
+
+ // Find the stars and generate the resulting assignment. Only
+ // check the sub-matrix of cost that corresponds to the input cost
+ // matrix. The remaining rows and columns are unassigned.
+ for ( unsigned j = 0; j < cost_in.cols(); ++j ) {
+ for ( unsigned i = 0; i < cost_in.rows(); ++i ) {
+ if ( M(i,j) == 1 ) {
+ assign[i] = j;
+ }
+ }
+ }
+
+ return assign;
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.h
new file mode 100644
index 0000000000000000000000000000000000000000..db0fa0cd37bbe1c008675402f57026ad65ffe99d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_hungarian_algorithm.h
@@ -0,0 +1,29 @@
+#ifndef vnl_hungarian_algorithm_h_
+#define vnl_hungarian_algorithm_h_
+
+//:
+// \file
+// \author Amitha Perera
+// \date Sep 2004
+
+#include <vcl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Find the best column to row assignment given a cost matrix.
+//
+// This is an implementation of the Hungarian algorithm (also known
+// as the Munkres algorithm). It finds the minimum cost assignment of
+// the rows of the cost matrix \a cost (workers) to the columns
+// (jobs).
+//
+// \param cost An N x M cost matrix. The costs cannot be -Infinity.
+//
+// \returns A vector v of size N such that v[i] = j means that row i
+// should be assigned to column j. \code v[i] = -1u \endcode (= \code
+// unsigned(-1) \endcode ) means that row i was not assigned to any
+// column. If N \> M, then every column will be assigned to some
+// row. If N \< M then every row will be assigned to some column.
+//
+vcl_vector<unsigned> vnl_hungarian_algorithm( vnl_matrix<double> const& cost );
+
+#endif // vnl_hungarian_algorithm_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity.h
new file mode 100644
index 0000000000000000000000000000000000000000..1ce2b3abc186c1895bdee3e697aa5e32ac1a2b8d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity.h
@@ -0,0 +1,36 @@
+// This is core/vnl/vnl_identity.h
+#ifndef vnl_identity_h_
+#define vnl_identity_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_identity
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 07 Dec 98
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/1/01 Tidied documentation
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_unary_function.h>
+
+template <class T>
+class vnl_identity : public vnl_unary_function<T,T>
+{
+ public:
+ vnl_unary_function<T,T>* Copy() const {
+ vnl_identity<T>* copy = new vnl_identity<T>;
+ *copy = *this;
+ return copy;
+ }
+
+ T f(T const& x) {
+ return x;
+ }
+};
+
+#endif // vnl_identity_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity_3x3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity_3x3.h
new file mode 100644
index 0000000000000000000000000000000000000000..b7adff5ab9bdfd3defcaaa1516111a15ed258aee
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_identity_3x3.h
@@ -0,0 +1,26 @@
+// This is core/vnl/vnl_identity_3x3.h
+#ifndef vnl_identity_3x3_h_
+#define vnl_identity_3x3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_identity_3x3
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 30 Nov 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 tidied documentation
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_double_3x3.h>
+
+struct vnl_identity_3x3 : public vnl_double_3x3
+{
+ vnl_identity_3x3() { set_identity(); }
+};
+
+#endif // vnl_identity_3x3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_imag.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_imag.h
new file mode 100644
index 0000000000000000000000000000000000000000..54e7817e0a0a690cb4faeea311dca3d6ad1c4f97
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_imag.h
@@ -0,0 +1,28 @@
+// This is core/vnl/vnl_imag.h
+#ifndef vnl_imag_h_
+#define vnl_imag_h_
+//:
+// \file
+// \brief Functions to return the imaginary parts of complex arrays, vectors, matrices
+//
+// \verbatim
+// Modifications
+// Peter Vanroose - 2 July 2002 - part of vnl_complex_ops.h moved here
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Return array I of imaginary parts of complex array C.
+template <class T> void vnl_imag(vcl_complex<T> const* C, T* I, unsigned int n);
+
+//: Vector of imaginary parts of vnl_vector<vcl_complex<T> >.
+// \relates vnl_vector
+template <class T> vnl_vector<T> vnl_imag(vnl_vector<vcl_complex<T> > const& C);
+
+//: Matrix of imaginary parts of vnl_matrix<vcl_complex<T> >.
+// \relates vnl_matrix
+template <class T> vnl_matrix<T> vnl_imag(vnl_matrix<vcl_complex<T> > const& C);
+
+#endif // vnl_imag_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_1x1.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_1x1.h
new file mode 100644
index 0000000000000000000000000000000000000000..7380d8411e901f0b881d1641365ff78f9e3da347
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_1x1.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_int_1x1.h
+#ifndef vnl_int_1x1_h_
+#define vnl_int_1x1_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 1x1 matrix of int
+//
+// vnl_int_1x1 is a vnl_matrix<int> of fixed size 1x1.
+// It is merely a typedef for vnl_matrix_fixed<int,1,1>
+//
+// \author Peter Vanroose
+// \date 29 June 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<int,1,1> vnl_int_1x1;
+
+#endif // vnl_int_1x1_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2.h
new file mode 100644
index 0000000000000000000000000000000000000000..f7727d1785f9c03f237b2c2f99187623e8d1abd2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_int_2.h
+#ifndef vnl_int_2_h_
+#define vnl_int_2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class vnl_int_2
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 21 Oct 1999: vnl_vector_fixed<int,2> already instantiated
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_int_2 : a vnl_vector of 2 ints.
+vnl_T_n_impl(int,2);
+
+#endif // vnl_int_2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2x2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2x2.h
new file mode 100644
index 0000000000000000000000000000000000000000..e55413a3ec9e6ed04c349707c449e1a52bfffb76
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_2x2.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_int_2x2.h
+#ifndef vnl_int_2x2_h_
+#define vnl_int_2x2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 2x2 matrix of int
+//
+// vnl_int_2x2 is a vnl_matrix<int> of fixed size 2x2. It is
+// merely a typedef for vnl_matrix_fixed<int,2,2>
+//
+// \author Peter Vanroose
+// \date 24 Febr 2003
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix_fixed.h>
+
+typedef vnl_matrix_fixed<int,2,2> vnl_int_2x2;
+
+#endif // vnl_int_2x2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_3.h
new file mode 100644
index 0000000000000000000000000000000000000000..113249101d00f4b77cf84104de0383589c6bd3f1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_3.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_int_3.h
+#ifndef vnl_int_3_h_
+#define vnl_int_3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief alias for vnl_vector_fixed<int,3>
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 21 Oct 1999: vnl_vector_fixed<int,3> already instantiated
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_int_3 : a vnl_vector of 3 ints.
+vnl_T_n_impl(int,3);
+
+#endif // vnl_int_3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_4.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_4.h
new file mode 100644
index 0000000000000000000000000000000000000000..f6f1bb7cd1bd3cb863b3347d9097b47a680657fd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_4.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_int_4.h
+#ifndef vnl_int_4_h_
+#define vnl_int_4_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief alias for vnl_vector_fixed<int,4>
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 21 Oct 1999: vnl_vector_fixed<int,4> already instantiated
+// \endverbatim
+
+#include <vnl/vnl_T_n.h>
+
+//: class vnl_int_4 : a vnl_vector of 4 ints.
+vnl_T_n_impl(int,4);
+
+#endif // vnl_int_4_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f644a2a3c96d5468a0e736de480feec00c7c5932
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.cxx
@@ -0,0 +1,35 @@
+// This is core/vnl/vnl_int_matrix.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+//
+// vnl_int_matrix
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 27 Dec 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_int_matrix.h"
+#include <vcl_fstream.h>
+
+//: Construct from matrix of double.
+// The double-to-int conversion is simply the standard (int) cast.
+vnl_int_matrix::vnl_int_matrix(const vnl_matrix<double>& d):
+ Base(d.rows(), d.columns())
+{
+ unsigned m = d.rows();
+ unsigned n = d.columns();
+
+ for (unsigned i = 0; i < m; ++i)
+ for (unsigned j = 0; j < n; ++j)
+ (*this)(i,j) = (int)d(i,j);
+}
+
+//: Load from disk
+vnl_int_matrix::vnl_int_matrix(char const* filename)
+{
+ vcl_ifstream s(filename);
+ read_ascii(s);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..f8fd88e335f4485095e2cd99593bd010f217ce57
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_int_matrix.h
@@ -0,0 +1,37 @@
+// This is core/vnl/vnl_int_matrix.h
+#ifndef vnl_int_matrix_h_
+#define vnl_int_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Specializes vnl_matrix for integers
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 27 Dec 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Tidied documentation
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix.h>
+
+//: Specializes vnl_matrix for integers, adding a vnl_matrix<double> ctor.
+class vnl_int_matrix : public vnl_matrix<int>
+{
+ typedef vnl_matrix<int> Base;
+ public:
+
+ vnl_int_matrix() {}
+ vnl_int_matrix(char const* filename);
+ vnl_int_matrix(unsigned r, unsigned c): Base(r, c) {}
+ vnl_int_matrix(unsigned r, unsigned c, int fillvalue): Base(r, c, fillvalue) {}
+ vnl_int_matrix(const vnl_matrix<double>& d);
+ vnl_int_matrix(const vnl_matrix<int>& d):Base(d) {}
+ vnl_int_matrix& operator=(const vnl_matrix<int>& d) { return (vnl_int_matrix&)Base::operator=(d); }
+};
+
+#endif // vnl_int_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_integrant_fnct.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_integrant_fnct.h
new file mode 100644
index 0000000000000000000000000000000000000000..c1431cbd37df4e04e525aacacbd8775f44fbe343
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_integrant_fnct.h
@@ -0,0 +1,19 @@
+#ifndef VNL_INTEGRANT_FNCT_H_
+#define VNL_INTEGRANT_FNCT_H_
+//:
+// \file
+// \author Kongbin Kang
+// \date Jan 12, 2005
+// \brief the abstract class of 1D integrant function used in integral
+//
+
+class vnl_integrant_fnct
+{
+ public:
+ vnl_integrant_fnct() {}
+ virtual ~vnl_integrant_fnct() {}
+
+ virtual double f_(double /*x*/) = 0;
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_inverse.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_inverse.h
new file mode 100644
index 0000000000000000000000000000000000000000..d0c336f062e544b79243e855380bf29b2ed91a49
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_inverse.h
@@ -0,0 +1,249 @@
+// This is core/vnl/vnl_inverse.h
+#ifndef vnl_inverse_h_
+#define vnl_inverse_h_
+//:
+// \file
+// \brief Calculates inverse of a small vnl_matrix_fixed (not using svd)
+// \author Peter Vanroose
+// \date 22 October 2002
+//
+// \verbatim
+// Modifications
+// 19 April 2003 - PVr - added interface for vnl_matrix<T>
+// 19 April 2004 - PVr - made 4x4 implementation a bit more robust (but still incomplete)
+// 18 June 2004 - PVr - finally completed 4x4 implementation
+// 19 June 2004 - PVr - added vnl_inverse_transpose() methods
+// \endverbatim
+
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_det.h>
+#include <vcl_cassert.h>
+
+//: Calculates inverse of a small vnl_matrix_fixed (not using svd)
+// This allows you to write e.g.
+//
+// x = vnl_inverse(A) * b;
+//
+// Note that this function is inlined (except for the call to vnl_det()),
+// which makes it much faster than the vnl_matrix_inverse class in vnl/algo
+// since that one is using svd.
+
+template <class T>
+vnl_matrix_fixed<T,1,1> vnl_inverse(vnl_matrix_fixed<T,1,1> const& m)
+{
+ return vnl_matrix_fixed<T,1,1>(T(1)/m(0,0));
+}
+
+template <class T>
+vnl_matrix_fixed<T,2,2> vnl_inverse(vnl_matrix_fixed<T,2,2> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 2x2 matrix with zero determinant");
+ return vnl_matrix_fixed<T,2,2>();
+ }
+ det = T(1)/det;
+ T d[4];
+ d[0] = m(1,1)*det; d[1] = - m(0,1)*det;
+ d[3] = m(0,0)*det; d[2] = - m(1,0)*det;
+ return vnl_matrix_fixed<T,2,2>(d);
+}
+
+template <class T>
+vnl_matrix_fixed<T,3,3> vnl_inverse(vnl_matrix_fixed<T,3,3> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 3x3 matrix with zero determinant");
+ return vnl_matrix_fixed<T,3,3>();
+ }
+ det = T(1)/det;
+ T d[9];
+ d[0] = (m(1,1)*m(2,2)-m(1,2)*m(2,1))*det;
+ d[1] = (m(2,1)*m(0,2)-m(2,2)*m(0,1))*det;
+ d[2] = (m(0,1)*m(1,2)-m(0,2)*m(1,1))*det;
+ d[3] = (m(1,2)*m(2,0)-m(1,0)*m(2,2))*det;
+ d[4] = (m(0,0)*m(2,2)-m(0,2)*m(2,0))*det;
+ d[5] = (m(1,0)*m(0,2)-m(1,2)*m(0,0))*det;
+ d[6] = (m(1,0)*m(2,1)-m(1,1)*m(2,0))*det;
+ d[7] = (m(0,1)*m(2,0)-m(0,0)*m(2,1))*det;
+ d[8] = (m(0,0)*m(1,1)-m(0,1)*m(1,0))*det;
+ return vnl_matrix_fixed<T,3,3>(d);
+}
+
+template <class T>
+vnl_matrix_fixed<T,4,4> vnl_inverse(vnl_matrix_fixed<T,4,4> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 4x4 matrix with zero determinant");
+ return vnl_matrix_fixed<T,4,4>();
+ }
+ det = T(1)/det;
+ T d[16];
+ d[0] = m(1,1)*m(2,2)*m(3,3) - m(1,1)*m(2,3)*m(3,2) - m(2,1)*m(1,2)*m(3,3)
+ + m(2,1)*m(1,3)*m(3,2) + m(3,1)*m(1,2)*m(2,3) - m(3,1)*m(1,3)*m(2,2);
+ d[1] = -m(0,1)*m(2,2)*m(3,3) + m(0,1)*m(2,3)*m(3,2) + m(2,1)*m(0,2)*m(3,3)
+ - m(2,1)*m(0,3)*m(3,2) - m(3,1)*m(0,2)*m(2,3) + m(3,1)*m(0,3)*m(2,2);
+ d[2] = m(0,1)*m(1,2)*m(3,3) - m(0,1)*m(1,3)*m(3,2) - m(1,1)*m(0,2)*m(3,3)
+ + m(1,1)*m(0,3)*m(3,2) + m(3,1)*m(0,2)*m(1,3) - m(3,1)*m(0,3)*m(1,2);
+ d[3] = -m(0,1)*m(1,2)*m(2,3) + m(0,1)*m(1,3)*m(2,2) + m(1,1)*m(0,2)*m(2,3)
+ - m(1,1)*m(0,3)*m(2,2) - m(2,1)*m(0,2)*m(1,3) + m(2,1)*m(0,3)*m(1,2);
+ d[4] = -m(1,0)*m(2,2)*m(3,3) + m(1,0)*m(2,3)*m(3,2) + m(2,0)*m(1,2)*m(3,3)
+ - m(2,0)*m(1,3)*m(3,2) - m(3,0)*m(1,2)*m(2,3) + m(3,0)*m(1,3)*m(2,2);
+ d[5] = m(0,0)*m(2,2)*m(3,3) - m(0,0)*m(2,3)*m(3,2) - m(2,0)*m(0,2)*m(3,3)
+ + m(2,0)*m(0,3)*m(3,2) + m(3,0)*m(0,2)*m(2,3) - m(3,0)*m(0,3)*m(2,2);
+ d[6] = -m(0,0)*m(1,2)*m(3,3) + m(0,0)*m(1,3)*m(3,2) + m(1,0)*m(0,2)*m(3,3)
+ - m(1,0)*m(0,3)*m(3,2) - m(3,0)*m(0,2)*m(1,3) + m(3,0)*m(0,3)*m(1,2);
+ d[7] = m(0,0)*m(1,2)*m(2,3) - m(0,0)*m(1,3)*m(2,2) - m(1,0)*m(0,2)*m(2,3)
+ + m(1,0)*m(0,3)*m(2,2) + m(2,0)*m(0,2)*m(1,3) - m(2,0)*m(0,3)*m(1,2);
+ d[8] = m(1,0)*m(2,1)*m(3,3) - m(1,0)*m(2,3)*m(3,1) - m(2,0)*m(1,1)*m(3,3)
+ + m(2,0)*m(1,3)*m(3,1) + m(3,0)*m(1,1)*m(2,3) - m(3,0)*m(1,3)*m(2,1);
+ d[9] = -m(0,0)*m(2,1)*m(3,3) + m(0,0)*m(2,3)*m(3,1) + m(2,0)*m(0,1)*m(3,3)
+ - m(2,0)*m(0,3)*m(3,1) - m(3,0)*m(0,1)*m(2,3) + m(3,0)*m(0,3)*m(2,1);
+ d[10]= m(0,0)*m(1,1)*m(3,3) - m(0,0)*m(1,3)*m(3,1) - m(1,0)*m(0,1)*m(3,3)
+ + m(1,0)*m(0,3)*m(3,1) + m(3,0)*m(0,1)*m(1,3) - m(3,0)*m(0,3)*m(1,1);
+ d[11]= -m(0,0)*m(1,1)*m(2,3) + m(0,0)*m(1,3)*m(2,1) + m(1,0)*m(0,1)*m(2,3)
+ - m(1,0)*m(0,3)*m(2,1) - m(2,0)*m(0,1)*m(1,3) + m(2,0)*m(0,3)*m(1,1);
+ d[12]= -m(1,0)*m(2,1)*m(3,2) + m(1,0)*m(2,2)*m(3,1) + m(2,0)*m(1,1)*m(3,2)
+ - m(2,0)*m(1,2)*m(3,1) - m(3,0)*m(1,1)*m(2,2) + m(3,0)*m(1,2)*m(2,1);
+ d[13]= m(0,0)*m(2,1)*m(3,2) - m(0,0)*m(2,2)*m(3,1) - m(2,0)*m(0,1)*m(3,2)
+ + m(2,0)*m(0,2)*m(3,1) + m(3,0)*m(0,1)*m(2,2) - m(3,0)*m(0,2)*m(2,1);
+ d[14]= -m(0,0)*m(1,1)*m(3,2) + m(0,0)*m(1,2)*m(3,1) + m(1,0)*m(0,1)*m(3,2)
+ - m(1,0)*m(0,2)*m(3,1) - m(3,0)*m(0,1)*m(1,2) + m(3,0)*m(0,2)*m(1,1);
+ d[15]= m(0,0)*m(1,1)*m(2,2) - m(0,0)*m(1,2)*m(2,1) - m(1,0)*m(0,1)*m(2,2)
+ + m(1,0)*m(0,2)*m(2,1) + m(2,0)*m(0,1)*m(1,2) - m(2,0)*m(0,2)*m(1,1);
+ return vnl_matrix_fixed<T,4,4>(d)*det;
+}
+
+template <class T>
+vnl_matrix<T> vnl_inverse(vnl_matrix<T> const& m)
+{
+ assert(m.rows() == m.columns());
+ assert(m.rows() <= 4);
+ if (m.rows() == 1)
+ return vnl_matrix<T>(1,1, T(1)/m(0,0));
+ else if (m.rows() == 2)
+ return vnl_matrix<T>(vnl_inverse(vnl_matrix_fixed<T,2,2>(m)));
+ else if (m.rows() == 3)
+ return vnl_matrix<T>(vnl_inverse(vnl_matrix_fixed<T,3,3>(m)));
+ else
+ return vnl_matrix<T>(vnl_inverse(vnl_matrix_fixed<T,4,4>(m)));
+}
+
+//: Calculates transpose of the inverse of a small vnl_matrix_fixed (not using svd)
+// This allows you to write e.g.
+//
+// x = vnl_inverse_transpose(A) * b;
+//
+// Note that this function is inlined (except for the call to vnl_det()),
+// which makes it much faster than the vnl_matrix_inverse class in vnl/algo
+// since that one is using svd. This is also faster than using
+//
+// x = vnl_inverse(A).transpose() * b;
+
+template <class T>
+vnl_matrix_fixed<T,1,1> vnl_inverse_transpose(vnl_matrix_fixed<T,1,1> const& m)
+{
+ return vnl_matrix_fixed<T,1,1>(T(1)/m(0,0));
+}
+
+template <class T>
+vnl_matrix_fixed<T,2,2> vnl_inverse_transpose(vnl_matrix_fixed<T,2,2> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 2x2 matrix with zero determinant");
+ return vnl_matrix_fixed<T,2,2>();
+ }
+ det = T(1)/det;
+ T d[4];
+ d[0] = m(1,1)*det; d[2] = - m(0,1)*det;
+ d[3] = m(0,0)*det; d[1] = - m(1,0)*det;
+ return vnl_matrix_fixed<T,2,2>(d);
+}
+
+template <class T>
+vnl_matrix_fixed<T,3,3> vnl_inverse_transpose(vnl_matrix_fixed<T,3,3> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 3x3 matrix with zero determinant");
+ return vnl_matrix_fixed<T,3,3>();
+ }
+ det = T(1)/det;
+ T d[9];
+ d[0] = (m(1,1)*m(2,2)-m(1,2)*m(2,1))*det;
+ d[3] = (m(2,1)*m(0,2)-m(2,2)*m(0,1))*det;
+ d[6] = (m(0,1)*m(1,2)-m(0,2)*m(1,1))*det;
+ d[1] = (m(1,2)*m(2,0)-m(1,0)*m(2,2))*det;
+ d[4] = (m(0,0)*m(2,2)-m(0,2)*m(2,0))*det;
+ d[7] = (m(1,0)*m(0,2)-m(1,2)*m(0,0))*det;
+ d[2] = (m(1,0)*m(2,1)-m(1,1)*m(2,0))*det;
+ d[5] = (m(0,1)*m(2,0)-m(0,0)*m(2,1))*det;
+ d[8] = (m(0,0)*m(1,1)-m(0,1)*m(1,0))*det;
+ return vnl_matrix_fixed<T,3,3>(d);
+}
+
+template <class T>
+vnl_matrix_fixed<T,4,4> vnl_inverse_transpose(vnl_matrix_fixed<T,4,4> const& m)
+{
+ T det = vnl_det(m);
+ if (det==0) {
+ assert(!"Cannot invert 4x4 matrix with zero determinant");
+ return vnl_matrix_fixed<T,4,4>();
+ }
+ det = T(1)/det;
+ T d[16];
+ d[0] = m(1,1)*m(2,2)*m(3,3) - m(1,1)*m(2,3)*m(3,2) - m(2,1)*m(1,2)*m(3,3)
+ + m(2,1)*m(1,3)*m(3,2) + m(3,1)*m(1,2)*m(2,3) - m(3,1)*m(1,3)*m(2,2);
+ d[4] = -m(0,1)*m(2,2)*m(3,3) + m(0,1)*m(2,3)*m(3,2) + m(2,1)*m(0,2)*m(3,3)
+ - m(2,1)*m(0,3)*m(3,2) - m(3,1)*m(0,2)*m(2,3) + m(3,1)*m(0,3)*m(2,2);
+ d[8] = m(0,1)*m(1,2)*m(3,3) - m(0,1)*m(1,3)*m(3,2) - m(1,1)*m(0,2)*m(3,3)
+ + m(1,1)*m(0,3)*m(3,2) + m(3,1)*m(0,2)*m(1,3) - m(3,1)*m(0,3)*m(1,2);
+ d[12]= -m(0,1)*m(1,2)*m(2,3) + m(0,1)*m(1,3)*m(2,2) + m(1,1)*m(0,2)*m(2,3)
+ - m(1,1)*m(0,3)*m(2,2) - m(2,1)*m(0,2)*m(1,3) + m(2,1)*m(0,3)*m(1,2);
+ d[1] = -m(1,0)*m(2,2)*m(3,3) + m(1,0)*m(2,3)*m(3,2) + m(2,0)*m(1,2)*m(3,3)
+ - m(2,0)*m(1,3)*m(3,2) - m(3,0)*m(1,2)*m(2,3) + m(3,0)*m(1,3)*m(2,2);
+ d[5] = m(0,0)*m(2,2)*m(3,3) - m(0,0)*m(2,3)*m(3,2) - m(2,0)*m(0,2)*m(3,3)
+ + m(2,0)*m(0,3)*m(3,2) + m(3,0)*m(0,2)*m(2,3) - m(3,0)*m(0,3)*m(2,2);
+ d[9] = -m(0,0)*m(1,2)*m(3,3) + m(0,0)*m(1,3)*m(3,2) + m(1,0)*m(0,2)*m(3,3)
+ - m(1,0)*m(0,3)*m(3,2) - m(3,0)*m(0,2)*m(1,3) + m(3,0)*m(0,3)*m(1,2);
+ d[13]= m(0,0)*m(1,2)*m(2,3) - m(0,0)*m(1,3)*m(2,2) - m(1,0)*m(0,2)*m(2,3)
+ + m(1,0)*m(0,3)*m(2,2) + m(2,0)*m(0,2)*m(1,3) - m(2,0)*m(0,3)*m(1,2);
+ d[2] = m(1,0)*m(2,1)*m(3,3) - m(1,0)*m(2,3)*m(3,1) - m(2,0)*m(1,1)*m(3,3)
+ + m(2,0)*m(1,3)*m(3,1) + m(3,0)*m(1,1)*m(2,3) - m(3,0)*m(1,3)*m(2,1);
+ d[6] = -m(0,0)*m(2,1)*m(3,3) + m(0,0)*m(2,3)*m(3,1) + m(2,0)*m(0,1)*m(3,3)
+ - m(2,0)*m(0,3)*m(3,1) - m(3,0)*m(0,1)*m(2,3) + m(3,0)*m(0,3)*m(2,1);
+ d[10]= m(0,0)*m(1,1)*m(3,3) - m(0,0)*m(1,3)*m(3,1) - m(1,0)*m(0,1)*m(3,3)
+ + m(1,0)*m(0,3)*m(3,1) + m(3,0)*m(0,1)*m(1,3) - m(3,0)*m(0,3)*m(1,1);
+ d[14]= -m(0,0)*m(1,1)*m(2,3) + m(0,0)*m(1,3)*m(2,1) + m(1,0)*m(0,1)*m(2,3)
+ - m(1,0)*m(0,3)*m(2,1) - m(2,0)*m(0,1)*m(1,3) + m(2,0)*m(0,3)*m(1,1);
+ d[3] = -m(1,0)*m(2,1)*m(3,2) + m(1,0)*m(2,2)*m(3,1) + m(2,0)*m(1,1)*m(3,2)
+ - m(2,0)*m(1,2)*m(3,1) - m(3,0)*m(1,1)*m(2,2) + m(3,0)*m(1,2)*m(2,1);
+ d[7] = m(0,0)*m(2,1)*m(3,2) - m(0,0)*m(2,2)*m(3,1) - m(2,0)*m(0,1)*m(3,2)
+ + m(2,0)*m(0,2)*m(3,1) + m(3,0)*m(0,1)*m(2,2) - m(3,0)*m(0,2)*m(2,1);
+ d[11]= -m(0,0)*m(1,1)*m(3,2) + m(0,0)*m(1,2)*m(3,1) + m(1,0)*m(0,1)*m(3,2)
+ - m(1,0)*m(0,2)*m(3,1) - m(3,0)*m(0,1)*m(1,2) + m(3,0)*m(0,2)*m(1,1);
+ d[15]= m(0,0)*m(1,1)*m(2,2) - m(0,0)*m(1,2)*m(2,1) - m(1,0)*m(0,1)*m(2,2)
+ + m(1,0)*m(0,2)*m(2,1) + m(2,0)*m(0,1)*m(1,2) - m(2,0)*m(0,2)*m(1,1);
+ return vnl_matrix_fixed<T,4,4>(d)*det;
+}
+
+template <class T>
+vnl_matrix<T> vnl_inverse_transpose(vnl_matrix<T> const& m)
+{
+ assert(m.rows() == m.columns());
+ assert(m.rows() <= 4);
+ if (m.rows() == 1)
+ return vnl_matrix<T>(1,1, T(1)/m(0,0));
+ else if (m.rows() == 2)
+ return vnl_matrix<T>(vnl_inverse_transpose(vnl_matrix_fixed<T,2,2>(m)));
+ else if (m.rows() == 3)
+ return vnl_matrix<T>(vnl_inverse_transpose(vnl_matrix_fixed<T,3,3>(m)));
+ else
+ return vnl_matrix<T>(vnl_inverse_transpose(vnl_matrix_fixed<T,4,4>(m)));
+}
+
+#endif // vnl_inverse_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..73c35da4ff1c7e88834b6aa0abc69885244355c1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.cxx
@@ -0,0 +1,45 @@
+// This is core/vnl/vnl_least_squares_cost_function.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//
+// vnl_least_squares_cost_function
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 20 Aug 99
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_least_squares_cost_function.h"
+
+vnl_least_squares_cost_function::vnl_least_squares_cost_function(vnl_least_squares_function* f):
+ vnl_cost_function(f->get_number_of_unknowns()),
+ storage_(f->get_number_of_residuals()),
+ jacobian_(f->get_number_of_residuals(), f->get_number_of_unknowns()),
+ f_(f)
+{
+}
+
+double vnl_least_squares_cost_function::f(const vnl_vector<double>& x)
+{
+ f_->f(x, storage_);
+ return storage_.squared_magnitude();
+}
+
+void vnl_least_squares_cost_function::gradf(const vnl_vector<double>& x, vnl_vector<double>& gradient)
+{
+ // residuals = a, b, c, ...
+ // params = x, y, z, ...
+ // f = a^2 + b^2 + c^2 + ...
+ // df/dx = 2a*da/dx + 2b*db/dx + ...
+
+ if (f_->has_gradient()) {
+ f_->f(x,storage_);
+ f_->gradf(x, jacobian_);
+ for (unsigned int c=0; c<jacobian_.columns(); ++c) {
+ gradient[c] = 0.0;
+ for (unsigned int r=0; r<jacobian_.rows(); ++r)
+ gradient[c] += storage_[r] * jacobian_(r,c);
+ gradient[c] *= 2;
+ }
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.h
new file mode 100644
index 0000000000000000000000000000000000000000..3e94db65c3303d768b53db284772a49e789b973b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_cost_function.h
@@ -0,0 +1,40 @@
+// This is core/vnl/vnl_least_squares_cost_function.h
+#ifndef vnl_least_squares_cost_function_h_
+#define vnl_least_squares_cost_function_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief vnl_least_squares_function -> vnl_cost_function adaptor
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 20 Aug 99
+//
+// \verbatim
+// Modifications
+// 990820 AWF Initial version.
+// LSB (Manchester) 23/3/01 Tidied documentation
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_cost_function.h>
+#include <vnl/vnl_least_squares_function.h>
+
+//: An adaptor that converts a vnl_least_squares_function to a vnl_cost_function
+class vnl_least_squares_cost_function : public vnl_cost_function
+{
+ public:
+ vnl_least_squares_cost_function(vnl_least_squares_function* f);
+
+ double f(const vnl_vector<double>& x);
+
+ virtual void gradf(const vnl_vector<double>& x, vnl_vector<double>& gradient);
+
+ protected:
+ vnl_vector<double> storage_;
+ vnl_matrix<double> jacobian_;
+ vnl_least_squares_function* f_;
+};
+
+#endif // vnl_least_squares_cost_function_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..334bdfaafff86e94d61333035a39c0262c03d151
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.cxx
@@ -0,0 +1,74 @@
+// This is core/vnl/vnl_least_squares_function.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+
+#include "vnl_least_squares_function.h"
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+
+void vnl_least_squares_function::dim_warning(unsigned int number_of_unknowns,
+ unsigned int number_of_residuals)
+{
+ if (number_of_unknowns > number_of_residuals)
+ vcl_cerr << "vnl_least_squares_function: WARNING: "
+ << "unknowns(" << number_of_unknowns << ") > "
+ << "residuals("<< number_of_residuals << ")\n";
+}
+
+void vnl_least_squares_function::gradf(vnl_vector<double> const& /*x*/,
+ vnl_matrix<double>& /*jacobian*/)
+{
+ vcl_cerr << "Warning: gradf() called but not implemented in derived class\n";
+}
+
+//: Compute fd gradient
+void vnl_least_squares_function::fdgradf(vnl_vector<double> const& x,
+ vnl_matrix<double>& jacobian,
+ double stepsize)
+{
+ unsigned int dim = x.size();
+ unsigned int n = jacobian.rows();
+ assert(dim == get_number_of_unknowns());
+ assert(n == get_number_of_residuals());
+ assert(dim == jacobian.columns());
+
+ vnl_vector<double> tx = x;
+ vnl_vector<double> fplus(n);
+ vnl_vector<double> fminus(n);
+ for (unsigned int i = 0; i < dim; ++i)
+ {
+ // calculate f just to the right of x[i]
+ double tplus = tx[i] = x[i] + stepsize;
+ this->f(tx, fplus);
+
+ // calculate f just to the left of x[i]
+ double tminus = tx[i] = x[i] - stepsize;
+ this->f(tx, fminus);
+
+ double h = 1.0 / (tplus - tminus);
+ for (unsigned int j = 0; j < n; ++j)
+ jacobian(j,i) = (fplus[j] - fminus[j]) * h;
+
+ // restore tx
+ tx[i] = x[i];
+ }
+}
+
+void vnl_least_squares_function::trace(int /* iteration */,
+ vnl_vector<double> const& /*x*/,
+ vnl_vector<double> const& /*fx*/)
+{
+ // This default implementation is empty; overloaded in derived class.
+}
+
+double vnl_least_squares_function::rms(vnl_vector<double> const& x)
+{
+ vnl_vector<double> fx(n_);
+ f(x, fx);
+ return fx.rms();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.h
new file mode 100644
index 0000000000000000000000000000000000000000..c97ce10b95969fb59c1069617d853787468fa0f1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_least_squares_function.h
@@ -0,0 +1,103 @@
+// This is core/vnl/vnl_least_squares_function.h
+#ifndef vnl_least_squares_function_h_
+#define vnl_least_squares_function_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Abstract base for minimising functions
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 31 Aug 96
+//
+// \verbatim
+// Modifications
+// 280697 AWF Changed return type of f from double to void, as it wasn't used, and
+// people were going to extra trouble to compute it.
+// 20 Apr 1999 FSM Added failure flag so that f() and grad() may signal failure to the caller.
+// 23/3/01 LSB (Manchester) Tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+#include <vcl_string.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Abstract base for minimising functions.
+// vnl_least_squares_function is an abstract base for functions to be minimized
+// by an optimizer. To define your own function to be minimized, subclass
+// from vnl_least_squares_function, and implement the pure virtual f (and
+// optionally grad_f).
+//
+// Whether or not f ought to be const is a problem. Clients might well
+// want to cache some information during the call, and if they're compute
+// objects, will almost certainly be writing to members during the
+// computation. For the moment it's non-const, but we'll see...
+class vnl_least_squares_function
+{
+ public:
+ enum UseGradient {
+ no_gradient,
+ use_gradient
+ };
+ bool failure;
+
+ //: Construct vnl_least_squares_function.
+ // Passing number of parameters (unknowns, domain dimension) and number of
+ // residuals (range dimension).
+ // The optional argument should be no_gradient if the gradf function has not
+ // been implemented. Default is use_gradient.
+ vnl_least_squares_function(unsigned int number_of_unknowns,
+ unsigned int number_of_residuals,
+ UseGradient g = use_gradient)
+ : failure(false), p_(number_of_unknowns), n_(number_of_residuals),
+ use_gradient_(g == use_gradient)
+ { dim_warning(p_,n_); }
+
+ virtual ~vnl_least_squares_function() {}
+
+ // the virtuals may call this to signal a failure.
+ void throw_failure() { failure = true; }
+ void clear_failure() { failure = false; }
+
+ //: The main function.
+ // Given the parameter vector x, compute the vector of residuals fx.
+ // Fx has been sized appropriately before the call.
+ virtual void f(vnl_vector<double> const& x, vnl_vector<double>& fx) = 0;
+
+ //: Calculate the Jacobian, given the parameter vector x.
+ virtual void gradf(vnl_vector<double> const& x, vnl_matrix<double>& jacobian);
+
+ //: Use this to compute a finite-difference gradient other than lmdif
+ void fdgradf(vnl_vector<double> const& x, vnl_matrix<double>& jacobian,
+ double stepsize);
+
+ //: Called after each LM iteration to print debugging etc.
+ virtual void trace(int iteration,
+ vnl_vector<double> const& x,
+ vnl_vector<double> const& fx);
+
+ //: Compute the rms error at x by calling f and returning the norm of the residual vector.
+ double rms(vnl_vector<double> const& x);
+
+ //: Return the number of unknowns
+ unsigned int get_number_of_unknowns() const { return p_; }
+
+ //: Return the number of residuals.
+ unsigned int get_number_of_residuals() const { return n_; }
+
+ //: Return true if the derived class has indicated that gradf has been implemented
+ bool has_gradient() const { return use_gradient_; }
+
+ protected:
+ unsigned int p_;
+ unsigned int n_;
+ bool use_gradient_;
+
+ void init(unsigned int number_of_unknowns, unsigned int number_of_residuals)
+ { p_ = number_of_unknowns; n_ = number_of_residuals; dim_warning(p_,n_); }
+ private:
+ void dim_warning(unsigned int n_unknowns, unsigned int n_residuals);
+};
+
+#endif // vnl_least_squares_function_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_operators_3.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_operators_3.h
new file mode 100644
index 0000000000000000000000000000000000000000..4bfe73e7ab5eea028d81a7720bc683bd63b66b72
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_operators_3.h
@@ -0,0 +1,49 @@
+// This is core/vnl/vnl_linear_operators_3.h
+#ifndef vnl_linear_operators_3_h_
+#define vnl_linear_operators_3_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief 3D linear algebra operations
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// Specialized linear operators for 3D vectors and matrices.
+// Include this file if you're inlining or compiling linear algebra
+// code for speed.
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Tidied documentation
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_double_3.h>
+#include <vnl/vnl_double_3x3.h>
+
+//: The binary multiplication operator
+// \relates vnl_matrix_fixed
+inline
+vnl_double_3 operator* (const vnl_double_3x3& A, const vnl_double_3& x)
+{
+ const double* a = A.data_block();
+ double r0 = a[0] * x[0] + a[1] * x[1] + a[2] * x[2];
+ double r1 = a[3] * x[0] + a[4] * x[1] + a[5] * x[2];
+ double r2 = a[6] * x[0] + a[7] * x[1] + a[8] * x[2];
+ return vnl_double_3(r0, r1, r2);
+}
+
+//: The binary addition operator
+// \relates vnl_vector_fixed
+inline
+vnl_double_3 operator+ (const vnl_double_3& a, const vnl_double_3& b)
+{
+ double r0 = a[0] + b[0];
+ double r1 = a[1] + b[1];
+ double r2 = a[2] + b[2];
+ return vnl_double_3(r0, r1, r2);
+}
+
+#endif // vnl_linear_operators_3_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..994f59311a6c5f50559308b41d5f5aceec9b1d16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.cxx
@@ -0,0 +1,48 @@
+// This is core/vnl/vnl_linear_system.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author David Capel, capes@robots
+// \date July 2000
+
+#include "vnl_linear_system.h"
+#include <vcl_cassert.h>
+
+vnl_linear_system::~vnl_linear_system()
+{
+}
+
+void vnl_linear_system::apply_preconditioner(vnl_vector<double> const& x, vnl_vector<double> & px) const
+{
+ assert(px.size() == x.size());
+
+ px = x;
+}
+
+double vnl_linear_system::get_rms_error(vnl_vector<double> const& x) const
+{
+ vnl_vector<double> resid(n_);
+ vnl_vector<double> b(n_);
+
+ multiply(x, resid);
+ get_rhs(b);
+
+ resid -= b;
+
+ return resid.rms();
+}
+
+double vnl_linear_system::get_relative_residual(vnl_vector<double> const& x) const
+{
+ vnl_vector<double> resid(n_);
+ vnl_vector<double> b(n_);
+
+ multiply(x, resid);
+ get_rhs(b);
+
+ resid -= b;
+
+ return resid.rms() / b.rms();
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.h
new file mode 100644
index 0000000000000000000000000000000000000000..4fb5e8991152392ef49d08b64d51b21b09b3c5b2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_linear_system.h
@@ -0,0 +1,71 @@
+// This is core/vnl/vnl_linear_system.h
+#ifndef vnl_linear_system_h_
+#define vnl_linear_system_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Abstraction for a linear system of equations.
+// \author David Capel, capes@robots
+// \date July 2000
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/1/01 Documentation tidied
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+
+//: Abstraction for a linear system of equations.
+// vnl_linear_system provides an abstraction for a linear system
+// of equations, Ax = b, to be solved by one of the iterative linear
+// solvers. Access to the systems is via the pure virtual methods
+// multiply() and transpose_multiply(). This procedural access scheme
+// makes it possible to solve very large, sparse systems which it would
+// be inefficient to store in matrix form.
+//
+// To solve the system, use an algorithm like vnl_lsqr.
+class vnl_linear_system
+{
+ public:
+
+ vnl_linear_system(unsigned int number_of_unknowns, unsigned int number_of_residuals) :
+ p_(number_of_unknowns), n_(number_of_residuals) {}
+
+ virtual ~vnl_linear_system();
+
+ //: Compute A*x, putting result in y
+ virtual void multiply(vnl_vector<double> const& x, vnl_vector<double>& y) const = 0;
+
+ //: Compute A_transpose * y, putting result in x
+ virtual void transpose_multiply(vnl_vector<double> const& y, vnl_vector<double>& x) const = 0;
+
+ //; Put the right-hand side of the system Ax = b into b
+ virtual void get_rhs(vnl_vector<double>& b) const = 0;
+
+ //; (Optional) Apply a suitable preconditioner to x.
+ // A preconditioner is an approximation of the inverse of A.
+ // Common choices are Jacobi (1/diag(A'A)), Gauss-Seidel,
+ // and incomplete LU or Cholesky decompositions.
+ // The default implementation applies the identity.
+ virtual void apply_preconditioner(vnl_vector<double> const& x, vnl_vector<double>& px) const;
+
+ //: Return the number of unknowns
+ unsigned int get_number_of_unknowns() const { return p_; }
+
+ //: Return the number of residuals.
+ unsigned int get_number_of_residuals() const { return n_; }
+
+ //: Compute rms error for parameter vector x
+ double get_rms_error(vnl_vector<double> const& x) const;
+
+ //: Compute relative residual (|Ax - b| / |b| )for parameter vector x
+ double get_relative_residual(vnl_vector<double> const& x) const;
+
+ protected:
+ unsigned int p_;
+ unsigned int n_;
+};
+
+#endif // vnl_linear_system_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..a44d23cf14643360d9cf9be3bab13298c413abb8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.cxx
@@ -0,0 +1,253 @@
+// This is core/vnl/vnl_math.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_math.h"
+#include <vxl_config.h>
+
+#if defined(VCL_VC) || defined(__MINGW32__)
+// I don't think we need this, because <ieeefp.h> is available -- fsm
+# include <Float.h> // for 'isnan' and 'finite'
+// # define isnan _isnan
+# define finite _finite
+# define finitef _finite
+#ifndef finitel
+# define finitel _finite
+#endif
+# define isnan _isnan
+#elif VXL_IEEEFP_HAS_FINITE
+# include <ieeefp.h>
+# ifndef finitef
+# define finitef finite
+# endif
+# ifndef finitel
+# define finitel finite
+# endif
+
+#elif VXL_C_MATH_HAS_FINITE
+# include <math.h> // dont_vxl_filter: this is *not* supposed to be <cmath>
+# if !VXL_C_MATH_HAS_FINITEF
+# define finitef finite
+# endif
+# if !VXL_C_MATH_HAS_FINITEL
+# define finitel finite
+# endif
+
+#elif defined(__hpux)
+# include <math.h> // dont_vxl_filter: this is *not* supposed to be <cmath>
+# define finite _Isfinite
+# define finitef _Isfinitef
+# define finitel _Isfinite
+
+#elif defined(SYSV)
+// needed on platforms with finite() declared in strange places
+extern "C" int finite(double);
+# define finitef finite
+# define finitel finite
+
+#elif defined(VCL_BORLAND)
+# include <math.h> // dont_vxl_filter: this is *not* supposed to be <cmath>
+# include <float.h>
+
+#else
+# warning finite() is not declared on this platform
+# define VNL_HAS_NO_FINITE
+#endif
+
+#ifdef VCL_SUNPRO_CC_5
+# include <math.h> // dont_vxl_filter: no HUGE_VAL or isnan() in <cmath>
+#endif
+
+#if defined(__APPLE__)
+# include <math.h> // dont_vxl_filter: this is *not* supposed to be <cmath>
+# define isnan(x) __isnand((double)x)
+#endif
+
+//--------------------------------------------------------------------------------
+
+#if !VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN
+
+// constants
+const double vnl_math::e VCL_STATIC_CONST_INIT_FLOAT_DEFN( 2.7182818284590452354 );
+const double vnl_math::log2e VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.4426950408889634074 );
+const double vnl_math::log10e VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.43429448190325182765 );
+const double vnl_math::ln2 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.69314718055994530942 );
+const double vnl_math::ln10 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 2.30258509299404568402 );
+const double vnl_math::pi VCL_STATIC_CONST_INIT_FLOAT_DEFN( 3.14159265358979323846 );
+const double vnl_math::pi_over_2 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.57079632679489661923 );
+const double vnl_math::pi_over_4 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.78539816339744830962 );
+const double vnl_math::one_over_pi VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.31830988618379067154 );
+const double vnl_math::two_over_pi VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.63661977236758134308 );
+const double vnl_math::two_over_sqrtpi VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.12837916709551257390 );
+const double vnl_math::sqrt2 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.41421356237309504880 );
+const double vnl_math::sqrt1_2 VCL_STATIC_CONST_INIT_FLOAT_DEFN( 0.70710678118654752440 );
+
+// IEEE double machine precision
+const double vnl_math::eps VCL_STATIC_CONST_INIT_FLOAT_DEFN( 2.2204460492503131e-16 );
+const double vnl_math::sqrteps VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.490116119384766e-08 );
+
+ //: IEEE single machine precision
+const float vnl_math::float_eps VCL_STATIC_CONST_INIT_FLOAT_DEFN( 1.192092896e-07f );
+const float vnl_math::float_sqrteps VCL_STATIC_CONST_INIT_FLOAT_DEFN( 3.4526698307e-4f );
+
+#endif
+
+//--------------------------------------------------------------------------------
+#if defined(VCL_ICC)
+#include <mathimf.h> // defines isnanf, isnan, and isnanl
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(float x) { return isnanf(x); }
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(double x) { return isnan(x); }
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(long double x) { return isnanl(x); }
+#elif defined(VCL_BORLAND)
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(float x) { return _isnan(x); }
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(double x) { return _isnan(x); }
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(long double x) { return _isnanl(x); }
+#elif !defined(VNL_HAS_NO_FINITE) && !defined(VCL_SGI_CC_7) && !defined(__alpha__) && !defined(VCL_WIN32)
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(float x) { return x != x; } // causes "floating exception" on alpha & sgi
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(double x) { return x != x; }
+//: Return true iff x is "Not a Number"
+bool vnl_math_isnan(long double x) { return x != x; }
+#else
+// Auxiliary function to simplify notation
+# ifndef DEBUG
+static inline unsigned int bMp(void*x,unsigned int y,int p=0){return ((((unsigned int*)x)[p])&y);}
+static inline bool bMe(void*x,unsigned int y,int p=0){return ((((unsigned int*)x)[p])&y)==y;}
+# else
+# include <vcl_iostream.h>
+static inline unsigned int bMp(void* x, unsigned int y, int p=0)
+{
+ unsigned char* v=(unsigned char*)x;
+ vcl_cout<<int(v[4*p])<<' '<<int(v[4*p+1])<<' '<<int(v[4*p+2])<<' '<<int(v[4*p+3])<<" & ";
+ v=(unsigned char*)(&y);
+ vcl_cout<<int(v[0])<<' '<<int(v[1])<<' '<<int(v[2])<<' '<<int(v[3])<<" = ";
+ unsigned int z = ((((unsigned int*)x)[p]) & y);
+ v=(unsigned char*)(&z);
+ vcl_cout<<int(v[0])<<' '<<int(v[1])<<' '<<int(v[2])<<' '<<int(v[3]);
+ if (z == y) vcl_cout<<" ==";
+ vcl_cout << '\n';
+ return z;
+}
+
+static inline bool bMe(void* x, unsigned int y, int p=0) { return bMp(x,y,p) == y; }
+# endif
+# if VXL_BIG_ENDIAN
+static const int sz_f = 0;
+static const int sz_d = 0;
+static const int sz_l = 0;
+# else
+static const int sz_f = sizeof(float)/sizeof(int) -1;
+static const int sz_d = sizeof(double)/sizeof(int) -1;
+static const int sz_l = sizeof(long double)/sizeof(int) -1;
+# endif
+// Assume IEEE floating point number representation
+bool vnl_math_isnan( float x){return bMe(&x,0x7f800000L,sz_f)&&bMp(&x,0x007fffffL,sz_f);}
+bool vnl_math_isnan(double x){return bMe(&x,0x7ff00000L,sz_d)&&bMp(&x,0x000fffffL,sz_d);}
+bool vnl_math_isnan(long double x)
+{
+ if (sizeof(long double) == 8) return bMe(&x,0x7ff00000L,sz_l) && bMp(&x,0x000fffffL,sz_l);
+ else if (sizeof(long double) <= 12)
+# if defined LDBL_MANT_DIG && LDBL_MANT_DIG<=53
+ return bMe(&x,0x4001ffffL,sz_l) && bMp(&x,0x40000000,sz_l-4);
+# else
+ return bMe(&x,0x7ff00000L,sz_l) && bMp(&x,0x000fffffL,sz_l-4);
+# endif
+ else return bMe(&x,0x7ff00000L,sz_l) && bMp(&x,0x0000ffffL,sz_l);
+}
+#endif
+
+// fsm
+// On linux noshared builds, with optimisation on, calling 'finite' within the
+// scope of vnl_math causes vnl_math_isinf to be called. This blows the stack.
+// Plausible theory : 'finite' is a preprocessor macro, defined in terms of a
+// macro called 'isinf'.
+#if defined(isinf)
+# if defined(__GNUC__) || defined(VCL_METRO_WERKS) || defined(__INTEL_COMPILER)
+// I do not know if MW accepts #warning. Comment out the #undef if not.
+# warning macro isinf is defined
+# undef isinf
+# else
+// do not fail silently
+# error macro isinf is defined
+# endif
+#endif
+
+#if defined(VCL_BORLAND)
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(float x) { return _finite(x) != 0; }
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(double x) { return _finite(x) != 0; }
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(long double x) { return _finitel(x) != 0 && !_isnanl(x); }
+#elif !defined(VNL_HAS_NO_FINITE)
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(float x) { return finitef(x) != 0; }
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(double x) { return finite(x) != 0; }
+//: Return true if x is neither NaN nor Inf.
+bool vnl_math_isfinite(long double x) { return finitel(x) != 0; }
+#else
+// Assume IEEE floating point number representation
+bool vnl_math_isfinite(float x) { return !bMe(&x,0x7f800000L,sz_f) && bMp(&x,0x7fffffffL,sz_f) != 0x7f7fffffL; }
+bool vnl_math_isfinite(double x) { return !bMe(&x,0x7ff00000L,sz_d); }
+bool vnl_math_isfinite(long double x)
+{
+ if (sizeof(long double) == 8) return !bMe(&x,0x7ff00000L,sz_l);
+ else if (sizeof(long double) <= 12) return !bMe(&x,0xbfff7fffL,sz_l) && !bMe(&x,0x4001ffffL,sz_l);
+ else return !bMe(&x,0x7ff70000L,sz_l);
+}
+#endif
+
+
+#if defined(VCL_BORLAND)
+//: Return true if x is inf
+bool vnl_math_isinf(float x) { return !_finite(x) && !_isnan(x); }
+//: Return true if x is inf
+bool vnl_math_isinf(double x) { return !_finite(x) && !_isnan(x); }
+//: Return true if x is inf
+bool vnl_math_isinf(long double x) { return !_finitel(x) && !_isnanl(x); }
+#elif !defined(VNL_HAS_NO_FINITE)
+//: Return true if x is inf
+bool vnl_math_isinf(float x) { return !finitef(x) && !isnan(x); }
+//: Return true if x is inf
+bool vnl_math_isinf(double x) { return !finite(x) && !isnan(x); }
+//: Return true if x is inf
+bool vnl_math_isinf(long double x) { return !finitel(x) && !isnan(x); }
+#else
+// Assume IEEE floating point number representation
+bool vnl_math_isinf(float x) {return(bMe(&x,0x7f800000L,sz_f)&&!bMp(&x,0x007fffffL,sz_f))||bMp(&x,0x7fffffffL,sz_f)==0x7f7fffffL;}
+bool vnl_math_isinf(double x) { return bMe(&x,0x7ff00000L,sz_d) && !bMp(&x,0x000fffffL,sz_d); }
+bool vnl_math_isinf(long double x)
+{
+ if (sizeof(long double) == 8) return bMe(&x,0x7ff00000L,sz_l) && !bMp(&x,0x000fffffL,sz_l);
+ else if (sizeof(long double) <= 12) return (bMe(&x,0xbfff7fffL,sz_l)||bMe(&x,0x4001ffffL,sz_l))&&!bMp(&x,0x40000000,sz_l-4);
+ else return bMe(&x,0x7ff70000L,sz_l) && !bMp(&x,0x0008ffffL,sz_l);
+}
+#endif
+
+//----------------------------------------------------------------------
+
+//: Type-accessible infinities for use in templates.
+template <class T> T vnl_huge_val(T);
+double vnl_huge_val(double) { return HUGE_VAL; }
+float vnl_huge_val(float) { return (float)HUGE_VAL; }
+#ifdef _INT_64BIT_
+long int vnl_huge_val(long int) { return 0x7fffffffffffffffL; }
+int vnl_huge_val(int) { return 0x7fffffffffffffffL; }
+#else
+int vnl_huge_val(int) { return 0x7fffffff; }
+#endif
+short vnl_huge_val(short) { return 0x7fff; }
+char vnl_huge_val(char) { return 0x7f; }
+
+//----------------------------------------------------------------------
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.h
new file mode 100644
index 0000000000000000000000000000000000000000..e9a0c99035b7e1b6ea532147215589378ebb33be
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_math.h
@@ -0,0 +1,226 @@
+// This is core/vnl/vnl_math.h
+#ifndef vnl_math_h_
+#define vnl_math_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Namespace with standard math functions
+//
+// The vnl_math namespace provides a standard set of the simple mathematical
+// functions (min, max, sqr, sgn, rnd, abs), and some predefined constants
+// such as pi and e, which are not defined by the ANSI C++ standard.
+//
+// There are complex versions defined in vnl_complex.h
+//
+// That's right, M_PI is nonstandard!
+//
+// Aside from e, pi and their associates the class also defines eps,
+// the IEEE double machine precision. This is the smallest number
+// eps such that 1+eps != 1.
+//
+// The operations are overloaded for int, float and double arguments,
+// which in combination with inlining can make them more efficient than
+// their counterparts in the standard C library.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date July 13, 1996
+//
+// \verbatim
+// Modifications
+// 210598 AWF Removed conditional VCL_IMPLEMENT_STATIC_CONSTS, sometimes gcc needs them.
+// LSB (Modifications) 23/1/01 Documentation tidied
+// Peter Vanroose - 7 Sept. 2002 - maxdouble etc. replaced by vnl_numeric_traits<T>::maxval
+// Amitha Perera - 13 Sep 2002 - make constant initialization standards compliant.
+// \endverbatim
+
+#include <vcl_cmath.h>
+#include "dll.h"
+
+//: Type-accessible infinities for use in templates.
+template <class T> T vnl_huge_val(T);
+double vnl_huge_val(double);
+float vnl_huge_val(float);
+long int vnl_huge_val(long int);
+int vnl_huge_val(int);
+short vnl_huge_val(short);
+char vnl_huge_val(char);
+
+//: real numerical constants
+class vnl_math
+{
+ public:
+ //: pi, e and all that
+ static VNL_DLL_DATA const double e VCL_STATIC_CONST_INIT_FLOAT_DECL(2.7182818284590452354);
+ static VNL_DLL_DATA const double log2e VCL_STATIC_CONST_INIT_FLOAT_DECL(1.4426950408889634074);
+ static VNL_DLL_DATA const double log10e VCL_STATIC_CONST_INIT_FLOAT_DECL(0.43429448190325182765);
+ static VNL_DLL_DATA const double ln2 VCL_STATIC_CONST_INIT_FLOAT_DECL(0.69314718055994530942);
+ static VNL_DLL_DATA const double ln10 VCL_STATIC_CONST_INIT_FLOAT_DECL(2.30258509299404568402);
+ static VNL_DLL_DATA const double pi VCL_STATIC_CONST_INIT_FLOAT_DECL(3.14159265358979323846);
+ static VNL_DLL_DATA const double pi_over_2 VCL_STATIC_CONST_INIT_FLOAT_DECL(1.57079632679489661923);
+ static VNL_DLL_DATA const double pi_over_4 VCL_STATIC_CONST_INIT_FLOAT_DECL(0.78539816339744830962);
+ static VNL_DLL_DATA const double one_over_pi VCL_STATIC_CONST_INIT_FLOAT_DECL(0.31830988618379067154);
+ static VNL_DLL_DATA const double two_over_pi VCL_STATIC_CONST_INIT_FLOAT_DECL(0.63661977236758134308);
+ static VNL_DLL_DATA const double two_over_sqrtpi VCL_STATIC_CONST_INIT_FLOAT_DECL(1.12837916709551257390);
+ static VNL_DLL_DATA const double sqrt2 VCL_STATIC_CONST_INIT_FLOAT_DECL(1.41421356237309504880);
+ static VNL_DLL_DATA const double sqrt1_2 VCL_STATIC_CONST_INIT_FLOAT_DECL(0.70710678118654752440);
+
+ //: IEEE double machine precision
+ static VNL_DLL_DATA const double eps VCL_STATIC_CONST_INIT_FLOAT_DECL(2.2204460492503131e-16);
+ static VNL_DLL_DATA const double sqrteps VCL_STATIC_CONST_INIT_FLOAT_DECL(1.490116119384766e-08);
+ //: IEEE single machine precision
+ static VNL_DLL_DATA const float float_eps VCL_STATIC_CONST_INIT_FLOAT_DECL(1.192092896e-07f);
+ static VNL_DLL_DATA const float float_sqrteps VCL_STATIC_CONST_INIT_FLOAT_DECL(3.4526698307e-4f);
+};
+
+// We do not want to make assumptions about unknown types that happen
+// to have conversions to one of the fundamental types. The templated
+// versions of isnan, isinf, and isfinite below serve as catch-alls to
+// cause linker errors if these functions are invoked with an unknown
+// type. However, due to compiler bugs, the templates sometimes match
+// too often (see documentation of VCL_TEMPLATE_MATCHES_TOO_OFTEN) and
+// are selected over reference-binding overloads like those in
+// vnl_rational.h. We add the catch-all templates only if the
+// compiler does not have this bug. -- Brad King
+
+// Note that the three template functions below should not be declared "inline"
+// since that would override the non-inline specialisations. - PVr.
+//
+
+// isnan
+inline bool vnl_math_isnan(char) { return false; }
+inline bool vnl_math_isnan(short) { return false; }
+inline bool vnl_math_isnan(int) { return false; }
+inline bool vnl_math_isnan(long) { return false; }
+inline bool vnl_math_isnan(signed char) { return false; }
+inline bool vnl_math_isnan(unsigned char) { return false; }
+inline bool vnl_math_isnan(unsigned short) { return false; }
+inline bool vnl_math_isnan(unsigned int) { return false; }
+inline bool vnl_math_isnan(unsigned long) { return false; }
+bool vnl_math_isnan(float);
+bool vnl_math_isnan(double);
+bool vnl_math_isnan(long double);
+#if !VCL_TEMPLATE_MATCHES_TOO_OFTEN
+template <class T> bool vnl_math_isnan(T);
+#endif
+
+// isinf
+inline bool vnl_math_isinf(char) { return false; }
+inline bool vnl_math_isinf(short) { return false; }
+inline bool vnl_math_isinf(int) { return false; }
+inline bool vnl_math_isinf(long) { return false; }
+inline bool vnl_math_isinf(signed char) { return false; }
+inline bool vnl_math_isinf(unsigned char) { return false; }
+inline bool vnl_math_isinf(unsigned short) { return false; }
+inline bool vnl_math_isinf(unsigned int) { return false; }
+inline bool vnl_math_isinf(unsigned long) { return false; }
+bool vnl_math_isinf(float);
+bool vnl_math_isinf(double);
+bool vnl_math_isinf(long double);
+#if !VCL_TEMPLATE_MATCHES_TOO_OFTEN
+template <class T> bool vnl_math_isinf(T);
+#endif
+
+// isfinite
+inline bool vnl_math_isfinite(char) { return true; }
+inline bool vnl_math_isfinite(short) { return true; }
+inline bool vnl_math_isfinite(int) { return true; }
+inline bool vnl_math_isfinite(long) { return true; }
+inline bool vnl_math_isfinite(signed char) { return true; }
+inline bool vnl_math_isfinite(unsigned char) { return true; }
+inline bool vnl_math_isfinite(unsigned short) { return true; }
+inline bool vnl_math_isfinite(unsigned int) { return true; }
+inline bool vnl_math_isfinite(unsigned long) { return true; }
+bool vnl_math_isfinite(float);
+bool vnl_math_isfinite(double);
+bool vnl_math_isfinite(long double);
+#if !VCL_TEMPLATE_MATCHES_TOO_OFTEN
+template <class T> bool vnl_math_isfinite(T);
+#endif
+
+// rnd (rounding; 0.5 rounds up)
+inline int vnl_math_rnd(float x) { return (x>=0.0)?(int)(x + 0.5):(int)(x - 0.5); }
+inline int vnl_math_rnd(double x) { return (x>=0.0)?(int)(x + 0.5):(int)(x - 0.5); }
+
+// abs
+inline bool vnl_math_abs(bool x) { return x; }
+inline unsigned char vnl_math_abs(unsigned char x) { return x; }
+inline unsigned char vnl_math_abs(signed char x) { return x < 0 ? -x : x; }
+inline unsigned char vnl_math_abs(char x) { return (unsigned char)x; }
+inline unsigned short vnl_math_abs(short x) { return x < 0 ? -x : x; }
+inline unsigned short vnl_math_abs(unsigned short x) { return x; }
+inline int vnl_math_abs(int x) { return x < 0 ? -x : x; }
+inline unsigned int vnl_math_abs(unsigned int x) { return x; }
+inline long vnl_math_abs(long x) { return x < 0 ? -x : x; }
+inline unsigned long vnl_math_abs(unsigned long x) { return x; }
+inline float vnl_math_abs(float x) { return x < 0.0f ? -x : x; }
+inline double vnl_math_abs(double x) { return x < 0.0 ? -x : x; }
+inline long double vnl_math_abs(long double x) { return x < 0.0 ? -x : x; }
+
+// max
+inline int vnl_math_max(int x, int y) { return (x > y) ? x : y; }
+inline unsigned int vnl_math_max(unsigned int x, unsigned int y) { return (x > y) ? x : y; }
+inline long vnl_math_max(long x, long y) { return (x > y) ? x : y; }
+inline unsigned long vnl_math_max(unsigned long x, unsigned long y) { return (x > y) ? x : y;}
+inline float vnl_math_max(float x, float y) { return (x < y) ? y : x; }
+inline double vnl_math_max(double x, double y) { return (x < y) ? y : x; }
+
+// min
+inline int vnl_math_min(int x, int y) { return (x < y) ? x : y; }
+inline unsigned int vnl_math_min(unsigned int x, unsigned int y) { return (x < y) ? x : y; }
+inline long vnl_math_min(long x, long y) { return (x < y) ? x : y; }
+inline unsigned long vnl_math_min(unsigned long x, unsigned long y) { return (x < y) ? x : y;}
+inline float vnl_math_min(float x, float y) { return (x > y) ? y : x; }
+inline double vnl_math_min(double x, double y) { return (x > y) ? y : x; }
+
+// sqr (square)
+inline bool vnl_math_sqr(bool x) { return x; }
+inline int vnl_math_sqr(int x) { return x*x; }
+inline unsigned int vnl_math_sqr(unsigned int x) { return x*x; }
+inline long vnl_math_sqr(long x) { return x*x; }
+inline float vnl_math_sqr(float x) { return x*x; }
+inline double vnl_math_sqr(double x) { return x*x; }
+
+// cube
+inline bool vnl_math_cube(bool x) { return x; }
+inline int vnl_math_cube(int x) { return x*x*x; }
+inline unsigned int vnl_math_cube(unsigned int x) { return x*x*x; }
+inline long vnl_math_cube(long x) { return x*x*x; }
+inline float vnl_math_cube(float x) { return x*x*x; }
+inline double vnl_math_cube(double x) { return x*x*x; }
+
+// sgn (sign in -1, 0, +1)
+inline int vnl_math_sgn(int x) { return x?((x>0)?1:-1):0; }
+inline int vnl_math_sgn(long x) { return x?((x>0)?1:-1):0; }
+inline int vnl_math_sgn(float x) { return (x != 0)?((x>0)?1:-1):0; }
+inline int vnl_math_sgn(double x) { return (x != 0)?((x>0)?1:-1):0; }
+
+// sgn0 (sign in -1, +1 only, useful for reals)
+inline int vnl_math_sgn0(int x) { return (x>=0)?1:-1; }
+inline int vnl_math_sgn0(long x) { return (x>=0)?1:-1; }
+inline int vnl_math_sgn0(float x) { return (x>=0)?1:-1; }
+inline int vnl_math_sgn0(double x) { return (x>=0)?1:-1; }
+
+// squared_magnitude
+inline unsigned int vnl_math_squared_magnitude(char x) { return int(x)*int(x); }
+inline unsigned int vnl_math_squared_magnitude(unsigned char x) { return int(x)*int(x); }
+inline unsigned int vnl_math_squared_magnitude(int x) { return x*x; }
+inline unsigned int vnl_math_squared_magnitude(unsigned int x) { return x*x; }
+inline long vnl_math_squared_magnitude(long x) { return x*x; }
+inline unsigned long vnl_math_squared_magnitude(unsigned long x) { return x*x; }
+inline float vnl_math_squared_magnitude(float x) { return x*x; }
+inline double vnl_math_squared_magnitude(double x) { return x*x; }
+inline long double vnl_math_squared_magnitude(long double x) { return x*x; }
+
+// cuberoot
+inline float vnl_math_cuberoot(float a) { return float((a<0) ? -vcl_exp(vcl_log(-a)/3) : vcl_exp(vcl_log(a)/3)); }
+inline double vnl_math_cuberoot(double a) { return (a<0) ? -vcl_exp(vcl_log(-a)/3) : vcl_exp(vcl_log(a)/3); }
+
+// hypotenuse
+inline double vnl_math_hypot(int x, int y) { return vcl_sqrt(double(x*x + y*y)); }
+inline float vnl_math_hypot(float x, float y) { return float( vcl_sqrt(double(x*x + y*y)) ); }
+inline double vnl_math_hypot(double x, double y) { return vcl_sqrt(x*x + y*y); }
+inline long double vnl_math_hypot(long double x, long double y) { return vcl_sqrt(x*x + y*y); }
+
+#endif // vnl_math_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f9736bbc5f22d3fbdf787006679ee2e8eb5ef38d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.cxx
@@ -0,0 +1,73 @@
+// This is core/vnl/vnl_matlab_filewrite.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_matlab_filewrite.h"
+
+#include <vcl_sstream.h>
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matlab_write.h>
+
+vnl_matlab_filewrite::vnl_matlab_filewrite(char const *file_name,
+ char const *basename)
+ : basename_(basename ? basename : "targetvar"), variable_int_(0)
+{
+ out_.open(file_name, vcl_ios_out | vcl_ios_binary);
+ if (out_.bad())
+ vcl_cerr << __FILE__ ":" << __LINE__ << ", WARNING : output stream is bad\n";
+}
+
+vcl_string vnl_matlab_filewrite::make_var_name(char const* variable_name)
+{
+ if (variable_name)
+ return vcl_string(variable_name);
+ else {
+ vcl_stringstream ss;
+ ss << variable_int_++;
+ return basename_ + ss.str();
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+//: scalar
+void vnl_matlab_filewrite::write(double v, char const* variable_name) {
+ vnl_matlab_write(out_, v, make_var_name(variable_name).c_str());
+}
+
+//: vector
+void vnl_matlab_filewrite::write(vnl_vector<double> const& v, char const* variable_name) {
+ vnl_matlab_write(out_, v.data_block(), v.size(), make_var_name(variable_name).c_str());
+}
+
+void vnl_matlab_filewrite::write(vnl_vector<vcl_complex<double> > const& v, char const* variable_name) {
+ vnl_matlab_write(out_, v.data_block(), v.size(), make_var_name(variable_name).c_str());
+}
+
+//: matrix
+void vnl_matlab_filewrite::write(vnl_matrix<float> const& M, char const* variable_name) {
+ vnl_matlab_write(out_, M.data_array(), M.rows(), M.cols(), make_var_name(variable_name).c_str());
+}
+
+void vnl_matlab_filewrite::write(vnl_matrix<double> const& M, char const* variable_name) {
+ vnl_matlab_write(out_, M.data_array(), M.rows(), M.cols(), make_var_name(variable_name).c_str());
+}
+
+void vnl_matlab_filewrite::write(vnl_matrix<vcl_complex<float> > const& M, char const* variable_name) {
+ vnl_matlab_write(out_, M.data_array(), M.rows(), M.cols(), make_var_name(variable_name).c_str());
+}
+
+void vnl_matlab_filewrite::write(vnl_matrix<vcl_complex<double> > const& M, char const* variable_name) {
+ vnl_matlab_write(out_, M.data_array(), M.rows(), M.cols(), make_var_name(variable_name).c_str());
+}
+
+void vnl_matlab_filewrite::write(double const * const *M, int rows, int cols, char const* variable_name) {
+ vnl_matlab_write(out_, M, rows, cols, make_var_name(variable_name).c_str());
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.h
new file mode 100644
index 0000000000000000000000000000000000000000..623396ada43808050c2a44451055fd73855da11a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_filewrite.h
@@ -0,0 +1,57 @@
+// This is core/vnl/vnl_matlab_filewrite.h
+#ifndef vnl_matlab_filewrite_h_
+#define vnl_matlab_filewrite_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author David Capel, Oxford RRG
+// \date 17 August 1998
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vcl_string.h>
+#include <vcl_fstream.h>
+#include <vcl_complex.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Code to perform MATLAB binary file operations
+// vnl_matlab_filewrite is a collection of I/O functions for reading/writing
+// matrices in the compact MATLAB binary format (.mat)
+
+class vnl_matlab_filewrite
+{
+ public:
+ vnl_matlab_filewrite (char const* file_name, char const *basename = 0);
+
+ //: Add scalar/vector/matrix variable to the MAT file using specified variable name.
+ // If no name is given, variables will be generated by
+ // appending 0,1,2 etc to the given basename.
+ void write(double v, char const* variable_name = 0);
+
+ void write(vnl_vector<double> const & v, char const* variable_name = 0);
+ void write(vnl_vector<vcl_complex<double> > const & v, char const* variable_name = 0);
+
+ void write(vnl_matrix<float> const & M, char const* variable_name = 0);
+ void write(vnl_matrix<double> const & M, char const* variable_name = 0);
+ void write(vnl_matrix<vcl_complex<float> > const & M, char const* variable_name = 0);
+ void write(vnl_matrix<vcl_complex<double> > const & M, char const* variable_name = 0);
+
+ void write(double const * const *M, int rows, int cols, char const* variable_name = 0);
+
+ protected:
+ vcl_string basename_;
+ int variable_int_;
+ vcl_fstream out_;
+
+ vcl_string make_var_name(char const* variable_name);
+};
+
+#endif // vnl_matlab_filewrite_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_header.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_header.h
new file mode 100644
index 0000000000000000000000000000000000000000..d831e593ff959d69304de12e87463254c5ab3c81
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_header.h
@@ -0,0 +1,35 @@
+// This is core/vnl/vnl_matlab_header.h
+#ifndef vnl_matlab_header_h_
+#define vnl_matlab_header_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief MATLAB header structure
+// \author fsm
+
+struct vnl_matlab_header
+{
+ long type; // sum of one byte order, one storage specifier and one precision specifier
+ long rows;
+ long cols;
+ long imag;
+ long namlen;
+
+ enum type_t {
+ // precision specifier
+ vnl_DOUBLE_PRECISION = 0,
+ vnl_SINGLE_PRECISION = 10,
+ // storage specifier
+ vnl_COLUMN_WISE = 0,
+ vnl_ROW_WISE = 100,
+ // byte order
+ vnl_LITTLE_ENDIAN = 0,
+ vnl_BIG_ENDIAN = 1000,
+ //
+ vnl_none = 0
+ };
+};
+
+#endif // vnl_matlab_header_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.h
new file mode 100644
index 0000000000000000000000000000000000000000..7e935114e88252b70472d0e418e720db6c8599cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.h
@@ -0,0 +1,88 @@
+// This is core/vnl/vnl_matlab_print.h
+#ifndef vnl_matlab_print_h_
+#define vnl_matlab_print_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Print matrices and vectors in nice MATLAB format.
+// \author fsm, from awf's MatOps code.
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_fwd.h>
+
+#include <vnl/vnl_matlab_print_format.h>
+
+// If a variable name (e.g. "foo") is given, the raw data will be preceded by
+// "foo = diag([ " for a vnl_diag_matrix
+// "foo = [ ...\n" for a vnl_matrix and
+// "foo = [ " for a vnl_vector
+// and followed by "])\n", "]\n" and "]\n" respectively. If the variable name
+// is a null pointer, the data is printed as is.
+
+//-------------------- "unnamed" forms.
+
+//: print a 1D array.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ T const *array,
+ unsigned length,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a 2D array.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ T const * const *array,
+ unsigned rows, unsigned cols,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//-------------------- "named" forms.
+
+//: print a vnl_diagonal_matrix<>.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_diag_matrix<T> const&,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a vnl_matrix<>.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_matrix<T> const&,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a vnl_matrix_fixed<>.
+template <class T, unsigned int n, unsigned int m>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_matrix_fixed<T,n,m> const&,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a vnl_matrix_ref<>.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_matrix_ref<T> const &,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a vnl_vector<>.
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_vector<T> const &,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+//: print a vnl_vector_fixed<>.
+template <class T, unsigned int n>
+vcl_ostream &vnl_matlab_print(vcl_ostream &,
+ vnl_vector_fixed<T,n> const &,
+ char const *variable_name =0,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+
+//: naughty naming-convention-defying-but-handy macro.
+#define MATLABPRINT(X) (vnl_matlab_print(vcl_cerr, (X).as_ref(), #X))
+
+#endif // vnl_matlab_print_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.txx
new file mode 100644
index 0000000000000000000000000000000000000000..902cf94deee30e5781c4102adb6233b1cf50f834
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print.txx
@@ -0,0 +1,200 @@
+// This is core/vnl/vnl_matlab_print.txx
+// It is different from vnl_matlab_print.cxx
+#ifndef vnl_matlab_print_txx_
+#define vnl_matlab_print_txx_
+// \author fsm
+// Adapted from awf's MatOps class.
+
+#include "vnl_matlab_print.h"
+
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_matrix_ref.h>
+#include <vnl/vnl_diag_matrix.h>
+#include <vnl/vnl_matlab_print_scalar.h>
+
+//--------------------------------------------------------------------------------
+
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream& s,
+ T const* array,
+ unsigned length,
+ vnl_matlab_print_format format)
+{
+ char buf[1024];
+ for (unsigned j=0; j<length; j++ ) {
+ // Format according to selected style
+ // In both cases an exact 0 goes out as such
+ vnl_matlab_print_scalar(array[j], buf, format);
+ s << buf;
+ }
+
+ return s;
+}
+
+template <class T>
+vcl_ostream &vnl_matlab_print(vcl_ostream &s,
+ T const * const *array,
+ unsigned rows, unsigned cols,
+ vnl_matlab_print_format format)
+{
+ for (unsigned i=0; i<rows; ++i)
+ vnl_matlab_print(s, array[i], cols, format) << '\n';
+ return s;
+}
+
+template <class T>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_diag_matrix<T> const& D,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = diag([ ";
+
+ vnl_matlab_print(s, D.begin(), D.size(), format);
+
+ if (variable_name)
+ s << " ])\n";
+
+ return s;
+}
+
+template <class T>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_matrix<T> const& M,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = [ ...\n";
+
+ if (variable_name && M.rows() == 0)
+ return s << "];\n";
+
+ for (unsigned int i=0; i<M.rows(); i++ ) {
+ vnl_matlab_print(s, M[i], M.cols(), format);
+
+ if (variable_name && (i == M.rows()-1))
+ s << " ]";
+
+ s << '\n';
+ }
+
+ return s;
+}
+
+template <class T>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_vector<T> const & v,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = [ ";
+
+ vnl_matlab_print(s, v.begin(), v.size(), format);
+
+ if (variable_name)
+ s << " ]\n";
+
+ return s;
+}
+
+template <class T, unsigned int n, unsigned int m>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_matrix_fixed<T,n,m> const& M,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = [ ...\n";
+
+ if (variable_name && M.rows() == 0)
+ return s << "];\n";
+
+ for (unsigned int i=0; i<n; ++i ) {
+ vnl_matlab_print(s, M[i], m, format);
+
+ if (variable_name && (i == n-1))
+ s << " ]";
+
+ s << '\n';
+ }
+
+ return s;
+}
+
+template <class T>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_matrix_ref<T> const& M,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = [ ...\n";
+
+ if (variable_name && M.rows() == 0)
+ return s << "];\n";
+
+ for (unsigned int i=0; i<M.rows(); ++i )
+ {
+ vnl_matlab_print(s, M[i], M.cols(), format);
+
+ if (variable_name && (i == M.rows()-1))
+ s << " ]";
+
+ s << '\n';
+ }
+
+ return s;
+}
+
+template <class T, unsigned int n>
+vcl_ostream& vnl_matlab_print(vcl_ostream& s,
+ vnl_vector_fixed<T,n> const & v,
+ char const* variable_name,
+ vnl_matlab_print_format format)
+{
+ if (variable_name)
+ s << variable_name << " = [ ";
+
+ vnl_matlab_print(s, v.begin(), n, format);
+
+ if (variable_name)
+ s << " ]\n";
+
+ return s;
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_MATLAB_PRINT_INSTANTIATE
+#define VNL_MATLAB_PRINT_INSTANTIATE(T) \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, T const*, unsigned, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, T const* const*, unsigned, unsigned, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_diag_matrix<T > const&, char const *, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix<T > const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector<T > const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_ref<T > const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,2,2> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,2,3> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,3,2> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,3,3> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,2,4> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,3,4> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,4,3> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,4,4> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_matrix_fixed<T,6,8> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,2> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,3> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,4> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,5> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,6> const&, char const*, vnl_matlab_print_format); \
+template vcl_ostream &vnl_matlab_print(vcl_ostream &, vnl_vector_fixed<T,7> const&, char const*, vnl_matlab_print_format)
+
+#endif // vnl_matlab_print_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print2.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print2.h
new file mode 100644
index 0000000000000000000000000000000000000000..bd4b355f6d2efea722d6baf91a25461f64741e32
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print2.h
@@ -0,0 +1,75 @@
+// This is core/vnl/vnl_matlab_print2.h
+#ifndef vnl_matlab_print2_h_
+#define vnl_matlab_print2_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+//
+// After including this header file, the client should be able to say :
+// \code
+// vnl_matrix<double> foo(3, 14);
+// ....
+// vcl_cerr << "and the blasted matrix is :" << endl
+// << vnl_matlab_print(foo)
+// << vnl_matlab_print(foo, "foo")
+// << vnl_matlab_print(foo, 0, vnl_matlab_fmt_long);
+// \endcode
+// instead of
+// \code
+// ....
+// vcl_cerr << "and the blasted matrix is :" << endl;
+// vnl_matlab_print(vcl_cerr, foo);
+// vnl_matlab_print(vcl_cerr, foo, "foo");
+// vnl_matlab_print(vcl_cerr, foo, 0, vnl_matlab_fmt_long);
+// \endcode
+//
+// \author fsm
+
+#include <vnl/vnl_matlab_print.h>
+#include <vcl_iosfwd.h>
+
+// The proxy classes.
+template <class T>
+struct vnl_matlab_print_proxy
+{
+ T const &obj;
+ char const *name;
+ vnl_matlab_print_format format;
+ vnl_matlab_print_proxy(T const &obj_,
+ char const *name_,
+ vnl_matlab_print_format format_)
+ : obj(obj_), name(name_), format(format_) { }
+ ~vnl_matlab_print_proxy() { }
+};
+
+// Output operator for the proxies.
+template <class T>
+inline
+vcl_ostream &operator<<(vcl_ostream &os, vnl_matlab_print_proxy<T> const &mp)
+{
+ return vnl_matlab_print(os, mp.obj, mp.name, mp.format);
+}
+
+// Functions to make proxies. This should work for objects of types
+// derived from vnl_vector, vnl_matrix etc because the overload
+// resolution is done in the operator<< above.
+template <class T>
+inline
+vnl_matlab_print_proxy<T>
+vnl_matlab_print(T const &obj,
+ char const *name = 0,
+ vnl_matlab_print_format format = vnl_matlab_print_format_default)
+{
+ return vnl_matlab_print_proxy<T>(obj, name, format);
+}
+
+#define VNL_MATLAB_PRINT2_INSTANTIATE(T) \
+template struct vnl_matlab_print_proxy<T >; \
+VCL_INSTANTIATE_INLINE(vcl_ostream & \
+ operator<<(vcl_ostream &, vnl_matlab_print_proxy<T > const &)); \
+VCL_INSTANTIATE_INLINE(vnl_matlab_print_proxy<T > \
+ vnl_matlab_print(T const &, char const *, vnl_matlab_print_format))
+
+#endif // vnl_matlab_print2_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..16a9a60616b649666a689c911e343d299f486adc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.cxx
@@ -0,0 +1,53 @@
+// This is core/vnl/vnl_matlab_print_format.cxx
+#include "vnl_matlab_print_format.h"
+//:
+// \file
+
+#include <vcl_iostream.h>
+#include <vcl_vector.h>
+
+//: Choose precision in printouts.
+//
+// vnl_matlab_format(vnl_matops::fmt_long) selects 16-digit precision
+//
+// vnl_matlab_format(vnl_matops::fmt_short) selects 4-digit precision
+
+//: this variable is the current top of the stack.
+// moved here because gcc 2.7 choked
+static vnl_matlab_print_format the_format = vnl_matlab_print_format_short;
+//: the rest of the stack is stored in this vector.
+static vcl_vector<int> *format_stack = 0;
+//: call this to initialize the format stack.
+static void vnl_matlab_print_format_init()
+{ if (!format_stack) format_stack = new vcl_vector<int>; }
+
+void vnl_matlab_print_format_push(vnl_matlab_print_format f)
+{
+ vnl_matlab_print_format_init();
+ format_stack->push_back(the_format);
+ the_format = f;
+}
+
+void vnl_matlab_print_format_pop()
+{
+ vnl_matlab_print_format_init();
+ if (format_stack->empty())
+ vcl_cerr << __FILE__ ": format stack empty\n";
+ else {
+ the_format = vnl_matlab_print_format(format_stack->back());
+ format_stack->pop_back();
+ }
+}
+
+vnl_matlab_print_format vnl_matlab_print_format_set(vnl_matlab_print_format f)
+{
+ vnl_matlab_print_format_init();
+ vnl_matlab_print_format old = the_format;
+ the_format = f;
+ return old;
+}
+
+vnl_matlab_print_format vnl_matlab_print_format_top()
+{
+ return the_format;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.h
new file mode 100644
index 0000000000000000000000000000000000000000..e880436fa13ac4fad930a40f533598e5614746e2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_format.h
@@ -0,0 +1,31 @@
+#ifndef vnl_matlab_print_format_h_
+#define vnl_matlab_print_format_h_
+/*
+ fsm
+*/
+
+//:
+// \file
+
+//: pretty-printing matlab formats
+enum vnl_matlab_print_format {
+ vnl_matlab_print_format_default,
+ vnl_matlab_print_format_short,
+ vnl_matlab_print_format_long,
+ vnl_matlab_print_format_short_e,
+ vnl_matlab_print_format_long_e
+};
+
+// -------------------- Setting the default format.
+
+//: get top of stack :
+vnl_matlab_print_format vnl_matlab_print_format_top();
+
+//: set new, get old format at top of stack :
+vnl_matlab_print_format vnl_matlab_print_format_set(vnl_matlab_print_format);
+
+//: push/pop the top of the stack :
+void vnl_matlab_print_format_push(vnl_matlab_print_format);
+void vnl_matlab_print_format_pop ();
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..03ce82e167f29e23e5b3730eecc29628e40e3750
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.cxx
@@ -0,0 +1,250 @@
+// This is core/vnl/vnl_matlab_print_scalar.cxx
+
+#include "vnl_matlab_print_scalar.h"
+
+#include <vcl_cstdio.h> // sprintf()
+#include <vcl_cstdlib.h> // abort()
+#include <vcl_cstring.h> // strlen()
+#include <vcl_complex.h>
+
+void vnl_matlab_print_scalar(int v,
+ char *buf,
+ vnl_matlab_print_format)
+{
+ vcl_sprintf(buf, "%4d ", v);
+}
+
+void vnl_matlab_print_scalar(unsigned v,
+ char *buf,
+ vnl_matlab_print_format)
+{
+ vcl_sprintf(buf, "%4u ", v);
+}
+
+void vnl_matlab_print_scalar(float v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ if (format == vnl_matlab_print_format_default)
+ format = vnl_matlab_print_format_top();
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ if (v == 0.0)
+ vcl_sprintf(buf, "%8d ", 0);
+ else
+ vcl_sprintf(buf, "%8.5f ", v);
+ break;
+ case vnl_matlab_print_format_short:
+ if (v == 0.0)
+ vcl_sprintf(buf, "%6d ", 0);
+ else
+ vcl_sprintf(buf, "%6.3f ", v);
+ break;
+ case vnl_matlab_print_format_long_e:
+ vcl_sprintf(buf, "%11.7e ", v);
+ break;
+ case vnl_matlab_print_format_short_e:
+ vcl_sprintf(buf, "%8.4e ", v);
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+}
+
+void vnl_matlab_print_scalar(double v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ if (format == vnl_matlab_print_format_default)
+ format = vnl_matlab_print_format_top();
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ if (v == 0.0)
+ vcl_sprintf(buf, "%16d ", 0);
+ else
+ vcl_sprintf(buf, "%16.13f ", v);
+ break;
+ case vnl_matlab_print_format_short:
+ if (v == 0.0)
+ vcl_sprintf(buf, "%8d ", 0);
+ else
+ vcl_sprintf(buf, "%8.4f ", v);
+ break;
+ case vnl_matlab_print_format_long_e:
+ vcl_sprintf(buf, "%20.14e ", v);
+ break;
+ case vnl_matlab_print_format_short_e:
+ vcl_sprintf(buf, "%10.4e ", v);
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+}
+
+void vnl_matlab_print_scalar(long double v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ vnl_matlab_print_scalar(double(v), buf, format); // FIXME
+}
+
+void vnl_matlab_print_scalar(vcl_complex<double> v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ if (format == vnl_matlab_print_format_default)
+ format = vnl_matlab_print_format_top();
+ int width = 16;
+ int precision = 12;
+ char conv = 'f';
+
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ case vnl_matlab_print_format_long_e:
+ width = 16;
+ precision = 12;
+ break;
+ case vnl_matlab_print_format_short:
+ case vnl_matlab_print_format_short_e:
+ width = 8;
+ precision = 4;
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ case vnl_matlab_print_format_short:
+ conv = 'f';
+ break;
+ case vnl_matlab_print_format_long_e:
+ case vnl_matlab_print_format_short_e:
+ conv = 'e';
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+
+ double r = vcl_real(v);
+ double i = vcl_imag(v);
+
+ char fmt[1024];
+ // Real part
+ if (r == 0) {
+ vcl_sprintf(fmt, "%%" "%d" "d ", width);
+ vcl_sprintf(buf, fmt, 0);
+
+ } else {
+ vcl_sprintf(fmt, "%%" "%d" "." "%d" "%c ", width, precision, conv);
+ vcl_sprintf(buf, fmt, r);
+ }
+
+ buf += vcl_strlen(buf);
+
+ // Imaginary part. Width is reduced as sign is taken care of separately
+ if (i == 0) {
+ vcl_sprintf(fmt, " %%" "%d" "s ", width-1);
+ vcl_sprintf(buf, fmt, "");
+ } else {
+ char sign = '+';
+ if (i < 0) {
+ sign = '-';
+ i = -i;
+ }
+ vcl_sprintf(fmt, "%c%%" "%d.%d%ci ", sign, width-1, precision, conv);
+ vcl_sprintf(buf, fmt, i);
+ }
+}
+
+void vnl_matlab_print_scalar(vcl_complex<float> v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ if (format == vnl_matlab_print_format_default)
+ format = vnl_matlab_print_format_top();
+ int width = 10;
+ int precision = 6;
+ char conv = 'f';
+
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ case vnl_matlab_print_format_long_e:
+ width = 10;
+ precision = 6;
+ break;
+ case vnl_matlab_print_format_short:
+ case vnl_matlab_print_format_short_e:
+ width = 8;
+ precision = 4;
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+
+ switch (format) {
+ case vnl_matlab_print_format_long:
+ case vnl_matlab_print_format_short:
+ conv = 'f';
+ break;
+ case vnl_matlab_print_format_long_e:
+ case vnl_matlab_print_format_short_e:
+ conv = 'e';
+ break;
+ default:/*vnl_matlab_print_format_default:*/ vcl_abort(); break;
+ }
+
+ float r = vcl_real(v);
+ float i = vcl_imag(v);
+
+ char fmt[1024];
+ // Real part
+ if (r == 0) {
+ vcl_sprintf(fmt, "%%" "%d" "d ", width);
+ vcl_sprintf(buf, fmt, 0);
+
+ } else {
+ vcl_sprintf(fmt, "%%" "%d" "." "%d" "%c ", width, precision, conv);
+ vcl_sprintf(buf, fmt, r);
+ }
+
+ buf += vcl_strlen(buf);
+
+ // Imaginary part. Width is reduced as sign is taken care of separately
+ if (i == 0) {
+ vcl_sprintf(fmt, " %%" "%d" "s ", width-1);
+ vcl_sprintf(buf, fmt, "");
+ } else {
+ char sign = '+';
+ if (i < 0) {
+ sign = '-';
+ i = -i;
+ }
+ vcl_sprintf(fmt, "%c%%" "%d.%d%ci ", sign, width-1, precision, conv);
+ vcl_sprintf(buf, fmt, i);
+ }
+}
+
+void vnl_matlab_print_scalar(vcl_complex<long double> v,
+ char *buf,
+ vnl_matlab_print_format format)
+{
+ vnl_matlab_print_scalar(vcl_complex<double>(vcl_real(v), vcl_imag(v)), buf, format); // FIXME
+}
+
+
+#include <vcl_iostream.h>
+template <class T>
+vcl_ostream &vnl_matlab_print_scalar(vcl_ostream &s,
+ T value,
+ vnl_matlab_print_format format)
+{
+ char buf[1024];
+ vnl_matlab_print_scalar(value, buf, format);
+ return s << buf;
+}
+
+#define inst(T) template vcl_ostream &vnl_matlab_print_scalar(vcl_ostream &, T, vnl_matlab_print_format)
+inst(int);
+inst(float);
+inst(double);
+inst(long double);
+inst(vcl_complex<float>);
+inst(vcl_complex<double>);
+inst(vcl_complex<long double>);
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.h
new file mode 100644
index 0000000000000000000000000000000000000000..3f808b61d829252ac1888ee0167f2c63c143914e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_print_scalar.h
@@ -0,0 +1,37 @@
+#ifndef vnl_matlab_print_scalar_h_
+#define vnl_matlab_print_scalar_h_
+/*
+ fsm
+*/
+
+//:
+// \file
+
+#include <vcl_iosfwd.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_print_format.h>
+
+//: print real or complex scalar into character buffer.
+#define vnl_matlab_print_scalar_declare(T) \
+void vnl_matlab_print_scalar(T v, \
+ char *buf, \
+ vnl_matlab_print_format =vnl_matlab_print_format_default)
+
+// Even with a function template we would have to
+// forward declare all the specializations anyway.
+vnl_matlab_print_scalar_declare(int);
+vnl_matlab_print_scalar_declare(unsigned int);
+vnl_matlab_print_scalar_declare(float);
+vnl_matlab_print_scalar_declare(double);
+vnl_matlab_print_scalar_declare(long double);
+vnl_matlab_print_scalar_declare(vcl_complex<float>);
+vnl_matlab_print_scalar_declare(vcl_complex<double>);
+vnl_matlab_print_scalar_declare(vcl_complex<long double>);
+
+//: print scalar to vcl_ostream.
+export template <class T>
+vcl_ostream &vnl_matlab_print_scalar(vcl_ostream &,
+ T value,
+ vnl_matlab_print_format =vnl_matlab_print_format_default);
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5c1e357d18512e6b0b88a1649e26c8b3d4bb4bd9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.cxx
@@ -0,0 +1,227 @@
+// This is core/vnl/vnl_matlab_read.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_matlab_read.h"
+#include <vcl_ios.h> // for vcl_ios_cur
+#include <vcl_iostream.h>
+#include <vcl_cstring.h> // memset()
+#include <vcl_complex.h>
+#include <vnl/vnl_c_vector.h>
+
+// FIXME: Currently ignores the byte ordering of the MAT file header, effectively
+// assuming the MAT file was written with the native byte ordering.
+
+//--------------------------------------------------------------------------------
+
+// SGI needs??
+void vnl_read_bytes(vcl_istream &s, void *p, unsigned bytes)
+{
+ s.read((char *)p, bytes);
+}
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_matlab_read_data(vcl_istream &s, float *p, unsigned n)
+{ ::vnl_read_bytes(s, p, n*sizeof(*p)); }
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_matlab_read_data(vcl_istream &s, double *p, unsigned n)
+{ ::vnl_read_bytes(s, p, n*sizeof(*p)); }
+
+#define implement_read_complex_data(T) \
+VCL_DEFINE_SPECIALIZATION \
+void vnl_matlab_read_data(vcl_istream &s, vcl_complex<T > *ptr, unsigned n) { \
+ T *re = vnl_c_vector<T >::allocate_T(n); \
+ T *im = vnl_c_vector<T >::allocate_T(n); \
+ ::vnl_read_bytes(s, re, n*sizeof(T)); \
+ ::vnl_read_bytes(s, im, n*sizeof(T)); \
+ for (unsigned i=0; i<n; ++i) \
+ ptr[i] = vcl_complex<T >(re[i], im[i]); \
+ vnl_c_vector<T >::deallocate(re, n); \
+ vnl_c_vector<T >::deallocate(im, n); \
+}
+
+implement_read_complex_data(float )
+implement_read_complex_data(double)
+
+#undef implement_read_complex_data
+
+//--------------------------------------------------------------------------------
+
+vnl_matlab_readhdr::vnl_matlab_readhdr(vcl_istream &s_) : s(s_), varname(0), data_read(false)
+{
+ read_hdr();
+}
+
+vnl_matlab_readhdr::~vnl_matlab_readhdr()
+{
+ if (varname)
+ delete [] varname;
+ varname = 0;
+}
+
+vnl_matlab_readhdr::operator vnl_matlab_readhdr::safe_bool () const
+{
+ return (s.good() && !s.eof())? VCL_SAFE_BOOL_TRUE : 0; // FIXME
+}
+
+bool vnl_matlab_readhdr::operator!() const
+{
+ return (s.good() && !s.eof())? false : true; // FIXME
+}
+
+bool vnl_matlab_readhdr::is_single() const
+{
+ return (hdr.type % (10*vnl_matlab_header::vnl_SINGLE_PRECISION)) >= vnl_matlab_header::vnl_SINGLE_PRECISION;
+}
+
+bool vnl_matlab_readhdr::is_rowwise() const
+{
+ return (hdr.type % (10*vnl_matlab_header::vnl_ROW_WISE)) >= vnl_matlab_header::vnl_ROW_WISE;
+}
+
+bool vnl_matlab_readhdr::is_bigendian() const
+{
+ return (hdr.type % (10*vnl_matlab_header::vnl_BIG_ENDIAN)) >= vnl_matlab_header::vnl_BIG_ENDIAN;
+}
+
+//: internal
+// increment 'current', record the file position and read the header.
+void vnl_matlab_readhdr::read_hdr()
+{
+ vcl_memset(&hdr, 0, sizeof hdr);
+ ::vnl_read_bytes(s, &hdr, sizeof(hdr));
+ if (varname)
+ delete [] varname;
+ varname = new char[hdr.namlen+1];
+#ifdef DEBUG
+ vcl_cerr << "type:" << hdr.type << vcl_endl
+ << "rows:" << hdr.rows << vcl_endl
+ << "cols:" << hdr.cols << vcl_endl
+ << "imag:" << hdr.imag << vcl_endl
+ << "namlen:" << hdr.namlen << vcl_endl;
+#endif
+ ::vnl_read_bytes(s, varname, hdr.namlen);
+ varname[hdr.namlen] = '\0';
+
+ data_read = false;
+}
+
+void vnl_matlab_readhdr::read_next()
+{
+ if (!data_read) {
+ // number of bytes to skip :
+ unsigned long n = rows()*cols()*sizeof(float);
+
+ if (!is_single())
+ n *= 2;
+
+ if (is_complex())
+ n *= 2;
+ s.seekg(n, vcl_ios_cur);
+ }
+
+ read_hdr();
+}
+
+//--------------------------------------------------------------------------------
+
+bool vnl_matlab_readhdr::type_chck(float &) { return is_single() && !is_complex(); }
+bool vnl_matlab_readhdr::type_chck(double &) { return !is_single() && !is_complex(); }
+bool vnl_matlab_readhdr::type_chck(vcl_complex<float> &) { return is_single() && is_complex(); }
+bool vnl_matlab_readhdr::type_chck(vcl_complex<double> &) { return !is_single() && is_complex(); }
+
+#define fsm_define_methods(T) \
+bool vnl_matlab_readhdr::read_data(T &v) { \
+ if (!type_chck(v)) { vcl_cerr << "type_check\n"; return false; }\
+ if (rows()!=1 || cols()!=1) { vcl_cerr << "size0\n"; return false; } \
+ vnl_matlab_read_data(s, &v, 1); \
+ data_read = true; return *this; \
+} \
+bool vnl_matlab_readhdr::read_data(T *p) { \
+ if (!type_chck(p[0])) { vcl_cerr << "type_check\n"; return false; } \
+ if (rows()!=1 && cols()!=1) { vcl_cerr << "size1\n"; return false; } \
+ vnl_matlab_read_data(s, p, rows()*cols()); \
+ data_read = true; return *this; \
+} \
+bool vnl_matlab_readhdr::read_data(T * const *m) { \
+ if (!type_chck(m[0][0])) { vcl_cerr << "type_check\n"; return false; } \
+ T *tmp = vnl_c_vector<T >::allocate_T(rows()*cols()); \
+ /*vnl_c_vector<T >::fill(tmp, rows()*cols(), 3.14159);*/ \
+ vnl_matlab_read_data(s, tmp, rows()*cols()); \
+ int a, b; \
+ if (is_rowwise()) { \
+ a = cols(); \
+ b = 1; \
+ } \
+ else { \
+ a = 1; \
+ b = rows(); \
+ } \
+ for (int i=0; i<rows(); ++i) \
+ for (int j=0; j<cols(); ++j) \
+ m[i][j] = tmp[a*i + b*j]; \
+ vnl_c_vector<T >::deallocate(tmp, rows()*cols()); \
+ data_read = true; return *this; \
+}
+fsm_define_methods(float);
+fsm_define_methods(double);
+fsm_define_methods(vcl_complex<float>);
+fsm_define_methods(vcl_complex<double>);
+#undef fsm_define_methods
+
+//--------------------------------------------------------------------------------
+
+#include <vcl_cassert.h>
+#include <vcl_new.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+template <class T>
+bool vnl_matlab_read_or_die(vcl_istream &s,
+ vnl_vector<T> &v,
+ char const *name)
+{
+ vnl_matlab_readhdr h(s);
+ if (!s) // eof?
+ return false;
+ if (name && *name)
+ assert(vcl_strcmp(name, h.name())==0/*wrong name?*/);
+ if (v.size() != unsigned(h.rows()*h.cols()))
+ {
+ vcl_destroy(&v);
+ new (&v) vnl_vector<T>(h.rows()*h.cols());
+ }
+ assert(h.read_data(v.begin())/*wrong type?*/);
+ return true;
+}
+
+template <class T>
+bool vnl_matlab_read_or_die(vcl_istream &s,
+ vnl_matrix<T> &M,
+ char const *name)
+{
+ vnl_matlab_readhdr h(s);
+ if (!s) // eof?
+ return false;
+ if (name && *name)
+ assert(vcl_strcmp(name, h.name())==0/*wrong name?*/);
+ if (M.rows() != unsigned(h.rows()) || M.cols() != unsigned(h.cols()))
+ {
+ vcl_destroy(&M);
+ new (&M) vnl_matrix<T>(h.rows(), h.cols());
+ }
+ assert(h.read_data(M.data_array())/*wrong type?*/);
+ return true;
+}
+
+#define inst(T) \
+template bool vnl_matlab_read_or_die(vcl_istream &, vnl_vector<T> &, char const *); \
+template bool vnl_matlab_read_or_die(vcl_istream &, vnl_matrix<T> &, char const *);
+
+inst(double);
+inst(float);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.h
new file mode 100644
index 0000000000000000000000000000000000000000..9e12a791238dadef37a2e14034a9bf538c4e2ade
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_read.h
@@ -0,0 +1,88 @@
+// This is core/vnl/vnl_matlab_read.h
+#ifndef vnl_matlab_read_h_
+#define vnl_matlab_read_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Read from MATLAB files
+// \author fsm
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 documentation tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vcl_iosfwd.h>
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_header.h>
+
+// ------------------------------ easy ------------------------------
+
+template <class T> class vnl_vector;
+template <class T> class vnl_matrix;
+
+//: Attempt to read vector or matrix.
+// If the MATLAB header cannot be read, return false.
+// Else, if a name is given, and it doesn't match what's in the file, abort().
+// If the data in the file cannot reasonably be read into the destination, abort().
+//
+// The vector/matrix will be resized if necessary.
+template <class T> bool vnl_matlab_read_or_die(vcl_istream &, vnl_vector<T> &, char const *name =0);
+template <class T> bool vnl_matlab_read_or_die(vcl_istream &, vnl_matrix<T> &, char const *name =0);
+
+// ------------------------------ less easy ------------------------------
+
+//: MATLAB stores its data as a real block followed by an imaginary block.
+// This function will read both blocks and interleave them into the area
+// pointed to by ptr. For real T, it is equivalent to s.read(ptr, sizeof(T)*n);
+template <class T> void vnl_matlab_read_data(vcl_istream &s, T *ptr, unsigned n);
+
+class vnl_matlab_readhdr
+{
+ VCL_SAFE_BOOL_DEFINE;
+ public:
+ vnl_matlab_readhdr(vcl_istream &);
+ ~vnl_matlab_readhdr();
+
+ operator safe_bool () const;
+ bool operator!() const;
+ void read_next(); // skip to next header in file
+
+ bool is_single() const;
+ bool is_rowwise() const;
+ bool is_bigendian() const; // don't use this
+ long rows() const { return hdr.rows; }
+ long cols() const { return hdr.cols; }
+ bool is_complex() const { return hdr.imag != 0; }
+ char const *name() const { return varname; }
+
+ // bah! no member templates
+ //template <class T> bool read_data(T &); // scalar
+ //template <class T> bool read_data(T *); // vector
+ //template <class T> bool read_data(T * const *); // 2D array
+#define fsm_declare_methods(T) \
+ private: \
+ bool type_chck(T &); \
+ public: \
+ bool read_data(T &); \
+ bool read_data(T *); \
+ bool read_data(T * const *) // no ; here, please. SunPro 5.0 barfs.
+fsm_declare_methods(float);
+fsm_declare_methods(double);
+fsm_declare_methods(vcl_complex<float>);
+fsm_declare_methods(vcl_complex<double>);
+#undef fsm_declare_methods
+
+ private:
+ vcl_istream &s;
+ vnl_matlab_header hdr;
+ char *varname;
+ bool data_read;
+
+ void read_hdr(); // internal work routine
+};
+
+#endif // vnl_matlab_read_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..f7a08e53a1ebedc2d3840dcc5970274795838e72
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.cxx
@@ -0,0 +1,179 @@
+// This is core/vnl/vnl_matlab_write.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_matlab_write.h"
+
+#include <vcl_iostream.h>
+#include <vcl_cstring.h> // strlen()
+#include <vcl_complex.h>
+#include <vnl/vnl_matlab_header.h>
+
+#include <vxl_config.h>
+#if VXL_LITTLE_ENDIAN // #ifdef i386
+# define native_BYTE_ORDER vnl_matlab_header::vnl_LITTLE_ENDIAN
+#else
+# define native_BYTE_ORDER vnl_matlab_header::vnl_BIG_ENDIAN
+#endif
+
+// SGI needs char * as first argument to vcl_ostream::write
+void vnl_write_bytes(vcl_ostream &s, void const *p, unsigned bytes)
+{
+ s.write((char const *)p, bytes);
+}
+
+// ------------------------------ traits without tears ------------------------------
+
+//awf: these cannot be static for sunpro 5...
+
+// template <class T> long scalar_precision(T const &);
+long vnl_scalar_precision(float const &) { return vnl_matlab_header::vnl_SINGLE_PRECISION; }
+long vnl_scalar_precision(double const &) { return vnl_matlab_header::vnl_DOUBLE_PRECISION; }
+long vnl_scalar_precision(vcl_complex<float> const &) { return vnl_matlab_header::vnl_SINGLE_PRECISION; }
+long vnl_scalar_precision(vcl_complex<double> const &) { return vnl_matlab_header::vnl_DOUBLE_PRECISION; }
+
+// template <class T> long is_complex(T const &);
+long vnl_is_complex(float const &) { return 0; }
+long vnl_is_complex(double const &) { return 0; }
+long vnl_is_complex(vcl_complex<float> const &) { return 1; }
+long vnl_is_complex(vcl_complex<double> const &) { return 1; }
+
+// template <class T> void vnl_write_real(vcl_ostream &, T const *, unsigned );
+void vnl_write_real(vcl_ostream &s, float const *data, unsigned n)
+{ ::vnl_write_bytes(s, data, n*sizeof(*data)); }
+
+void vnl_write_real(vcl_ostream &s, double const *data, unsigned n)
+{ ::vnl_write_bytes(s, data, n*sizeof(*data)); }
+
+void vnl_write_real(vcl_ostream &s, vcl_complex<float> const *data, unsigned n)
+{
+ float dummy;
+ for (unsigned i=0; i<n; ++i) { // real block
+ dummy = vcl_real(data[i]);
+ ::vnl_write_bytes(s, &dummy, sizeof(dummy));
+ }
+}
+
+void vnl_write_real(vcl_ostream &s, vcl_complex<double> const *data, unsigned n)
+{
+ double dummy;
+ for (unsigned i=0; i<n; ++i) { // real block
+ dummy = vcl_real(data[i]);
+ ::vnl_write_bytes(s, &dummy, sizeof(dummy));
+ }
+}
+
+// template <class T> void vnl_write_imag(vcl_ostream &, T const *, unsigned );
+
+void vnl_write_imag(vcl_ostream &, float const *, unsigned ) { }
+
+void vnl_write_imag(vcl_ostream &, double const *, unsigned ) { }
+
+void vnl_write_imag(vcl_ostream &s, vcl_complex<float> const *data, unsigned n)
+{
+ float dummy;
+ for (unsigned i=0; i<n; ++i) { // imag block
+ dummy = vcl_imag(data[i]);
+ ::vnl_write_bytes(s, &dummy, sizeof(dummy));
+ }
+}
+
+void vnl_write_imag(vcl_ostream &s, vcl_complex<double> const *data, unsigned n)
+{
+ double dummy;
+ for (unsigned i=0; i<n; ++i) { // imag block
+ dummy = vcl_imag(data[i]);
+ ::vnl_write_bytes(s, &dummy, sizeof(dummy));
+ }
+}
+
+//--------------------------------------------------------------------------------
+
+//: scalars
+template <class T>
+bool vnl_matlab_write(vcl_ostream &s, T const & x, char const *name)
+{
+ vnl_matlab_header hdr;
+ hdr.type = native_BYTE_ORDER + vnl_matlab_header::vnl_COLUMN_WISE + vnl_scalar_precision(x);
+ hdr.rows = 1;
+ hdr.cols = 1;
+ hdr.imag = vnl_is_complex(x);
+ hdr.namlen = (unsigned long)vcl_strlen(name)+1L;
+
+ ::vnl_write_bytes(s, &hdr, sizeof(hdr));
+ ::vnl_write_bytes(s, name, hdr.namlen);
+ vnl_write_real(s, &x, 1);
+ vnl_write_imag(s, &x, 1);
+
+ return s.good() != 0;
+}
+#define scalar_instantiate(T) \
+template bool vnl_matlab_write(vcl_ostream &, T const &, char const *);
+
+//: 1D array
+template <class T>
+bool vnl_matlab_write(vcl_ostream &s, T const *v, unsigned n, char const *name)
+{
+ vnl_matlab_header hdr;
+ hdr.type = native_BYTE_ORDER + vnl_matlab_header::vnl_COLUMN_WISE + vnl_scalar_precision(v[0]);
+ hdr.rows = (long)n;
+ hdr.cols = 1L;
+ hdr.imag = vnl_is_complex(v[0]);
+ hdr.namlen = (unsigned long)vcl_strlen(name)+1L;
+
+ ::vnl_write_bytes(s, &hdr, sizeof(hdr));
+ ::vnl_write_bytes(s, name, hdr.namlen);
+ vnl_write_real(s, v, n);
+ vnl_write_imag(s, v, n);
+
+ return s.good() != 0;
+}
+#define array1D_instantiate(T) \
+template bool vnl_matlab_write(vcl_ostream &, T const *, unsigned, char const *);
+
+//: 2D array
+template <class T>
+bool vnl_matlab_write(vcl_ostream &s,
+ T const * const *data,
+ unsigned rows, unsigned cols,
+ char const *name)
+{
+ vnl_matlab_header hdr;
+ hdr.type = native_BYTE_ORDER + vnl_matlab_header::vnl_ROW_WISE + vnl_scalar_precision(data[0][0]);
+ hdr.rows = (long)rows;
+ hdr.cols = (long)cols;
+ hdr.imag = vnl_is_complex(data[0][0]);
+ hdr.namlen = (unsigned long)vcl_strlen(name)+1L;
+
+ ::vnl_write_bytes(s, &hdr, sizeof(hdr));
+ ::vnl_write_bytes(s, name, hdr.namlen);
+ for (unsigned i=0; i<rows; ++i)
+ vnl_write_real(s, data[i], cols);
+ for (unsigned i=0; i<rows; ++i)
+ vnl_write_imag(s, data[i], cols);
+
+ return s.good() != 0;
+}
+#define array2D_instantiate(T) \
+template bool vnl_matlab_write(vcl_ostream &, T const * const *, unsigned, unsigned, char const *);
+
+//--------------------------------------------------------------------------------
+
+scalar_instantiate(float);
+scalar_instantiate(double);
+scalar_instantiate(vcl_complex<float>);
+scalar_instantiate(vcl_complex<double>);
+
+array1D_instantiate(float);
+array1D_instantiate(double);
+array1D_instantiate(vcl_complex<float>);
+array1D_instantiate(vcl_complex<double>);
+
+array2D_instantiate(float);
+array2D_instantiate(double);
+array2D_instantiate(vcl_complex<float>);
+array2D_instantiate(vcl_complex<double>);
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.h
new file mode 100644
index 0000000000000000000000000000000000000000..70432ed3fb69a07bda1a8848e6af7b6eff15d82e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matlab_write.h
@@ -0,0 +1,36 @@
+// This is core/vnl/vnl_matlab_write.h
+#ifndef vnl_matlab_write_h_
+#define vnl_matlab_write_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Write to a MAT file
+//
+// Core code stolen from D. Capel's code. These functions are useful
+// because they allow one to write, say, an image buffer to a MAT file.
+//
+// NB. with these functions, the variable name *must* be a non-null and
+// point to a zero-terminated string. otherwise the code will segfault.
+//
+// \author fsm
+//
+// \verbatim
+// Modifications
+// 09 Mar 2000 fsm. changed order of arguments for consistency with vnl_matlab_read.
+// LSB (Manchester) 23/3/01 Tided documentation
+// \endverbatim
+
+#include <vcl_iosfwd.h>
+
+template <class T> // scalar
+bool vnl_matlab_write(vcl_ostream &, T const &, char const *variable_name);
+
+template <class T> // 1D array
+bool vnl_matlab_write(vcl_ostream &, T const *, unsigned size, char const *variable_name);
+
+template <class T> // 2D array
+bool vnl_matlab_write(vcl_ostream &, T const * const *, unsigned rows, unsigned cols, char const *variable_name);
+
+#endif // vnl_matlab_write_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..13251b5b0a2605e6935fca83bd833d2a4b15ca4d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.cxx
@@ -0,0 +1,128 @@
+// This is core/vnl/vnl_matops.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_matops.h"
+#include <vcl_cassert.h>
+
+vnl_matrix<double> vnl_matops::cat(vnl_matrix<double> const &A, vnl_matrix<double> const &B) {
+ int rowsA = A.rows();
+ int colsA = A.columns();
+ int rowsB = B.rows();
+ int colsB = B.columns();
+
+ assert(rowsA == rowsB);
+
+ vnl_matrix<double> M(rowsA,colsA+colsB);
+ M.update(A,0,0);
+ M.update(B,0,colsA);
+
+ return M;
+}
+
+vnl_matrix<double> vnl_matops::cat(vnl_matrix<double> const &A, vnl_vector<double> const &B) {
+ int rowsA = A.rows();
+ int colsA = A.columns();
+ int rowsB = B.size();
+
+ assert(rowsA == rowsB);
+
+ vnl_matrix<double> M(rowsA,colsA+1);
+ M.update(A,0,0);
+ M.set_column(colsA,B);
+
+ return M;
+}
+
+vnl_matrix<double> vnl_matops::cat(vnl_vector<double> const &A, vnl_matrix<double> const &B) {
+ int rowsA = A.size();
+ int rowsB = B.rows();
+ int colsB = B.columns();
+
+ assert(rowsA == rowsB);
+
+ vnl_matrix<double> M(rowsA,colsB+1);
+ M.set_column(0,A);
+ M.update(B,0,1);
+
+ return M;
+}
+
+vnl_matrix<double> vnl_matops::vcat(vnl_matrix<double> const &A, vnl_matrix<double> const &B) {
+ int rowsA = A.rows();
+ int colsA = A.columns();
+ int rowsB = B.rows();
+ int colsB = B.columns();
+
+ assert(colsA == colsB);
+
+ vnl_matrix<double> M(rowsA+rowsB,colsA);
+ M.update(A,0,0);
+ M.update(B,rowsA,0);
+
+ return M;
+}
+
+extern "C" int dtrans_(double *a, const int& m, const int& n, const int& mn, int* move, const int& iwrk, int* iok);
+
+//: Return fro_norm( (A ./ B) - mean(A ./ B) )
+double vnl_matops::homg_diff(vnl_matrix<double> const& A, vnl_matrix<double> const& B)
+{
+ vnl_matrix<double> ratio = element_quotient(A, B);
+
+ return (ratio - ratio.mean()).fro_norm();
+}
+
+#define implement_converters(U,V) \
+vnl_matrix<U> make_matrix_ ## U(vnl_matrix<V> const& M) \
+{ \
+ unsigned m = M.rows(); \
+ unsigned n = M.columns(); \
+ vnl_matrix<U> ret(m, n); \
+ for (unsigned i = 0; i < m; ++i) \
+ for (unsigned j = 0; j < n; ++j) \
+ ret(i,j) = U(M(i,j)); \
+ return ret; \
+} \
+ \
+vnl_vector<U> make_vector_ ## U(vnl_vector<V> const& v) \
+{ \
+ unsigned n = v.size(); \
+ vnl_vector<U> ret(n); \
+ for (unsigned i = 0; i < n; ++i) \
+ ret[i] = U(v[i]); \
+ return ret; \
+} \
+
+implement_converters(double,float)
+
+implement_converters(float,double)
+
+vnl_matrix<double> vnl_matops::f2d(vnl_matrix<float> const& M)
+{
+ return make_matrix_double(M);
+}
+
+
+vnl_matrix<float> vnl_matops::d2f(vnl_matrix<double> const& M)
+{
+ return make_matrix_float(M);
+}
+
+vnl_vector<double> vnl_matops::f2d(vnl_vector<float> const& M)
+{
+ return make_vector_double(M);
+}
+
+
+vnl_vector<float> vnl_matops::d2f(vnl_vector<double> const& M)
+{
+ return make_vector_float(M);
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.h
new file mode 100644
index 0000000000000000000000000000000000000000..158b9bc01b6de97d4949e9800523838ad9e4114c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matops.h
@@ -0,0 +1,46 @@
+// This is core/vnl/vnl_matops.h
+#ifndef vnl_matops_h_
+#define vnl_matops_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief A collection of Matrix operations
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 05 Aug 96
+//
+// \verbatim
+// Modifications
+// 23 may 97, Peter Vanroose - "NO_COMPLEX" option added
+// LSB (Manchester) 23/3/01 Documentation tidied
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+//: A collection of Matrix operations
+// mostly declared as static methods.
+// Highlights include matrix gluing, and type conversions.
+// matlab_print has been moved to vnl_matlab_print.h.
+class vnl_matops
+{
+ public:
+ static double homg_diff(vnl_matrix<double> const& A, vnl_matrix<double> const& B);
+
+ //: Laminating
+ static vnl_matrix<double> cat(vnl_matrix<double> const& A, vnl_matrix<double> const& B);
+ static vnl_matrix<double> cat(vnl_matrix<double> const& A, vnl_vector<double> const& B);
+ static vnl_matrix<double> cat(vnl_vector<double> const& A, vnl_matrix<double> const& B);
+
+ static vnl_matrix<double> vcat(vnl_matrix<double> const& A, vnl_matrix<double> const& B);
+
+ //: Conversions
+ static vnl_matrix<double> f2d(vnl_matrix<float> const&);
+ static vnl_vector<double> f2d(vnl_vector<float> const&);
+ static vnl_matrix<float> d2f(vnl_matrix<double> const&);
+ static vnl_vector<float> d2f(vnl_vector<double> const&);
+};
+
+#endif // vnl_matops_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..6d606fd08acb8ffded5d6da6eb45cd2fe2b641de
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.h
@@ -0,0 +1,613 @@
+// This is core/vnl/vnl_matrix.h
+#ifndef vnl_matrix_h_
+#define vnl_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief An ordinary mathematical matrix
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_tag.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_config.h>
+#ifndef NDEBUG
+# if VNL_CONFIG_CHECK_BOUNDS
+# include <vnl/vnl_error.h>
+# include <vcl_cassert.h>
+# endif
+#else
+# undef VNL_CONFIG_CHECK_BOUNDS
+# define VNL_CONFIG_CHECK_BOUNDS 0
+# undef ERROR_CHECKING
+#endif
+
+export template <class T> class vnl_vector;
+export template <class T> class vnl_matrix;
+
+//--------------------------------------------------------------------------------
+
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+#define v vnl_vector<T>
+#define m vnl_matrix<T>
+#endif // DOXYGEN_SHOULD_SKIP_THIS
+template <class T> m operator+(T const&, m const&);
+template <class T> m operator-(T const&, m const&);
+template <class T> m operator*(T const&, m const&);
+template <class T> m element_product(m const&, m const&);
+template <class T> m element_quotient(m const&, m const&);
+template <class T> T dot_product(m const&, m const&);
+template <class T> T inner_product(m const&, m const&);
+template <class T> T cos_angle(m const&, m const& );
+template <class T> vcl_ostream& operator<<(vcl_ostream&, m const&);
+template <class T> vcl_istream& operator>>(vcl_istream&, m&);
+#undef v
+#undef m
+
+//--------------------------------------------------------------------------------
+
+enum vnl_matrix_type
+{
+ vnl_matrix_null,
+ vnl_matrix_identity
+};
+
+//: An ordinary mathematical matrix
+// The vnl_matrix<T> class implements two-dimensional arithmetic
+// matrices for a user-specified numeric data type. Using the
+// parameterized types facility of C++, it is possible, for
+// example, for the user to create a matrix of rational numbers
+// by parameterizing the vnl_matrix class over the Rational class.
+// The only requirement for the type is that it supports the
+// basic arithmetic operators.
+//
+// Note: Unlike the other sequence classes, the
+// vnl_matrix<T> class is fixed-size. It will not grow once the
+// size has been specified to the constructor or changed by the
+// assignment or multiplication operators. The vnl_matrix<T>
+// class is row-based with addresses of rows being cached, and
+// elements accessed as m[row][col].
+//
+// Note: The matrix can, however, be resized using the set_size(nr,nc) function.
+//
+// Note: Indexing of the matrix is zero-based, so the top-left element is M(0,0).
+//
+// Note: Inversion of matrix M, and other operations such as solving systems of linear
+// equations are handled by the matrix decomposition classes in vnl/algo, such
+// as matrix_inverse, svd, qr etc.
+//
+// Note: Use a vnl_vector<T> with these matrices.
+
+template<class T>
+class vnl_matrix
+{
+ public:
+ //: Default constructor creates an empty matrix of size 0,0.
+ vnl_matrix() :
+ num_rows(0),
+ num_cols(0),
+ data(0)
+ {
+ }
+
+ //: Construct a matrix of size r rows by c columns
+ // Contents are unspecified.
+ // Complexity $O(1)$
+ vnl_matrix(unsigned r, unsigned c); // r rows, c cols.
+
+ //: Construct a matrix of size r rows by c columns, and all emelemnts equal to v0
+ // Complexity $O(r.c)$
+ vnl_matrix(unsigned r, unsigned c, T const& v0); // r rows, c cols, value v0.
+
+ //: Construct a matrix of size r rows by c columns, with a special type
+ // Contents are specified by t
+ // Complexity $O(r.c)$
+ vnl_matrix(unsigned r, unsigned c, vnl_matrix_type t); // r rows, c cols, special type
+
+ //: Construct a matrix of size r rows by c columns, initialised by an automatic array
+ // The first n elements, are initialised row-wise, to values.
+ // Complexity $O(n)$
+ vnl_matrix(unsigned r, unsigned c, unsigned n, T const values[]); // use automatic arrays.
+
+ //: Construct a matrix of size r rows by c columns, initialised by a memory block
+ // The values are initialise row wise from the data.
+ // Complexity $O(r.c)$
+ vnl_matrix(T const* data_block, unsigned r, unsigned c); // fill row-wise.
+
+ //: Copy construct a matrix
+ // Complexity $O(r.c)$
+ vnl_matrix(vnl_matrix<T> const&); // from another matrix.
+
+#ifndef VXL_DOXYGEN_SHOULD_SKIP_THIS
+// <internal>
+ // These constructors are here so that operator* etc can take
+ // advantage of the C++ return value optimization.
+ vnl_matrix(vnl_matrix<T> const &, vnl_matrix<T> const &, vnl_tag_add); // M + M
+ vnl_matrix(vnl_matrix<T> const &, vnl_matrix<T> const &, vnl_tag_sub); // M - M
+ vnl_matrix(vnl_matrix<T> const &, T, vnl_tag_mul); // M * s
+ vnl_matrix(vnl_matrix<T> const &, T, vnl_tag_div); // M / s
+ vnl_matrix(vnl_matrix<T> const &, T, vnl_tag_add); // M + s
+ vnl_matrix(vnl_matrix<T> const &, T, vnl_tag_sub); // M - s
+ vnl_matrix(vnl_matrix<T> const &, vnl_matrix<T> const &, vnl_tag_mul); // M * M
+ vnl_matrix(vnl_matrix<T> &that, vnl_tag_grab)
+ : num_rows(that.num_rows), num_cols(that.num_cols), data(that.data)
+ { that.num_cols=that.num_rows=0; that.data=0; } // "*this" now uses "that"'s data.
+// </internal>
+#endif
+
+ //: Matrix destructor
+ ~vnl_matrix();
+
+// Basic 2D-Array functionality-------------------------------------------
+
+ //: Return number of rows
+ unsigned rows() const { return num_rows; }
+
+ //: Return number of columns
+ // A synonym for cols()
+ unsigned columns() const { return num_cols; }
+
+ //: Return number of columns
+ // A synonym for columns()
+ unsigned cols() const { return num_cols; }
+
+ //: Return number of elements
+ // This equals rows() * cols()
+ unsigned size() const { return rows()*cols(); }
+
+ //: set element with boundary checks if error checking is on.
+ void put(unsigned r, unsigned c, T const&);
+
+ //: get element with boundary checks if error checking is on.
+ T get(unsigned r, unsigned c) const;
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T * operator[](unsigned r) { return data[r]; }
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T const * operator[](unsigned r) const { return data[r]; }
+
+ //: Access an element for reading or writing
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator()(unsigned r, unsigned c)
+ {
+#if VNL_CONFIG_CHECK_BOUNDS
+ assert(r<rows()); // Check the row index is valid
+ assert(c<cols()); // Check the column index is valid
+#endif
+ return this->data[r][c];
+ }
+
+ //: Access an element for reading
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T const & operator()(unsigned r, unsigned c) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS
+ assert(r<rows()); // Check the row index is valid
+ assert(c<cols()); // Check the column index is valid
+#endif
+ return this->data[r][c];
+ }
+
+
+// Filling and copying------------------------------------------------
+
+ //: Set all elements of matrix to specified value.
+ // Complexity $O(r.c)$
+ void fill(T const&);
+
+ //: Set all diagonal elements of matrix to specified value.
+ // Complexity $O(\min(r,c))$
+ void fill_diagonal(T const&);
+
+ //: Fill (laminate) this matrix with the given data.
+ // We assume that p points to a contiguous rows*cols array, stored rowwise.
+ void copy_in(T const *);
+
+ //: Fill (laminate) this matrix with the given data.
+ // A synonym for copy_in()
+ void set(T const *d) { copy_in(d); }
+
+ //: Fill the given array with this matrix.
+ // We assume that p points to a contiguous rows*cols array, stored rowwise.
+ // No bounds checking on the array.
+ void copy_out(T *) const;
+
+
+ //: Set all elements to value v
+ // Complexity $O(r.c)$
+ vnl_matrix<T>& operator=(T const&v) { fill(v); return *this; }
+
+ //: Copies all elements of rhs matrix into lhs matrix.
+ // Complexity $O(\min(r,c))$
+ vnl_matrix<T>& operator=(vnl_matrix<T> const&);
+
+// Arithmetic ----------------------------------------------------
+ // note that these functions should not pass scalar as a const&.
+ // Look what would happen to A /= A(0,0).
+
+ //: Add rhs to each element of lhs matrix in situ
+ vnl_matrix<T>& operator+=(T value);
+
+ //: Subtract rhs from each element of lhs matrix in situ
+ vnl_matrix<T>& operator-=(T value);
+
+ //: Scalar multiplication in situ of lhs matrix by rhs
+ vnl_matrix<T>& operator*=(T value);
+
+ //: Scalar division of lhs matrix in situ by rhs
+ vnl_matrix<T>& operator/=(T value);
+
+ //: Add rhs to lhs matrix in situ
+ vnl_matrix<T>& operator+=(vnl_matrix<T> const&);
+ //: Subtract rhs from lhs matrix in situ
+ vnl_matrix<T>& operator-=(vnl_matrix<T> const&);
+ //: Multiply lhs matrix in situ by rhs
+ vnl_matrix<T>& operator*=(vnl_matrix<T> const&rhs) { return *this = (*this) * rhs; }
+
+ //: Negate all elements of matrix
+ vnl_matrix<T> operator-() const;
+
+
+ //: Add rhs to each element of lhs matrix and return result in new matrix
+ vnl_matrix<T> operator+(T const& v) const { return vnl_matrix<T>(*this, v, vnl_tag_add()); }
+
+ //: Subtract rhs from each element of lhs matrix and return result in new matrix
+ vnl_matrix<T> operator-(T const& v) const { return vnl_matrix<T>(*this, v, vnl_tag_sub()); }
+
+ //: Scalar multiplication of lhs matrix by rhs and return result in new matrix
+ vnl_matrix<T> operator*(T const& v) const { return vnl_matrix<T>(*this, v, vnl_tag_mul()); }
+
+ //: Scalar division of lhs matrix by rhs and return result in new matrix
+ vnl_matrix<T> operator/(T const& v) const { return vnl_matrix<T>(*this, v, vnl_tag_div()); }
+
+ //: Matrix add rhs to lhs matrix and return result in new matrix
+ vnl_matrix<T> operator+(vnl_matrix<T> const& rhs) const { return vnl_matrix<T>(*this, rhs, vnl_tag_add()); }
+ //: Matrix subtract rhs from lhs and return result in new matrix
+ vnl_matrix<T> operator-(vnl_matrix<T> const& rhs) const { return vnl_matrix<T>(*this, rhs, vnl_tag_sub()); }
+ //: Matrix multiply lhs by rhs matrix and return result in new matrix
+ vnl_matrix<T> operator*(vnl_matrix<T> const& rhs) const { return vnl_matrix<T>(*this, rhs, vnl_tag_mul()); }
+
+ ////--------------------------- Additions ----------------------------
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix<T> apply(T (*f)(T)) const;
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix<T> apply(T (*f)(T const&)) const;
+
+ //: Return transpose
+ vnl_matrix<T> transpose() const;
+
+ //: Return conjugate transpose
+ vnl_matrix<T> conjugate_transpose() const;
+
+ //: Set values of this matrix to those of M, starting at [top,left]
+ vnl_matrix<T>& update(vnl_matrix<T> const&, unsigned top=0, unsigned left=0);
+
+ //: Set the elements of the i'th column to v[j] (No bounds checking)
+ void set_column(unsigned i, T const * v);
+
+ //: Set the elements of the i'th column to value
+ void set_column(unsigned i, T value );
+
+ //: Set j-th column to v
+ void set_column(unsigned j, vnl_vector<T> const& v);
+
+ //: Set columns to those in M, starting at starting_column
+ void set_columns(unsigned starting_column, vnl_matrix<T> const& M);
+
+ //: Set the elements of the i'th row to v[j] (No bounds checking)
+ void set_row(unsigned i, T const * v);
+
+ //: Set the elements of the i'th row to value
+ void set_row(unsigned i, T value );
+
+ //: Set the i-th row
+ void set_row(unsigned i, vnl_vector<T> const&);
+
+ //: Extract a sub-matrix of size r x c, starting at (top,left)
+ // Thus it contains elements [top,top+r-1][left,left+c-1]
+ vnl_matrix<T> extract(unsigned r, unsigned c,
+ unsigned top=0, unsigned left=0) const;
+
+ //: Get a vector equal to the given row
+ vnl_vector<T> get_row(unsigned r) const;
+
+ //: Get a vector equal to the given column
+ vnl_vector<T> get_column(unsigned c) const;
+
+ //: Get n rows beginning at rowstart
+ vnl_matrix<T> get_n_rows(unsigned rowstart, unsigned n) const;
+
+ //: Get n columns beginning at colstart
+ vnl_matrix<T> get_n_columns(unsigned colstart, unsigned n) const;
+
+ // mutators
+
+ //: Set this matrix to an identity matrix
+ // Abort if the matrix is not square
+ void set_identity();
+
+ //: Transpose this matrix efficiently
+ void inplace_transpose();
+
+ //: Reverse order of rows.
+ void flipud();
+ //: Reverse order of columns.
+ void fliplr();
+
+ //: Normalize each row so it is a unit vector
+ // Zero rows are ignored
+ void normalize_rows();
+
+ //: Normalize each column so it is a unit vector
+ // Zero columns are ignored
+ void normalize_columns();
+
+ //: Scale elements in given row by a factor of T
+ void scale_row(unsigned row, T value);
+
+ //: Scale elements in given column by a factor of T
+ void scale_column(unsigned col, T value);
+
+ //: Swap this matrix with that matrix
+ void swap(vnl_matrix<T> & that);
+
+ //: Type def for norms.
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of absolute values of elements
+ abs_t array_one_norm() const { return vnl_c_vector<T>::one_norm(begin(), size()); }
+
+ //: Return square root of sum of squared absolute element values
+ abs_t array_two_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return largest absolute element value
+ abs_t array_inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), size()); }
+
+ //: Return sum of absolute values of elements
+ abs_t absolute_value_sum() const { return array_one_norm(); }
+
+ //: Return largest absolute value
+ abs_t absolute_value_max() const { return array_inf_norm(); }
+
+ // $ || M ||_1 := \max_j \sum_i | M_{ij} | $
+ abs_t operator_one_norm() const;
+
+ // $ || M ||_\inf := \max_i \sum_j | M_{ij} | $
+ abs_t operator_inf_norm() const;
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t frobenius_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t fro_norm() const { return frobenius_norm(); }
+
+ //: Return RMS of all elements
+ abs_t rms() const { return vnl_c_vector<T>::rms_norm(begin(), size()); }
+
+ //: Return minimum value of elements
+ T min_value() const { return vnl_c_vector<T>::min_value(begin(), size()); }
+
+ //: Return maximum value of elements
+ T max_value() const { return vnl_c_vector<T>::max_value(begin(), size()); }
+
+ //: Return mean of all matrix elements
+ T mean() const { return vnl_c_vector<T>::mean(begin(), size()); }
+
+ // predicates
+
+ //: Return true iff the size is zero.
+ bool empty() const { return !data || !num_rows || !num_cols; }
+
+ //: Return true if all elements equal to identity.
+ bool is_identity() const;
+
+ //: Return true if all elements equal to identity, within given tolerance
+ bool is_identity(double tol) const;
+
+ //: Return true if all elements equal to zero.
+ bool is_zero() const;
+
+ //: Return true if all elements equal to zero, within given tolerance
+ bool is_zero(double tol) const;
+
+ //: Return true if finite
+ bool is_finite() const;
+
+ //: Return true if matrix contains NaNs
+ bool has_nans() const;
+
+ //: abort if size is not as expected
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size(unsigned r, unsigned c) const
+ {
+#ifndef NDEBUG
+ assert_size_internal(r, c);
+#endif
+ }
+ //: abort if matrix contains any INFs or NANs.
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const
+ {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ ////----------------------- Input/Output ----------------------------
+
+ //: Read a vnl_matrix from an ascii vcl_istream, automatically determining file size if the input matrix has zero size.
+ static vnl_matrix<T> read(vcl_istream& s);
+
+ // : Read a vnl_matrix from an ascii vcl_istream, automatically determining file size if the input matrix has zero size.
+ bool read_ascii(vcl_istream& s);
+
+ //--------------------------------------------------------------------------------
+
+ //: Access the contiguous block storing the elements in the matrix row-wise. O(1).
+ // 1d array, row-major order.
+ T const* data_block() const { return data[0]; }
+
+ //: Access the contiguous block storing the elements in the matrix row-wise. O(1).
+ // 1d array, row-major order.
+ T * data_block() { return data[0]; }
+
+ //: Access the 2D array, so that elements can be accessed with array[row][col] directly.
+ // 2d array, [row][column].
+ T const* const* data_array() const { return data; }
+
+ //: Access the 2D array, so that elements can be accessed with array[row][col] directly.
+ // 2d array, [row][column].
+ T * * data_array() { return data; }
+
+ typedef T element_type;
+
+ //: Iterators
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() { return data?data[0]:0; }
+ //: Iterator pointing to element beyond end of data
+ iterator end() { return data?data[0]+num_rows*num_cols:0; }
+
+ //: Const iterators
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data?data[0]:0; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return data?data[0]+num_rows*num_cols:0; }
+
+ //: Return a reference to this.
+ // Useful in code which would prefer not to know if its argument
+ // is a matrix, matrix_ref or a matrix_fixed. Note that it doesn't
+ // return a matrix_ref, so it's only useful in templates or macros.
+ vnl_matrix<T> const& as_ref() const { return *this; }
+
+ //: Return a reference to this.
+ vnl_matrix<T>& as_ref() { return *this; }
+
+ //--------------------------------------------------------------------------------
+
+ //: Return true if *this == rhs
+ bool operator_eq(vnl_matrix<T> const & rhs) const;
+
+ //: Equality operator
+ bool operator==(vnl_matrix<T> const &that) const { return this->operator_eq(that); }
+
+ //: Inequality operator
+ bool operator!=(vnl_matrix<T> const &that) const { return !this->operator_eq(that); }
+
+ //: Print matrix to os in some hopefully sensible format
+ void print(vcl_ostream& os) const;
+
+ //: Make the matrix as if it had been default-constructed.
+ void clear();
+
+ //: Resize to r rows by c columns. Old data lost.
+ // Returns true if size changed.
+ bool set_size(unsigned r, unsigned c);
+
+//--------------------------------------------------------------------------------
+
+ protected:
+ unsigned num_rows; // Number of rows
+ unsigned num_cols; // Number of columns
+ T** data; // Pointer to the vnl_matrix
+
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ // Since this bug exists, we need a flag that can be set during
+ // construction to tell our destructor whether we own data.
+ char vnl_matrix_own_data;
+#endif
+
+ void assert_size_internal(unsigned r, unsigned c) const;
+ void assert_finite_internal() const;
+
+ //: Delete data
+ void destroy();
+
+#if VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+# define v vnl_vector<T>
+# define m vnl_matrix<T>
+ friend m operator+ VCL_NULL_TMPL_ARGS (T const&, m const&);
+ friend m operator- VCL_NULL_TMPL_ARGS (T const&, m const&);
+ friend m operator* VCL_NULL_TMPL_ARGS (T const&, m const&);
+ friend m element_product VCL_NULL_TMPL_ARGS (m const&, m const&);
+ friend m element_quotient VCL_NULL_TMPL_ARGS (m const&, m const&);
+ friend T dot_product VCL_NULL_TMPL_ARGS (m const&, m const&);
+ friend T inner_product VCL_NULL_TMPL_ARGS (m const&, m const&);
+ friend T cos_angle VCL_NULL_TMPL_ARGS (m const&, m const&);
+ friend vcl_ostream& operator<< VCL_NULL_TMPL_ARGS (vcl_ostream&, m const&);
+ friend vcl_istream& operator>> VCL_NULL_TMPL_ARGS (vcl_istream&, m&);
+# undef v
+# undef m
+#endif
+
+ // inline function template instantiation hack for gcc 2.97 -- fsm
+ static void inline_function_tickler();
+};
+
+
+// Definitions of inline functions.
+
+
+//: Returns the value of the element at specified row and column. O(1).
+// Checks for valid range of indices.
+
+template<class T>
+inline T vnl_matrix<T>::get(unsigned row, unsigned column) const
+{
+#ifdef ERROR_CHECKING
+ if (row >= this->num_rows) // If invalid size specified
+ vnl_error_matrix_row_index("get", row); // Raise exception
+ if (column >= this->num_cols) // If invalid size specified
+ vnl_error_matrix_col_index("get", column); // Raise exception
+#endif
+ return this->data[row][column];
+}
+
+//: Puts value into element at specified row and column. O(1).
+// Checks for valid range of indices.
+
+template<class T>
+inline void vnl_matrix<T>::put(unsigned row, unsigned column, T const& value)
+{
+#ifdef ERROR_CHECKING
+ if (row >= this->num_rows) // If invalid size specified
+ vnl_error_matrix_row_index("put", row); // Raise exception
+ if (column >= this->num_cols) // If invalid size specified
+ vnl_error_matrix_col_index("put", column); // Raise exception
+#endif
+ this->data[row][column] = value; // Assign data value
+}
+
+
+// non-member arithmetical operators.
+
+//:
+// \relates vnl_matrix
+template<class T>
+inline vnl_matrix<T> operator*(T const& value, vnl_matrix<T> const& m)
+{
+ return vnl_matrix<T>(m, value, vnl_tag_mul());
+}
+
+//:
+// \relates vnl_matrix
+template<class T>
+inline vnl_matrix<T> operator+(T const& value, vnl_matrix<T> const& m)
+{
+ return vnl_matrix<T>(m, value, vnl_tag_add());
+}
+
+//: Swap two matrices
+// \relates vnl_matrix
+template<class T>
+inline void swap(vnl_matrix<T> &A, vnl_matrix<T> &B) { A.swap(B); }
+
+
+#endif // vnl_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..28ec49655e5406b11c59116c53a7f32daa845c80
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix.txx
@@ -0,0 +1,1590 @@
+// This is core/vnl/vnl_matrix.txx
+#ifndef vnl_matrix_txx_
+#define vnl_matrix_txx_
+//:
+// \file
+//
+// Copyright (C) 1991 Texas Instruments Incorporated.
+// Copyright (C) 1992 General Electric Company.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated, General Electric Company,
+// provides this software "as is" without express or implied warranty.
+//
+// Created: MBN 04/21/89 Initial design and implementation
+// Updated: MBN 06/22/89 Removed non-destructive methods
+// Updated: LGO 08/09/89 Inherit from Generic
+// Updated: MBN 08/20/89 Changed template usage to reflect new syntax
+// Updated: MBN 09/11/89 Added conditional exception handling and base class
+// Updated: LGO 10/05/89 Don't re-allocate data in operator= when same size
+// Updated: LGO 10/19/89 Add extra parameter to varargs constructor
+// Updated: MBN 10/19/89 Added optional argument to set_compare method
+// Updated: LGO 12/08/89 Allocate column data in one chunk
+// Updated: LGO 12/08/89 Clean-up get and put, add const everywhere.
+// Updated: LGO 12/19/89 Remove the map and reduce methods
+// Updated: MBN 02/22/90 Changed size arguments from int to unsigned int
+// Updated: MJF 06/30/90 Added base class name to constructor initializer
+// Updated: VDN 02/21/92 New lite version
+// Updated: VDN 05/05/92 Use envelope to avoid unnecessary copying
+// Updated: VDN 09/30/92 Matrix inversion with singular value decomposition
+// Updated: AWF 08/21/96 set_identity, normalize_rows, scale_row.
+// Updated: AWF 09/30/96 set_row/set_column methods. Const-correct data_block().
+// Updated: AWF 14/02/97 get_n_rows, get_n_columns.
+// Updated: PVR 20/03/97 get_row, get_column.
+//
+// The parameterized vnl_matrix<T> class implements two dimensional arithmetic
+// matrices of a user specified type. The only constraint placed on the type is
+// that it must overload the following operators: +, -, *, and /. Thus, it
+// will be possible to have a vnl_matrix over vcl_complex<T>. The vnl_matrix<T>
+// class is static in size, that is once a vnl_matrix<T> of a particular size
+// has been created, there is no dynamic growth method available. You can
+// resize the matrix, with the loss of any existing data using set_size().
+//
+// Each matrix contains a protected data section that has a T** slot that
+// points to the physical memory allocated for the two dimensional array. In
+// addition, two integers specify the number of rows and columns for the
+// matrix. These values are provided in the constructors. A single protected
+// slot contains a pointer to a compare function to be used in equality
+// operations. The default function used is the built-in == operator.
+//
+// Four different constructors are provided. The first constructor takes two
+// integer arguments specifying the row and column size. Enough memory is
+// allocated to hold row*column elements of type Type. The second constructor
+// takes the same two first arguments, but also accepts an additional third
+// argument that is a reference to an object of the appropriate type whose
+// value is used as an initial fill value. The third constructor is similar to
+// the third, except that it accepts a variable number of initialization values
+// for the Matrix. If there are fewer values than elements, the rest are set
+// to zero. Finally, the last constructor takes a single argument consisting of
+// a reference to a Matrix and duplicates its size and element values.
+//
+// Methods are provided for destructive scalar and Matrix addition,
+// multiplication, check for equality and inequality, fill, reduce, and access
+// and set individual elements. Finally, both the input and output operators
+// are overloaded to allow for formatted input and output of matrix elements.
+//
+// Good matrix inversion is needed. We choose singular value decomposition,
+// since it is general and works great for nearly singular cases. Singular
+// value decomposition is preferred to LU decomposition, since the accuracy
+// of the pivots is independent from the left->right top->down elimination.
+// LU decomposition also does not give eigenvectors and eigenvalues when
+// the matrix is symmetric.
+//
+// Several different constructors are provided. See .h file for brief descriptions.
+
+//--------------------------------------------------------------------------------
+
+#include "vnl_matrix.h"
+
+#include <vcl_cassert.h>
+#include <vcl_cstdlib.h> // abort()
+#include <vcl_cctype.h> // isspace()
+#include <vcl_iostream.h>
+#include <vcl_vector.h>
+#include <vcl_algorithm.h>
+
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_numeric_traits.h>
+//--------------------------------------------------------------------------------
+
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+// vnl_matrix owns its data by default.
+# define vnl_matrix_construct_hack() vnl_matrix_own_data = 1
+#else
+# define vnl_matrix_construct_hack()
+#endif
+
+// This macro allocates and initializes the dynamic storage used by a vnl_matrix.
+#define vnl_matrix_alloc_blah(rowz_, colz_) \
+do { \
+ this->num_rows = (rowz_); \
+ this->num_cols = (colz_); \
+ if (this->num_rows && this->num_cols) { \
+ /* Allocate memory to hold the row pointers */ \
+ this->data = vnl_c_vector<T>::allocate_Tptr(this->num_rows); \
+ /* Allocate memory to hold the elements of the matrix */ \
+ T* elmns = vnl_c_vector<T>::allocate_T(this->num_rows * this->num_cols); \
+ /* Fill in the array of row pointers */ \
+ for (unsigned int i = 0; i < this->num_rows; ++ i) \
+ this->data[i] = elmns + i*this->num_cols; \
+ } \
+ else { \
+ /* This is to make sure .begin() and .end() work for 0xN matrices: */ \
+ (this->data = vnl_c_vector<T>::allocate_Tptr(1))[0] = 0; \
+ } \
+} while (false)
+
+// This macro releases the dynamic storage used by a vnl_matrix.
+#define vnl_matrix_free_blah \
+do { \
+ if (this->data) { \
+ if (this->num_cols && this->num_rows) { \
+ vnl_c_vector<T>::deallocate(this->data[0], this->num_cols * this->num_rows); \
+ vnl_c_vector<T>::deallocate(this->data, this->num_rows); \
+ } else { \
+ vnl_c_vector<T>::deallocate(this->data, 1); \
+ } \
+ } \
+} while (false)
+
+//: Creates a matrix with given number of rows and columns.
+// Elements are not initialized. O(m*n).
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (unsigned rowz, unsigned colz)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(rowz, colz);
+}
+
+//: Creates a matrix with given number of rows and columns, and initialize all elements to value. O(m*n).
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (unsigned rowz, unsigned colz, T const& value)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(rowz, colz);
+ for (unsigned int i = 0; i < rowz; ++ i)
+ for (unsigned int j = 0; j < colz; ++ j)
+ this->data[i][j] = value;
+}
+
+//: r rows, c cols, special type. Currently implements "identity".
+template <class T>
+vnl_matrix<T>::vnl_matrix(unsigned r, unsigned c, vnl_matrix_type t)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(r, c);
+ if (t == vnl_matrix_identity) {
+ assert(r == c);
+ for (unsigned int i = 0; i < r; ++ i)
+ for (unsigned int j = 0; j < c; ++ j)
+ this->data[i][j] = (i==j) ? T(1) : T(0);
+ }
+}
+
+#if 1 // fsm: who uses this?
+//: Creates a matrix with given dimension (rows, cols) and initialize first n elements, row-wise, to values. O(m*n).
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (unsigned rowz, unsigned colz, unsigned n, T const values[])
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(rowz, colz);
+ if (n > rowz*colz)
+ n = rowz*colz;
+ T *dst = this->data[0];
+ for (unsigned k=0; k<n; ++k)
+ dst[k] = values[k];
+}
+#endif
+
+//: Creates a matrix from a block array of data, stored row-wise.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (T const* datablck, unsigned rowz, unsigned colz)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(rowz, colz);
+ unsigned int n = rowz*colz;
+ T *dst = this->data[0];
+ for (unsigned int k=0; k<n; ++k)
+ dst[k] = datablck[k];
+}
+
+
+//: Creates a new matrix and copies all the elements.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const& from)
+{
+ vnl_matrix_construct_hack();
+ if (from.data) {
+ vnl_matrix_alloc_blah(from.num_rows, from.num_cols);
+ unsigned int n = this->num_rows * this->num_cols;
+ T *dst = this->data[0];
+ T const *src = from.data[0];
+ for (unsigned int k=0; k<n; ++k)
+ dst[k] = src[k];
+ }
+ else {
+ num_rows = 0;
+ num_cols = 0;
+ data = 0;
+ }
+}
+
+//------------------------------------------------------------
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &A, vnl_matrix<T> const &B, vnl_tag_add)
+{
+#ifndef NDEBUG
+ if (A.num_rows != B.num_rows || A.num_cols != B.num_cols)
+ vnl_error_matrix_dimension ("vnl_tag_add", A.num_rows, A.num_cols, B.num_rows, B.num_cols);
+#endif
+
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(A.num_rows, A.num_cols);
+
+ unsigned int n = A.num_rows * A.num_cols;
+ T const *a = A.data[0];
+ T const *b = B.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = a[i] + b[i];
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &A, vnl_matrix<T> const &B, vnl_tag_sub)
+{
+#ifndef NDEBUG
+ if (A.num_rows != B.num_rows || A.num_cols != B.num_cols)
+ vnl_error_matrix_dimension ("vnl_tag_sub", A.num_rows, A.num_cols, B.num_rows, B.num_cols);
+#endif
+
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(A.num_rows, A.num_cols);
+
+ unsigned int n = A.num_rows * A.num_cols;
+ T const *a = A.data[0];
+ T const *b = B.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = a[i] - b[i];
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &M, T s, vnl_tag_mul)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(M.num_rows, M.num_cols);
+
+ unsigned int n = M.num_rows * M.num_cols;
+ T const *m = M.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = m[i] * s;
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &M, T s, vnl_tag_div)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(M.num_rows, M.num_cols);
+
+ unsigned int n = M.num_rows * M.num_cols;
+ T const *m = M.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = m[i] / s;
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &M, T s, vnl_tag_add)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(M.num_rows, M.num_cols);
+
+ unsigned int n = M.num_rows * M.num_cols;
+ T const *m = M.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = m[i] + s;
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &M, T s, vnl_tag_sub)
+{
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(M.num_rows, M.num_cols);
+
+ unsigned int n = M.num_rows * M.num_cols;
+ T const *m = M.data[0];
+ T *dst = this->data[0];
+
+ for (unsigned int i=0; i<n; ++i)
+ dst[i] = m[i] - s;
+}
+
+template<class T>
+vnl_matrix<T>::vnl_matrix (vnl_matrix<T> const &A, vnl_matrix<T> const &B, vnl_tag_mul)
+{
+#ifndef NDEBUG
+ if (A.num_cols != B.num_rows)
+ vnl_error_matrix_dimension("vnl_tag_mul", A.num_rows, A.num_cols, B.num_rows, B.num_cols);
+#endif
+
+ unsigned int l = A.num_rows;
+ unsigned int m = A.num_cols; // == B.num_rows
+ unsigned int n = B.num_cols;
+
+ vnl_matrix_construct_hack();
+ vnl_matrix_alloc_blah(l, n);
+
+ for (unsigned int i=0; i<l; ++i) {
+ for (unsigned int k=0; k<n; ++k) {
+ T sum(0);
+ for (unsigned int j=0; j<m; ++j)
+ sum += A.data[i][j] * B.data[j][k];
+ this->data[i][k] = sum;
+ }
+ }
+}
+
+//------------------------------------------------------------
+
+template<class T>
+vnl_matrix<T>::~vnl_matrix()
+{
+ // save some fcalls if data is 0 (i.e. in matrix_fixed)
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ if (data && vnl_matrix_own_data) destroy();
+#else
+ if (data) destroy();
+#endif
+}
+
+//: Frees up the dynamic storage used by matrix.
+// O(m*n).
+
+template<class T>
+void vnl_matrix<T>::destroy()
+{
+ vnl_matrix_free_blah;
+}
+
+template<class T>
+void vnl_matrix<T>::clear()
+{
+ if (data) {
+ destroy();
+ num_rows = 0;
+ num_cols = 0;
+ data = 0;
+ }
+}
+
+// Resizes the data arrays of THIS matrix to (rows x cols). O(m*n).
+// Elements are not initialized, existing data is not preserved.
+// Returns true if size is changed.
+
+template<class T>
+bool vnl_matrix<T>::set_size (unsigned rowz, unsigned colz)
+{
+ if (this->data) {
+ // if no change in size, do not reallocate.
+ if (this->num_rows == rowz && this->num_cols == colz)
+ return false;
+
+ // else, simply release old storage and allocate new.
+ vnl_matrix_free_blah;
+ vnl_matrix_alloc_blah(rowz, colz);
+ }
+ else {
+ // This happens if the matrix is default constructed.
+ vnl_matrix_alloc_blah(rowz, colz);
+ }
+
+ return true;
+}
+
+#undef vnl_matrix_alloc_blah
+#undef vnl_matrix_free_blah
+
+//------------------------------------------------------------
+
+//: Sets all elements of matrix to specified value. O(m*n).
+
+template<class T>
+void vnl_matrix<T>::fill (T const& value)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] = value;
+}
+
+//: Sets all diagonal elements of matrix to specified value. O(n).
+
+template<class T>
+void vnl_matrix<T>::fill_diagonal (T const& value)
+{
+ for (unsigned int i = 0; i < this->num_rows && i < this->num_cols; i++)
+ this->data[i][i] = value;
+}
+
+#if 0
+//: Assigns value to all elements of a matrix. O(m*n).
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator= (T const& value)
+{
+ for (unsigned i = 0; i < this->num_rows; i++) // For each row in Matrix
+ for (unsigned j = 0; j < this->num_cols; j++) // For each column in Matrix
+ this->data[i][j] = value; // Assign value
+ return *this; // Return Matrix reference
+}
+#endif // 0
+
+//: Copies all elements of rhs matrix into lhs matrix. O(m*n).
+// If needed, the arrays in lhs matrix are freed up, and new arrays are
+// allocated to match the dimensions of the rhs matrix.
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator= (vnl_matrix<T> const& rhs)
+{
+ if (this != &rhs) { // make sure *this != m
+ if (rhs.data) {
+ this->set_size(rhs.num_rows, rhs.num_cols);
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] = rhs.data[i][j];
+ }
+ else {
+ // rhs is default-constructed.
+ clear();
+ }
+ }
+ return *this;
+}
+
+template<class T>
+void vnl_matrix<T>::print(vcl_ostream& os) const
+{
+ for (unsigned int i = 0; i < this->rows(); i++) {
+ for (unsigned int j = 0; j < this->columns(); j++)
+ os << this->data[i][j] << ' ';
+ os << '\n';
+ }
+}
+
+//: Prints the 2D array of elements of a matrix out to a stream.
+// O(m*n).
+
+template<class T>
+vcl_ostream& operator<< (vcl_ostream& os, vnl_matrix<T> const& m)
+{
+ for (unsigned int i = 0; i < m.rows(); ++i) {
+ for (unsigned int j = 0; j < m.columns(); ++j)
+ os << m(i, j) << ' ';
+ os << '\n';
+ }
+ return os;
+}
+
+//: Read an vnl_matrix from an ascii vcl_istream.
+// Automatically determines file size if the input matrix has zero size.
+template<class T>
+vcl_istream& operator>>(vcl_istream& s, vnl_matrix<T>& M)
+{
+ M.read_ascii(s);
+ return s;
+}
+
+template<class T>
+void vnl_matrix<T>::inline_function_tickler()
+{
+ vnl_matrix<T> M;
+ // fsm: hack to get 2.96 to instantiate the inline function.
+ M = T(1) + T(3) * M;
+}
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator+= (T value)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] += value;
+ return *this;
+}
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator-= (T value)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] -= value;
+ return *this;
+}
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator*= (T value)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] *= value;
+ return *this;
+}
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator/= (T value)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] /= value;
+ return *this;
+}
+
+
+//: Adds lhs matrix with rhs matrix, and stores in place in lhs matrix.
+// O(m*n). The dimensions of the two matrices must be identical.
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator+= (vnl_matrix<T> const& rhs)
+{
+#ifndef NDEBUG
+ if (this->num_rows != rhs.num_rows ||
+ this->num_cols != rhs.num_cols) // Size match?
+ vnl_error_matrix_dimension ("operator+=",
+ this->num_rows, this->num_cols,
+ rhs.num_rows, rhs.num_cols);
+#endif
+ for (unsigned int i = 0; i < this->num_rows; i++) // For each row
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in column
+ this->data[i][j] += rhs.data[i][j]; // Add elements
+ return *this;
+}
+
+
+//: Subtract lhs matrix with rhs matrix and store in place in lhs matrix.
+// O(m*n).
+// The dimensions of the two matrices must be identical.
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::operator-= (vnl_matrix<T> const& rhs)
+{
+#ifndef NDEBUG
+ if (this->num_rows != rhs.num_rows ||
+ this->num_cols != rhs.num_cols) // Size?
+ vnl_error_matrix_dimension ("operator-=",
+ this->num_rows, this->num_cols,
+ rhs.num_rows, rhs.num_cols);
+#endif
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] -= rhs.data[i][j];
+ return *this;
+}
+
+
+template<class T>
+vnl_matrix<T> operator- (T const& value, vnl_matrix<T> const& m)
+{
+ vnl_matrix<T> result(m.rows(),m.columns());
+ for (unsigned int i = 0; i < m.rows(); i++) // For each row
+ for (unsigned int j = 0; j < m.columns(); j++) // For each element in column
+ result.put(i,j, value - m.get(i,j) ); // subtract from value element.
+ return result;
+}
+
+
+#if 0 // commented out
+//: Returns new matrix which is the product of m1 with m2, m1 * m2.
+// O(n^3). Number of columns of first matrix must match number of rows
+// of second matrix.
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::operator* (vnl_matrix<T> const& rhs) const
+{
+#ifndef NDEBUG
+ if (this->num_cols != rhs.num_rows) // dimensions do not match?
+ vnl_error_matrix_dimension("operator*",
+ this->num_rows, this->num_cols,
+ rhs.num_rows, rhs.num_cols);
+#endif
+ vnl_matrix<T> result(this->num_rows, rhs.num_cols); // Temp to store product
+ for (unsigned i = 0; i < this->num_rows; i++) { // For each row
+ for (unsigned j = 0; j < rhs.num_cols; j++) { // For each element in column
+ T sum = 0;
+ for (unsigned k = 0; k < this->num_cols; k++) // Loop over column values
+ sum += (this->data[i][k] * rhs.data[k][j]); // Multiply
+ result(i,j) = sum;
+ }
+ }
+ return result;
+}
+#endif
+
+//: Returns new matrix which is the negation of THIS matrix.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::operator- () const
+{
+ vnl_matrix<T> result(this->num_rows, this->num_cols);
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ result.data[i][j] = - this->data[i][j];
+ return result;
+}
+
+#if 0 // commented out
+//: Returns new matrix with elements of lhs matrix added with value.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::operator+ (T const& value) const
+{
+ vnl_matrix<T> result(this->num_rows, this->num_cols);
+ for (unsigned i = 0; i < this->num_rows; i++) // For each row
+ for (unsigned j = 0; j < this->num_cols; j++) // For each element in column
+ result.data[i][j] = (this->data[i][j] + value); // Add scalar
+ return result;
+}
+
+
+//: Returns new matrix with elements of lhs matrix multiplied with value.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::operator* (T const& value) const
+{
+ vnl_matrix<T> result(this->num_rows, this->num_cols);
+ for (unsigned i = 0; i < this->num_rows; i++) // For each row
+ for (unsigned j = 0; j < this->num_cols; j++) // For each element in column
+ result.data[i][j] = (this->data[i][j] * value); // Multiply
+ return result;
+}
+
+
+//: Returns new matrix with elements of lhs matrix divided by value. O(m*n).
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::operator/ (T const& value) const
+{
+ vnl_matrix<T> result(this->num_rows, this->num_cols);
+ for (unsigned i = 0; i < this->num_rows; i++) // For each row
+ for (unsigned j = 0; j < this->num_cols; j++) // For each element in column
+ result.data[i][j] = (this->data[i][j] / value); // Divide
+ return result;
+}
+#endif
+
+//: Return the matrix made by applying "f" to each element.
+template <class T>
+vnl_matrix<T> vnl_matrix<T>::apply(T (*f)(T const&)) const
+{
+ vnl_matrix<T> ret(num_rows, num_cols);
+ vnl_c_vector<T>::apply(this->data[0], num_rows * num_cols, f, ret.data_block());
+ return ret;
+}
+
+//: Return the matrix made by applying "f" to each element.
+template <class T>
+vnl_matrix<T> vnl_matrix<T>::apply(T (*f)(T)) const
+{
+ vnl_matrix<T> ret(num_rows, num_cols);
+ vnl_c_vector<T>::apply(this->data[0], num_rows * num_cols, f, ret.data_block());
+ return ret;
+}
+
+////--------------------------- Additions------------------------------------
+
+//: Returns new matrix with rows and columns transposed.
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::transpose() const
+{
+ vnl_matrix<T> result(this->num_cols, this->num_rows);
+ for (unsigned int i = 0; i < this->num_cols; i++)
+ for (unsigned int j = 0; j < this->num_rows; j++)
+ result.data[i][j] = this->data[j][i];
+ return result;
+}
+
+// adjoint/hermitian transpose
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::conjugate_transpose() const
+{
+ vnl_matrix<T> result(transpose());
+ vnl_c_vector<T>::conjugate(result.begin(), // src
+ result.begin(), // dst
+ result.size()); // size of block
+ return result;
+}
+
+//: Replaces the submatrix of THIS matrix, starting at top left corner, by the elements of matrix m. O(m*n).
+// This is the reverse of extract().
+
+template<class T>
+vnl_matrix<T>& vnl_matrix<T>::update (vnl_matrix<T> const& m,
+ unsigned top, unsigned left)
+{
+ unsigned int bottom = top + m.num_rows;
+ unsigned int right = left + m.num_cols;
+#ifndef NDEBUG
+ if (this->num_rows < bottom || this->num_cols < right)
+ vnl_error_matrix_dimension ("update",
+ bottom, right, m.num_rows, m.num_cols);
+#endif
+ for (unsigned int i = top; i < bottom; i++)
+ for (unsigned int j = left; j < right; j++)
+ this->data[i][j] = m.data[i-top][j-left];
+ return *this;
+}
+
+
+//: Returns a copy of submatrix of THIS matrix, specified by the top-left corner and size in rows, cols. O(m*n).
+// Use update() to copy new values of this submatrix back into THIS matrix.
+
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::extract (unsigned rowz, unsigned colz,
+ unsigned top, unsigned left) const{
+#ifndef NDEBUG
+ unsigned int bottom = top + rowz;
+ unsigned int right = left + colz;
+ if ((this->num_rows < bottom) || (this->num_cols < right))
+ vnl_error_matrix_dimension ("extract",
+ this->num_rows, this->num_cols, bottom, right);
+#endif
+ vnl_matrix<T> result(rowz, colz);
+ for (unsigned int i = 0; i < rowz; i++) // actual copy of all elements
+ for (unsigned int j = 0; j < colz; j++) // in submatrix
+ result.data[i][j] = data[top+i][left+j];
+ return result;
+}
+
+//: Returns the dot product of the two matrices. O(m*n).
+// This is the sum of all pairwise products of the elements m1[i,j]*m2[i,j].
+
+template<class T>
+T dot_product (vnl_matrix<T> const& m1, vnl_matrix<T> const& m2)
+{
+#ifndef NDEBUG
+ if (m1.rows() != m2.rows() || m1.columns() != m2.columns()) // Size?
+ vnl_error_matrix_dimension ("dot_product",
+ m1.rows(), m1.columns(),
+ m2.rows(), m2.columns());
+#endif
+ return vnl_c_vector<T>::dot_product(m1.begin(), m2.begin(), m1.rows()*m1.cols());
+}
+
+//: Hermitian inner product.
+// O(mn).
+
+template<class T>
+T inner_product (vnl_matrix<T> const& m1, vnl_matrix<T> const& m2)
+{
+#ifndef NDEBUG
+ if (m1.rows() != m2.rows() || m1.columns() != m2.columns()) // Size?
+ vnl_error_matrix_dimension ("inner_product",
+ m1.rows(), m1.columns(),
+ m2.rows(), m2.columns());
+#endif
+ return vnl_c_vector<T>::inner_product(m1.begin(), m2.begin(), m1.rows()*m1.cols());
+}
+
+// cos_angle. O(mn).
+
+template<class T>
+T cos_angle (vnl_matrix<T> const& a, vnl_matrix<T> const& b)
+{
+ typedef typename vnl_numeric_traits<T>::real_t real_t;
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<abs_t>::real_t abs_r;
+
+ T ab = inner_product(a,b);
+ abs_t a_b = (abs_t)vcl_sqrt( (abs_r)vnl_math_abs(inner_product(a,a) * inner_product(b,b)) );
+
+ return T( ab / a_b);
+}
+
+//: Returns new matrix whose elements are the products m1[ij]*m2[ij].
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> element_product (vnl_matrix<T> const& m1,
+ vnl_matrix<T> const& m2)
+{
+#ifndef NDEBUG
+ if (m1.rows() != m2.rows() || m1.columns() != m2.columns()) // Size?
+ vnl_error_matrix_dimension ("element_product",
+ m1.rows(), m1.columns(), m2.rows(), m2.columns());
+#endif
+ vnl_matrix<T> result(m1.rows(), m1.columns());
+ for (unsigned int i = 0; i < m1.rows(); i++)
+ for (unsigned int j = 0; j < m1.columns(); j++)
+ result.put(i,j, m1.get(i,j) * m2.get(i,j) );
+ return result;
+}
+
+//: Returns new matrix whose elements are the quotients m1[ij]/m2[ij].
+// O(m*n).
+
+template<class T>
+vnl_matrix<T> element_quotient (vnl_matrix<T> const& m1,
+ vnl_matrix<T> const& m2)
+{
+#ifndef NDEBUG
+ if (m1.rows() != m2.rows() || m1.columns() != m2.columns()) // Size?
+ vnl_error_matrix_dimension("element_quotient",
+ m1.rows(), m1.columns(), m2.rows(), m2.columns());
+#endif
+ vnl_matrix<T> result(m1.rows(), m1.columns());
+ for (unsigned int i = 0; i < m1.rows(); i++)
+ for (unsigned int j = 0; j < m1.columns(); j++)
+ result.put(i,j, m1.get(i,j) / m2.get(i,j) );
+ return result;
+}
+
+//: Fill this matrix with the given data.
+// We assume that p points to a contiguous rows*cols array, stored rowwise.
+template<class T>
+void vnl_matrix<T>::copy_in(T const *p)
+{
+ T* dp = this->data[0];
+ unsigned int n = this->num_rows * this->num_cols;
+ while (n--)
+ *dp++ = *p++;
+}
+
+//: Fill the given array with this matrix.
+// We assume that p points to a contiguous rows*cols array, stored rowwise.
+template<class T>
+void vnl_matrix<T>::copy_out(T *p) const
+{
+ T* dp = this->data[0];
+ unsigned int n = this->num_rows * this->num_cols;
+ while (n--)
+ *p++ = *dp++;
+}
+
+//: Fill this matrix with a row*row identity matrix.
+template<class T>
+void vnl_matrix<T>::set_identity()
+{
+#ifndef NDEBUG
+ if (this->num_rows != this->num_cols) // Size?
+ vnl_error_matrix_nonsquare ("set_identity");
+#endif
+ for (unsigned int i = 0; i < this->num_rows; i++) // For each row in the Matrix
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in column
+ if (i == j)
+ this->data[i][j] = T(1);
+ else
+ this->data[i][j] = T(0);
+}
+
+//: Make each row of the matrix have unit norm.
+// All-zero rows are ignored.
+template<class T>
+void vnl_matrix<T>::normalize_rows()
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<T>::real_t real_t;
+ typedef typename vnl_numeric_traits<real_t>::abs_t abs_real_t;
+ for (unsigned int i = 0; i < this->num_rows; i++) { // For each row in the Matrix
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in row
+ norm += vnl_math_squared_magnitude(this->data[i][j]);
+
+ if (norm != 0) {
+ abs_real_t scale = abs_real_t(1)/(vcl_sqrt((abs_real_t)norm));
+ for (unsigned int j = 0; j < this->num_cols; j++)
+ this->data[i][j] = T(real_t(this->data[i][j]) * scale);
+ }
+ }
+}
+
+//: Make each column of the matrix have unit norm.
+// All-zero columns are ignored.
+template<class T>
+void vnl_matrix<T>::normalize_columns()
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<T>::real_t real_t;
+ typedef typename vnl_numeric_traits<real_t>::abs_t abs_real_t;
+ for (unsigned int j = 0; j < this->num_cols; j++) { // For each column in the Matrix
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ norm += vnl_math_squared_magnitude(this->data[i][j]);
+
+ if (norm != 0) {
+ abs_real_t scale = abs_real_t(1)/(vcl_sqrt((abs_real_t)norm));
+ for (unsigned int i = 0; i < this->num_rows; i++)
+ this->data[i][j] = T(real_t(this->data[i][j]) * scale);
+ }
+ }
+}
+
+//: Multiply row[row_index] by value
+template<class T>
+void vnl_matrix<T>::scale_row(unsigned row_index, T value)
+{
+#ifndef NDEBUG
+ if (row_index >= this->num_rows)
+ vnl_error_matrix_row_index("scale_row", row_index);
+#endif
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in row
+ this->data[row_index][j] *= value;
+}
+
+//: Multiply column[column_index] by value
+template<class T>
+void vnl_matrix<T>::scale_column(unsigned column_index, T value)
+{
+#ifndef NDEBUG
+ if (column_index >= this->num_cols)
+ vnl_error_matrix_col_index("scale_column", column_index);
+#endif
+ for (unsigned int j = 0; j < this->num_rows; j++) // For each element in column
+ this->data[j][column_index] *= value;
+}
+
+//: Returns a copy of n rows, starting from "row"
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::get_n_rows (unsigned row, unsigned n) const
+{
+#ifndef NDEBUG
+ if (row + n > this->num_rows)
+ vnl_error_matrix_row_index ("get_n_rows", row);
+#endif
+
+ // Extract data rowwise.
+ return vnl_matrix<T>(data[row], n, this->num_cols);
+}
+
+//: Returns a copy of n columns, starting from "column".
+template<class T>
+vnl_matrix<T> vnl_matrix<T>::get_n_columns (unsigned column, unsigned n) const
+{
+#ifndef NDEBUG
+ if (column + n > this->num_cols)
+ vnl_error_matrix_col_index ("get_n_columns", column);
+#endif
+
+ vnl_matrix<T> result(this->num_rows, n);
+ for (unsigned int c = 0; c < n; ++c)
+ for (unsigned int r = 0; r < this->num_rows; ++r)
+ result(r, c) = data[r][column + c];
+ return result;
+}
+
+//: Create a vector out of row[row_index].
+template<class T>
+vnl_vector<T> vnl_matrix<T>::get_row(unsigned row_index) const
+{
+#ifdef ERROR_CHECKING
+ if (row_index >= this->num_rows)
+ vnl_error_matrix_row_index ("get_row", row_index);
+#endif
+
+ vnl_vector<T> v(this->num_cols);
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in row
+ v[j] = this->data[row_index][j];
+ return v;
+}
+
+//: Create a vector out of column[column_index].
+template<class T>
+vnl_vector<T> vnl_matrix<T>::get_column(unsigned column_index) const
+{
+#ifdef ERROR_CHECKING
+ if (column_index >= this->num_cols)
+ vnl_error_matrix_col_index ("get_column", column_index);
+#endif
+
+ vnl_vector<T> v(this->num_rows);
+ for (unsigned int j = 0; j < this->num_rows; j++) // For each element in row
+ v[j] = this->data[j][column_index];
+ return v;
+}
+
+//--------------------------------------------------------------------------------
+
+//: Set row[row_index] to data at given address. No bounds check.
+template<class T>
+void vnl_matrix<T>::set_row(unsigned row_index, T const *v)
+{
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in row
+ this->data[row_index][j] = v[j];
+}
+
+//: Set row[row_index] to given vector. No bounds check.
+template<class T>
+void vnl_matrix<T>::set_row(unsigned row_index, vnl_vector<T> const &v)
+{
+ set_row(row_index,v.data_block());
+}
+
+//: Set row[row_index] to given value.
+template<class T>
+void vnl_matrix<T>::set_row(unsigned row_index, T v)
+{
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each element in row
+ this->data[row_index][j] = v;
+}
+
+//--------------------------------------------------------------------------------
+
+//: Set column[column_index] to data at given address.
+template<class T>
+void vnl_matrix<T>::set_column(unsigned column_index, T const *v)
+{
+ for (unsigned int i = 0; i < this->num_rows; i++) // For each element in row
+ this->data[i][column_index] = v[i];
+}
+
+//: Set column[column_index] to given vector. No bounds check.
+template<class T>
+void vnl_matrix<T>::set_column(unsigned column_index, vnl_vector<T> const &v)
+{
+ set_column(column_index,v.data_block());
+}
+
+//: Set column[column_index] to given value.
+template<class T>
+void vnl_matrix<T>::set_column(unsigned column_index, T v)
+{
+ for (unsigned int j = 0; j < this->num_rows; j++) // For each element in row
+ this->data[j][column_index] = v;
+}
+
+
+//: Set columns starting at starting_column to given matrix
+template<class T>
+void vnl_matrix<T>::set_columns(unsigned starting_column, vnl_matrix<T> const& m)
+{
+#ifndef NDEBUG
+ if (this->num_rows != m.num_rows ||
+ this->num_cols < m.num_cols + starting_column) // Size match?
+ vnl_error_matrix_dimension ("set_columns",
+ this->num_rows, this->num_cols,
+ m.num_rows, m.num_cols);
+#endif
+
+ for (unsigned int j = 0; j < m.num_cols; ++j)
+ for (unsigned int i = 0; i < this->num_rows; i++) // For each element in row
+ this->data[i][starting_column + j] = m.data[i][j];
+}
+
+//--------------------------------------------------------------------------------
+
+//: Two matrices are equal if and only if they have the same dimensions and the same values.
+// O(m*n).
+// Elements are compared with operator== as default.
+// Change this default with set_compare() at run time or by specializing
+// vnl_matrix_compare at compile time.
+
+template<class T>
+bool vnl_matrix<T>::operator_eq(vnl_matrix<T> const& rhs) const
+{
+ if (this == &rhs) // same object => equal.
+ return true;
+
+ if (this->num_rows != rhs.num_rows || this->num_cols != rhs.num_cols)
+ return false; // different sizes => not equal.
+
+ for (unsigned int i = 0; i < this->num_rows; i++) // For each row
+ for (unsigned int j = 0; j < this->num_cols; j++) // For each columne
+ if (!(this->data[i][j] == rhs.data[i][j])) // different element ?
+ return false; // Then not equal.
+
+ return true; // Else same; return true
+}
+
+template <class T>
+bool vnl_matrix<T>::is_identity() const
+{
+ T const zero(0);
+ T const one(1);
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j) {
+ T xm = (*this)(i,j);
+ if ( !((i == j) ? (xm == one) : (xm == zero)) )
+ return false;
+ }
+ return true;
+}
+
+//: Return true if maximum absolute deviation of M from identity is <= tol.
+template <class T>
+bool vnl_matrix<T>::is_identity(double tol) const
+{
+ T one(1);
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j) {
+ T xm = (*this)(i,j);
+ abs_t absdev = (i == j) ? vnl_math_abs(xm - one) : vnl_math_abs(xm);
+ if (absdev > tol)
+ return false;
+ }
+ return true;
+}
+
+template <class T>
+bool vnl_matrix<T>::is_zero() const
+{
+ T const zero(0);
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j)
+ if ( !( (*this)(i, j) == zero) )
+ return false;
+
+ return true;
+}
+
+//: Return true if max(abs((*this))) <= tol.
+template <class T>
+bool vnl_matrix<T>::is_zero(double tol) const
+{
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j)
+ if (vnl_math_abs((*this)(i,j)) > tol)
+ return false;
+
+ return true;
+}
+
+//: Return true if any element of (*this) is nan
+template <class T>
+bool vnl_matrix<T>::has_nans() const
+{
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j)
+ if (vnl_math_isnan((*this)(i,j)))
+ return true;
+
+ return false;
+}
+
+//: Return false if any element of (*this) is inf or nan
+template <class T>
+bool vnl_matrix<T>::is_finite() const
+{
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j)
+ if (!vnl_math_isfinite((*this)(i,j)))
+ return false;
+
+ return true;
+}
+
+//: Abort if any element of M is inf or nan
+template <class T>
+void vnl_matrix<T>::assert_finite_internal() const
+{
+ if (is_finite())
+ return;
+
+ vcl_cerr << "\n\n" __FILE__ ": " << __LINE__ << ": matrix has non-finite elements\n";
+
+ if (rows() <= 20 && cols() <= 20) {
+ vcl_cerr << __FILE__ ": here it is:\n" << *this;
+ }
+ else {
+ vcl_cerr << __FILE__ ": it is quite big (" << rows() << 'x' << cols() << ")\n"
+ << __FILE__ ": in the following picture '-' means finite and '*' means non-finite:\n";
+
+ for (unsigned int i=0; i<rows(); ++i) {
+ for (unsigned int j=0; j<cols(); ++j)
+ vcl_cerr << char(vnl_math_isfinite((*this)(i, j)) ? '-' : '*');
+ vcl_cerr << '\n';
+ }
+ }
+ vcl_cerr << __FILE__ ": calling abort()\n";
+ vcl_abort();
+}
+
+//: Abort unless M has the given size.
+template <class T>
+void vnl_matrix<T>::assert_size_internal(unsigned rs,unsigned cs) const
+{
+ if (this->rows()!=rs || this->cols()!=cs) {
+ vcl_cerr << __FILE__ ": size is " << this->rows() << 'x' << this->cols()
+ << ". should be " << rs << 'x' << cs << vcl_endl;
+ vcl_abort();
+ }
+}
+
+//: Read a vnl_matrix from an ascii vcl_istream.
+// Automatically determines file size if the input matrix has zero size.
+template <class T>
+bool vnl_matrix<T>::read_ascii(vcl_istream& s)
+{
+ if (!s.good()) {
+ vcl_cerr << __FILE__ ": vnl_matrix<T>::read_ascii: Called with bad stream\n";
+ return false;
+ }
+
+ bool size_known = (this->rows() != 0);
+
+ if (size_known) {
+ for (unsigned int i = 0; i < this->rows(); ++i)
+ for (unsigned int j = 0; j < this->columns(); ++j)
+ s >> this->data[i][j];
+
+ return s.good() || s.eof();
+ }
+
+ bool debug = false;
+
+ vcl_vector<T> first_row_vals;
+ if (debug)
+ vcl_cerr << __FILE__ ": vnl_matrix<T>::read_ascii: Determining file dimensions: ";
+
+ for (;;) {
+ // Clear whitespace, looking for a newline
+ while (true)
+ {
+ int c = s.get();
+ if (c == EOF)
+ goto loademup;
+ if (!vcl_isspace(c)) {
+ if (!s.putback(c).good())
+ vcl_cerr << "vnl_matrix<T>::read_ascii: Could not push back '" << c << "'\n";
+
+ goto readfloat;
+ }
+ // First newline after first number tells us the column dimension
+ if (c == '\n' && first_row_vals.size() > 0) {
+ goto loademup;
+ }
+ }
+ readfloat:
+ T val;
+ s >> val;
+ if (!s.fail())
+ first_row_vals.push_back(val);
+ if (s.eof())
+ goto loademup;
+ }
+ loademup:
+ unsigned int colz = first_row_vals.size();
+
+ if (debug) vcl_cerr << colz << " cols, ";
+
+ if (colz == 0)
+ return false;
+
+ // need to be careful with resizing here as will often be reading humungous files
+ // So let's just build an array of row pointers
+ vcl_vector<T*> row_vals;
+ row_vals.reserve(1000);
+ {
+ // Copy first row. Can't use first_row_vals, as may be a vector of bool...
+ T* row = vnl_c_vector<T>::allocate_T(colz);
+ for (unsigned int k = 0; k < colz; ++k)
+ row[k] = first_row_vals[k];
+ row_vals.push_back(row);
+ }
+
+ while (true)
+ {
+ T* row = vnl_c_vector<T>::allocate_T(colz);
+ if (row == 0) {
+ vcl_cerr << "vnl_matrix<T>::read_ascii: Error, Out of memory on row "
+ << row_vals.size() << vcl_endl;
+ return false;
+ }
+ s >> row[0];
+ if (!s.good())
+ {
+ vnl_c_vector<T>::deallocate(row, colz);
+ break;
+ }
+ for (unsigned int k = 1; k < colz; ++k) {
+ if (s.eof()) {
+ vcl_cerr << "vnl_matrix<T>::read_ascii: Error, EOF on row "
+ << row_vals.size() << ", column " << k << vcl_endl;
+
+ return false;
+ }
+ s >> row[k];
+ if (s.fail()) {
+ vcl_cerr << "vnl_matrix<T>::read_ascii: Error, row "
+ << row_vals.size() << " failed on column " << k << vcl_endl;
+ return false;
+ }
+ }
+ row_vals.push_back(row);
+ }
+
+ unsigned int rowz = row_vals.size();
+
+ if (debug)
+ vcl_cerr << rowz << " rows.\n";
+
+ set_size(rowz, colz);
+
+ T* p = this->data[0];
+ for (unsigned int i = 0; i < rowz; ++i) {
+ for (unsigned int j = 0; j < colz; ++j)
+ *p++ = row_vals[i][j];
+ /*if (i>0)*/ vnl_c_vector<T>::deallocate(row_vals[i], colz);
+ }
+
+ return true;
+}
+
+//: Read a vnl_matrix from an ascii vcl_istream.
+// Automatically determines file size if the input matrix has zero size.
+// This is a static method so you can type
+// <verb>
+// vnl_matrix<float> M = vnl_matrix<float>::read(cin);
+// </verb>
+// which many people prefer to the ">>" alternative.
+template <class T>
+vnl_matrix<T> vnl_matrix<T>::read(vcl_istream& s)
+{
+ vnl_matrix<T> M;
+ s >> M;
+ return M;
+}
+
+template <class T>
+void vnl_matrix<T>::swap(vnl_matrix<T> &that)
+{
+ vcl_swap(this->num_rows, that.num_rows);
+ vcl_swap(this->num_cols, that.num_cols);
+ vcl_swap(this->data, that.data);
+}
+
+//: Reverse order of rows. Name is from Matlab, meaning "flip upside down".
+template <class T>
+void vnl_matrix<T>::flipud()
+{
+ unsigned int n = this->rows();
+ unsigned int colz = this->columns();
+
+ unsigned int m = n / 2;
+ for (unsigned int r = 0; r < m; ++r) {
+ unsigned int r1 = r;
+ unsigned int r2 = n - 1 - r;
+ for (unsigned int c = 0; c < colz; ++c) {
+ T tmp = (*this)(r1, c);
+ (*this)(r1, c) = (*this)(r2, c);
+ (*this)(r2, c) = tmp;
+ }
+ }
+}
+
+//: Reverse order of columns.
+template <class T>
+void vnl_matrix<T>::fliplr()
+{
+ unsigned int n = this->cols();
+ unsigned int rowz = this->rows();
+
+ unsigned int m = n / 2;
+ for (unsigned int c = 0; c < m; ++c) {
+ unsigned int c1 = c;
+ unsigned int c2 = n - 1 - c;
+ for (unsigned int r = 0; r < rowz; ++r) {
+ T tmp = (*this)(r, c1);
+ (*this)(r, c1) = (*this)(r, c2);
+ (*this)(r, c2) = tmp;
+ }
+ }
+}
+
+// || M || = \max \sum | M |
+// 1 j i ij
+template <class T>
+typename vnl_matrix<T>::abs_t vnl_matrix<T>::operator_one_norm() const
+{
+ //typedef vnl_numeric_traits<T>::abs_t abs_t;
+ abs_t max = 0;
+ for (unsigned int j=0; j<this->num_cols; ++j) {
+ abs_t tmp = 0;
+ for (unsigned int i=0; i<this->num_rows; ++i)
+ tmp += vnl_math_abs(this->data[i][j]);
+ if (tmp > max)
+ max = tmp;
+ }
+ return max;
+}
+
+// || M || = \max \sum | M |
+// oo i j ij
+template <class T>
+typename vnl_matrix<T>::abs_t vnl_matrix<T>::operator_inf_norm() const
+{
+ //typedef vnl_numeric_traits<T>::abs_t abs_t;
+ abs_t max = 0;
+ for (unsigned int i=0; i<this->num_rows; ++i) {
+ abs_t tmp = 0;
+ for (unsigned int j=0; j<this->num_cols; ++j)
+ tmp += vnl_math_abs(this->data[i][j]);
+ if (tmp > max)
+ max = tmp;
+ }
+ return max;
+}
+
+template <class doublereal> // ideally, char* should be bool* - PVr
+int vnl_inplace_transpose(doublereal *a, unsigned m, unsigned n, char* move, unsigned iwrk)
+{
+ static doublereal b, c;
+ int k = m * n - 1;
+ static int iter, i1, i2, im, i1c, i2c, ncount, max_;
+
+// *****
+// ALGORITHM 380 - REVISED
+// *****
+// A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH
+// CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED
+// COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK
+// USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE
+// VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE
+// SUCCESS OR FAILURE OF THE ROUTINE.
+// NORMAL RETURN IOK=0
+// ERRORS IOK=-2 ,IWRK NEGATIVE OR ZERO
+// IOK.GT.0, (SHOULD NEVER OCCUR),IN THIS CASE
+// WE SET IOK EQUAL TO THE FINAL VALUE OF ITER WHEN THE SEARCH
+// IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED
+// NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS
+
+ if (m < 2 || n < 2)
+ return 0; // JUST RETURN IF MATRIX IS SINGLE ROW OR COLUMN
+ if (iwrk < 1)
+ return -2; // ERROR RETURN
+ if (m == n) {
+ // IF MATRIX IS SQUARE, EXCHANGE ELEMENTS A(I,J) AND A(J,I).
+ for (unsigned i = 0; i < n; ++i)
+ for (unsigned j = i+1; j < n; ++j) {
+ i1 = i + j * n;
+ i2 = j + i * m;
+ b = a[i1];
+ a[i1] = a[i2];
+ a[i2] = b;
+ }
+ return 0; // NORMAL RETURN
+ }
+ ncount = 2;
+ for (unsigned i = 0; i < iwrk; ++i)
+ move[i] = char(0); // false;
+ if (m > 2 && n > 2) {
+ // CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM FOR GCD(M-1,N-1).
+ int ir2 = m - 1;
+ int ir1 = n - 1;
+ int ir0 = ir2 % ir1;
+ while (ir0 != 0) {
+ ir2 = ir1;
+ ir1 = ir0;
+ ir0 = ir2 % ir1;
+ }
+ ncount += ir1 - 1;
+ }
+// SET INITIAL VALUES FOR SEARCH
+ iter = 1;
+ im = m;
+// AT LEAST ONE LOOP MUST BE RE-ARRANGED
+ goto L80;
+// SEARCH FOR LOOPS TO REARRANGE
+L40:
+ max_ = k - iter;
+ ++iter;
+ if (iter > max_)
+ return iter; // error return
+ im += m;
+ if (im > k)
+ im -= k;
+ i2 = im;
+ if (iter == i2)
+ goto L40;
+ if (iter <= (int)iwrk) {
+ if (move[iter-1])
+ goto L40;
+ else
+ goto L80;
+ }
+ while (i2 > iter && i2 < max_) {
+ i1 = i2;
+ i2 = m * i1 - k * (i1 / n);
+ }
+ if (i2 != iter)
+ goto L40;
+// REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP
+L80:
+ i1 = iter;
+ b = a[i1];
+ i1c = k - iter;
+ c = a[i1c];
+ while (true) {
+ i2 = m * i1 - k * (i1 / n);
+ i2c = k - i2;
+ if (i1 <= (int)iwrk)
+ move[i1-1] = '1'; // true;
+ if (i1c <= (int)iwrk)
+ move[i1c-1] = '1'; // true;
+ ncount += 2;
+ if (i2 == iter)
+ break;
+ if (i2+iter == k) {
+ doublereal d = b; b = c; c = d; // interchange b and c
+ break;
+ }
+ a[i1] = a[i2];
+ a[i1c] = a[i2c];
+ i1 = i2;
+ i1c = i2c;
+ }
+// FINAL STORE AND TEST FOR FINISHED
+ a[i1] = b;
+ a[i1c] = c;
+ if (ncount > k)
+ return 0; // NORMAL RETURN
+ goto L40;
+} /* dtrans_ */
+
+
+//: Transpose matrix M in place.
+// Works for rectangular matrices using an enormously clever algorithm from ACM TOMS.
+template <class T>
+void vnl_matrix<T>::inplace_transpose()
+{
+ unsigned m = rows();
+ unsigned n = columns();
+ unsigned iwrk = (m+n)/2;
+ vcl_vector<char> move(iwrk);
+
+ int iok = ::vnl_inplace_transpose(data_block(), n, m, &move[0], iwrk);
+ if (iok != 0)
+ vcl_cerr << __FILE__ " : inplace_transpose() -- iok = " << iok << vcl_endl;
+
+ this->num_rows = n;
+ this->num_cols = m;
+
+ // row pointers. we have to reallocate even when n<=m because
+ // vnl_c_vector<T>::deallocate needs to know n_when_allocatod.
+ {
+ T *tmp = data[0];
+ vnl_c_vector<T>::deallocate(data, m);
+ data = vnl_c_vector<T>::allocate_Tptr(n);
+ for (unsigned i=0; i<n; ++i)
+ data[i] = tmp + i * m;
+ }
+}
+
+//------------------------------------------------------------------------------
+
+#define VNL_MATRIX_INSTANTIATE(T) \
+template class vnl_matrix<T >; \
+template vnl_matrix<T > operator-(T const &, vnl_matrix<T > const &); \
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator+(T const &, vnl_matrix<T > const &)); \
+VCL_INSTANTIATE_INLINE(vnl_matrix<T > operator*(T const &, vnl_matrix<T > const &)); \
+template T dot_product(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+template T inner_product(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+template T cos_angle(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+template vnl_matrix<T > element_product(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+template vnl_matrix<T > element_quotient(vnl_matrix<T > const &, vnl_matrix<T > const &); \
+template int vnl_inplace_transpose(T*, unsigned, unsigned, char*, unsigned); \
+template vcl_ostream & operator<<(vcl_ostream &, vnl_matrix<T > const &); \
+template vcl_istream & operator>>(vcl_istream &, vnl_matrix<T > &)
+
+#endif // vnl_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.h
new file mode 100644
index 0000000000000000000000000000000000000000..d8ee0d22750935a48fefcc17a16c6bf2fd28f022
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.h
@@ -0,0 +1,28 @@
+// This is core/vnl/vnl_matrix_exp.h
+#ifndef vnl_matrix_exp_h_
+#define vnl_matrix_exp_h_
+//:
+// \file
+// \brief Compute the exponential of a square matrix
+//
+// Compute the exponential of a square matrix, by summing its
+// exponential series $\exp(X) = \displaystyle\sum_{n \ge 0} X^n/n!$
+// till a convergence requirement is met.
+//
+// Many improvements are possible.
+//
+// \author fsm
+
+#include <vnl/vnl_matrix.h>
+
+//: Compute the exponential of a square matrix - fiddly form
+// \relates vnl_matrix
+template <class T>
+bool vnl_matrix_exp(vnl_matrix<T> const &X, vnl_matrix<T> &expX, double max_err);
+
+//: Compute the exponential of a square matrix - easy form.
+// \relates vnl_matrix
+template <class T>
+vnl_matrix<T> vnl_matrix_exp(vnl_matrix<T> const &X);
+
+#endif // vnl_matrix_exp_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.txx
new file mode 100644
index 0000000000000000000000000000000000000000..6b42af5d2657a1087f667ad218b750de3da1c651
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_exp.txx
@@ -0,0 +1,73 @@
+// This is core/vnl/vnl_matrix_exp.txx
+#ifndef vnl_matrix_exp_txx_
+#define vnl_matrix_exp_txx_
+/*
+ fsm
+*/
+#include "vnl_matrix_exp.h"
+#include <vcl_cassert.h>
+#ifdef DEBUG
+#include <vcl_iostream.h>
+#endif
+
+template <class T>
+bool vnl_matrix_exp(vnl_matrix<T> const &X, vnl_matrix<T> &expX, double max_err)
+{
+ unsigned N = X.rows();
+ X.assert_size(N, N);
+ expX.assert_size(N, N);
+
+ double norm_X = X.operator_inf_norm();
+#ifdef DEBUG
+ vcl_cerr << "norm_X = " << norm_X << vcl_endl;
+#endif
+
+ // exponential series
+ expX.set_identity();
+ vnl_matrix<T> acc(X);
+ double norm_acc_bound = norm_X;
+ for (unsigned n=1; true; ++n) {
+ expX += acc;
+#ifdef DEBUG
+ vcl_cerr << "n=" << n << vcl_endl;
+#endif
+
+ if (norm_X < n) {
+ double err_bound = norm_acc_bound / (1 - norm_X/n);
+#ifdef DEBUG
+ vcl_cerr << "err_bound = " << err_bound << vcl_endl;
+#endif
+ if (err_bound < max_err)
+ break;
+ }
+
+ acc = acc * X;
+ acc /= n+1;
+
+ norm_acc_bound *= norm_X/(n+1);
+ }
+
+ return true;
+}
+
+template <class T>
+vnl_matrix<T> vnl_matrix_exp(vnl_matrix<T> const &X)
+{
+ vnl_matrix<T> expX(X.rows(), X.cols());
+#ifndef NDEBUG
+ bool retval =
+#endif
+ vnl_matrix_exp(X, expX, 1e-10);
+
+ assert(retval);
+ return expX;
+}
+
+//--------------------------------------------------------------------------------
+
+#undef VNL_MATRIX_EXP_INSTANTIATE
+#define VNL_MATRIX_EXP_INSTANTIATE(T) \
+template bool vnl_matrix_exp(vnl_matrix<T > const &, vnl_matrix<T > &, double); \
+template vnl_matrix<T > vnl_matrix_exp(vnl_matrix<T > const &)
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.h
new file mode 100644
index 0000000000000000000000000000000000000000..cde3908c00b58ec25dfd28d2eafe305a9c625f55
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.h
@@ -0,0 +1,911 @@
+// This is core/vnl/vnl_matrix_fixed.h
+#ifndef vnl_matrix_fixed_h_
+#define vnl_matrix_fixed_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief fixed size matrix
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 23 Nov 1996: added explicit copy constructor
+// LSB (Manchester) 15/03/2001: added Binary I/O and tidied up the documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Oct.2002 - Amitha Perera - separated vnl_matrix and vnl_matrix_fixed,
+// removed necessity for vnl_matrix_fixed_ref
+// 26Oct.2002 - Peter Vanroose - added inplace_transpose() method
+// July.2003 - Paul Smyth - fixed end() bug, made op*=() more general
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vcl_cstring.h> // memcpy()
+#include <vcl_cassert.h>
+#include <vcl_iosfwd.h>
+
+#include "vnl_matrix.h"
+#include "vnl_matrix_ref.h"
+#include "vnl_vector.h"
+#include "vnl_c_vector.h"
+
+export template <class T, unsigned int n> class vnl_vector_fixed;
+export template <class T, unsigned int num_rows, unsigned int num_cols> class vnl_matrix_fixed;
+
+// This mess is for a MSVC6 workaround.
+//
+// The problem: the matrix-matrix operator* should be written as a
+// non-member function since vxl (currently) forbits the use of member
+// templates. However, when declared as
+//
+// template <class T, unsigned m, unsigned n, unsigned o>
+// matrix<T,m,o> operator*( matrix<T,m,n>, matrix<T,n,o> );
+//
+// MSVC6 does not find it. A solution is to declare it as a member
+// template. However, the obvious
+//
+// template <unsigned o>
+// matrix<T,num_rows,o> operator*( matrix<T,num_cols,o> );
+//
+// causes an internal compiler error. It turns out that if the new
+// template parameter "o" comes _first_, then all is okay. Now, we
+// can't change the signature of vnl_matrix_fixed to <unsigned num_cols,
+// unsigned num_rows, type>, so we use a "hidden" helper matrix. Except
+// that user defined conversion operators and conversion constructors
+// are not called for templated functions. So we have to use a helper
+// base class. The base class is empty, which means that there is no
+// loss in space or time efficiency. Finally, we have:
+//
+// template <unsigned num_cols, unsigned num_rows, class T>
+// class fake_base { };
+//
+// template <class T, unsigned num_rows, unsigned num_cols>
+// class matrix : public fake_base<num_cols,num_rows,T>
+// {
+// template <unsigned o>
+// matrix<T,num_rows,o> operator*( fake_base<o,num_cols,T> );
+// };
+//
+// Notice how "o" is first in the list of template parameters. Since
+// base class conversions _are_ performed during template matching,
+// matrix<T,m,n> is matched as fake_base<n,m,T>, and all is good. For
+// some values of good.
+//
+// Of course, all this trickery is pre-processed away for conforming
+// compilers.
+//
+template <class T, unsigned int num_rows, unsigned int num_cols>
+class vnl_matrix_fixed;
+template <class T, unsigned M, unsigned N>
+inline
+vnl_vector_fixed<T, M> vnl_matrix_fixed_mat_vec_mult(const vnl_matrix_fixed<T, M, N>& a, const vnl_vector_fixed<T, N>& b);
+template <class T, unsigned M, unsigned N, unsigned O>
+inline
+vnl_matrix_fixed<T, M, O> vnl_matrix_fixed_mat_mat_mult(const vnl_matrix_fixed<T, M, N>& a, const vnl_matrix_fixed<T, N, O>& b);
+#ifdef VCL_VC60
+template <unsigned num_cols, unsigned num_rows, class T>
+class vnl_matrix_fixed_fake_base
+{
+};
+
+#define VNL_MATRIX_FIXED_VCL60_WORKAROUND : public vnl_matrix_fixed_fake_base<num_cols,num_rows,T>
+#else
+#define VNL_MATRIX_FIXED_VCL60_WORKAROUND /* no workaround. Phew. */
+#endif
+
+//: Fixed size, stack-stored, space-efficient matrix.
+// vnl_matrix_fixed is a fixed-length, stack storage vector. It has
+// the same storage size as a C-style array. It is not related via
+// inheritance to vnl_matrix. However, it can be converted cheaply to
+// a vnl_matrix_ref.
+//
+// Read the overview documentation of vnl_vector_fixed. The text there
+// applies here.
+template <class T, unsigned int num_rows, unsigned int num_cols>
+class vnl_matrix_fixed VNL_MATRIX_FIXED_VCL60_WORKAROUND
+{
+ public:
+ typedef unsigned int size_type;
+
+ private:
+ T data_[num_rows][num_cols]; // Local storage
+
+ public:
+
+ //: Construct an empty num_rows*num_cols matrix
+ vnl_matrix_fixed() {}
+
+ //: Construct an m*n matrix and fill with value
+ explicit vnl_matrix_fixed(T value)
+ {
+ T* p = data_[0];
+ unsigned int n = num_rows * num_cols;
+ while (n--)
+ *p++ = value;
+ }
+
+ //: Construct an m*n Matrix and copy data into it row-wise.
+ explicit vnl_matrix_fixed(const T* datablck)
+ {
+ vcl_memcpy(data_[0], datablck, num_rows*num_cols*sizeof(T));
+ }
+
+ //: Construct an m*n Matrix and copy rhs into it.
+ // Abort if rhs is not the same size.
+ vnl_matrix_fixed(const vnl_matrix_fixed& rhs)
+ {
+ vcl_memcpy(data_[0], rhs.data_block(), num_rows*num_cols*sizeof(T));
+ }
+
+ //: Construct an m*n Matrix and copy rhs into it.
+ // Abort if rhs is not the same size.
+ vnl_matrix_fixed(const vnl_matrix<T>& rhs)
+ {
+ assert(rhs.rows() == num_rows && rhs.columns() == num_cols);
+ vcl_memcpy(data_[0], rhs.data_block(), num_rows*num_cols*sizeof(T));
+ }
+
+ // Destruct the m*n matrix.
+ // An explicit destructor seems to be necessary, at least for gcc 3.0.0,
+ // to avoid the compiler generating multiple versions of it.
+ // (This way, a weak symbol is generated; otherwise not. A bug of gcc 3.0.)
+ ~vnl_matrix_fixed() {}
+
+ //: Set all elements to value v
+ // Complexity $O(r.c)$
+ vnl_matrix_fixed& operator= (T const&v) { fill(v); return *this; }
+
+ //: Copy a vnl_matrix into this.
+ // Abort if rhs is not the same size.
+ vnl_matrix_fixed& operator=(const vnl_matrix<T>& rhs)
+ {
+ assert(rhs.rows() == num_rows && rhs.columns() == num_cols);
+ vcl_memcpy(data_[0], rhs.data_block(), num_rows*num_cols*sizeof(T));
+ return *this;
+ }
+
+ //: Copy another vnl_matrix_fixed<T,m,n> into this.
+ vnl_matrix_fixed& operator=(const vnl_matrix_fixed& rhs)
+ {
+ vcl_memcpy(data_[0], rhs.data_block(), num_rows*num_cols*sizeof(T));
+ return *this;
+ }
+
+// Basic 2D-Array functionality-------------------------------------------
+
+ //: Return number of rows
+ unsigned rows() const { return num_rows; }
+
+ //: Return number of columns
+ // A synonym for cols()
+ unsigned columns() const { return num_cols; }
+
+ //: Return number of columns
+ // A synonym for columns()
+ unsigned cols() const { return num_cols; }
+
+ //: Return number of elements
+ // This equals rows() * cols()
+ unsigned size() const { return num_rows*num_cols; }
+
+ //: set element
+ void put (unsigned r, unsigned c, T const& v) { (*this)(r,c) = v; }
+
+ //: get element
+ T get (unsigned r, unsigned c) const { return (*this)(r,c); }
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T * operator[] (unsigned r) { return data_[r]; }
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T const * operator[] (unsigned r) const { return data_[r]; }
+
+ //: Access an element for reading or writing
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator() (unsigned r, unsigned c)
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(r<rows()); // Check the row index is valid
+ assert(c<cols()); // Check the column index is valid
+#endif
+ return this->data_[r][c];
+ }
+
+ //: Access an element for reading
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T const & operator() (unsigned r, unsigned c) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(r<rows()); // Check the row index is valid
+ assert(c<cols()); // Check the column index is valid
+#endif
+ return this->data_[r][c];
+ }
+
+// Filling and copying------------------------------------------------
+
+ //: Set all elements of matrix to specified value.
+ // Complexity $O(r.c)$
+ void fill (T);
+
+ //: Set all diagonal elements of matrix to specified value.
+ // Complexity $O(\min(r,c))$
+ void fill_diagonal (T);
+
+ //: Fill (laminate) this matrix with the given data.
+ // We assume that p points to a contiguous rows*cols array, stored rowwise.
+ void copy_in(T const *);
+
+ //: Fill (laminate) this matrix with the given data.
+ // A synonym for copy_in()
+ void set(T const *d) { copy_in(d); }
+
+ //: Fill the given array with this matrix.
+ // We assume that p points to
+ // a contiguous rows*cols array, stored rowwise.
+ // No bounds checking on the array
+ void copy_out(T *) const;
+
+ //: Transpose this matrix efficiently, if it is a square matrix
+ void inplace_transpose();
+
+
+// Arithmetic ----------------------------------------------------
+ // note that these functions should not pass scalar as a const&.
+ // Look what would happen to A /= A(0,0).
+
+ //: Add \a s to each element of lhs matrix in situ
+ vnl_matrix_fixed& operator+= (T s)
+ {
+ add( data_block(), s, data_block() ); return *this;
+ }
+
+ //: Subtract \a s from each element of lhs matrix in situ
+ vnl_matrix_fixed& operator-= (T s)
+ {
+ sub( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator*= (T s)
+ {
+ mul( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator/= (T s)
+ {
+ div( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator+= (vnl_matrix_fixed const& m)
+ {
+ add( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator+= (vnl_matrix<T> const& m)
+ {
+ assert( m.rows() == rows() && m.cols() == cols() );
+ add( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator-= (vnl_matrix_fixed const& m)
+ {
+ sub( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed& operator-= (vnl_matrix<T> const& m)
+ {
+ assert( m.rows() == rows() && m.cols() == cols() );
+ sub( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //: Negate all elements of matrix
+ vnl_matrix_fixed operator- () const
+ {
+ vnl_matrix_fixed r;
+ sub( T(0), data_block(), r.data_block() );
+ return r;
+ }
+
+ //:
+ vnl_matrix_fixed& operator*= (vnl_matrix_fixed<T,num_cols,num_cols> const& s)
+ {
+ vnl_matrix_fixed<T, num_rows, num_cols> out;
+ for (unsigned i = 0; i < num_rows; ++i)
+ for (unsigned j = 0; j < num_cols; ++j)
+ {
+ T accum = this->data_[i][0] * s(0,j);
+ for (unsigned k = 1; k < num_cols; ++k)
+ accum += this->data_[i][k] * s(k,j);
+ out(i,j) = accum;
+ }
+ return *this = out;
+ }
+
+#ifdef VCL_VC60
+ template <unsigned o>
+ vnl_matrix_fixed<T,num_rows,o> operator*( vnl_matrix_fixed_fake_base<o,num_cols,T> const& mat ) const
+ {
+ vnl_matrix_fixed<T,num_cols,o> const& b = static_cast<vnl_matrix_fixed<T,num_cols,o> const&>(mat);
+ return vnl_matrix_fixed_mat_mat_mult<T,num_rows,num_cols,o>( *this, b );
+ }
+ vnl_vector_fixed<T, num_rows> operator*( vnl_vector_fixed<T, num_cols> const& b) const
+ {
+ return vnl_matrix_fixed_mat_vec_mult<T,num_rows,num_cols>(*this,b);
+ }
+#endif
+
+ ////--------------------------- Additions ----------------------------
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix_fixed apply(T (*f)(T)) const;
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix_fixed apply(T (*f)(T const&)) const;
+
+ //: Return transpose
+ vnl_matrix_fixed<T,num_cols,num_rows> transpose () const;
+
+ //: Return conjugate transpose
+ vnl_matrix_fixed<T,num_cols,num_rows> conjugate_transpose () const;
+
+ //: Set values of this matrix to those of M, starting at [top,left]
+ vnl_matrix_fixed& update (vnl_matrix<T> const&, unsigned top=0, unsigned left=0);
+
+ //: Set the elements of the i'th column to v[j] (No bounds checking)
+ void set_column(unsigned i, T const * v);
+
+ //: Set the elements of the i'th column to value
+ void set_column(unsigned i, T value );
+
+ //: Set j-th column to v
+ void set_column(unsigned j, vnl_vector<T> const& v);
+
+ //: Set columns to those in M, starting at starting_column
+ void set_columns(unsigned starting_column, vnl_matrix<T> const& M);
+
+ //: Set the elements of the i'th row to v[j] (No bounds checking)
+ void set_row (unsigned i, T const * v);
+
+ //: Set the elements of the i'th row to value
+ void set_row (unsigned i, T value );
+
+ //: Set the i-th row
+ void set_row (unsigned i, vnl_vector<T> const&);
+
+ //: Extract a sub-matrix of size r x c, starting at (top,left)
+ // Thus it contains elements [top,top+r-1][left,left+c-1]
+ vnl_matrix<T> extract (unsigned r, unsigned c,
+ unsigned top=0, unsigned left=0) const;
+
+ //: Get a vector equal to the given row
+ vnl_vector<T> get_row (unsigned row) const;
+
+ //: Get a vector equal to the given column
+ vnl_vector<T> get_column(unsigned col) const;
+
+ //: Get n rows beginning at rowstart
+ vnl_matrix<T> get_n_rows (unsigned rowstart, unsigned n) const;
+
+ //: Get n columns beginning at colstart
+ vnl_matrix<T> get_n_columns(unsigned colstart, unsigned n) const;
+
+
+ // mutators
+
+ //: Set this matrix to an identity matrix
+ // Abort if the matrix is not square
+ void set_identity();
+
+ //: Reverse order of rows.
+ void flipud();
+
+ //: Reverse order of columns.
+ void fliplr();
+
+ //: Normalize each row so it is a unit vector
+ // Zero rows are ignored
+ void normalize_rows();
+
+ //: Normalize each column so it is a unit vector
+ // Zero columns are ignored
+ void normalize_columns();
+
+ //: Scale elements in given row by a factor of T
+ void scale_row (unsigned row, T value);
+
+ //: Scale elements in given column by a factor of T
+ void scale_column(unsigned col, T value);
+
+ //: Type def for norms.
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of absolute values of elements
+ abs_t array_one_norm() const { return vnl_c_vector<T>::one_norm(begin(), size()); }
+
+ //: Return square root of sum of squared absolute element values
+ abs_t array_two_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return largest absolute element value
+ abs_t array_inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), size()); }
+
+ //: Return sum of absolute values of elements
+ abs_t absolute_value_sum() const { return array_one_norm(); }
+
+ //: Return largest absolute value
+ abs_t absolute_value_max() const { return array_inf_norm(); }
+
+ // $ || M ||_1 := \max_j \sum_i | M_{ij} | $
+ abs_t operator_one_norm() const;
+
+ // $ || M ||_\inf := \max_i \sum_j | M_{ij} | $
+ abs_t operator_inf_norm() const;
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t frobenius_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t fro_norm() const { return frobenius_norm(); }
+
+ //: Return RMS of all elements
+ abs_t rms() const { return vnl_c_vector<T>::rms_norm(begin(), size()); }
+
+ //: Return minimum value of elements
+ T min_value() const { return vnl_c_vector<T>::min_value(begin(), size()); }
+
+ //: Return maximum value of elements
+ T max_value() const { return vnl_c_vector<T>::max_value(begin(), size()); }
+
+ //: Return mean of all matrix elements
+ T mean() const { return vnl_c_vector<T>::mean(begin(), num_rows*num_cols /*size()*/); }
+ // size() call in this method causes an ICE for MSVC when instantating 1x1 matrix
+
+ // predicates
+
+ //: Return true iff the size is zero.
+ bool empty() const { return num_rows==0 && num_cols==0; }
+
+ //: Return true if all elements equal to identity.
+ bool is_identity() const;
+
+ //: Return true if all elements equal to identity, within given tolerance
+ bool is_identity(double tol) const;
+
+ //: Return true if all elements equal to zero.
+ bool is_zero() const;
+
+ //: Return true if all elements equal to zero, within given tolerance
+ bool is_zero(double tol) const;
+
+ //: Return true if finite
+ bool is_finite() const;
+
+ //: Return true if matrix contains NaNs
+ bool has_nans() const;
+
+ //: abort if size is not as expected
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size(unsigned nr_rows, unsigned nr_cols) const
+ {
+#ifndef NDEBUG
+ assert_size_internal(nr_rows, nr_cols);
+#endif
+ }
+
+ //: abort if matrix contains any INFs or NANs.
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const
+ {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ ////----------------------- Input/Output ----------------------------
+
+ // : Read a vnl_matrix from an ascii vcl_istream, automatically determining file size if the input matrix has zero size.
+ bool read_ascii(vcl_istream& s);
+
+ //--------------------------------------------------------------------------------
+
+ //: Access the contiguous block storing the elements in the matrix row-wise. O(1).
+ // 1d array, row-major order.
+ T const* data_block () const { return data_[0]; }
+
+ //: Access the contiguous block storing the elements in the matrix row-wise. O(1).
+ // 1d array, row-major order.
+ T * data_block () { return data_[0]; }
+
+
+ //----------------------------------------------------------------------
+ // Conversion to vnl_matrix_ref.
+
+ // The const version of as_ref should return a const vnl_matrix_ref
+ // so that the vnl_matrix_ref::non_const() cannot be used on
+ // it. This prevents a const vnl_matrix_fixed from being cast into a
+ // non-const vnl_matrix reference, giving a slight increase in type safety.
+
+ //: Explicit conversion to a vnl_matrix_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_matrix but not for vnl_matrix_fixed. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_matrix_ref::non_const
+ vnl_matrix_ref<T> as_ref() { return vnl_matrix_ref<T>( num_rows, num_cols, data_block() ); }
+
+ //: Explicit conversion to a vnl_matrix_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_matrix but not for vnl_matrix_fixed. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_matrix_ref::non_const
+ const vnl_matrix_ref<T> as_ref() const { return vnl_matrix_ref<T>( num_rows, num_cols, const_cast<T*>(data_block()) ); }
+
+ //: Cheap conversion to vnl_matrix_ref
+ // Sometimes, such as with templated functions, the compiler cannot
+ // use this user-defined conversion. For those cases, use the
+ // explicit as_ref() method instead.
+ operator const vnl_matrix_ref<T>() const { return vnl_matrix_ref<T>( num_rows, num_cols, const_cast<T*>(data_block()) ); }
+
+ //: Convert to a vnl_matrix.
+ const vnl_matrix<T> as_matrix() const { return vnl_matrix<T>(const_cast<T*>(data_block()),num_rows,num_cols); }
+
+ //----------------------------------------------------------------------
+
+ typedef T element_type;
+
+ //: Iterators
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() { return data_[0]; }
+ //: Iterator pointing to element beyond end of data
+ iterator end() { return begin() + size(); }
+
+ //: Const iterators
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data_[0]; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return begin() + size(); }
+
+ //--------------------------------------------------------------------------------
+
+ //: Return true if *this == rhs
+ bool operator_eq (vnl_matrix_fixed const & rhs) const
+ {
+ return equal( this->data_block(), rhs.data_block() );
+ }
+
+ //: Equality operator
+ bool operator==(vnl_matrix<T> const &that) const { return this->operator_eq(that); }
+
+ //: Inequality operator
+ bool operator!=(vnl_matrix<T> const &that) const { return !this->operator_eq(that); }
+
+ //: Print matrix to os in some hopefully sensible format
+ void print(vcl_ostream& os) const;
+
+//--------------------------------------------------------------------------------
+
+
+ // Helper routines for arithmetic. These routines know the size from
+ // the template parameters. The vector-vector operations are
+ // element-wise.
+
+ static void add( const T* a, const T* b, T* r );
+ static void add( const T* a, T b, T* r );
+ static void sub( const T* a, const T* b, T* r );
+ static void sub( const T* a, T b, T* r );
+ static void sub( T a, const T* b, T* r );
+ static void mul( const T* a, const T* b, T* r );
+ static void mul( const T* a, T b, T* r );
+ static void div( const T* a, const T* b, T* r );
+ static void div( const T* a, T b, T* r );
+
+ static bool equal( const T* a, const T* b );
+
+ private:
+ void assert_finite_internal() const;
+
+ void assert_size_internal(unsigned, unsigned) const;
+};
+
+#undef VNL_MATRIX_FIXED_VCL60_WORKAROUND
+
+
+// Make the operators below inline because (1) they are small and
+// (2) we then have less explicit instantiation trouble.
+
+
+// --- Matrix-scalar -------------------------------------------------------------
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( const vnl_matrix_fixed<T,m,n>& mat1, const vnl_matrix_fixed<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( const vnl_matrix_fixed<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( const T& s,
+ const vnl_matrix_fixed<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( const vnl_matrix_fixed<T,m,n>& mat1, const vnl_matrix_fixed<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( const vnl_matrix_fixed<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( const T& s,
+ const vnl_matrix_fixed<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( s, mat.data_block(), r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator*( const vnl_matrix_fixed<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator*( const T& s,
+ const vnl_matrix_fixed<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator/( const vnl_matrix_fixed<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::div( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> element_product( const vnl_matrix_fixed<T,m,n>& mat1,
+ const vnl_matrix_fixed<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+
+template <class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> element_quotient( const vnl_matrix_fixed<T,m,n>& mat1,
+ const vnl_matrix_fixed<T,m,n>& mat2)
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::div( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+
+// The following two functions are helper functions keep the
+// matrix-matrix and matrix-vector multiplication code in one place,
+// so that bug fixes, etc, can be localized.
+template <class T, unsigned M, unsigned N>
+inline
+vnl_vector_fixed<T, M>
+vnl_matrix_fixed_mat_vec_mult(const vnl_matrix_fixed<T, M, N>& a,
+ const vnl_vector_fixed<T, N>& b)
+{
+ vnl_vector_fixed<T, M> out;
+ for (unsigned i = 0; i < M; ++i)
+ {
+ T accum = a(i,0) * b(0);
+ for (unsigned k = 1; k < N; ++k)
+ accum += a(i,k) * b(k);
+ out(i) = accum;
+ }
+ return out;
+}
+
+// see comment above
+template <class T, unsigned M, unsigned N, unsigned O>
+inline
+vnl_matrix_fixed<T, M, O>
+vnl_matrix_fixed_mat_mat_mult(const vnl_matrix_fixed<T, M, N>& a,
+ const vnl_matrix_fixed<T, N, O>& b)
+{
+ vnl_matrix_fixed<T, M, O> out;
+ for (unsigned i = 0; i < M; ++i)
+ for (unsigned j = 0; j < O; ++j)
+ {
+ T accum = a(i,0) * b(0,j);
+ for (unsigned k = 1; k < N; ++k)
+ accum += a(i,k) * b(k,j);
+ out(i,j) = accum;
+ }
+ return out;
+}
+
+#ifndef VCL_VC60
+// The version for correct compilers
+
+//: Multiply conformant vnl_matrix_fixed (M x N) and vector_fixed (N)
+// \relates vnl_vector_fixed
+// \relates vnl_matrix_fixed
+template <class T, unsigned M, unsigned N>
+inline
+vnl_vector_fixed<T, M> operator*(const vnl_matrix_fixed<T, M, N>& a, const vnl_vector_fixed<T, N>& b)
+{
+ return vnl_matrix_fixed_mat_vec_mult(a,b);
+}
+
+//: Multiply two conformant vnl_matrix_fixed (M x N) times (N x O)
+// \relates vnl_matrix_fixed
+template <class T, unsigned M, unsigned N, unsigned O>
+inline
+vnl_matrix_fixed<T, M, O> operator*(const vnl_matrix_fixed<T, M, N>& a, const vnl_matrix_fixed<T, N, O>& b)
+{
+ return vnl_matrix_fixed_mat_mat_mult(a,b);
+}
+#endif // VCL_VC60
+
+
+// These overloads for the common case of mixing a fixed with a
+// non-fixed. Because the operator* are templated, the fixed will not
+// be automatically converted to a non-fixed-ref. These do it for you.
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator+( const vnl_matrix_fixed<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() + b;
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator+( const vnl_matrix<T>& a, const vnl_matrix_fixed<T,m,n>& b )
+{
+ return a + b.as_ref();
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator-( const vnl_matrix_fixed<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() - b;
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator-( const vnl_matrix<T>& a, const vnl_matrix_fixed<T,m,n>& b )
+{
+ return a - b.as_ref();
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator*( const vnl_matrix_fixed<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() * b;
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator*( const vnl_matrix<T>& a, const vnl_matrix_fixed<T,m,n>& b )
+{
+ return a * b.as_ref();
+}
+
+template <class T, unsigned m, unsigned n>
+inline vnl_vector<T> operator*( const vnl_matrix_fixed<T,m,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() * b;
+}
+
+template <class T, unsigned n>
+inline vnl_vector<T> operator*( const vnl_matrix<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return a * b.as_ref();
+}
+
+
+// --- I/O operations ------------------------------------------------------------
+
+template <class T, unsigned m, unsigned n>
+inline
+vcl_ostream& operator<< (vcl_ostream& os, vnl_matrix_fixed<T,m,n> const& mat)
+{
+ mat.print(os);
+ return os;
+}
+
+template <class T, unsigned m, unsigned n>
+inline
+vcl_istream& operator>> (vcl_istream& is, vnl_matrix_fixed<T,m,n>& mat)
+{
+ mat.read_ascii(is);
+ return is;
+}
+
+// More workarounds for Visual C++ 6.0. The problem is that VC6 cannot
+// automatically determine the m of the second parameter, for some
+// reason. Also, VC6 can't figure out that vector_fixed::SIZE is a
+// compile time constant when used in the return parameter. So, we
+// have to introduce a helper class to do it.
+//
+#ifdef VCL_VC60
+
+template<class T, unsigned m, class FixedVector>
+struct outer_product_fixed_type_helper
+{
+ typedef vnl_matrix_fixed<T,m,FixedVector::SIZE> result_matrix;
+};
+template<class V1, class V2, class RM>
+struct outer_product_fixed_calc_helper
+{
+ static RM calc( V1 const& a, V2 const& b );
+};
+template <class T, unsigned m, class SecondFixedVector>
+outer_product_fixed_type_helper<T,m,SecondFixedVector>::result_matrix
+outer_product(vnl_vector_fixed<T,m> const& a, SecondFixedVector const& b)
+{
+ typedef vnl_vector_fixed<T,m> VecA;
+ typedef vnl_vector_fixed<T,SecondFixedVector::SIZE> VecB;
+ typedef outer_product_fixed_type_helper<T,m,SecondFixedVector>::result_matrix ResultMat;
+ return outer_product_fixed_calc_helper<VecA,VecB,ResultMat>::calc(a,b);
+}
+
+#else // no need for VC6 workaround for outer_product
+
+//:
+// \relates vnl_vector_fixed
+template <class T, unsigned m, unsigned n>
+vnl_matrix_fixed<T,m,n> outer_product(vnl_vector_fixed<T,m> const& a, vnl_vector_fixed<T,n> const& b);
+
+#endif // VC6 workaround for outer_product
+
+#define VNL_MATRIX_FIXED_INSTANTIATE(T, M, N) \
+extern "please include vnl/vnl_matrix_fixed.txx instead"
+
+#endif // vnl_matrix_fixed_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.txx
new file mode 100644
index 0000000000000000000000000000000000000000..18da2bd4b1d0d711a6d6ff9e47fd0ca8e4c626b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed.txx
@@ -0,0 +1,735 @@
+// This is core/vnl/vnl_matrix_fixed.txx
+#ifndef vnl_matrix_fixed_txx_
+#define vnl_matrix_fixed_txx_
+//:
+// \file
+#include "vnl_matrix_fixed.h"
+
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+#include <vcl_cstdlib.h> // for abort
+#include <vcl_cassert.h>
+
+#include <vnl/vnl_error.h>
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_vector_fixed.h>
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::add( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) + *(b++);
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::add( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) + b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::sub( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) - *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::sub( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) - b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::sub( T a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = a - *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::mul( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) * *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::mul( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) * b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::div( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) / *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::div( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) / b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::equal( const T* a, const T* b )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ if ( *(a++) != *(b++) ) return false;
+ return true;
+}
+
+//------------------------------------------------------------
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::fill (T value)
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ for (unsigned int j = 0; j < ncols; j++)
+ this->data_[i][j] = value;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::fill_diagonal (T value)
+{
+ for (unsigned int i = 0; i < nrows && i < ncols; i++)
+ this->data_[i][i] = value;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::print(vcl_ostream& os) const
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ os << this->data_[i][0];
+ for (unsigned int j = 1; j < ncols; j++)
+ os << ' ' << this->data_[i][j];
+ os << '\n';
+ }
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,nrows,ncols>
+vnl_matrix_fixed<T,nrows,ncols>::apply(T (*f)(T const&)) const
+{
+ vnl_matrix_fixed<T,nrows,ncols> ret;
+ vnl_c_vector<T>::apply(this->data_[0], rows()*cols(), f, ret.data_block());
+ return ret;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,nrows,ncols>
+vnl_matrix_fixed<T,nrows,ncols>::apply(T (*f)(T)) const
+{
+ vnl_matrix_fixed<T,nrows,ncols> ret;
+ vnl_c_vector<T>::apply(this->data_[0], rows()*cols(), f, ret.data_block());
+ return ret;
+}
+
+////--------------------------- Additions------------------------------------
+
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,ncols,nrows>
+vnl_matrix_fixed<T,nrows,ncols>::transpose() const
+{
+ vnl_matrix_fixed<T,ncols,nrows> result;
+ for (unsigned int i = 0; i < cols(); i++)
+ for (unsigned int j = 0; j < rows(); j++)
+ result(i,j) = this->data_[j][i];
+ return result;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,ncols,nrows>
+vnl_matrix_fixed<T,nrows,ncols>::conjugate_transpose() const
+{
+ vnl_matrix_fixed<T,ncols,nrows> result(transpose());
+ vnl_c_vector<T>::conjugate(result.begin(), // src
+ result.begin(), // dst
+ result.size()); // size of block
+ return result;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,nrows,ncols>&
+vnl_matrix_fixed<T,nrows,ncols>::update (vnl_matrix<T> const& m,
+ unsigned top, unsigned left)
+{
+ const unsigned int bottom = top + m.rows();
+ const unsigned int right = left + m.cols();
+#ifndef NDEBUG
+ if (nrows < bottom || ncols < right)
+ vnl_error_matrix_dimension ("update",
+ bottom, right, m.rows(), m.cols());
+#endif
+ for (unsigned int i = top; i < bottom; i++)
+ for (unsigned int j = left; j < right; j++)
+ this->data_[i][j] = m(i-top,j-left);
+ return *this;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed<T,nrows,ncols>::extract (unsigned rowz, unsigned colz,
+ unsigned top, unsigned left) const
+{
+#ifndef NDEBUG
+ unsigned int bottom = top + rowz;
+ unsigned int right = left + colz;
+ if ((nrows < bottom) || (ncols < right))
+ vnl_error_matrix_dimension ("extract",
+ nrows, ncols, bottom, right);
+#endif
+ vnl_matrix<T> result(rowz, colz);
+ for (unsigned int i = 0; i < rowz; i++) // actual copy of all elements
+ for (unsigned int j = 0; j < colz; j++) // in submatrix
+ result(i,j) = this->data_[top+i][left+j];
+ return result;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::copy_in(T const *p)
+{
+ T* dp = this->data_block();
+ unsigned int i = nrows * ncols;
+ while (i--)
+ *dp++ = *p++;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void vnl_matrix_fixed<T,nrows,ncols>::copy_out(T *p) const
+{
+ T const* dp = this->data_block();
+ unsigned int i = nrows*ncols;
+ while (i--)
+ *p++ = *dp++;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_identity()
+{
+#ifndef NDEBUG
+ if (nrows != ncols) // Size?
+ vnl_error_matrix_nonsquare ("set_identity");
+#endif
+ // Two simple loops are generally better than having a branch inside
+ // the loop. Probably worth the O(n) extra writes.
+ for (unsigned int i = 0; i < nrows; i++)
+ for (unsigned int j = 0; j < ncols; j++)
+ this->data_[i][j] = T(0);
+ for (unsigned int i = 0; i < nrows; i++)
+ this->data_[i][i] = T(1);
+}
+
+//: Make each row of the matrix have unit norm.
+// All-zero rows are ignored.
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::normalize_rows()
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int j = 0; j < ncols; j++)
+ norm += vnl_math_squared_magnitude( this->data_[i][j] );
+
+ if (norm != 0)
+ {
+ typedef typename vnl_numeric_traits<abs_t>::real_t real_t;
+ real_t scale = real_t(1)/vcl_sqrt((real_t)norm);
+ for (unsigned int j = 0; j < ncols; j++)
+ {
+ // FIXME need correct rounding here
+ // There is e.g. no *standard* operator*=(complex<float>, double), hence the T() cast.
+ this->data_[i][j] *= T(scale);
+ }
+ }
+ }
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::normalize_columns()
+{
+ for (unsigned int j = 0; j < ncols; j++) { // For each column in the Matrix
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int i = 0; i < nrows; i++)
+ norm += vnl_math_squared_magnitude( this->data_[i][j] );
+
+ if (norm != 0)
+ {
+ typedef typename vnl_numeric_traits<abs_t>::real_t real_t;
+ real_t scale = real_t(1)/vcl_sqrt((real_t)norm);
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ // FIXME need correct rounding here
+ // There is e.g. no *standard* operator*=(complex<float>, double), hence the T() cast.
+ this->data_[i][j] *= T(scale);
+ }
+ }
+ }
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::scale_row(unsigned row_index, T value)
+{
+#ifndef NDEBUG
+ if (row_index >= nrows)
+ vnl_error_matrix_row_index("scale_row", row_index);
+#endif
+ for (unsigned int j = 0; j < ncols; j++)
+ this->data_[row_index][j] *= value;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::scale_column(unsigned column_index, T value)
+{
+#ifndef NDEBUG
+ if (column_index >= ncols)
+ vnl_error_matrix_col_index("scale_column", column_index);
+#endif
+ for (unsigned int j = 0; j < nrows; j++)
+ this->data_[j][column_index] *= value;
+}
+
+//: Returns a copy of n rows, starting from "row"
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed<T,nrows,ncols>::get_n_rows (unsigned row, unsigned n) const
+{
+#ifndef NDEBUG
+ if (row + n > nrows)
+ vnl_error_matrix_row_index ("get_n_rows", row);
+#endif
+
+ // Extract data rowwise.
+ return vnl_matrix<T>(data_[row], n, ncols);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed<T,nrows,ncols>::get_n_columns (unsigned column, unsigned n) const
+{
+#ifndef NDEBUG
+ if (column + n > ncols)
+ vnl_error_matrix_col_index ("get_n_columns", column);
+#endif
+
+ vnl_matrix<T> result(nrows, n);
+ for (unsigned int c = 0; c < n; ++c)
+ for (unsigned int r = 0; r < nrows; ++r)
+ result(r, c) = this->data_[r][column + c];
+ return result;
+}
+
+//: Create a vector out of row[row_index].
+template<class T, unsigned nrows, unsigned ncols>
+vnl_vector<T> vnl_matrix_fixed<T,nrows,ncols>::get_row(unsigned row_index) const
+{
+#ifdef ERROR_CHECKING
+ if (row_index >= nrows)
+ vnl_error_matrix_row_index ("get_row", row_index);
+#endif
+
+ vnl_vector<T> v(ncols);
+ for (unsigned int j = 0; j < ncols; j++) // For each element in row
+ v[j] = this->data_[row_index][j];
+ return v;
+}
+
+//: Create a vector out of column[column_index].
+template<class T, unsigned nrows, unsigned ncols>
+vnl_vector<T> vnl_matrix_fixed<T,nrows,ncols>::get_column(unsigned column_index) const
+{
+#ifdef ERROR_CHECKING
+ if (column_index >= ncols)
+ vnl_error_matrix_col_index ("get_column", column_index);
+#endif
+
+ vnl_vector<T> v(nrows);
+ for (unsigned int j = 0; j < nrows; j++)
+ v[j] = this->data_[j][column_index];
+ return v;
+}
+
+//--------------------------------------------------------------------------------
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_row(unsigned row_index, T const *v)
+{
+ for (unsigned int j = 0; j < ncols; j++)
+ this->data_[row_index][j] = v[j];
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_row(unsigned row_index, vnl_vector<T> const &v)
+{
+ set_row(row_index,v.data_block());
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_row(unsigned row_index, T v)
+{
+ for (unsigned int j = 0; j < ncols; j++)
+ this->data_[row_index][j] = v;
+}
+
+//--------------------------------------------------------------------------------
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_column(unsigned column_index, T const *v)
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ this->data_[i][column_index] = v[i];
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_column(unsigned column_index, vnl_vector<T> const &v)
+{
+ set_column(column_index,v.data_block());
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_column(unsigned column_index, T v)
+{
+ for (unsigned int j = 0; j < nrows; j++)
+ this->data_[j][column_index] = v;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::set_columns(unsigned starting_column, vnl_matrix<T> const& m)
+{
+#ifndef NDEBUG
+ if (nrows != m.rows() ||
+ ncols < m.cols() + starting_column) // Size match?
+ vnl_error_matrix_dimension ("set_columns",
+ nrows, ncols,
+ m.rows(), m.cols());
+#endif
+
+ for (unsigned int j = 0; j < m.cols(); ++j)
+ for (unsigned int i = 0; i < nrows; i++)
+ this->data_[i][starting_column + j] = m(i,j);
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::is_identity() const
+{
+ T const zero(0);
+ T const one(1);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ {
+ T xm = this->data_[i][j];
+ if ( !((i == j) ? (xm == one) : (xm == zero)) )
+ return false;
+ }
+ return true;
+}
+
+//: Return true if maximum absolute deviation of M from identity is <= tol.
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::is_identity(double tol) const
+{
+ T one(1);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ {
+ T xm = this->data_[i][j];
+ abs_t absdev = (i == j) ? vnl_math_abs(xm - one) : vnl_math_abs(xm);
+ if (absdev > tol)
+ return false;
+ }
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::is_zero() const
+{
+ T const zero(0);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if ( !( this->data_[i][ j] == zero) )
+ return false;
+
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::is_zero(double tol) const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (vnl_math_abs(this->data_[i][j]) > tol)
+ return false;
+
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::has_nans() const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (vnl_math_isnan(this->data_[i][j]))
+ return true;
+
+ return false;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::is_finite() const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (!vnl_math_isfinite(this->data_[i][j]))
+ return false;
+
+ return true;
+}
+
+//: Abort if any element of M is inf or nan
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::assert_finite_internal() const
+{
+ if (is_finite())
+ return;
+
+ vcl_cerr << "\n\n" __FILE__ ": " << __LINE__ << ": matrix has non-finite elements\n";
+
+ if (rows() <= 20 && cols() <= 20)
+ vcl_cerr << __FILE__ ": here it is:\n" << *this << '\n';
+ else
+ {
+ vcl_cerr << __FILE__ ": it is quite big (" << rows() << 'x' << cols() << ")\n"
+ << __FILE__ ": in the following picture '-' means finite and '*' means non-finite:\n";
+
+ for (unsigned int i=0; i<rows(); ++i)
+ {
+ for (unsigned int j=0; j<cols(); ++j)
+ vcl_cerr << char(vnl_math_isfinite(this->data_[i][ j]) ? '-' : '*');
+ vcl_cerr << '\n';
+ }
+ }
+ vcl_cerr << __FILE__ ": calling abort()\n";
+ vcl_abort();
+}
+
+//: Abort unless M has the given size.
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::assert_size_internal(unsigned rs,unsigned cs) const
+{
+ if (nrows!=rs || ncols!=cs)
+ {
+ vcl_cerr << __FILE__ ": size is " << nrows << 'x' << ncols
+ << ". should be " << rs << 'x' << cs << vcl_endl;
+ vcl_abort();
+ }
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed<T,nrows,ncols>::read_ascii(vcl_istream& s)
+{
+ if (!s.good())
+ {
+ vcl_cerr << __FILE__ ": vnl_matrix_fixed<T,nrows,ncols>::read_ascii: Called with bad stream\n";
+ return false;
+ }
+
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ s >> this->data_[i][j];
+
+ return s.good() || s.eof();
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::flipud()
+{
+ for (unsigned int r1 = 0; 2*r1+1 < nrows; ++r1)
+ {
+ unsigned int r2 = nrows - 1 - r1;
+ for (unsigned int c = 0; c < ncols; ++c)
+ {
+ T tmp = this->data_[r1][c];
+ this->data_[r1][c] = this->data_[r2][c];
+ this->data_[r2][c] = tmp;
+ }
+ }
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed<T,nrows,ncols>::fliplr()
+{
+ for (unsigned int c1 = 0; 2*c1+1 < ncols; ++c1)
+ {
+ unsigned int c2 = ncols - 1 - c1;
+ for (unsigned int r = 0; r < nrows; ++r)
+ {
+ T tmp = this->data_[r][c1];
+ this->data_[r][c1] = this->data_[r][c2];
+ this->data_[r][c2] = tmp;
+ }
+ }
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+typename vnl_matrix_fixed<T,nrows,ncols>::abs_t
+vnl_matrix_fixed<T,nrows,ncols>::operator_one_norm() const
+{
+ abs_t m(0);
+ for (unsigned int j=0; j<ncols; ++j)
+ {
+ abs_t t(0);
+ for (unsigned int i=0; i<nrows; ++i)
+ t += vnl_math_abs( this->data_[i][j] );
+ if (t > m)
+ m = t;
+ }
+ return m;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+typename vnl_matrix_fixed<T,nrows,ncols>::abs_t
+vnl_matrix_fixed<T,nrows,ncols>::operator_inf_norm() const
+{
+ abs_t m(0);
+ for (unsigned int i=0; i<nrows; ++i)
+ {
+ abs_t t(0);
+ for (unsigned int j=0; j<ncols; ++j)
+ t += vnl_math_abs( this->data_[i][j] );
+ if (t > m)
+ m = t;
+ }
+ return m;
+}
+
+//: Transpose square matrix M in place.
+template <class T, unsigned nrows, unsigned ncols>
+void vnl_matrix_fixed<T,nrows,ncols>::inplace_transpose()
+{
+ assert(nrows==ncols); // cannot inplace_transpose non-square fixed size matrix
+ for (unsigned i = 0; i < nrows; ++i)
+ for (unsigned j = i+1; j < ncols; ++j)
+ {
+ T t = this->data_[i][j];
+ this->data_[i][j] = this->data_[j][i];
+ this->data_[j][i] = t;
+ }
+}
+
+// Workaround for argument deduction bug in VC6. See comment in .h
+// file. Note that the body of the function is outside the #ifdefs to
+// maintain a single implementation of the function. The way to read
+// this code is to just jump to the #else part and scan down, ignoring
+// the #endif. Unless, of course, you are masochist and actually want
+// to read the workaround.
+//
+#ifdef VCL_VC60
+
+template<class VecA, class VecB, class RM>
+RM
+outer_product_fixed_calc_helper<VecA,VecB,RM>::calc( VecA const& a, VecB const& b )
+{
+ RM out; // RM should be a vnl_matrix_fixed of VecA::SIZE by VecB::SIZE
+ for (unsigned int i = 0; i < VecA::SIZE; i++)
+ for (unsigned int j = 0; j < VecB::SIZE; j++)
+ out[i][j] = a[i] * b[j];
+ return out;
+};
+
+#define VNL_OUTER_PRODUCT_FIXED_INSTANTIATE( T, M, N ) \
+ template struct outer_product_fixed_calc_helper< vnl_vector_fixed<T,M >, \
+ vnl_vector_fixed<T,N >, \
+ vnl_matrix_fixed<T,M,N > >
+
+#else // no need for workaround; declare the function sanely.
+
+template <class T, unsigned m, unsigned n>
+vnl_matrix_fixed<T,m,n>
+outer_product(vnl_vector_fixed<T,m> const& a, vnl_vector_fixed<T,n> const& b)
+{
+ vnl_matrix_fixed<T,m,n> out; // = a.column() * b.row()
+ for (unsigned int i = 0; i < m; i++)
+ for (unsigned int j = 0; j < n; j++)
+ out[i][j] = a[i] * b[j];
+ return out;
+}
+
+#define VNL_OUTER_PRODUCT_FIXED_INSTANTIATE( T, M, N ) \
+ template vnl_matrix_fixed<T,M,N > outer_product(vnl_vector_fixed<T,M > const&,\
+ vnl_vector_fixed<T,N > const& )
+
+#endif // VC60 outer_product workaround
+
+
+#undef VNL_MATRIX_FIXED_INSTANTIATE
+#define VNL_MATRIX_FIXED_INSTANTIATE(T, M, N) \
+ template class vnl_matrix_fixed<T,M,N >; \
+ VNL_OUTER_PRODUCT_FIXED_INSTANTIATE( T, M, N )
+
+#endif // vnl_matrix_fixed_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.h
new file mode 100644
index 0000000000000000000000000000000000000000..1334120bbb4d50566c2aa63f5b58c9e620860924
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.h
@@ -0,0 +1,920 @@
+// This is core/vnl/vnl_matrix_fixed_ref.h
+#ifndef vnl_matrix_fixed_ref_h_
+#define vnl_matrix_fixed_ref_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Fixed size stack-stored vnl_matrix
+//
+// > > From: Amitha Perera [mailto:perera@cs.rpi.edu]
+// > > Sent: Monday, October 07, 2002 3:18 PM
+// > > Subject: vnl_vector_fixed_ref
+// > >
+// > > I'm working on separating vnl_vector and vnl_vector_fixed in the VXL
+// > > tree, as I mailed a while ago to the vxl-maintainers list. I noticed
+// > > that you'd committed a vnl_vector_fixed_ref class which doesn't seem
+// > > to provide any additional functionality over vnl_vector_ref. May I
+// > > remove it, or is there some use for it?
+// > >
+// > > FYI, the author is listed as "Paul P. Smyth, Vicon Motion
+// > > Systems Ltd."
+// > > and the comment is dated 02 May 2001.
+//
+// Paul Smyth <paul.smyth@vicon.com> writes:
+// > The rationale behind it was that I had some (fast) algorithms for
+// > matrix/vector operations that made use of compile-time knowledge of the
+// > vector and matrix sizes.
+// > This was typically appropriate when trying to interpret a fixed-size
+// > subvector within a large vector of parameters as e.g. a translation.
+// >
+// > As I saw it, the various types of vector possible were: (with their current
+// > names)
+// > - pointer to memory, plus compile-time knowledge of vector size ( T*, and enum{size}) = vnl_vector_fixed_ref
+// > - ownership of memory, plus compile-time size = vnl_vector_fixed
+// > - pointer to memory, plus run-time only knowledge of size (T* and size()) = vnl_vector_ref
+// > - ownership of memory, variably sized = vnl_vector
+// >
+// > I had a conversation with Andrew Fitzgibbon, where he reckoned that the best
+// > thing to do with vnl vectors etc. was to create entirely separate types, and
+// > routines for conversion between them (possibly implicitly), rather that
+// > trying to establish a class hierarchy, which may add too many burdens in
+// > terms of object size for small vectors/matrices.
+// >
+// > Sorry - I've now found the debate on the maintaners list!
+// >
+// > Anyway, I believe that vector_fixed_ref is very necessary, and that you
+// > should be able to convert from a vector_fixed to a vector_fixed_ref - say
+// > using an as_ref() member on vector_fixed or standalone function.
+// > And I believe that for the restructured classes, vector_fixed_ref and
+// > vector_fixed should not be related by inheritance, as that would place an
+// > excessive burden on the size of vector_fixed.
+// >
+// > ------
+// > Another issue - do you have a mechanism for dealing with const data safely?
+// > {
+// > template<typename T, int n>
+// > vnl_vector_fixed_ref(T* i_Data);
+// >
+// > void MyFunction(const vnl_vector<double> & Input)
+// > {
+// > // take a reference to the first 3 elements of Input
+// > vnl_vector_fixed_ref<double,3> ref(Input.begin());
+// > // compiler error - as making vector_fixed_ref from const
+// > double *
+// > }
+// > }
+// >
+// > The options appear to be
+// > 1) Make a separate class vnl_vector_fixed_ref_const
+// > 2) Make vnl_vector_fixed_ref so it can be instantiated with
+// > vnl_vector_fixed_ref<double,n> AND vnl_vector_fixed_ref<const double,n>, and
+// > gives appropriate behaviour - would probably require a to_const function
+// > which generates vnl_vector_fixed_ref<const T,n> from
+// > vnl_vector_fixed_ref<T,n>
+// >
+// > ------
+// > Another note is that a number of routines that use vector_fixed currently
+// > (e.g. cross_3d) should really use vector_fixed_ref as an input, because they
+// > should be able to operate on fixed vector references as well as fixed
+// > vectors.
+// >
+// > While I'm at it, has it been decided that the vnl_vector and vnl_vector_ref
+// > classes are to remain unchanged? Because having vnl_vector as the base, and
+// > vnl_vector_ref derived from it is a real pain in the backside. A vector
+// > which may or may not own its own memory is a more general type than one
+// > which does own it's own memory, and having vnl_vector as the base means that
+// > all sorts of nastinesses can happen. Simply, a vector_ref Is-not a type of
+// > vector.
+// > If anything, it should be the other way round.
+// >
+// > void DoAssign(vnl_vector<double> & RefToMemoryIDontOwn, const vnl_vector<double> & NewContents)
+// > {
+// > RefToMemoryIDontOwn = NewContents;
+// > }
+// >
+// > void DeleteTwice()
+// > {
+// > vnl_vector<double> vec1(3, 0); // size 3 - news 3*double
+// > vnl_vector<double> vec2(4,1); // size 4 news 4 * double
+// > vnl_vector_ref<double> ref_to_1(3,vec1.begin()); // copies pointer
+// > DoAssign(ref_to_1, vec2); // deletes memory owned by 1, news 4 * double
+// > // vec1 now points to deleted memory, and will crash when goes out of scope
+// > }
+// >
+// > Maybe that issue isn't on your agenda - but it's a bit of a disaster. I know
+// > that fixing this might break some code.
+// >
+// > ---------
+// > Sorry for rolling all these things into one - I'd be interested to know what
+// > you think. But please don't kill my vnl_vector_ref!
+// >
+// > Paul.
+//
+// vnl_matrix_fixed_ref is a fixed-size vnl_matrix for which the data space
+// has been supplied externally. This is useful for two main tasks:
+//
+// (a) Treating some row-based "C" matrix as a vnl_matrix in order to
+// perform vnl_matrix operations on it.
+//
+// (b) Declaring a vnl_matrix that uses entirely stack-based storage for the
+// matrix.
+//
+// The big warning is that returning a vnl_matrix_fixed_ref pointer will free
+// non-heap memory if deleted through a vnl_matrix pointer. This should be
+// very difficult though, as vnl_matrix_fixed_ref objects may not be constructed
+// using operator new. This in turn is plausible as the point is to avoid
+// such calls.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// \verbatim
+// Modifications:
+// 27-Nov-1996 Peter Vanroose - added default constructor which allocates matrix storage
+// 4-Jul-2003 Paul Smyth - general cleanup and rewrite; interface now as vnl_matrix_fixed
+// 15-Aug-2003 Peter Vanroose - removed "duplicate" operator=(vnl_matrix_fixed<T,n> const&)
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_cassert.h>
+#include <vcl_iosfwd.h>
+#include <vcl_cstring.h> // memcpy()
+#include <vnl/vnl_matrix_fixed.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_vector_fixed_ref.h>
+#include <vnl/vnl_c_vector.h>
+
+//: Fixed size stack-stored vnl_matrix
+// vnl_matrix_fixed_ref is a fixed-size vnl_matrix for which the data space
+// has been supplied externally. This is useful for two main tasks:
+//
+// (a) Treating some row-based "C" matrix as a vnl_matrix in order to
+// perform vnl_matrix operations on it.
+//
+// (b) Declaring a vnl_matrix that uses entirely stack-based storage for the
+// matrix.
+//
+// The big warning is that returning a vnl_matrix_fixed_ref pointer will free
+// non-heap memory if deleted through a vnl_matrix pointer. This should be
+// very difficult though, as vnl_matrix_fixed_ref objects may not be constructed
+// using operator new. This in turn is plausible as the point is to avoid
+// such calls.
+//
+
+template <class T, unsigned num_rows, unsigned num_cols>
+class vnl_matrix_fixed_ref_const
+{
+ protected:
+ const T* data_;
+ public:
+ vnl_matrix_fixed_ref_const(const vnl_matrix_fixed<T,num_rows,num_cols>& rhs)
+ : data_(rhs.data_block())
+ {
+ }
+ explicit vnl_matrix_fixed_ref_const(const T * dataptr)
+ : data_(dataptr)
+ {
+ }
+ vnl_matrix_fixed_ref_const(const vnl_matrix_fixed_ref_const<T,num_rows,num_cols> & rhs)
+ : data_(rhs.data_)
+ {
+ }
+ //: Get j-th row
+ vnl_vector_fixed<T,num_rows> get_row(unsigned row_index) const
+ {
+ vnl_vector<T> v(num_cols);
+ for (unsigned int j = 0; j < num_cols; j++) // For each element in row
+ v[j] = (*this)(row_index,j);
+ return v;
+ }
+
+ //: Get j-th column
+ vnl_vector_fixed<T,num_cols> get_column(unsigned column_index) const
+ {
+ vnl_vector<T> v(num_rows);
+ for (unsigned int j = 0; j < num_rows; j++)
+ v[j] = (*this)(j,column_index);
+ return v;
+ }
+ const T * data_block() const { return data_; }
+
+ //: Const iterators
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data_; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return begin() + this->size(); }
+
+ //: Type defs for iterators
+ typedef const T element_type;
+ //: Type defs for iterators
+ typedef const T *iterator;
+
+ T const & operator() (unsigned r, unsigned c) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(r<num_rows); // Check the row index is valid
+ assert(c<num_cols); // Check the column index is valid
+#endif
+ return *(data_ + num_cols * r + c);
+ }
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T const * operator[] (unsigned r) const { return data_ + num_cols * r; }
+
+ //: Return number of rows
+ unsigned rows () const { return num_rows; }
+
+ //: Return number of columns
+ // A synonym for cols()
+ unsigned columns () const { return num_cols; }
+
+ //: Return number of columns
+ // A synonym for columns()
+ unsigned cols () const { return num_cols; }
+
+ //: Return number of elements
+ // This equals rows() * cols()
+ unsigned size () const { return num_rows*num_cols; }
+
+
+ //: Print matrix to os in some hopefully sensible format
+ void print(vcl_ostream& os) const;
+
+ void copy_out(T *) const;
+
+ ////--------------------------- Additions ----------------------------
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix_fixed<T,num_rows,num_cols> apply(T (*f)(T)) const;
+
+ //: Make a new matrix by applying function to each element.
+ vnl_matrix_fixed<T,num_rows,num_cols> apply(T (*f)(T const&)) const;
+
+ //: Return transpose
+ vnl_matrix_fixed<T,num_cols,num_rows> transpose () const;
+
+ //: Return conjugate transpose
+ vnl_matrix_fixed<T,num_cols,num_rows> conjugate_transpose () const;
+
+ //: Extract a sub-matrix of size rows x cols, starting at (top,left)
+ // Thus it contains elements [top,top+rows-1][left,left+cols-1]
+ vnl_matrix<T> extract (unsigned rows, unsigned cols,
+ unsigned top=0, unsigned left=0) const;
+
+ //: Get n rows beginning at rowstart
+ vnl_matrix<T> get_n_rows (unsigned rowstart, unsigned n) const;
+
+ //: Get n columns beginning at colstart
+ vnl_matrix<T> get_n_columns(unsigned colstart, unsigned n) const;
+
+ //: Type def for norms.
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of absolute values of elements
+ abs_t array_one_norm() const { return vnl_c_vector<T>::one_norm(begin(), size()); }
+
+ //: Return square root of sum of squared absolute element values
+ abs_t array_two_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return largest absolute element value
+ abs_t array_inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), size()); }
+
+ //: Return sum of absolute values of elements
+ abs_t absolute_value_sum() const { return array_one_norm(); }
+
+ //: Return largest absolute value
+ abs_t absolute_value_max() const { return array_inf_norm(); }
+
+ // $ || M ||_1 := \max_j \sum_i | M_{ij} | $
+ abs_t operator_one_norm() const;
+
+ // $ || M ||_\inf := \max_i \sum_j | M_{ij} | $
+ abs_t operator_inf_norm() const;
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t frobenius_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return Frobenius norm of matrix (sqrt of sum of squares of its elements)
+ abs_t fro_norm() const { return frobenius_norm(); }
+
+ //: Return RMS of all elements
+ abs_t rms() const { return vnl_c_vector<T>::rms_norm(begin(), size()); }
+
+ //: Return minimum value of elements
+ T min_value() const { return vnl_c_vector<T>::min_value(begin(), size()); }
+
+ //: Return maximum value of elements
+ T max_value() const { return vnl_c_vector<T>::max_value(begin(), size()); }
+
+ //: Return mean of all matrix elements
+ T mean() const { return vnl_c_vector<T>::mean(begin(), size()); }
+
+ // predicates
+
+ //: Return true iff the size is zero.
+ bool empty() const { return num_rows==0 && num_cols==0; }
+
+ //: Return true if all elements equal to identity.
+ bool is_identity() const;
+
+ //: Return true if all elements equal to identity, within given tolerance
+ bool is_identity(double tol) const;
+
+ //: Return true if all elements equal to zero.
+ bool is_zero() const;
+
+ //: Return true if all elements equal to zero, within given tolerance
+ bool is_zero(double tol) const;
+
+ //: Return true if finite
+ bool is_finite() const;
+
+ //: Return true if matrix contains NaNs
+ bool has_nans() const;
+
+ //: abort if size is not as expected
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size(unsigned rows, unsigned cols) const
+ {
+#ifndef NDEBUG
+ assert_size_internal(rows, cols);
+#endif
+ }
+ //: abort if matrix contains any INFs or NANs.
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const
+ {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ static void add( const T* a, const T* b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::add(a,b,r); }
+ static void add( const T* a, T b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::add(a,b,r); }
+ static void sub( const T* a, const T* b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::sub(a,b,r); }
+ static void sub( const T* a, T b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::sub(a,b,r); }
+ static void sub( T a, const T* b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::sub(a,b,r); }
+ static void mul( const T* a, const T* b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::mul(a,b,r); }
+ static void mul( const T* a, T b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::mul(a,b,r); }
+ static void div( const T* a, const T* b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::div(a,b,r); }
+ static void div( const T* a, T b, T* r ) { vnl_matrix_fixed<T,num_rows,num_cols>::div(a,b,r); }
+
+ static bool equal( const T* a, const T* b ) { return vnl_matrix_fixed<T,num_rows,num_cols>::equal(a,b); }
+
+ private:
+ const vnl_matrix_fixed_ref_const<T,num_rows,num_cols> & operator=(const vnl_matrix_fixed_ref_const<T,num_rows,num_cols>& ) const
+ {
+ assert(!"Assignment is illegal for a vnl_matrix_fixed_ref_const");
+ return *this;
+ }
+
+ void assert_finite_internal() const;
+
+ void assert_size_internal(unsigned, unsigned) const;
+};
+
+
+template <class T, unsigned num_rows, unsigned num_cols>
+class vnl_matrix_fixed_ref : public vnl_matrix_fixed_ref_const<T,num_rows,num_cols>
+{
+ typedef vnl_matrix_fixed_ref_const<T,num_rows,num_cols> base;
+
+ public:
+ // this is the only point where the const_cast happens
+ // the base class is used to store the pointer, so that conversion is not necessary
+ T * data_block() const {
+ return const_cast<T*>(this->data_);
+ }
+ vnl_matrix_fixed_ref(vnl_matrix_fixed<T,num_rows,num_cols>& rhs)
+ : base(rhs.data_block())
+ {
+ }
+ explicit vnl_matrix_fixed_ref(T * dataptr)
+ : base(dataptr)
+ {
+ }
+
+ //: Copy another vnl_matrix_fixed<T,m,n> into this.
+ vnl_matrix_fixed_ref const & operator=(const vnl_matrix_fixed_ref_const<T,num_rows,num_cols>& rhs) const
+ {
+ vcl_memcpy(data_block(), rhs.data_block(), num_rows*num_cols*sizeof(T));
+ return *this;
+ }
+
+ // Basic 2D-Array functionality-------------------------------------------
+
+ //: set element
+ void put (unsigned r, unsigned c, T const& v) { (*this)(r,c) = v; }
+
+ //: get element
+ T get (unsigned r, unsigned c) const { return (*this)(r,c); }
+
+ //: return pointer to given row
+ // No boundary checking here.
+ T * operator[] (unsigned r) const { return data_block() + num_cols * r; }
+
+
+ //: Access an element for reading or writing
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator() (unsigned r, unsigned c) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(r<num_rows); // Check the row index is valid
+ assert(c<num_cols); // Check the column index is valid
+#endif
+ return *(this->data_block() + num_cols * r + c);
+ }
+
+
+ // Filling and copying------------------------------------------------
+
+ //: Set all elements of matrix to specified value.
+ // Complexity $O(r.c)$
+ void fill (T) const;
+
+ //: Set all diagonal elements of matrix to specified value.
+ // Complexity $O(\min(r,c))$
+ void fill_diagonal (T) const;
+
+ //: Fill (laminate) this matrix with the given data.
+ // We assume that p points to a contiguous rows*cols array, stored rowwise.
+ void copy_in(T const *) const;
+
+ //: Fill (laminate) this matrix with the given data.
+ // A synonym for copy_in()
+ void set(T const *d) const { copy_in(d); }
+
+ //: Fill the given array with this matrix.
+ // We assume that p points to a contiguous rows*cols array, stored rowwise.
+ // No bounds checking on the array
+
+ //: Transpose this matrix efficiently, if it is a square matrix
+ void inplace_transpose() const;
+
+
+ // Arithmetic ----------------------------------------------------
+ // note that these functions should not pass scalar as a const&.
+ // Look what would happen to A /= A(0,0).
+
+ //: Add \a s to each element of lhs matrix in situ
+ vnl_matrix_fixed_ref const& operator+= (T s) const
+ {
+ add( data_block(), s, data_block() ); return *this;
+ }
+
+ //: Subtract \a s from each element of lhs matrix in situ
+ vnl_matrix_fixed_ref const& operator-= (T s) const
+ {
+ sub( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator*= (T s) const
+ {
+ mul( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator/= (T s) const
+ {
+ div( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const & operator+= (vnl_matrix_fixed_ref_const<T,num_rows,num_cols> const& m) const
+ {
+ add( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator+= (vnl_matrix<T> const& m) const
+ {
+ assert( m.rows() == num_rows && m.cols() == num_cols );
+ add( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator-= (vnl_matrix_fixed_ref_const<T,num_rows,num_cols> const& m) const
+ {
+ sub( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator-= (vnl_matrix<T> const& m) const
+ {
+ assert( m.rows() == num_rows && m.cols() == num_cols );
+ sub( data_block(), m.data_block(), data_block() ); return *this;
+ }
+
+ //: Negate all elements of matrix
+ vnl_matrix_fixed<T,num_rows,num_cols> operator- () const
+ {
+ vnl_matrix_fixed<T,num_rows,num_cols> r;
+ sub( T(0), data_block(), r.data_block() );
+ return r;
+ }
+
+ //:
+ vnl_matrix_fixed_ref const& operator*= (vnl_matrix_fixed_ref_const<T,num_cols,num_cols> const& s) const
+ {
+ vnl_matrix_fixed<T, num_rows, num_cols> out;
+ for (unsigned i = 0; i < num_rows; ++i)
+ for (unsigned j = 0; j < num_cols; ++j)
+ {
+ T accum = this->operator()(i,0) * s(0,j);
+ for (unsigned k = 1; k < num_cols; ++k)
+ accum += this->operator()(i,k) * s(k,j);
+ out(i,j) = accum;
+ }
+ *this = out;
+ return *this;
+ }
+
+#ifdef VCL_VC60
+ template<unsigned o>
+ vnl_matrix_fixed<T,num_rows,o> operator*( vnl_matrix_fixed_fake_base<o,num_cols,T> const& mat ) const
+ {
+ vnl_matrix_fixed<T,num_cols,o> const& b = static_cast<vnl_matrix_fixed<T,num_cols,o> const&>(mat);
+ return vnl_matrix_fixed_mat_mat_mult<T,num_rows,num_cols,o>( *this, b );
+ }
+ vnl_vector_fixed<T, num_rows> operator*( vnl_vector_fixed_ref_const<T, num_cols> const& b) const
+ {
+ return vnl_matrix_fixed_mat_vec_mult<T,num_rows,num_cols>(*this,b);
+ }
+#endif
+
+
+ //: Set values of this matrix to those of M, starting at [top,left]
+ vnl_matrix_fixed_ref const & update (vnl_matrix<T> const&, unsigned top=0, unsigned left=0) const;
+
+ //: Set the elements of the i'th column to v[j] (No bounds checking)
+ void set_column(unsigned i, T const * v) const;
+
+ //: Set the elements of the i'th column to value
+ void set_column(unsigned i, T value ) const;
+
+ //: Set j-th column to v
+ void set_column(unsigned j, vnl_vector<T> const& v) const;
+
+ //: Set columns to those in M, starting at starting_column
+ void set_columns(unsigned starting_column, vnl_matrix<T> const& M) const;
+
+ //: Set the elements of the i'th row to v[j] (No bounds checking)
+ void set_row (unsigned i, T const * v) const;
+
+ //: Set the elements of the i'th row to value
+ void set_row (unsigned i, T value ) const;
+
+ //: Set the i-th row
+ void set_row (unsigned i, vnl_vector<T> const&) const;
+
+
+ // mutators
+
+ //: Set this matrix to an identity matrix
+ // Abort if the matrix is not square
+ void set_identity() const;
+
+ //: Reverse order of rows.
+ void flipud() const;
+
+ //: Reverse order of columns.
+ void fliplr() const;
+
+ //: Normalize each row so it is a unit vector
+ // Zero rows are ignored
+ void normalize_rows() const;
+
+ //: Normalize each column so it is a unit vector
+ // Zero columns are ignored
+ void normalize_columns() const;
+
+ //: Scale elements in given row by a factor of T
+ void scale_row (unsigned row, T value) const;
+
+ //: Scale elements in given column by a factor of T
+ void scale_column(unsigned col, T value) const;
+
+
+ ////----------------------- Input/Output ----------------------------
+
+ // : Read a vnl_matrix from an ascii vcl_istream, automatically determining file size if the input matrix has zero size.
+ bool read_ascii(vcl_istream& s) const;
+
+
+ //----------------------------------------------------------------------
+ // Conversion to vnl_matrix_ref.
+
+ // The const version of as_ref should return a const vnl_matrix_ref
+ // so that the vnl_matrix_ref::non_const() cannot be used on
+ // it. This prevents a const vnl_matrix_fixed from being cast into a
+ // non-const vnl_matrix reference, giving a slight increase in type safety.
+
+ //: Explicit conversion to a vnl_matrix_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_matrix_ref but not for vnl_matrix_fixed_ref. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_matrix_ref::non_const
+ vnl_matrix_ref<T> as_ref() { return vnl_matrix_ref<T>( num_rows, num_cols, data_block() ); }
+
+ //: Explicit conversion to a vnl_matrix_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_matrix_ref but not for vnl_matrix_fixed_ref. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_matrix_ref::non_const
+ const vnl_matrix_ref<T> as_ref() const { return vnl_matrix_ref<T>( num_rows, num_cols, const_cast<T*>(data_block()) ); }
+
+ //: Cheap conversion to vnl_matrix_ref
+ // Sometimes, such as with templated functions, the compiler cannot
+ // use this user-defined conversion. For those cases, use the
+ // explicit as_ref() method instead.
+ operator const vnl_matrix_ref<T>() const { return vnl_matrix_ref<T>( num_rows, num_cols, const_cast<T*>(data_block()) ); }
+
+ //: Convert to a vnl_matrix.
+ const vnl_matrix<T> as_matrix() const { return vnl_matrix<T>(const_cast<T*>(data_block()),num_rows,num_cols); }
+
+ //----------------------------------------------------------------------
+
+ typedef T element_type;
+
+ //: Iterators
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() const { return data_block(); }
+ //: Iterator pointing to element beyond end of data
+ iterator end() const { return begin() + this->size(); }
+ //--------------------------------------------------------------------------------
+
+ //: Return true if *this == rhs
+ bool operator_eq (vnl_matrix_fixed_ref_const<T,num_rows,num_cols> const & rhs) const
+ {
+ return equal( this->data_block(), rhs.data_block() );
+ }
+
+ //: Equality operator
+ bool operator==(vnl_matrix_fixed_ref_const<T,num_rows,num_cols> const &that) const { return this->operator_eq(that); }
+
+ //: Inequality operator
+ bool operator!=(vnl_matrix_fixed_ref_const<T,num_rows,num_cols> const &that) const { return !this->operator_eq(that); }
+
+//--------------------------------------------------------------------------------
+};
+
+#undef VNL_MATRIX_FIXED_VCL60_WORKAROUND
+
+ // Helper routines for arithmetic. These routines know the size from
+ // the template parameters. The vector-vector operations are
+ // element-wise.
+
+
+// Make the operators below inline because (1) they are small and
+// (2) we then have less explicit instantiation trouble.
+
+
+// --- Matrix-scalar -------------------------------------------------------------
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( const vnl_matrix_fixed_ref_const<T,m,n>& mat1, const vnl_matrix_fixed_ref_const<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( const vnl_matrix_fixed_ref_const<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator+( T s, const vnl_matrix_fixed_ref_const<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::add( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( const vnl_matrix_fixed_ref_const<T,m,n>& mat1, const vnl_matrix_fixed_ref_const<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( const vnl_matrix_fixed_ref_const<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator-( T s, const vnl_matrix_fixed_ref_const<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::sub( s, mat.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator*( const vnl_matrix_fixed_ref_const<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator*( T s, const vnl_matrix_fixed_ref_const<T,m,n>& mat )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> operator/( const vnl_matrix_fixed_ref_const<T,m,n>& mat, T s )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::div( mat.data_block(), s, r.data_block() );
+ return r;
+}
+
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> element_product( const vnl_matrix_fixed_ref_const<T,m,n>& mat1,
+ const vnl_matrix_fixed_ref_const<T,m,n>& mat2 )
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::mul( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+
+template<class T, unsigned m, unsigned n>
+inline
+vnl_matrix_fixed<T,m,n> element_quotient( const vnl_matrix_fixed_ref_const<T,m,n>& mat1,
+ const vnl_matrix_fixed_ref_const<T,m,n>& mat2)
+{
+ vnl_matrix_fixed<T,m,n> r;
+ vnl_matrix_fixed<T,m,n>::div( mat1.data_block(), mat2.data_block(), r.data_block() );
+ return r;
+}
+
+
+// The following two functions are helper functions that keep the
+// matrix-matrix and matrix-vector multiplication code in one place,
+// so that bug fixes, etc, can be localized.
+template <class T, unsigned M, unsigned N>
+inline
+vnl_vector_fixed<T, M>
+vnl_matrix_fixed_mat_vec_mult(const vnl_matrix_fixed_ref_const<T, M, N>& a,
+ const vnl_vector_fixed_ref_const<T, N>& b)
+{
+ vnl_vector_fixed<T, M> out;
+ for (unsigned i = 0; i < M; ++i)
+ {
+ T accum = a(i,0) * b(0);
+ for (unsigned k = 1; k < N; ++k)
+ accum += a(i,k) * b(k);
+ out(i) = accum;
+ }
+ return out;
+}
+
+// see comment above
+template <class T, unsigned M, unsigned N, unsigned O>
+inline
+vnl_matrix_fixed<T, M, O>
+vnl_matrix_fixed_mat_mat_mult(const vnl_matrix_fixed_ref_const<T, M, N>& a,
+ const vnl_matrix_fixed_ref_const<T, N, O>& b)
+{
+ vnl_matrix_fixed<T, M, O> out;
+ for (unsigned i = 0; i < M; ++i)
+ for (unsigned j = 0; j < O; ++j)
+ {
+ T accum = a(i,0) * b(0,j);
+ for (unsigned k = 1; k < N; ++k)
+ accum += a(i,k) * b(k,j);
+ out(i,j) = accum;
+ }
+ return out;
+}
+
+#ifndef VCL_VC60
+// The version for correct compilers
+
+//: Multiply conformant vnl_matrix_fixed (M x N) and vector_fixed (N)
+// \relates vnl_vector_fixed
+// \relates vnl_matrix_fixed
+template <class T, unsigned M, unsigned N>
+inline
+vnl_vector_fixed<T, M> operator*(const vnl_matrix_fixed_ref_const<T, M, N>& a, const vnl_vector_fixed_ref_const<T, N>& b)
+{
+ return vnl_matrix_fixed_mat_vec_mult(a,b);
+}
+
+//: Multiply two conformant vnl_matrix_fixed (M x N) times (N x O)
+// \relates vnl_matrix_fixed
+template <class T, unsigned M, unsigned N, unsigned O>
+inline
+vnl_matrix_fixed<T, M, O> operator*(const vnl_matrix_fixed_ref_const<T, M, N>& a, const vnl_matrix_fixed_ref_const<T, N, O>& b)
+{
+ return vnl_matrix_fixed_mat_mat_mult(a,b);
+}
+#endif // ! VCL_VC60
+
+
+// These overloads for the common case of mixing a fixed with a
+// non-fixed. Because the operator* are templated, the fixed will not
+// be automatically converted to a non-fixed-ref. These do it for you.
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator+( const vnl_matrix_fixed_ref_const<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() + b;
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator+( const vnl_matrix<T>& a, const vnl_matrix_fixed_ref_const<T,m,n>& b )
+{
+ return a + b.as_ref();
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator-( const vnl_matrix_fixed_ref_const<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() - b;
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator-( const vnl_matrix<T>& a, const vnl_matrix_fixed_ref_const<T,m,n>& b )
+{
+ return a - b.as_ref();
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator*( const vnl_matrix_fixed_ref_const<T,m,n>& a, const vnl_matrix<T>& b )
+{
+ return a.as_ref() * b;
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_matrix<T> operator*( const vnl_matrix<T>& a, const vnl_matrix_fixed_ref_const<T,m,n>& b )
+{
+ return a * b.as_ref();
+}
+
+template<class T, unsigned m, unsigned n>
+inline vnl_vector<T> operator*( const vnl_matrix_fixed_ref_const<T,m,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() * b;
+}
+
+template<class T, unsigned n>
+inline vnl_vector<T> operator*( const vnl_matrix<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return a * b.as_ref();
+}
+
+
+// --- I/O operations ------------------------------------------------------------
+
+template<class T, unsigned m, unsigned n>
+inline
+vcl_ostream& operator<< (vcl_ostream& os, vnl_matrix_fixed_ref_const<T,m,n> const& mat)
+{
+ mat.print(os);
+ return os;
+}
+
+template<class T, unsigned m, unsigned n>
+inline
+vcl_istream& operator>> (vcl_istream& is, vnl_matrix_fixed_ref<T,m,n>& mat)
+{
+ mat.read_ascii(is);
+ return is;
+}
+
+
+#endif // vnl_matrix_fixed_ref_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.txx
new file mode 100644
index 0000000000000000000000000000000000000000..2bf43d7c18eb67ceb5f5a6b5c061e1459facb005
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_fixed_ref.txx
@@ -0,0 +1,698 @@
+// This is core/vnl/vnl_matrix_fixed_ref.txx
+#ifndef vnl_matrix_fixed_ref_txx_
+#define vnl_matrix_fixed_ref_txx_
+
+#include "vnl_matrix_fixed_ref.h"
+//:
+// \file
+
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+#include <vcl_cstdlib.h> // for abort
+#include <vcl_cassert.h>
+
+#include <vnl/vnl_error.h>
+#include <vnl/vnl_math.h>
+
+#if 0 // commented out
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::add( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) + *(b++);
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::add( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) + b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::sub( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) - *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::sub( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) - b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::sub( T a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = a - *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::mul( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) * *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::mul( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) * b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::div( const T* a, const T* b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) / *(b++);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::div( const T* a, T b, T* r )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ *(r++) = *(a++) / b;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::equal( const T* a, const T* b )
+{
+ unsigned int count = nrows*ncols;
+ while ( count-- )
+ if ( *(a++) != *(b++) ) return false;
+ return true;
+}
+#endif // 0
+
+//------------------------------------------------------------
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::fill (T value) const
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ for (unsigned int j = 0; j < ncols; j++)
+ (*this)(i,j) = value;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::fill_diagonal (T value) const
+{
+ for (unsigned int i = 0; i < nrows && i < ncols; i++)
+ (*this)(i,i) = value;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::print(vcl_ostream& os) const
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ os << (*this)(i,0);
+ for (unsigned int j = 1; j < ncols; j++)
+ os << ' ' << (*this)(i,j);
+ os << '\n';
+ }
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,nrows,ncols>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::apply(T (*f)(T const&)) const
+{
+ vnl_matrix_fixed<T,nrows,ncols> ret;
+ vnl_c_vector<T>::apply(this->begin(), rows()*cols(), f, ret.data_block());
+ return ret;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,nrows,ncols>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::apply(T (*f)(T)) const
+{
+ vnl_matrix_fixed<T,nrows,ncols> ret;
+ vnl_c_vector<T>::apply(this->begin(), rows()*cols(), f, ret.data_block());
+ return ret;
+}
+
+////--------------------------- Additions------------------------------------
+
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,ncols,nrows>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::transpose() const
+{
+ vnl_matrix_fixed<T,ncols,nrows> result;
+ for (unsigned int i = 0; i < cols(); i++)
+ for (unsigned int j = 0; j < rows(); j++)
+ result(i,j) = (*this)(j,i);
+ return result;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed<T,ncols,nrows>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::conjugate_transpose() const
+{
+ vnl_matrix_fixed<T,ncols,nrows> result(transpose());
+ vnl_c_vector<T>::conjugate(result.begin(), // src
+ result.begin(), // dst
+ result.size()); // size of block
+ return result;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix_fixed_ref<T,nrows,ncols> const&
+vnl_matrix_fixed_ref<T,nrows,ncols>::update (vnl_matrix<T> const& m,
+ unsigned top, unsigned left) const
+{
+ const unsigned int bottom = top + m.rows();
+ const unsigned int right = left + m.cols();
+#ifndef NDEBUG
+ if (nrows < bottom || ncols < right)
+ vnl_error_matrix_dimension ("update",
+ bottom, right, m.rows(), m.cols());
+#endif
+ for (unsigned int i = top; i < bottom; i++)
+ for (unsigned int j = left; j < right; j++)
+ (*this)(i,j) = m(i-top,j-left);
+ return *this;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::extract (unsigned rowz, unsigned colz,
+ unsigned top, unsigned left) const
+{
+#ifndef NDEBUG
+ unsigned int bottom = top + rowz;
+ unsigned int right = left + colz;
+ if ((nrows < bottom) || (ncols < right))
+ vnl_error_matrix_dimension ("extract",
+ nrows, ncols, bottom, right);
+#endif
+ vnl_matrix<T> result(rowz, colz);
+ for (unsigned int i = 0; i < rowz; i++) // actual copy of all elements
+ for (unsigned int j = 0; j < colz; j++) // in submatrix
+ result(i,j) = (*this)(top+i,left+j);
+ return result;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::copy_in(T const *p) const
+{
+ T* dp = this->data_block();
+ unsigned int i = nrows * ncols;
+ while (i--)
+ *dp++ = *p++;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void vnl_matrix_fixed_ref_const<T,nrows,ncols>::copy_out(T *p) const
+{
+ T const* dp = this->data_block();
+ unsigned int i = nrows*ncols;
+ while (i--)
+ *p++ = *dp++;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_identity() const
+{
+#ifndef NDEBUG
+ if (nrows != ncols) // Size?
+ vnl_error_matrix_nonsquare ("set_identity");
+#endif
+ // Two simple loops are generally better than having a branch inside
+ // the loop. Probably worth the O(n) extra writes.
+ for (unsigned int i = 0; i < nrows; i++)
+ for (unsigned int j = 0; j < ncols; j++)
+ (*this)(i,j) = T(0);
+ for (unsigned int i = 0; i < nrows; i++)
+ (*this)(i,i) = T(1);
+}
+
+//: Make each row of the matrix have unit norm.
+// All-zero rows are ignored.
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::normalize_rows() const
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int j = 0; j < ncols; j++)
+ norm += vnl_math_squared_magnitude( (*this)(i,j) );
+
+ if (norm != 0)
+ {
+ typedef typename vnl_numeric_traits<abs_t>::real_t real_t;
+ real_t scale = real_t(1)/vcl_sqrt((real_t)norm);
+ for (unsigned int j = 0; j < ncols; j++)
+ {
+ // FIXME need correct rounding here
+ // There is e.g. no *standard* operator*=(complex<float>, double), hence the T() cast.
+ (*this)(i,j) *= (T)(scale);
+ }
+ }
+ }
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::normalize_columns() const
+{
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ for (unsigned int j = 0; j < ncols; j++) { // For each column in the Matrix
+ abs_t norm(0); // double will not do for all types.
+ for (unsigned int i = 0; i < nrows; i++)
+ norm += vnl_math_squared_magnitude( (*this)(i,j) );
+
+ if (norm != 0)
+ {
+ typedef typename vnl_numeric_traits<abs_t>::real_t real_t;
+ real_t scale = real_t(1)/vcl_sqrt((real_t)norm);
+ for (unsigned int i = 0; i < nrows; i++)
+ {
+ // FIXME need correct rounding here
+ // There is e.g. no *standard* operator*=(complex<float>, double), hence the T() cast.
+ (*this)(i,j) *= (T)(scale);
+ }
+ }
+ }
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::scale_row(unsigned row_index, T value) const
+{
+#ifndef NDEBUG
+ if (row_index >= nrows)
+ vnl_error_matrix_row_index("scale_row", row_index);
+#endif
+ for (unsigned int j = 0; j < ncols; j++)
+ (*this)(row_index,j) *= value;
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::scale_column(unsigned column_index, T value) const
+{
+#ifndef NDEBUG
+ if (column_index >= ncols)
+ vnl_error_matrix_col_index("scale_column", column_index);
+#endif
+ for (unsigned int j = 0; j < nrows; j++)
+ (*this)(j,column_index) *= value;
+}
+
+//: Returns a copy of n rows, starting from "row"
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::get_n_rows (unsigned row, unsigned n) const
+{
+#ifndef NDEBUG
+ if (row + n > nrows)
+ vnl_error_matrix_row_index ("get_n_rows", row);
+#endif
+
+ // Extract data rowwise.
+ return vnl_matrix<T>((*this)[row], n, ncols);
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+vnl_matrix<T>
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::get_n_columns (unsigned column, unsigned n) const
+{
+#ifndef NDEBUG
+ if (column + n > ncols)
+ vnl_error_matrix_col_index ("get_n_columns", column);
+#endif
+
+ vnl_matrix<T> result(nrows, n);
+ for (unsigned int c = 0; c < n; ++c)
+ for (unsigned int r = 0; r < nrows; ++r)
+ result(r, c) = (*this)(r,column + c);
+ return result;
+}
+
+#if 0 // commented out
+
+//: Create a vector out of row[row_index].
+template<class T, unsigned nrows, unsigned ncols>
+vnl_vector<T> vnl_matrix_fixed_ref_const<T,nrows,ncols>::get_row(unsigned row_index) const
+{
+#if ERROR_CHECKING
+ if (row_index >= nrows)
+ vnl_error_matrix_row_index ("get_row", row_index);
+#endif
+
+ vnl_vector<T> v(ncols);
+ for (unsigned int j = 0; j < ncols; j++) // For each element in row
+ v[j] = (*this)(row_index,j);
+ return v;
+}
+
+//: Create a vector out of column[column_index].
+template<class T, unsigned nrows, unsigned ncols>
+vnl_vector<T> vnl_matrix_fixed_ref_const<T,nrows,ncols>::get_column(unsigned column_index) const
+{
+#if ERROR_CHECKING
+ if (column_index >= ncols)
+ vnl_error_matrix_col_index ("get_column", column_index);
+#endif
+
+ vnl_vector<T> v(nrows);
+ for (unsigned int j = 0; j < nrows; j++)
+ v[j] = (*this)(j,column_index);
+ return v;
+}
+
+#endif // 0
+
+//--------------------------------------------------------------------------------
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_row(unsigned row_index, T const *v) const
+{
+ for (unsigned int j = 0; j < ncols; j++)
+ (*this)(row_index,j) = v[j];
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_row(unsigned row_index, vnl_vector<T> const &v) const
+{
+ set_row(row_index,v.data_block());
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_row(unsigned row_index, T v) const
+{
+ for (unsigned int j = 0; j < ncols; j++)
+ (*this)(row_index,j) = v;
+}
+
+//--------------------------------------------------------------------------------
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_column(unsigned column_index, T const *v) const
+{
+ for (unsigned int i = 0; i < nrows; i++)
+ (*this)(i,column_index) = v[i];
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_column(unsigned column_index, vnl_vector<T> const &v) const
+{
+ set_column(column_index,v.data_block());
+}
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_column(unsigned column_index, T v) const
+{
+ for (unsigned int j = 0; j < nrows; j++)
+ (*this)(j,column_index) = v;
+}
+
+
+template<class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::set_columns(unsigned starting_column, vnl_matrix<T> const& m) const
+{
+#ifndef NDEBUG
+ if (nrows != m.rows() ||
+ ncols < m.cols() + starting_column) // Size match?
+ vnl_error_matrix_dimension ("set_columns",
+ nrows, ncols,
+ m.rows(), m.cols());
+#endif
+
+ for (unsigned int j = 0; j < m.cols(); ++j)
+ for (unsigned int i = 0; i < nrows; i++)
+ (*this)(i,starting_column + j) = m(i,j);
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::is_identity() const
+{
+ T const zero(0);
+ T const one(1);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ {
+ T xm = (*this)(i,j);
+ if ( !((i == j) ? (xm == one) : (xm == zero)) )
+ return false;
+ }
+ return true;
+}
+
+//: Return true if maximum absolute deviation of M from identity is <= tol.
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::is_identity(double tol) const
+{
+ T one(1);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ {
+ T xm = (*this)(i,j);
+ abs_t absdev = (i == j) ? vnl_math_abs(xm - one) : vnl_math_abs(xm);
+ if (absdev > tol)
+ return false;
+ }
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::is_zero() const
+{
+ T const zero(0);
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if ( !( (*this)(i, j) == zero) )
+ return false;
+
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::is_zero(double tol) const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (vnl_math_abs((*this)(i,j)) > tol)
+ return false;
+
+ return true;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::has_nans() const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (vnl_math_isnan((*this)(i,j)))
+ return true;
+
+ return false;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::is_finite() const
+{
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ if (!vnl_math_isfinite((*this)(i,j)))
+ return false;
+
+ return true;
+}
+
+//: Abort if any element of M is inf or nan
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::assert_finite_internal() const
+{
+ if (is_finite())
+ return;
+
+ vcl_cerr << "\n\n" << __FILE__ " : " << __LINE__ << ": matrix has non-finite elements\n";
+
+ if (rows() <= 20 && cols() <= 20)
+ vcl_cerr << __FILE__ ": here it is:\n" << *this << '\n';
+ else
+ {
+ vcl_cerr << __FILE__ ": it is quite big (" << rows() << 'x' << cols() << ")\n"
+ << __FILE__ ": in the following picture '-' means finite and '*' means non-finite:\n";
+
+ for (unsigned int i=0; i<rows(); ++i)
+ {
+ for (unsigned int j=0; j<cols(); ++j)
+ vcl_cerr << char(vnl_math_isfinite((*this)(i, j)) ? '-' : '*');
+ vcl_cerr << '\n';
+ }
+ }
+ vcl_cerr << __FILE__ ": calling abort()\n";
+ vcl_abort();
+}
+
+//: Abort unless M has the given size.
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::assert_size_internal(unsigned rs,unsigned cs) const
+{
+ if (nrows!=rs || ncols!=cs)
+ {
+ vcl_cerr << __FILE__ ": size is " << nrows << 'x' << ncols
+ << ". should be " << rs << 'x' << cs << vcl_endl;
+ vcl_abort();
+ }
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+bool
+vnl_matrix_fixed_ref<T,nrows,ncols>::read_ascii(vcl_istream& s) const
+{
+ if (!s.good())
+ {
+ vcl_cerr << __FILE__ ": vnl_matrix_fixed_ref_const<T,nrows,ncols>::read_ascii: Called with bad stream\n";
+ return false;
+ }
+
+ for (unsigned int i = 0; i < nrows; ++i)
+ for (unsigned int j = 0; j < ncols; ++j)
+ s >> (*this)(i,j);
+
+ return s.good() || s.eof();
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::flipud() const
+{
+ for (unsigned int r1 = 0; 2*r1+1 < nrows; ++r1)
+ {
+ unsigned int r2 = nrows - 1 - r1;
+ for (unsigned int c = 0; c < ncols; ++c)
+ {
+ T tmp = (*this)(r1, c);
+ (*this)(r1, c) = (*this)(r2, c);
+ (*this)(r2, c) = tmp;
+ }
+ }
+}
+
+
+template <class T, unsigned nrows, unsigned ncols>
+void
+vnl_matrix_fixed_ref<T,nrows,ncols>::fliplr() const
+{
+ for (unsigned int c1 = 0; 2*c1+1 < ncols; ++c1)
+ {
+ unsigned int c2 = ncols - 1 - c1;
+ for (unsigned int r = 0; r < nrows; ++r)
+ {
+ T tmp = (*this)(r, c1);
+ (*this)(r, c1) = (*this)(r, c2);
+ (*this)(r, c2) = tmp;
+ }
+ }
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+typename vnl_matrix_fixed_ref_const<T,nrows,ncols>::abs_t
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::operator_one_norm() const
+{
+ abs_t m(0);
+ for (unsigned int j=0; j<ncols; ++j)
+ {
+ abs_t t(0);
+ for (unsigned int i=0; i<nrows; ++i)
+ t += vnl_math_abs( (*this)(i,j) );
+ if (t > m)
+ m = t;
+ }
+ return m;
+}
+
+template <class T, unsigned nrows, unsigned ncols>
+typename vnl_matrix_fixed_ref_const<T,nrows,ncols>::abs_t
+vnl_matrix_fixed_ref_const<T,nrows,ncols>::operator_inf_norm() const
+{
+ abs_t m(0);
+ for (unsigned int i=0; i<nrows; ++i)
+ {
+ abs_t t(0);
+ for (unsigned int j=0; j<ncols; ++j)
+ t += vnl_math_abs( (*this)(i,j) );
+ if (t > m)
+ m = t;
+ }
+ return m;
+}
+
+//: Transpose square matrix M in place.
+template <class T, unsigned nrows, unsigned ncols>
+void vnl_matrix_fixed_ref<T,nrows,ncols>::inplace_transpose() const
+{
+ assert(nrows==ncols); // cannot inplace_transpose non-square fixed size matrix
+ for (unsigned i = 0; i < nrows; ++i)
+ for (unsigned j = i+1; j < ncols; ++j)
+ {
+ T t = (*this)(i,j);
+ (*this)(i,j) = (*this)(j,i);
+ (*this)(j,i) = t;
+ }
+}
+
+
+#define VNL_MATRIX_FIXED_REF_INSTANTIATE(T,m,n) \
+template class vnl_matrix_fixed_ref_const<T, m, n >; \
+template class vnl_matrix_fixed_ref<T, m, n >
+
+#endif // vnl_matrix_fixed_ref_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_ref.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_ref.h
new file mode 100644
index 0000000000000000000000000000000000000000..2c99edeeb0cb3e0426c07939d5cbd60fed48ab38
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_matrix_ref.h
@@ -0,0 +1,114 @@
+// This is core/vnl/vnl_matrix_ref.h
+#ifndef vnl_matrix_ref_h_
+#define vnl_matrix_ref_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief vnl_matrix reference to user-supplied storage.
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// \verbatim
+// Modifications
+// Documentation updated by Ian Scott 12 Mar 2000
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_matrix.h>
+
+//: vnl_matrix reference to user-supplied storage
+// vnl_matrix_ref is a vnl_matrix for which the data space has been
+// supplied externally. This is useful for two main tasks:
+// (a) Treating some row-based "C" matrix as a vnl_matrix in order to
+// perform vnl_matrix operations on it.
+//
+// This is a dangerous class. I believe that I've covered all the bases, but
+// it's really only intended for interfacing with the Fortran routines.
+//
+// The big warning is that returning a vnl_matrix_ref pointer will free non-heap
+// memory if deleted through a vnl_matrix pointer. This should be
+// very difficult though, as vnl_matrix_ref objects may not be constructed using
+// operator new, and are therefore unlikely to be the unwitting subject
+// of an operator delete.
+template <class T>
+class vnl_matrix_ref : public vnl_matrix<T>
+{
+ typedef vnl_matrix<T> Base;
+
+ public:
+ // Constructors/Destructors--------------------------------------------------
+ vnl_matrix_ref(unsigned int m, unsigned int n, T *datablck) {
+ Base::data = vnl_c_vector<T>::allocate_Tptr(m);
+ for (unsigned int i = 0; i < m; ++i)
+ Base::data[i] = datablck + i * n;
+ Base::num_rows = m;
+ Base::num_cols = n;
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ this->vnl_matrix_own_data = 0;
+#endif
+ }
+
+ vnl_matrix_ref(vnl_matrix_ref<T> const & other) : vnl_matrix<T>() {
+ Base::data = vnl_c_vector<T>::allocate_Tptr(other.rows());
+ for (unsigned int i = 0; i < other.rows(); ++i)
+ Base::data[i] = const_cast<T*>(other.data_block()) + i * other.cols();
+ Base::num_rows = other.rows();
+ Base::num_cols = other.cols();
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ this->vnl_matrix_own_data = 0;
+#endif
+ }
+
+ ~vnl_matrix_ref() {
+ Base::data[0] = 0; // Prevent base dtor from releasing our memory
+ }
+
+ //: Reference to self to make non-const temporaries.
+ // This is intended for passing vnl_matrix_fixed objects to
+ // functions that expect non-const vnl_matrix references:
+ // \code
+ // void mutator( vnl_matrix<double>& );
+ // ...
+ // vnl_matrix_fixed<double,5,3> my_m;
+ // mutator( m ); // Both these fail because the temporary vnl_matrix_ref
+ // mutator( m.as_ref() ); // cannot be bound to the non-const reference
+ // mutator( m.as_ref().non_const() ); // works
+ // \endcode
+ // \attention Use this only to pass the reference to a
+ // function. Otherwise, the underlying object will be destructed and
+ // you'll be left with undefined behaviour.
+ vnl_matrix_ref& non_const() { return *this; }
+
+#if 0
+ private:
+ // Private operator new because deleting a pointer to
+ // one of these through a baseclass pointer will attempt
+ // to free this in-class memory.
+ // Therefore disallow newing of these -- if you're paying for
+ // one malloc, you can afford three.
+ // fsm: This was wrong for two reasons:
+ // 1. operator new may not return a null pointer.
+ // 2. it should be enabled for compilers that need it,
+ // not disabled for compilers that don't need it.
+#include <vcl_new.h>
+ void* operator new(vcl_size_t) { return 0; }
+#endif
+
+ private:
+ //: Resizing is disallowed
+ bool resize (unsigned int, unsigned int) { return false; }
+ //: Resizing is disallowed
+ bool make_size (unsigned int, unsigned int) { return false; }
+ //: Resizing is disallowed
+ bool set_size (unsigned int, unsigned int) { return false; }
+
+ //: Copy constructor from vnl_matrix<T> is disallowed
+ // (because it would create a non-const alias to the matrix)
+ vnl_matrix_ref(vnl_matrix<T> const &) {}
+};
+
+#endif // vnl_matrix_ref_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..235a336ae527eeebcc29919f7a7098091a3793ed
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.cxx
@@ -0,0 +1,82 @@
+// This is core/vnl/vnl_nonlinear_minimizer.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG, 22 Aug 99
+
+#include "vnl_nonlinear_minimizer.h"
+#include <vcl_iostream.h>
+#include <vcl_iomanip.h>
+
+//: Default ctor sets verbosity etc.
+vnl_nonlinear_minimizer::vnl_nonlinear_minimizer()
+{
+ xtol = 1e-8; // Termination tolerance on X (solution vector)
+ maxfev = 2000; // Termination maximum number of iterations.
+ ftol = xtol * 0.01; // Termination tolerance on F (sum of squared residuals)
+ gtol = 1e-5; // Termination tolerance on Grad(F)' * F = 0
+ epsfcn = xtol * 0.001; // Step length for FD Jacobian
+ trace = false;
+ verbose_ = false;
+ check_derivatives_=0;
+ failure_code_ = ERROR_FAILURE;
+ reset();
+}
+
+vnl_nonlinear_minimizer::~vnl_nonlinear_minimizer()
+{
+}
+
+vnl_matrix<double> const& vnl_nonlinear_minimizer::get_covariance()
+{
+ static vnl_matrix<double> null;
+ return null;
+}
+
+void vnl_nonlinear_minimizer::reset()
+{
+ num_iterations_ = 0;
+ num_evaluations_ = 0;
+ start_error_ = 0;
+}
+
+//: Called by derived classes after each function evaluation.
+void vnl_nonlinear_minimizer::report_eval(double f)
+{
+ if (num_evaluations_ == 0) {
+ start_error_ = f;
+ end_error_ = f;
+ }
+ if (f < end_error_)
+ end_error_ = f;
+
+ ++num_evaluations_;
+}
+
+//: Called by derived classes after each iteration
+void vnl_nonlinear_minimizer::report_iter()
+{
+ ++num_iterations_;
+ if (verbose_)
+ vcl_cerr << "Iter " << vcl_setw(4) << num_iterations_ << ", Eval "
+ << vcl_setw(4) << num_evaluations_ << ": Best F = "
+ << vcl_setw(10) << end_error_ << '\n';
+}
+
+//: Return the name of the class
+// Used by polymorphic IO
+vcl_string vnl_nonlinear_minimizer::is_a() const
+{
+ static const vcl_string class_name_="vnl_nonlinear_minimizer";
+ return class_name_;
+}
+
+//: Return true if the name of the class matches the argument
+// Used by polymorphic IO
+bool vnl_nonlinear_minimizer::is_class(vcl_string const& s) const
+{
+ return s==vnl_nonlinear_minimizer::is_a();
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.h
new file mode 100644
index 0000000000000000000000000000000000000000..15dc4c944a9f735abb16e69bbc955f1a0fee8d35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_nonlinear_minimizer.h
@@ -0,0 +1,156 @@
+// This is core/vnl/vnl_nonlinear_minimizer.h
+#ifndef vnl_nonlinear_minimizer_h_
+#define vnl_nonlinear_minimizer_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Base class for nonlinear optimization
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 22 Aug 99
+//
+// \verbatim
+// Modifications
+// 22/03/2001 dac - added binary io and tidied documentation
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+
+#include <vcl_string.h>
+#include <vnl/vnl_matrix.h>
+
+
+//: vnl_nonlinear_minimizer is a base class for nonlinear optimization.
+// It defines a few common abilities such as get_num_evaluations.
+// Known derived classes are:
+// - vnl_levenberg_marquardt
+// - vnl_lbfgs
+// - vnl_conjugate_gradient
+// - vnl_brent
+// - vnl_powell
+class vnl_nonlinear_minimizer
+{
+ public:
+ vnl_nonlinear_minimizer();
+
+ virtual ~vnl_nonlinear_minimizer();
+
+
+ //: Set the convergence tolerance on F (sum of squared residuals).
+ // When the differences in successive RMS errors is less than this, the
+ // routine terminates. So this is effectively the desired precision of your
+ // minimization. Setting it too low wastes time, too high might cause early
+ // convergence. The default of 1e-9 is on the safe side, but if speed is an
+ // issue, you can try raising it.
+ void set_f_tolerance(double v) { ftol = v; }
+ double get_f_tolerance() const { return ftol; }
+
+ //: Set the convergence tolerance on X.
+ // When the length of the steps taken in X are about this long, the routine
+ // terminates. The default is 1e-8, which should work for many problems,
+ // but if you can get away with 1e-4, say, minimizations will be much quicker.
+ void set_x_tolerance(double v) {
+ xtol = v;
+ epsfcn = xtol * 0.001;
+ }
+ double get_x_tolerance() const { return xtol; }
+
+ //: Set the convergence tolerance on Grad(F)' * F.
+ void set_g_tolerance(double v) { gtol = v; }
+ double get_g_tolerance() const { return gtol; }
+
+ //: Set the termination maximum number of iterations.
+ void set_max_function_evals(int v) { maxfev = v; }
+ int get_max_function_evals() const { return maxfev; }
+
+ //: Set the step length for FD Jacobian.
+ // Be aware that set_x_tolerance will reset this to xtol * 0.001.
+ // The default is 1e-11.
+ void set_epsilon_function(double v) { epsfcn = v; }
+ double get_epsilon_function() const { return epsfcn; }
+
+ //: Turn on per-iteration printouts.
+ void set_trace(bool on) { trace = on; }
+ bool get_trace() const { return trace; }
+
+ //: Set verbose flag
+ void set_verbose(bool verb) { verbose_ = verb; }
+ bool get_verbose() const { return verbose_; }
+
+ //: Set check_derivatives flag. Negative values may mean fewer checks.
+ void set_check_derivatives(int cd) { check_derivatives_ = cd; }
+ int get_check_derivatives() const { return check_derivatives_; }
+
+ //: Return the error of the function when it was evaluated at the start point of the last minimization.
+ // For minimizers driven by a vnl_least_squares_function (Levenberg-Marquardt)
+ // this is usually the RMS error.
+ // For those driven by a vnl_cost_function (CG, LBFGS, Amoeba) it is simply the
+ // value of the vnl_cost_function at the start (usually the sum of squared residuals).
+ double get_start_error() const { return start_error_; }
+
+ //:Return the best error that was achieved by the last minimization, corresponding to the returned x.
+ double get_end_error() const { return end_error_; }
+
+ //:Return the total number of times the function was evaluated by the last minimization.
+ int get_num_evaluations() const { return num_evaluations_; }
+
+ //:Return the number of {\em iterations} in the last minimization.
+ // Each iteration may have comprised several function evaluations.
+ int get_num_iterations() const { return num_iterations_; }
+
+ //:Return the covariance of the estimate at the end.
+ virtual vnl_matrix<double> const& get_covariance();
+
+ //: Return the name of the class.
+ // Used by polymorphic IO
+ virtual vcl_string is_a() const;
+
+ //: Return true if the name of the class matches the argument.
+ // Used by polymorphic IO
+ virtual bool is_class(vcl_string const& s) const;
+
+ //:Some generic return codes that apply to all minimizers.
+ enum ReturnCodes {
+ ERROR_FAILURE =-1,
+ ERROR_DODGY_INPUT = 0,
+ CONVERGED_FTOL = 1,
+ CONVERGED_XTOL = 2,
+ CONVERGED_XFTOL = 3,
+ CONVERGED_GTOL = 4,
+ FAILED_TOO_MANY_ITERATIONS = 5,
+ FAILED_FTOL_TOO_SMALL = 6,
+ FAILED_XTOL_TOO_SMALL = 7,
+ FAILED_GTOL_TOO_SMALL = 8
+ };
+
+ //:Return the failure code of the last minimization
+ ReturnCodes get_failure_code() const { return failure_code_; }
+
+ protected:
+ // Data Members--------------------------------------------------------------
+ // Input variables
+ double xtol; //!< Termination tolerance on X (solution vector)
+ int maxfev; //!< Termination maximum number of iterations
+ double ftol; //!< Termination tolerance on F (sum of squared residuals)
+ double gtol; //!< Termination tolerance on Grad(F)' * F = 0
+ double epsfcn; //!< Step length for FD Jacobian
+
+ // Output variables
+ unsigned num_iterations_;
+ int num_evaluations_;
+ double start_error_;
+ double end_error_;
+
+ bool trace;
+
+ // Verbose flag.
+ bool verbose_;
+ int check_derivatives_;
+ ReturnCodes failure_code_;
+
+ void reset();
+ void report_eval(double f);
+ void report_iter();
+};
+
+#endif // vnl_nonlinear_minimizer_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..0c662a25c4e8fd5b8fc98304b63eb61431a02c16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.cxx
@@ -0,0 +1,98 @@
+// This is core/vnl/vnl_numeric_traits.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// Created: 12 Feb 98
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_numeric_traits.h"
+#include <vcl_complex.h>
+#include <vxl_config.h>
+
+static const long s16 = 0x7fffL;
+static const unsigned long u16 = 0xffffL;
+static const long s32 = 0x7fffffffL;
+static const unsigned long u32 = 0xffffffffL;
+#if VXL_HAS_INT_64 // need this arithmetic magic to avoid compiler errors
+static const vxl_uint_64 u64 = (vxl_uint_64)(-1);
+static const vxl_sint_64 s64 = u64/2;
+#else // dummy
+static const long s64 = 0L;
+static const unsigned long u64 = 0L;
+#endif
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vnl_numeric_traits<bool>::zero VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const char vnl_numeric_traits<char>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const unsigned char vnl_numeric_traits<unsigned char>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const signed char vnl_numeric_traits<signed char>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const short vnl_numeric_traits<short>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const unsigned short vnl_numeric_traits<unsigned short>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const int vnl_numeric_traits<int>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const unsigned int vnl_numeric_traits<unsigned int>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const long vnl_numeric_traits<long>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+const unsigned long vnl_numeric_traits<unsigned long>::zero VCL_STATIC_CONST_INIT_INT_DEFN(0);
+#endif
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vnl_numeric_traits<bool>::one VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const char vnl_numeric_traits<char>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const unsigned char vnl_numeric_traits<unsigned char>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const signed char vnl_numeric_traits<signed char>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const short vnl_numeric_traits<short>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const unsigned short vnl_numeric_traits<unsigned short>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const int vnl_numeric_traits<int>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const unsigned int vnl_numeric_traits<unsigned int>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const long vnl_numeric_traits<long>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+const unsigned long vnl_numeric_traits<unsigned long>::one VCL_STATIC_CONST_INIT_INT_DEFN(1);
+#endif
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vnl_numeric_traits<bool>::maxval VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const char vnl_numeric_traits<char>::maxval VCL_STATIC_CONST_INIT_INT_DEFN(char(255)<0?127:255);
+// It is 127 when "char" is signed and 255 when "char" is unsigned.
+const unsigned char vnl_numeric_traits<unsigned char>::maxval VCL_STATIC_CONST_INIT_INT_DEFN(255);
+const signed char vnl_numeric_traits<signed char>::maxval VCL_STATIC_CONST_INIT_INT_DEFN(127);
+#endif
+
+const short vnl_numeric_traits<short>::maxval = s16;
+const unsigned short vnl_numeric_traits<unsigned short>::maxval = u16;
+const int vnl_numeric_traits<int>::maxval = sizeof(int)==4?s32:s16;
+const unsigned int vnl_numeric_traits<unsigned int>::maxval = sizeof(unsigned int)==4?u32:u16;
+const long vnl_numeric_traits<long>::maxval = sizeof(long)==8?s64:s32;
+const unsigned long vnl_numeric_traits<unsigned long>::maxval = sizeof(unsigned long)==8?u64:u32;
+
+#if !VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN
+const float vnl_numeric_traits<float>::zero VCL_STATIC_CONST_INIT_FLOAT_DEFN(0.0F);
+const double vnl_numeric_traits<double>::zero VCL_STATIC_CONST_INIT_FLOAT_DEFN(0.0);
+const long double vnl_numeric_traits<long double>::zero VCL_STATIC_CONST_INIT_FLOAT_DEFN(0.0);
+
+const float vnl_numeric_traits<float>::one VCL_STATIC_CONST_INIT_FLOAT_DEFN(1.0F);
+const double vnl_numeric_traits<double>::one VCL_STATIC_CONST_INIT_FLOAT_DEFN(1.0);
+const long double vnl_numeric_traits<long double>::one VCL_STATIC_CONST_INIT_FLOAT_DEFN(1.0);
+
+const float vnl_numeric_traits<float>::maxval VCL_STATIC_CONST_INIT_FLOAT_DEFN(3.40282346638528860e+38F);
+const double vnl_numeric_traits<double>::maxval VCL_STATIC_CONST_INIT_FLOAT_DEFN(1.7976931348623157E+308);
+const long double vnl_numeric_traits<long double>::maxval VCL_STATIC_CONST_INIT_FLOAT_DEFN(1.7976931348623157E+308);
+#endif
+
+// Must use constructor-call syntax for initialization of complex
+// specializations for Borland compiler.
+const vcl_complex<float> vnl_numeric_traits<vcl_complex<float> >::zero(0.0f);
+const vcl_complex<double> vnl_numeric_traits<vcl_complex<double> >::zero(0.0);
+const vcl_complex<long double> vnl_numeric_traits<vcl_complex<long double> >::zero(0.0);
+
+const vcl_complex<float> vnl_numeric_traits<vcl_complex<float> >::one(1.0f);
+const vcl_complex<double> vnl_numeric_traits<vcl_complex<double> >::one(1.0);
+const vcl_complex<long double> vnl_numeric_traits<vcl_complex<long double> >::one(1.0);
+
+// Unknown, so undefined. Will cause link errors if someone refers to it.
+//const vcl_complex<float> vnl_numeric_traits<vcl_complex<float> >::maxval;
+//const vcl_complex<double> vnl_numeric_traits<vcl_complex<double> >::maxval;
+//const vcl_complex<long double> vnl_numeric_traits<vcl_complex<long double> >::maxval;
+
+//--------------------------------------------------------------------------------
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.h
new file mode 100644
index 0000000000000000000000000000000000000000..9825612ea5e3c7bcc6ac913552d98c4852306388
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_numeric_traits.h
@@ -0,0 +1,442 @@
+// This is core/vnl/vnl_numeric_traits.h
+#ifndef vnl_numeric_traits_h_
+#define vnl_numeric_traits_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Templated zero/one/precision
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Sep 96
+//
+// To allow templated numerical algorithms to determine appropriate
+// values for zero, one, maxval, and types for double precision,
+// maximum product etc.
+//
+// \verbatim
+// Modifications
+// 980212 AWF Initial version.
+// AWF 010498 Moved to math
+// LSB (Manchester) 23/3/01 Documentation tidied
+// Peter Vanroose 14/7/01 vnl_rational added
+// Peter Vanroose 14/10/01 vnl_rational moved to vnl_rational.h
+// AWF 250202 Add const T specializations for the basic types.
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vxl_config.h> // for type vxl_uint_64
+#include <vcl_complex.h>
+
+// this is an empty class template.
+// only the specializations make sense.
+#if !defined(VCL_VC)
+template <class T>
+class vnl_numeric_traits;
+#else
+// However, *some* compilers require the template to be defined
+// under some circumstances...
+// Since the non-specialized template doesn't make any sense, make
+// sure that any types "accidently" derived from it will cause
+// compiler errors.
+class vnl_numeric_traits_not_a_valid_type { };
+template <class T>
+class vnl_numeric_traits
+{
+ public:
+ //: Additive identity
+ static const vnl_numeric_traits_not_a_valid_type zero;
+
+ //: Multiplicative identity
+ static const vnl_numeric_traits_not_a_valid_type one;
+
+ //: Maximum value which this type can assume
+ static const vnl_numeric_traits_not_a_valid_type maxval;
+
+ //: Return value of abs()
+ typedef vnl_numeric_traits_not_a_valid_type abs_t;
+
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vnl_numeric_traits_not_a_valid_type double_t;
+
+ //: Name of type which results from multiplying this type with a double
+ typedef vnl_numeric_traits_not_a_valid_type real_t;
+};
+#endif
+
+#ifndef NO_STD_BOOL
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<bool>
+{
+ public:
+ //: Additive identity
+ static const bool zero VCL_STATIC_CONST_INIT_INT_DECL(false);
+ //: Multiplicative identity
+ static const bool one VCL_STATIC_CONST_INIT_INT_DECL(true);
+ //: Maximum value which this type can assume
+ static const bool maxval VCL_STATIC_CONST_INIT_INT_DECL(true);
+ //: Return value of abs()
+ typedef unsigned int abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef unsigned int double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<bool const> : public vnl_numeric_traits<bool> {};
+#endif
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<char>
+{
+ public:
+ //: Additive identity
+ static const char zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const char one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume.
+ // It is 127 (and not 255) since "char" is not guaranteed to be unsigned.
+ static const char maxval VCL_STATIC_CONST_INIT_INT_DECL(char(255)<0?127:255);
+ //: Return value of abs()
+ typedef unsigned char abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef short double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<char const> : public vnl_numeric_traits<char> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned char>
+{
+ public:
+ //: Additive identity
+ static const unsigned char zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const unsigned char one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const unsigned char maxval VCL_STATIC_CONST_INIT_INT_DECL(255);
+ //: Return value of abs()
+ typedef unsigned char abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef unsigned short double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned char const> : public vnl_numeric_traits<unsigned char> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<signed char>
+{
+ public:
+ //: Additive identity
+ static const signed char zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const signed char one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const signed char maxval VCL_STATIC_CONST_INIT_INT_DECL(127);
+ //: Return value of abs()
+ typedef unsigned char abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef signed short double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<signed char const> : public vnl_numeric_traits<signed char> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<short>
+{
+ public:
+ //: Additive identity
+ static const short zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const short one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const short maxval; // = 0x7fff;
+ //: Return value of abs()
+ typedef unsigned short abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef int double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<short const> : public vnl_numeric_traits<short> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned short>
+{
+ public:
+ //: Additive identity
+ static const unsigned short zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const unsigned short one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const unsigned short maxval; // = 0xffff;
+ //: Return value of abs()
+ typedef unsigned short abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef unsigned int double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned short const> : public vnl_numeric_traits<unsigned short> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<int>
+{
+ public:
+ //: Additive identity
+ static const int zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const int one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const int maxval; // = 0x7fffffff;
+ //: Return value of abs()
+ typedef unsigned int abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef long double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<int const> : public vnl_numeric_traits<int> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned int>
+{
+ public:
+ //: Additive identity
+ static const unsigned int zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const unsigned int one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const unsigned int maxval; // = 0xffffffff;
+ //: Return value of abs()
+ typedef unsigned int abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef unsigned long double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned int const> : public vnl_numeric_traits<unsigned int> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<long>
+{
+ public:
+ //: Additive identity
+ static const long zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const long one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const long maxval; // = 0x7fffffffL or 0x7fffffffffffffffL;
+ //: Return value of abs()
+ typedef unsigned long abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vxl_sint_64 double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<long const> : public vnl_numeric_traits<long > {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned long>
+{
+ public:
+ //: Additive identity
+ static const unsigned long zero VCL_STATIC_CONST_INIT_INT_DECL(0);
+ //: Multiplicative identity
+ static const unsigned long one VCL_STATIC_CONST_INIT_INT_DECL(1);
+ //: Maximum value which this type can assume
+ static const unsigned long maxval; // = 0xffffffffL or 0xffffffffffffffffL;
+ //: Return value of abs()
+ typedef unsigned long abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vxl_uint_64 double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<unsigned long const> : public vnl_numeric_traits<unsigned long> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<float>
+{
+ public:
+ //: Additive identity
+ static const float zero VCL_STATIC_CONST_INIT_FLOAT_DECL(0.0F);
+ //: Multiplicative identity
+ static const float one VCL_STATIC_CONST_INIT_FLOAT_DECL(1.0F);
+ //: Maximum value which this type can assume
+ static const float maxval VCL_STATIC_CONST_INIT_FLOAT_DECL(3.40282346638528860e+38F);
+ //: Return value of abs()
+ typedef float abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef double double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<float const> : public vnl_numeric_traits<float> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<double>
+{
+ public:
+ //: Additive identity
+ static const double zero VCL_STATIC_CONST_INIT_FLOAT_DECL(0.0);
+ //: Multiplicative identity
+ static const double one VCL_STATIC_CONST_INIT_FLOAT_DECL(1.0);
+ //: Maximum value which this type can assume
+ static const double maxval VCL_STATIC_CONST_INIT_FLOAT_DECL(1.7976931348623157E+308);
+ //: Return value of abs()
+ typedef double abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef long double double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<double const> : public vnl_numeric_traits<double> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<long double>
+{
+ public:
+ //: Additive identity
+ static const long double zero VCL_STATIC_CONST_INIT_FLOAT_DECL(0.0);
+ //: Multiplicative identity
+ static const long double one VCL_STATIC_CONST_INIT_FLOAT_DECL(1.0);
+ //: Maximum value which this type can assume
+ static const long double maxval VCL_STATIC_CONST_INIT_FLOAT_DECL(1.7976931348623157E+308);
+ //: Return value of abs()
+ typedef long double abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef long double double_t; // ahem
+ //: Name of type which results from multiplying this type with a double
+ typedef long double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<long double const> : public vnl_numeric_traits<long double> {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits< vcl_complex<float> >
+{
+ public:
+ //: Additive identity
+ static const vcl_complex<float> zero;
+ //: Multiplicative identity
+ static const vcl_complex<float> one;
+ // Maximum value which this type can assume; makes no sense for this type
+ //static const vcl_complex<float> maxval;
+
+ //: Return value of abs()
+ typedef float abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vcl_complex<vnl_numeric_traits<float>::double_t> double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef vcl_complex<float> real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vcl_complex<float> const> : public vnl_numeric_traits<vcl_complex<float> > {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits< vcl_complex<double> >
+{
+ public:
+ //: Additive identity
+ static const vcl_complex<double> zero;
+ //: Multiplicative identity
+ static const vcl_complex<double> one;
+ // Maximum value which this type can assume; makes no sense for this type
+ //static const vcl_complex<double> maxval;
+
+ //: Return value of abs()
+ typedef double abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vcl_complex<vnl_numeric_traits<double>::double_t> double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef vcl_complex<double> real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vcl_complex<double> const> : public vnl_numeric_traits<vcl_complex<double> > {};
+#endif
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits< vcl_complex<long double> >
+{
+ public:
+ //: Additive identity
+ static const vcl_complex<long double> zero;
+ //: Multiplicative identity
+ static const vcl_complex<long double> one;
+ // Maximum value which this type can assume; makes no sense for this type
+ //static const vcl_complex<long double> maxval;
+
+ //: Return value of abs()
+ typedef long double abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vcl_complex<vnl_numeric_traits<long double>::double_t> double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef vcl_complex<long double> real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vcl_complex<long double> const> : public vnl_numeric_traits<vcl_complex<long double> > {};
+#endif
+
+#endif // vnl_numeric_traits_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_operators.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_operators.h
new file mode 100644
index 0000000000000000000000000000000000000000..525475f7e7dc6a75c67094e9177fc299d25317ec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_operators.h
@@ -0,0 +1,89 @@
+// This is core/vnl/vnl_operators.h
+#ifndef vnl_operators_h_
+#define vnl_operators_h_
+//:
+// \file
+// \brief Various operators for templated vnl classes
+// \author Ian Scott
+
+
+//: Define a complete ordering on vnl_vector
+// This is useful to create a set, or map of vectors.
+//
+// The ordering itself is implementation defined - so don't rely
+// on the meaning of less here.
+//
+// \relates vnl_vector
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_fixed.h>
+
+
+template<class T>
+bool operator<(vnl_vector<T> const& lhs, vnl_vector<T> const& rhs)
+{
+ if (&lhs == &rhs) return false; // same object => equal.
+
+ if (lhs.size() < rhs.size()) return true; // Size different ?
+ else if (lhs.size() > rhs.size()) return false;
+
+ for (unsigned i = 0; i < lhs.size(); i++) // For each index
+ {
+ if (lhs(i) < rhs(i)) return true; // Element different ?
+ else if (lhs(i) > rhs(i)) return false;
+ }
+ return false; // Else all same.
+}
+
+
+//: Define a complete ordering on vnl_matrix
+// This is useful to create a set, or map of matrices.
+//
+// The ordering itself is implementation defined - so don't rely
+// on the meaning of less here.
+//
+// \relates vnl_matrix
+template<class T>
+bool operator<(vnl_matrix<T> const& lhs, vnl_matrix<T> const& rhs)
+{
+ if (&lhs == &rhs) return false; // same object => equal.
+
+ if (lhs.rows() < rhs.rows()) return true; // Size different ?
+ else if (lhs.rows() > rhs.rows()) return false;
+ else if (lhs.cols() < rhs.cols()) return true;
+ else if (lhs.cols() > rhs.cols()) return false;
+
+
+ for (unsigned i = 0; i < lhs.size(); i++) // For each index
+ {
+ if (lhs.data_block()[i] < rhs.data_block()[i]) return true; // Element different ?
+ else if (lhs.data_block()[i] > rhs.data_block()[i]) return false;
+ }
+ return false; // Else all same.
+}
+
+
+//: Define a complete ordering on vnl_vector_fixed
+// This is useful to create a set, or map of vectors.
+//
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+bool operator<(vnl_vector_fixed<T,n> const& lhs, vnl_vector_fixed<T,n> const& rhs)
+{
+ return lhs.as_ref() < rhs.as_ref();
+}
+
+
+//: Define a complete ordering on vnl_matrix_fixed
+// This is useful to create a set, or map of matrices.
+//
+// \relates vnl_matrix_fixed
+template<class T, unsigned int n, unsigned int m>
+bool operator<(vnl_matrix_fixed<T,n,m> const& lhs, vnl_matrix_fixed<T,n,m> const& rhs)
+{
+ return lhs.as_ref() < rhs.as_ref();
+}
+
+#endif // vnl_operators_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.h
new file mode 100644
index 0000000000000000000000000000000000000000..7a9d1ceda3abdbe85d51c0b01fa887232ab8f1ce
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.h
@@ -0,0 +1,157 @@
+// This is core/vnl/vnl_quaternion.h
+#ifndef vnl_quaternion_h_
+#define vnl_quaternion_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Unit quaternion represents rotation in 3D.
+// \author awf@robots.ox.ac.uk
+// \date 16 Mar 00
+//
+// \verbatim
+// Modifications
+// 20-05-2000 fsm. changed FLOAT to T since gcc will barf at
+// the very reasonable forward declaration
+// template <class FLOAT> class vnl_quaternion;
+// 23-3-2001 LSB (Manchester) Tidied documentation
+// 13-1-2003 Peter Vanroose - removed unimplemented method rotation_matrix()
+// \endverbatim
+
+#include <vnl/vnl_vector_fixed.h>
+#include <vnl/vnl_matrix_fixed.h>
+#include <vcl_iostream.h>
+
+//: 4-element vector that represents rotation in 3D.
+// vnl_quaternion is a 4-element vector with 1 real and 3 imaginary
+// components:
+// \code
+// q = r + (i*x + j*y + k*z)
+// r = cos(theta/2)
+// (x, y, z) = sin(theta/2) (kx, ky, kz)
+// \endcode
+// where theta and k are respectively the angle and axis of rotation.
+// 3D vectors can be thought of as imaginary quaternions, and so a
+// quaternion is represented as a vnl_vector<T> with the imaginary
+// part before the real part for 1-1 alignment.
+//
+// Unit quaternions provide a more efficient representation for
+// rotation, than the usual orthonormal matrix that has nine
+// parameters and six orthonormal constraints. The unit
+// quaternion has only one unit magnitude constraint. Composing
+// rotations with quaternions results in fewer multiplications
+// and less error. To insure valid rotation results, the
+// nearest unit quaternion is computed, and this is much easier
+// than finding the nearest orthonormal matrix. Transforming
+// vectors with a quaternion requires more operations compared
+// to multiplication with the equivalent orthonormal matrix.
+//
+// \sa
+// vnl_vector<T> and vnl_matrix<T> for basic operations on vectors and matrices.
+// \sa
+// CoolTransform for coordinate transformations.
+// \sa
+// Envelope for envelope-letter scheme that avoids deep copy on
+// return by value in arithmetic expressions like: q1 * q2 * q3 *...
+//
+
+export template <class T>
+class vnl_quaternion : public vnl_vector_fixed<T, 4>
+{
+ typedef vnl_vector_fixed<T, 4> Base;
+ public:
+
+ //: Constructor for null quaternion
+ vnl_quaternion () {}
+
+ //: Construct quaternion from components x,y,z,r
+ vnl_quaternion (T x, T y, T z, T r);
+
+ //: Construct quaternion from axis and angle of rotation
+ vnl_quaternion (const vnl_vector<T>& axis, T angle);
+
+ //: Construct quaternion from from 3-4 square row-major
+ explicit vnl_quaternion (const vnl_matrix<T>& transform); // from 3-4 square row-major
+
+ //: Construct quaternion from from from 3-4D vector
+ vnl_quaternion (const vnl_vector<T>& vec);
+
+ //: Construct quaternion from from from 4D vector
+ vnl_quaternion (const vnl_vector_fixed<T,4>& vec);
+
+ //: Copy constructor -- Creates a copy of from quaternion.
+ inline vnl_quaternion (const vnl_quaternion<T>& from) : Base(from) {}
+
+ //: Free internal array
+ inline ~vnl_quaternion() {} // vnl_vector will free data array
+
+ //: Overloads assignment operator to copy rhs quaternion into lhs quaternion.
+ inline vnl_quaternion& operator= (const vnl_quaternion<T>& rhs) { Base::operator=(rhs); return *this; }
+
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to both get and set the component.
+ inline T& x () { return this->operator()(0); }
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to both get and set the component.
+ inline T& y () { return this->operator()(1); }
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to both get and set the component.
+ inline T& z () { return this->operator()(2); }
+ //: Real component.
+ // Use this accessor to both get and set the component.
+ inline T& r () { return this->operator()(3); }
+
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to get the component.
+ inline T x () const { return this->operator()(0); }
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to get the component.
+ inline T y () const { return this->operator()(1); }
+ //: Imaginary component, parallel to axis of rotation.
+ // Use this accessor to get the component.
+ inline T z () const { return this->operator()(2); }
+ //: Real component.
+ // Use this accessor to get the component.
+ inline T r () const { return this->operator()(3); }
+
+ //: Copies and returns the real part.
+ inline T real () const { return (*this)[3]; }
+
+ //: Copies and returns the imaginary part.
+ inline vnl_vector<T> imaginary () const { return this->extract(3,0); }
+
+ //: Axis of rotation
+ vnl_vector<T> axis () const;
+
+ //: Angle of rotation
+ T angle () const;
+
+ //: 3x3 rotation matrix
+ vnl_matrix_fixed<T,3,3> rotation_matrix_transpose () const;
+
+ //: 4x4 rotation matrix
+ vnl_matrix_fixed<T,4,4> rotation_matrix_transpose_4 () const;
+
+ //: Same real, opposite img part
+ vnl_quaternion<T> conjugate () const;
+
+ //: Inverse for nonzero quat
+ vnl_quaternion<T> inverse () const;
+
+ vnl_quaternion<T> operator* (const vnl_quaternion<T>&) const;
+
+ //: Rotate 3D v
+ vnl_vector<T> rotate (const vnl_vector<T>& v) const;
+};
+
+//: operator<<
+// \relates vnl_quaternion
+template <class T>
+inline vcl_ostream& operator<< (vcl_ostream& os, const vnl_quaternion<T>& q) {
+ return os << *((const vnl_vector_fixed<T,4>*) &q);
+}
+
+#define VNL_QUATERNION_INSTANTIATE(T) extern "you must include vnl/vnl_quaternion.txx first"
+
+#endif // vnl_quaternion_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.txx
new file mode 100644
index 0000000000000000000000000000000000000000..411e377f0a8915bff202eacd7839e3e6b063e243
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_quaternion.txx
@@ -0,0 +1,274 @@
+// This is core/vnl/vnl_quaternion.txx
+#ifndef vnl_quaternion_txx_
+#define vnl_quaternion_txx_
+//:
+// \file
+//
+// Copyright (C) 1992 General Electric Company.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// General Electric Company,
+// provides this software "as is" without express or implied warranty.
+//
+// Created: VDN 06/23/92 design and implementation
+//
+// Quaternion IS-A vector, and is a special case of general n-dimensional space.
+// The IS-A relationship is enforced with public inheritance.
+// All member functions on vectors are applicable to quaternions.
+//
+// Rep Invariant:
+// - norm = 1, for a rotation.
+// - position vector represented by imaginary quaternion.
+// References:
+// - Horn, B.K.P. (1987) Closed-form solution of absolute orientation using
+// unit quaternions. J. Opt. Soc. Am. Vol 4, No 4, April.
+// - Horn, B.K.P. (1987) Robot Vision. MIT Press. pp. 437-551.
+//
+
+
+#include "vnl_quaternion.h"
+
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+
+#include <vnl/vnl_cross.h>
+
+//: Creates a quaternion from its ordered components.
+// x, y, z denote the imaginary part, which are the coordinates
+// of the rotation axis multiplied by the sine of half the
+// angle of rotation. r denotes the real part, or the
+// cosine of half the angle of rotation. Default is to
+// create a null quaternion, corresponding to a null rotation
+// or an identity transform, which has undefined
+// rotation axis.
+
+template <class T>
+vnl_quaternion<T>::vnl_quaternion (T x, T y, T z, T r)
+{
+ this->operator[](0) = x; // 3 first elements are
+ this->operator[](1) = y; // imaginary parts
+ this->operator[](2) = z;
+ this->operator[](3) = r; // last element is real part
+}
+
+//: Creates a quaternion from the normalized axis direction and the angle of rotation in radians.
+
+template <class T>
+vnl_quaternion<T>::vnl_quaternion (const vnl_vector<T>& axis, T angle)
+{
+ double a = angle * 0.5; // half angle
+ T s = T(vcl_sin(a));
+ for (int i = 0; i < 3; i++) // imaginary vector is sine of
+ this->operator[](i) = s * axis(i); // half angle multiplied with axis
+ this->operator[](3) = T(vcl_cos(a)); // real part is cosine of half angle
+}
+
+//: Creates a quaternion from a vector.
+// 2D or 3D vector is converted into an imaginary quaternion with same
+// (x, y, z) components. 4D vector is assumed to be a 4-element
+// quaternion, to provide casting between vector and quaternion.
+
+template <class T>
+vnl_quaternion<T>::vnl_quaternion (const vnl_vector<T>& vec)
+{
+ unsigned i = 0;
+ for (; i < vec.size(); i++) // 1-1 layout between vector & quaternion
+ this->operator[](i) = vec.get(i);
+ for (; i < 4; i++)
+ this->operator[](i) = 0.0;
+}
+
+//: Creates a quaternion from a vector.
+// 4D vector is assumed to be a 4-element quaternion, to
+// provide casting between vector and quaternion
+
+template <class T>
+vnl_quaternion<T>::vnl_quaternion (const vnl_vector_fixed<T,4>& vec)
+{
+ for (unsigned int i = 0; i < vec.size(); i++) // 1-1 layout between vector & quaternion
+ this->operator[](i) = vec[i];
+}
+
+
+//: Creates a quaternion from a rotation matrix.
+// Its orthonormal basis vectors are row-wise in the top-left most block.
+// The transform matrix may be any size,
+// but the rotation matrix must be the upper left 3x3.
+// WARNING: Takes the transpose of the rotation matrix...
+template <class T>
+vnl_quaternion<T>::vnl_quaternion (const vnl_matrix<T>& transform)
+{
+ vnl_matrix_fixed<T,3,3> rot = transform.extract(3, 3, 0, 0);
+ double d0 = rot(0,0), d1 = rot(1,1), d2 = rot(2,2);
+ double xx = 1.0 + d0 - d1 - d2; // from the diagonal of rotation
+ double yy = 1.0 - d0 + d1 - d2; // matrix, find the terms in
+ double zz = 1.0 - d0 - d1 + d2; // each Quaternion compoment
+ double rr = 1.0 + d0 + d1 + d2;
+
+ double max = rr; // find the maximum of all
+ if (xx > max) max = xx; // diagonal terms.
+ if (yy > max) max = yy;
+ if (zz > max) max = zz;
+
+ if (rr == max) {
+ T r4 = T(vcl_sqrt(rr * 4.0));
+ this->x() = (rot(1,2) - rot(2,1)) / r4; // find other components from
+ this->y() = (rot(2,0) - rot(0,2)) / r4; // off diagonal terms of
+ this->z() = (rot(0,1) - rot(1,0)) / r4; // rotation matrix.
+ this->r() = r4 / 4;
+ } else if (xx == max) {
+ T x4 = T(vcl_sqrt(xx * 4.0));
+ this->x() = x4 / 4;
+ this->y() = (rot(0,1) + rot(1,0)) / x4;
+ this->z() = (rot(0,2) + rot(2,0)) / x4;
+ this->r() = (rot(1,2) - rot(2,1)) / x4;
+ } else if (yy == max) {
+ T y4 = T(vcl_sqrt(yy * 4.0));
+ this->x() = (rot(0,1) + rot(1,0)) / y4;
+ this->y() = y4 / 4;
+ this->z() = (rot(1,2) + rot(2,1)) / y4;
+ this->r() = (rot(2,0) - rot(0,2)) / y4;
+ } else {
+ T z4 = T(vcl_sqrt(zz * 4.0));
+ this->x() = (rot(0,2) + rot(2,0)) / z4;
+ this->y() = (rot(1,2) + rot(2,1)) / z4;
+ this->z() = z4 / 4;
+ this->r() = (rot(0,1) - rot(1,0)) / z4;
+ }
+}
+
+//:
+
+template <class T>
+T vnl_quaternion<T>::angle () const
+{
+ return T(2 * vcl_atan2 (this->imaginary().magnitude(),
+ this->real())); // angle is always positive
+}
+
+//: Queries the angle and the direction of the rotation axis of the quaternion.
+// A null quaternion will return zero for angle and k direction for axis.
+
+template <class T>
+vnl_vector<T> vnl_quaternion<T>::axis () const
+{
+ vnl_vector<T> direc = this->imaginary(); // direc parallel to imag. part
+ T mag = direc.magnitude();
+ if (mag == 0) {
+ vcl_cout << "Axis not well defined for zero Quaternion. Use (0,0,1) instead.\n";
+ direc[2] = 1.0; // or signal exception here.
+ } else
+ direc /= mag; // normalize direction vector
+ return direc;
+}
+
+
+//: Converts a normalized quaternion into a square rotation matrix with dimension dim.
+// This is the reverse counterpart of constructing a quaternion from a transformation matrix.
+// WARNING this is inconsistent with the quaternion docs and q.rotate()
+
+template <class T>
+vnl_matrix_fixed<T,3,3> vnl_quaternion<T>::rotation_matrix_transpose () const
+{
+ vnl_matrix_fixed<T,3,3> rot;
+ vnl_quaternion<T> const& q = *this;
+
+ T x2 = q.x() * q.x();
+ T y2 = q.y() * q.y();
+ T z2 = q.z() * q.z();
+ T r2 = q.r() * q.r();
+ rot(0,0) = r2 + x2 - y2 - z2; // fill diagonal terms
+ rot(1,1) = r2 - x2 + y2 - z2;
+ rot(2,2) = r2 - x2 - y2 + z2;
+ T xy = q.x() * q.y();
+ T yz = q.y() * q.z();
+ T zx = q.z() * q.x();
+ T rx = q.r() * q.x();
+ T ry = q.r() * q.y();
+ T rz = q.r() * q.z();
+ rot(0,1) = 2 * (xy + rz); // fill off diagonal terms
+ rot(0,2) = 2 * (zx - ry);
+ rot(1,2) = 2 * (yz + rx);
+ rot(1,0) = 2 * (xy - rz);
+ rot(2,0) = 2 * (zx + ry);
+ rot(2,1) = 2 * (yz - rx);
+
+ return rot;
+}
+
+
+template <class T>
+vnl_matrix_fixed<T,4,4> vnl_quaternion<T>::rotation_matrix_transpose_4() const
+{
+ vnl_matrix_fixed<T,4,4> rot;
+ rot.set_identity();
+ rot.update(this->rotation_matrix_transpose().as_ref());
+ return rot;
+}
+
+//: Returns the conjugate of given quaternion, having same real and opposite imaginary parts.
+
+template <class T>
+vnl_quaternion<T> vnl_quaternion<T>::conjugate () const
+{
+ return vnl_quaternion<T> (-x(), -y(), -z(), r());
+}
+
+//: Returns the inverse of given quaternion.
+// For unit quaternion representing rotation, the inverse is the
+// same as the conjugate.
+
+template <class T>
+vnl_quaternion<T> vnl_quaternion<T>::inverse () const
+{
+ vnl_quaternion<T> inv = this->conjugate();
+ inv /= vnl_c_vector<T>::dot_product(this->data_, this->data_, 4);
+ return inv;
+}
+
+//: Returns the product of two quaternions.
+// Multiplication of two quaternions is not symmetric and has
+// fewer operations than multiplication of orthonormal
+// matrices. If object is rotated by r1, then by r2, then
+// the composed rotation (r2 o r1) is represented by the
+// quaternion (q2 * q1), or by the matrix (m1 * m2). Note
+// that matrix composition is reversed because matrices
+// and vectors are represented row-wise.
+
+template <class T>
+vnl_quaternion<T> vnl_quaternion<T>::operator* (const vnl_quaternion<T>& rhs) const
+{
+ T r1 = this->real(); // real and img parts of args
+ T r2 = rhs.real();
+ vnl_vector<T> i1 = this->imaginary();
+ vnl_vector<T> i2 = rhs.imaginary();
+ T real_v = (r1 * r2) - ::dot_product(i1, i2); // real&img of product q1*q2
+ vnl_vector<T> img = vnl_cross_3d(i1, i2);
+ img += (i2 * r1) + (i1 * r2);
+ vnl_quaternion<T> prod(img[0], img[1], img[2], real_v);
+ return prod;
+}
+
+//: Rotates 3D vector v with source quaternion and stores the rotated vector back into v.
+// For speed and greater accuracy, first convert quaternion into an orthonormal
+// matrix, then use matrix multiplication to rotate many vectors.
+
+template <class T>
+vnl_vector<T> vnl_quaternion<T>::rotate (const vnl_vector<T>& v) const
+{
+ T r = this->real();
+ vnl_vector<T> i = this->imaginary();
+ vnl_vector<T> rotated = v+ vnl_cross_3d(i, v) * T(2*r)- vnl_cross_3d(vnl_cross_3d(i, v), i) * T(2);
+ return rotated;
+}
+
+#undef VNL_QUATERNION_INSTANTIATE
+#define VNL_QUATERNION_INSTANTIATE(T) \
+template class vnl_quaternion<T >;\
+VCL_INSTANTIATE_INLINE(vcl_ostream& operator<< (vcl_ostream&, const vnl_quaternion<T >&))
+
+#endif // vnl_quaternion_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..d0699551e361997a92aadcba1aba68c035986b18
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.cxx
@@ -0,0 +1,220 @@
+// This is core/vnl/vnl_random.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+
+#include "vnl_random.h"
+#include <vcl_ctime.h>
+#include <vcl_cmath.h>
+#include <vcl_cassert.h>
+
+unsigned long vnl_random::linear_congruential_lrand32()
+{
+ return linear_congruential_previous = (linear_congruential_previous*linear_congruential_multiplier + 1)&0xffffffff;
+}
+
+//: Construct with seed
+vnl_random::vnl_random(unsigned long seed)
+ : mz_array_position(0L), mz_borrow(0), mz_previous_normal_flag(0)
+{reseed(seed);}
+
+//: Construct with seed
+vnl_random::vnl_random(unsigned long seed[vnl_random_array_size])
+ : mz_array_position(0L), mz_borrow(0), mz_previous_normal_flag(0)
+{reseed(seed);}
+
+vnl_random::vnl_random(const vnl_random& r)
+ : linear_congruential_previous(r.linear_congruential_previous)
+ , mz_array_position(r.mz_array_position)
+ , mz_borrow(r.mz_borrow)
+ , mz_previous_normal_flag(r.mz_previous_normal_flag)
+{
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_seed_array[i] = r.mz_seed_array[i];
+ mz_array[i] = r.mz_array[i];
+ }
+}
+
+vnl_random& vnl_random::operator=(const vnl_random& r)
+{
+ linear_congruential_previous=r.linear_congruential_previous;
+ mz_array_position=r.mz_array_position;
+ mz_borrow=r.mz_borrow;
+ mz_previous_normal_flag=r.mz_previous_normal_flag;
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_seed_array[i] = r.mz_seed_array[i];
+ mz_array[i] = r.mz_array[i];
+ }
+ return *this;
+}
+
+vnl_random::vnl_random() : mz_array_position(0), mz_borrow(0), mz_previous_normal_flag(0)
+{
+ reseed();
+}
+
+vnl_random::~vnl_random()
+{
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_seed_array[i] = 0;
+ mz_array[i] = 0;
+ }
+}
+
+void vnl_random::reseed()
+{
+ reseed((unsigned long)vcl_time(NULL));
+}
+
+void vnl_random::reseed(unsigned long seed)
+{
+ mz_array_position = 0L;
+ mz_borrow = 0L;
+
+ linear_congruential_previous = seed;
+ // Use the lc generator to fill the array
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_seed_array[i] = linear_congruential_lrand32();
+ mz_array[i] = mz_seed_array[i];
+ }
+
+ // Warm up with 1000 randoms
+ for (int j=0;j<1000;j++) lrand32();
+}
+
+void vnl_random::reseed(unsigned long seed[vnl_random_array_size])
+{
+ mz_array_position = 0L;
+ mz_borrow = 0L;
+
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_array[i] = seed[i];
+ mz_seed_array[i] = seed[i];
+ }
+}
+
+void vnl_random::restart()
+{
+ mz_array_position = 0L;
+
+ for (int i=0;i<vnl_random_array_size;++i)
+ {
+ mz_array[i] = mz_seed_array[i];
+ }
+}
+
+double vnl_random::normal()
+{
+ if (mz_previous_normal_flag)
+ {
+ mz_previous_normal_flag = 0;
+ return mz_previous_normal;
+ }
+ else
+ {
+ double x,y,r2;
+ do
+ {
+ x = drand32(-1.0,1.0);
+ y = drand32(-1.0,1.0);
+ r2 = x*x+y*y;
+ }
+ while (r2 >=1.0 || r2 == 0.0);
+ double fac = vcl_sqrt(-2.0*vcl_log(r2)/r2);
+ mz_previous_normal = x*fac;
+ mz_previous_normal_flag = 1;
+ return y*fac;
+ }
+}
+
+
+//: Random value from a unit normal distribution about zero
+// Uses a drand64() as its underlying generator.
+// Because the function uses a probability transform, the randomness (and
+// quantisation) is non-linearly dependent on the value. The further the sample
+// is from zero, the lower the number of bits on which it is random.
+double vnl_random::normal64()
+{
+ if (mz_previous_normal_flag)
+ {
+ mz_previous_normal_flag = 0;
+ return mz_previous_normal;
+ }
+ else
+ {
+ double x,y,r2;
+ do
+ {
+ x = drand64(-1.0,1.0);
+ y = drand64(-1.0,1.0);
+ r2 = x*x+y*y;
+ }
+ while (r2 >=1.0 || r2 == 0.0);
+ double fac = vcl_sqrt(-2.0*vcl_log(r2)/r2);
+ mz_previous_normal = x*fac;
+ mz_previous_normal_flag = 1;
+ return y*fac;
+ }
+}
+
+unsigned long vnl_random::lrand32()
+{
+ unsigned long p1 = mz_array[(vnl_random_array_size + mz_array_position - mz_previous1)%vnl_random_array_size];
+ unsigned long p2 = (p1 - mz_array[mz_array_position] - mz_borrow)&0xffffffff;
+ if (p2 < p1) mz_borrow = 0;
+ if (p2 > p1) mz_borrow = 1;
+ mz_array[mz_array_position] = p2;
+ mz_array_position = (++mz_array_position)%vnl_random_array_size;
+ return p2;
+}
+
+int vnl_random::lrand32(int lower, int upper)
+{
+ assert(lower <= upper);
+
+ // Note: we have to reject some numbers otherwise we get a very slight bias
+ // towards the lower part of the range lower - upper. See below
+
+ unsigned long range = upper-lower+1;
+ unsigned long denom = 0xffffffff/range;
+ unsigned long ran;
+ while ((ran=lrand32()) >= denom*range) ;
+ return lower + int(ran/denom);
+}
+
+
+int vnl_random::lrand32(int lower, int upper, int &count)
+{
+ assert(lower <= upper);
+
+ // Note: we have to reject some numbers otherwise we get a very slight bias
+ // towards the lower part of the range lower - upper. Hence this is a "count"
+ // version of the above function that returns the number of lrand32()
+ // calls made.
+
+ unsigned long range = upper-lower+1;
+ unsigned long denom = 0xffffffff/range;
+ unsigned long ran;
+ count = 1;
+ while ((ran=lrand32())>=denom*range) ++count;
+ return lower + int(ran/denom);
+}
+
+double vnl_random::drand32(double lower, double upper)
+{
+ assert(lower <= upper);
+ return (double(lrand32())/0xffffffff)*(upper-lower) + lower;
+}
+
+double vnl_random::drand64(double lower, double upper)
+{
+ assert(lower <= upper);
+ return (double(lrand32())/0xffffffff + double(lrand32())/(double(0xffffffff)*double(0xffffffff)))*(upper-lower) + lower;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.h
new file mode 100644
index 0000000000000000000000000000000000000000..01d3602f1448a3266ba7a8aa38d524c09787d5a7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_random.h
@@ -0,0 +1,145 @@
+// This is core/vnl/vnl_random.h
+#ifndef vnl_random_h
+#define vnl_random_h
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author Aaron Kotcheff (Manchester)
+// \brief A superior random number generator
+
+const int vnl_random_array_size = 37;
+
+//: A superior random number generator.
+// Implements a new random number generator that
+// recently appeared in the literature. It generates 32 bit
+// numbers with a higher degree of randomness than previous
+// generators and has a cycle of 10^354 i.e. so huge that in
+// practice it never cycles.
+// For the mathematics behind it see:
+// "A New Class of Random Number Generators" G. Marsaglia and A. Zaman,
+// Annals of Applied Probability 1991, Vol. 1, No. 3, 462.
+class vnl_random
+{
+ enum {linear_congruential_multiplier = 1664525, mz_previous1 = 24};
+ unsigned long linear_congruential_previous;
+ unsigned long mz_seed_array[vnl_random_array_size];
+ unsigned long mz_array[vnl_random_array_size];
+ int mz_array_position;
+ int mz_borrow;
+ unsigned long linear_congruential_lrand32();
+
+ double mz_previous_normal;
+ int mz_previous_normal_flag;
+
+ public:
+ //: Default constructor.
+ // Initializes the random number generator non-deterministically.
+ // i.e. it will generate a different series of random numbers each
+ // time the program is run.
+ vnl_random();
+
+ //: Destructor
+ ~vnl_random();
+
+ //: Construct with seed.
+ // Initializes the random number generator deterministically
+ // using a single ulong as the 'seed'. A linear congruential
+ // generator is used to generate the 37 ulongs needed
+ // as the real seed. The same seed will produce the
+ // same series of random numbers.
+ //
+ // 9667566 is a good seed.
+ vnl_random(unsigned long seed);
+
+ //: Construct with seed.
+ // Initializes the random number generator deterministically
+ // using 37 ulongs as the 'seed'. The same seed will
+ // produce the same series of random numbers.
+ vnl_random(unsigned long seed[vnl_random_array_size]);
+
+ //: Copy constructor.
+ // Initializes/sets the random number generator to exactly
+ // the same state as the argument, i.e. both will generate exactly
+ // the same series of random numbers from then on.
+ vnl_random(const vnl_random&);
+
+ //: Copy operator.
+ // Initializes/sets the random number generator to exactly
+ // the same state as the argument, i.e. both will generate exactly
+ // the same series of random numbers from then on.
+ vnl_random& operator=(const vnl_random&);
+
+ //: Starts a new non-deterministic sequence from an already declared generator.
+ void reseed();
+
+ //: Starts a new deterministic sequence from an already declared generator using the provided seed.
+ void reseed(unsigned long);
+
+ //: Starts a new deterministic sequence from an already declared generator using the provided seed.
+ void reseed(unsigned long[vnl_random_array_size]);
+
+ //: This restarts the sequence of random numbers.
+ // Restarts so that it repeats
+ // from the point at which you declared the generator, last
+ // initialized it, or last called a 'reseed'.
+ void restart();
+
+ //: Generates a random unsigned 32-bit number.
+ unsigned long lrand32();
+
+ //: Generates a random unsigned long in [a,b]
+ int lrand32(int a, int b);
+
+ //: Generates a random unsigned long in [0,b]
+ int lrand32(int b) {return lrand32(0, b);}
+
+ //: Generates a random unsigned long in [a,b]
+ int lrand32(int a, int b, int&);
+
+ //: Generates a random double in the range a <= x <= b with 32 bit randomness.
+ // drand32(1,0) is random down to about the 10th decimal place.
+ double drand32(double a, double b);
+
+ //: Generates a random unsigned integer in [0,n)
+ // This function allows the random number generator to be used as
+ // a functor, e.g. with vcl_random_shuffle()
+ unsigned long operator()(unsigned n) { return lrand32(0, n-1); }
+
+ //: Generates a random double in the range 0 <= x <= b with 32 bit randomness.
+ // drand32(1.0) is random down to about the 10th decimal place.
+ double drand32(double b) {return drand32(0.0, b);}
+
+ //: Generates a random double in the range 0 <= x <= 1 with 32 bit randomness.
+ // drand32() is random down to about the 10th decimal place.
+ double drand32() {return drand32(0.0, 1.0);}
+
+ //: Generates a random double in the range a <= x <= b with 64 bit randomness.
+ // Completely random down to the accuracy of an IEEE double.
+ double drand64(double a, double b);
+
+ //: Generates a random double in the range 0 <= x <= b with 64 bit randomness.
+ // Completely random down to the accuracy of an IEEE double.
+ double drand64(double b) {return drand64(0.0, b);}
+
+ //: Generates a random double in the range 0 <= x <= 1 with 64 bit randomness.
+ // Completely random down to the accuracy of an IEEE double.
+ double drand64() {return drand64(0.0, 1.0);}
+
+ //: Random value from a unit normal distribution about zero.
+ // Uses a drand32() as its underlying generator.
+ // Because the function uses a probability transform, the randomness (and
+ // quantisation) is non-linearly dependent on the value. The further the
+ // sample is from zero, the lower the number of bits on which it is random.
+ double normal();
+
+ //: Random value from a unit normal distribution about zero.
+ // Uses a drand64() as its underlying generator.
+ // Because the function uses a probability transform, the randomness (and
+ // quantisation) is non-linearly dependent on the value. The further the
+ // sample is from zero, the lower the number of bits on which it is random.
+ double normal64();
+};
+
+#endif // vnl_random_h
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.h
new file mode 100644
index 0000000000000000000000000000000000000000..7b99a79576f82a927117fb1d91adc6942fdf1d32
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.h
@@ -0,0 +1,71 @@
+// This is core/vnl/vnl_rank.h
+#ifndef vnl_rank_h_
+#define vnl_rank_h_
+//:
+// \file
+// \author Peter Vanroose, Leuven
+// \date 27 March 2003
+// \brief Direct computation of the rank of a matrix, without using svd
+//
+// The (row) rank of a matrix is its number of linearly independent rows.
+// This turns out to be equal to the number of linearly independent columns,
+// i.e., the column rank, so it is just called the rank of the matrix.
+// This can be computed by row-reducing (or column-reducing) the matrix
+// and then counting the number of non-zero rows (or columns).
+
+#include <vnl/vnl_matrix.h>
+
+typedef enum { vnl_rank_row, vnl_rank_column, vnl_rank_both } vnl_rank_type;
+typedef enum { vnl_rank_pivot_one, vnl_rank_pivot_all } vnl_rank_pivot_type;
+
+//: Returns the rank of a matrix
+// By default, the row rank of the matrix is determined.
+// Specify vnl_rank_column to obtain the column rank.
+//
+// \relates vnl_matrix
+template <class T>
+unsigned int vnl_rank(vnl_matrix<T> const& mat, vnl_rank_type = vnl_rank_both);
+
+//: Row reduce a matrix.
+// First try to use 1 or -1 as pivot element in each row, to avoid divisions;
+// then use any nonzero element as candidate pivot.
+// Repeat this process until the matrix does not change any more.
+// At that point, the matrix spans the same row space as before and contains
+// as many zeros as possible.
+//
+// When specifying vnl_rank_pivot_one is given as second argument,
+// only elements with value 1 or -1 are used as candidate pivot elements.
+//
+// Note that for integer matrices, the resulting matrix is still integer,
+// and is guaranteed to be row equivalent with the original matrix.
+//
+// \relates vnl_matrix
+//
+template <class T>
+vnl_matrix<T> vnl_rank_row_reduce(vnl_matrix<T> const& mat,
+ vnl_rank_pivot_type = vnl_rank_pivot_all);
+
+//: Column reduce a matrix.
+//
+// \relates vnl_matrix
+//
+template <class T>
+vnl_matrix<T> vnl_rank_column_reduce(vnl_matrix<T> const& mat,
+ vnl_rank_pivot_type = vnl_rank_pivot_all);
+
+//: Row and column reduce a matrix.
+// Perform both row reduction and column reduction on a matrix.
+// The resulting matrix will in general no longer span the same row space
+// (or column space) as the original matrix, but the rank will not have
+// changed, and the number of nonzero elements will be minimal (viz at most
+// one per row and one per column).
+//
+// \relates vnl_matrix
+//
+template <class T>
+vnl_matrix<T> vnl_rank_row_column_reduce(vnl_matrix<T> const& mat,
+ vnl_rank_pivot_type = vnl_rank_pivot_all);
+
+#define VNL_RANK_INSTANTIATE(T) extern "please #include vnl/vnl_rank.txx instead"
+
+#endif // vnl_rank_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.txx
new file mode 100644
index 0000000000000000000000000000000000000000..a2e01bb5bc2012c0bfa776c4158d618cd778aa9f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rank.txx
@@ -0,0 +1,219 @@
+// This is core/vnl/vnl_rank.txx
+#ifndef vnl_rank_txx_
+#define vnl_rank_txx_
+
+#include "vnl_rank.h"
+
+template <class T>
+vnl_matrix<T> vnl_rank_row_reduce(vnl_matrix<T> const& mat, vnl_rank_pivot_type t)
+{
+ vnl_matrix<T> a = mat;
+ bool changed = true;
+ unsigned int m = a.rows(), n=a.columns();
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int r=0; r<m; ++r)
+ {
+ unsigned int c=0; while (c<n && a[r][c] != 1 && a[r][c] != -1) ++c;
+ if (c==n) continue;
+ for (unsigned int s=0; s<m; ++s)
+ {
+ if (s==r || a[s][c] == 0) continue;
+ for (unsigned int d=0; d<n; ++d)
+ if (d!=c) a[s][d] -= a[r][d] * a[r][c] * a[s][c];
+ a[s][c] = T(0);
+ changed = true;
+ }
+ }
+ }
+ if (t == vnl_rank_pivot_one) return a;
+ changed = true;
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int r=0; r<m; ++r)
+ {
+ unsigned int c=0; while (c<n && a[r][c] == 0) ++c;
+ if (c==n) continue; // zero row
+ for (unsigned int s=0; s<m; ++s)
+ {
+ if (s==r) continue;
+ T scale = a[s][c] / a[r][c];
+ // Note that this can possibly be an integer division, so
+ // it is *not* guaranteed that a[r][c] * scale == a[s][c] .
+ if (scale == 0) continue;
+ for (unsigned int d=0; d<n; ++d)
+ if (d!=c) a[s][d] -= a[r][d] * scale;
+ a[s][c] -= a[r][c] * scale;
+ changed = true;
+ }
+ }
+ }
+ return a;
+}
+
+template <class T>
+vnl_matrix<T> vnl_rank_column_reduce(vnl_matrix<T> const& mat, vnl_rank_pivot_type t)
+{
+ vnl_matrix<T> a = mat;
+ bool changed = true;
+ unsigned int m = a.rows(), n=a.columns();
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int c=0; c<n; ++c)
+ {
+ unsigned int r=0; while (r<m && a[r][c] != 1 && a[r][c] != -1) ++r;
+ if (r==m) continue;
+ for (unsigned int d=0; d<n; ++d)
+ {
+ if (d==c || a[r][d] == 0) continue;
+ for (unsigned int s=0; s<m; ++s)
+ if (s!=r) a[s][d] -= a[s][c] * a[r][c] * a[r][d];
+ a[r][d] = T(0);
+ changed = true;
+ }
+ }
+ }
+ if (t == vnl_rank_pivot_one) return a;
+ changed = true;
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int c=0; c<n; ++c)
+ {
+ unsigned int r=0; while (r<m && a[r][c] == 0) ++r;
+ if (r==m) continue; // zero row
+ for (unsigned int d=0; d<n; ++d)
+ {
+ if (d==c) continue;
+ T scale = a[r][d] / a[r][c];
+ // Note that this can possibly be an integer division, so
+ // it is *not* guaranteed that a[r][c] * scale == a[r][d] .
+ if (scale == 0) continue;
+ for (unsigned int s=0; s<m; ++s)
+ if (s!=r) a[s][d] -= a[s][c] * scale;
+ a[r][d] -= a[r][c] * scale;
+ changed = true;
+ }
+ }
+ }
+ return a;
+}
+
+template <class T>
+vnl_matrix<T> vnl_rank_row_column_reduce(vnl_matrix<T> const& mat, vnl_rank_pivot_type t)
+{
+ vnl_matrix<T> a = mat;
+ bool changed = true;
+ unsigned int m = a.rows(), n=a.columns();
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int r=0; r<m; ++r)
+ {
+ unsigned int c=0; while (c<n && a[r][c] != 1 && a[r][c] != -1) ++c;
+ if (c==n) continue;
+ for (unsigned int s=0; s<m; ++s)
+ {
+ if (s==r || a[s][c] == 0) continue;
+ for (unsigned int d=0; d<n; ++d)
+ if (d!=c) a[s][d] -= a[r][d] * a[r][c] * a[s][c];
+ a[s][c] = T(0);
+ changed = true;
+ }
+ }
+ for (unsigned int c=0; c<n; ++c)
+ {
+ unsigned int r=0; while (r<m && a[r][c] != 1 && a[r][c] != -1) ++r;
+ if (r==m) continue;
+ for (unsigned int d=0; d<n; ++d)
+ {
+ if (d==c || a[r][d] == 0) continue;
+ for (unsigned int s=0; s<m; ++s)
+ if (s!=r) a[s][d] -= a[s][c] * a[r][c] * a[r][d];
+ a[r][d] = T(0);
+ changed = true;
+ }
+ }
+ }
+ if (t == vnl_rank_pivot_one) return a;
+ changed = true;
+ while (changed)
+ {
+ changed = false;
+ for (unsigned int r=0; r<m; ++r)
+ {
+ unsigned int c=0; while (c<n && a[r][c] == 0) ++c;
+ if (c==n) continue; // zero row
+ for (unsigned int s=0; s<m; ++s)
+ {
+ if (s==r) continue;
+ T scale = a[s][c] / a[r][c];
+ // Note that this can possibly be an integer division, so
+ // it is *not* guaranteed that a[r][c] * scale == a[s][c] .
+ if (scale == 0) continue;
+ for (unsigned int d=0; d<n; ++d)
+ if (d!=c) a[s][d] -= a[r][d] * scale;
+ a[s][c] -= a[r][c] * scale;
+ changed = true;
+ }
+ }
+ for (unsigned int c=0; c<n; ++c)
+ {
+ unsigned int r=0; while (r<m && a[r][c] == 0) ++r;
+ if (r==m) continue; // zero row
+ for (unsigned int d=0; d<n; ++d)
+ {
+ if (d==c) continue;
+ T scale = a[r][d] / a[r][c];
+ // Note that this can possibly be an integer division, so
+ // it is *not* guaranteed that a[r][c] * scale == a[r][d] .
+ if (scale == 0) continue;
+ for (unsigned int s=0; s<m; ++s)
+ if (s!=r) a[s][d] -= a[s][c] * scale;
+ a[r][d] -= a[r][c] * scale;
+ changed = true;
+ }
+ }
+ }
+ return a;
+}
+
+template <class T>
+unsigned int vnl_rank(vnl_matrix<T> const& mat, vnl_rank_type t)
+{
+ unsigned int rank = 0;
+ if (t == vnl_rank_row)
+ {
+ vnl_matrix<T> a = vnl_rank_row_reduce(mat, vnl_rank_pivot_all);
+ for (unsigned int r=0; r<a.rows(); ++r)
+ {
+ unsigned int c=0;
+ while (c<a.columns() && a[r][c] == 0) ++c;
+ if (c!=a.columns()) ++rank; // not all elements in row r are 0
+ }
+ }
+ else
+ {
+ vnl_matrix<T> a = (t == vnl_rank_column) ? vnl_rank_column_reduce(mat,vnl_rank_pivot_all) :
+ vnl_rank_row_column_reduce(mat,vnl_rank_pivot_all);
+ for (unsigned int c=0; c<a.columns(); ++c)
+ {
+ unsigned int r=0;
+ while (r<a.rows() && a[r][c] == 0) ++r;
+ if (r!=a.rows()) ++rank; // not all elements in column c are 0
+ }
+ }
+ return rank;
+}
+
+#undef VNL_RANK_INSTANTIATE
+#define VNL_RANK_INSTANTIATE(T) \
+template vnl_matrix<T > vnl_rank_row_reduce(vnl_matrix<T > const&, vnl_rank_pivot_type);\
+template vnl_matrix<T > vnl_rank_column_reduce(vnl_matrix<T > const&, vnl_rank_pivot_type);\
+template vnl_matrix<T > vnl_rank_row_column_reduce(vnl_matrix<T > const&, vnl_rank_pivot_type);\
+template unsigned int vnl_rank(vnl_matrix<T > const&, vnl_rank_type)
+
+#endif // vnl_rank_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..227bf7cefc3ee7c3fc48e4ba89741b6e6267483c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.cxx
@@ -0,0 +1,27 @@
+// This is core/vnl/vnl_rational.cxx
+#include "vnl_rational.h"
+//:
+// \file
+
+//: Creates a rational from a double.
+// This is done by computing the continued fraction approximation for d.
+vnl_rational::vnl_rational(double d)
+{
+ bool sign = d<0;
+ if (sign) d = -d;
+
+ // Continued fraction approximation of abs(d): recursively determined
+ long den=0L, num=1L, prev_den=1L, prev_num=0L;
+
+ while (d*num < 1e9 && d*den < 1e9) {
+ long a = (long)d; // integral part of d
+ d -= a; // certainly >= 0
+ long temp = num; num = a*num + prev_num; prev_num = temp;
+ temp = den; den = a*den + prev_den; prev_den = temp;
+ if (d < 1e-6) break;
+ d = 1/d;
+ }
+ num_ = num; den_ = den;
+ if (sign) num_ = -num_;
+ // no need to normalize() since prev_num and prev_den have guaranteed a gcd=1
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.h
new file mode 100644
index 0000000000000000000000000000000000000000..0f9f8ded6db94db63ac7c304d403c0851c5b3496
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational.h
@@ -0,0 +1,447 @@
+// This is core/vnl/vnl_rational.h
+#ifndef vnl_rational_h_
+#define vnl_rational_h_
+//:
+// \file
+// \brief High-precision rational numbers
+//
+// The vnl_rational class provides high-precision rational numbers and
+// arithmetic, using the built-in type long, for the numerator and denominator.
+// Implicit conversion to the system defined types short, int, long, float, and
+// double is supported by overloaded operator member functions. Although the
+// rational class makes judicious use of inline functions and deals only with
+// integral values, the user is warned that the rational integer arithmetic
+// class is still considerably slower than the built-in integer data types. If
+// the range of values anticipated will fit into a built-in type, use that
+// instead.
+//
+// In addition to the original COOL Rational class, vnl_rational is able to
+// represent plus and minus infinity. An other interesting addition is the
+// possibility to construct a rational from a double. This allows for lossless
+// conversion from e.g. double 1.0/3.0 to the rational number 1/3, hence no more
+// rounding errors. This is implemented with continued fraction approximations.
+//
+// \author
+// Copyright (C) 1991 Texas Instruments Incorporated.
+//
+// Permission is granted to any individual or institution to use, copy, modify,
+// and distribute this software, provided that this complete copyright and
+// permission notice is maintained, intact, in all copies and supporting
+// documentation.
+//
+// Texas Instruments Incorporated provides this software "as is" without
+// express or implied warranty.
+//
+// \verbatim
+// Modifications
+// Peter Vanroose, 13 July 2001: Added continued fraction cnstrctr from double
+// Peter Vanroose, 10 July 2001: corrected operator%=()
+// Peter Vanroose, 10 July 2001: corrected ceil() and floor() for negative args
+// Peter Vanroose, 10 July 2001: extended operability range of += by using gcd
+// Peter Vanroose, 10 July 2001: added abs().
+// Peter Vanroose, 10 July 2001: removed state data member and added Inf repres
+// Peter Vanroose, 9 July 2001: ported to vnl from COOL
+// \endverbatim
+
+#include <vcl_iostream.h>
+#include <vcl_cassert.h>
+
+//: High-precision rational numbers
+//
+// The vnl_rational class provides high-precision rational numbers and
+// arithmetic, using the built-in type long, for the numerator and denominator.
+// Implicit conversion to the system defined types short, int, long, float, and
+// double is supported by overloaded operator member functions. Although the
+// rational class makes judicious use of inline functions and deals only with
+// integral values, the user is warned that the rational integer arithmetic
+// class is still considerably slower than the built-in integer data types. If
+// the range of values anticipated will fit into a built-in type, use that
+// instead.
+//
+// In addition to the original COOL Rational class, vnl_rational is able to
+// represent plus and minus infinity. An other interesting addition is the
+// possibility to construct a rational from a double. This allows for lossless
+// conversion from e.g. double 1.0/3.0 to the rational number 1/3, hence no more
+// rounding errors. This is implemented with continued fraction approximations.
+//
+class vnl_rational
+{
+ long num_; //!< Numerator portion
+ long den_; //!< Denominator portion
+
+ public:
+ //: Creates a rational with given numerator and denominator.
+ // Default constructor gives 0.
+ // Also serves as automatic cast from long to vnl_rational.
+ // The only input which is not allowed is (0,0);
+ // the denominator is allowed to be 0, to represent +Inf or -Inf.
+ inline vnl_rational (long num = 0L, long den = 1L)
+ : num_(num), den_(den) { assert(num!=0||den!=0); normalize(); }
+ //: Creates a rational with given numerator and denominator.
+ // Note these are not automatic type conversions because of a bug
+ // in the Borland compiler. Since these just convert their
+ // arguments to long anyway, there is no harm in letting
+ // the long overload be used for automatic conversions.
+ explicit inline vnl_rational (int num, int den = 1)
+ : num_(num), den_(den) { assert(num!=0||den!=0); normalize(); }
+ explicit inline vnl_rational (unsigned int num, unsigned int den = 1)
+ : num_((long)num), den_((long)den) { assert(num!=0||den!=0); normalize(); }
+ //: Creates a rational from a double.
+ // This is done by computing the continued fraction approximation for d.
+ // Note that this is explicitly *not* an automatic type conversion.
+ explicit vnl_rational (double d);
+ // Copy constructor
+ inline vnl_rational (vnl_rational const& from)
+ : num_(from.numerator()), den_(from.denominator()) {}
+ // Destructor
+ inline ~vnl_rational() {}
+ // Assignment: overwrite an existing vnl_rational
+ inline void set(long num, long den) { assert(num!=0||den!=0); num_=num; den_=den; normalize(); }
+
+ //: Return the numerator of the (simplified) rational number representation
+ inline long numerator () const { return num_; }
+ //: Return the denominator of the (simplified) rational number representation
+ inline long denominator () const { return den_; }
+
+ //: Copies the contents and state of rhs rational over to the lhs
+ inline vnl_rational& operator= (vnl_rational const& rhs) {
+ num_ = rhs.numerator(); den_ = rhs.denominator(); return *this; }
+
+ //: Returns true if the two rationals have the same representation
+ inline bool operator== (vnl_rational const& rhs) const {
+ return num_ == rhs.numerator() && den_ == rhs.denominator(); }
+ inline bool operator!= (vnl_rational const& rhs) const { return !operator==(rhs); }
+ inline bool operator== (long rhs) const { return num_ == rhs && den_ == 1; }
+ inline bool operator!= (long rhs) const { return !operator==(rhs); }
+ inline bool operator== (int rhs) const { return num_ == rhs && den_ == 1; }
+ inline bool operator!= (int rhs) const { return !operator==(rhs); }
+
+ //: Unary minus - returns the negation of the current rational.
+ inline vnl_rational operator-() const { return vnl_rational(-num_, den_); }
+ //: Unary plus - returns the current rational.
+ inline vnl_rational operator+() const { return *this; }
+ //: Unary not - returns true if rational is equal to zero.
+ inline bool operator!() const { return num_ == 0L; }
+ //: Returns the absolute value of the current rational.
+ inline vnl_rational abs() const { return vnl_rational(num_<0?-num_:num_, den_); }
+ //: Replaces rational with 1/rational and returns it.
+ // Inverting 0 gives +Inf, inverting +-Inf gives 0.
+ vnl_rational& invert () {
+ long t = num_; num_ = den_; den_ = t; normalize(); return *this; }
+
+ //: Plus/assign: replace lhs by lhs + rhs
+ // Note that +Inf + -Inf and -Inf + +Inf are undefined.
+ inline vnl_rational& operator+= (vnl_rational const& r) {
+ if (den_ == r.denominator()) num_ += r.numerator();
+ else { long c = vnl_rational::gcd(den_,r.denominator()); if (c==0) c=1;
+ num_ = num_*(r.denominator()/c) + (den_/c)*r.numerator();
+ den_ *= r.denominator()/c; }
+ assert(num_!=0 || den_ != 0); // +Inf + -Inf is undefined
+ normalize (); return *this;
+ }
+ inline vnl_rational& operator+= (long r) { num_ += den_*r; return *this; }
+ //: Minus/assign: replace lhs by lhs - rhs
+ // Note that +Inf - +Inf and -Inf - -Inf are undefined.
+ inline vnl_rational& operator-= (vnl_rational const& r) {
+ if (den_ == r.denominator()) num_ -= r.num_;
+ else { long c = vnl_rational::gcd(den_,r.denominator()); if (c==0) c=1;
+ num_ = num_*(r.denominator()/c) - (den_/c)*r.numerator();
+ den_ *= r.denominator()/c; }
+ assert(num_!=0 || den_ != 0); // +Inf - +Inf is undefined
+ normalize (); return *this;
+ }
+ inline vnl_rational& operator-= (long r) { num_ -= den_*r; return *this; }
+ //: Multiply/assign: replace lhs by lhs * rhs
+ // Note that 0 * Inf and Inf * 0 are undefined.
+ inline vnl_rational& operator*= (vnl_rational const& r) {
+ num_ *= r.numerator(); den_ *= r.denominator();
+ assert(num_!=0 || den_ != 0); // 0 * Inf is undefined
+ normalize (); return *this;
+ }
+ inline vnl_rational& operator*= (long r) {num_*=r;normalize();return *this;}
+ //: Divide/assign: replace lhs by lhs / rhs
+ // Note that 0 / 0 and Inf / Inf are undefined.
+ inline vnl_rational& operator/= (vnl_rational const& r) {
+ num_ *= r.denominator(); den_ *= r.numerator();
+ assert(num_!=0 || den_ != 0); // 0/0, Inf/Inf undefined
+ normalize (); return *this;
+ }
+ inline vnl_rational& operator/= (long r) {
+ den_ *= r; assert(num_!=0 || den_ != 0); // 0/0 undefined
+ normalize (); return *this;
+ }
+ //: Modulus/assign: replace lhs by lhs % rhs
+ // Note that r % Inf is r, and that r % 0 and Inf % r are undefined.
+ inline vnl_rational& operator%= (vnl_rational const& r) {
+ assert(r.numerator() != 0);
+ if (den_ == r.denominator()) num_ %= r.numerator();
+ else { long c = vnl_rational::gcd(den_,r.denominator()); if (c==0) c=1;
+ num_ *= r.denominator()/c;
+ num_ %= (den_/c)*r.numerator();
+ den_ *= r.denominator()/c; }
+ normalize (); return *this;
+ }
+ inline vnl_rational& operator%=(long r){assert(r);num_%=den_*r;normalize();return *this;}
+
+ //: Pre-increment (++r). No-op when +-Inf.
+ inline vnl_rational& operator++ () { num_ += den_; return *this; }
+ //: Pre-decrement (--r). No-op when +-Inf.
+ inline vnl_rational& operator-- () { num_ -= den_; return *this; }
+ //: Post-increment (r++). No-op when +-Inf.
+ inline vnl_rational operator++(int){vnl_rational b=*this;num_+=den_;return b;}
+ //: Post-decrement (r--). No-op when +-Inf.
+ inline vnl_rational operator--(int){vnl_rational b=*this;num_-=den_;return b;}
+
+ inline bool operator< (vnl_rational const& rhs) const {
+ if (den_ == rhs.denominator()) // If same denominator
+ return num_ < rhs.numerator(); // includes the case -Inf < +Inf
+ // note that denominator is always >= 0:
+ else
+ return num_ * rhs.denominator() < den_ * rhs.numerator();
+ }
+ inline bool operator> (vnl_rational const& r) const { return r < *this; }
+ inline bool operator<= (vnl_rational const& r) const { return !operator>(r); }
+ inline bool operator>= (vnl_rational const& r) const { return !operator<(r); }
+ inline bool operator< (long r) const { return num_ < den_ * r; }
+ inline bool operator> (long r) const { return num_ > den_ * r; }
+ inline bool operator<= (long r) const { return !operator>(r); }
+ inline bool operator>= (long r) const { return !operator<(r); }
+ inline bool operator< (int r) const { return num_ < den_ * r; }
+ inline bool operator> (int r) const { return num_ > den_ * r; }
+ inline bool operator<= (int r) const { return !operator>(r); }
+ inline bool operator>= (int r) const { return !operator<(r); }
+ inline bool operator< (double r) const { return num_ < den_ * r; }
+ inline bool operator> (double r) const { return num_ > den_ * r; }
+ inline bool operator<= (double r) const { return !operator>(r); }
+ inline bool operator>= (double r) const { return !operator<(r); }
+
+ //: Converts rational value to integer by truncating towards zero.
+ inline long truncate () const { assert(den_ != 0); return num_/den_; }
+ //: Converts rational value to integer by truncating towards negative infinity.
+ inline long floor () const { long t = truncate();
+ return num_<0L && (num_%den_) != 0 ? t-1 : t; }
+ //: Converts rational value to integer by truncating towards positive infinity.
+ inline long ceil () const { long t = truncate();
+ return num_>0L && (num_%den_) != 0 ? t+1 : t; }
+ //: Rounds rational to nearest integer.
+ inline long round () const { long t = truncate();
+ if (num_ < 0) return ((-num_)%den_) >= 0.5*den_ ? t-1 : t;
+ else return (num_ %den_) >= 0.5*den_ ? t+1 : t;
+ }
+
+ // Implicit conversions
+ inline operator short () {
+ long t = truncate (); short r = (short)t;
+ assert(r == t); // abort on underflow or overflow
+ return r;
+ }
+ inline operator int () {
+ long t = truncate (); int r = (int)t;
+ assert(r == t); // abort on underflow or overflow
+ return r;
+ }
+ inline operator long () const { return truncate(); }
+ inline operator long () { return truncate(); }
+ inline operator float () const { return ((float)num_)/((float)den_); }
+ inline operator float () { return ((float)num_)/((float)den_); }
+ inline operator double () const { return ((double)num_)/((double)den_); }
+ inline operator double () { return ((double)num_)/((double)den_); }
+
+ //: Calculate greatest common divisor of two integers.
+ // Used to simplify rational number.
+ static inline long gcd (long l1, long l2) {
+ while (l2!=0) { long t = l2; l2 = l1 % l2; l1 = t; }
+ return l1<0 ? (-l1) : l1;
+ }
+
+ private:
+ //: Private function to normalize numerator/denominator of rational number.
+ // If num_ and den_ are both nonzero, their gcd is made 1 and den_ made positive.
+ // Otherwise, the nonzero den_ is set to 1 or the nonzero num_ to +1 or -1.
+ inline void normalize () {
+ if (num_ == 0) { den_ = 1; return; } // zero
+ if (den_ == 0) { num_ = (num_>0) ? 1 : -1; return; } // +-Inf
+ if (num_ != 1 && num_ != -1 && den_ != 1) {
+ long common = vnl_rational::gcd (num_, den_);
+ if (common != 1) { num_ /= common; den_ /= common; }
+ }
+ // if negative, put sign in numerator:
+ if (den_ < 0) { num_ *= -1; den_ *= -1; }
+ }
+};
+
+//: formatted output
+// \relates vnl_rational
+inline vcl_ostream& operator<< (vcl_ostream& s, vnl_rational const& r)
+{
+ return s << r.numerator() << '/' << r.denominator();
+}
+
+//: simple input
+// \relates vnl_rational
+inline vcl_istream& operator>> (vcl_istream& s, vnl_rational& r)
+{
+ long n, d; s >> n >> d;
+ r.set(n,d); return s;
+}
+
+//: Returns the sum of two rational numbers.
+// \relates vnl_rational
+inline vnl_rational operator+ (vnl_rational const& r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result += r2;
+}
+
+inline vnl_rational operator+ (vnl_rational const& r1, long r2)
+{
+ vnl_rational result(r1); return result += r2;
+}
+
+inline vnl_rational operator+ (vnl_rational const& r1, int r2)
+{
+ vnl_rational result(r1); return result += (long)r2;
+}
+
+inline vnl_rational operator+ (long r2, vnl_rational const& r1)
+{
+ vnl_rational result(r1); return result += r2;
+}
+
+inline vnl_rational operator+ (int r2, vnl_rational const& r1)
+{
+ vnl_rational result(r1); return result += (long)r2;
+}
+
+//: Returns the difference of two rational numbers.
+// \relates vnl_rational
+inline vnl_rational operator- (vnl_rational const& r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result -= r2;
+}
+
+inline vnl_rational operator- (vnl_rational const& r1, long r2)
+{
+ vnl_rational result(r1); return result -= r2;
+}
+
+inline vnl_rational operator- (vnl_rational const& r1, int r2)
+{
+ vnl_rational result(r1); return result -= (long)r2;
+}
+
+inline vnl_rational operator- (long r2, vnl_rational const& r1)
+{
+ vnl_rational result(-r1); return result += r2;
+}
+
+inline vnl_rational operator- (int r2, vnl_rational const& r1)
+{
+ vnl_rational result(-r1); return result += (long)r2;
+}
+
+//: Returns the product of two rational numbers.
+// \relates vnl_rational
+inline vnl_rational operator* (vnl_rational const& r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result *= r2;
+}
+
+inline vnl_rational operator* (vnl_rational const& r1, long r2)
+{
+ vnl_rational result(r1); return result *= r2;
+}
+
+inline vnl_rational operator* (vnl_rational const& r1, int r2)
+{
+ vnl_rational result(r1); return result *= (long)r2;
+}
+
+inline vnl_rational operator* (long r2, vnl_rational const& r1)
+{
+ vnl_rational result(r1); return result *= r2;
+}
+
+inline vnl_rational operator* (int r2, vnl_rational const& r1)
+{
+ vnl_rational result(r1); return result *= (long)r2;
+}
+
+//: Returns the quotient of two rational numbers.
+// \relates vnl_rational
+inline vnl_rational operator/ (vnl_rational const& r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result /= r2;
+}
+
+inline vnl_rational operator/ (vnl_rational const& r1, long r2)
+{
+ vnl_rational result(r1); return result /= r2;
+}
+
+inline vnl_rational operator/ (vnl_rational const& r1, int r2)
+{
+ vnl_rational result(r1); return result /= (long)r2;
+}
+
+inline vnl_rational operator/ (long r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result /= r2;
+}
+
+inline vnl_rational operator/ (int r1, vnl_rational const& r2)
+{
+ vnl_rational result((long)r1); return result /= r2;
+}
+
+//: Returns the remainder of r1 divided by r2.
+// \relates vnl_rational
+inline vnl_rational operator% (vnl_rational const& r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result %= r2;
+}
+
+inline vnl_rational operator% (vnl_rational const& r1, long r2)
+{
+ vnl_rational result(r1); return result %= r2;
+}
+
+inline vnl_rational operator% (vnl_rational const& r1, int r2)
+{
+ vnl_rational result(r1); return result %= (long)r2;
+}
+
+inline vnl_rational operator% (long r1, vnl_rational const& r2)
+{
+ vnl_rational result(r1); return result %= r2;
+}
+
+inline vnl_rational operator% (int r1, vnl_rational const& r2)
+{
+ vnl_rational result((long)r1); return result %= r2;
+}
+
+inline bool operator== (int r1, vnl_rational const& r2) { return r2==r1; }
+inline bool operator== (long r1, vnl_rational const& r2) { return r2==r1; }
+inline bool operator!= (int r1, vnl_rational const& r2) { return r2!=r1; }
+inline bool operator!= (long r1, vnl_rational const& r2) { return r2!=r1; }
+inline bool operator< (int r1, vnl_rational const& r2) { return r2> r1; }
+inline bool operator< (long r1, vnl_rational const& r2) { return r2> r1; }
+inline bool operator> (int r1, vnl_rational const& r2) { return r2< r1; }
+inline bool operator> (long r1, vnl_rational const& r2) { return r2< r1; }
+inline bool operator<= (int r1, vnl_rational const& r2) { return r2>=r1; }
+inline bool operator<= (long r1, vnl_rational const& r2) { return r2>=r1; }
+inline bool operator>= (int r1, vnl_rational const& r2) { return r2<=r1; }
+inline bool operator>= (long r1, vnl_rational const& r2) { return r2<=r1; }
+
+inline long truncate (vnl_rational const& r) { return r.truncate(); }
+inline long floor (vnl_rational const& r) { return r.floor(); }
+inline long ceil (vnl_rational const& r) { return r.ceil(); }
+inline long round (vnl_rational const& r) { return r.round(); }
+
+inline vnl_rational vnl_math_abs(vnl_rational const& x) { return x<0L ? -x : x; }
+inline vnl_rational vnl_math_squared_magnitude(vnl_rational const& x) { return x*x; }
+inline vnl_rational vnl_math_sqr(vnl_rational const& x) { return x*x; }
+inline bool vnl_math_isnan(vnl_rational const& ){return false;}
+inline bool vnl_math_isfinite(vnl_rational const& x){return x.denominator() != 0L;}
+
+#endif // vnl_rational_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..095f0c13b7bd273c391ebbd75df10385b6896c1f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.cxx
@@ -0,0 +1,34 @@
+//:
+// \file
+// \author Peter Vanroose
+// \date 6 September 2002
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_rational_traits.h"
+#include <vcl_complex.h>
+#include <vcl_cmath.h>
+
+const vnl_rational vnl_numeric_traits<vnl_rational>::zero = vnl_rational(0L,1L);
+const vnl_rational vnl_numeric_traits<vnl_rational>::one = vnl_rational(1L,1L);
+const vnl_rational vnl_numeric_traits<vnl_rational>::maxval = vnl_rational(vnl_numeric_traits<long>::maxval,1L);
+
+const vcl_complex<vnl_rational> vnl_numeric_traits<vcl_complex<vnl_rational> >::zero
+ = vcl_complex<vnl_rational>(vnl_rational(0L,1L),vnl_rational(0L,1L));
+const vcl_complex<vnl_rational> vnl_numeric_traits<vcl_complex<vnl_rational> >::one
+ = vcl_complex<vnl_rational>(vnl_rational(1L,1L),vnl_rational(0L,1L));
+
+vnl_rational vnl_math_squared_magnitude(vcl_complex<vnl_rational> const& x)
+{
+ return x.real()*x.real()+x.imag()*x.imag();
+}
+
+vnl_rational vnl_math_abs(vcl_complex<vnl_rational> const& x)
+{
+ return vnl_rational(vcl_sqrt(double(x.real()*x.real()+x.imag()*x.imag())));
+}
+
+vcl_ostream& operator<<(vcl_ostream& os, vcl_complex<vnl_rational> x)
+{
+ return os << x.real() << '+' << x.imag() << 'j';
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.h
new file mode 100644
index 0000000000000000000000000000000000000000..90cb849d0ea79522793f0a14bc82a391cdedc977
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rational_traits.h
@@ -0,0 +1,70 @@
+// This is core/vnl/vnl_rational_traits.h
+#ifndef vnl_rational_traits_h_
+#define vnl_rational_traits_h_
+//:
+// \file
+// \brief numeric traits for vnl_rational
+
+#include <vnl/vnl_rational.h>
+#include <vnl/vnl_numeric_traits.h>
+#include <vcl_iosfwd.h>
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vnl_rational>
+{
+ public:
+ //: Additive identity
+ static const vnl_rational zero; // = 0L
+ //: Multiplicative identity
+ static const vnl_rational one; // = 1L
+ //: Maximum value which this type can assume
+ static const vnl_rational maxval; // = vnl_numeric_traits<long>::maxval;
+ //: Return value of abs()
+ typedef vnl_rational abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vnl_rational double_t;
+ //: Name of type which results from multiplying this type with a double.
+ // Note that this requires an explicit cast from double to vnl_rational.
+ // This must be a built-in type: do not set this to vnl_rational, since
+ // that would require std::sqrt(vnl_rational) etc., which is not allowed.
+ typedef double real_t;
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vnl_rational const> : public vnl_numeric_traits<vnl_rational>
+{
+};
+#endif
+
+vcl_ostream& operator<<(vcl_ostream&, vcl_complex<vnl_rational>);
+
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vcl_complex<vnl_rational> >
+{
+ public:
+ //: Additive identity
+ static const vcl_complex<vnl_rational> zero; // = vcl_complex<vnl_rational>(0L,0L)
+ //: Multiplicative identity
+ static const vcl_complex<vnl_rational> one; // = vcl_complex<vnl_rational>(1L,0L)
+ //: Maximum value which this type can assume; makes no sense for this type
+ static const vcl_complex<vnl_rational> maxval;
+ //: Return value of abs()
+ typedef vnl_rational abs_t;
+ //: Name of a type twice as long as this one for accumulators and products.
+ typedef vcl_complex<vnl_rational> double_t;
+ //: Name of type which results from multiplying this type with a double
+ typedef vcl_complex<vnl_rational> real_t; // should be vcl_complex<double>, but that gives casting problems
+};
+
+#if !VCL_CANNOT_SPECIALIZE_CV
+VCL_DEFINE_SPECIALIZATION
+class vnl_numeric_traits<vcl_complex<vnl_rational> const> : public vnl_numeric_traits<vcl_complex<vnl_rational> >
+{
+};
+#endif
+
+vnl_rational vnl_math_squared_magnitude(vcl_complex<vnl_rational> const& );
+vnl_rational vnl_math_abs(vcl_complex<vnl_rational> const& );
+
+#endif // vnl_rational_traits_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real.h
new file mode 100644
index 0000000000000000000000000000000000000000..da865fe4886d2696ddebddbedb90ccd88fefb604
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real.h
@@ -0,0 +1,28 @@
+// This is core/vnl/vnl_real.h
+#ifndef vnl_real_h_
+#define vnl_real_h_
+//:
+// \file
+// \brief Functions to return the real parts of complex arrays, vectors, matrices
+//
+// \verbatim
+// Modifications
+// Peter Vanroose - 2 July 2002 - part of vnl_complex_ops.h moved here
+// \endverbatim
+
+#include <vcl_complex.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+//: Return array R of real parts of complex array C.
+template <class T> void vnl_real(vcl_complex<T> const* C, T* R, unsigned int n);
+
+//: Vector of real parts of vnl_vector<vcl_complex<T> >.
+// \relates vnl_vector
+template <class T> vnl_vector<T> vnl_real(vnl_vector<vcl_complex<T> > const& C);
+
+//: Matrix of real parts of vnl_matrix<vcl_complex<T> >.
+// \relates vnl_matrix
+template <class T> vnl_matrix<T> vnl_real(vnl_matrix<vcl_complex<T> > const& C);
+
+#endif // vnl_real_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dfa6554fc82a4c9c5d624b649510dd42a9a001f4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.cxx
@@ -0,0 +1,240 @@
+// This is core/vnl/vnl_real_npolynomial.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \brief a degree n real polynomial
+// \author Marc Pollefeys, ESAT-VISICS, K.U.Leuven, 12-08-97
+//
+// Implements a polynomial with N variables
+
+#include "vnl_real_npolynomial.h"
+#include <vcl_cassert.h>
+#include <vcl_cmath.h> // vcl_fabs()
+#include <vcl_iostream.h>
+
+//: Constructor
+//<PRE>
+// coeffs = vnl_vector<double>(nterms)
+// polyn = vnl_matrix<int>(nterms,nvar)
+// Example: A*x^3 + B*x*y + C*y^2 + D*x*y^2
+// nvar = 2;
+// nterms = 4;
+// coeffs = [A B C D]';
+// polyn = [3 0]
+// [1 1]
+// [0 2]
+// [1 2];
+//</PRE>
+
+vnl_real_npolynomial::vnl_real_npolynomial(const vnl_vector<double>& c, const vnl_matrix<unsigned int>& p)
+ : coeffs_(c)
+ , polyn_(p)
+ , nvar_(p.cols())
+ , nterms_(p.rows())
+ , ideg_(p.max_value())
+{
+ assert(c.size() == p.rows());
+ simplify();
+}
+
+//: Combine terms with identical exponents (i.e., identical rows in polyn_).
+// Remove terms with zero coefficient.
+void vnl_real_npolynomial::simplify()
+{
+ for (unsigned int row1=0; row1<nterms_; ++row1)
+ for (unsigned int row2=row1+1; row2<nterms_; ++row2) {
+ unsigned int col=0;
+ while (col<nvar_ && polyn_(row1,col) == polyn_(row2,col)) ++col;
+ if (col < nvar_) continue; // not all exponents are identical
+ coeffs_(row1) += coeffs_(row2); coeffs_(row2) = 0;
+ }
+ for (unsigned int row=0; row<nterms_; ++row)
+ if (coeffs_(row) == 0) {
+ --nterms_; // decrement nterms, and move last element to vacant place:
+ coeffs_(row) = coeffs_(nterms_);
+ coeffs_(nterms_) = 0; // not really necessary; to keep coeffs_ consistent
+ for (unsigned int i=0; i<nvar_; ++i)
+ polyn_(row,i) = polyn_(nterms_,i);
+ }
+}
+
+double vnl_real_npolynomial::eval(const vnl_matrix<double>& xn)
+{
+ double s=0;
+ for (unsigned int i=0; i<nterms_; i++){
+ double t=coeffs_(i);
+ for (unsigned int j=0; j<nvar_; j++)
+ t*=xn(j,polyn_(i,j));
+ s+=t;
+ }
+ return s;
+}
+
+double vnl_real_npolynomial::eval(const vnl_vector<double>& x)
+{
+ vnl_matrix<double> xn(nvar_,ideg_+1);
+
+ for (unsigned int j=0; j<nvar_; j++){
+ xn(j,0)=1;
+ for (unsigned int i=1; i<ideg_+1; i++)
+ xn(j,i)=xn(j,i-1)*x(j);
+ }
+ return eval(xn);
+}
+
+
+//: Set the coefficients and degree of variable
+void vnl_real_npolynomial::set(const vnl_vector<double>& c, const vnl_matrix<unsigned int>& p)
+{
+ coeffs_= c;
+ polyn_ = p;
+ nvar_ = p.cols();
+ nterms_ = p.rows();
+ ideg_ = p.max_value();
+}
+
+
+unsigned int vnl_real_npolynomial::degree()
+{
+ unsigned int d=0;
+ for (unsigned int i=0; i<nterms_; i++)
+ {
+ unsigned int dt=0;
+ for (unsigned int j=0; j<nvar_; j++)
+ dt+=polyn_(i,j);
+ if (dt>d) d=dt;
+ }
+ return d;
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator-() const
+{
+ vnl_vector<double> coef(nterms_);
+ for (unsigned int i=0; i<nterms_; ++i) coef(i) = - coeffs_(i);
+
+ vnl_matrix<unsigned int> poly = polyn_;
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator+(vnl_real_npolynomial const& P) const
+{
+ assert(nvar_ == P.nvar_); // both polynomials must have the same variables
+
+ vnl_vector<double> coef(nterms_+P.nterms_);
+ unsigned int i = 0; for (; i<nterms_; ++i) coef(i) = coeffs_(i);
+ for (unsigned int j=0; j<P.nterms_; ++i,++j) coef(i) = P.coeffs_(j);
+
+ vnl_matrix<unsigned int> poly(nterms_+P.nterms_,nvar_);
+ for (i=0; i<nterms_; ++i)
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(i,k) = polyn_(i,k);
+ for (unsigned int j=0; j<P.nterms_; ++i,++j)
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(i,k) = P.polyn_(j,k);
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator+(double P) const
+{
+ vnl_vector<double> coef(nterms_+1);
+ for (unsigned int i=0; i<nterms_; ++i)
+ coef(i) = coeffs_(i);
+ coef(nterms_) = P;
+
+ vnl_matrix<unsigned int> poly(nterms_+1,nvar_);
+ for (unsigned int i=0; i<nterms_; ++i)
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(i,k) = polyn_(i,k);
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(nterms_,k) = 0;
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator-(vnl_real_npolynomial const& P) const
+{
+ assert(nvar_ == P.nvar_); // both polynomials must have the same variables
+
+ vnl_vector<double> coef(nterms_+P.nterms_);
+ unsigned int i = 0; for (; i<nterms_; ++i) coef(i) = coeffs_(i);
+ for (unsigned int j=0; j<P.nterms_; ++i,++j) coef(i) = - P.coeffs_(j);
+
+ vnl_matrix<unsigned int> poly(nterms_+P.nterms_,nvar_);
+ for (i=0; i<nterms_; ++i)
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(i,k) = polyn_(i,k);
+ for (unsigned int j=0; j<P.nterms_; ++i,++j)
+ for (unsigned int k=0; k<nvar_; ++k)
+ poly(i,k) = P.polyn_(j,k);
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator*(vnl_real_npolynomial const& P) const
+{
+ assert(nvar_ == P.nvar_); // both polynomials must have the same variables
+
+ vnl_vector<double> coef(nterms_*P.nterms_);
+ unsigned int k = 0;
+ for (unsigned int i=0; i<nterms_; ++i)
+ for (unsigned int j=0; j<P.nterms_; ++j,++k)
+ coef(k) = coeffs_(i) * P.coeffs_(j);
+
+ vnl_matrix<unsigned int> poly(nterms_*P.nterms_,nvar_);
+ k = 0;
+ for (unsigned int i=0; i<nterms_; ++i)
+ for (unsigned int j=0; j<P.nterms_; ++j,++k)
+ for (unsigned int l=0; l<nvar_; ++l)
+ poly(k,l) = polyn_(i,l) + P.polyn_(j,l);
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vnl_real_npolynomial vnl_real_npolynomial::operator*(double P) const
+{
+ vnl_vector<double> coef(nterms_);
+ for (unsigned int i=0; i<nterms_; ++i)
+ coef(i) = coeffs_(i) * P;
+
+ vnl_matrix<unsigned int> poly = polyn_;
+
+ return vnl_real_npolynomial(coef, poly);
+}
+
+vcl_ostream& operator<<(vcl_ostream& os, vnl_real_npolynomial const& P)
+{
+ if (P.nvar_ <= 3)
+ for (unsigned int i=0; i<P.nterms_; ++i)
+ {
+ os << ' ';
+ if (i>0 && P.coeffs_(i) > 0) os << '+';
+ if (vcl_fabs(P.coeffs_(i)) != 1) os << P.coeffs_(i) << ' ';
+ unsigned int totaldeg = 0;
+ if (P.nvar_ > 0 && P.polyn_(i,0) > 0) { os << 'X'; totaldeg += P.polyn_(i,0); }
+ if (P.nvar_ > 0 && P.polyn_(i,0) > 1) os << '^' << P.polyn_(i,0);
+ if (P.nvar_ > 1 && P.polyn_(i,1) > 0) { os << 'Y'; totaldeg += P.polyn_(i,1); }
+ if (P.nvar_ > 1 && P.polyn_(i,1) > 1) os << '^' << P.polyn_(i,1);
+ if (P.nvar_ > 2 && P.polyn_(i,2) > 0) { os << 'Z'; totaldeg += P.polyn_(i,2); }
+ if (P.nvar_ > 2 && P.polyn_(i,2) > 1) os << '^' << P.polyn_(i,2);
+ if (totaldeg == 0 && vcl_fabs(P.coeffs_(i)) == 1) os << P.coeffs_(i);
+ }
+ else
+ for (unsigned int i=0; i<P.nterms_; ++i)
+ {
+ os << ' ';
+ if (i>0 && P.coeffs_(i) > 0) os << '+';
+ if (vcl_fabs(P.coeffs_(i)) != 1) os << P.coeffs_(i) << ' ';
+ unsigned int totaldeg = 0;
+ for (unsigned int j=0; j<P.nvar_; ++j) {
+ if (P.polyn_(i,j) > 0) os << 'X' << j;
+ if (P.polyn_(i,j) > 1) os << '^' << P.polyn_(i,j);
+ totaldeg += P.polyn_(i,j);
+ }
+ if (totaldeg == 0 && vcl_fabs(P.coeffs_(i)) == 1) os << P.coeffs_(i);
+ }
+ os << vcl_endl; return os;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.h
new file mode 100644
index 0000000000000000000000000000000000000000..7a104a174708109b91efd54f6ef69c7b76f49c85
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_npolynomial.h
@@ -0,0 +1,119 @@
+// This is core/vnl/vnl_real_npolynomial.h
+#ifndef vnl_real_npolynomial_h_
+#define vnl_real_npolynomial_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief contains class for polynomials with N variables
+//
+// Implements a polynomial with N variables
+//
+// \author Marc Pollefeys, ESAT-VISICS, K.U.Leuven
+// \date 12-08-97
+//
+// \verbatim
+// Modifications
+// Peter Vanroose 10 Oct 1999 - added simplify();
+// determine nterms_ nvar_ ideg_ automatically
+// Peter Vanroose 20 Oct 1999 - Added operator+(), - * and vcl_ostream <<
+// dac (Manchester) 15/03/2001: Tidied up the documentation + added binary_io
+// \endverbatim
+
+
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vcl_iosfwd.h>
+
+//: real polynomial in N variables.
+// vnl_real_npolynomial represents a polynomial in multiple variables.
+// Used by vnl_rnpoly_solve which solves systems of polynomial equations.
+// Representation: an N-omial (N terms) is represented by (1) a vector
+// with the N coefficients (vnl_vector<double>), and (2) a matrix with
+// N rows, the i-th row representing the exponents of term i, as follows:
+// (vnl_matrix<int>) column k contains the (integer) exponent of variable
+// k. Example: the polynomial $A X^3 + B XY + C Y^2 + D XY^2$ is
+// represented by the coefficients vector [A B C D] and the exponents
+// matrix
+// \verbatim
+// [3 0]
+// [1 1]
+// [0 2]
+// [1 2].
+// \endverbatim
+
+class vnl_real_npolynomial
+{
+ friend class vnl_rnpoly_solve;
+
+ public:
+
+ // Constructor-----------------------------------------------------------------
+ vnl_real_npolynomial() { } // don't use this. only here for the STL vector class.
+ vnl_real_npolynomial(const vnl_vector<double>& c, const vnl_matrix<unsigned int>& p);
+
+ // Computations--------------------------------------------------------------
+
+ double eval(const vnl_vector<double>& x);
+ unsigned int degree();
+ vnl_real_npolynomial operator-() const; // unary minus
+ vnl_real_npolynomial operator+(vnl_real_npolynomial const& ) const;
+ vnl_real_npolynomial operator-(vnl_real_npolynomial const& ) const;
+ vnl_real_npolynomial operator*(vnl_real_npolynomial const& ) const;
+ vnl_real_npolynomial operator+(double ) const;
+ vnl_real_npolynomial operator-(double P) const { return operator+(-P); }
+ vnl_real_npolynomial operator*(double ) const;
+ vnl_real_npolynomial& operator*=(double P) { coeffs_ *= P; return *this; }
+ vnl_real_npolynomial operator/(double P) const { return operator*(1.0/P); }
+ vnl_real_npolynomial& operator/=(double P) { return operator*=(1.0/P); }
+ friend vcl_ostream& operator<<(vcl_ostream& , vnl_real_npolynomial const& );
+
+ // nb also added functions to access the coeffs_ member variable
+
+ //--- Data Access------------------------------------------------------------
+
+ //: Return the degree (highest power of x) of the polynomial.
+ unsigned int degree() const { return coeffs_.size() - 1; }
+
+ //: Access to the polynomial coefficients
+ double& operator [] (unsigned int i) { return coeffs_[i]; }
+ //: Access to the polynomial coefficients
+ double operator [] (unsigned int i) const { return coeffs_[i]; }
+
+ //: Return the vector of coefficients
+ const vnl_vector<double>& coefficients() const { return coeffs_; }
+ //: Return the vector of coefficients
+ vnl_vector<double>& coefficients() { return coeffs_; }
+
+ //: Set vector of coefficients of each product
+ void set(const vnl_vector<double> & c, const vnl_matrix<unsigned int> & p);
+
+ //: Return the polynomial matrix
+ // (ie specifying the variables in each product)
+ const vnl_matrix<unsigned int>& polyn() const { return polyn_; }
+
+ //: Return the vector of coefficients
+ vnl_matrix<unsigned int>& polyn() { return polyn_; }
+
+ private:
+ void simplify();
+ double eval(const vnl_matrix<double>& xn);
+
+ // Data Members--------------------------------------------------------------
+
+ //: coefficients
+ vnl_vector<double> coeffs_;
+ //: degrees of every term for every variable
+ vnl_matrix<unsigned int> polyn_;
+ //: number of variables = # columns of polyn_
+ unsigned int nvar_;
+ //: number of terms of polynomial
+ unsigned int nterms_;
+ //: max. degree of polynomial
+ unsigned int ideg_;
+};
+
+#endif // vnl_real_npolynomial_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..13f91e3463ab5400e8a86f24517e3821423f4fb9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.cxx
@@ -0,0 +1,217 @@
+// This is core/vnl/vnl_real_polynomial.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \brief Evaluation of real polynomials - the implementation
+// \author Andrew W. Fitzgibbon, Oxford RRG 23 Aug 96
+//
+// Modifications
+// IMS (Manchester) 14/03/2001: Added Manchester IO scheme
+
+#include "vnl_real_polynomial.h"
+#include <vcl_iostream.h>
+#include <vcl_complex.h>
+#include <vcl_cmath.h>
+
+// This is replacing a member template...
+template <class T>
+T vnl_real_polynomial_evaluate(double const *a, int n, T const& x)
+{
+ --n;
+ T acc = a[n];
+ T xn = x;
+ while (n) {
+ acc += a[--n] * xn;
+ xn *= x;
+ } ;
+
+ return acc;
+}
+
+// The following code confuses doxygen, causing it to link every
+// mention of double to vnl_real_polynomial::evaluate
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+# ifdef VCL_WIN32
+# define SELECT(T) <T >
+# else
+# define SELECT(T)
+# endif
+
+//: Instantiate templates before use
+template double vnl_real_polynomial_evaluate SELECT(double )
+ (double const*,int,double const&);
+template vcl_complex<double> vnl_real_polynomial_evaluate SELECT(vcl_complex<double>)
+ (double const*,int,vcl_complex<double> const&);
+
+//: Evaluate polynomial at value x
+double vnl_real_polynomial::evaluate(double x) const
+{
+ return vnl_real_polynomial_evaluate SELECT(double)(coeffs_.data_block(), coeffs_.size(), x);
+}
+
+
+//: Evaluate polynomial at complex value x
+vcl_complex<double> vnl_real_polynomial::evaluate(vcl_complex<double> const& x) const
+{
+ return vnl_real_polynomial_evaluate SELECT(vcl_complex<double>)
+ (coeffs_.data_block(), coeffs_.size(), x);
+}
+#endif // DOXYGEN_SHOULD_SKIP_THIS
+
+//: Evaluate derivative at value x.
+double vnl_real_polynomial::devaluate(double x) const
+{
+ return derivative().evaluate(x);
+}
+
+
+//: Evaluate derivative at complex value x. Not implemented.
+vcl_complex<double> vnl_real_polynomial::devaluate(vcl_complex<double> const& x) const
+{
+ return derivative().evaluate(x);
+}
+
+//: Evaluate integral at x (assuming constant of integration is zero)
+double vnl_real_polynomial::evaluate_integral(double x) const
+{
+ int d = coeffs_.size()-1;
+ const double* f = coeffs_.data_block();
+ double sum = 0.0;
+ int di=1;
+ double xi=x;
+ for (int i=d;i>=0;--i)
+ {
+ sum += f[i]*xi/di;
+ xi*=x;
+ di++;
+ }
+
+ return sum;
+}
+
+//: Evaluate integral between x1 and x2
+double vnl_real_polynomial::evaluate_integral(double x1, double x2) const
+{
+ return evaluate_integral(x2)-evaluate_integral(x1);
+}
+
+//: Returns sum of two polynomials f1(x)+f2(x)
+vnl_real_polynomial operator+(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2)
+{
+ // Degree of result is highest of the two inputs
+ int d1=f1.degree();
+ int d2=f2.degree();
+ int d = d1;
+ if (d2>d) d=d2;
+
+ vnl_real_polynomial sum(d);
+
+ // Coefficients are stored such that f(i) is coef. on x^(d-i)
+ for (int i=0;i<=d;++i)
+ {
+ sum[d-i]=0.0;
+ if (i<=d1) sum[d-i]+=f1[d1-i];
+ if (i<=d2) sum[d-i]+=f2[d2-i];
+ }
+
+ return sum;
+}
+
+//: Returns sum of two polynomials f1(x)-f2(x)
+vnl_real_polynomial operator-(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2)
+{
+ // Degree of result is highest of the two inputs
+ int d1=f1.degree();
+ int d2=f2.degree();
+ int d = d1;
+ if (d2>d) d=d2;
+
+ vnl_real_polynomial sum(d);
+
+ // Coefficients are stored such that f(i) is coef. on x^(d-i)
+ for (int i=0;i<=d;++i)
+ {
+ sum[d-i]=0.0;
+ if (i<=d1) sum[d-i]+=f1[d1-i];
+ if (i<=d2) sum[d-i]-=f2[d2-i];
+ }
+
+ return sum;
+}
+
+//: Returns polynomial which is product of two polynomials f1(x)*f2(x)
+vnl_real_polynomial operator*(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2)
+{
+ int d1=f1.degree();
+ int d2=f2.degree();
+ int d = d1+d2;
+
+ vnl_real_polynomial sum(d);
+ sum.coefficients().fill(0.0);
+
+ for (int i=0;i<=d1;++i)
+ for (int j=0;j<=d2;++j)
+ sum[d-(i+j)] += (f1[d1-i]*f2[d2-j]);
+
+ return sum;
+}
+
+//: Returns RMS difference between f1 and f2 over range [x1,x2]
+// $\frac1{\sqrt{|x_2-x_1|}}\,\sqrt{\int_{x_1}^{x_2}\left(f_1(x)-f_2(x)\right)^2\,dx}$
+double vnl_rms_difference(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2,
+ double x1, double x2)
+{
+ double dx = vcl_fabs(x2-x1);
+ if (dx==0.0) return 0;
+
+ vnl_real_polynomial df = f2-f1;
+ vnl_real_polynomial df2 = df*df;
+ double area = vcl_fabs(df2.evaluate_integral(x1,x2));
+ return vcl_sqrt(area/dx);
+}
+
+//: Return derivative of this polynomial
+vnl_real_polynomial vnl_real_polynomial::derivative() const
+{
+ vnl_vector<double> c = coefficients();
+ int d = degree();
+ vnl_vector<double> cd (d);
+ for (int i=0; i<d; ++i)
+ cd[i] = c[i] * (d-i);
+ return vnl_real_polynomial(cd);
+}
+
+//: Return primitive function (inverse derivative) of this polynomial
+// Since a primitive function is not unique, the one with constant = 0 is returned
+vnl_real_polynomial vnl_real_polynomial::primitive() const
+{
+ vnl_vector<double> c = coefficients();
+ int d = degree();
+ vnl_vector<double> cd (d+2);
+ for (int i=0; i<=d; ++i)
+ cd[i] = c[i] / (d-i+1);
+ cd[d+1] = 0.0;
+ return vnl_real_polynomial(cd);
+}
+
+void vnl_real_polynomial::print(vcl_ostream& os) const
+{
+ int d = degree();
+ int i = 0;
+ while (i <= d && coeffs_[i] == 0) ++i;
+ if (i > d) { os << "0 "; return; }
+ bool b = (coeffs_[i+1] > 0); // to avoid '+' in front of equation
+
+ for (; i <= d; ++i) {
+ if (coeffs_[i] == 0) continue;
+ if (coeffs_[i] > 0 && !b) os << '+';
+ b = false;
+ if (coeffs_[i] == -1) os << '-';
+ else if (coeffs_[i] != 1) os << coeffs_[i];
+
+ if (i < d-1) os << " X^" << d-i << ' ';
+ else if (i == d-1) os << " X ";
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.h
new file mode 100644
index 0000000000000000000000000000000000000000..fd108d3ce460a439fa5b5fe3d19f92e81a7a8f14
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_real_polynomial.h
@@ -0,0 +1,132 @@
+// This is core/vnl/vnl_real_polynomial.h
+#ifndef vnl_real_polynomial_h_
+#define vnl_real_polynomial_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Evaluation of real polynomials
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 06 Aug 96
+//
+// \verbatim
+// Modifications
+// 23 may 97, Peter Vanroose - "NO_COMPLEX" option added (until "complex" type is standardised)
+// 27/03/2001 Ian Scott and Tim Cootes - Added Binary IO
+// 27/03/2001 Ian Scott - Comments tidied up
+// 25/11/2001 Peter Vanroose - added operator==(), derivative(), primitive(), print()
+// 12/22/2004 Kongbin Kang - add structured comment for operator==()
+// \endverbatim
+
+#include <vnl/vnl_vector.h>
+#include <vcl_complex.h>
+#include <vcl_iosfwd.h>
+#include <vcl_cassert.h>
+
+//:Evaluation of real polynomials at real and complex points.
+// vnl_real_polynomial represents a univariate polynomial with real
+// coefficients, stored as a vector of doubles. This allows
+// evaluation of the polynomial $p(x)$ at given values of $x$,
+// or of its derivative $p'(x)$.
+//
+// Roots may be extracted using the roots() method.
+class vnl_real_polynomial
+{
+ public:
+ //: Initialize polynomial.
+ // The polynomial is $ a[0] x^d + a[1] x^{d-1} + \cdots + a[d] = 0 $.
+ vnl_real_polynomial(vnl_vector<double> const & a): coeffs_(a) {
+ if (a.empty()) { coeffs_.set_size(1); coeffs_(0)=0.0; }
+ }
+
+ //: Initialize polynomial from C vector.
+ // The parameter len is the number
+ // of coefficients, one greater than the degree.
+ vnl_real_polynomial(double const * a, unsigned len): coeffs_(a, len) {
+ if (len==0) { coeffs_.set_size(1); coeffs_(0)=0.0; }
+ }
+
+ //: Initialize polynomial from double.
+ // Useful when adding or multiplying a polynomial and a number.
+ vnl_real_polynomial(double a): coeffs_(1u, a) {}
+
+ //: Initialize polynomial of a given degree.
+ vnl_real_polynomial(int d): coeffs_(d+1) { assert (d>=0); }
+
+ //: comparison operator
+ bool operator==(vnl_real_polynomial const& p) const { return p.coefficients() == coeffs_; }
+
+ //: Evaluate polynomial at value x
+ double evaluate(double x) const;
+
+ //: Evaluate integral at x (assuming constant of integration is zero)
+ double evaluate_integral(double x) const;
+
+ //: Evaluate integral between x1 and x2
+ double evaluate_integral(double x1, double x2) const;
+
+ //: Evaluate derivative at value x
+ double devaluate(double x) const;
+
+ //: Evaluate polynomial at complex value x
+ vcl_complex<double> evaluate(vcl_complex<double> const& x) const;
+
+
+ //: Evaluate derivative at complex value x
+ vcl_complex<double> devaluate(vcl_complex<double> const& x) const;
+
+ //: Return derivative of this polynomial
+ vnl_real_polynomial derivative() const;
+
+ //: Return primitive function (inverse derivative) of this polynomial
+ // Since a primitive function is not unique, the one with constant = 0 is returned
+ vnl_real_polynomial primitive() const;
+
+ // Data Access---------------------------------------------------------------
+
+ //: Return the degree (highest power of x) of the polynomial.
+ int degree() const { return int(coeffs_.size()) - 1; }
+
+ //: Access to the polynomial coefficients
+ double& operator [] (int i) { return coeffs_[i]; }
+ //: Access to the polynomial coefficients
+ double operator [] (int i) const { return coeffs_[i]; }
+
+ //: Return the vector of coefficients
+ const vnl_vector<double>& coefficients() const { return coeffs_; }
+ //: Return the vector of coefficients
+ vnl_vector<double>& coefficients() { return coeffs_; }
+
+ void set_coefficients(vnl_vector<double> const& coeffs) {coeffs_ = coeffs;}
+
+ //: Print this polynomial to stream
+ void print(vcl_ostream& os) const;
+
+ protected:
+ //: The coefficients of the polynomial.
+ // coeffs_.back() is the const term.
+ // coeffs_[n] is the coefficient of the x^(d-n) term,
+ // where d=coeffs_.size()-1
+ // \invariant coeffs_size() >= 1;
+ vnl_vector<double> coeffs_;
+};
+
+//: Returns polynomial which is sum of two polynomials f1(x)+f2(x)
+// \relates vnl_real_polynomial
+vnl_real_polynomial operator+(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2);
+
+//: Returns polynomial which is different of two polynomials f1(x)-f2(x)
+// \relates vnl_real_polynomial
+vnl_real_polynomial operator-(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2);
+
+//: Returns polynomial which is product of two polynomials f1(x)*f2(x)
+vnl_real_polynomial operator*(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2);
+
+//: Returns RMS difference between f1 and f2 over range [x1,x2]
+// $\frac1{\sqrt{|x_2-x_1|}}\,\sqrt{\int_{x_1}^{x_2}\left(f_1(x)-f_2(x)\right)^2\,dx}$
+// \relates vnl_real_polynomial
+double vnl_rms_difference(const vnl_real_polynomial& f1, const vnl_real_polynomial& f2,
+ double x1, double x2);
+
+#endif // vnl_real_polynomial_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..52a80a6463ace06b158f2f963d41c6380f3d01ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.cxx
@@ -0,0 +1,74 @@
+// This is core/vnl/vnl_rotation_matrix.cxx
+#include "vnl_rotation_matrix.h"
+
+#include <vcl_cmath.h>
+
+bool vnl_rotation_matrix(double const x[3], double **R)
+{
+ // start with an identity matrix.
+ for (unsigned i=0; i<3; ++i)
+ for (unsigned j=0; j<3; ++j)
+ R[i][j] = (i==j ? 1 : 0);
+
+ // normalize x to a unit vector u, of norm 'angle'.
+ double u[3] = {x[0], x[1], x[2]};
+ double angle = vcl_sqrt(u[0]*u[0] + u[1]*u[1] + u[2]*u[2]);
+ if (angle == 0)
+ return true;
+ u[0] /= angle;
+ u[1] /= angle;
+ u[2] /= angle;
+
+ // add (cos(angle)-1)*(1 - u u').
+ double cos_angle = vcl_cos(angle);
+ for (unsigned i=0; i<3; ++i)
+ for (unsigned j=0; j<3; ++j)
+ R[i][j] += (cos_angle-1) * ((i==j ? 1:0) - u[i]*u[j]);
+
+ // add sin(angle) * [u]
+ double sin_angle = vcl_sin(angle);
+ /* */ R[0][1] -= sin_angle*u[2]; R[0][2] += sin_angle*u[1];
+ R[1][0] += sin_angle*u[2]; /* */ R[1][2] -= sin_angle*u[0];
+ R[2][0] -= sin_angle*u[1]; R[2][1] += sin_angle*u[0]; /* */
+
+#if 0
+ vcl_cerr << "axis = [" << axis[0] << ' ' << axis[1] << ' ' << axis[2] << "];\n";
+
+ vcl_cerr << "R=[\n";
+ for (unsigned i=0; i<3; ++i) {
+ for (unsigned j=0; j<3; ++j)
+ vcl_cerr << ' ' << R[i][j];
+ vcl_cerr << vcl_endl;
+ }
+ vcl_cerr << "];\n";
+ vcl_exit(1);
+#endif
+ return true;
+}
+
+bool vnl_rotation_matrix(double const axis[3], double R[3][3])
+{
+ double *R_[3] = { R[0], R[1], R[2] };
+ return vnl_rotation_matrix(axis, R_);
+}
+
+bool vnl_rotation_matrix(double const axis[3], double *R0, double *R1, double *R2)
+{
+ double *R[3] = { R0, R1, R2 };
+ return vnl_rotation_matrix(axis, R);
+}
+
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+
+bool vnl_rotation_matrix(vnl_vector<double> const &axis, vnl_matrix<double> &R)
+{
+ return vnl_rotation_matrix(&axis[0], R.data_array());
+}
+
+vnl_matrix<double> vnl_rotation_matrix(vnl_vector<double> const &axis)
+{
+ vnl_matrix<double> R(3, 3);
+ vnl_rotation_matrix(&axis[0], R.data_array());
+ return R;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..7f36b996c11fcb1a1096903ca36137193d34d828
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_rotation_matrix.h
@@ -0,0 +1,23 @@
+// This is core/vnl/vnl_rotation_matrix.h
+#ifndef vnl_rotation_matrix_h_
+#define vnl_rotation_matrix_h_
+//:
+// \file
+// \brief Functions to create a 3x3 rotation matrix
+//
+// The result is a (special) orthogonal 3x3 matrix which is a
+// rotation about the axis, by an angle equal to ||axis||.
+
+template <class T> class vnl_vector;
+template <class T> class vnl_matrix;
+
+bool vnl_rotation_matrix(double const axis[3], double **R);
+bool vnl_rotation_matrix(double const axis[3], double *R0, double *R1, double *R2);
+bool vnl_rotation_matrix(double const axis[3], double R[3][3]);
+bool vnl_rotation_matrix(vnl_vector<double> const &axis, vnl_matrix<double> &R);
+
+//: Returns an orthogonal 3x3 matrix which is a rotation about the axis, by an angle equal to ||axis||.
+// \relates vnl_matrix
+vnl_matrix<double> vnl_rotation_matrix(vnl_vector<double> const &axis);
+
+#endif // vnl_rotation_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..e8a1f44f6eacd70788b8c6b705959ff7e6228b09
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.cxx
@@ -0,0 +1,71 @@
+// This is core/vnl/vnl_sample.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//:
+// \file
+// \author fsm
+
+#include "vnl_sample.h"
+#include <vnl/vnl_math.h>
+
+#include <vcl_cmath.h>
+#include <vxl_config.h>
+
+#if VXL_STDLIB_HAS_DRAND48
+# include <stdlib.h> // dont_vxl_filter
+#else
+// rand() is not always a good random number generator,
+// so use a simple congruential random number generator - PVr
+static unsigned long vnl_sample_seed = 12345;
+#endif
+
+# include <vcl_ctime.h>
+
+void vnl_sample_reseed()
+{
+#if VXL_STDLIB_HAS_SRAND48
+ srand48( vcl_time(0) );
+#elif !VXL_STDLIB_HAS_DRAND48
+ vnl_sample_seed = (unsigned long)vcl_time(0);
+#endif
+}
+
+void vnl_sample_reseed(int seed)
+{
+#if VXL_STDLIB_HAS_SRAND48
+ srand48( seed );
+#elif !VXL_STDLIB_HAS_DRAND48
+ vnl_sample_seed = seed;
+#endif
+}
+
+//: return a random number uniformly drawn on [a, b)
+double vnl_sample_uniform(double a, double b)
+{
+#if VXL_STDLIB_HAS_DRAND48
+ double u = drand48(); // uniform on [0, 1)
+#else
+ vnl_sample_seed = (vnl_sample_seed*16807)%2147483647L;
+ double u = double(vnl_sample_seed)/2147483647L; // uniform on [0, 1)
+#endif
+ return (1.0 - u)*a + u*b;
+}
+
+void vnl_sample_normal_2(double *x, double *y)
+{
+ double u = vnl_sample_uniform(0, 1);
+ double theta = vnl_sample_uniform(0, 2 * vnl_math::pi);
+
+ double r = vcl_sqrt(-2*vcl_log(u));
+
+ if (x) *x = r * vcl_cos(theta);
+ if (y) *y = r * vcl_sin(theta);
+}
+
+double vnl_sample_normal(double mean, double sigma)
+{
+ double x;
+ vnl_sample_normal_2(&x, 0);
+ return mean + sigma * x;
+}
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.h
new file mode 100644
index 0000000000000000000000000000000000000000..da2b8af48e40ed329ce03d84cd2a858cc5999dfc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sample.h
@@ -0,0 +1,63 @@
+// This is core/vnl/vnl_sample.h
+#ifndef vnl_sample_h_
+#define vnl_sample_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief easy ways to sample from various probability distributions
+
+//: re-seed the random number generator.
+void vnl_sample_reseed();
+
+//: re-seed the random number generator given a seed.
+void vnl_sample_reseed(int seed);
+
+//: uniform on [a, b)
+double vnl_sample_uniform(double a, double b);
+
+//: two independent samples from a standard normal distribution.
+void vnl_sample_normal_2(double *x, double *y);
+
+//: Normal distribution with given mean and standard deviation
+double vnl_sample_normal(double mean, double sigma);
+
+// P(X = k) = [kth term in binomial expansion of (p + (1-p))^n]
+//int vnl_sample_binomial(int n, int k, double p);
+
+// ----------------------------------------
+
+//: handy function to fill a range of values.
+template <class I>
+inline void vnl_sample_uniform(I begin, I end, double a, double b)
+{
+ for (I p=begin; p!=end; ++p)
+ (*p) = vnl_sample_uniform(a, b);
+}
+
+//: handy function to fill a range of values.
+template <class I>
+inline void vnl_sample_normal(I begin, I end, double mean, double sigma)
+{
+ for (I p=begin; p!=end; ++p)
+ (*p) = vnl_sample_normal(mean, sigma);
+}
+
+//: handy function to fill a range of values.
+template <class I, class T>
+inline void vnl_sample_uniform(I begin, I end, double a, double b, T /*dummy*/)
+{
+ for (I p=begin; p!=end; ++p)
+ (*p) = T(vnl_sample_uniform(a, b));
+}
+
+//: handy function to fill a range of values.
+template <class I, class T>
+inline void vnl_sample_normal(I begin, I end, double mean, double sigma, T /*dummy*/)
+{
+ for (I p=begin; p!=end; ++p)
+ (*p) = T(vnl_sample_normal(mean, sigma));
+}
+
+#endif // vnl_sample_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.h
new file mode 100644
index 0000000000000000000000000000000000000000..e51bc74303937874677d873240aee2e763d61d69
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.h
@@ -0,0 +1,138 @@
+// This is core/vnl/vnl_scalar_join_iterator.h
+#ifndef vnl_scalar_join_iterator_h_
+#define vnl_scalar_join_iterator_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Database join on matrix columns
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 27 Dec 96
+//
+// vnl_scalar_join_iterator implements a fast database join on columns
+// of matrices of scalars. "Scalar" here really means that the
+// objects have comparison operators. The cost is O(n log n) where
+// n is the number of rows, all for the two sorts in the ctor.
+//
+// CAVEAT: The current implementation fudges multiple occurrences
+// of the same key in the source column. For example,
+// \verbatim
+// join 1 3 and 3 5 on columns 2 and 1 respectively
+// 2 3 3 6
+// \endverbatim
+// should give
+// \verbatim
+// 1 3 3 5
+// 1 3 3 6
+// 2 3 3 5
+// 2 3 3 6
+// \endverbatim
+// and it doesn't. Contact awf if you need this to work.
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) Documentation Tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_list.h>
+#include <vnl/vnl_matrix.h>
+
+template <class T>
+class vnl_scalar_join_iterator_indexed_pair;
+
+//: Database join on matrix columns.
+// vnl_scalar_join_iterator implements a fast database join on columns
+// of matrices of scalars. "Scalar" here really means that the
+// objects have comparison operators. The cost is O(n log n) where
+// n is the number of rows, all for the two sorts in the ctor.
+//
+// CAVEAT: The current implementation fudges multiple occurrences
+// of the same key in the source column. For example,
+// \verbatim
+// join 1 3 and 3 5 on columns 2 and 1 respectively
+// 2 3 3 6
+// \endverbatim
+// should give
+// \verbatim
+// 1 3 3 5
+// 1 3 3 6
+// 2 3 3 5
+// 2 3 3 6
+// \endverbatim
+// and it doesn't. Contact awf if you need this to work.
+
+template <class T>
+class vnl_scalar_join_iterator
+{
+ VCL_SAFE_BOOL_DEFINE;
+ protected:
+ unsigned n1;
+ unsigned n2;
+ vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >* pI1;
+ vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >* pI2;
+ vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >& I1;
+ vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >& I2;
+ typename vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >::iterator index1;
+ typename vcl_list<vnl_scalar_join_iterator_indexed_pair<T> >::iterator index2;
+
+ public:
+
+ //: Initialize this iterator to the join of relation1(:,column1) and relation2(:,column2).
+ // The algorithm sorts an array of pointers to each row and
+ // traversal of the iterator runs through these to produce the join.
+ // After construction the row1() and row2() methods indicate the first pair.
+ vnl_scalar_join_iterator(const vnl_matrix<T>& relation1, unsigned column1,
+ const vnl_matrix<T>& relation2, unsigned column2);
+
+ ~vnl_scalar_join_iterator();
+
+
+ //: Return true if all pairs have been seen.
+ operator safe_bool () const
+ { return (!done())? VCL_SAFE_BOOL_TRUE : 0; }
+
+ //: Return false if all pairs have been seen.
+ bool operator!() const
+ { return (!done())? false : true; }
+
+ //: Advance to the next pair. This is prefix ++.
+ inline vnl_scalar_join_iterator<T>& operator ++ () { next(); return *this; }
+
+ bool done() const;
+ void next();
+
+ //: Return the index of the current row in the first relation.
+ unsigned row1() const;
+ //: Return the index of the current row in the second relation.
+ unsigned row2() const;
+
+ private:
+ // Postfix ++ is private as it would be costly to implement.
+ vnl_scalar_join_iterator<T>& operator ++ (int);
+
+#if 0
+ T object1() const { return *I1[index1].object; }
+ T object2() const { return *I2[index2].object; }
+#endif
+};
+
+//: Helper class to hold the sorted arrays of indices.
+template <class T>
+class vnl_scalar_join_iterator_indexed_pair
+{
+ public:
+ const T* object;
+ int original_index;
+
+ vnl_scalar_join_iterator_indexed_pair() {}
+ vnl_scalar_join_iterator_indexed_pair(const T* object_, int original_index_):object(object_), original_index(original_index_) {}
+
+ bool operator == (const vnl_scalar_join_iterator_indexed_pair<T>& that) const;
+ bool operator < (const vnl_scalar_join_iterator_indexed_pair<T>& that) const;
+};
+
+#endif // vnl_scalar_join_iterator_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.txx
new file mode 100644
index 0000000000000000000000000000000000000000..e3372095d9bd7537fd5ddc3f0f74c8ce02a88bb3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_scalar_join_iterator.txx
@@ -0,0 +1,161 @@
+// This is core/vnl/vnl_scalar_join_iterator.txx
+#ifndef vnl_scalar_join_iterator_txx_
+#define vnl_scalar_join_iterator_txx_
+//:
+// \file
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 27 Dec 96
+//
+//-----------------------------------------------------------------------------
+
+#include "vnl_scalar_join_iterator.h"
+#include <vcl_list.txx>
+
+#define VNL_SCALAR_JOIN_ITERATOR_INSTANTIATE(T) \
+template class vnl_scalar_join_iterator_indexed_pair<T >;\
+template class vnl_scalar_join_iterator<T >; \
+template vcl_ostream& operator<<(vcl_ostream& s, const vnl_scalar_join_iterator_indexed_pair<T >& p);\
+VCL_LIST_INSTANTIATE(vnl_scalar_join_iterator_indexed_pair<T >)
+
+#include <vcl_cassert.h>
+#include <vcl_iostream.h>
+#include <vnl/vnl_matrix.h>
+
+// Helper class to hold the sorted arrays of indices.
+
+template <class T>
+bool vnl_scalar_join_iterator_indexed_pair<T>::operator ==
+ (const vnl_scalar_join_iterator_indexed_pair<T>& that) const
+{
+ return (*that.object) == (*object);
+}
+
+template <class T>
+bool vnl_scalar_join_iterator_indexed_pair<T>::operator <
+ (const vnl_scalar_join_iterator_indexed_pair<T>& that) const
+{
+ return (*object) < (*that.object);
+}
+
+template <class T>
+vcl_ostream& operator<<(vcl_ostream& s,
+ const vnl_scalar_join_iterator_indexed_pair<T>& p)
+{
+ return s << p.original_index << " " << *(p.object) << '\n';
+}
+
+template <class T>
+vnl_scalar_join_iterator<T>::vnl_scalar_join_iterator
+ (const vnl_matrix<T>& relation1, unsigned column1,
+ const vnl_matrix<T>& relation2, unsigned column2):
+ n1(relation1.rows()),
+ n2(relation2.rows()),
+ pI1(new vcl_list<vnl_scalar_join_iterator_indexed_pair<T > >(n1)),
+ pI2(new vcl_list<vnl_scalar_join_iterator_indexed_pair<T > >(n2)),
+ I1(*pI1),
+ I2(*pI2)
+{
+ // Sort on appropriate columns
+ {
+ for (unsigned i = 0; i < n1; ++i)
+ I1.push_back(vnl_scalar_join_iterator_indexed_pair<T>(&relation1(i, column1), i));
+ I1.sort();
+ }
+ {
+ for (unsigned i = 0; i < n2; ++i)
+ I2.push_back(vnl_scalar_join_iterator_indexed_pair<T>(&relation2(i, column2), i));
+ I2.sort();
+ }
+
+ // Initialize for iteration
+ index1 = I1.begin();
+ index2 = I2.begin();
+
+ // Loop to first
+ for (;;) {
+ T star1 = *(*index1).object;
+ T star2 = *(*index2).object;
+ if (star1 == star2)
+ return;
+
+ if (star1 > star2)
+ ++index2;
+ else
+ ++index1;
+ }
+}
+
+//: Destructor
+template <class T>
+vnl_scalar_join_iterator<T>::~vnl_scalar_join_iterator()
+{
+ delete pI1;
+ delete pI2;
+}
+
+template <class T>
+bool vnl_scalar_join_iterator<T>::done() const
+{
+ return (index1 == I1.end()) || (index2 == I2.end());
+}
+
+//: Increment the iterator to point to the next pair of rows.
+template <class T>
+void vnl_scalar_join_iterator<T>::next()
+{
+ T obj1 = *(*index1).object;
+ // increment i2, check if still valid/same
+ if (++index2 == I2.end()) return;
+
+ T nextobj2 = *(*index2).object;
+ if (obj1 == nextobj2)
+ return; // Found another match
+
+ // nextobj2 must not be < obj1
+ assert(!(nextobj2 < obj1));
+
+ // So, objects are different (in fact, obj1 > obj2 right now), lockstep until
+ // they match or we're done.
+ while (!done()) {
+ T obj1 = *(*index1).object;
+ T obj2 = *(*index2).object;
+
+ if (obj1 == obj2) {
+ // If they're equal, hack back along obj2's array to find the start of the
+ // stretch of equal ones. This allows join
+ // 1 3 3 5
+ // 2 3 3 6
+ // to return the kronecker product of the sets by iteration.
+ // No that's going to be a hack. Will be fixed RSN.
+ return;
+ }
+
+ if (obj1 > obj2)
+ ++index2;
+ else
+ ++index1;
+ }
+}
+
+template <class T>
+unsigned vnl_scalar_join_iterator<T>::row1()
+{
+ return (*index1).original_index;
+}
+
+template <class T>
+unsigned vnl_scalar_join_iterator<T>::row2()
+{
+ return (*index2).original_index;
+}
+
+//: Postfix ++ should not be used. Only present for instantiation purposes.
+template <class T>
+vnl_scalar_join_iterator<T>& vnl_scalar_join_iterator<T>::operator++(int)
+{
+ vcl_cerr << "This should not happen! postfix ++ called\n";
+ return *this;
+}
+
+#endif // vnl_scalar_join_iterator_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..1b7e0387a4423d56086cbf30cae86faa2180e011
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.h
@@ -0,0 +1,204 @@
+// This is core/vnl/vnl_sparse_matrix.h
+#ifndef vnl_sparse_matrix_h_
+#define vnl_sparse_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Simple sparse matrix
+//
+// Only those values which
+// are non-zero are stored. The sparse matrix currently supports
+// only getting/putting elements, and multiply by vector or another
+// sparse matrix.
+//
+// Each row is stored as a vector of vcl_pair<unsigned int,T>, where the first
+// of the pair indicates the column index, and the second the
+// value. All rows are stored, as vcl_vector< row >;
+//
+// \author Rupert W. Curwen, GE CR&D
+// \date 20 Oct 98
+//
+// \verbatim
+// Modifications
+//
+// Robin Flatland 5/31/99 Added pre_mult(lhs,result), where
+// lhs is a vector.
+//
+// Robin Flatland 6/08/99 Added iterator that allows sequential
+// access to non-zero values in matrix.
+// Iterator is controlled using reset, next,
+// getrow, getcolumn, and value.
+//
+// David Capel May 2000 Added set_row, scale_row, mult, vcat and const
+// methods where appropriate.
+// \endverbatim
+
+#include <vcl_vector.h>
+#include <vnl/vnl_vector.h>
+#include <vcl_functional.h>
+
+//: Stores elements of sparse matrix
+// Only those values which
+// are non-zero are stored. The sparse matrix currently supports
+// only getting/putting elements, and multiply by vector or another
+// sparse matrix.
+//
+// Each row is stored as a vector of vcl_pair<unsigned int,T>, where the first
+// of the pair indicates the column index, and the second the
+// value. All rows are stored, as vcl_vector< row >;
+//
+template <class T>
+class vnl_sparse_matrix_pair
+{
+ public:
+ unsigned int first;
+ T second;
+
+//: Constructs a pair with null values
+ vnl_sparse_matrix_pair() : first(0), second(T(0)) {}
+
+//: Constructs a pair with position a and value b
+ vnl_sparse_matrix_pair(unsigned int const& a, T const& b) : first(a), second(b) {}
+
+ vnl_sparse_matrix_pair(const vnl_sparse_matrix_pair<T>& o) : first(o.first), second(o.second) {}
+
+ vnl_sparse_matrix_pair<T>& operator=(vnl_sparse_matrix_pair const &o) {
+ if (&o != this) {
+ first = o.first;
+ second = o.second;
+ }
+ return *this;
+ }
+
+ struct less : public vcl_binary_function<vnl_sparse_matrix_pair, vnl_sparse_matrix_pair, bool>
+ {
+ bool operator() (vnl_sparse_matrix_pair const& p1, vnl_sparse_matrix_pair const& p2) {
+ return p1.first < p2.first;
+ }
+ };
+};
+
+
+//: Simple sparse matrix
+// Stores non-zero elements as a sparse_matrix_pair
+template <class T>
+class vnl_sparse_matrix
+{
+ public:
+ typedef vnl_sparse_matrix_pair<T> pair_t;
+#if defined(VCL_SUNPRO_CC)
+ // SunPro is the broken one.
+ typedef vcl_vector < typename pair_t > row;
+ typedef vcl_vector < typename row > vnl_sparse_matrix_elements;
+#else
+ typedef vcl_vector < pair_t > row;
+ typedef vcl_vector < row > vnl_sparse_matrix_elements;
+#endif
+
+ // typedef vcl_vector<typename pair_t> row;
+
+ //: Construct an empty matrix
+ vnl_sparse_matrix();
+
+ //: Construct an empty m*n matrix
+ vnl_sparse_matrix(unsigned int m, unsigned int n);
+
+ //: Construct an m*n Matrix and copy rhs into it.
+ vnl_sparse_matrix(const vnl_sparse_matrix<T>& rhs);
+
+ //: Copy another vnl_sparse_matrix<T> into this.
+ vnl_sparse_matrix<T>& operator=(const vnl_sparse_matrix<T>& rhs);
+
+ //: Multiply this*rhs, another sparse matrix.
+ void mult(vnl_sparse_matrix<T> const& rhs, vnl_sparse_matrix<T>& result) const;
+
+ //: Multiply this*rhs, where rhs is a vector.
+ void mult(vnl_vector<T> const& rhs, vnl_vector<T>& result) const;
+
+ //: Multiply this*p, a fortran order matrix.
+ void mult(unsigned int n, unsigned int m, T const* p, T* q) const;
+
+ //: Multiplies lhs*this, where lhs is a vector
+ void pre_mult(const vnl_vector<T>& lhs, vnl_vector<T>& result) const;
+
+ //: Add rhs to this.
+ void add(const vnl_sparse_matrix<T>& rhs, vnl_sparse_matrix<T>& result) const;
+
+ //: Subtract rhs from this.
+ void subtract(const vnl_sparse_matrix<T>& rhs, vnl_sparse_matrix<T>& result) const;
+
+ //: Get a reference to an entry in the matrix.
+ T& operator()(unsigned int row, unsigned int column);
+
+ //: Get diag(A_tranpose * A).
+ // Useful for forming Jacobi preconditioners for linear solvers.
+ void diag_AtA(vnl_vector<T>& result) const;
+
+ //: Set a whole row at once. Much faster.
+ void set_row(unsigned int r,
+ vcl_vector<int> const& cols,
+ vcl_vector<T> const& vals);
+
+ //: Return row as vector of pairs
+ // Added to aid binary I/O
+ row& get_row(unsigned int r) {return elements[r];}
+
+ //: Laminate matrix A onto the bottom of this one
+ vnl_sparse_matrix<T>& vcat(vnl_sparse_matrix<T> const& A);
+
+ //: Get the number of rows in the matrix.
+ unsigned int rows() const { return rs_; }
+
+ //: Get the number of columns in the matrix.
+ unsigned int columns() const { return cs_; }
+
+ //: Get the number of columns in the matrix.
+ unsigned int cols() const { return cs_; }
+
+ //: Return whether a given row is empty
+ bool empty_row(unsigned int r) const { return elements[r].empty(); }
+
+ //: This is occasionally useful.
+ T sum_row(unsigned int r);
+
+ //: Useful for normalizing row sums in convolution operators
+ void scale_row(unsigned int r, T scale);
+
+ //: Resizes the array to have r rows and c cols -- sets elements to null
+ void set_size( int r, int c );
+
+ //: Resizes the array to have r rows and c cols
+ void resize( int r, int c );
+
+ //: Resets the internal iterator
+ void reset();
+
+ //: Moves the internal iterator to next non-zero entry in matrix.
+ // Returns true if there is another value, false otherwise. Use
+ // in combination with methods reset, getrow, getcolumn, and value.
+ bool next();
+
+ //: Returns the row of the entry pointed to by internal iterator.
+ int getrow();
+
+ //: Returns the column of the entry pointed to by internal iterator.
+ int getcolumn();
+
+ //: Returns the value pointed to by the internal iterator.
+ T value();
+
+
+ protected:
+ vnl_sparse_matrix_elements elements;
+ unsigned int rs_, cs_;
+
+ // internal iterator
+ unsigned int itr_row;
+ typename row::iterator itr_cur;
+ bool itr_isreset;
+};
+
+
+#endif // vnl_sparse_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..b400079b07d36d2c2f7598ba3c38ef781ff0793a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix.txx
@@ -0,0 +1,610 @@
+// This is core/vnl/vnl_sparse_matrix.txx
+#ifndef vnl_sparse_matrix_txx_
+#define vnl_sparse_matrix_txx_
+//:
+// \file
+
+#include "vnl_sparse_matrix.h"
+#include <vcl_cassert.h>
+#include <vcl_algorithm.h>
+#include <vcl_iostream.h>
+
+// #define DEBUG_SPARSE 1
+
+#ifdef DEBUG_SPARSE
+# include <vnl/vnl_matrix.h>
+#endif
+
+// Implementation of vnl_sparse_matrix
+//------------------------------------------------------------
+
+//: Construct an empty matrix
+template <class T>
+vnl_sparse_matrix<T>::vnl_sparse_matrix()
+ : rs_(0), cs_(0)
+{
+}
+
+//------------------------------------------------------------
+//: Construct an empty m*n matrix. There are m rows and n columns.
+template <class T>
+vnl_sparse_matrix<T>::vnl_sparse_matrix(unsigned int m, unsigned int n)
+ : elements(m), rs_(m), cs_(n)
+{
+}
+
+//------------------------------------------------------------
+//: Construct an m*n Matrix and copy rhs into it.
+template <class T>
+vnl_sparse_matrix<T>::vnl_sparse_matrix(const vnl_sparse_matrix<T>& rhs)
+ : elements(rhs.elements), rs_(rhs.rs_), cs_(rhs.cs_)
+{
+}
+
+//------------------------------------------------------------
+//: Copy another vnl_sparse_matrix<T> into this.
+template <class T>
+vnl_sparse_matrix<T>& vnl_sparse_matrix<T>::operator=(const vnl_sparse_matrix<T>& rhs)
+{
+ if (this == &rhs)
+ return *this;
+
+ elements = rhs.elements;
+ rs_ = rhs.rs_;
+ cs_ = rhs.cs_;
+
+ return *this;
+}
+
+//------------------------------------------------------------
+//: Multiply this*rhs, another sparse matrix.
+template <class T>
+void vnl_sparse_matrix<T>::mult(vnl_sparse_matrix<T> const& rhs, vnl_sparse_matrix<T>& result) const
+{
+ assert(rhs.rows() == columns());
+ unsigned int result_rows = rows();
+ unsigned int result_cols = rhs.columns();
+
+ // Clear result matrix.
+ result.elements.clear();
+
+ // Now give the result matrix enough rows.
+ result.elements.resize(result_rows);
+ result.rs_ = result_rows;
+ result.cs_ = result_cols;
+
+ // Now, iterate over non-zero rows of this.
+ for (unsigned row_id=0; row_id<elements.size(); ++row_id) {
+ // Get the row from this matrix (lhs).
+ row const& this_row = elements[row_id];
+
+ // Skip to next row if empty.
+ if (this_row.empty())
+ continue;
+
+ // Get the new row in the result matrix.
+ row& result_row = result.elements[row_id];
+
+ // Iterate over the row.
+ for (typename row::const_iterator col_iter = this_row.begin();
+ col_iter != this_row.end();
+ ++col_iter)
+ {
+ // Get the element from the row.
+ vnl_sparse_matrix_pair<T> const & entry = *col_iter;
+ unsigned const col_id = entry.first;
+
+ // So we are at (row_id,col_id) = this_val in lhs matrix (this).
+ // This must be multiplied by each entry in row col_id in
+ // the rhs matrix, and the result added to result_row[col_id].
+
+ // If that row in rhs is empty, there is nothing to do.
+ row const & rhs_row = rhs.elements[col_id];
+ if (rhs_row.empty())
+ continue;
+
+ // Else iterate over rhs's row.
+ typename row::iterator result_col_iter = result_row.begin();
+ for (typename row::const_iterator rhs_col_iter = rhs_row.begin();
+ rhs_col_iter != rhs_row.end();
+ ++rhs_col_iter)
+ {
+ const vnl_sparse_matrix_pair<T>& rhs_entry = *rhs_col_iter;
+ unsigned int const dest_col = rhs_entry.first;
+
+ // Calculate the product.
+ T prod = entry.second * rhs_entry.second;
+
+ // This must be added into result_row, at column dest_col.
+ while ((result_col_iter != result_row.end()) &&
+ ((*result_col_iter).first < dest_col))
+ ++result_col_iter;
+
+ if ((result_col_iter == result_row.end()) ||
+ ((*result_col_iter).first != dest_col))
+ {
+ // Add new column to the row.
+ result_col_iter = result_row.insert(result_col_iter, vnl_sparse_matrix_pair<T>(dest_col,prod));
+ }
+ else
+ {
+ // Else add product to existing contents.
+ (*result_col_iter).second += prod;
+ }
+ }
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Multiply this*p, a fortran order matrix.
+// The matrix p has n rows and m columns, and is in fortran order, ie. columns first.
+template <class T>
+void vnl_sparse_matrix<T>::mult(unsigned int prows, unsigned int pcols,
+ T const* p, T* q) const
+{
+ assert(prows == columns());
+
+ // Clear q matrix.
+ int size = prows*pcols;
+ for (int temp=0; temp<size; temp++)
+ q[temp] = T(0);
+
+#ifdef DEBUG_SPARSE
+ vnl_matrix<double> md(rows(),columns());
+ for (int rr = 0; rr<rows(); rr++)
+ for (int cc = 0; cc<columns(); cc++)
+ md(rr,cc) = (*this)(rr,cc);
+
+ vnl_matrix<double> pd(prows,pcols);
+ for (int rr = 0; rr<prows; rr++)
+ for (int cc = 0; cc<pcols; cc++)
+ pd(rr,cc) = p[rr + cc*prows];
+
+ vcl_cout << "Initial p:\n";
+ for (int rr = 0; rr<prows; rr++) {
+ for (int cc = 0; cc<pcols; cc++) {
+ T pval = p[rr + cc*prows];
+ vcl_cout << pval << ' ';
+ }
+ vcl_cout << '\n';
+ }
+#endif
+
+ // Now, iterate over non-zero rows of this.
+ for (unsigned row_id=0; row_id<elements.size(); ++row_id) {
+ // Get the row from this matrix (lhs).
+ row const & this_row = elements[row_id];
+
+ // Skip to next row if empty.
+ if (this_row.empty())
+ continue;
+
+ // Iterate over the row.
+ for (typename row::const_iterator col_iter = this_row.begin();
+ col_iter != this_row.end();
+ ++col_iter)
+ {
+ // Get the element from the row.
+ vnl_sparse_matrix_pair<T> const & entry = *col_iter;
+ unsigned const col_id = entry.first;
+
+ // So we are at (row_id,col_id) = this_val in lhs matrix
+ // (this). This must be multiplied by each entry in row
+ // col_id in the p matrix, and the result added to
+ // (row_id,p_col_id) in the q matrix.
+ //
+
+ // Iterate over p's row.
+ for (unsigned int p_col_id = 0; p_col_id < pcols; p_col_id++) {
+ // Get the correct position from p.
+ T pval = p[col_id + p_col_id*prows];
+
+ // Calculate the product.
+ T prod = entry.second * pval;
+
+ // Add the product into the correct position in q.
+ q[row_id + p_col_id*prows] += prod;
+ }
+ }
+ }
+
+#ifdef DEBUG_SPARSE
+ vcl_cout << "Final q:\n";
+ for (int rr = 0; rr<prows; rr++) {
+ for (int cc = 0; cc<pcols; cc++) {
+ T pval = q[rr + cc*prows];
+ vcl_cout << pval << ' ';
+ }
+ vcl_cout << '\n';
+ }
+ vcl_cout << "nonsparse: " << md*pd << '\n';
+#endif
+}
+
+
+//------------------------------------------------------------
+//: Multiply this*rhs, a vector.
+template <class T>
+void vnl_sparse_matrix<T>::mult(vnl_vector<T> const& rhs, vnl_vector<T>& result) const
+{
+ assert(rhs.size() == columns());
+
+ result.set_size( rows() );
+ result.fill(T(0));
+
+ int rhs_row_id =0;
+ typename vcl_vector<row>::const_iterator lhs_row_iter = elements.begin();
+ for ( ; lhs_row_iter != elements.end(); ++lhs_row_iter, rhs_row_id++ ) {
+ row const & lhs_row = *lhs_row_iter;
+ if (lhs_row.empty()) continue;
+
+ typename row::const_iterator lhs_col_iter = lhs_row.begin();
+ for ( ; lhs_col_iter != lhs_row.end(); ++lhs_col_iter) {
+ vnl_sparse_matrix_pair<T> const & entry = *lhs_col_iter;
+ unsigned const lhs_col_id = entry.first;
+
+ result[ rhs_row_id ] += rhs[ lhs_col_id ] * entry.second;
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Multiply lhs*this, where lhs is a vector
+template <class T>
+void vnl_sparse_matrix<T>::pre_mult(const vnl_vector<T>& lhs, vnl_vector<T>& result) const
+{
+ assert(lhs.size() == rows());
+
+ // Resize and clear result vector
+ result.set_size( columns() );
+ result.fill(T(0));
+
+ // Now, iterate over lhs values and rows of rhs
+ unsigned lhs_col_id = 0;
+ for (typename vcl_vector<row>::const_iterator rhs_row_iter = elements.begin();
+ rhs_row_iter != elements.end();
+ ++rhs_row_iter, lhs_col_id++ )
+ {
+ // Get the row from rhs matrix.
+ row const & rhs_row = *rhs_row_iter;
+
+ // Skip to next row if empty.
+ if (rhs_row.empty()) continue;
+
+ // Iterate over values in rhs row
+ for (typename row::const_iterator rhs_col_iter = rhs_row.begin();
+ rhs_col_iter != rhs_row.end();
+ ++rhs_col_iter)
+ {
+ // Get the element from the row.
+ vnl_sparse_matrix_pair<T> const& entry = *rhs_col_iter;
+ unsigned const rhs_col_id = entry.first;
+
+ result[ rhs_col_id ] += lhs[ lhs_col_id ] * entry.second;
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Add rhs to this.
+template <class T>
+void vnl_sparse_matrix<T>::add(const vnl_sparse_matrix<T>& rhs,
+ vnl_sparse_matrix<T>& result) const
+{
+ assert((rhs.rows() == rows()) && (rhs.columns() == columns()));
+
+ // Clear result matrix.
+ result.elements.clear();
+
+ // Now give the result matrix enough rows.
+ result.elements.resize(rows());
+ result.rs_ = rows();
+ result.cs_ = columns();
+
+ // Now, iterate over non-zero rows of this.
+ unsigned int row_id = 0;
+ for (typename vcl_vector<row>::const_iterator row_iter = elements.begin();
+ row_iter != elements.end();
+ ++row_iter, ++row_id)
+ {
+ // Get the row from this matrix (lhs).
+ row const & this_row = *row_iter;
+
+ // Get the new row in the result matrix.
+ row& result_row = result.elements[row_id];
+
+ // Store this into result row.
+ result_row = this_row;
+
+ // If rhs row is empty, we are done.
+ if (rhs.empty_row(row_id))
+ continue;
+
+ // Get the rhs row.
+ row const& rhs_row = rhs.elements[row_id];
+
+ // Iterate over the rhs row.
+ for (typename row::const_iterator col_iter = rhs_row.begin();
+ col_iter != rhs_row.end();
+ ++col_iter)
+ {
+ // Get the element from the row.
+ vnl_sparse_matrix_pair<T> const& entry = *col_iter;
+ unsigned const col_id = entry.first;
+
+ // So we are at (row_id,col_id) in rhs matrix.
+ result(row_id,col_id) += entry.second;
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Subtract rhs from this.
+template <class T>
+void vnl_sparse_matrix<T>::subtract(const vnl_sparse_matrix<T>& rhs,
+ vnl_sparse_matrix<T>& result) const
+{
+ assert((rhs.rows() == rows()) && (rhs.columns() == columns()));
+
+ // Clear result matrix.
+ result.elements.clear();
+
+ // Now give the result matrix enough rows.
+ result.elements.resize(rows());
+ result.rs_ = rows();
+ result.cs_ = columns();
+
+ // Now, iterate over non-zero rows of this.
+ unsigned int row_id = 0;
+ for (typename vcl_vector<row>::const_iterator row_iter = elements.begin();
+ row_iter != elements.end();
+ ++row_iter, ++row_id)
+ {
+ // Get the row from this matrix (lhs).
+ row const& this_row = *row_iter;
+
+ // Get the new row in the result matrix.
+ row& result_row = result.elements[row_id];
+
+ // Store this into result row.
+ result_row = this_row;
+
+ // If rhs row is empty, we are done.
+ if (rhs.empty_row(row_id))
+ continue;
+
+ // Get the rhs row.
+ row const& rhs_row = rhs.elements[row_id];
+
+ // Iterate over the rhs row.
+ for (typename row::const_iterator col_iter = rhs_row.begin();
+ col_iter != rhs_row.end();
+ ++col_iter)
+ {
+ // Get the element from the row.
+ vnl_sparse_matrix_pair<T> const& entry = *col_iter;
+ unsigned const col_id = entry.first;
+
+ // So we are at (row_id,col_id) in rhs matrix.
+ result(row_id,col_id) -= entry.second;
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Get a reference to an entry in the matrix.
+template <class T>
+T& vnl_sparse_matrix<T>::operator()(unsigned int r, unsigned int c)
+{
+ assert((r < rows()) && (c < columns()));
+ row& rw = elements[r];
+ typename row::iterator ri;
+ for (ri = rw.begin(); (ri != rw.end()) && ((*ri).first < c); ++ri);
+
+ if ((ri == rw.end()) || ((*ri).first != c)) {
+ // Add new column to the row.
+ ri = rw.insert(ri, vnl_sparse_matrix_pair<T>(c,T(0)));
+ }
+
+ return (*ri).second;
+}
+
+template <class T>
+void vnl_sparse_matrix<T>::diag_AtA(vnl_vector<T> & result) const
+{
+ result.set_size( columns() );
+ result.fill(T(0));
+
+ typename vcl_vector<row>::const_iterator row_iter = elements.begin();
+ for ( ; row_iter != elements.end(); ++row_iter) {
+ row const& this_row = *row_iter;
+ typename row::const_iterator col_iter = this_row.begin();
+ for ( ; col_iter != this_row.end(); ++col_iter) {
+ vnl_sparse_matrix_pair<T> const& entry = *col_iter;
+ unsigned const col_id = entry.first;
+ result[col_id] += entry.second * entry.second;
+ }
+ }
+}
+
+//------------------------------------------------------------
+//: Set row in the matrix.
+
+template <class T>
+void vnl_sparse_matrix<T>::set_row(unsigned int r,
+ vcl_vector<int> const& cols,
+ vcl_vector<T> const& vals)
+{
+ assert (r < rows());
+ assert (cols.size() == vals.size());
+
+ row& rw = elements[r];
+ if (rw.size() != cols.size()) rw = row(cols.size());
+ for (unsigned int i=0; i < cols.size(); ++i)
+ rw[i] = vnl_sparse_matrix_pair<T>(cols[i], vals[i]);
+ typedef typename vnl_sparse_matrix_pair<T>::less less;
+ vcl_sort(rw.begin(), rw.end(), less());
+}
+
+template <class T>
+vnl_sparse_matrix<T>& vnl_sparse_matrix<T>::vcat(vnl_sparse_matrix<T> const& A)
+{
+ if (rs_ == 0) {
+ rs_ = A.rs_;
+ cs_ = A.cs_;
+ elements = A.elements;
+ }
+ else {
+ assert(cs_ == A.cs_);
+ rs_ += A.rs_;
+ elements.insert(elements.end(), A.elements.begin(), A.elements.end());
+ }
+ return *this;
+}
+
+
+//------------------------------------------------------------
+//: This is occasionally useful. Sums a row of the matrix efficiently.
+template <class T>
+T vnl_sparse_matrix<T>::sum_row(unsigned int r)
+{
+ assert(r < rows());
+ row & rw = elements[r];
+ T sum = T(0);
+ for (typename row::iterator ri = rw.begin(); ri != rw.end(); ++ri)
+ sum += (*ri).second;
+
+ return sum;
+}
+
+template <class T>
+void vnl_sparse_matrix<T>::scale_row(unsigned int r, T scale)
+{
+ assert(r < rows());
+ row& rw = elements[r];
+ for (typename row::iterator ri = rw.begin(); ri != rw.end(); ++ri)
+ (*ri).second *= scale;
+}
+
+//------------------------------------------------------------
+//: Resizes the matrix so that it has r rows and c columns, clearing the current contents.
+//
+template <class T>
+void vnl_sparse_matrix<T>::set_size( int r, int c)
+{
+ rs_ = r;
+ cs_ = c;
+ elements.resize(r);
+ typename vnl_sparse_matrix_elements::iterator ie;
+ for (ie = elements.begin(); ie != elements.end(); ++ie)
+ {
+ // just set matrix to 0
+ ie->clear();
+ }
+ reset(); // reset iterator
+}
+
+//------------------------------------------------------------
+//: Resizes the matrix so that it has r rows and c columns, leaving the current contents.
+// This is more wasteful of resources than set_size, but it preserves the contents.
+//
+template <class T>
+void vnl_sparse_matrix<T>::resize( int r, int c)
+{
+ unsigned int oldCs = cs_;
+
+ rs_ = r;
+ cs_ = c;
+ elements.resize(r);
+
+ // If the array has fewer columns now, we also need to cut them out
+ if (oldCs > cs_){
+ for (unsigned int r = 0; r < elements.size(); r++){
+ row& rw = elements[r];
+ typename row::iterator iter;
+ for (iter = rw.begin(); iter != rw.end() && (*iter).first<cs_ ; ++iter);
+ if (iter != rw.end()) rw.erase(iter,rw.end());
+ }
+ }
+
+ reset(); // reset iterator
+}
+
+//------------------------------------------------------------
+//: Resets the internal iterator
+template <class T>
+void vnl_sparse_matrix<T>::reset()
+{
+ itr_isreset = true;
+ itr_row = 0;
+}
+
+//------------------------------------------------------------
+//: Moves the internal iterator to next non-zero entry in matrix.
+// Returns true if there is another value, false otherwise. Use
+// in combination with methods reset, getrow, getcolumn, and value.
+//
+template <class T>
+bool vnl_sparse_matrix<T>::next()
+{
+ if ( itr_row >= rows() )
+ return false;
+
+ if ( itr_isreset ) {
+ // itr_cur is not pointing to a entry
+ itr_row = 0;
+ itr_isreset = false;
+ } else {
+ // itr_cur is pointing to an entry.
+ // Try to move to next entry in current row.
+ itr_cur++;
+ if ( itr_cur != elements[itr_row].end() )
+ return true; // found next entry in current row
+ else
+ itr_row++;
+ }
+
+ // search for next entry starting at row itr_row
+ while ( itr_row < rows() ) {
+ itr_cur = elements[itr_row].begin();
+ if ( itr_cur != elements[itr_row].end() )
+ return true;
+ else
+ itr_row++;
+ }
+
+ return itr_row < rows();
+}
+
+//------------------------------------------------------------
+//: Returns the row of the entry pointed to by internal iterator.
+//
+template <class T>
+int vnl_sparse_matrix<T>::getrow()
+{
+ return itr_row;
+}
+
+//------------------------------------------------------------
+//: Returns the column of the entry pointed to by internal iterator.
+//
+template <class T>
+int vnl_sparse_matrix<T>::getcolumn()
+{
+ return (*itr_cur).first;
+}
+
+//------------------------------------------------------------
+//: Returns the value pointed to by the internal iterator.
+//
+template <class T>
+T vnl_sparse_matrix<T>::value()
+{
+ return (*itr_cur).second;
+}
+
+#define VNL_SPARSE_MATRIX_INSTANTIATE(T) \
+template class vnl_sparse_matrix<T >
+
+#endif // vnl_sparse_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.cxx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..5a602989fa39ac29e2901318b3c3d8369805153e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.cxx
@@ -0,0 +1,82 @@
+// This is core/vnl/vnl_sparse_matrix_linear_system.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+
+#include "vnl_sparse_matrix_linear_system.h"
+#include <vcl_cassert.h>
+#include <vnl/vnl_copy.h>
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::get_rhs(vnl_vector<double>& b) const
+{
+ b = b_;
+}
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::transpose_multiply(vnl_vector<double> const& b, vnl_vector<double> & x) const
+{
+ A_.pre_mult(b,x);
+}
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::get_rhs(vnl_vector<double>& b) const
+{
+ vnl_copy(b_, b);
+}
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::transpose_multiply(vnl_vector<double> const& b, vnl_vector<double> & x) const
+{
+ static vnl_vector<float> x_float;
+ static vnl_vector<float> b_float;
+
+ if (x_float.size() != x.size()) x_float = vnl_vector<float> (x.size());
+ if (b_float.size() != b.size()) b_float = vnl_vector<float> (b.size());
+
+ vnl_copy(b, b_float);
+ A_.pre_mult(b_float,x_float);
+ vnl_copy(x_float, x);
+}
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::multiply(vnl_vector<double> const& x, vnl_vector<double> & b) const
+{
+ A_.mult(x,b);
+}
+
+
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::multiply(vnl_vector<double> const& x, vnl_vector<double> & b) const
+{
+ static vnl_vector<float> x_float;
+ static vnl_vector<float> b_float;
+
+ if (x_float.size() != x.size()) x_float = vnl_vector<float> (x.size());
+ if (b_float.size() != b.size()) b_float = vnl_vector<float> (b.size());
+
+ vnl_copy(x, x_float);
+ A_.mult(x_float,b_float);
+ vnl_copy(b_float, b);
+}
+
+
+template<class T>
+void vnl_sparse_matrix_linear_system<T>::apply_preconditioner(vnl_vector<double> const& x, vnl_vector<double> & px) const
+{
+ assert(x.size() == px.size());
+
+ if (jacobi_precond_.size() == 0) {
+ vnl_vector<T> tmp(get_number_of_unknowns());
+ A_.diag_AtA(tmp);
+ const_cast<vnl_vector<double> &>(jacobi_precond_) = vnl_vector<double> (tmp.size());
+ for (unsigned int i=0; i < tmp.size(); ++i)
+ const_cast<vnl_vector<double> &>(jacobi_precond_)[i] = 1.0 / double(tmp[i]);
+ }
+
+ px = dot_product(x,jacobi_precond_);
+}
+
+template class vnl_sparse_matrix_linear_system<double>;
+template class vnl_sparse_matrix_linear_system<float>;
+
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.h
new file mode 100644
index 0000000000000000000000000000000000000000..dc841dcce764d1dd2c853c47765696d35b7fc5b9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sparse_matrix_linear_system.h
@@ -0,0 +1,67 @@
+// This is core/vnl/vnl_sparse_matrix_linear_system.h
+#ifndef vnl_sparse_matrix_linear_system_h_
+#define vnl_sparse_matrix_linear_system_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief vnl_sparse_matrix -> vnl_linear_system adaptor
+//
+// An adaptor that converts a vnl_sparse_matrix<T> to a vnl_linear_system
+//
+// \author David Capel, capes@robots
+// \date July 2000
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 19/3/01 Documentation tidied
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_linear_system.h>
+#include <vnl/vnl_sparse_matrix.h>
+
+//: vnl_sparse_matrix -> vnl_linear_system adaptor
+// An adaptor that converts a vnl_sparse_matrix<T> to a vnl_linear_system
+template <class T>
+class vnl_sparse_matrix_linear_system : public vnl_linear_system
+{
+ public:
+ //::Constructor from vnl_sparse_matrix<double> for system Ax = b
+ // Keeps a reference to the original sparse matrix A and vector b so DO NOT DELETE THEM!!
+ vnl_sparse_matrix_linear_system(vnl_sparse_matrix<T> const& A, vnl_vector<T> const& b) :
+ vnl_linear_system(A.columns(), A.rows()), A_(A), b_(b) {}
+
+ //: Implementations of the vnl_linear_system virtuals.
+ void multiply(vnl_vector<double> const& x, vnl_vector<double> & b) const;
+ //: Implementations of the vnl_linear_system virtuals.
+ void transpose_multiply(vnl_vector<double> const& b, vnl_vector<double> & x) const;
+ //: Implementations of the vnl_linear_system virtuals.
+ void get_rhs(vnl_vector<double>& b) const;
+ //: Implementations of the vnl_linear_system virtuals.
+ void apply_preconditioner(vnl_vector<double> const& x, vnl_vector<double> & px) const;
+
+ protected:
+ vnl_sparse_matrix<T> const& A_;
+ vnl_vector<T> const& b_;
+ vnl_vector<double> jacobi_precond_;
+};
+
+#if !defined(VCL_VC70)
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::get_rhs(vnl_vector<double>& b) const;
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::transpose_multiply(vnl_vector<double> const& b, vnl_vector<double> & x) const;
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::get_rhs(vnl_vector<double>& b) const;
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::transpose_multiply(vnl_vector<double> const& b, vnl_vector<double> & x) const;
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<double>::multiply(vnl_vector<double> const& x, vnl_vector<double> & b) const;
+VCL_DEFINE_SPECIALIZATION
+void vnl_sparse_matrix_linear_system<float>::multiply(vnl_vector<double> const& x, vnl_vector<double> & b) const;
+#endif
+
+#endif // vnl_sparse_matrix_linear_system_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.h
new file mode 100644
index 0000000000000000000000000000000000000000..a349fea4a43b1181c786a8a45c6e693de3448d7c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.h
@@ -0,0 +1,228 @@
+// This is core/vnl/vnl_sym_matrix.h
+#ifndef vnl_sym_matrix_h_
+#define vnl_sym_matrix_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Contains class for symmetric matrices
+// \author Ian Scott (Manchester ISBE)
+// \date 6/12/2001
+
+#include <vcl_cassert.h>
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_vector.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_c_vector.h>
+
+//: stores a symmetric matrix as just the diagonal and lower triangular part
+// vnl_sym_matrix stores a symmetric matrix for time and space efficiency.
+// Specifically, only the diagonal and lower triangular elements are stored.
+
+export
+template <class T>
+class vnl_sym_matrix
+{
+ public:
+ //: Construct an empty symmetric matrix.
+ vnl_sym_matrix(): data_(0), index_(0), nn_(0) {}
+
+ //: Construct an symmetric matrix of size nn by nn.
+ explicit vnl_sym_matrix(unsigned nn):
+ data_(vnl_c_vector<T>::allocate_T(nn * (nn + 1) / 2)),
+ index_(vnl_c_vector<T>::allocate_Tptr(nn)),
+ nn_(nn) { setup_index(); }
+
+ //: Construct a symmetric matrix with elements equal to data
+ // Value should be stored row-wise, and contain the
+ // n*(n+1)/2 diagonal and lower triangular elements
+ inline vnl_sym_matrix(T const * data, unsigned nn);
+
+ //: Construct a symmetric matrix with all elements equal to value
+ inline vnl_sym_matrix(unsigned nn, const T & value);
+
+ //: Construct a symmetric matrix from a full matrix.
+ // If NDEBUG is set, the symmetry of the matrix will be asserted.
+ inline explicit vnl_sym_matrix(vnl_matrix<T> const& that);
+ ~vnl_sym_matrix()
+ { vnl_c_vector<T>::deallocate(data_, size());
+ vnl_c_vector<T>::deallocate(index_, nn_);}
+
+ vnl_sym_matrix<T>& operator=(vnl_sym_matrix<T> const& that);
+
+ // Operations----------------------------------------------------------------
+
+ //: In-place arithmetic operations
+ vnl_sym_matrix<T>& operator*=(T v) { vnl_c_vector<T>::scale(data_, data_, size(), v); return *this; }
+ //: In-place arithmetic operations
+ vnl_sym_matrix<T>& operator/=(T v) { vnl_c_vector<T>::scale(data_, data_, size(), ((T)1)/v); return *this; }
+
+
+ // Data Access---------------------------------------------------------------
+
+ T operator () (unsigned i, unsigned j) const {
+ return (i > j) ? index_[i][j] : index_[j][i];
+ }
+
+ T& operator () (unsigned i, unsigned j) {
+ return (i > j) ? index_[i][j] : index_[j][i];
+ }
+
+ //: Access a half-row of data.
+ // Only the first i+1 values from this pointer are valid.
+ const T* operator [] (unsigned i) const {
+ assert (i < nn_);
+ return index_[i];
+ }
+
+ //: fast access, however i >= j
+ T fast (unsigned i, unsigned j) const {
+ assert (i >= j);
+ return index_[i][j];
+ }
+
+ //: fast access, however i >= j
+ T& fast (unsigned i, unsigned j) {
+ assert (i >= j);
+ return index_[i][j];
+ }
+
+ // iterators
+
+ typedef T* iterator;
+ inline iterator begin() { return data_; }
+ inline iterator end() { return data_ + size(); }
+ typedef const T* const_iterator;
+ inline const_iterator begin() const { return data_; }
+ inline const_iterator end() const { return data_ + size(); }
+
+ unsigned long size() const { return nn_ * (nn_ + 1) / 2; }
+ unsigned rows() const { return nn_; }
+ unsigned cols() const { return nn_; }
+ unsigned columns() const { return nn_; }
+
+ // Need this until we add a vnl_sym_matrix ctor to vnl_matrix;
+ inline vnl_matrix<T> as_matrix() const;
+
+ //: Resize matrix to n by n.
+ // You will loose any existing data.
+ inline void set_size(int n);
+
+
+ //: Return pointer to the lower triangular elements as a contiguous 1D C array;
+ T* data_block() { return data_; }
+ //: Return pointer to the lower triangular elements as a contiguous 1D C array;
+ T const* data_block() const { return data_; }
+
+ //: Set the first i values of row i
+ // or the top i values of column i
+ void set_half_row (const vnl_vector<T> &half_row, unsigned i);
+
+ //: Replaces the symmetric submatrix of THIS matrix with the elements of matrix m.
+ // Starting at top left corner. Complexity is $O(m^2)$.
+ vnl_sym_matrix<T>& update (vnl_sym_matrix<T> const& m, unsigned diag_start=0);
+
+ //: Swap contents of m with THIS
+ void swap(vnl_sym_matrix &m);
+
+ protected:
+//: Set up the index array
+ inline void setup_index() {
+ T * data = data_;
+ for (unsigned i=0; i< nn_; ++i) { index_[i] = data; data += i+1; }
+ }
+
+ T* data_;
+ T** index_;
+ unsigned nn_;
+};
+
+//:
+// \relates vnl_sym_matrix
+template <class T> vcl_ostream& operator<< (vcl_ostream&, vnl_sym_matrix<T> const&);
+
+
+template <class T>
+inline vnl_sym_matrix<T>::vnl_sym_matrix(T const * data, unsigned nn):
+ data_(vnl_c_vector<T>::allocate_T(nn * (nn + 1) / 2)),
+ index_(vnl_c_vector<T>::allocate_Tptr(nn)),
+ nn_(nn)
+{
+ setup_index();
+ for (unsigned i = 0; i < nn_; ++i)
+ for (unsigned j = 0; j <= i; ++j)
+ fast(i,j) = *(data++);
+}
+
+template <class T>
+inline vnl_sym_matrix<T>::vnl_sym_matrix(unsigned nn, const T & value):
+ data_(vnl_c_vector<T>::allocate_T(nn * (nn + 1) / 2)),
+ index_(vnl_c_vector<T>::allocate_Tptr(nn)),
+ nn_(nn)
+{
+ setup_index();
+ vnl_c_vector<T>::fill(data_, size(), value);
+}
+
+
+template <class T>
+inline vnl_sym_matrix<T>::vnl_sym_matrix(vnl_matrix<T> const& that):
+ data_(vnl_c_vector<T>::allocate_T(that.rows() * (that.rows() + 1) / 2)),
+ index_(vnl_c_vector<T>::allocate_Tptr(that.rows())),
+ nn_(that.rows())
+{
+ setup_index();
+ assert (nn_ == that.cols());
+ for (unsigned i = 0; i < nn_; ++i)
+ for (unsigned j = 0; j <= i; ++j)
+ {
+ assert( that(i,j) == that(j,i) );
+ fast(i,j) = that(i,j);
+ }
+}
+
+//: Convert a vnl_sym_matrix to a vnl_matrix.
+template <class T>
+inline vnl_matrix<T> vnl_sym_matrix<T>::as_matrix() const
+{
+ vnl_matrix<T> ret(nn_, nn_);
+ for (unsigned i = 0; i < nn_; ++i)
+ for (unsigned j = 0; j <= i; ++j)
+ ret(i,j) = ret(j,i) = fast(i,j);
+ return ret;
+}
+
+
+template <class T>
+inline void vnl_sym_matrix<T>::set_size(int n)
+{
+ if (n == (int)nn_) return;
+
+ vnl_c_vector<T>::deallocate(data_, size());
+ vnl_c_vector<T>::deallocate(index_, nn_);
+
+ nn_ = n;
+ data_ = vnl_c_vector<T>::allocate_T(size());
+ index_ = vnl_c_vector<T>::allocate_Tptr(n);
+
+ setup_index();
+}
+
+template <class T>
+bool operator==(const vnl_sym_matrix<T> &a, const vnl_sym_matrix<T> &b);
+
+template <class T>
+bool operator==(const vnl_sym_matrix<T> &a, const vnl_matrix<T> &b);
+
+template <class T>
+bool operator==(const vnl_matrix<T> &a, const vnl_sym_matrix<T> &b);
+
+//: Swap the contents of a and b.
+// \relates vnl_sym_matrix
+template <class T>
+void swap(vnl_sym_matrix<T> &a, vnl_sym_matrix<T> &b)
+{ a.swap(b); }
+
+
+#endif // vnl_sym_matrix_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.txx
new file mode 100644
index 0000000000000000000000000000000000000000..bb09049688465a8f493b2c8c3d956a9c65504f6a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_sym_matrix.txx
@@ -0,0 +1,138 @@
+// This is core/vnl/vnl_sym_matrix.txx
+#ifndef vnl_sym_matrix_txx_
+#define vnl_sym_matrix_txx_
+//:
+// \file
+
+#include "vnl_sym_matrix.h"
+#include <vcl_iostream.h>
+
+
+// ==========================================================================
+//: Replaces the symmetric submatrix of THIS matrix, starting at top left corner, by the elements of matrix m.
+// O(m*m).
+template<class T>
+vnl_sym_matrix<T>& vnl_sym_matrix<T>::update (vnl_sym_matrix<T> const& m,
+ unsigned diagonal_start)
+{
+ unsigned int end = diagonal_start + m.nn_;
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ if (this->nn_ < end)
+ vnl_error_matrix_dimension ("vnl_sym_matrix::update",
+ end, end, m.nn_, m.nn_);
+#endif
+ for (unsigned int i = diagonal_start; i < end; i++)
+ for (unsigned int j = diagonal_start; j <= i; j++)
+ this->fast(i,j) = m.fast(i-diagonal_start,j-diagonal_start);
+ return *this;
+}
+
+// ==========================================================================
+//: Swap contents of m with THIS
+template <class T>
+void vnl_sym_matrix<T>::swap(vnl_sym_matrix<T> &m)
+{
+ unsigned nn = nn_;
+ T **index = index_;
+ T *data = data_;
+ nn_ =m.nn_;
+ index_ =m.index_;
+ data_ =m.data_;
+ m.nn_ =nn;
+ m.index_ =index;
+ m.data_ =data;
+}
+
+// ==========================================================================
+
+template <class T>
+vnl_sym_matrix<T>& vnl_sym_matrix<T>::operator=(vnl_sym_matrix<T> const& that)
+{
+ if (&that == this) return *this;
+
+ set_size(that.rows());
+ update(that);
+ return *this;
+}
+
+// ==========================================================================
+//: Set the first i values of row i
+// or the top i values of column i
+template <class T>
+void vnl_sym_matrix<T>::set_half_row (const vnl_vector<T> &half_row, unsigned i)
+{
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ if (half_row.size() != i+1)
+ vnl_error_vector_dimension ("vnl_sym_matrix::set_half_row wrong size for half row",
+ half_row.size(), i+1);
+ if ( i > nn_)
+ vnl_error_vector_dimension ("vnl_sym_matrix::set_half_row wrong sizes",
+ i+1, rows());
+#endif
+ half_row.copy_out(index_[i]);
+}
+
+// ==========================================================================
+//: print in lower triangular form
+template <class T>
+vcl_ostream& operator<< (vcl_ostream& s, const vnl_sym_matrix<T>& M)
+{
+ for (unsigned i=0; i<M.rows(); ++i)
+ {
+ for (unsigned j=0; j<=i; ++j)
+ s << M.fast(i,j) << ' ';
+ s << '\n';
+ }
+ return s;
+}
+
+// ==========================================================================
+
+template <class T>
+bool operator==(const vnl_sym_matrix<T> &a, const vnl_sym_matrix<T> &b)
+{
+ if (a.rows() != b.rows()) return false;
+ const T* a_data = a.data_block();
+ const T* b_data = b.data_block();
+ const unsigned mn = a.size();
+ for (unsigned i = 0; i < mn; ++i)
+ if (a_data[i] != b_data[i]) return false;
+ return true;
+}
+
+// ==========================================================================
+
+template <class T>
+bool operator==(const vnl_sym_matrix<T> &a, const vnl_matrix<T> &b)
+{
+ if (a.rows() != b.rows() || a.cols() != b.cols()) return false;
+
+ const unsigned n = a.rows();
+ for (unsigned i=0; i< n; ++i)
+ {
+ for (unsigned j=0; j<i; ++j)
+ if (a.fast(i,j) != b(i,j) || a.fast(i,j) != b(j,i)) return false;
+ if (a.fast(i,i) != b(i,i)) return false;
+ }
+ return true;
+}
+
+// ==========================================================================
+
+template <class T>
+bool operator==(const vnl_matrix<T> &a, const vnl_sym_matrix<T> &b)
+{
+ return operator==(b,a);
+}
+
+// ==========================================================================
+
+#undef VNL_SYM_MATRIX_INSTANTIATE
+#define VNL_SYM_MATRIX_INSTANTIATE(T) \
+template class vnl_sym_matrix<T >; \
+template vcl_ostream& operator<< (vcl_ostream& s, vnl_sym_matrix<T > const &); \
+template bool operator==(const vnl_sym_matrix<T > &a, const vnl_sym_matrix<T > &b); \
+template bool operator==(const vnl_sym_matrix<T > &a, const vnl_matrix<T > &b); \
+template bool operator==(const vnl_matrix<T > &a, const vnl_sym_matrix<T > &b)
+
+#endif // vnl_sym_matrix_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_tag.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_tag.h
new file mode 100644
index 0000000000000000000000000000000000000000..0f0d654a9db8dbf9534bf22bf3c28119c44c1e6b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_tag.h
@@ -0,0 +1,19 @@
+// This is core/vnl/vnl_tag.h
+#ifndef vnl_tag_h_
+#define vnl_tag_h_
+//:
+// \file
+// \author fsm
+//
+// These tags are used as argument to some private vnl_matrix and vnl_vector
+// constructors to take advantage of the C++ return value optimization.
+// \relates vnl_matrix
+// \relates vnl_vector
+
+struct vnl_tag_add { };
+struct vnl_tag_sub { };
+struct vnl_tag_mul { };
+struct vnl_tag_div { };
+struct vnl_tag_grab { };
+
+#endif // vnl_tag_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_trace.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_trace.h
new file mode 100644
index 0000000000000000000000000000000000000000..9b083e417219ea3d63ac40785d1b27683a1e53bf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_trace.h
@@ -0,0 +1,42 @@
+// This is core/vnl/vnl_trace.h
+#ifndef vnl_trace_h_
+#define vnl_trace_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Calculate trace of a matrix
+// \author fsm
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 19/3/01 Documentation tidied
+// Peter Vanroose 27-Jun-2003 made inline and added trace(matrix_fixed)
+// \endverbatim
+
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_matrix_fixed.h>
+
+//: Calculate trace of a matrix
+// \relates vnl_matrix
+template <class T>
+T vnl_trace(vnl_matrix<T> const& M) {
+ T sum(0);
+ const unsigned int N = M.rows()<M.cols() ? M.rows() : M.cols();
+ for (unsigned int i=0; i<N; ++i)
+ sum += M(i, i);
+ return sum;
+}
+
+//: Calculate trace of a matrix
+// \relates vnl_matrix_fixed
+template <class T, unsigned int N1, unsigned int N2>
+T vnl_trace(vnl_matrix_fixed<T,N1,N2> const& M) {
+ T sum(0);
+ for (unsigned int i=0; i<N1 && i<N2; ++i)
+ sum += M(i, i);
+ return sum;
+}
+
+#endif // vnl_trace_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_transpose.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_transpose.h
new file mode 100644
index 0000000000000000000000000000000000000000..ac82774ae06c061c85307365f4d440a61ee21555
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_transpose.h
@@ -0,0 +1,76 @@
+// This is core/vnl/vnl_transpose.h
+#ifndef vnl_transpose_h_
+#define vnl_transpose_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Efficient matrix transpose
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 23 Dec 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 19/3/01 Tidied documentation
+// \endverbatim
+
+#include <vcl_iostream.h>
+#include <vnl/vnl_fastops.h>
+
+//: Efficient matrix transpose
+// vnl_transpose is an efficient way to write C = vnl_transpose(A) * B.
+// The vnl_transpose class holds a reference to the original matrix
+// and when involved in an operation for which it has been specialized,
+// performs the operation without copying.
+//
+// If the operation has not been specialized, the vnl_transpose performs
+// a copying conversion to a matrix, printing a message to stdout.
+// At that stage, the user may choose to implement the particular operation
+// or use vnl_transpose::asMatrix() to clear the warning.
+//
+// NOTE: This is a reference class, so should be shorter-lived than the
+// matrix to which it refers.
+//
+// NOTE: This only works for arguments of type vnl_matrix<double>
+
+class vnl_transpose
+{
+ const vnl_matrix<double>& M_;
+ public:
+
+ //: Make a vnl_transpose object referring to matrix M
+ vnl_transpose(const vnl_matrix<double>& M): M_(M) {}
+
+ //: Noisily convert a vnl_transpose to a matrix
+ operator vnl_matrix<double> () const {
+ vcl_cerr << "vnl_transpose being converted to matrix -- help! I don't wanna go!\n";
+ return M_.transpose();
+ }
+
+ //: Quietly convert a vnl_transpose to a matrix
+ vnl_matrix<double> asMatrix () const { return M_.transpose(); }
+
+ //: Return M' * O
+ vnl_matrix<double> operator* (const vnl_matrix<double>& O) {
+ vnl_matrix<double> ret(M_.columns(), O.columns());
+ vnl_fastops::AtB(ret, M_, O);
+ return ret;
+ }
+
+ //: Return M' * O
+ vnl_vector<double> operator* (const vnl_vector<double>& O) {
+ vnl_vector<double> ret(M_.columns());
+ vnl_fastops::AtB(ret, M_, O);
+ return ret;
+ }
+
+ //: Return A * B'
+ friend vnl_matrix<double> operator* (const vnl_matrix<double>& A, const vnl_transpose& B) {
+ vnl_matrix<double> ret(A.rows(), B.M_.rows());
+ vnl_fastops::ABt(ret, A, B.M_);
+ return ret;
+ }
+};
+
+#endif // vnl_transpose_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.h
new file mode 100644
index 0000000000000000000000000000000000000000..6ab87cb7c8cba063ffe81730a21fa43bc4163179
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.h
@@ -0,0 +1,52 @@
+// This is core/vnl/vnl_unary_function.h
+#ifndef vnl_unary_function_h_
+#define vnl_unary_function_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Abstract 1D map
+//
+// vnl_unary_function is an abstract map between two types (read spaces).
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 28 Nov 98
+//
+// \verbatim
+// Modifications
+// 981128 AWF Initial version.
+// LSB Manchester 19/3/01 Documentation tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+
+
+
+//: Abstract 1D map between two types (read spaces)
+template <class Return, class Argument>
+class vnl_unary_function
+{
+ public:
+// typedef vcl_numeric_limits<Return> limits;
+
+ //: Apply the function.
+ // The name is "f" rather than operator(), as the function will generally be
+ // called through a pointer. Note that the function is NOT const when you subclass.
+ virtual Return f(Argument const& i) = 0;
+
+ //: Return bounding cube of range (outputs)
+ virtual Return get_range_min() const;
+ virtual Return get_range_max() const;
+
+ //: Copy should allocate a copy of this on the heap and return it.
+ // If Subclasses do not implement this function, it will return null, but many
+ // applications will never call it, so this may not be a problem for you.
+ virtual vnl_unary_function<Return, Argument> * Copy() const { return 0; }
+
+ virtual ~vnl_unary_function() {}
+};
+
+#endif // vnl_unary_function_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.txx
new file mode 100644
index 0000000000000000000000000000000000000000..57480865d120657ea16124c47f8fcfabf1603062
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_unary_function.txx
@@ -0,0 +1,42 @@
+// This is core/vnl/vnl_unary_function.txx
+#ifndef vnl_unary_function_txx_
+#define vnl_unary_function_txx_
+//:
+// \file
+// \brief Abstract 1D map
+// vnl_unary_function is an abstract map between two types (read spaces).
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 28 Nov 98
+//
+// \verbatim
+// Modifications
+// 981128 AWF Initial version.
+// LSB Manchester 19/3/01 Documentation tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Oct.2003 - Ian Scott - Move the use of vcl_limits out of the .h file, to
+// solve stupid MSVC6.0 problems.
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_limits.h>
+#include "vnl_unary_function.h"
+
+//: Return bounding cube of range (outputs)
+template <class RETURN, class ARGUMENT>
+RETURN vnl_unary_function<RETURN, ARGUMENT>::get_range_min() const
+{
+ return vcl_numeric_limits<RETURN>::min();
+}
+
+//: Return bounding cube of range (outputs)
+template <class RETURN, class ARGUMENT>
+RETURN vnl_unary_function<RETURN, ARGUMENT>::get_range_max() const
+{
+ return vcl_numeric_limits<RETURN>::max();
+}
+
+#define VNL_UNARY_FUNCTION_INSTANTIATE(S,T) \
+template class vnl_unary_function<S, T >
+
+#endif // vnl_unary_function_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.h
new file mode 100644
index 0000000000000000000000000000000000000000..ab862af05703467a69fdfd50948e05470cc884af
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.h
@@ -0,0 +1,539 @@
+// This is core/vnl/vnl_vector.h
+#ifndef vnl_vector_h_
+#define vnl_vector_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \author Andrew W. Fitzgibbon
+//
+// \verbatim
+// Modifications
+// Comments re-written by Tim Cootes, for his sins.
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Mar.2004 - Peter Vanroose - deprecated fixed-size constructors now compile only when VNL_CONFIG_LEGACY_METHODS==1
+// \endverbatim
+
+#include <vcl_iosfwd.h>
+#include <vnl/vnl_tag.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_config.h>
+#ifndef NDEBUG
+# include <vnl/vnl_error.h>
+# if VNL_CONFIG_CHECK_BOUNDS
+# include <vcl_cassert.h>
+# endif
+#else
+# undef VNL_CONFIG_CHECK_BOUNDS
+# define VNL_CONFIG_CHECK_BOUNDS 0
+# undef ERROR_CHECKING
+#endif
+#if VNL_CONFIG_LEGACY_METHODS
+# include <vcl_deprecated.h>
+#endif
+
+export template <class T> class vnl_vector;
+export template <class T> class vnl_matrix;
+
+//----------------------------------------------------------------------
+
+#define v vnl_vector<T>
+#define m vnl_matrix<T>
+template <class T> T dot_product(v const&, v const&);
+template <class T> T inner_product(v const&, v const&);
+template <class T> T bracket(v const &, m const &, v const &);
+template <class T> T cos_angle(v const&, v const& );
+template <class T> double angle(v const&, v const&);
+template <class T> m outer_product(v const&, v const&);
+template <class T> v operator+(T, v const&);
+template <class T> v operator-(T, v const&);
+template <class T> v operator*(T, v const&);
+// also exists as method: template <class T> v operator*(m const&, v const&);
+template <class T> v operator*(v const&, m const&);
+template <class T> v element_product(v const&,v const&);
+template <class T> v element_quotient(v const&,v const&);
+template <class T> T vnl_vector_ssd(v const&, v const&);
+template <class T> void swap(v &, v &);
+#undef v
+#undef m
+
+//----------------------------------------------------------------------
+
+//: Mathematical vector class, templated by type of element.
+// The vnl_vector<T> class implements one-dimensional arithmetic
+// vectors to be used with the vnl_matrix<T> class. vnl_vector<T>
+// has size fixed by constructor time or changed by assignment
+// operator.
+// For faster, non-mallocing vectors with size known at compile
+// time, use vnl_vector_fixed* or vnl_T_n (e.g. vnl_double_3).
+//
+// NOTE: Vectors are indexed from zero! Thus valid elements are [0,size()-1].
+template<class T>
+class vnl_vector
+{
+ public:
+ friend class vnl_matrix<T>;
+
+ //: Creates an empty vector. O(1).
+ vnl_vector() : num_elmts(0) , data(0) {}
+
+ //: Creates vector containing n elements.
+ // Elements are not initialized.
+ explicit vnl_vector(unsigned len);
+
+ //: Creates vector of len elements, all set to v0
+ vnl_vector(unsigned len, T const& v0);
+
+ //: Creates a vector of specified length and initialize first n elements with values. O(n).
+ vnl_vector(unsigned len, int n, T const values[]);
+
+#if VNL_CONFIG_LEGACY_METHODS // these constructors are deprecated and should not be used
+ //: Creates a vector of length 2 and initializes with the arguments, px,py.
+ // Requires that len==2.
+ // Consider using vnl_vector_fixed<T,2> instead!
+ // \deprecated
+ vnl_vector(unsigned len, T const& px, T const& py);
+
+ //: Creates a vector of length 3 and initializes with the arguments, px,py,pz.
+ // Requires that len==3.
+ // Consider using vnl_vector_fixed<T,3> instead!
+ // \deprecated
+ vnl_vector(unsigned len, T const& px, T const& py, T const& pz);
+
+ //: Creates a vector of length 4 and initializes with the arguments.
+ // Requires that len==4.
+ // Consider using vnl_vector_fixed<T,4> instead!
+ // \deprecated
+ vnl_vector(unsigned len, T const& px, T const& py, T const& pz, T const& pw);
+#endif
+
+ //: Create n element vector and copy data from data_block
+ vnl_vector(T const* data_block,unsigned int n);
+
+ //: Copy constructor
+ vnl_vector(vnl_vector<T> const&);
+
+#ifndef VXL_DOXYGEN_SHOULD_SKIP_THIS
+// <internal>
+ // These constructors are here so that operator* etc can take
+ // advantage of the C++ return value optimization.
+ vnl_vector(vnl_vector<T> const &, vnl_vector<T> const &, vnl_tag_add); // v + v
+ vnl_vector(vnl_vector<T> const &, vnl_vector<T> const &, vnl_tag_sub); // v - v
+ vnl_vector(vnl_vector<T> const &, T, vnl_tag_mul); // v * s
+ vnl_vector(vnl_vector<T> const &, T, vnl_tag_div); // v / s
+ vnl_vector(vnl_vector<T> const &, T, vnl_tag_add); // v + s
+ vnl_vector(vnl_vector<T> const &, T, vnl_tag_sub); // v - s
+ vnl_vector(vnl_matrix<T> const &, vnl_vector<T> const &, vnl_tag_mul); // M * v
+ vnl_vector(vnl_vector<T> const &, vnl_matrix<T> const &, vnl_tag_mul); // v * M
+ vnl_vector(vnl_vector<T> &that, vnl_tag_grab)
+ : num_elmts(that.num_elmts), data(that.data)
+ { that.num_elmts=0; that.data=0; } // "*this" now uses "that"'s data.
+// </internal>
+#endif
+
+ //: Destructor
+ ~vnl_vector();
+
+ //: Return the length, number of elements, dimension of this vector.
+ unsigned size() const { return num_elmts; }
+
+ //: Put value at given position in vector.
+ inline void put(unsigned int i, T const&);
+
+ //: Get value at element i
+ inline T get(unsigned int i) const;
+
+ //: Set all values to v
+ void fill(T const& v);
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_in(T const * ptr);
+
+ //: Copy elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_out(T *) const; // from vector to array[].
+
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void set(T const *ptr) { copy_in(ptr); }
+
+ //: Return reference to the element at specified index.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator()(unsigned int i)
+ {
+#if VNL_CONFIG_CHECK_BOUNDS
+ assert(i<size()); // Check the index is valid.
+#endif
+ return data[i];
+ }
+ //: Return reference to the element at specified index. No range checking.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T const & operator()(unsigned int i) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS
+ assert(i<size()); // Check the index is valid
+#endif
+ return data[i];
+ }
+
+ //: Return reference to the element at specified index. No range checking.
+ T & operator[](unsigned int i) { return data[i]; }
+ //: Return reference to the element at specified index. No range checking.
+ T const & operator[](unsigned int i) const { return data[i]; }
+
+ //: Set all elements to value v
+ vnl_vector<T>& operator=(T const&v) { fill(v); return *this; }
+
+ //: Copy operator
+ vnl_vector<T>& operator=(vnl_vector<T> const& rhs);
+
+ //: Add scalar value to all elements
+ vnl_vector<T>& operator+=(T );
+
+ //: Subtract scalar value from all elements
+ vnl_vector<T>& operator-=(T value) { return *this += (-value); }
+
+ //: Multiply all elements by scalar
+ vnl_vector<T>& operator*=(T );
+
+ //: Divide all elements by scalar
+ vnl_vector<T>& operator/=(T );
+
+ //: Add rhs to this and return *this
+ vnl_vector<T>& operator+=(vnl_vector<T> const& rhs);
+
+ //: Subtract rhs from this and return *this
+ vnl_vector<T>& operator-=(vnl_vector<T> const& rhs);
+
+ //: *this = M*(*this) where M is a suitable matrix.
+ // this is treated as a column vector
+ vnl_vector<T>& pre_multiply(vnl_matrix<T> const& M);
+
+ //: *this = (*this)*M where M is a suitable matrix.
+ // this is treated as a row vector
+ vnl_vector<T>& post_multiply(vnl_matrix<T> const& M);
+
+ //: *this = (*this)*M where M is a suitable matrix.
+ // this is treated as a row vector
+ vnl_vector<T>& operator*=(vnl_matrix<T> const& m) { return this->post_multiply(m); }
+
+ //: Unary plus operator
+ // Return new vector = (*this)
+ vnl_vector<T> operator+() const { return *this; }
+
+ //: Unary minus operator
+ // Return new vector = -1*(*this)
+ vnl_vector<T> operator-() const;
+
+ vnl_vector<T> operator+(T v) const { return vnl_vector<T>(*this, v, vnl_tag_add()); }
+ vnl_vector<T> operator-(T v) const { return vnl_vector<T>(*this, v, vnl_tag_sub()); }
+ vnl_vector<T> operator*(T v) const { return vnl_vector<T>(*this, v, vnl_tag_mul()); }
+ vnl_vector<T> operator/(T v) const { return vnl_vector<T>(*this, v, vnl_tag_div()); }
+
+ vnl_vector<T> operator+(vnl_vector<T> const& v) const { return vnl_vector<T>(*this, v, vnl_tag_add()); }
+ vnl_vector<T> operator-(vnl_vector<T> const& v) const { return vnl_vector<T>(*this, v, vnl_tag_sub()); }
+ vnl_vector<T> operator*(vnl_matrix<T> const& M) const { return vnl_vector<T>(*this, M, vnl_tag_mul()); }
+
+ //--------------------------------------------------------------------------------
+
+ //: Access the contiguous block storing the elements in the vector. O(1).
+ // data_block()[0] is the first element of the vector
+ T const* data_block() const { return data; }
+
+ //: Access the contiguous block storing the elements in the vector. O(1).
+ // data_block()[0] is the first element of the vector
+ T * data_block() { return data; }
+
+ //: Type defs for iterators
+ typedef T element_type;
+ //: Type defs for iterators
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() { return data; }
+
+ //: Iterator pointing to element beyond end of data
+ iterator end() { return data+num_elmts; }
+
+ //: Const iterator type
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return data+num_elmts; }
+
+ //: Return a reference to this.
+ // Useful in code which would prefer not to know if its argument
+ // is a vector, vector_ref or a vector_fixed. Note that it doesn't
+ // return a vector_ref, so it's only useful in templates or macros.
+ vnl_vector<T> const& as_ref() const { return *this; }
+
+ //: Return a reference to this.
+ vnl_vector<T>& as_ref() { return *this; }
+
+ //: Applies function to elements
+ vnl_vector<T> apply(T (*f)(T)) const;
+ //: Applies function to elements
+ vnl_vector<T> apply(T (*f)(T const&)) const;
+
+ //: Returns a subvector specified by the start index and length. O(n).
+ vnl_vector<T> extract(unsigned int len, unsigned int start=0) const;
+
+ //: Replaces elements with index beginning at start, by values of v. O(n).
+ vnl_vector<T>& update(vnl_vector<T> const&, unsigned int start=0);
+
+ // norms etc
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of squares of elements
+ abs_t squared_magnitude() const { return vnl_c_vector<T>::two_nrm2(begin(), size()); }
+
+ //: Return magnitude (length) of vector
+ abs_t magnitude() const { return two_norm(); }
+
+ //: Return sum of absolute values of the elements
+ abs_t one_norm() const { return vnl_c_vector<T>::one_norm(begin(), size()); }
+
+ //: Return sqrt of sum of squares of values of elements
+ abs_t two_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return largest absolute element value
+ abs_t inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), size()); }
+
+ //: Normalise by dividing through by the magnitude
+ vnl_vector<T>& normalize() { vnl_c_vector<T>::normalize(begin(), size()); return *this; }
+
+ // These next 6 functions are should really be helper functions since they aren't
+ // really proper functions on a vector in a philosophial sense.
+
+ //: Root Mean Squares of values
+ abs_t rms() const { return vnl_c_vector<T>::rms_norm(begin(), size()); }
+
+ //: Smallest value
+ T min_value() const { return vnl_c_vector<T>::min_value(begin(), size()); }
+
+ //: Largest value
+ T max_value() const { return vnl_c_vector<T>::max_value(begin(), size()); }
+
+ //: Mean of values in vector
+ T mean() const { return vnl_c_vector<T>::mean(begin(), size()); }
+
+ //: Sum of values in a vector
+ T sum() const { return vnl_c_vector<T>::sum(begin(), size()); }
+
+ //: Reverse the order of the elements
+ // Element i swaps with element size()-1-i
+ void flip();
+
+ //: Set this to that and that to this
+ void swap(vnl_vector<T> & that);
+
+#if VNL_CONFIG_LEGACY_METHODS // these methods are deprecated and should not be used
+ //: Return first element of vector
+ // \deprecated
+ T& x() const { VXL_DEPRECATED("vnl_vector<T>::x()"); return data[0]; }
+ //: Return second element of vector
+ // \deprecated
+ T& y() const { VXL_DEPRECATED("vnl_vector<T>::y()"); return data[1]; }
+ //: Return third element of vector
+ // \deprecated
+ T& z() const { VXL_DEPRECATED("vnl_vector<T>::z()"); return data[2]; }
+ //: Return fourth element of vector
+ // \deprecated
+ T& t() const { VXL_DEPRECATED("vnl_vector<T>::t()"); return data[3]; }
+ //: Set the first element (with bound checking)
+ // \deprecated
+ void set_x(T const&xx) { VXL_DEPRECATED("vnl_vector<T>::set_x()"); if (size() >= 1) data[0] = xx; }
+ //: Set the second element (with bound checking)
+ // \deprecated
+ void set_y(T const&yy) { VXL_DEPRECATED("vnl_vector<T>::set_y()"); if (size() >= 2) data[1] = yy; }
+ //: Set the third element (with bound checking)
+ // \deprecated
+ void set_z(T const&zz) { VXL_DEPRECATED("vnl_vector<T>::set_z()"); if (size() >= 3) data[2] = zz; }
+ //: Set the fourth element (with bound checking)
+ // \deprecated
+ void set_t(T const&tt) { VXL_DEPRECATED("vnl_vector<T>::set_t()"); if (size() >= 4) data[3] = tt; }
+#endif // VNL_CONFIG_LEGACY_METHODS
+
+ //: Check that size()==sz if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size(unsigned sz) const {
+#ifndef NDEBUG
+ assert_size_internal(sz);
+#endif
+ }
+
+ //: Check that this is finite if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ //: Return true if its finite
+ bool is_finite() const;
+
+ //: Return true iff all the entries are zero.
+ bool is_zero() const;
+
+ //: Return true iff the size is zero.
+ bool empty() const { return !data || !num_elmts; }
+
+ //: Return true if *this == v
+ bool operator_eq(vnl_vector<T> const& v) const;
+
+ //: Equality test
+ bool operator==(vnl_vector<T> const &that) const { return this->operator_eq(that); }
+
+ //: Inequality test
+ bool operator!=(vnl_vector<T> const &that) const { return !this->operator_eq(that); }
+
+ //: Resize to n elements.
+ // This is a destructive resize, in that the old data is lost if size() != \a n before the call.
+ // If size() is already \a n, this is a null operation.
+ bool set_size(unsigned n);
+
+ //: Make the vector as if it had been default-constructed.
+ void clear();
+
+
+ //: Read from text stream
+ bool read_ascii(vcl_istream& s);
+
+ //: Read from text stream
+ static vnl_vector<T> read(vcl_istream& s);
+
+ protected:
+ unsigned num_elmts; // Number of elements (length)
+ T* data; // Pointer to the actual data
+
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ // Since this bug exists, we need a flag that can be set during
+ // construction to tell our destructor whether we own data.
+ char vnl_vector_own_data;
+#endif
+
+ void assert_size_internal(unsigned sz) const;
+ void assert_finite_internal() const;
+
+ void destroy();
+
+#if VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+#ifndef DOXYGEN_SHOULD_SKIP_THIS
+# define v vnl_vector<T>
+# define m vnl_matrix<T>
+#endif // DOXYGEN_SHOULD_SKIP_THIS
+ friend T dot_product VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend T inner_product VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend T bracket VCL_NULL_TMPL_ARGS (v const&, m const&, v const&);
+ friend T cos_angle VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend double angle VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend m outer_product VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend v operator+ VCL_NULL_TMPL_ARGS (T const, v const&);
+ friend v operator- VCL_NULL_TMPL_ARGS (T const, v const&);
+ friend v operator* VCL_NULL_TMPL_ARGS (T const, v const&);
+ friend v operator* VCL_NULL_TMPL_ARGS (m const&, v const&);
+ friend v element_product VCL_NULL_TMPL_ARGS (v const&, v const&);
+ friend v element_quotient VCL_NULL_TMPL_ARGS (v const&, v const&);
+# undef v
+# undef m
+#endif
+
+ // inline function template instantiation hack for gcc 2.97 -- fsm
+ static void inline_function_tickler();
+};
+
+
+// Definitions of inline functions
+
+
+//: Gets the element at specified index and return its value. O(1).
+// Range check is performed.
+
+template <class T>
+inline T vnl_vector<T>::get(unsigned int index) const
+{
+#ifdef ERROR_CHECKING
+ if (index >= this->num_elmts) // If invalid index specified
+ vnl_error_vector_index("get", index); // Raise exception
+#endif
+ return this->data[index];
+}
+
+//: Puts the value at specified index. O(1).
+// Range check is performed.
+
+template <class T>
+inline void vnl_vector<T>::put(unsigned int index, T const& value)
+{
+#ifdef ERROR_CHECKING
+ if (index >= this->num_elmts) // If invalid index specified
+ vnl_error_vector_index("put", index); // Raise exception
+#endif
+ this->data[index] = value; // Assign data value
+}
+
+//: multiply matrix and (column) vector. O(m*n).
+// \relates vnl_vector
+// \relates vnl_matrix
+template<class T>
+inline vnl_vector<T> operator*(vnl_matrix<T> const& m, vnl_vector<T> const& v)
+{
+ return vnl_vector<T>(m, v, vnl_tag_mul());
+}
+
+//: add scalar and vector. O(n).
+// \relates vnl_vector
+template<class T>
+inline vnl_vector<T> operator+(T s, vnl_vector<T> const& v)
+{
+ return vnl_vector<T>(v, s, vnl_tag_add());
+}
+
+//: subtract vector from scalar. O(n).
+// \relates vnl_vector
+template<class T>
+inline vnl_vector<T> operator-(T s, vnl_vector<T> const& v)
+{
+ return vnl_vector<T>(-v, s, vnl_tag_add());
+}
+
+//: multiply scalar and vector. O(n).
+// \relates vnl_vector
+template<class T>
+inline vnl_vector<T> operator*(T s, vnl_vector<T> const& v)
+{
+ return vnl_vector<T>(v, s, vnl_tag_mul());
+}
+
+//: Interchange the two vectors
+// \relates vnl_vector
+template<class T>
+inline void swap(vnl_vector<T> &a, vnl_vector<T> &b) { a.swap(b); }
+
+//: Euclidean Distance between two vectors.
+// Sum of Differences squared.
+// \relates vnl_vector
+template<class T>
+inline T vnl_vector_ssd(vnl_vector<T> const& v1, vnl_vector<T> const& v2)
+{
+#ifndef NDEBUG
+ if (v1.size() != v2.size())
+ vnl_error_vector_dimension("vnl_vector_ssd", v1.size(), v2.size());
+#endif
+ return vnl_c_vector<T>::euclid_dist_sq(v1.begin(), v2.begin(), v1.size());
+}
+
+// Non-vector functions which are nevertheless very useful.
+
+//: Write vector to a vcl_ostream
+// \relates vnl_vector
+export template <class T> vcl_ostream& operator<<(vcl_ostream &, vnl_vector<T> const&);
+//: Read vector from a vcl_istream
+// \relates vnl_vector
+export template <class T> vcl_istream& operator>>(vcl_istream &, vnl_vector<T> &);
+
+#endif // vnl_vector_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.txx
new file mode 100644
index 0000000000000000000000000000000000000000..0d7b4801288bfbea9f2c2175cd9ec570beac424f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector.txx
@@ -0,0 +1,862 @@
+// This is core/vnl/vnl_vector.txx
+#ifndef vnl_vector_txx_
+#define vnl_vector_txx_
+//:
+// \file
+//
+// \date VDN 02/21/92 new lite version adapted from Matrix.h
+//
+// The parameterized vnl_vector<T> class implements 1D arithmetic vectors of a
+// user specified type. The only constraint placed on the type is that
+// it must overload the following operators: +, -, *, and /. Thus, it will
+// be possible to have a vnl_vector over vcl_complex<T>. The vnl_vector<T>
+// class is static in size, that is once a vnl_vector<T> of a particular
+// size has been declared, elements cannot be added or removed. Using the
+// set_size() method causes the vector to resize, but the contents will be
+// lost.
+//
+// Each vector contains a protected data section that has a T* slot that
+// points to the physical memory allocated for the one dimensional array. In
+// addition, an integer specifies the number of elements for the
+// vector. These values are provided in the constructors.
+//
+// Several constructors are provided. See .h file for descriptions.
+//
+// Methods are provided for destructive scalar and vector addition,
+// multiplication, check for equality and inequality, fill, reduce, and access
+// and set individual elements. Finally, both the input and output operators
+// are overloaded to allow for formatted input and output of vector elements.
+//
+// vnl_vector is a special type of matrix, and is implemented for space and time
+// efficiency. When vnl_vector is pre_multiplied by/with matrix, m*v, vnl_vector is
+// implicitly a column matrix. When vnl_vector is post_multiplied by/with matrix
+// v*m, vnl_vector is implicitly a row matrix.
+//
+
+#include "vnl_vector.h"
+
+#include <vcl_cstdlib.h> // abort()
+#include <vcl_cassert.h>
+#include <vcl_vector.h>
+#include <vcl_iostream.h>
+#include <vcl_algorithm.h>
+
+#include <vnl/vnl_math.h>
+#include <vnl/vnl_matrix.h>
+#include <vnl/vnl_c_vector.h>
+#include <vnl/vnl_numeric_traits.h>
+
+//--------------------------------------------------------------------------------
+
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+// vnl_vector owns its data by default.
+# define vnl_vector_construct_hack() vnl_vector_own_data = 1
+#else
+# define vnl_vector_construct_hack()
+#endif
+
+// This macro allocates the dynamic storage used by a vnl_vector.
+#define vnl_vector_alloc_blah(size) \
+do { \
+ this->num_elmts = (size); \
+ this->data = vnl_c_vector<T>::allocate_T(size); \
+} while (false)
+
+// This macro deallocates the dynamic storage used by a vnl_vector.
+#define vnl_vector_free_blah \
+do { \
+ vnl_c_vector<T>::deallocate(this->data, this->num_elmts); \
+} while (false)
+
+//: Creates a vector with specified length. O(n).
+// Elements are not initialized.
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(len);
+}
+
+
+//: Creates a vector of specified length, and initialize all elements with value. O(n).
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len, T const& value)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(len);
+ for (unsigned i = 0; i < len; i ++) // For each element
+ this->data[i] = value; // Assign initial value
+}
+
+//: Creates a vector of specified length and initialize first n elements with values. O(n).
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len, int n, T const values[])
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(len);
+ if (n > 0) { // If user specified values
+ for (unsigned i = 0; i < len && n; i++, n--) // Initialize first n elements
+ this->data[i] = values[i]; // with values
+ }
+}
+
+#if VNL_CONFIG_LEGACY_METHODS // these constructors are deprecated and should not be used
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len, T const& px, T const& py)
+{
+ VXL_DEPRECATED("vnl_vector<T>::vnl_vector(2, T const& px, T const& py)");
+ assert(len==2);
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(2);
+ this->data[0] = px;
+ this->data[1] = py;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len, T const& px, T const& py, T const& pz)
+{
+ VXL_DEPRECATED("vnl_vector<T>::vnl_vector(3, T const& px, T const& py, T const& pz)");
+ assert(len==3);
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(3);
+ this->data[0] = px;
+ this->data[1] = py;
+ this->data[2] = pz;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (unsigned len, T const& px, T const& py, T const& pz, T const& pw)
+{
+ VXL_DEPRECATED("vnl_vector<T>::vnl_vector(4, T const& px, T const& py, T const& pz, T const& pt)");
+ assert(len==4);
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(4);
+ this->data[0] = px;
+ this->data[1] = py;
+ this->data[2] = pz;
+ this->data[3] = pw;
+}
+
+#endif // VNL_CONFIG_LEGACY_METHODS
+
+//: Creates a new copy of vector v. O(n).
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const& v)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(v.num_elmts);
+ for (unsigned i = 0; i < v.num_elmts; i ++) // For each element in v
+ this->data[i] = v.data[i]; // Copy value
+}
+
+//: Creates a vector from a block array of data, stored row-wise.
+// Values in datablck are copied. O(n).
+
+template<class T>
+vnl_vector<T>::vnl_vector (T const* datablck, unsigned len)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(len);
+ for (unsigned i = 0; i < len; ++i) // Copy data from datablck
+ this->data[i] = datablck[i];
+}
+
+//------------------------------------------------------------
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, vnl_vector<T> const &v, vnl_tag_add)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ if (u.size() != v.size())
+ vnl_error_vector_dimension ("vnl_vector<>::vnl_vector(v, v, vnl_vector_add_tag)", u.size(), v.size());
+#endif
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] + v[i];
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, vnl_vector<T> const &v, vnl_tag_sub)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ if (u.size() != v.size())
+ vnl_error_vector_dimension ("vnl_vector<>::vnl_vector(v, v, vnl_vector_sub_tag)", u.size(), v.size());
+#endif
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] - v[i];
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, T s, vnl_tag_mul)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] * s;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, T s, vnl_tag_div)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] / s;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, T s, vnl_tag_add)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] + s;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &u, T s, vnl_tag_sub)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(u.num_elmts);
+ for (unsigned int i=0; i<num_elmts; ++i)
+ data[i] = u[i] - s;
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_matrix<T> const &M, vnl_vector<T> const &v, vnl_tag_mul)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(M.rows());
+
+#ifndef NDEBUG
+ if (M.cols() != v.size())
+ vnl_error_vector_dimension ("vnl_vector<>::vnl_vector(M, v, vnl_vector_mul_tag)", M.cols(), v.size());
+#endif
+ for (unsigned int i=0; i<num_elmts; ++i) {
+ T som(0);
+ for (unsigned int j=0; j<M.cols(); ++j)
+ som += M[i][j] * v[j];
+ data[i] = som;
+ }
+}
+
+template<class T>
+vnl_vector<T>::vnl_vector (vnl_vector<T> const &v, vnl_matrix<T> const &M, vnl_tag_mul)
+{
+ vnl_vector_construct_hack();
+ vnl_vector_alloc_blah(M.cols());
+#ifndef NDEBUG
+ if (v.size() != M.rows())
+ vnl_error_vector_dimension ("vnl_vector<>::vnl_vector(v, M, vnl_vector_mul_tag)", v.size(), M.rows());
+#endif
+ for (unsigned int j=0; j<num_elmts; ++j) {
+ T som(0);
+ for (unsigned int i=0; i<M.rows(); ++i)
+ som += v[i] * M[i][j];
+ data[j] = som;
+ }
+}
+
+template<class T>
+vnl_vector<T>::~vnl_vector()
+{
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ if (data && vnl_vector_own_data) destroy();
+#else
+ if (data) destroy();
+#endif
+}
+
+//: Frees up the array inside vector. O(1).
+
+template<class T>
+void vnl_vector<T>::destroy()
+{
+ vnl_vector_free_blah;
+}
+
+template<class T>
+void vnl_vector<T>::clear()
+{
+ if (data) {
+ destroy();
+ num_elmts = 0;
+ data = 0;
+ }
+}
+
+template<class T>
+bool vnl_vector<T>::set_size(unsigned n)
+{
+ if (this->data) {
+ // if no change in size, do not reallocate.
+ if (this->num_elmts == n)
+ return false;
+
+ vnl_vector_free_blah;
+ vnl_vector_alloc_blah(n);
+ }
+ else {
+ // this happens if the vector is default constructed.
+ vnl_vector_alloc_blah(n);
+ }
+ return true;
+}
+
+#undef vnl_vector_alloc_blah
+#undef vnl_vector_free_blah
+
+//------------------------------------------------------------
+
+//: Read a vnl_vector from an ascii vcl_istream.
+// If the vector has nonzero size on input, read that many values.
+// Otherwise, read to EOF.
+template <class T>
+bool vnl_vector<T>::read_ascii(vcl_istream& s)
+{
+ bool size_known = (this->size() != 0);
+ if (size_known) {
+ for (unsigned i = 0; i < this->size(); ++i)
+ s >> (*this)(i);
+ return s.good() || s.eof();
+ }
+
+ // Just read until EOF
+ vcl_vector<T> allvals;
+ unsigned n = 0;
+ while (!s.eof()) {
+ T value;
+ s >> value;
+
+ if (s.bad())
+ break;
+ allvals.push_back(value);
+ ++n;
+ }
+ this->set_size(n); //*this = vnl_vector<T>(n);
+ for (unsigned i = 0; i < n; ++i)
+ (*this)[i] = allvals[i];
+ return true;
+}
+
+template <class T>
+vnl_vector<T> vnl_vector<T>::read(vcl_istream& s)
+{
+ vnl_vector<T> V;
+ V.read_ascii(s);
+ return V;
+}
+
+//: Sets all elements of a vector to a specified fill value. O(n).
+
+template<class T>
+void vnl_vector<T>::fill (T const& value) {
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] = value;
+}
+
+//: Sets elements of a vector to those in an array. O(n).
+
+template<class T>
+void vnl_vector<T>::copy_in (T const *ptr) {
+ for (unsigned i = 0; i < num_elmts; ++i)
+ data[i] = ptr[i];
+}
+
+//: Sets elements of an array to those in vector. O(n).
+
+template<class T>
+void vnl_vector<T>::copy_out (T *ptr) const {
+ for (unsigned i = 0; i < num_elmts; ++i)
+ ptr[i] = data[i];
+}
+
+//: Copies rhs vector into lhs vector. O(n).
+// Changes the dimension of lhs vector if necessary.
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator= (vnl_vector<T> const& rhs) {
+ if (this != &rhs) { // make sure *this != m
+ if (rhs.data) {
+ if (this->num_elmts != rhs.num_elmts)
+ this->set_size(rhs.size());
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] = rhs.data[i];
+ }
+ else {
+ // rhs is default-constructed.
+ clear();
+ }
+ }
+ return *this;
+}
+
+//: Increments all elements of vector with value. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator+= (T value) {
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] += value;
+ return *this;
+}
+
+//: Multiplies all elements of vector with value. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator*= (T value) {
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] *= value;
+ return *this;
+}
+
+//: Divides all elements of vector by value. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator/= (T value) {
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] /= value;
+ return *this;
+}
+
+
+//: Mutates lhs vector with its addition with rhs vector. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator+= (vnl_vector<T> const& rhs) {
+#ifndef NDEBUG
+ if (this->num_elmts != rhs.num_elmts)
+ vnl_error_vector_dimension ("operator+=", this->num_elmts, rhs.num_elmts);
+#endif
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] += rhs.data[i];
+ return *this;
+}
+
+
+//: Mutates lhs vector with its subtraction with rhs vector. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::operator-= (vnl_vector<T> const& rhs) {
+#ifndef NDEBUG
+ if (this->num_elmts != rhs.num_elmts)
+ vnl_error_vector_dimension ("operator-=", this->num_elmts, rhs.num_elmts);
+#endif
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ this->data[i] -= rhs.data[i];
+ return *this;
+}
+
+//: Pre-multiplies vector with matrix and stores result back in vector.
+// v = m * v. O(m*n). Vector is assumed a column matrix.
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::pre_multiply (vnl_matrix<T> const& m) {
+#ifndef NDEBUG
+ if (m.columns() != this->num_elmts) // dimensions do not match?
+ vnl_error_vector_dimension ("operator*=", this->num_elmts, m.columns());
+#endif
+ T* temp= vnl_c_vector<T>::allocate_T(m.rows()); // Temporary
+ vnl_matrix<T>& mm = (vnl_matrix<T>&) m; // Drop const for get()
+ for (unsigned i = 0; i < m.rows(); i++) { // For each index
+ temp[i] = (T)0; // Initialize element value
+ for (unsigned k = 0; k < this->num_elmts; k++) // Loop over column values
+ temp[i] += (mm.get(i,k) * this->data[k]); // Multiply
+ }
+ vnl_c_vector<T>::deallocate(this->data, this->num_elmts); // Free up the data space
+ num_elmts = m.rows(); // Set new num_elmts
+ this->data = temp; // Pointer to new storage
+ return *this; // Return vector reference
+}
+
+//: Post-multiplies vector with matrix and stores result back in vector.
+// v = v * m. O(m*n). Vector is assumed a row matrix.
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::post_multiply (vnl_matrix<T> const& m) {
+#ifndef NDEBUG
+ if (this->num_elmts != m.rows()) // dimensions do not match?
+ vnl_error_vector_dimension ("operator*=", this->num_elmts, m.rows());
+#endif
+ T* temp= vnl_c_vector<T>::allocate_T(m.columns()); // Temporary
+ vnl_matrix<T>& mm = (vnl_matrix<T>&) m; // Drop const for get()
+ for (unsigned i = 0; i < m.columns(); i++) { // For each index
+ temp[i] = (T)0; // Initialize element value
+ for (unsigned k = 0; k < this->num_elmts; k++) // Loop over column values
+ temp[i] += (this->data[k] * mm.get(k,i)); // Multiply
+ }
+ vnl_c_vector<T>::deallocate(this->data, num_elmts); // Free up the data space
+ num_elmts = m.columns(); // Set new num_elmts
+ this->data = temp; // Pointer to new storage
+ return *this; // Return vector reference
+}
+
+
+//: Creates new vector containing the negation of THIS vector. O(n).
+
+template<class T>
+vnl_vector<T> vnl_vector<T>::operator- () const {
+ vnl_vector<T> result(this->num_elmts);
+ for (unsigned i = 0; i < this->num_elmts; i++)
+ result.data[i] = - this->data[i]; // negate element
+ return result;
+}
+
+#if 0 // commented out
+//: Returns new vector which is the multiplication of matrix m with column vector v. O(m*n).
+
+template<class T>
+vnl_vector<T> operator* (vnl_matrix<T> const& m, vnl_vector<T> const& v) {
+
+#ifndef NDEBUG
+ if (m.columns() != v.size()) // dimensions do not match?
+ vnl_error_vector_dimension ("operator*", m.columns(), v.size());
+#endif
+ vnl_vector<T> result(m.rows()); // Temporary
+ vnl_matrix<T>& mm = (vnl_matrix<T>&) m; // Drop const for get()
+ for (unsigned i = 0; i < m.rows(); i++) { // For each index
+ result[i] = (T)0; // Initialize element value
+ for (unsigned k = 0; k < v.size(); k++) // Loop over column values
+ result[i] += (mm.get(i,k) * v[k]); // Multiply
+ }
+ return result;
+}
+
+
+//: Returns new vector which is the multiplication of row vector v with matrix m. O(m*n).
+
+template<class T>
+vnl_vector<T> vnl_vector<T>::operator* (vnl_matrix<T> const&m) const {
+
+ // rick@aai: casting away const avoids the following error (using gcc272)
+ // at m.rows during instantiation of 'template class vnl_vector<double >;'
+ // "cannot lookup method in incomplete type `const vnl_matrix<double>`"
+ // For some reason, instantiating the following function prior to vnl_vector
+ // also avoids the error.
+ // template vnl_matrix<double> outer_product(vnl_vector<double> const&, vnl_vector<double> const&)
+
+#ifndef NDEBUG
+ if (num_elmts != m.rows()) // dimensions do not match?
+ vnl_error_vector_dimension ("operator*", num_elmts, m.rows());
+#endif
+ vnl_vector<T> result(m.columns()); // Temporary
+ vnl_matrix<T>& mm = (vnl_matrix<T>&) m; // Drop const for get()
+ for (unsigned i = 0; i < m.columns(); i++) { // For each index
+ result.data[i] = (T)0; // Initialize element value
+ for (unsigned k = 0; k < num_elmts; k++) // Loop over column values
+ result.data[i] += (data[k] * mm.get(k,i)); // Multiply
+ }
+ return result;
+}
+#endif
+
+
+//: Replaces elements with index beginning at start, by values of v. O(n).
+
+template<class T>
+vnl_vector<T>& vnl_vector<T>::update (vnl_vector<T> const& v, unsigned start) {
+ unsigned stop = start + v.size();
+#ifndef NDEBUG
+ if ( stop > this->num_elmts)
+ vnl_error_vector_dimension ("update", stop-start, v.size());
+#endif
+ for (unsigned i = start; i < stop; i++)
+ this->data[i] = v.data[i-start];
+ return *this;
+}
+
+
+//: Returns a subvector specified by the start index and length. O(n).
+
+template<class T>
+vnl_vector<T> vnl_vector<T>::extract (unsigned len, unsigned start) const {
+#ifndef NDEBUG
+ unsigned stop = start + len;
+ if (this->num_elmts < stop)
+ vnl_error_vector_dimension ("extract", stop-start, len);
+#endif
+ vnl_vector<T> result(len);
+ for (unsigned i = 0; i < len; i++)
+ result.data[i] = data[start+i];
+ return result;
+}
+
+//: Returns new vector whose elements are the products v1[i]*v2[i]. O(n).
+
+template<class T>
+vnl_vector<T> element_product (vnl_vector<T> const& v1, vnl_vector<T> const& v2) {
+#ifndef NDEBUG
+ if (v1.size() != v2.size())
+ vnl_error_vector_dimension ("element_product", v1.size(), v2.size());
+#endif
+ vnl_vector<T> result(v1.size());
+ for (unsigned i = 0; i < v1.size(); i++)
+ result[i] = v1[i] * v2[i];
+ return result;
+}
+
+//: Returns new vector whose elements are the quotients v1[i]/v2[i]. O(n).
+
+template<class T>
+vnl_vector<T> element_quotient (vnl_vector<T> const& v1, vnl_vector<T> const& v2) {
+#ifndef NDEBUG
+ if (v1.size() != v2.size())
+ vnl_error_vector_dimension ("element_quotient", v1.size(), v2.size());
+#endif
+ vnl_vector<T> result(v1.size());
+ for (unsigned i = 0; i < v1.size(); i++)
+ result[i] = v1[i] / v2[i];
+ return result;
+}
+
+//:
+template <class T>
+vnl_vector<T> vnl_vector<T>::apply(T (*f)(T const&)) const {
+ vnl_vector<T> ret(size());
+ vnl_c_vector<T>::apply(this->data, num_elmts, f, ret.data);
+ return ret;
+}
+
+//: Return the vector made by applying "f" to each element.
+template <class T>
+vnl_vector<T> vnl_vector<T>::apply(T (*f)(T)) const {
+ vnl_vector<T> ret(num_elmts);
+ vnl_c_vector<T>::apply(this->data, num_elmts, f, ret.data);
+ return ret;
+}
+
+//: Returns the dot product of two nd-vectors, or [v1]*[v2]^T. O(n).
+
+template<class T>
+T dot_product (vnl_vector<T> const& v1, vnl_vector<T> const& v2) {
+#ifndef NDEBUG
+ if (v1.size() != v2.size())
+ vnl_error_vector_dimension ("dot_product", v1.size(), v2.size());
+#endif
+ return vnl_c_vector<T>::dot_product(v1.begin(),
+ v2.begin(),
+ v1.size());
+}
+
+//: Hermitian inner product. O(n)
+
+template<class T>
+T inner_product (vnl_vector<T> const& v1, vnl_vector<T> const& v2) {
+#ifndef NDEBUG
+ if (v1.size() != v2.size())
+ vnl_error_vector_dimension ("inner_product", v1.size(), v2.size());
+#endif
+ return vnl_c_vector<T>::inner_product(v1.begin(),
+ v2.begin(),
+ v1.size());
+}
+
+//: Returns the 'matrix element' <u|A|v> = u^t * A * v. O(mn).
+
+template<class T>
+T bracket(vnl_vector<T> const &u, vnl_matrix<T> const &A, vnl_vector<T> const &v) {
+#ifndef NDEBUG
+ if (u.size() != A.rows())
+ vnl_error_vector_dimension("bracket",u.size(),A.rows());
+ if (A.columns() != v.size())
+ vnl_error_vector_dimension("bracket",A.columns(),v.size());
+#endif
+ T brak(0);
+ for (unsigned i=0; i<u.size(); ++i)
+ for (unsigned j=0; j<v.size(); ++j)
+ brak += u[i]*A(i,j)*v[j];
+ return brak;
+}
+
+//: Returns the nxn outer product of two nd-vectors, or [v1]^T*[v2]. O(n).
+
+template<class T>
+vnl_matrix<T> outer_product (vnl_vector<T> const& v1,
+ vnl_vector<T> const& v2) {
+ vnl_matrix<T> out(v1.size(), v2.size());
+ for (unsigned i = 0; i < out.rows(); i++) // v1.column() * v2.row()
+ for (unsigned j = 0; j < out.columns(); j++)
+ out[i][j] = v1[i] * v2[j];
+ return out;
+}
+
+
+//--------------------------------------------------------------------------------
+
+template <class T>
+void vnl_vector<T>::flip() {
+ for (unsigned i=0;i<num_elmts/2;i++) {
+ T tmp=data[i];
+ data[i]=data[num_elmts-1-i];
+ data[num_elmts-1-i]=tmp;
+ }
+}
+
+template <class T>
+void vnl_vector<T>::swap(vnl_vector<T> &that)
+{
+ vcl_swap(this->num_elmts, that.num_elmts);
+ vcl_swap(this->data, that.data);
+}
+
+//--------------------------------------------------------------------------------
+
+// Disable warning caused when T is complex<float>. The static_cast
+// to real_t constructs a complex<float> from a double.
+#if defined(_MSC_VER)
+# pragma warning (push)
+# pragma warning (disable: 4244) /* conversion with loss of data */
+#endif
+
+// fsm : cos_angle should return a T, or a double-precision extension
+// of T. "double" is wrong since it won't work if T is complex.
+template <class T>
+T cos_angle(vnl_vector<T> const& a, vnl_vector<T> const& b) {
+ typedef typename vnl_numeric_traits<T>::real_t real_t;
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<abs_t>::real_t abs_r;
+
+ real_t ab = inner_product(a,b);
+ real_t a_b = static_cast<real_t>(
+ vcl_sqrt( abs_r(a.squared_magnitude() * b.squared_magnitude()) ));
+ return T( ab / a_b);
+}
+
+#if defined(_MSC_VER)
+# pragma warning (pop)
+#endif
+
+//: Returns smallest angle between two non-zero n-dimensional vectors. O(n).
+
+template<class T>
+double angle (vnl_vector<T> const& a, vnl_vector<T> const& b) {
+ typedef typename vnl_numeric_traits<T>::abs_t abs_t;
+ typedef typename vnl_numeric_traits<abs_t>::real_t abs_r;
+ const abs_r c = abs_r( cos_angle(a, b) );
+ // IMS: sometimes cos_angle returns 1+eps, which can mess up vcl_acos.
+ if (c >= 1.0) return 0;
+ if (c <= -1.0) return vnl_math::pi;
+ return vcl_acos( c );
+}
+
+template <class T>
+bool vnl_vector<T>::is_finite() const {
+ for (unsigned i = 0; i < this->size();++i)
+ if (!vnl_math_isfinite( (*this)[i] ))
+ return false;
+
+ return true;
+}
+
+template <class T>
+bool vnl_vector<T>::is_zero() const
+{
+ T const zero(0);
+ for (unsigned i = 0; i < this->size();++i)
+ if ( !( (*this)[i] == zero) )
+ return false;
+
+ return true;
+}
+
+template <class T>
+void vnl_vector<T>::assert_finite_internal() const {
+ if (this->is_finite())
+ return;
+
+ vcl_cerr << __FILE__ ": *** NAN FEVER **\n" << *this;
+ vcl_abort();
+}
+
+template <class T>
+void vnl_vector<T>::assert_size_internal(unsigned sz) const {
+ if (this->size() != sz) {
+ vcl_cerr << __FILE__ ": Size is " << this->size() << ". Should be " << sz << '\n';
+ vcl_abort();
+ }
+}
+
+template<class T>
+bool vnl_vector<T>::operator_eq (vnl_vector<T> const& rhs) const {
+ if (this == &rhs) // same object => equal.
+ return true;
+
+ if (this->size() != rhs.size()) // Size different ?
+ return false; // Then not equal.
+ for (unsigned i = 0; i < size(); i++) // For each index
+ if (!(this->data[i] == rhs.data[i])) // Element different ?
+ return false; // Then not equal.
+
+ return true; // Else same; return true.
+}
+
+//--------------------------------------------------------------------------------
+
+//: Overloads the output operator to print a vector. O(n).
+
+template<class T>
+vcl_ostream& operator<< (vcl_ostream& s, vnl_vector<T> const& v) {
+ for (unsigned i = 0; i+1 < v.size(); ++i) // For each index in vector
+ s << v[i] << ' '; // Output data element
+ if (v.size() > 0) s << v[v.size()-1];
+ return s;
+}
+
+//: Read a vnl_vector from an ascii vcl_istream.
+// If the vector has nonzero size on input, read that many values.
+// Otherwise, read to EOF.
+template <class T>
+vcl_istream& operator>>(vcl_istream& s, vnl_vector<T>& M) {
+ M.read_ascii(s); return s;
+}
+
+template <class T>
+void vnl_vector<T>::inline_function_tickler()
+{
+ vnl_vector<T> v;
+ // fsm: hacks to get 2.96/2.97/3.0 to instantiate the inline functions.
+ v = T(3) + v;
+ v = T(3) - v;
+ v = T(3) * v;
+}
+
+
+//--------------------------------------------------------------------------------
+
+// The instantiation macros are split because some functions
+// (vnl_angle) shouldn't be instantiated for complex types.
+
+#define VNL_VECTOR_INSTANTIATE_COMMON(T) \
+template class vnl_vector<T >; \
+/* arithmetic, comparison etc */ \
+VCL_INSTANTIATE_INLINE(vnl_vector<T > operator+(T const, vnl_vector<T > const &)); \
+VCL_INSTANTIATE_INLINE(vnl_vector<T > operator-(T const, vnl_vector<T > const &)); \
+VCL_INSTANTIATE_INLINE(vnl_vector<T > operator*(T const, vnl_vector<T > const &)); \
+template vnl_vector<T > operator*(vnl_matrix<T > const &, vnl_vector<T > const &); \
+/* element-wise */ \
+template vnl_vector<T > element_product(vnl_vector<T > const &, vnl_vector<T > const &); \
+template vnl_vector<T > element_quotient(vnl_vector<T > const &, vnl_vector<T > const &); \
+/* dot products, angles etc */ \
+template T inner_product(vnl_vector<T > const &, vnl_vector<T > const &); \
+template T dot_product(vnl_vector<T > const &, vnl_vector<T > const &); \
+template T cos_angle(vnl_vector<T > const & , vnl_vector<T > const &); \
+template T bracket(vnl_vector<T > const &, vnl_matrix<T > const &, vnl_vector<T > const &); \
+template vnl_matrix<T > outer_product(vnl_vector<T > const &,vnl_vector<T > const &); \
+/* I/O */ \
+template vcl_ostream & operator<<(vcl_ostream &, vnl_vector<T > const &); \
+template vcl_istream & operator>>(vcl_istream &, vnl_vector<T > &)
+
+#define VNL_VECTOR_INSTANTIATE(T) \
+VNL_VECTOR_INSTANTIATE_COMMON(T); \
+template double angle(vnl_vector<T > const & , vnl_vector<T > const &)
+
+#define VNL_VECTOR_INSTANTIATE_COMPLEX(T) \
+VNL_VECTOR_INSTANTIATE_COMMON(T)
+
+#endif // vnl_vector_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.h
new file mode 100644
index 0000000000000000000000000000000000000000..26342a2f844ad5d413eacf3254be42e909752f13
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.h
@@ -0,0 +1,879 @@
+// This is core/vnl/vnl_vector_fixed.h
+#ifndef vnl_vector_fixed_h_
+#define vnl_vector_fixed_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Fixed length stack-stored vnl_vector
+//
+// The operators are inlined because (1) they are small and
+// (2) we then have less explicit instantiation trouble.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// \verbatim
+// Modifications
+// LSB Manchester 16/3/01 Binary I/O added
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Oct.2002 - Amitha Perera - decoupled vnl_vector and vnl_vector_fixed for
+// space efficiency, removed necessity for vnl_vector_fixed_ref
+// Jun.2003 - Paul Smyth - added as_fixed_ref() to convert to fixed-size ref
+// removed duplicate cross_3d
+// Jun.2003 - Peter Vanroose - added cross_2d
+// Oct.2003 - Peter Vanroose - removed deprecated x(), y(), z(), t()
+// \endverbatim
+
+#include <vcl_cstring.h> // memcpy()
+#include <vcl_cassert.h>
+#include <vcl_iosfwd.h>
+#include "vnl_vector.h"
+#include "vnl_vector_ref.h"
+#include "vnl_c_vector.h"
+#include "vnl_matrix.h" // outerproduct
+
+export template <class T, unsigned int n> class vnl_vector_fixed;
+export template <class T, unsigned int num_rows, unsigned int num_cols> class vnl_matrix_fixed;
+
+//: Fixed length stack-stored, space-efficient vector.
+// vnl_vector_fixed is a fixed-length, stack storage vector. It has
+// the same storage size as a C-style array. It is not related via
+// inheritance to vnl_vector. However, it can be converted cheaply to
+// a vnl_vector_ref.
+//
+// In most cases, a vnl_vector_fixed can be used where a vnl_vector is
+// expected. There are some situations, however, when the automatic
+// conversion cannot be applied. In those cases, you need to call the
+// as_ref() method to perform an explicit conversion. This occurs most
+// often when the called function is templated, since the user-defined
+// conversion operators are then suppressed.
+// \code
+// template<class T>
+// void do_something( const vnl_vector<T>& v );
+// ...
+// vnl_vector_fixed<double,4> my_vec;
+//
+// do_something( my_vec );
+// // Error: no do_something( vnl_vector_fixed<double,4> ) found
+//
+// do_something( my_vec.as_ref() ); // works
+// \endcode
+//
+// Since the conversion operator creates a temporary vnl_vector_ref
+// object, the conversion cannot be used directly to a function that
+// expects a non-const vnl_vector reference. Use
+// vnl_vector_ref::non_const method for this (and only this).
+// \code
+// void mutator( vnl_vector<double>& v );
+// ...
+// vnl_vector_fixed<double,4> my_vec;
+// mutator( my_vec.as_ref().non_const() );
+// \endcode
+// If the mutator only accesses the data, all should be fine. If the
+// mutator attempts to resize the vector, you are doomed.
+//
+// vnl_vector_fixed defines most of the operators defined by
+// vnl_vector, and does so efficiently. If you try to mix
+// vnl_vector_fixed and vnl_vector, however, you will probably get a
+// vnl_vector result, with the corresponding malloc cost.
+template <class T, unsigned int n>
+class vnl_vector_fixed
+{
+ public:
+ typedef unsigned int size_type;
+ // Compile-time accessible attribute to get the dimensionality of the vector.
+ enum{ SIZE = n };
+
+ protected:
+ T data_[n];
+
+ public:
+ // Don't out-of-line the constructors, as extra the function call
+ // adds a significant overhead. (memcpy is often implemented with a
+ // couple of assembly instructions.)
+
+ //: Construct an uninitialized n-vector
+ vnl_vector_fixed() {}
+
+ //: Copy constructor
+ // The dimensions must match.
+ vnl_vector_fixed( const vnl_vector_fixed<T,n>& rhs )
+ {
+ vcl_memcpy( data_, rhs.data_, sizeof data_ );
+ }
+
+ //: Construct a fixed-n-vector copy of \a rhs.
+ // The dimensions must match.
+ vnl_vector_fixed( const vnl_vector<T>& rhs )
+ {
+ assert( n == rhs.size() );
+ vcl_memcpy( data_, rhs.data_block(), sizeof data_ );
+ }
+
+ //: Constructs n-vector with all elements initialised to \a v
+ explicit vnl_vector_fixed( const T& v ) { fill( v ); }
+
+ //: Construct an fixed-n-vector initialized from \a datablck
+ // The data *must* have enough data. No checks performed.
+ explicit vnl_vector_fixed( const T* datablck )
+ {
+ vcl_memcpy( data_, datablck, sizeof data_ );
+ }
+
+ //: Convenience constructor for 2-D vectors
+ // While this constructor is sometimes useful, consider using
+ // vnl_double_2 or vnl_float_2 instead.
+ vnl_vector_fixed( const T& x0, const T& x1 )
+ {
+ assert( n == 2 );
+ data_[0] = x0; data_[1] = x1;
+ }
+
+ //: Convenience constructor for 3-D vectors
+ // While this constructor is sometimes useful, consider using
+ // vnl_double_3 or vnl_float_3 instead.
+ vnl_vector_fixed( const T& x0, const T& x1, const T& x2 )
+ {
+ assert( n == 3 );
+ data_[0] = x0; data_[1] = x1; data_[2] = x2;
+ }
+
+ //: Convenience constructor for 4-D vectors
+ vnl_vector_fixed( const T& x0, const T& x1, const T& x2, const T& x3 )
+ {
+ assert( n == 4 );
+ data_[0] = x0; data_[1] = x1; data_[2] = x2; data_[3] = x3;
+ }
+
+ //: Copy operator
+ vnl_vector_fixed<T,n>& operator=( const vnl_vector_fixed<T,n>& rhs ) {
+ vcl_memcpy( data_, rhs.data_, sizeof data_ );
+ return *this;
+ }
+
+ //: Copy data from a dynamic vector
+ // The dimensions must match.
+ vnl_vector_fixed<T,n>& operator=( const vnl_vector<T>& rhs) {
+ assert( n == rhs.size() );
+ vcl_memcpy( data_, rhs.data_block(), sizeof data_ );
+ return *this;
+ }
+
+ //: Length of the vector.
+ // This is always \a n.
+ unsigned size() const { return n; }
+
+ //: Put value at given position in vector.
+ void put (unsigned int i, T const& v) { data_[i] = v; }
+
+ //: Get value at element i
+ T get (unsigned int i) const { return data_[i]; }
+
+ //: Set all values to v
+ void fill( T const& v )
+ {
+ for ( size_type i = 0; i < n; ++i )
+ data_[i] = v;
+ }
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_in( T const * ptr )
+ {
+ for ( size_type i = 0; i < n; ++i )
+ data_[i] = ptr[i];
+ }
+
+ //: Copy elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_out( T* ptr ) const
+ {
+ for ( size_type i = 0; i < n; ++i )
+ ptr[i] = data_[i];
+ }
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void set( T const *ptr ) { copy_in(ptr); }
+
+
+ //: Return reference to the element at specified index.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator() (unsigned int i)
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(i<n); // Check the index is valid.
+#endif
+ return data_[i];
+ }
+
+ //: Return reference to the element at specified index.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T const & operator() (unsigned int i) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(i<n); // Check the index is valid
+#endif
+ return data_[i];
+ }
+
+ //: Return the i-th element
+ T& operator[] ( unsigned int i ) { return data_[i]; }
+
+ //: Return the i-th element
+ const T& operator[] ( unsigned int i ) const { return data_[i]; }
+
+ //: Access the contiguous block storing the elements in the vector.
+ // O(1).
+ // data_block()[0] is the first element of the vector
+ T const* data_block() const { return data_; }
+
+ //: Access the contiguous block storing the elements in the vector.
+ // O(1).
+ // data_block()[0] is the first element of the vector
+ T * data_block() { return data_; }
+
+ //----------------------------------------------------------------------
+ // Conversion to vnl_vector_ref.
+
+ // The const version of as_ref should return a const vnl_vector_ref
+ // so that the vnl_vector_ref::non_const() cannot be used on
+ // it. This prevents a const vnl_vector_fixed from being cast into a
+ // non-const vnl_vector reference, giving a slight increase in type safety.
+
+ //: Explicit conversion to a vnl_vector_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_vector but not for vnl_vector_fixed. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_vector_ref::non_const
+ vnl_vector_ref<T> as_ref() { return vnl_vector_ref<T>( n, data_ ); }
+
+ //: Explicit conversion to a vnl_vector_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_vector but not for vnl_vector_fixed. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_vector_ref::non_const
+ const vnl_vector_ref<T> as_ref() const { return vnl_vector_ref<T>( n, const_cast<T*>(data_) ); }
+
+ //: Cheap conversion to vnl_vector_ref
+ // Sometimes, such as with templated functions, the compiler cannot
+ // use this user-defined conversion. For those cases, use the
+ // explicit as_ref() method instead.
+ operator const vnl_vector_ref<T>() const { return vnl_vector_ref<T>( n, const_cast<T*>(data_) ); }
+
+ //----------------------------------------------------------------------
+
+ //: Type defs for iterators
+ typedef T element_type;
+ //: Type defs for iterators
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() { return data_; }
+
+ //: Iterator pointing to element beyond end of data
+ iterator end() { return data_+n; }
+
+ //: Const iterator type
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data_; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return data_+n; }
+
+
+ //: Apply f to each element.
+ // Returns a new vector with the result.
+ vnl_vector_fixed<T,n> apply(T (*f)(T));
+
+ //: Apply f to each element.
+ // Returns a new vector with the result.
+ vnl_vector_fixed<T,n> apply(T (*f)(const T&));
+
+ //:
+ vnl_vector_fixed<T,n>& operator+=( T s ) { add( data_, s, data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator-=( T s ) { sub( data_, s, data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator*=( T s ) { mul( data_, s, data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator/=( T s ) { div( data_, s, data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator+=( const vnl_vector_fixed<T,n>& v ) { add( data_, v.data_block(), data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator-=( const vnl_vector_fixed<T,n>& v ) { sub( data_, v.data_block(), data_ ); return *this; }
+
+ //:
+ vnl_vector_fixed<T,n>& operator+=( const vnl_vector<T>& v )
+ {
+ assert( v.size() == n );
+ add( data_, v.data_block(), data_ ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed<T,n>& operator-=( const vnl_vector<T>& v )
+ {
+ assert( v.size() == n );
+ sub( data_, v.data_block(), data_ ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed<T,n> operator-() const
+ {
+ vnl_vector_fixed<T,n> result;
+ sub( (T)0, data_, result.data_ );
+ return result;
+ }
+
+ //: Returns a subvector specified by the start index and length. O(n).
+ vnl_vector<T> extract (unsigned int len, unsigned int start=0) const;
+
+ //: Convert to a vnl_vector.
+ vnl_vector<T> as_vector() const { return extract(n); }
+
+ //: Replaces elements with index beginning at start, by values of v. O(n).
+ vnl_vector_fixed& update (vnl_vector<T> const&, unsigned int start=0);
+
+ // norms etc
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of squares of elements
+ abs_t squared_magnitude() const { return vnl_c_vector<T>::two_nrm2(begin(), size()); }
+
+ //: Return magnitude (length) of vector
+ abs_t magnitude() const { return two_norm(); }
+
+ //: Return sum of absolute values of the elements
+ abs_t one_norm() const { return vnl_c_vector<T>::one_norm(begin(), size()); }
+
+ //: Return sqrt of sum of squares of values of elements
+ abs_t two_norm() const { return vnl_c_vector<T>::two_norm(begin(), size()); }
+
+ //: Return largest absolute element value
+ abs_t inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), size()); }
+
+ //: Normalise by dividing through by the magnitude
+ vnl_vector_fixed<T,n>& normalize() { vnl_c_vector<T>::normalize(begin(), size()); return *this; }
+
+ // These next 6 functions are should really be helper functions since they aren't
+ // really proper functions on a vector in a philosophical sense.
+
+ //: Root Mean Squares of values
+ abs_t rms () const { return vnl_c_vector<T>::rms_norm(begin(), size()); }
+
+ //: Smallest value
+ T min_value () const { return vnl_c_vector<T>::min_value(begin(), size()); }
+
+ //: Largest value
+ T max_value () const { return vnl_c_vector<T>::max_value(begin(), size()); }
+
+ //: Mean of values in vector
+ T mean() const { return vnl_c_vector<T>::mean(begin(), size()); }
+
+ //: Sum of values in a vector
+ T sum() const { return vnl_c_vector<T>::sum(begin(), size()); }
+
+ //: Reverse the order of the elements
+ // Element i swaps with element size()-1-i
+ void flip();
+
+ //: Check that size()==sz if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size( unsigned sz ) const { assert( sz == n ); }
+
+ //: Check that this is finite if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const
+ {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ //: Return true if its finite
+ bool is_finite() const;
+
+ //: Return true iff all the entries are zero.
+ bool is_zero() const;
+
+ //: Return true iff the size is zero.
+ bool empty() const { return n==0; }
+
+ //: Return true if *this == v
+ bool operator_eq (vnl_vector_fixed<T,n> const& v) const
+ {
+ for ( size_type i = 0; i < n; ++i )
+ if ( (*this)[i] != v[i] )
+ return false;
+ return true;
+ }
+
+ //: Return true if *this == v
+ bool operator_eq (vnl_vector<T> const& v) const
+ {
+ assert( v.size() == n );
+ for ( size_type i = 0; i < n; ++i )
+ if ( (*this)[i] != v[i] )
+ return false;
+ return true;
+ }
+
+
+ //: Read from text stream
+ bool read_ascii(vcl_istream& s);
+
+ //: Display the vector
+ // Output each element separated by a single space.
+ void print( vcl_ostream& s ) const;
+
+ public:
+ // Helper routines for arithmetic. n is the size, and is the
+ // template parameter.
+
+ inline static void add( const T* a, const T* b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a + *b;
+ }
+
+ inline static void add( const T* a, T b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a + b;
+ }
+
+ inline static void sub( const T* a, const T* b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a - *b;
+ }
+
+ inline static void sub( const T* a, T b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a - b;
+ }
+
+ inline static void sub( T a, const T* b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++b )
+ *r = a - *b;
+ }
+
+ inline static void mul( const T* a, const T* b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a * *b;
+ }
+
+ inline static void mul( const T* a, T b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a * b;
+ }
+
+ inline static void div( const T* a, const T* b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a / *b;
+ }
+
+ inline static void div( const T* a, T b, T* r )
+ {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a / b;
+ }
+
+ private:
+ //: See assert_finite().
+ void assert_finite_internal() const;
+};
+
+
+// --- Vector-scalar operators ----------------------------------------
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( const vnl_vector_fixed<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( const T& s,
+ const vnl_vector_fixed<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( const vnl_vector_fixed<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( const T& s,
+ const vnl_vector_fixed<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( s, v.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator*( const vnl_vector_fixed<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator*( const T& s,
+ const vnl_vector_fixed<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator/( const vnl_vector_fixed<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::div( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+
+// --- Vector-vector operators ----------------------------------------
+//
+// Includes overloads for the common case of mixing a fixed with a
+// non-fixed. Because the operators are templated, the fixed will not
+// be automatically converted to a non-fixed-ref. These do it for you.
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> operator+( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() + b;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> operator+( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return a + b.as_ref();
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> operator-( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() - b;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> operator-( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return a - b.as_ref();
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> element_product( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> element_product( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ assert( b.size() == n );
+ vnl_vector<T> r(n);
+ vnl_vector_fixed<T,n>::mul( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> element_product( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ assert( a.size() == n );
+ vnl_vector<T> r(n);
+ vnl_vector_fixed<T,n>::mul( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> element_quotient( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::div( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> element_quotient( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ assert( b.size() == n );
+ vnl_vector<T> r(n);
+ vnl_vector_fixed<T,n>::div( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector<T> element_quotient( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ assert( a.size() == n );
+ vnl_vector<T> r(n);
+ vnl_vector_fixed<T,n>::div( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return dot_product( a.as_ref(), b.as_ref() );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return dot_product( a.as_ref(), b );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return dot_product( a, b.as_ref() );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_matrix<T> outer_product( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return outer_product( a, b.as_ref());
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_matrix<T> outer_product( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return outer_product( a.as_ref(), b);
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T angle( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return angle( a.as_ref(), b.as_ref() );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T angle( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return angle( a.as_ref(), b );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T angle( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return angle( a, b.as_ref() );
+}
+
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return vnl_vector_ssd( a.as_ref(), b.as_ref() );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector_fixed<T,n>& a, const vnl_vector<T>& b )
+{
+ return vnl_vector_ssd( a.as_ref(), b );
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector<T>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return vnl_vector_ssd( a, b.as_ref() );
+}
+
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator==( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return a.operator_eq(b);
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator==( vnl_vector_fixed<T,n> const& a, vnl_vector<T> const& b )
+{
+ return a.operator_eq(b);
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator==( vnl_vector<T> const& a, vnl_vector_fixed<T,n> const& b )
+{
+ return b.operator_eq(a);
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator!=( const vnl_vector_fixed<T,n>& a, const vnl_vector_fixed<T,n>& b )
+{
+ return ! a.operator_eq(b);
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator!=( vnl_vector_fixed<T,n> const& a, vnl_vector<T> const& b )
+{
+ return ! a.operator_eq(b);
+}
+
+//:
+// \relates vnl_vector
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline bool operator!=( vnl_vector<T> const& a, vnl_vector_fixed<T,n> const& b )
+{
+ return ! b.operator_eq(a);
+}
+
+
+// --- I/O operators -------------------------------------------------
+
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline
+vcl_ostream& operator<< ( vcl_ostream& ostr, const vnl_vector_fixed<T,n>& v )
+{
+ v.print( ostr );
+ return ostr;
+}
+
+//:
+// \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline
+vcl_istream& operator>> ( vcl_istream& ostr, vnl_vector_fixed<T,n>& v )
+{
+ v.read_ascii( ostr );
+ return ostr;
+}
+
+#endif // vnl_vector_fixed_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.txx
new file mode 100644
index 0000000000000000000000000000000000000000..cbb0bc27312552ae4a464dc3a697ec686be9cd7d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed.txx
@@ -0,0 +1,126 @@
+// This is core/vnl/vnl_vector_fixed.txx
+#ifndef vnl_vector_fixed_txx_
+#define vnl_vector_fixed_txx_
+//:
+// \file
+#include "vnl_vector_fixed.h"
+#include "vnl_matrix_fixed.h"
+
+#include <vcl_cassert.h>
+#include <vcl_algorithm.h> // for vcl_swap
+#include <vcl_iostream.h> // for vcl_cerr
+#include <vcl_cstdlib.h> // for vcl_abort
+#include <vnl/vnl_math.h> // for vnl_math_isfinite
+
+template<class T, unsigned int n>
+vnl_vector_fixed<T,n>
+vnl_vector_fixed<T,n>::apply( T (*f)(T) )
+{
+ vnl_vector_fixed<T,n> ret;
+ for ( size_type i = 0; i < n; ++i )
+ ret[i] = f( data_[i] );
+ return ret;
+}
+
+template<class T, unsigned int n>
+vnl_vector_fixed<T,n>
+vnl_vector_fixed<T,n>::apply( T (*f)(const T&) )
+{
+ vnl_vector_fixed<T,n> ret;
+ for ( size_type i = 0; i < n; ++i )
+ ret[i] = f( data_[i] );
+ return ret;
+}
+
+
+template<class T, unsigned int n>
+vnl_vector<T>
+vnl_vector_fixed<T,n>::extract( unsigned int len, unsigned int start ) const
+{
+ assert( start < n && start + len <= n );
+ return vnl_vector<T>( data_ + start, len );
+}
+
+template<class T, unsigned int n>
+vnl_vector_fixed<T,n>&
+vnl_vector_fixed<T,n>::update( const vnl_vector<T>& v, unsigned int start )
+{
+ size_type stop = start + v.size();
+ assert( stop <= n );
+ for (size_type i = start; i < stop; i++)
+ this->data_[i] = v[i-start];
+ return *this;
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed<T,n>::flip()
+{
+ for ( unsigned int i=0; 2*i+1 < n; ++i )
+ vcl_swap( data_[i], data_[n-1-i] );
+}
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed<T,n>::is_finite() const
+{
+ for ( size_type i = 0; i < this->size(); ++i )
+ if ( !vnl_math_isfinite( (*this)[i] ) )
+ return false;
+
+ return true;
+}
+
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed<T,n>::is_zero() const
+{
+ T const zero(0);
+ for ( size_type i = 0; i < this->size(); ++i )
+ if ( !( (*this)[i] == zero) )
+ return false;
+
+ return true;
+}
+
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed<T,n>::read_ascii(vcl_istream& s)
+{
+ for (unsigned i = 0; i < this->size(); ++i)
+ s >> (*this)(i);
+
+ return s.good() || s.eof();
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed<T,n>::assert_finite_internal() const
+{
+ if (this->is_finite())
+ return;
+
+ vcl_cerr << __FILE__ ": *** NAN FEVER **\n" << *this;
+ vcl_abort();
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed<T,n>::print(vcl_ostream& s) const
+{
+ if (this->size() > 0)
+ s << (*this)[0];
+ for (size_type i=1; i < this->size(); ++i)
+ s << ' ' << (*this)[i];
+}
+
+
+// we don't need to explicitly instantiate all the operator+ and such
+// since they appear in the .h file and are inline.
+
+#define VNL_VECTOR_FIXED_INSTANTIATE(T,n) \
+template class vnl_vector_fixed<T,n >
+
+#endif // vnl_vector_fixed_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.h
new file mode 100644
index 0000000000000000000000000000000000000000..e6186b6c3103d5f1622564d07031df3492ac6709
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.h
@@ -0,0 +1,669 @@
+// This is core/vnl/vnl_vector_fixed_ref.h
+#ifndef vnl_vector_fixed_ref_h_
+#define vnl_vector_fixed_ref_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Fixed size vnl_vector using user-supplied storage
+// See vnl_matrix_fixed_ref for rationale.
+// See also vnl_vector_ref, vnl_vector_fixed
+//
+// \author Paul P. Smyth, Vicon Motion Systems Ltd.
+// \date 02 May 2001
+//
+// \verbatim
+// Modifications
+// 4-Jul-2003 Paul Smyth - general cleanup and rewrite; interface now as vnl_vector_fixed
+// \endverbatim
+
+#include <vcl_cassert.h>
+#include <vnl/vnl_vector_fixed.h>
+#include <vcl_iosfwd.h>
+
+
+template <class T, unsigned int n>
+class vnl_vector_fixed_ref_const
+{
+ public:
+ typedef unsigned int size_type;
+
+ protected:
+ const T* data_;
+
+ public:
+ vnl_vector_fixed_ref_const(vnl_vector_fixed<T,n> const& rhs) : data_(rhs.data_block()) {}
+
+ explicit vnl_vector_fixed_ref_const(const T * dataptr) : data_(dataptr) {}
+
+ vnl_vector_fixed_ref_const(const vnl_vector_fixed_ref_const<T,n> & rhs) : data_(rhs.data_block()) {}
+
+ const T * data_block() const { return data_; }
+
+ public:
+ // Don't out-of-line the constructors, as the extra function call
+ // adds a significant overhead. (memcpy is often implemented with a
+ // couple of assembly instructions.)
+
+
+ //: Length of the vector.
+ // This is always \a n.
+ unsigned size() const { return n; }
+
+ //: Get value at element i
+ T get (unsigned int i) const { return data_[i]; }
+
+ //: Copy elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_out( T* ptr ) const {
+ for ( size_type i = 0; i < n; ++i )
+ ptr[i] = data_[i];
+ }
+
+
+ //: Return reference to the element at specified index.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T const & operator() (unsigned int i) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(i<n); // Check the index is valid
+#endif
+ return data_[i];
+ }
+
+
+ //: Return the i-th element
+ const T& operator[] ( unsigned int i ) const { return data_[i]; }
+
+
+ //----------------------------------------------------------------------
+ // Conversion to vnl_vector_ref.
+
+ // The const version of as_ref should return a const vnl_vector_ref
+ // so that the vnl_vector_ref::non_const() cannot be used on
+ // it. This prevents a vnl_vector_fixed_ref_const from being cast into a
+ // non-const vnl_vector reference, giving a slight increase in type safety.
+
+ //: Explicit conversion to a vnl_vector_ref.
+ // This is a cheap conversion for those functions that have an interface
+ // for vnl_vector_ref but not for vnl_vector_fixed_ref. There is also a
+ // conversion operator that should work most of the time.
+ // \sa vnl_vector_ref::non_const
+ const vnl_vector_ref<T> as_ref() const { return vnl_vector_ref<T>( n, const_cast<T*>(data_) ); }
+
+ //: Cheap conversion to vnl_vector_ref
+ // Sometimes, such as with templated functions, the compiler cannot
+ // use this user-defined conversion. For those cases, use the
+ // explicit as_ref() method instead.
+ operator const vnl_vector_ref<T>() const { return vnl_vector_ref<T>( n, const_cast<T*>(data_) ); }
+
+ //----------------------------------------------------------------------
+
+ //: Type defs for iterators
+ typedef T element_type;
+ //: Type defs for iterators
+ typedef T const *iterator;
+
+ //: Const iterator type
+ typedef T const *const_iterator;
+ //: Iterator pointing to start of data
+ const_iterator begin() const { return data_; }
+ //: Iterator pointing to element beyond end of data
+ const_iterator end() const { return data_+n; }
+
+
+ //: Apply f to each element.
+ // Returns a new vector with the result.
+ vnl_vector_fixed<T,n> apply(T (*f)(T)) const;
+
+ //: Apply f to each element.
+ // Returns a new vector with the result.
+ vnl_vector_fixed<T,n> apply(T (*f)(const T&)) const;
+
+ //:
+ vnl_vector_fixed<T,n> operator-() const {
+ vnl_vector_fixed<T,n> result;
+ sub( (T)0, data_, result.data_block() );
+ return result;
+ }
+
+ //: Returns a subvector specified by the start index and length. O(n).
+ vnl_vector<T> extract (unsigned int len, unsigned int start=0) const;
+
+ //: Convert to a vnl_vector.
+ vnl_vector<T> as_vector() const { return extract(n); }
+
+
+ // norms etc
+ typedef typename vnl_c_vector<T>::abs_t abs_t;
+
+ //: Return sum of squares of elements
+ abs_t squared_magnitude() const { return vnl_c_vector<T>::two_nrm2(begin(), n); }
+
+ //: Return magnitude (length) of vector
+ abs_t magnitude() const { return two_norm(); }
+
+ //: Return sum of absolute values of the elements
+ abs_t one_norm() const { return vnl_c_vector<T>::one_norm(begin(), n); }
+
+ //: Return sqrt of sum of squares of values of elements
+ abs_t two_norm() const { return vnl_c_vector<T>::two_norm(begin(), n); }
+
+ //: Return largest absolute element value
+ abs_t inf_norm() const { return vnl_c_vector<T>::inf_norm(begin(), n); }
+
+
+ // These next 6 functions are should really be helper functions since they aren't
+ // really proper functions on a vector in a philosophical sense.
+
+ //: Root Mean Squares of values
+ abs_t rms () const { return vnl_c_vector<T>::rms_norm(begin(), n); }
+
+ //: Smallest value
+ T min_value () const { return vnl_c_vector<T>::min_value(begin(), n); }
+
+ //: Largest value
+ T max_value () const { return vnl_c_vector<T>::max_value(begin(), n); }
+
+ //: Mean of values in vector
+ T mean() const { return vnl_c_vector<T>::mean(begin(), n); }
+
+ //: Sum of values in a vector
+ T sum() const { return vnl_c_vector<T>::sum(begin(), n); }
+
+
+ //: Check that size()==sz if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_size( unsigned sz ) const { assert( sz == n ); }
+
+ //: Check that this is finite if not, abort();
+ // This function does or tests nothing if NDEBUG is defined
+ void assert_finite() const {
+#ifndef NDEBUG
+ assert_finite_internal();
+#endif
+ }
+
+ //: Return true if its finite
+ bool is_finite() const;
+
+ //: Return true iff all the entries are zero.
+ bool is_zero() const;
+
+ //: Return true iff the size is zero.
+ bool empty() const { return n==0; }
+
+ //: Return true if *this == v
+ bool operator_eq (vnl_vector_fixed_ref_const<T,n> const& v) const {
+ for ( size_type i = 0; i < n; ++i )
+ if ( (*this)[i] != v[i] )
+ return false;
+ return true;
+ }
+
+ //: Return true if *this == v
+ bool operator_eq (vnl_vector<T> const& v) const {
+ assert( v.size() == n );
+ for ( size_type i = 0; i < n; ++i )
+ if ( (*this)[i] != v[i] )
+ return false;
+ return true;
+ }
+
+
+ //: Display the vector
+ // Output each element separated by a single space.
+ void print( vcl_ostream& s ) const;
+
+ public:
+ // Helper routines for arithmetic. n is the size, and is the
+ // template parameter.
+
+ inline static void add( const T* a, const T* b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a + *b;
+ }
+
+ inline static void add( const T* a, T b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a + b;
+ }
+
+ inline static void sub( const T* a, const T* b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a - *b;
+ }
+
+ inline static void sub( const T* a, T b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a - b;
+ }
+
+ inline static void sub( T a, const T* b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++b )
+ *r = a - *b;
+ }
+
+ inline static void mul( const T* a, const T* b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a * *b;
+ }
+
+ inline static void mul( const T* a, T b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a * b;
+ }
+
+ inline static void div( const T* a, const T* b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a,++b )
+ *r = *a / *b;
+ }
+
+ inline static void div( const T* a, T b, T* r ) {
+ for ( unsigned int i=0; i < n; ++i,++r,++a )
+ *r = *a / b;
+ }
+
+
+ //: Equality operator
+ bool operator==(vnl_vector_fixed_ref_const<T,n> const &that) const { return this->operator_eq(that); }
+
+ //: Inequality operator
+ bool operator!=(vnl_vector_fixed_ref_const<T,n> const &that) const { return !this->operator_eq(that); }
+
+ private:
+ //: See assert_finite().
+ const vnl_vector_fixed_ref_const<T,n> & operator=(const vnl_vector_fixed<T,n> & ) const
+ {
+ assert(!"Assignment is illegal for a vnl_vector_fixed_ref_const");
+ return *this;
+ }
+ const vnl_vector_fixed_ref_const<T,n> & operator=(const vnl_vector_fixed_ref_const<T,n> & ) const
+ {
+ assert(!"Assignment is illegal for a vnl_vector_fixed_ref_const");
+ return *this;
+ }
+ void assert_finite_internal() const;
+};
+
+// Non const vector fixed reference
+
+template <class T, unsigned n>
+class vnl_vector_fixed_ref : public vnl_vector_fixed_ref_const<T,n>
+{
+ typedef vnl_vector_fixed_ref_const<T,n> base;
+
+ public:
+ typedef unsigned int size_type;
+
+ // this is the only point where the const_cast happens
+ // the base class is used to store the pointer, so that conversion is not necessary
+ T * data_block() const { return const_cast<T*>(this->data_); }
+
+ vnl_vector_fixed_ref(vnl_vector_fixed<T,n>& rhs) : base(rhs.data_block()) {}
+
+ explicit vnl_vector_fixed_ref(T * dataptr) : base(dataptr) {}
+
+ //: Copy operator
+ vnl_vector_fixed_ref<T,n> const & operator=( const vnl_vector_fixed<T,n>& rhs ) const {
+ vcl_memcpy( data_block(), rhs.data_block(), n * sizeof(T) );
+ return *this;
+ }
+
+ //: Copy operator
+ vnl_vector_fixed_ref<T,n> const& operator=( const vnl_vector_fixed_ref_const<T,n>& rhs ) const {
+ vcl_memcpy( data_block(), rhs.data_block(), n * sizeof(T) );
+ return *this;
+ }
+
+
+ //: Put value at given position in vector.
+ void put (unsigned int i, T const& v) const { data_block()[i] = v; }
+
+ //: Set all values to v
+ void fill( T const& v ) { for ( size_type i = 0; i < n; ++i ) data_block()[i] = v; }
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void copy_in( T const * ptr ) const { for ( size_type i = 0; i < n; ++i ) data_block()[i] = ptr[i]; }
+
+ //: Sets elements to ptr[i]
+ // Note: ptr[i] must be valid for i=0..size()-1
+ void set( T const *ptr ) const { copy_in(ptr); }
+
+
+ //: Return reference to the element at specified index.
+ // There are assert style boundary checks - #define NDEBUG to turn them off.
+ T & operator() (unsigned int i) const
+ {
+#if VNL_CONFIG_CHECK_BOUNDS && (!defined NDEBUG)
+ assert(i<n); // Check the index is valid.
+#endif
+ return data_block()[i];
+ }
+
+ //: Return the i-th element
+ T& operator[] ( unsigned int i ) const { return data_block()[i]; }
+
+ // \sa vnl_vector_ref::non_const
+ vnl_vector_ref<T> as_ref() { return vnl_vector_ref<T>( n, data_block() ); }
+
+ typedef T *iterator;
+ //: Iterator pointing to start of data
+ iterator begin() const { return data_block(); }
+
+ //: Iterator pointing to element beyond end of data
+ iterator end() const { return begin()+n; }
+
+ //: Replaces elements with index beginning at start, by values of v. O(n).
+ vnl_vector_fixed_ref const& update (vnl_vector<T> const&, unsigned int start=0) const;
+
+ //: Read from text stream
+ bool read_ascii(vcl_istream& s) const;
+
+ void flip() const;
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator+=( T s ) const {
+ add( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator-=( T s ) const {
+ sub( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator*=( T s ) const {
+ mul( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator/=( T s ) const {
+ div( data_block(), s, data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator+=( const vnl_vector_fixed<T,n>& v ) const {
+ add( data_block(), v.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator-=( const vnl_vector_fixed<T,n>& v ) const {
+ sub( data_block(), v.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator+=( const vnl_vector<T>& v ) const {
+ assert( v.size() == n );
+ add( data_block(), v.data_block(), data_block() ); return *this;
+ }
+
+ //:
+ vnl_vector_fixed_ref<T,n> const & operator-=( const vnl_vector<T>& v ) const {
+ assert( v.size() == n );
+ sub( data_block(), v.data_block(), data_block() ); return *this;
+ }
+};
+
+
+// Make the operators below inline because (1) they are small and
+// (2) we then have less explicit instantiation trouble.
+
+
+// --- Vector-scalar operators ----------------------------------------
+
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( const vnl_vector_fixed_ref_const<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( T s, const vnl_vector_fixed_ref_const<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( const vnl_vector_fixed_ref_const<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( T s, const vnl_vector_fixed_ref_const<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( s, v.data_block(), r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator*( const vnl_vector_fixed_ref_const<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator*( T s, const vnl_vector_fixed_ref_const<T,n>& v )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator/( const vnl_vector_fixed_ref_const<T,n>& v, T s )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::div( v.data_block(), s, r.data_block() );
+ return r;
+}
+
+
+// --- Vector-vector operators ----------------------------------------
+
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator+( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::add( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> operator-( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::sub( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> element_product( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::mul( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T, unsigned int n>
+inline vnl_vector_fixed<T,n> element_quotient( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ vnl_vector_fixed<T,n> r;
+ vnl_vector_fixed<T,n>::div( a.data_block(), b.data_block(), r.data_block() );
+ return r;
+}
+
+template<class T>
+vnl_vector_fixed<T,3> vnl_cross_3d(vnl_vector_fixed_ref_const<T,3> const& v1, vnl_vector_fixed_ref_const<T,3> const& v2)
+{
+ vnl_vector_fixed<T,3> result;
+
+ result[0] = v1[1] * v2[2] - v1[2] * v2[1];
+ result[1] = v1[2] * v2[0] - v1[0] * v2[2];
+ result[2] = v1[0] * v2[1] - v1[1] * v2[0];
+ return result;
+}
+
+// These overloads for the common case of mixing a fixed with a
+// non-fixed. Because the operator* are templated, the fixed will not
+// be automatically converted to a non-fixed-ref. These do it for you.
+
+template<class T, unsigned int n>
+inline vnl_vector<T> operator+( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() + b;
+}
+
+template<class T, unsigned int n>
+inline vnl_vector<T> operator+( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return a + b.as_ref();
+}
+
+template<class T, unsigned int n>
+inline vnl_vector<T> operator-( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return a.as_ref() - b;
+}
+
+template<class T, unsigned int n>
+inline vnl_vector<T> operator-( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return a - b.as_ref();
+}
+
+
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return dot_product( a.as_ref(), b.as_ref() );
+}
+
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return dot_product( a.as_ref(), b );
+}
+
+template<class T, unsigned n>
+inline T dot_product( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return dot_product( a, b.as_ref() );
+}
+
+template<class T, unsigned int m, unsigned int n>
+inline vnl_matrix_fixed<T,m,n> outer_product( const vnl_vector_fixed_ref_const<T,m>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ vnl_matrix_fixed<T,m,n> out; // = a.column() * b.row()
+ for (unsigned int i = 0; i < m; i++)
+ for (unsigned int j = 0; j < n; j++)
+ out[i][j] = a[i] * b[j];
+ return out;
+}
+
+template<class T,unsigned int n>
+ inline vnl_vector_fixed<T,n> vnl_cross_3d( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b ) {
+ return vnl_cross_3d( a.as_ref(), b);
+}
+
+template<class T,unsigned int n>
+ inline vnl_vector_fixed<T,n> vnl_cross_3d( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b ) {
+ return vnl_cross_3d( a, b.as_ref());
+}
+
+template<class T, unsigned int n>
+inline vnl_matrix<T> outer_product( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return outer_product( a, b.as_ref());
+}
+
+template<class T, unsigned int n>
+inline vnl_matrix<T> outer_product( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return outer_product( a.as_ref(), b);
+}
+
+template<class T, unsigned n>
+inline T angle( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return angle( a.as_ref(), b.as_ref() );
+}
+
+template<class T, unsigned n>
+inline T angle( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return angle( a.as_ref(), b );
+}
+
+template<class T, unsigned n>
+inline T angle( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return angle( a, b.as_ref() );
+}
+
+
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return vnl_vector_ssd( a.as_ref(), b.as_ref() );
+}
+
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector_fixed_ref_const<T,n>& a, const vnl_vector<T>& b )
+{
+ return vnl_vector_ssd( a.as_ref(), b );
+}
+
+template<class T, unsigned n>
+inline T vnl_vector_ssd( const vnl_vector<T>& a, const vnl_vector_fixed_ref_const<T,n>& b )
+{
+ return vnl_vector_ssd( a, b.as_ref() );
+}
+
+
+// --- I/O operators -------------------------------------------------
+
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline
+vcl_ostream& operator<<(vcl_ostream& o,const vnl_vector_fixed_ref_const<T,n>& v)
+{
+ v.print(o);
+ return o;
+}
+
+//: \relates vnl_vector_fixed
+template<class T, unsigned int n>
+inline
+vcl_istream& operator>>(vcl_istream& i, const vnl_vector_fixed_ref<T,n>& v)
+{
+ v.read_ascii(i);
+ return i;
+}
+
+
+#endif // vnl_vector_fixed_ref_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.txx b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.txx
new file mode 100644
index 0000000000000000000000000000000000000000..efceaaaac86a6926fb6ccc6fb9b1fd994b779845
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_fixed_ref.txx
@@ -0,0 +1,127 @@
+// This is core/vnl/vnl_vector_fixed_ref.txx
+#ifndef vnl_vector_fixed_ref_txx_
+#define vnl_vector_fixed_ref_txx_
+// Author: Paul P. Smyth, Vicon Motion Systems Ltd.
+// Created: 02 May 2001
+//
+#include "vnl_vector_fixed_ref.h"
+#include <vcl_cassert.h>
+#include <vcl_algorithm.h> // for vcl_swap
+#include <vcl_iostream.h> // for vcl_cerr
+#include <vcl_cstdlib.h> // for vcl_abort
+#include <vnl/vnl_math.h> // for vnl_math_isfinite
+
+
+//------------------------------------------------------------
+
+template<class T, unsigned int n>
+vnl_vector_fixed<T,n>
+vnl_vector_fixed_ref_const<T,n>::apply( T (*f)(T) ) const
+{
+ vnl_vector_fixed<T,n> ret;
+ for ( size_type i = 0; i < n; ++i )
+ ret[i] = f( data_block()[i] );
+ return ret;
+}
+
+template<class T, unsigned int n>
+vnl_vector_fixed<T,n>
+vnl_vector_fixed_ref_const<T,n>::apply( T (*f)(const T&) ) const
+{
+ vnl_vector_fixed<T,n> ret;
+ for ( size_type i = 0; i < n; ++i )
+ ret[i] = f( data_block()[i] );
+ return ret;
+}
+
+
+template<class T, unsigned int n>
+vnl_vector<T>
+vnl_vector_fixed_ref_const<T,n>::extract( unsigned int len, unsigned int start ) const
+{
+ assert( start < n && start + len <= n );
+ return vnl_vector<T>( data_block() + start, len );
+}
+
+template<class T, unsigned int n>
+vnl_vector_fixed_ref<T,n> const&
+vnl_vector_fixed_ref<T,n>::update( const vnl_vector<T>& v, unsigned int start ) const
+{
+ size_type stop = start + v.size();
+ assert( stop <= n );
+ for (size_type i = start; i < stop; i++)
+ this->data_block()[i] = v[i-start];
+ return *this;
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed_ref<T,n>::flip() const
+{
+ for ( unsigned int i=0; 2*i+1 < n; ++i )
+ vcl_swap( data_block()[i], data_block()[n-1-i] );
+}
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed_ref_const<T,n>::is_finite() const
+{
+ for ( size_type i = 0; i < this->size(); ++i )
+ if ( !vnl_math_isfinite( (*this)[i] ) )
+ return false;
+
+ return true;
+}
+
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed_ref_const<T,n>::is_zero() const
+{
+ T const zero(0);
+ for ( size_type i = 0; i < this->size(); ++i )
+ if ( !( (*this)[i] == zero) )
+ return false;
+
+ return true;
+}
+
+
+template <class T, unsigned int n>
+bool
+vnl_vector_fixed_ref<T,n>::read_ascii(vcl_istream& s) const
+{
+ for (unsigned i = 0; i < this->size(); ++i)
+ s >> (*this)(i);
+
+ return s.good() || s.eof();
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed_ref_const<T,n>::assert_finite_internal() const
+{
+ if (this->is_finite())
+ return;
+
+ vcl_cerr << __FILE__ ": *** NAN FEVER **\n" << *this;
+ vcl_abort();
+}
+
+template <class T, unsigned int n>
+void
+vnl_vector_fixed_ref_const<T,n>::print( vcl_ostream& s ) const
+{
+ if ( this->size() > 0 )
+ s << (*this)[0];
+ for ( size_type i = 1; i < this->size(); ++i )
+ s << ' ' << (*this)[i];
+}
+
+// instantiation macros for vnl_vector_fixed_ref<T,unsigned> :
+
+#define VNL_VECTOR_FIXED_REF_INSTANTIATE(T,n) \
+template class vnl_vector_fixed_ref<T, n >; \
+template class vnl_vector_fixed_ref_const<T, n >
+
+#endif // vnl_vector_fixed_ref_txx_
diff --git a/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_ref.h b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_ref.h
new file mode 100644
index 0000000000000000000000000000000000000000..2d2b908e2650409667568ec135d0bc18f30c1476
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vnl/vnl_vector_ref.h
@@ -0,0 +1,93 @@
+// This is core/vnl/vnl_vector_ref.h
+#ifndef vnl_vector_ref_h_
+#define vnl_vector_ref_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief vnl_vector using user-supplied storage
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 04 Aug 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 19/03/2001: Tidied up the documentation
+// Peter Vanroose 27-Jun-2003 Removed .txx as all methods are inlined
+// \endverbatim
+//-----------------------------------------------------------------------------
+
+#include <vnl/vnl_vector.h>
+
+//: vnl_vector using user-supplied storage
+// vnl_vector for which the data space has
+// been supplied externally.
+export template <class T>
+class vnl_vector_ref : public vnl_vector<T>
+{
+ public:
+ typedef vnl_vector<T> Base;
+
+ //: Constructor
+ // Do *not* call anything else than the default constructor of vnl_vector<T>
+ vnl_vector_ref(unsigned n, T *space) : vnl_vector<T>() {
+ Base::data = space;
+ Base::num_elmts = n;
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ this->vnl_vector_own_data = 0;
+#endif
+ }
+
+ //: Copy constructor
+ // Do *not* call anything else than the default constructor of vnl_vector<T>
+ // (That is why the default copy constructor is *not* good.)
+ vnl_vector_ref(vnl_vector_ref<T> const& v) : vnl_vector<T>() {
+ Base::data = const_cast<T*>(v.data_block()); // const incorrect!
+ Base::num_elmts = v.size();
+#if VCL_HAS_SLICED_DESTRUCTOR_BUG
+ this->vnl_vector_own_data = 0;
+#endif
+ }
+
+ //: Destructor
+ // Prevents base destructor from releasing memory we don't own
+ ~vnl_vector_ref() {
+ Base::data = 0;
+ }
+
+ //: Reference to self to make non-const temporaries.
+ // This is intended for passing vnl_vector_fixed objects to
+ // functions that expect non-const vnl_vector references:
+ // \code
+ // void mutator( vnl_vector<double>& );
+ // ...
+ // vnl_vector_fixed<double,4> my_v;
+ // mutator( v ); // Both these fail because the temporary vnl_vector_ref
+ // mutator( v.as_ref() ); // cannot be bound to the non-const reference
+ // mutator( v.as_ref().non_const() ); // works
+ // \endcode
+ // \attention Use this only to pass the reference to a
+ // function. Otherwise, the underlying object will be destructed and
+ // you'll be left with undefined behaviour.
+ vnl_vector_ref& non_const() { return *this; }
+
+ private:
+
+ //: Copy constructor from vnl_vector<T> is disallowed:
+ vnl_vector_ref(vnl_vector<T> const&) {}
+
+#if 0 // NOW COMMENTED OUT - PVR, may 97
+ // Private operator new because deleting a pointer to
+ // one of these through a baseclass pointer will attempt
+ // to free the referenced memory.
+ // Therefore disallow newing of these -- if you're paying for
+ // one malloc, you can afford two.
+ void* operator new(vcl_size_t) { return 0; }
+
+ public:
+ // Privatizing other new means we must offer placement new for STL
+ void* operator new(vcl_size_t, void* space) { return space; }
+#endif
+};
+
+#endif // vnl_vector_ref_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vxl_config.h.in b/Utilities/ITK/Utilities/vxl/core/vxl_config.h.in
new file mode 100644
index 0000000000000000000000000000000000000000..38f0b734f47da281c52279b4bac8469119c1825b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vxl_config.h.in
@@ -0,0 +1,165 @@
+#ifndef vxl_config_h_
+#define vxl_config_h_
+
+/* this file either is or was generated from vxl_config.h.in */
+
+/* -------------------- machine word characteristics */
+
+/* these are 0 or 1, never empty. */
+#define VXL_LITTLE_ENDIAN @VXL_LITTLE_ENDIAN@
+#define VXL_BIG_ENDIAN @VXL_BIG_ENDIAN@
+
+/* we can't just use typedefs, because on systems where there are */
+/* no 64bit integers we have to #define vxl_int_64 to `void' in */
+/* order to catch illegitimate uses. However, typedefs are superior */
+/* to #defines, especially for the two keyword types, so we use */
+/* typedefs for the valid cases. */
+
+#define VXL_HAS_BYTE @VXL_HAS_BYTE@
+#define VXL_BYTE_STRING "@VXL_BYTE@"
+#if @VXL_HAS_BYTE@
+ typedef signed @VXL_BYTE@ vxl_sbyte;
+ typedef unsigned @VXL_BYTE@ vxl_byte;
+#else
+# define vxl_sbyte void
+# define vxl_byte void
+#endif
+
+#define VXL_HAS_INT_8 @VXL_HAS_INT_8@
+#define VXL_INT_8_STRING "@VXL_INT_8@"
+#if @VXL_HAS_INT_8@
+ typedef @VXL_INT_8@ vxl_int_8;
+ typedef signed @VXL_INT_8@ vxl_sint_8;
+ typedef unsigned @VXL_INT_8@ vxl_uint_8;
+#else
+# define vxl_int_8 void
+# define vxl_sint_8 void
+# define vxl_uint_8 void
+#endif
+
+#define VXL_HAS_INT_16 @VXL_HAS_INT_16@
+#define VXL_INT_16_STRING "@VXL_INT_16@"
+#if @VXL_HAS_INT_16@
+ typedef @VXL_INT_16@ vxl_int_16;
+ typedef signed @VXL_INT_16@ vxl_sint_16;
+ typedef unsigned @VXL_INT_16@ vxl_uint_16;
+#else
+# define vxl_int_16 void
+# define vxl_sint_16 void
+# define vxl_uint_16 void
+#endif
+
+#define VXL_HAS_INT_32 @VXL_HAS_INT_32@
+#define VXL_INT_32_STRING "@VXL_INT_32@"
+#if @VXL_HAS_INT_32@
+ typedef @VXL_INT_32@ vxl_int_32;
+ typedef signed @VXL_INT_32@ vxl_sint_32;
+ typedef unsigned @VXL_INT_32@ vxl_uint_32;
+#else
+# define vxl_int_32 void
+# define vxl_sint_32 void
+# define vxl_uint_32 void
+#endif
+
+#define VXL_HAS_INT_64 @VXL_HAS_INT_64@
+#define VXL_INT_64_STRING "@VXL_INT_64@"
+#if @VXL_HAS_INT_64@
+ typedef @VXL_INT_64@ vxl_int_64;
+ typedef signed @VXL_INT_64@ vxl_sint_64;
+ typedef unsigned @VXL_INT_64@ vxl_uint_64;
+#else
+# define vxl_int_64 void
+# define vxl_sint_64 void
+# define vxl_uint_64 void
+#endif
+
+#define VXL_INT_64_IS_LONG @VXL_INT_64_IS_LONG@
+
+#define VXL_HAS_IEEE_32 @VXL_HAS_IEEE_32@
+#define VXL_IEEE_32_STRING "@VXL_IEEE_32@"
+#if @VXL_HAS_IEEE_32@
+ typedef @VXL_IEEE_32@ vxl_ieee_32;
+#else
+# define vxl_ieee_32 void
+#endif
+
+#define VXL_HAS_IEEE_64 @VXL_HAS_IEEE_64@
+#define VXL_IEEE_64_STRING "@VXL_IEEE_64@"
+#if @VXL_HAS_IEEE_64@
+ typedef @VXL_IEEE_64@ vxl_ieee_64;
+#else
+# define vxl_ieee_64 void
+#endif
+
+#define VXL_HAS_IEEE_96 @VXL_HAS_IEEE_96@
+#define VXL_IEEE_96_STRING "@VXL_IEEE_96@"
+#if @VXL_HAS_IEEE_96@
+ typedef @VXL_IEEE_96@ vxl_ieee_96;
+#else
+# define vxl_ieee_96 void
+#endif
+
+#define VXL_HAS_IEEE_128 @VXL_HAS_IEEE_128@
+#define VXL_IEEE_128_STRING "@VXL_IEEE_128@"
+#if @VXL_HAS_IEEE_128@
+ typedef @VXL_IEEE_128@ vxl_ieee_128;
+#else
+# define vxl_ieee_128 void
+#endif
+
+/* -------------------- operating system services */
+
+#define VXL_HAS_PTHREAD_H @VXL_HAS_PTHREAD_H@
+#define VXL_HAS_SEMAPHORE_H @VXL_HAS_SEMAPHORE_H@
+
+/* -------------------- library quirks */
+
+/* these should be 1 if the symbol in question is declared */
+/* in the relevant header file and 0 otherwise. */
+
+#define VXL_UNISTD_HAS_USECONDS_T @VXL_UNISTD_HAS_USECONDS_T@
+#define VXL_UNISTD_HAS_INTPTR_T @VXL_UNISTD_HAS_INTPTR_T@
+#define VXL_UNISTD_HAS_UALARM @VXL_UNISTD_HAS_UALARM@
+#define VXL_UNISTD_HAS_USLEEP @VXL_UNISTD_HAS_USLEEP@
+#define VXL_UNISTD_HAS_LCHOWN @VXL_UNISTD_HAS_LCHOWN@
+#define VXL_UNISTD_HAS_PREAD @VXL_UNISTD_HAS_PREAD@
+#define VXL_UNISTD_HAS_PWRITE @VXL_UNISTD_HAS_PWRITE@
+#define VXL_UNISTD_HAS_TELL @VXL_UNISTD_HAS_TELL@
+
+/* true if <stdlib.h> declares qsort() */
+#define VXL_STDLIB_HAS_QSORT @VXL_STDLIB_HAS_QSORT@
+
+/* true if <stdlib.h> declares lrand48() */
+#define VXL_STDLIB_HAS_LRAND48 @VXL_STDLIB_HAS_LRAND48@
+
+/* true if <stdlib.h> declares drand48() */
+#define VXL_STDLIB_HAS_DRAND48 @VXL_STDLIB_HAS_DRAND48@
+
+/* true if <stdlib.h> declares srand48() */
+#define VXL_STDLIB_HAS_SRAND48 @VXL_STDLIB_HAS_SRAND48@
+
+/* true if <ieeefp.h> declares finite() */
+#define VXL_IEEEFP_HAS_FINITE @VXL_IEEEFP_HAS_FINITE@
+
+/* true if <math.h> declares finitef() */
+#define VXL_C_MATH_HAS_FINITEF @VXL_C_MATH_HAS_FINITEF@
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITE @VXL_C_MATH_HAS_FINITE@
+
+/* true if <math.h> declares finitel() */
+#define VXL_C_MATH_HAS_FINITEL @VXL_C_MATH_HAS_FINITEL@
+
+/* true if <math.h> declares sqrtf() for the C compiler */
+#define VXL_C_MATH_HAS_SQRTF @VXL_C_MATH_HAS_SQRTF@
+
+/* true if usleep() returns void */
+#define VXL_UNISTD_USLEEP_IS_VOID @VXL_UNISTD_USLEEP_IS_VOID@
+
+/* true if gettime() takes two arguments */
+#define VXL_TWO_ARG_GETTIME @VXL_TWO_ARG_GETTIME@
+
+/* true if <ieeefp.h> is available */
+#define VXL_HAS_IEEEFP_H @VXL_HAS_IEEEFP_H@
+
+#endif /* vxl_config_h_ */
diff --git a/Utilities/ITK/Utilities/vxl/core/vxl_copyright.h b/Utilities/ITK/Utilities/vxl/core/vxl_copyright.h
new file mode 100644
index 0000000000000000000000000000000000000000..f8f80040434afbaa5efa93fbfee55c90a1b6dd77
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vxl_copyright.h
@@ -0,0 +1,37 @@
+#ifndef vxl_copyright_h_
+#define vxl_copyright_h_
+
+// <begin copyright notice>
+// ---------------------------------------------------------------------------
+//
+// Copyright (c) 2000-2003 TargetJr Consortium
+// GE Corporate Research and Development (GE CRD)
+// 1 Research Circle
+// Niskayuna, NY 12309
+// All Rights Reserved
+// Reproduction rights limited as described below.
+//
+// Permission to use, copy, modify, distribute, and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that (i) the above copyright notice and this permission
+// notice appear in all copies of the software and related documentation,
+// (ii) the name TargetJr Consortium (represented by GE CRD), may not be
+// used in any advertising or publicity relating to the software without
+// the specific, prior written permission of GE CRD, and (iii) any
+// modifications are clearly marked and summarized in a change history
+// log.
+//
+// THE SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
+// EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+// WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+// IN NO EVENT SHALL THE TARGETJR CONSORTIUM BE LIABLE FOR ANY SPECIAL,
+// INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND OR ANY
+// DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+// WHETHER OR NOT ADVISED OF THE POSSIBILITY OF SUCH DAMAGES, OR ON
+// ANY THEORY OF LIABILITY ARISING OUT OF OR IN CONNECTION WITH THE
+// USE OR PERFORMANCE OF THIS SOFTWARE.
+//
+// ---------------------------------------------------------------------------
+// <end copyright notice>
+
+#endif // vxl_copyright_h_
diff --git a/Utilities/ITK/Utilities/vxl/core/vxl_version.h b/Utilities/ITK/Utilities/vxl/core/vxl_version.h
new file mode 100644
index 0000000000000000000000000000000000000000..fe45c303da88acbb50f36119fbefccfbb93fb6a2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/core/vxl_version.h
@@ -0,0 +1,62 @@
+#ifndef vxl_version_h_
+#define vxl_version_h_
+
+//:
+// \file
+// \brief The VXL version.
+// This version number applies to the whole vxl tree, not just the
+// core libraries.
+
+//: Major version number.
+// This will only increase after major changes, or an large accumulation of
+// significant smaller ones.
+#define VXL_VERSION_MAJOR 1
+
+//: Minor version number.
+// This increments between versions. There is no
+// "even = release, odd = developement" pattern, or anything like that.
+#define VXL_VERSION_MINOR 2
+
+//: Patch number.
+// This is only likely to be non-zero if an serious bug is found soon after the
+// release of x.y.0. The VXL-maintainers do not usually distinguish between bug fixes
+// and feature improvements, so the fix for most known bugs will first be released
+// in x.(y+1).0
+#define VXL_VERSION_PATCH 0
+
+//: Version date. This is updated every day.
+// Formats are year=CCYY, month=MM, day=DD
+#define VXL_VERSION_DATE_YEAR 2005
+#define VXL_VERSION_DATE_MONTH 07
+#define VXL_VERSION_DATE_DAY 30
+
+//: ITK Modification: Defined to indicate this vxl is in ITK.
+#define VXL_VERSION_ITK
+
+//: This can either be "RELEASE" or "CVS"
+#define VXL_SOURCE "CVS"
+
+//: Helper macros to create strings with the preprocessor.
+#define VXL_VERSION_TO_STRING(s) VXL_VERSION_TO_STRING0(s)
+#define VXL_VERSION_TO_STRING0(s) #s
+
+//: Version number as a string literal.
+// This is in the format "major.minor.patch".
+#define VXL_VERSION_STRING \
+ VXL_VERSION_TO_STRING(VXL_VERSION_MAJOR.VXL_VERSION_MINOR.VXL_VERSION_PATCH)
+
+//: Version date as a string literal.
+// This is in the format "CCYY-MM-DD".
+#define VXL_VERSION_DATE \
+ VXL_VERSION_TO_STRING(VXL_VERSION_DATE_YEAR-VXL_VERSION_DATE_MONTH-VXL_VERSION_DATE_DAY)
+
+//: Version date accessible from preprocessor.
+// This is an integer in the format CCYYMMDD.
+#define VXL_VERSION_DATE_FULL \
+ VXL_VERSION_DATE_FULL0(VXL_VERSION_DATE_YEAR, \
+ VXL_VERSION_DATE_MONTH, \
+ VXL_VERSION_DATE_DAY)
+#define VXL_VERSION_DATE_FULL0(y,m,d) VXL_VERSION_DATE_FULL1(y,m,d)
+#define VXL_VERSION_DATE_FULL1(y,m,d) y##m##d
+
+#endif // vxl_version_h_
diff --git a/Utilities/ITK/Utilities/vxl/v3p/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/v3p/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..e6c5bb6b7fbd7fb32ba4262dfdcec307e1b0686a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/CMakeLists.txt
@@ -0,0 +1 @@
+SUBDIRS(netlib)
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib.URL b/Utilities/ITK/Utilities/vxl/v3p/netlib.URL
new file mode 100644
index 0000000000000000000000000000000000000000..4c6539532ace4ef8ef4ab77f34e73f74f1de457f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib.URL
@@ -0,0 +1,3 @@
+
+http://netlib.bell-labs.com/netlib/master/readme.html
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/v3p/netlib/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/v3p/netlib/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..00f5f99e7a72c3b217b05c27dd967e88741d5cea
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/CMakeLists.txt
@@ -0,0 +1,310 @@
+# ./v3p/netlib/CMakeLists.txt
+
+SET( netlib_sources
+ f2c.h
+ netlib.h
+
+ # Std Fortran Library
+ F77_aloc.c
+ exit.c
+ s_cmp.c
+ d_lg10.c
+ s_cat.c
+ s_copy.c
+ d_sign.c
+ d_cnjg.c
+ d_imag.c
+ z_div.c
+ z_abs.c
+ z_sqrt.c
+ cabs.c
+ c_abs.c
+ c_div.c
+ sig_die.c
+ r_sign.c
+ r_imag.c
+ r_cnjg.c
+
+ pow_ii.c
+ pow_ri.c
+ pow_di.c
+ pow_dd.c
+
+ # BLAS
+ izamax.c
+
+ daxpy.c
+ dcopy.c
+ ddot.c
+ dnrm2.c
+ drot.c
+ drotg.c
+ dscal.c
+ dasum.c
+ dzasum.c
+ dswap.c
+ dgemv.c
+ dger.c
+
+ saxpy.c
+ scopy.c
+ sdot.c
+ snrm2.c
+ srot.c
+ srotg.c
+ sscal.c
+ sasum.c
+ sswap.c
+ sgemv.c
+ sger.c
+ caxpy.c
+ ccopy.c
+ cdotc.c
+ csrot.c
+ scnrm2.c
+ cscal.c
+ cswap.c
+ zaxpy.c
+ zcopy.c
+ zdotc.c
+ zdotu.c
+ zdrot.c
+ dznrm2.c
+ zdscal.c
+ zgemm.c
+ zgemv.c
+ zgerc.c
+ zscal.c
+ ztrmm.c
+ ztrmv.c
+ ztrsv.c
+ zswap.c
+
+ # LINALG
+ lsqr.c
+
+ # LINPACK
+ ssvdc.c
+ dsvdc.c
+ csvdc.c
+ zsvdc.c
+ sqrdc.c
+ dqrdc.c
+ cqrdc.c
+ zqrdc.c
+ sqrsl.c
+ dqrsl.c
+ zqrsl.c
+ cqrsl.c
+ dpofa.c
+ dpoco.c
+ dposl.c
+ dpodi.c
+ isamax.c
+ idamax.c
+
+ # EISPACK
+ rsg.c
+ rg.c
+ rs.c
+ tql1.c
+ tql2.c
+ tred1.c
+ tred2.c
+
+ # ITPACK
+ dsrc2c.c
+
+ # MINPACK
+ enorm.c
+ fdjac2.c
+ lmpar.c
+ qrfac.c
+ qrsolv.c
+ lmdif.c
+ lmder.c
+ lmder1.c
+ pythag.c
+ rpoly.c
+
+ # TOMS Misc
+ dtrans.c
+ trans.c
+
+ # General
+ machineparams.c
+
+ # Temperton FFT routines
+ dgpfa.c
+ dgpfa3f.c
+ dsetgpfa.c
+ gpfa2f.c
+ gpfa5f.c
+ dgpfa2f.c
+ dgpfa5f.c
+ gpfa.c
+ gpfa3f.c
+ setgpfa.c
+
+ # NAPACK
+ cg.c
+
+ # from DATAPAC
+ camsun.c
+
+ # from LASO2
+ dnlaso.c
+ snlaso.c
+
+ # from OPT
+ lbfgs.c lbfgs.h
+ lbfgs-lb1.c
+
+ # from LAPACK
+ ilaenv.c
+ izmax1.c
+
+ xerbla.c
+ urand.c
+ lsame.c
+ dlamch.c
+ slamch.c
+
+ dgeqpf.c
+ dgeqr2.c
+ dgerq2.c
+ dggsvd.c
+ dggsvp.c
+ dlacpy.c
+ dlags2.c
+ dlange.c
+ dlapll.c
+ dlapmt.c
+ dlapy2.c
+ dlarf.c
+ dlarfg.c
+ dlartg.c
+ dlas2.c
+ dlaset.c
+ dlassq.c
+ dlasv2.c
+ dlabad.c
+ dladiv.c
+ dlapy3.c
+
+ dorg2r.c
+ dorm2r.c
+ dormr2.c
+ dtgsja.c
+ sggsvd.c
+ sgeqpf.c
+ sgeqr2.c
+ sgerq2.c
+ sggsvp.c
+ slacpy.c
+ slags2.c
+ slange.c
+ slapll.c
+ slapmt.c
+ slapy2.c
+ slarf.c
+ slarfg.c
+ slartg.c
+ slas2.c
+ slaset.c
+ slassq.c
+ slasv2.c
+ sorg2r.c
+ sorm2r.c
+ sormr2.c
+ stgsja.c
+
+ zgebak.c
+ zgebal.c
+ zgeev.c
+ zgehd2.c
+ zgehrd.c
+ zhseqr.c
+ zlacgv.c
+ zlacpy.c
+ zladiv.c
+ zlahqr.c
+ zlahrd.c
+ zlange.c
+ zlanhs.c
+ zlarf.c
+ zlarfb.c
+ zlarfg.c
+ zlarft.c
+ zlarfx.c
+ zlascl.c
+ zlaset.c
+ zlassq.c
+ zlatrs.c
+ ztrevc.c
+ zung2r.c
+ zunghr.c
+ zungqr.c
+
+ # Added by fsm for generalized chur
+ dgecon.c
+ dgemm.c
+ dgeqrf.c
+ dgesc2.c
+ dgetc2.c
+ dggbak.c
+ dggbal.c
+ dgges.c
+ dgghrd.c
+ dhgeqz.c
+ dlacon.c
+ dlag2.c
+ dlagv2.c
+ dlanhs.c
+ dlarfb.c
+ dlarft.c
+ dlascl.c
+ dlaswp.c
+ dlatdf.c
+ dlatrs.c
+ dorgqr.c
+ dorgr2.c
+ dormqr.c
+ drscl.c
+ dtgex2.c
+ dtgexc.c
+ dtgsen.c
+ dtgsy2.c
+ dtgsyl.c
+ dtrmm.c
+ dtrmv.c
+ dtrsv.c
+ i_dnnt.c
+
+ # The "Triangle" program of Jonathan Richard Shewchuk
+ triangle.h triangle.c
+
+ # numeric integration
+ trapezod.c
+ simpson.c
+ adaquad.c
+)
+
+IF(CMAKE_COMPILER_IS_GNUCC)
+ # These really need to be inserted later in the options list to gcc,
+ # but this isn't supported in CMake 1.8.3
+ SET_SOURCE_FILES_PROPERTIES(gpfa5f.c PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(dgpfa5f.c PROPERTIES COMPILE_FLAGS -O0)
+ SET_SOURCE_FILES_PROPERTIES(zlarfx.c PROPERTIES COMPILE_FLAGS -Os)
+ SET_SOURCE_FILES_PROPERTIES(rg.c PROPERTIES COMPILE_FLAGS -O1)
+ SET_SOURCE_FILES_PROPERTIES(dnlaso.c PROPERTIES COMPILE_FLAGS -O0)
+ SET(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -w")
+ENDIF(CMAKE_COMPILER_IS_GNUCC)
+
+ADD_LIBRARY( itknetlib ${netlib_sources} )
+
+IF(UNIX)
+ TARGET_LINK_LIBRARIES( itknetlib m )
+ENDIF(UNIX)
+
+INSTALL_TARGETS(/lib/InsightToolkit itknetlib)
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/F77_aloc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/F77_aloc.c
new file mode 100644
index 0000000000000000000000000000000000000000..6ebda627c4e06a1d20c46342500fac28e876bdbf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/F77_aloc.c
@@ -0,0 +1,32 @@
+#include "f2c.h"
+#include "netlib.h"
+#undef abs
+#undef min
+#undef max
+#include <stdio.h>
+
+static integer memfailure = 3;
+
+#ifdef KR_headers
+extern char *malloc();
+extern void exit_();
+
+char *
+F77_aloc(Len, whence) integer Len; const char *whence;
+#else
+#include <stdlib.h>
+extern void exit_(integer*);
+
+char *
+F77_aloc(integer Len, const char *whence)
+#endif
+{
+ char *rv;
+ unsigned int uLen = (unsigned int) Len; /* for K&R C */
+
+ if (!(rv = (char*)malloc(uLen))) {
+ fprintf(stderr, "malloc(%u) failure in %s\n", uLen, whence);
+ exit_(&memfailure);
+ }
+ return rv;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/README b/Utilities/ITK/Utilities/vxl/v3p/netlib/README
new file mode 100644
index 0000000000000000000000000000000000000000..5029743f0c276a3baad6165c3c6f713690953e34
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/README
@@ -0,0 +1,5 @@
+
+This library contains various routines grabbed from netlib and other places. In
+general the C files are direct translations of the FORTRAN, so the .f should be
+edited if improvements are required or mods are to be made.
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.c
new file mode 100644
index 0000000000000000000000000000000000000000..df3f0edb1a5c3a5410f45a2267cc3a7f040329b2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.c
@@ -0,0 +1,145 @@
+/* adaquad.f -- translated by f2c (version 20020621). */
+#include "f2c.h"
+extern /* Subroutine */
+int srule_(E_fp, doublereal *, doublereal *, doublereal *, doublereal *);
+extern /* Subroutine */
+int refine_(U_fp, integer *, doublereal *, integer *, integer *);
+
+/* NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994 */
+/* To accompany the text: */
+/* NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992 */
+/* Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A. */
+/* This free software is complements of the author. */
+
+/* Algorithm 7.5 (Adaptive Quadrature Using Simpson's Rule). */
+/* Section 7.4, Adaptive Quadrature, Page 389 */
+
+/* Subroutine */
+int adaptquad_(E_fp f, doublereal *a, doublereal *b, doublereal *tol, doublereal *srmat,
+ doublereal *integral, doublereal *errbdd, integer *m, integer *state)
+{
+ /* Local variables */
+ static integer j, k, n, iterating;
+ static doublereal sum1, sum2;
+ static doublereal srvec[11];
+
+ /* Function Body */
+ iterating = 0;
+ srule_((E_fp)f, a, b, tol, srvec);
+ for (k = 0; k < 11; ++k) {
+ srmat[k * 101] = srvec[k];
+ }
+ *m = 1;
+ *state = iterating;
+ while (*state == iterating) {
+ n = *m;
+ for (j = n; j >= 1; --j) {
+ refine_((U_fp)f, &j, srmat, m, state);
+ }
+ }
+ sum1 = 0.f;
+ sum2 = 0.f;
+ for (j = 0; j < *m; ++j) {
+ sum1 += srmat[j + 707];
+ sum2 += dabs(srmat[j + 808]);
+ }
+ *integral = sum1;
+ *errbdd = sum2;
+ return 0;
+} /* adaptquad_ */
+
+/* Subroutine */
+int refine_(U_fp f, integer *p, doublereal *srmat, integer *m, integer *state)
+{
+ /* System generated locals */
+ integer pm1;
+
+ /* Local variables */
+ static doublereal a, b, c__;
+ static integer j, k;
+ static integer iterating;
+ static doublereal err, tol, tol2;
+ static doublereal check;
+ static doublereal sr0vec[11], sr1vec[11], sr2vec[11];
+
+ /* Function Body */
+ iterating = 0;
+ *state = 1;
+ pm1 = *p - 1;
+ for (k = 0; k < 11; ++k) {
+ sr0vec[k] = srmat[pm1 + k * 101];
+ }
+ a = sr0vec[0];
+ c__ = sr0vec[1];
+ b = sr0vec[2];
+/* fa = sr0vec[3]; */
+/* fc = sr0vec[4]; */
+/* fb = sr0vec[5]; */
+/* s = sr0vec[6]; */
+/* s2 = sr0vec[7]; */
+ err = sr0vec[8];
+ tol = sr0vec[9];
+ check = sr0vec[10];
+ if (check == 1.f) {
+ return 0;
+ }
+ tol2 = tol / 2;
+ srule_((E_fp)f, &a, &c__, &tol2, sr1vec);
+ srule_((E_fp)f, &c__, &b, &tol2, sr2vec);
+ err = dabs(sr0vec[6] - sr1vec[6] - sr2vec[6]) / 10;
+ if (err < tol) {
+ sr0vec[10] = 1.f;
+ }
+ if (err < tol) {
+ for (k = 0; k < 11; ++k) {
+ srmat[pm1 + k * 101] = sr0vec[k];
+ }
+ srmat[pm1 + 707] = sr1vec[6] + sr2vec[6];
+ srmat[pm1 + 808] = err;
+ } else {
+ for (j = *m; j >= pm1; --j) {
+ for (k = 0; k < 11; ++k) {
+ srmat[j + k * 101] = srmat[j - 1 + k * 101];
+ }
+ }
+ ++(*m);
+ for (k = 0; k < 11; ++k) {
+ srmat[pm1 + k * 101] = sr1vec[k];
+ }
+ for (k = 0; k < 11; ++k) {
+ srmat[*p + k * 101] = sr2vec[k];
+ }
+ *state = iterating;
+ }
+ return 0;
+} /* refine_ */
+
+/* Subroutine */
+int srule_(E_fp f, doublereal *a, doublereal *b, doublereal *tol0, doublereal *srvec)
+{
+ static doublereal c__, h__, s, s2, fa, fb, fc, err, tol1, check;
+
+ /* Function Body */
+ h__ = (*b - *a) / 2;
+ c__ = (*a + *b) / 2;
+ fa = (*f)(a);
+ fc = (*f)(&c__);
+ fb = (*f)(b);
+ s = h__ * ((*f)(a) + (*f)(&c__) * 4 + (*f)(b)) / 3;
+ s2 = s;
+ tol1 = *tol0;
+ err = *tol0;
+ check = 0.f;
+ srvec[0] = *a;
+ srvec[1] = c__;
+ srvec[2] = *b;
+ srvec[3] = fa;
+ srvec[4] = fc;
+ srvec[5] = fb;
+ srvec[6] = s;
+ srvec[7] = s2;
+ srvec[8] = err;
+ srvec[9] = tol1;
+ srvec[10] = check;
+ return 0;
+} /* srule_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.f
new file mode 100644
index 0000000000000000000000000000000000000000..4446a96bc53b91f910ff2c14346953cb7b87df64
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/adaquad.f
@@ -0,0 +1,131 @@
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.5 (Adaptive Quadrature Using Simpson's Rule).
+C Section 7.4, Adaptive Quadrature, Page 389
+C
+
+C add missing variable F in Refine subrutine.
+ SUBROUTINE AdaptQuad(F,A,B,Tol,SRmat,Integral,ErrBdd,M,State)
+ INTEGER M,State
+ REAL A,B,Tol,SRmat,Integral,ErrBdd
+ INTEGER J,K,N,Iterating,Done
+ REAL Sum1,Sum2,SRvec
+ DIMENSION SRmat(1:101,1:11),SRvec(1:11)
+ EXTERNAL F
+ Iterating = 0
+ Done = 1
+ CALL Srule(F,A,B,Tol,SRvec)
+ DO K=1,11
+ SRmat(1, K) = SRvec(K)
+ ENDDO
+ M = 1
+ State = Iterating
+ DO WHILE (State .EQ. Iterating)
+ N = M
+ DO J=N,1,-1
+ CALL Refine(F,J,SRmat,M,State)
+ ENDDO
+ ENDDO
+ Sum1 = 0
+ Sum2 = 0
+ DO J=1,M
+ Sum1 = Sum1 + SRmat(J, 8)
+ Sum2 = Sum2 + Abs(SRmat(J, 9))
+ ENDDO
+ Integral = Sum1
+ ErrBdd = Sum2
+ RETURN
+ END
+
+ SUBROUTINE Refine(F, P,SRmat,M,State)
+ INTEGER P,M,State
+ REAL SRmat
+ INTEGER J,K,Iterating,Done
+ REAL A,B,C,Err,Fa,Fb,Fc,S,S2,Tol,Tol2,Err,Check
+ REAL SR0vec,SR1vec,SR2vec
+ DIMENSION SRmat(1:101,1:11)
+ DIMENSION SR0vec(1:11),SR1vec(1:11),SR2vec(1:11)
+ EXTERNAL F
+ Iterating = 0
+ Done = 1
+ State = Done
+ DO K=1,11
+ SR0vec(K) = SRmat(P, K)
+ ENDDO
+ A = SR0vec(1)
+ C = SR0vec(2)
+ B = SR0vec(3)
+ Fa = SR0vec(4)
+ Fc = SR0vec(5)
+ Fb = SR0vec(6)
+ S = SR0vec(7)
+ S2 = SR0vec(8)
+ Err = SR0vec(9)
+ Tol = SR0vec(10)
+ Check = SR0vec(11)
+ IF (Check .EQ. 1) RETURN
+ Tol2 = Tol / 2
+ CALL Srule(F, A, C, Tol2, SR1vec)
+ CALL Srule(F, C, B, Tol2, SR2vec)
+ Err = ABS(SR0vec(7) - SR1vec(7) - SR2vec(7)) / 10
+ IF (Err .LT. Tol) THEN
+ SR0vec(11) = 1
+ ENDIF
+ IF (Err .LT. Tol) THEN
+ DO K=1,11
+ SRmat(P, K) = SR0vec(K)
+ ENDDO
+ SRmat(P, 8) = SR1vec(7) + SR2vec(7)
+ SRmat(P, 9) = Err
+ ELSE
+ DO J=(M + 1),P,-1
+ DO K=1,11
+ SRmat(J, K) = SRmat(J - 1, K)
+ ENDDO
+ ENDDO
+ M = M + 1
+ DO K=1,11
+ SRmat(P, K) = SR1vec(K)
+ ENDDO
+ DO K=1,11
+ SRmat(P + 1, K) = SR2vec(K)
+ ENDDO
+ State = Iterating
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE Srule(F,A,B,Tol0,SRvec)
+ REAL A,B,Tol0,SRvec
+ REAL C,H,Fa,Fb,Fc,S,S2,Tol1,Err,Check
+ DIMENSION SRvec(1:11)
+ EXTERNAL F
+ H = (B - A) / 2
+ C = (A + B) / 2
+ Fa = F(A)
+ Fc = F(C)
+ Fb = F(B)
+ S = H * (F(A) + 4 * F(C) + F(B)) / 3
+ S2 = S
+ Tol1 = Tol0
+ Err = Tol0
+ Check = 0
+ SRvec(1) = A
+ SRvec(2) = C
+ SRvec(3) = B
+ SRvec(4) = Fa
+ SRvec(5) = Fc
+ SRvec(6) = Fb
+ SRvec(7) = S
+ SRvec(8) = S2
+ SRvec(9) = Err
+ SRvec(10) = Tol1
+ SRvec(11) = Check
+ RETURN
+ END
+
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/c_abs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/c_abs.c
new file mode 100644
index 0000000000000000000000000000000000000000..b4ade29d9d3123e1605b2632c0d6bd0fb4371f61
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/c_abs.c
@@ -0,0 +1,17 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+extern double f__cabs();
+#else
+extern double f__cabs(double, double);
+#endif
+
+#ifdef KR_headers
+real c_abs(z) const complex *z;
+#else
+real c_abs(const complex *z)
+#endif
+{
+return( (real)f__cabs( z->r, z->i ) );
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/c_div.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/c_div.c
new file mode 100644
index 0000000000000000000000000000000000000000..36cea47e3be7009b9034a8aaa8d9f474ecdbea89
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/c_div.c
@@ -0,0 +1,45 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001, to allow c being equal to a or b */
+
+#ifdef KR_headers
+VOID c_div(c, a, b) complex *a; const complex *b, *c;
+#else
+void c_div(complex *c, const complex *a, const complex *b)
+#endif
+{
+ float ratio, den;
+ float abr, abi;
+ float ar = a->r, ai = a->i;
+
+ if ( (abr = b->r) < 0.)
+ abr = - abr;
+ if ( (abi = b->i) < 0.)
+ abi = - abi;
+ if ( abr <= abi ) {
+ if (abi == 0) {
+#ifdef IEEE_COMPLEX_DIVIDE
+ float af, bf;
+ af = bf = abr;
+ if (a->i != 0 || a->r != 0)
+ af = 1.;
+ c->i = c->r = af / bf;
+ return;
+#else
+ sig_die("complex division by zero", 1);
+#endif
+ }
+ ratio = b->r / b->i ;
+ den = b->i * (1 + ratio*ratio);
+ c->r = (ar*ratio + ai) / den;
+ c->i = (ai*ratio - ar) / den;
+ }
+
+ else {
+ ratio = b->i / b->r ;
+ den = b->r * (1 + ratio*ratio);
+ c->r = (ar + ai*ratio) / den;
+ c->i = (ai - ar*ratio) / den;
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cabs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cabs.c
new file mode 100644
index 0000000000000000000000000000000000000000..5c52ed4f4c91a5295b7e7fbd541dcd91ef999f41
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cabs.c
@@ -0,0 +1,28 @@
+#include "f2c.h"
+#include "netlib.h"
+#ifdef KR_headers
+extern double sqrt();
+double f__cabs(real, imag) double real, imag;
+#else
+extern double sqrt(double); /* #include <math.h> */
+double f__cabs(double real, double imag)
+#endif
+{
+ double temp;
+
+ if(real < 0)
+ real = -real;
+ if(imag < 0)
+ imag = -imag;
+ if(imag > real){
+ temp = real;
+ real = imag;
+ imag = temp;
+ }
+ if((real+imag) == real)
+ return real;
+
+ temp = imag/real;
+ temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/
+ return temp;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.c
new file mode 100644
index 0000000000000000000000000000000000000000..fb6edb41f14b336dcac132b9be0b1f167c4c5b0c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.c
@@ -0,0 +1,627 @@
+#include "f2c.h"
+#include "netlib.h"
+#include <stdio.h>
+extern double sqrt(double), exp(double), pow(double,double), log(double); /* #include <math.h> */
+
+static void norcdf_(real *x, real *cdf);
+static void dnorcdf_(doublereal *x, doublereal *cdf);
+
+/* Subroutine */ void chscdf_(x, nu, cdf)
+const real *x;
+const integer *nu;
+real *cdf;
+{
+ /* Initialized data */
+ static integer nucut = 1000;
+ static doublereal b43 = 17.;
+ static doublereal pi = 3.14159265358979;
+ static doublereal dpower = .33333333333333;
+ static doublereal b11 = .33333333333333;
+ static doublereal b21 = -.02777777777778;
+ static doublereal b31 = -6.1728395061e-4;
+ static doublereal b32 = -13.;
+ static doublereal b41 = 1.8004115226e-4;
+ static doublereal b42 = 6.;
+
+ /* Error strings */
+ static char fmt_15[] = "(***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE CHSCDF SUBROUTINE IS NON-POSITIVE *****)";
+ static char fmt_47[] = "(***** THE VALUE OF THE ARGUMENT IS %d *****\002)";
+ static char fmt_4[] = "(***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMENT TO THE CHSCDF SUBROUTINE IS NEGATIVE *****)";
+ static char fmt_46[] = "(***** THE VALUE OF THE ARGUMENT IS %f *****\002)";
+ static char fmt_99[] = "(*****INTERNAL ERROR IN CHSCDF SUBROUTINE -- IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT %d)";
+
+ /* Local variables */
+ static real cdfn;
+ static integer imin, imax;
+ static doublereal term, term0, term1, term2, term3, term4;
+ static integer i;
+ static doublereal dcdfn, dfact;
+ static real amean, u, z;
+ static integer ibran;
+ static real spchi;
+ static doublereal d1, d2, d3, ai;
+ static real sd;
+ static doublereal dw, dx;
+ static integer ievodd;
+ static doublereal chi;
+ static real anu;
+ static doublereal danu, danu2, dnu;
+ static doublereal sum;
+
+/* PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION */
+/* WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. */
+/* THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. */
+/* THE PROBABILITY DENSITY FUNCTION IS GIVEN */
+/* IN THE REFERENCES BELOW. */
+/* INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT */
+/* WHICH THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION IS TO BE EVALUATED. */
+/* X SHOULD BE NON-NEGATIVE. */
+/* --NU = THE INTEGER NUMBER OF DEGREES */
+/* OF FREEDOM. */
+/* NU SHOULD BE POSITIVE. */
+/* OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE */
+/* DISTRIBUTION FUNCTION VALUE. */
+/* OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION */
+/* WITH DEGREES OF FREEDOM PARAMETER = NU. */
+/* PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. */
+/* RESTRICTIONS--X SHOULD BE NON-NEGATIVE. */
+/* --NU SHOULD BE A POSITIVE INTEGER VARIABLE. */
+/* OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. */
+/* FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. */
+/* MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. */
+/* LANGUAGE--ANSI FORTRAN. */
+/* REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS */
+/* SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5.*/
+/* --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE */
+/* DISTRIBUTIONS--1, 1970, PAGE 176, */
+/* FORMULA 28, AND PAGE 180, FORMULA 33.1. */
+/* --OWEN, HANDBOOK OF STATISTICAL TABLES, */
+/* 1962, PAGES 50-55. */
+/* --PEARSON AND HARTLEY, BIOMETRIKA TABLES */
+/* FOR STATISTICIANS, VOLUME 1, 1954, */
+/* PAGES 122-131. */
+/* WRITTEN BY--JAMES J. FILLIBEN */
+/* STATISTICAL ENGINEERING LABORATORY (205.03) */
+/* NATIONAL BUREAU OF STANDARDS */
+/* WASHINGTON, D. C. 20234 */
+/* PHONE: 301-921-2315 */
+/* ORIGINAL VERSION--JUNE 1972. */
+/* UPDATED --MAY 1974. */
+/* UPDATED --SEPTEMBER 1975. */
+/* UPDATED --NOVEMBER 1975. */
+/* UPDATED --OCTOBER 1976. */
+/* */
+/* --------------------------------------------------------------------- */
+
+/* CHECK THE INPUT ARGUMENTS FOR ERRORS */
+
+ if (*nu <= 0) {
+ fprintf(stderr,fmt_15);
+ fprintf(stderr,fmt_47,*nu);
+ *cdf = 0.f;
+ return;
+ }
+ if (*x < 0.f) {
+ fprintf(stderr,fmt_4);
+ fprintf(stderr,fmt_46,*x);
+ *cdf = 0.f;
+ return;
+ }
+
+ dx = *x;
+ anu = (real) (*nu);
+ dnu = (doublereal) (*nu);
+
+/* IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN. */
+/* IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 */
+/* STANDARD DEVIATIONS BELOW THE MEAN, */
+/* SET CDF = 0.0 AND RETURN. */
+/* IF NU IS 10 OR LARGER AND X IS MORE THAN 100 */
+/* STANDARD DEVIATIONS BELOW THE MEAN, */
+/* SET CDF = 0.0 AND RETURN. */
+/* IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 */
+/* STANDARD DEVIATIONS ABOVE THE MEAN, */
+/* SET CDF = 1.0 AND RETURN. */
+/* IF NU IS 10 OR LARGER AND X IS MORE THAN 100 */
+/* STANDARD DEVIATIONS ABOVE THE MEAN, */
+/* SET CDF = 1.0 AND RETURN. */
+
+ if (*x <= 0.f) {
+ *cdf = 0.f;
+ return;
+ }
+ amean = anu;
+ sd = sqrtf(anu * 2.f);
+ z = (*x - amean) / sd;
+ if (*nu < 10 && z < -200.f) {
+ *cdf = 0.f;
+ return;
+ }
+ if (*nu >= 10 && z < -100.f) {
+ *cdf = 0.f;
+ return;
+ }
+ if (*nu < 10 && z > 200.f) {
+ *cdf = 1.f;
+ return;
+ }
+ if (*nu >= 10 && z > 100.f) {
+ *cdf = 1.f;
+ return;
+ }
+
+/* DISTINGUISH BETWEEN 3 SEPARATE REGIONS */
+/* OF THE (X,NU) SPACE. */
+/* BRANCH TO THE PROPER COMPUTATIONAL METHOD */
+/* DEPENDING ON THE REGION. */
+/* NUCUT HAS THE VALUE 1000. */
+
+ if (*nu < nucut) {
+ goto L1000;
+ }
+ if (*nu >= nucut && *x <= anu) {
+ goto L2000;
+ }
+ if (*nu >= nucut && *x > anu) {
+ goto L3000;
+ }
+ ibran = 1;
+ fprintf(stderr,fmt_99,ibran);
+ return;
+
+/* TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE */
+/* (THAT IS, WHEN NU IS SMALLER THAN 1000). */
+/* METHOD UTILIZED--EXACT FINITE SUM */
+/* (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5). */
+
+L1000:
+ chi = sqrt(dx);
+ ievodd = *nu - (*nu / 2 << 1);
+ if (ievodd == 0) {
+ sum = 1.;
+ term = 1.;
+ imin = 2;
+ imax = *nu - 2;
+ }
+ else {
+ sum = 0.;
+ term = 1.f / chi;
+ imin = 1;
+ imax = *nu - 1;
+ }
+ if (imin <= imax)
+ for (i = imin; i <= imax; i += 2) {
+ ai = (doublereal) i;
+ term *= dx / ai;
+ sum += term;
+ }
+
+ sum *= exp(-dx / 2.);
+ if (ievodd != 0) {
+ sum *= sqrt(2. / pi);
+ spchi = (float)chi;
+ norcdf_(&spchi, &cdfn);
+ dcdfn = cdfn;
+ sum += (1. - dcdfn) * 2.;
+ }
+ *cdf = 1.f - (float)sum;
+ return;
+
+/* TREAT THE CASE WHEN NU IS LARGE */
+/* (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) */
+/* AND X IS LESS THAN OR EQUAL TO NU. */
+/* METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION */
+/* (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28). */
+
+L2000:
+ dfact = dnu * 4.5;
+ u = (float)(dx / dnu);
+ u = (float)((pow(u, dpower) - 1.0 + 1.0 / dfact) * sqrt(dfact));
+ norcdf_(&u, &cdfn);
+ *cdf = cdfn;
+ return;
+
+/* TREAT THE CASE WHEN NU IS LARGE */
+/* (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) */
+/* AND X IS LARGER THAN NU. */
+/* METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION */
+/* (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1). */
+
+L3000:
+ dw = sqrt(dx - dnu - dnu * log(dx / dnu));
+ danu = sqrt(2.0 / dnu);
+ d1 = dw;
+ d2 = dw * dw;
+ d3 = dw * d2;
+ term0 = dw;
+ term1 = b11 * danu;
+ danu2 = danu * danu;
+ term2 = b21 * d1 * danu2;
+ term3 = b31 * (d2 + b32) * danu * danu2;
+ term4 = b41 * (b42 * d3 + b43 * d1) * danu2 * danu2;
+ u = (float)(term0 + term1 + term2 + term3 + term4);
+ norcdf_(&u, &cdfn);
+ *cdf = cdfn;
+} /* chscdf_ */
+
+/* Subroutine */
+static void norcdf_(x, cdf)
+real *x, *cdf;
+{
+ /* Initialized data */
+ static real b1 = .31938153f;
+ static real b2 = -.356563782f;
+ static real b3 = 1.781477937f;
+ static real b4 = -1.821255978f;
+ static real b5 = 1.330274429f;
+ static real p = .2316419f;
+
+ /* System generated locals */
+ real tt;
+
+ /* Local variables */
+ static real t, z;
+
+/* PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) */
+/* DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. */
+/* THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS */
+/* THE PROBABILITY DENSITY FUNCTION */
+/* F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). */
+/* INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT */
+/* WHICH THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION IS TO BE EVALUATED. */
+/* OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE */
+/* DISTRIBUTION FUNCTION VALUE. */
+/* OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE CDF. */
+/* PRINTING--NONE. */
+/* RESTRICTIONS--NONE. */
+/* OTHER DATAPAC SUBROUTINES NEEDED--NONE. */
+/* FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. */
+/* MODE OF INTERNAL OPERATIONS--SINGLE PRECISION. */
+/* LANGUAGE--ANSI FORTRAN. */
+/* REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS */
+/* SERIES 55, 1964, PAGE 932, FORMULA 26.2.17. */
+/* --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE */
+/* DISTRIBUTIONS--1, 1970, PAGES 40-111. */
+/* WRITTEN BY--JAMES J. FILLIBEN */
+/* STATISTICAL ENGINEERING LABORATORY (205.03) */
+/* NATIONAL BUREAU OF STANDARDS */
+/* WASHINGTON, D. C. 20234 */
+/* PHONE: 301-921-2315 */
+/* ORIGINAL VERSION--JUNE 1972. */
+/* UPDATED --SEPTEMBER 1975. */
+/* UPDATED --NOVEMBER 1975. */
+/* */
+/* --------------------------------------------------------------------- */
+
+/* CHECK THE INPUT ARGUMENTS FOR ERRORS. */
+/* NO INPUT ARGUMENT ERRORS POSSIBLE FOR THIS DISTRIBUTION. */
+
+ z = *x;
+ if (z < 0.f)
+ z = -z;
+ t = 1.f / (p * z + 1.f);
+ tt = t*t;
+ *cdf = 1.f - (float)exp(z * -.5f * z) * .39894228040143f * (b1 * t + b2 * tt + b3 * t*tt + b4 * tt*tt + b5 * t*tt*tt);
+ if (*x < 0.f) {
+ *cdf = 1.f - *cdf;
+ }
+} /* norcdf_ */
+
+/* Subroutine */ void dchscdf_(x, nu, cdf)
+doublereal *x;
+integer *nu;
+doublereal *cdf;
+{
+ /* Initialized data */
+ static integer nucut = 1000;
+ static doublereal b43 = 17.;
+ static doublereal pi = 3.14159265358979;
+ static doublereal dpower = .333333333333333333;
+ static doublereal b11 = .333333333333333333;
+ static doublereal b21 = -.027777777777777778;
+ static doublereal b31 = -6.1728395061e-4;
+ static doublereal b32 = -13.;
+ static doublereal b41 = 1.8004115226e-4;
+ static doublereal b42 = 6.;
+
+ /* Error strings */
+ static char fmt_15[] = "(***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE CHSCDF SUBROUTINE IS NON-POSITIVE *****)";
+ static char fmt_47[] = "(***** THE VALUE OF THE ARGUMENT IS %d *****\002)";
+ static char fmt_4[] = "(***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMENT TO THE CHSCDF SUBROUTINE IS NEGATIVE *****)";
+ static char fmt_46[] = "(***** THE VALUE OF THE ARGUMENT IS %f *****\002)";
+ static char fmt_99[] = "(*****INTERNAL ERROR IN CHSCDF SUBROUTINE -- IMPOSSIBLE BRANCH CONDITION AT BRANCH POINT %d)";
+
+ /* System generated locals */
+ doublereal danu2;
+
+ /* Local variables */
+ static doublereal cdfn, danu;
+ static integer imin, imax;
+ static doublereal term, term0, term1, term2, term3, term4;
+ static integer i;
+ static doublereal dcdfn, dfact;
+ static doublereal amean, u, z;
+ static integer ibran;
+ static doublereal spchi;
+ static doublereal d1, d2, d3, ai;
+ static doublereal sd;
+ static doublereal dw, dx;
+ static integer ievodd;
+ static doublereal chi;
+ static doublereal anu;
+ static doublereal dnu;
+ static doublereal sum;
+
+/* PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION */
+/* WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU. */
+/* THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X. */
+/* THE PROBABILITY DENSITY FUNCTION IS GIVEN */
+/* IN THE REFERENCES BELOW. */
+/* INPUT ARGUMENTS--X = THE DOUBLE PRECISION VALUE AT */
+/* WHICH THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION IS TO BE EVALUATED. */
+/* X SHOULD BE NON-NEGATIVE. */
+/* --NU = THE INTEGER NUMBER OF DEGREES */
+/* OF FREEDOM. */
+/* NU SHOULD BE POSITIVE. */
+/* OUTPUT ARGUMENTS--CDF = THE DOUBLE PRECISION CUMULATIVE */
+/* DISTRIBUTION FUNCTION VALUE. */
+/* OUTPUT--THE DOUBLE PRECISION CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION */
+/* WITH DEGREES OF FREEDOM PARAMETER = NU. */
+/* PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. */
+/* RESTRICTIONS--X SHOULD BE NON-NEGATIVE. */
+/* --NU SHOULD BE A POSITIVE INTEGER VARIABLE. */
+/* OTHER DATAPAC SUBROUTINES NEEDED--NORCDF. */
+/* FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP. */
+/* MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. */
+/* LANGUAGE--ANSI FORTRAN. */
+/* REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS */
+/* SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5.*/
+/* --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE */
+/* DISTRIBUTIONS--1, 1970, PAGE 176, */
+/* FORMULA 28, AND PAGE 180, FORMULA 33.1. */
+/* --OWEN, HANDBOOK OF STATISTICAL TABLES, */
+/* 1962, PAGES 50-55. */
+/* --PEARSON AND HARTLEY, BIOMETRIKA TABLES */
+/* FOR STATISTICIANS, VOLUME 1, 1954, */
+/* PAGES 122-131. */
+/* WRITTEN BY--JAMES J. FILLIBEN */
+/* STATISTICAL ENGINEERING LABORATORY (205.03) */
+/* NATIONAL BUREAU OF STANDARDS */
+/* WASHINGTON, D. C. 20234 */
+/* PHONE: 301-921-2315 */
+/* ORIGINAL VERSION--JUNE 1972. */
+/* UPDATED --MAY 1974. */
+/* UPDATED --SEPTEMBER 1975. */
+/* UPDATED --NOVEMBER 1975. */
+/* UPDATED --OCTOBER 1976. */
+/* */
+/* --------------------------------------------------------------------- */
+
+/* CHECK THE INPUT ARGUMENTS FOR ERRORS */
+
+ if (*nu <= 0) {
+ fprintf(stderr,fmt_15);
+ fprintf(stderr,fmt_47,*nu);
+ *cdf = 0.0;
+ return;
+ }
+ if (*x < 0.0) {
+ fprintf(stderr,fmt_4);
+ fprintf(stderr,fmt_46,*x);
+ *cdf = 0.0;
+ return;
+ }
+
+ dx = *x;
+ anu = (doublereal) (*nu);
+ dnu = (doublereal) (*nu);
+
+/* IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN. */
+/* IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 */
+/* STANDARD DEVIATIONS BELOW THE MEAN, */
+/* SET CDF = 0.0 AND RETURN. */
+/* IF NU IS 10 OR LARGER AND X IS MORE THAN 100 */
+/* STANDARD DEVIATIONS BELOW THE MEAN, */
+/* SET CDF = 0.0 AND RETURN. */
+/* IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200 */
+/* STANDARD DEVIATIONS ABOVE THE MEAN, */
+/* SET CDF = 1.0 AND RETURN. */
+/* IF NU IS 10 OR LARGER AND X IS MORE THAN 100 */
+/* STANDARD DEVIATIONS ABOVE THE MEAN, */
+/* SET CDF = 1.0 AND RETURN. */
+
+ if (*x <= 0.0) {
+ *cdf = 0.0;
+ return;
+ }
+ amean = anu;
+ sd = sqrt(anu * 2.0);
+ z = (*x - amean) / sd;
+ if (*nu < 10 && z < -200.0) {
+ *cdf = 0.0;
+ return;
+ }
+ if (*nu >= 10 && z < -100.0) {
+ *cdf = 0.0;
+ return;
+ }
+ if (*nu < 10 && z > 200.0) {
+ *cdf = 1.0;
+ return;
+ }
+ if (*nu >= 10 && z > 100.0) {
+ *cdf = 1.0;
+ return;
+ }
+
+/* DISTINGUISH BETWEEN 3 SEPARATE REGIONS */
+/* OF THE (X,NU) SPACE. */
+/* BRANCH TO THE PROPER COMPUTATIONAL METHOD */
+/* DEPENDING ON THE REGION. */
+/* NUCUT HAS THE VALUE 1000. */
+
+ if (*nu < nucut) {
+ goto L1000;
+ }
+ if (*nu >= nucut && *x <= anu) {
+ goto L2000;
+ }
+ if (*nu >= nucut && *x > anu) {
+ goto L3000;
+ }
+ ibran = 1;
+ fprintf(stderr,fmt_99,ibran);
+ return;
+
+/* TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE */
+/* (THAT IS, WHEN NU IS SMALLER THAN 1000). */
+/* METHOD UTILIZED--EXACT FINITE SUM */
+/* (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5). */
+
+L1000:
+ chi = sqrt(dx);
+ ievodd = *nu - (*nu / 2 << 1);
+ if (ievodd == 0) {
+ sum = 1.;
+ term = 1.;
+ imin = 2;
+ imax = *nu - 2;
+ }
+ else {
+ sum = 0.;
+ term = 1.0 / chi;
+ imin = 1;
+ imax = *nu - 1;
+ }
+ if (imin <= imax)
+ for (i = imin; i <= imax; i += 2) {
+ ai = (doublereal) i;
+ term *= dx / ai;
+ sum += term;
+ }
+
+ sum *= exp(-dx / 2.);
+ if (ievodd != 0) {
+ sum *= sqrt(2. / pi);
+ spchi = chi;
+ dnorcdf_(&spchi, &cdfn);
+ dcdfn = cdfn;
+ sum += (1. - dcdfn) * 2.;
+ }
+ *cdf = 1.0 - sum;
+ if (*cdf < 0.0) *cdf = 0.0;
+ return;
+
+/* TREAT THE CASE WHEN NU IS LARGE */
+/* (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) */
+/* AND X IS LESS THAN OR EQUAL TO NU. */
+/* METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION */
+/* (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28). */
+
+L2000:
+ dfact = dnu * 4.5;
+ u = dx / dnu;
+ u = (pow(u, dpower) - 1.0 + 1.0 / dfact) * sqrt(dfact);
+ dnorcdf_(&u, &cdfn);
+ *cdf = cdfn;
+ return;
+
+/* TREAT THE CASE WHEN NU IS LARGE */
+/* (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000) */
+/* AND X IS LARGER THAN NU. */
+/* METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION */
+/* (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1). */
+
+L3000:
+ dw = sqrt(dx - dnu - dnu * log(dx / dnu));
+ danu = sqrt(2.0 / dnu);
+ d1 = dw;
+ d2 = dw * dw;
+ d3 = dw * d2;
+ term0 = dw;
+ term1 = b11 * danu;
+ danu2 = danu * danu;
+ term2 = b21 * d1 * danu2;
+ term3 = b31 * (d2 + b32) * danu * danu2;
+ term4 = b41 * (b42 * d3 + b43 * d1) * danu2 * danu2;
+ u = term0 + term1 + term2 + term3 + term4;
+ dnorcdf_(&u, &cdfn);
+ *cdf = cdfn;
+} /* dchscdf_ */
+
+/* Subroutine */
+static void dnorcdf_(x, cdf)
+doublereal *x, *cdf;
+{
+ /* Initialized data */
+ static doublereal b1 = .31938153;
+ static doublereal b2 = -.356563782;
+ static doublereal b3 = 1.781477937;
+ static doublereal b4 = -1.821255978;
+ static doublereal b5 = 1.330274429;
+ static doublereal p = .2316419;
+
+ /* System generated locals */
+ doublereal tt;
+
+ /* Local variables */
+ static doublereal t, z;
+
+
+/* PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE FOR THE NORMAL (GAUSSIAN) */
+/* DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1. */
+/* THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS */
+/* THE PROBABILITY DENSITY FUNCTION */
+/* F(X) = (1/SQRT(2*PI))*EXP(-X*X/2). */
+/* INPUT ARGUMENTS--X = THE DOUBLE PRECISION VALUE AT */
+/* WHICH THE CUMULATIVE DISTRIBUTION */
+/* FUNCTION IS TO BE EVALUATED. */
+/* OUTPUT ARGUMENTS--CDF = THE DOUBLE PRECISION CUMULATIVE */
+/* DISTRIBUTION FUNCTION VALUE. */
+/* OUTPUT--THE DOUBLE PRECISION CUMULATIVE DISTRIBUTION */
+/* FUNCTION VALUE CDF. */
+/* PRINTING--NONE. */
+/* RESTRICTIONS--NONE. */
+/* OTHER DATAPAC SUBROUTINES NEEDED--NONE. */
+/* FORTRAN LIBRARY SUBROUTINES NEEDED--EXP. */
+/* MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION. */
+/* LANGUAGE--ANSI FORTRAN. */
+/* REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS */
+/* SERIES 55, 1964, PAGE 932, FORMULA 26.2.17. */
+/* --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE */
+/* DISTRIBUTIONS--1, 1970, PAGES 40-111. */
+/* WRITTEN BY--JAMES J. FILLIBEN */
+/* STATISTICAL ENGINEERING LABORATORY (205.03) */
+/* NATIONAL BUREAU OF STANDARDS */
+/* WASHINGTON, D. C. 20234 */
+/* PHONE: 301-921-2315 */
+/* ORIGINAL VERSION--JUNE 1972. */
+/* UPDATED --SEPTEMBER 1975. */
+/* UPDATED --NOVEMBER 1975. */
+/* */
+/* --------------------------------------------------------------------- */
+
+/* CHECK THE INPUT ARGUMENTS FOR ERRORS. */
+/* NO INPUT ARGUMENT ERRORS POSSIBLE FOR THIS DISTRIBUTION. */
+
+ z = *x;
+ if (z < 0.0)
+ z = -z;
+ t = 1.0 / (p * z + 1.0);
+ tt = t*t;
+ *cdf = 1.0 - exp(z * -.5 * z) * .39894228040143 * (b1 * t + b2 * tt + b3 * t*tt + b4 * tt*tt + b5 * t*tt*tt);
+ if (*x < 0.0)
+ *cdf = 1.0 - *cdf;
+ if (*cdf < 0.0)
+ *cdf = 0.0;
+} /* dnorcdf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.f
new file mode 100644
index 0000000000000000000000000000000000000000..4ed48499b3f71c442a5ba31809257e8b9b1c2142
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/camsun.f
@@ -0,0 +1,278 @@
+ SUBROUTINE CHSCDF(X,NU,CDF)
+C
+C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
+C FUNCTION VALUE FOR THE CHI-SQUARED DISTRIBUTION
+C WITH INTEGER DEGREES OF FREEDOM PARAMETER = NU.
+C THIS DISTRIBUTION IS DEFINED FOR ALL NON-NEGATIVE X.
+C THE PROBABILITY DENSITY FUNCTION IS GIVEN
+C IN THE REFERENCES BELOW.
+C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT
+C WHICH THE CUMULATIVE DISTRIBUTION
+C FUNCTION IS TO BE EVALUATED.
+C X SHOULD BE NON-NEGATIVE.
+C --NU = THE INTEGER NUMBER OF DEGREES
+C OF FREEDOM.
+C NU SHOULD BE POSITIVE.
+C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE
+C DISTRIBUTION FUNCTION VALUE.
+C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
+C FUNCTION VALUE CDF FOR THE CHI-SQUARED DISTRIBUTION
+C WITH DEGREES OF FREEDOM PARAMETER = NU.
+C PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
+C RESTRICTIONS--X SHOULD BE NON-NEGATIVE.
+C --NU SHOULD BE A POSITIVE INTEGER VARIABLE.
+C OTHER DATAPAC SUBROUTINES NEEDED--NORCDF.
+C FORTRAN LIBRARY SUBROUTINES NEEDED--DSQRT, DEXP.
+C MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
+C LANGUAGE--ANSI FORTRAN.
+C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
+C SERIES 55, 1964, PAGE 941, FORMULAE 26.4.4 AND 26.4.5.
+C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
+C DISTRIBUTIONS--1, 1970, PAGE 176,
+C FORMULA 28, AND PAGE 180, FORMULA 33.1.
+C --OWEN, HANDBOOK OF STATISTICAL TABLES,
+C 1962, PAGES 50-55.
+C --PEARSON AND HARTLEY, BIOMETRIKA TABLES
+C FOR STATISTICIANS, VOLUME 1, 1954,
+C PAGES 122-131.
+C WRITTEN BY--JAMES J. FILLIBEN
+C STATISTICAL ENGINEERING LABORATORY (205.03)
+C NATIONAL BUREAU OF STANDARDS
+C WASHINGTON, D. C. 20234
+C PHONE: 301-921-2315
+C ORIGINAL VERSION--JUNE 1972.
+C UPDATED --MAY 1974.
+C UPDATED --SEPTEMBER 1975.
+C UPDATED --NOVEMBER 1975.
+C UPDATED --OCTOBER 1976.
+C
+C---------------------------------------------------------------------
+C
+ DOUBLE PRECISION DX,PI,CHI,SUM,TERM,AI,DCDFN
+ DOUBLE PRECISION DNU
+ DOUBLE PRECISION DSQRT,DEXP
+ DOUBLE PRECISION DLOG
+ DOUBLE PRECISION DFACT,DPOWER
+ DOUBLE PRECISION DW
+ DOUBLE PRECISION D1,D2,D3
+ DOUBLE PRECISION TERM0,TERM1,TERM2,TERM3,TERM4
+ DOUBLE PRECISION B11
+ DOUBLE PRECISION B21
+ DOUBLE PRECISION B31,B32
+ DOUBLE PRECISION B41,B42,B43
+ DATA NUCUT/1000/
+ DATA PI/3.14159265358979D0/
+ DATA DPOWER/0.33333333333333D0/
+ DATA B11/0.33333333333333D0/
+ DATA B21/-0.02777777777778D0/
+ DATA B31/-0.00061728395061D0/
+ DATA B32/-13.0D0/
+ DATA B41/0.00018004115226D0/
+ DATA B42/6.0D0/
+ DATA B43/17.0D0/
+C
+ IPR=6
+C
+C CHECK THE INPUT ARGUMENTS FOR ERRORS
+C
+ IF(NU.LE.0)GOTO50
+ IF(X.LT.0.0)GOTO55
+ GOTO90
+ 50 WRITE(IPR,15)
+ WRITE(IPR,47)NU
+ CDF=0.0
+ RETURN
+ 55 WRITE(IPR,4)
+ WRITE(IPR,46)X
+ CDF=0.0
+ RETURN
+ 90 CONTINUE
+ 4 FORMAT(1H , 96H***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUME
+ 1NT TO THE CHSCDF SUBROUTINE IS NEGATIVE *****)
+ 15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
+ 1 CHSCDF SUBROUTINE IS NON-POSITIVE *****)
+ 46 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
+ 47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8 ,6H *****)
+C
+C-----START POINT-----------------------------------------------------
+C
+ DX=X
+ ANU=NU
+ DNU=NU
+C
+C IF X IS NON-POSITIVE, SET CDF = 0.0 AND RETURN.
+C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200
+C STANDARD DEVIATIONS BELOW THE MEAN,
+C SET CDF = 0.0 AND RETURN.
+C IF NU IS 10 OR LARGER AND X IS MORE THAN 100
+C STANDARD DEVIATIONS BELOW THE MEAN,
+C SET CDF = 0.0 AND RETURN.
+C IF NU IS SMALLER THAN 10 AND X IS MORE THAN 200
+C STANDARD DEVIATIONS ABOVE THE MEAN,
+C SET CDF = 1.0 AND RETURN.
+C IF NU IS 10 OR LARGER AND X IS MORE THAN 100
+C STANDARD DEVIATIONS ABOVE THE MEAN,
+C SET CDF = 1.0 AND RETURN.
+C
+ IF(X.LE.0.0)GOTO105
+ AMEAN=ANU
+ SD=SQRT(2.0*ANU)
+ Z=(X-AMEAN)/SD
+ IF(NU.LT.10.AND.Z.LT.-200.0)GOTO105
+ IF(NU.GE.10.AND.Z.LT.-100.0)GOTO105
+ IF(NU.LT.10.AND.Z.GT.200.0)GOTO107
+ IF(NU.GE.10.AND.Z.GT.100.0)GOTO107
+ GOTO109
+ 105 CDF=0.0
+ RETURN
+ 107 CDF=1.0
+ RETURN
+ 109 CONTINUE
+C
+C DISTINGUISH BETWEEN 3 SEPARATE REGIONS
+C OF THE (X,NU) SPACE.
+C BRANCH TO THE PROPER COMPUTATIONAL METHOD
+C DEPENDING ON THE REGION.
+C NUCUT HAS THE VALUE 1000.
+C
+ IF(NU.LT.NUCUT)GOTO1000
+ IF(NU.GE.NUCUT.AND.X.LE.ANU)GOTO2000
+ IF(NU.GE.NUCUT.AND.X.GT.ANU)GOTO3000
+ IBRAN=1
+ WRITE(IPR,99)IBRAN
+ 99 FORMAT(1H ,42H*****INTERNAL ERROR IN CHSCDF SUBROUTINE--,
+ 146HIMPOSSIBLE BRANCH CONDITION AT BRANCH POINT = ,I8)
+ RETURN
+C
+C TREAT THE SMALL AND MODERATE DEGREES OF FREEDOM CASE
+C (THAT IS, WHEN NU IS SMALLER THAN 1000).
+C METHOD UTILIZED--EXACT FINITE SUM
+C (SEE AMS 55, PAGE 941, FORMULAE 26.4.4 AND 26.4.5).
+C
+ 1000 CONTINUE
+ CHI=DSQRT(DX)
+ IEVODD=NU-2*(NU/2)
+ IF(IEVODD.EQ.0)GOTO120
+C
+ SUM=0.0D0
+ TERM=1.0/CHI
+ IMIN=1
+ IMAX=NU-1
+ GOTO130
+C
+ 120 SUM=1.0D0
+ TERM=1.0D0
+ IMIN=2
+ IMAX=NU-2
+C
+ 130 IF(IMIN.GT.IMAX)GOTO160
+ DO100I=IMIN,IMAX,2
+ AI=I
+ TERM=TERM*(DX/AI)
+ SUM=SUM+TERM
+ 100 CONTINUE
+ 160 CONTINUE
+C
+ SUM=SUM*DEXP(-DX/2.0D0)
+ IF(IEVODD.EQ.0)GOTO170
+ SUM=(DSQRT(2.0D0/PI))*SUM
+ SPCHI=CHI
+ CALL NORCDF(SPCHI,CDFN)
+ DCDFN=CDFN
+ SUM=SUM+2.0D0*(1.0D0-DCDFN)
+ 170 CDF=1.0D0-SUM
+ RETURN
+C
+C TREAT THE CASE WHEN NU IS LARGE
+C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000)
+C AND X IS LESS THAN OR EQUAL TO NU.
+C METHOD UTILIZED--WILSON-HILFERTY APPROXIMATION
+C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 176, FORMULA 28).
+C
+ 2000 CONTINUE
+ DFACT=4.5D0*DNU
+ U=(((DX/DNU)**DPOWER)-1.0D0+(1.0D0/DFACT))*DSQRT(DFACT)
+ CALL NORCDF(U,CDFN)
+ CDF=CDFN
+ RETURN
+C
+C TREAT THE CASE WHEN NU IS LARGE
+C (THAT IS, WHEN NU IS EQUAL TO OR GREATER THAN 1000)
+C AND X IS LARGER THAN NU.
+C METHOD UTILIZED--HILL'S ASYMPTOTIC EXPANSION
+C (SEE JOHNSON AND KOTZ, VOLUME 1, PAGE 180, FORMULA 33.1).
+C
+ 3000 CONTINUE
+ DW=DSQRT(DX-DNU-DNU*DLOG(DX/DNU))
+ DANU=DSQRT(2.0D0/DNU)
+ D1=DW
+ D2=DW**2
+ D3=DW**3
+ TERM0=DW
+ TERM1=B11*DANU
+ TERM2=B21*D1*(DANU**2)
+ TERM3=B31*(D2+B32)*(DANU**3)
+ TERM4=B41*(B42*D3+B43*D1)*(DANU**4)
+ U=TERM0+TERM1+TERM2+TERM3+TERM4
+ CALL NORCDF(U,CDFN)
+ CDF=CDFN
+ RETURN
+C
+ END
+* NORCDF
+ SUBROUTINE NORCDF(X,CDF)
+C
+C PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
+C FUNCTION VALUE FOR THE NORMAL (GAUSSIAN)
+C DISTRIBUTION WITH MEAN = 0 AND STANDARD DEVIATION = 1.
+C THIS DISTRIBUTION IS DEFINED FOR ALL X AND HAS
+C THE PROBABILITY DENSITY FUNCTION
+C F(X) = (1/SQRT(2*PI))*EXP(-X*X/2).
+C INPUT ARGUMENTS--X = THE SINGLE PRECISION VALUE AT
+C WHICH THE CUMULATIVE DISTRIBUTION
+C FUNCTION IS TO BE EVALUATED.
+C OUTPUT ARGUMENTS--CDF = THE SINGLE PRECISION CUMULATIVE
+C DISTRIBUTION FUNCTION VALUE.
+C OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
+C FUNCTION VALUE CDF.
+C PRINTING--NONE.
+C RESTRICTIONS--NONE.
+C OTHER DATAPAC SUBROUTINES NEEDED--NONE.
+C FORTRAN LIBRARY SUBROUTINES NEEDED--EXP.
+C MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
+C LANGUAGE--ANSI FORTRAN.
+C REFERENCES--NATIONAL BUREAU OF STANDARDS APPLIED MATHEMATICS
+C SERIES 55, 1964, PAGE 932, FORMULA 26.2.17.
+C --JOHNSON AND KOTZ, CONTINUOUS UNIVARIATE
+C DISTRIBUTIONS--1, 1970, PAGES 40-111.
+C WRITTEN BY--JAMES J. FILLIBEN
+C STATISTICAL ENGINEERING LABORATORY (205.03)
+C NATIONAL BUREAU OF STANDARDS
+C WASHINGTON, D. C. 20234
+C PHONE: 301-921-2315
+C ORIGINAL VERSION--JUNE 1972.
+C UPDATED --SEPTEMBER 1975.
+C UPDATED --NOVEMBER 1975.
+C
+C---------------------------------------------------------------------
+C
+ DATA B1,B2,B3,B4,B5,P/.319381530,-0.356563782,1.781477937,-1.82125
+ 15978,1.330274429,.2316419/
+C
+ IPR=6
+C
+C CHECK THE INPUT ARGUMENTS FOR ERRORS.
+C NO INPUT ARGUMENT ERRORS POSSIBLE
+C FOR THIS DISTRIBUTION.
+C
+C-----START POINT-----------------------------------------------------
+C
+ Z=X
+ IF(X.LT.0.0)Z=-Z
+ T=1.0/(1.0+P*Z)
+ CDF=1.0-((0.39894228040143 )*EXP(-0.5*Z*Z))*(B1*T+B2*T**2+B3*T**3
+ 1+B4*T**4+B5*T**5)
+ IF(X.LT.0.0)CDF=1.0-CDF
+C
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..487124359d132cdf85aeda566d693d9f66484e18
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.c
@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+
+/* Subroutine */ void caxpy_(n, ca, cx, incx, cy, incy)
+const integer *n;
+const complex *ca, *cx;
+const integer *incx;
+complex *cy;
+const integer *incy;
+{
+ /* System generated locals */
+ complex q__1;
+
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* constant times a vector plus a vector. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (ca->r == 0.f && ca->i == 0.f) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ q__1.r = ca->r * cx[i].r - ca->i * cx[i].i,
+ q__1.i = ca->r * cx[i].i + ca->i * cx[i].r;
+ cy[i].r += q__1.r, cy[i].i += q__1.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ q__1.r = ca->r * cx[ix].r - ca->i * cx[ix].i,
+ q__1.i = ca->r * cx[ix].i + ca->i * cx[ix].r;
+ cy[iy].r += q__1.r, cy[iy].i += q__1.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* caxpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..7037c5a54ce23cb946b6a6cd061d4211a262242f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/caxpy.f
@@ -0,0 +1,34 @@
+ subroutine caxpy(n,ca,cx,incx,cy,incy)
+c
+c constant times a vector plus a vector.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ complex cx(*),cy(*),ca
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if (abs(real(ca)) + abs(aimag(ca)) .eq. 0.0 ) return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ cy(iy) = cy(iy) + ca*cx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ cy(i) = cy(i) + ca*cx(i)
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.c
new file mode 100644
index 0000000000000000000000000000000000000000..9ecdc673fe1fa12dde4cc4236dd07c84ff44ce0f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.c
@@ -0,0 +1,41 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void ccopy_(n, cx, incx, cy, incy)
+const integer *n;
+const complex *cx;
+const integer *incx;
+complex *cy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* copies a vector, x, to a vector, y. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ cy[i].r = cx[i].r, cy[i].i = cx[i].i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ cy[iy].r = cx[ix].r, cy[iy].i = cx[ix].i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* ccopy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.f
new file mode 100644
index 0000000000000000000000000000000000000000..61d5267e55ff5f183d703a4445bf3a3b7bfe618f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ccopy.f
@@ -0,0 +1,33 @@
+ subroutine ccopy(n,cx,incx,cy,incy)
+c
+c copies a vector, x, to a vector, y.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ complex cx(*),cy(*)
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ cy(iy) = cx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ cy(i) = cx(i)
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.c
new file mode 100644
index 0000000000000000000000000000000000000000..b18b2cbeafe633ad6638b1b2861d18edeed83fde
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.c
@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Complex */ void cdotc_( ret_val, n, cx, incx, cy, incy)
+complex *ret_val;
+const integer *n;
+const complex *cx;
+const integer *incx;
+const complex *cy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i;
+ static complex ctemp;
+ static integer ix, iy;
+
+/* forms the dot product of two vectors, conjugating the first vector */
+/* */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ ret_val->r = 0.f, ret_val->i = 0.f;
+ return;
+ }
+ ctemp.r = 0.f, ctemp.i = 0.f;
+
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ctemp.r += cx[i].r * cy[i].r + cx[i].i * cy[i].i,
+ ctemp.i += cx[i].r * cy[i].i - cx[i].i * cy[i].r;
+ }
+ ret_val->r = ctemp.r, ret_val->i = ctemp.i;
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ctemp.r += cx[ix].r * cy[iy].r + cx[ix].i * cy[iy].i,
+ ctemp.i += cx[ix].r * cy[iy].i - cx[ix].i * cy[iy].r;
+ ix += *incx; iy += *incy;
+ }
+ ret_val->r = ctemp.r, ret_val->i = ctemp.i;
+ }
+} /* cdotc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.f
new file mode 100644
index 0000000000000000000000000000000000000000..1d5890596fd58d031821a33f19b8394dd58268f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cdotc.f
@@ -0,0 +1,38 @@
+ complex function cdotc(n,cx,incx,cy,incy)
+c
+c forms the dot product of two vectors, conjugating the first
+c vector.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ complex cx(*),cy(*),ctemp
+ integer i,incx,incy,ix,iy,n
+c
+ ctemp = (0.0,0.0)
+ cdotc = (0.0,0.0)
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ctemp = ctemp + conjg(cx(ix))*cy(iy)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ cdotc = ctemp
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ ctemp = ctemp + conjg(cx(i))*cy(i)
+ 30 continue
+ cdotc = ctemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.c
new file mode 100644
index 0000000000000000000000000000000000000000..8893289be677e5f7173be5afe5c04d0fdeee5e22
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.c
@@ -0,0 +1,840 @@
+#include "f2c.h"
+#include "netlib.h"
+#include <assert.h>
+#include <stdio.h>
+extern double log(double), exp(double), sqrt(double); /* #include <math.h> */
+
+static doublereal fv_(doublereal *a, doublereal *x, doublereal *h, const integer *n, doublereal (*value)(doublereal*));
+static doublereal fd_(doublereal *a, doublereal *x, doublereal *h, const integer *n, void (*grad)(doublereal*,doublereal*));
+static void fvd_(doublereal *v, doublereal *d, doublereal *a, doublereal *x, doublereal *h, const integer *n,
+ void (*both)(doublereal*,doublereal*,doublereal*));
+static void cub_(doublereal *x, doublereal *a, doublereal *b, doublereal *c, doublereal *d, doublereal *e, doublereal *f);
+static void ins_(doublereal *s, doublereal *f, doublereal *a, doublereal *b, doublereal *c,
+ doublereal *fa, doublereal *fb, doublereal *fc, integer *j, doublereal *y, doublereal *z);
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+#ifdef DEBUG
+/* Table of constant values */
+static integer c__9 = 9;
+static integer c__1 = 1;
+#endif
+
+/* ________________________________________________________ */
+/* | | */
+/* | MINIMIZE A FUNCTION USING THE FLETCHER-REEVES FORM | */
+/* | OF THE CONJUGATE GRADIENT METHOD | */
+/* | WITH (OR WITHOUT) PRECONDITIONING | */
+/* | | */
+/* | INPUT: | */
+/* | | */
+/* | X --ARRAY CONTAINING STARTING GUESS | */
+/* | | */
+/* | STEP --STARTING GUESS FOR MINIMIZER IN DIREC- | */
+/* | TION OF NEGATIVE GRADIENT DURING FIRST | */
+/* | ITERATION (E. G. STEP=1) WHEN STEP=0, | */
+/* | THE PROGRAM SELECTS A STARTING GUESS | */
+/* | | */
+/* | T --COMPUTING TOLERANCE (ITERATIONS STOP | */
+/* | WHEN MAX-NORM OF GRADIENT .LE. T) | */
+/* | | */
+/* | LIMIT --MAXIMUM NUMBER OF ITERATIONS | */
+/* | | */
+/* | N --NUMBER OF UNKNOWNS | */
+/* | | */
+/* | M --NUMBER OF ITERATIONS UNTIL THE SEARCH | */
+/* | DIRECTIONS ARE RENORMALIZED ALONG THE | */
+/* | NEGATIVE GRADIENT (TYPICALLY, M = N) | */
+/* | | */
+/* | VALUE --NAME OF COST EVALUATION FUNC. ROUTINE | */
+/* | (EXTERNAL IN MAIN PROGRAM) | */
+/* | VALUE(X) IS VALUE OF COST AT X | */
+/* | | */
+/* | GRAD --NAME OF GRADIENT EVALUATION SUBROUTINE | */
+/* | (EXTERNAL IN MAIN PROGRAM) | */
+/* | GRAD(G,X) PUTS IN G THE GRADIENT AT X | */
+/* | | */
+/* | BOTH --NAME SUBROUTINE TO EVALUATE BOTH COST | */
+/* | AND ITS GRADIENT (EXTERNAL IN MAIN | */
+/* | PROGRAM) BOTH(V,G,X) PUTS THE VALUE IN | */
+/* | V AND THE GRADIENT IN G FOR THE POINT X| */
+/* | | */
+/* | PRE --NAME OF PRECONDITIONING SUBROUTINE | */
+/* | (EXTERNAL IN MAIN PROGRAM) | */
+/* | PRE(Y,Z) APPLIES THE PRECONDITIONER TO | */
+/* | Z, STORING THE RESULT IN Y. | */
+/* | IF PRECONDITIONING NOT USED SET Y = Z | */
+/* | | */
+/* | H --WORK ARRAY (LENGTH AT LEAST 3N) | */
+/* | | */
+/* | OUTPUT: | */
+/* | | */
+/* | X --MINIMIZER | */
+/* | | */
+/* | E --MAX-NORM OF GRADIENT | */
+/* | | */
+/* | IT --NUMBER OF ITERATIONS PERFORMED | */
+/* | | */
+/* | STEP --STEP SIZE ALONG SEARCH DIRECTION FOR | */
+/* | FINAL ITERATION | */
+/* | | */
+/* | BUILTIN FUNCTIONS: DABS,DEXP,IDINT,DLOG,DSQRT,DMAX1,| */
+/* | DMIN1,DSIGN | */
+/* | PACKAGE ROUTINES: CUB,FD,FV,FVD,INS | */
+/* |________________________________________________________| */
+
+/* Subroutine */ void cg_(x, e, it, step, t, limit, n, m, value, grad, both, pre, h)
+doublereal *x, *e;
+integer *it;
+doublereal *step;
+const doublereal *t;
+const integer *limit, *n, *m;
+doublereal (*value) (doublereal*);
+void (*grad) (doublereal*,doublereal*);
+void (*both) (doublereal*,doublereal*,doublereal*);
+void (*pre) (doublereal*,doublereal*);
+doublereal *h;
+{
+ /* Initialized data */
+ static doublereal a1 = .1;
+ static doublereal a2 = .9;
+ static doublereal a3 = 5.;
+ static doublereal a4 = .2;
+ static doublereal a5 = 10.;
+ static doublereal a6 = .9;
+ static doublereal a7 = .3;
+
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal a, b, c, d, f, g;
+ static integer i, j, k, l;
+ static doublereal p, q, r, s, v, w, y[50], z[50], a8, c0, c1, d0, f0, f1, l3, da, db, fa, fb, fc;
+ static integer na, nb, nc, nd, iq;
+
+#ifdef DEBUG
+ /* Fortran I/O blocks */
+ static cilist io___43 = { 0, 6, 0, 0, 0 };
+ static cilist io___44 = { 0, 6, 0, 0, 0 };
+ static cilist io___45 = { 0, 6, 0, 0, 0 };
+ static cilist io___46 = { 0, 6, 0, 0, 0 };
+#endif
+
+ a8 = a3 + .01;
+ *it = 0;
+ (*both)(&f, &h[*n * 2], x);
+ *e = 0.f;
+ for (i = 0; i < *n; ++i) {
+ if (abs(h[i + *n * 2]) > *e) {
+ *e = abs(h[i + *n * 2]);
+ }
+ }
+ if (*e <= *t) {
+ return;
+ }
+ l3 = 1.f / log(a3);
+ (*pre)(&h[*n], &h[*n * 2]);
+ a = *step;
+ if (a <= 0.) {
+ for (i = 0; i < *n; ++i) {
+ if (abs(x[i]) > a) {
+ a = abs(x[i]);
+ }
+ }
+ a *= .01f / *e;
+ if (a == 0.) {
+ a = 1.f;
+ }
+ }
+ g = 0.f;
+ for (i = 0; i < *n; ++i) {
+ g += h[i + *n] * h[i + *n * 2];
+ }
+ if (g < 0.) {
+ goto L620;
+ }
+L50:
+ l = 0;
+ for (i = 0; i < *n; ++i) {
+ h[i] = -h[i+*n];
+ }
+ d = -g;
+L70:
+ fa = fv_(&a, x, h, n, value);
+ c0 = a;
+ f0 = fa;
+ j = 2;
+ y[0] = 0.f;
+ z[0] = f;
+ y[1] = a;
+ z[1] = fa;
+ v = a1 * d;
+ w = a2 * d;
+ iq = 0;
+ if (fa > f) {
+ c = a; b = 0.f; a = 0.f;
+ fc = fa; fb = f; fa = f;
+ }
+ else {
+ c = 0.f; b = 0.f;
+ fc = f; fb = f;
+ iq = 1;
+ }
+ na = 0; nb = 0; nc = 0; nd = 0;
+ q = (d + (f - f0) / c0) / c0;
+ if (q < 0.) {
+ goto L110;
+ }
+ q = a;
+L100:
+ ++nd;
+ if (nd > 25) {
+ goto L610;
+ }
+ q *= a3;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f < w * q) {
+ goto L100;
+ }
+ goto L260;
+L110:
+ q = d * .5f / q;
+ if (q < c0 * .01f) {
+ q = c0 * .01f;
+ }
+ p = fv_(&q, x, h, n, value);
+ if (p > f0) {
+ f1 = f0; c1 = c0;
+ f0 = p; c0 = q;
+ }
+ else {
+ f1 = p; c1 = q;
+ }
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+L135:
+ if (a == 0.) {
+ goto L140;
+ }
+ if (fa - f >= v * a) {
+ goto L160;
+ }
+ if (fa - f < w * a) {
+ goto L210;
+ }
+ goto L280;
+L140:
+ q = c0;
+ if (c1 < q) {
+ q = c1;
+ }
+L150:
+ ++na;
+ if (na > 25) {
+ goto L630;
+ }
+ q *= a4;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f >= v * q) {
+ goto L150;
+ }
+ goto L250;
+L160:
+ if (c0 > c1) {
+ goto L200;
+ }
+ if (f0 - f > v * c0) {
+ goto L180;
+ }
+ if (f0 - f >= w * c0) {
+ goto L320;
+ }
+ if (c1 <= a5 * c0) {
+ goto L320;
+ }
+ r = log(c1 / c0);
+ s = (doublereal) (-((integer) (r * l3 + .999f)));
+ r = exp(r / s) * .999f;
+ q = c1;
+L170:
+ q *= r;
+ if (q < c0) {
+ goto L320;
+ }
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ ++na;
+ if (p - f > v * q) {
+ goto L170;
+ }
+ goto L320;
+L180:
+ q = c0;
+L190:
+ ++na;
+ if (na > 25) {
+ goto L630;
+ }
+ q *= a4;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f >= v * q) {
+ goto L190;
+ }
+ goto L250;
+L200:
+ q = a;
+ goto L190;
+L210:
+ if (c0 < c1) {
+ goto L290;
+ }
+ if (f0 - f >= v * c0) {
+ goto L230;
+ }
+ if (f0 - f >= w * c0) {
+ goto L250;
+ }
+ q = c0;
+L220:
+ ++nd;
+ if (nd > 25) {
+ goto L610;
+ }
+ q *= a3;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f < w * q) {
+ goto L220;
+ }
+ goto L250;
+L230:
+ if (c0 <= a5 * c1) {
+ goto L250;
+ }
+ r = log(c0 / c1);
+ s = (doublereal) ((integer) (r * l3 + .999f));
+ r = exp(r / s) * 1.001f;
+ q = a;
+L240:
+ q *= r;
+ if (q > c0) {
+ goto L250;
+ }
+ ++nd;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f < w * q) {
+ goto L240;
+ }
+L250:
+ if (iq == 1) {
+ goto L320;
+ }
+L260:
+ if (b == 0.) {
+ goto L280;
+ }
+ if (c == 0.) {
+ goto L270;
+ }
+ v = c - a;
+ w = a - b;
+ r = 1.f / v;
+ s = 1.f / w;
+ p = fc - fa;
+ q = fb - fa;
+ *e = p * r + q * s;
+ d__1 = c - b;
+ if (d_sign(e, &d__1) != *e) {
+ goto L320;
+ }
+ if (*e == 0.) {
+ goto L320;
+ }
+ q = p * r * w - q * s * v;
+ q = a - q * .5f / *e;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ goto L320;
+L270:
+ r = 1.f / a;
+ s = 1.f / b;
+ p = r * (fa - f) - d;
+ q = s * (fb - f) - d;
+ *e = a - b;
+ v = (r * p - s * q) / *e;
+ w = (a * q * s - b * p * r) / *e;
+ v = w * w - v * 3.f * d;
+ if (v < 0.) {
+ v = 0.f;
+ }
+ v = sqrt(v);
+ if (w + v == 0.) {
+ goto L320;
+ }
+ q = -d / (w + v);
+ if (q <= 0.) {
+ goto L320;
+ }
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ goto L320;
+L280:
+ if (iq == 1) {
+ goto L320;
+ }
+ q = (d + (f - fa) / a) / a;
+ if (q >= 0.) {
+ goto L320;
+ }
+ q = d * .5f / q;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ goto L320;
+L290:
+ if (f0 - f > v * c0) {
+ goto L300;
+ }
+ if (f0 - f > w * c0) {
+ goto L320;
+ }
+L300:
+ q = a;
+L310:
+ ++nd;
+ if (nd > 25) {
+ goto L610;
+ }
+ q *= a3;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f < w * q) {
+ goto L310;
+ }
+ goto L250;
+L320:
+ da = fd_(&a, x, h, n, grad);
+ if (da > a6 * g) {
+ goto L410;
+ }
+ if (da >= 0.) {
+ goto L560;
+ }
+ r = a;
+ q = 0.f;
+ for (i = 0; i < j; ++i) {
+ if (y[i] > a) {
+ goto L370;
+ }
+ if (y[i] <= q || y[i] == a) {
+ continue; /* next i */
+ }
+ q = y[i];
+ }
+ if (a <= a8 * q) {
+ goto L560;
+ }
+ q = a;
+L340:
+ ++nd;
+ if (nd > 25) {
+ goto L610;
+ }
+ q *= a3;
+ p = fv_(&q, x, h, n, value);
+ f1 = fa;
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p < f1) {
+ goto L340;
+ }
+ if (a > r) {
+ goto L360;
+ }
+ for (i = 0; i < *n; ++i) {
+ h[i+*n] = x[i] + a * h[i];
+ }
+ goto L560;
+L360:
+ da = fd_(&a, x, h, n, grad);
+ if (da > a6 * g) {
+ goto L410;
+ }
+ goto L560;
+L370:
+ q = y[i];
+ for (k = i; k < j; ++k) {
+ if (y[k] <= a) {
+ continue; /* next k */
+ }
+ if (y[k] < q) {
+ q = y[k];
+ }
+ }
+ if (q <= a5 * a) {
+ goto L560;
+ }
+ f0 = log(q / a);
+ s = (doublereal) ((integer) (f0 * l3 + .999f));
+ f0 = exp(f0 / s) * 1.001f;
+ s = a;
+L390:
+ s *= f0;
+ if (s >= q) {
+ goto L320;
+ }
+ p = fv_(&s, x, h, n, value);
+ f1 = fa;
+ ins_(&s, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p < f1) {
+ goto L390;
+ }
+ if (a > r) {
+ goto L320;
+ }
+ for (i = 0; i < *n; ++i) {
+ h[i+*n] = x[i] + a * h[i];
+ }
+ goto L560;
+L410:
+ b = 0.f;
+ k = 0;
+ i = k;
+L420:
+ ++i;
+ if (i+1 > j) {
+ goto L430;
+ }
+ if (y[i] >= a) {
+ goto L420;
+ }
+ if (y[i] < b) {
+ goto L420;
+ }
+ b = y[i];
+ k = i;
+ goto L420;
+L430:
+ fb = z[k];
+ db = d;
+ if (b != 0.) {
+ db = fd_(&b, x, h, n, grad);
+ }
+ w = abs(b - a) * 2.f;
+ cub_(&c, &a, &b, &fa, &fb, &da, &db);
+ nc = 1;
+ goto L480;
+L450:
+ w *= .5f;
+ if (w < abs(c0 - c)) {
+ goto L550;
+ }
+ if (c0 < c) {
+ goto L460;
+ }
+ if (d0 >= d) {
+ goto L470;
+ }
+ goto L550;
+L460:
+ if (d0 > d) {
+ goto L550;
+ }
+L470:
+ cub_(&c, &c, &c0, &f, &f0, &d, &d0);
+ ++nc;
+ if (nc > 30) {
+ goto L600;
+ }
+L480:
+ r = max(a,b);
+ s = min(a,b);
+ if (c > r) {
+ goto L490;
+ }
+ if (c > s) {
+ goto L500;
+ }
+ c = s + (s - c);
+ s = (a + b) * .5f;
+ if (c > s) {
+ c = s;
+ }
+ goto L500;
+L490:
+ c = r - (c - r);
+ s = (a + b) * .5f;
+ if (c < s) {
+ c = s;
+ }
+L500:
+ c0 = a;
+ f0 = fa;
+ d0 = da;
+ fvd_(&f, &d, &c, x, h, n, both);
+ if (f < fa) {
+ goto L510;
+ }
+ b = c;
+ fb = f;
+ db = d;
+ goto L450;
+L510:
+ if (c < a) {
+ goto L540;
+ }
+ if (d < 0.) {
+ goto L530;
+ }
+L520:
+ b = a;
+ fb = fa;
+ db = da;
+L530:
+ a = c;
+ fa = f;
+ da = d;
+ if (d > a6 * g) {
+ goto L450;
+ }
+ goto L560;
+L540:
+ if (d < 0.) {
+ goto L520;
+ }
+ goto L530;
+L550:
+ c = (a + b) * .5f;
+ ++nb;
+ w = abs(b - a);
+ goto L500;
+L560:
+ *e = 0.f;
+ for (i = 0; i < *n; ++i) {
+ if (abs(h[i+*n*2]) > *e) {
+ *e = abs(h[i+*n*2]);
+ }
+ x[i] = h[i+*n];
+ }
+ ++(*it);
+ if (*e <= *t) {
+ goto L660;
+ }
+ if (*it >= *limit) {
+ goto L660;
+ }
+ f = fa;
+ d = da;
+ a *= a7;
+ (*pre)(&h[*n], &h[*n*2]);
+ r = 0.f;
+ for (i = 0; i < *n; ++i) {
+ r += h[i+*n] * h[i+*n*2];
+ }
+ if (r < 0.) {
+ goto L620;
+ }
+ s = r / g;
+ g = r;
+ ++l;
+ if (l >= *m) {
+ goto L50;
+ }
+ d = 0.f;
+ for (i = 0; i < *n; ++i) {
+ h[i] = -h[i+*n] + s * h[i];
+ d += h[i] * h[i+*n*2];
+ }
+ goto L70;
+L600:
+ if (d < g) {
+ goto L560;
+ }
+#ifdef DEBUG
+ s_wsle(&io___43);
+ do_lio(&c__9, &c__1, "UNABLE TO OBTAIN DESCENT DIRECTION", 34L);
+ e_wsle();
+#endif
+ printf("UNABLE TO OBTAIN DESCENT DIRECTION\n"); assert(0);
+/* s_stop("", 0L); */
+L610:
+#ifdef DEBUG
+ s_wsle(&io___44);
+ do_lio(&c__9, &c__1, "THE FUNCTION DECREASES WITH NO MINIMUM", 38L);
+ e_wsle();
+#endif
+ printf("THE FUNCTION DECREASES WITH NO MINIMUM\n"); assert(0);
+/* s_stop("", 0L); */
+L620:
+#ifdef DEBUG
+ s_wsle(&io___45);
+ do_lio(&c__9, &c__1, "PRECONDITIONER NOT POSITIVE DEFINITE", 36L);
+ e_wsle();
+#endif
+ printf("PRECONDITIONER NOT POSITIVE DEFINITE\n"); assert(0);
+/* s_stop("", 0L); */
+L630:
+ /* Computing 25th power */
+ d__1 = a3, d__1 *= d__1, d__1 *= d__1, d__1 *= d__1,
+ q *= a3 * d__1 * d__1 * d__1;
+ nd = 0;
+L640:
+ ++nd;
+ if (nd > 25) {
+ goto L650;
+ }
+ q *= a3;
+ p = fv_(&q, x, h, n, value);
+ ins_(&q, &p, &a, &b, &c, &fa, &fb, &fc, &j, y, z);
+ if (p - f > v * q) {
+ goto L640;
+ }
+ goto L135;
+L650:
+#ifdef DEBUG
+ s_wsle(&io___46);
+ do_lio(&c__9, &c__1, "UNABLE TO SATISFY ARMIJO CONDITION", 34L);
+ e_wsle();
+#endif
+ printf("UNABLE TO SATISFY ARMIJO CONDITION\n");
+ return;
+L660:
+ *step = a;
+} /* cg_ */
+
+static doublereal fv_(a, x, h, n, value)
+doublereal *a, *x, *h;
+const integer *n;
+doublereal (*value) (doublereal*);
+{
+ /* Local variables */
+ static integer i;
+
+ for (i = 0; i < *n; ++i) {
+ h[i+*n] = x[i] + *a * h[i];
+ }
+ return (*value)(&h[*n]);
+} /* fv_ */
+
+static doublereal fd_(a, x, h, n, grad)
+doublereal *a, *x, *h;
+const integer *n;
+void (*grad) (doublereal*,doublereal*);
+{
+ /* Local variables */
+ static doublereal d;
+ static integer i;
+
+ for (i = 0; i < *n; ++i) {
+ h[i+*n] = x[i] + *a * h[i];
+ }
+ (*grad)(&h[*n*2], &h[*n]);
+ d = 0.f;
+ for (i = 0; i < *n; ++i) {
+ d += h[i] * h[i+*n*2];
+ }
+ return d;
+} /* fd_ */
+
+/* Subroutine */
+static void fvd_(v, d, a, x, h, n, both)
+doublereal *v, *d, *a, *x, *h;
+const integer *n;
+/* Subroutine */ void (*both) (doublereal*,doublereal*,doublereal*);
+{
+ /* Local variables */
+ static integer i;
+
+ for (i = 0; i < *n; ++i) {
+ h[i+*n] = x[i] + *a * h[i];
+ }
+ (*both)(v, &h[*n*2], &h[*n]);
+ *d = 0.f;
+ for (i = 0; i < *n; ++i) {
+ *d += h[i] * h[i+*n*2];
+ }
+ return;
+} /* fvd_ */
+
+/* Subroutine */
+static void cub_(x, a, b, c, d, e, f)
+doublereal *x, *a, *b, *c, *d, *e, *f;
+{
+ /* Local variables */
+ static doublereal g, v, w, y, z;
+
+ g = *b - *a;
+ if (g == 0.) {
+ goto L50;
+ }
+ v = *e + *f - (*d - *c) * 3 / g;
+ w = v * v - *e * *f;
+ if (w < 0.) {
+ w = 0.f;
+ }
+ w = sqrt(w);
+ w = d_sign(&w, &g);
+ y = *e + v;
+ z = *f + v;
+ if (d_sign(&y, &g) != y) {
+ goto L30;
+ }
+ if (d_sign(&z, &g) != z) {
+ goto L20;
+ }
+ if (z == 0.) {
+ goto L20;
+ }
+L10:
+ *x = *b - g * *f / (z + w);
+ return;
+L20:
+ if (*c < *d) {
+ *x = *a;
+ }
+ if (*c >= *d) {
+ *x = *b;
+ }
+ return;
+L30:
+ if (d_sign(&z, &g) != z) {
+ goto L40;
+ }
+ if (abs(*e) > abs(*f)) {
+ goto L10;
+ }
+L40:
+ *x = *a + g * *e / (y - w);
+ return;
+L50:
+ *x = *a;
+ return;
+} /* cub_ */
+
+/* Subroutine */
+static void ins_(s, f, a, b, c, fa, fb, fc, j, y, z)
+doublereal *s, *f, *a, *b, *c, *fa, *fb, *fc;
+integer *j;
+doublereal *y, *z;
+{
+ y[*j] = *s;
+ z[*j] = *f;
+ ++(*j);
+ if (*f <= *fa) {
+ *c = *b; *b = *a; *a = *s;
+ *fc = *fb; *fb = *fa; *fa = *f;
+ return;
+ }
+ if (*f <= *fb) {
+ *c = *b; *b = *s;
+ *fc = *fb; *fb = *f;
+ return;
+ }
+ if (*f > *fc) {
+ return;
+ }
+ *c = *s;
+ *fc = *f;
+} /* ins_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.f
new file mode 100644
index 0000000000000000000000000000000000000000..5cd85ddbcd30abfac074cbdb6e0b39b0d04f5960
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cg.f
@@ -0,0 +1,491 @@
+C
+C ________________________________________________________
+C | |
+C | MINIMIZE A FUNCTION USING THE FLETCHER-REEVES FORM |
+C | OF THE CONJUGATE GRADIENT METHOD |
+C | WITH (OR WITHOUT) PRECONDITIONING |
+C | |
+C | INPUT: |
+C | |
+C | X --ARRAY CONTAINING STARTING GUESS |
+C | |
+C | STEP --STARTING GUESS FOR MINIMIZER IN DIREC- |
+C | TION OF NEGATIVE GRADIENT DURING FIRST |
+C | ITERATION (E. G. STEP=1) WHEN STEP=0, |
+C | THE PROGRAM SELECTS A STARTING GUESS |
+C | |
+C | T --COMPUTING TOLERANCE (ITERATIONS STOP |
+C | WHEN MAX-NORM OF GRADIENT .LE. T) |
+C | |
+C | LIMIT --MAXIMUM NUMBER OF ITERATIONS |
+C | |
+C | N --NUMBER OF UNKNOWNS |
+C | |
+C | M --NUMBER OF ITERATIONS UNTIL THE SEARCH |
+C | DIRECTIONS ARE RENORMALIZED ALONG THE |
+C | NEGATIVE GRADIENT (TYPICALLY, M = N) |
+C | |
+C | VALUE --NAME OF COST EVALUATION FUNC. ROUTINE |
+C | (EXTERNAL IN MAIN PROGRAM) |
+C | VALUE(X) IS VALUE OF COST AT X |
+C | |
+C | GRAD --NAME OF GRADIENT EVALUATION SUBROUTINE |
+C | (EXTERNAL IN MAIN PROGRAM) |
+C | GRAD(G,X) PUTS IN G THE GRADIENT AT X |
+C | |
+C | BOTH --NAME SUBROUTINE TO EVALUATE BOTH COST |
+C | AND ITS GRADIENT (EXTERNAL IN MAIN |
+C | PROGRAM) BOTH(V,G,X) PUTS THE VALUE IN |
+C | V AND THE GRADIENT IN G FOR THE POINT X|
+C | |
+C | PRE --NAME OF PRECONDITIONING SUBROUTINE |
+C | (EXTERNAL IN MAIN PROGRAM) |
+C | PRE(Y,Z) APPLIES THE PRECONDITIONER TO |
+C | Z, STORING THE RESULT IN Y. |
+C | IF PRECONDITIONING NOT USED SET Y = Z |
+C | |
+C | H --WORK ARRAY (LENGTH AT LEAST 3N) |
+C | |
+C | OUTPUT: |
+C | |
+C | X --MINIMIZER |
+C | |
+C | E --MAX-NORM OF GRADIENT |
+C | |
+C | IT --NUMBER OF ITERATIONS PERFORMED |
+C | |
+C | STEP --STEP SIZE ALONG SEARCH DIRECTION FOR |
+C | FINAL ITERATION |
+C | |
+C | BUILTIN FUNCTIONS: DABS,DEXP,IDINT,DLOG,DSQRT,DMAX1,|
+C | DMIN1,DSIGN |
+C | PACKAGE ROUTINES: CUB,FD,FV,FVD,INS |
+C |________________________________________________________|
+C
+ SUBROUTINE CG(X,E,IT,STEP,T,LIMIT,N,M,VALUE,GRAD,BOTH,PRE,H)
+ INTEGER I,IT,J,K,L,LIMIT,M,N,NA,NB,NC,ND
+ REAL*8 H(N,1),X(1),Y(50),Z(50),A1,A2,A3,A4,A5,A6,A7,A8,A,B,C,C0,C1
+ REAL*8 D,D0,DA,DB,E,F,F0,F1,FA,FB,FC,G,L3,P,Q,R,S,STEP,T,V,W
+ REAL*8 FV,FD,VALUE
+ EXTERNAL BOTH,GRAD,PRE,VALUE
+ DATA A1/.1D0/,A2/.9D0/,A3/5.D0/,A4/.2D0/,A5/10.D0/,A6/.9D0/
+ DATA A7/.3D0/
+ A8 = A3 + .01D0
+ IT = 0
+ CALL BOTH(F,H(1,3),X)
+ E = 0.
+ DO 10 I = 1,N
+10 IF ( DABS(H(I,3)) .GT. E ) E = DABS(H(I,3))
+ IF ( E .LE. T ) RETURN
+ L3 = 1./DLOG(A3)
+ CALL PRE(H(1,2),H(1,3))
+ A = STEP
+ IF ( A .GT. 0. ) GOTO 30
+ DO 20 I = 1,N
+20 IF ( DABS(X(I)) .GT. A ) A = DABS(X(I))
+ A = .01*A/E
+ IF ( A .EQ. 0. ) A = 1.
+30 G = 0.
+ DO 40 I = 1,N
+40 G = G + H(I,2)*H(I,3)
+ IF ( G .LT. 0. ) GOTO 620
+50 L = 0
+ DO 60 I = 1,N
+60 H(I,1) = -H(I,2)
+ D = -G
+70 FA = FV(A,X,H,N,VALUE)
+ C0 = A
+ F0 = FA
+ J = 2
+ Y(1) = 0.
+ Z(1) = F
+ Y(2) = A
+ Z(2) = FA
+ V = A1*D
+ W = A2*D
+ IQ = 0
+ IF ( FA .LE. F ) GOTO 80
+ C = A
+ B = 0.
+ A = 0.
+ FC = FA
+ FB = F
+ FA = F
+ GOTO 90
+80 C = 0.
+ B = 0.
+ FC = F
+ FB = F
+ IQ = 1
+90 NA = 0
+ NB = 0
+ NC = 0
+ ND = 0
+ Q = (D+(F-F0)/C0)/C0
+ IF ( Q .LT. 0. ) GOTO 110
+ Q = A
+100 ND = ND + 1
+ IF ( ND .GT. 25 ) GOTO 610
+ Q = A3*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .LT. W*Q ) GOTO 100
+ GOTO 260
+110 Q = .5*D/Q
+ IF ( Q .LT. .01*C0 ) Q = .01*C0
+ P = FV(Q,X,H,N,VALUE)
+ IF ( P .LE. F0 ) GOTO 120
+ F1 = F0
+ C1 = C0
+ F0 = P
+ C0 = Q
+ GOTO 130
+120 F1 = P
+ C1 = Q
+130 CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+135 IF ( A .EQ. 0. ) GOTO 140
+ IF ( FA-F .GE. V*A ) GOTO 160
+ IF ( FA-F .LT. W*A ) GOTO 210
+ GOTO 280
+140 Q = C0
+ IF ( C1 .LT. Q ) Q = C1
+150 NA = NA + 1
+ IF ( NA .GT. 25 ) GOTO 630
+ Q = A4*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .GE. V*Q ) GOTO 150
+ GOTO 250
+160 IF ( C0 .GT. C1 ) GOTO 200
+ IF ( F0-F .GT. V*C0 ) GOTO 180
+ IF ( F0-F .GE. W*C0 ) GOTO 320
+ IF ( C1 .LE. A5*C0 ) GOTO 320
+ R = DLOG(C1/C0)
+ S = -IDINT(R*L3+.999)
+ R = .999*DEXP(R/S)
+ Q = C1
+170 Q = Q*R
+ IF ( Q .LT. C0 ) GOTO 320
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ NA = NA + 1
+ IF ( P-F .GT. V*Q ) GOTO 170
+ GOTO 320
+180 Q = C0
+190 NA = NA + 1
+ IF ( NA .GT. 25 ) GOTO 630
+ Q = A4*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .GE. V*Q ) GOTO 190
+ GOTO 250
+200 Q = A
+ GOTO 190
+210 IF ( C0 .LT. C1 ) GOTO 290
+ IF ( F0-F .GE. V*C0 ) GOTO 230
+ IF ( F0-F .GE. W*C0 ) GOTO 250
+ Q = C0
+220 ND = ND + 1
+ IF ( ND .GT. 25 ) GOTO 610
+ Q = A3*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .LT. W*Q ) GOTO 220
+ GOTO 250
+230 IF ( C0 .LE. A5*C1 ) GOTO 250
+ R = DLOG(C0/C1)
+ S = IDINT(R*L3+.999)
+ R = 1.001*DEXP(R/S)
+ Q = A
+240 Q = Q*R
+ IF ( Q .GT. C0 ) GOTO 250
+ ND = ND + 1
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .LT. W*Q ) GOTO 240
+250 IF ( IQ .EQ. 1 ) GOTO 320
+260 IF ( B .EQ. 0. ) GOTO 280
+ IF ( C .EQ. 0. ) GOTO 270
+ V = C - A
+ W = A - B
+ R = 1./V
+ S = 1./W
+ P = FC - FA
+ Q = FB - FA
+ E = P*R + Q*S
+ IF ( DSIGN(E,C-B) .NE. E ) GOTO 320
+ IF ( E .EQ. 0. ) GOTO 320
+ Q = (P*R)*W - (Q*S)*V
+ Q = A - .5*Q/E
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ GOTO 320
+270 R = 1./A
+ S = 1./B
+ P = R*(FA-F) - D
+ Q = S*(FB-F) - D
+ E = A - B
+ V = (R*P-S*Q)/E
+ W = (A*Q*S-B*P*R)/E
+ V = W*W-3.*V*D
+ IF ( V .LT. 0. ) V = 0.
+ V = DSQRT(V)
+ IF ( W+V .EQ. 0. ) GOTO 320
+ Q = -D/(W+V)
+ IF ( Q .LE. 0. ) GOTO 320
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ GOTO 320
+280 IF ( IQ .EQ. 1 ) GOTO 320
+ Q = (D+(F-FA)/A)/A
+ IF ( Q .GE. 0. ) GOTO 320
+ Q = .5*D/Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ GOTO 320
+290 IF ( F0-F .GT. V*C0 ) GOTO 300
+ IF ( F0-F .GT. W*C0 ) GOTO 320
+300 Q = A
+310 ND = ND + 1
+ IF ( ND .GT. 25 ) GOTO 610
+ Q = A3*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .LT. W*Q ) GOTO 310
+ GOTO 250
+320 DA = FD(A,X,H,N,GRAD)
+ IF ( DA .GT. A6*G ) GOTO 410
+ IF ( DA .GE. 0. ) GOTO 560
+ R = A
+ Q = 0.
+ DO 330 I = 1,J
+ IF ( Y(I) .GT. A ) GOTO 370
+ IF ( Y(I) .LE. Q ) GOTO 330
+ IF ( Y(I) .EQ. A ) GOTO 330
+ Q = Y(I)
+330 CONTINUE
+ IF ( A .LE. A8*Q ) GOTO 560
+ Q = A
+340 ND = ND + 1
+ IF ( ND .GT. 25 ) GOTO 610
+ Q = A3*Q
+ P = FV(Q,X,H,N,VALUE)
+ F1 = FA
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P .LT. F1 ) GOTO 340
+ IF ( A .GT. R ) GOTO 360
+ DO 350 I = 1,N
+350 H(I,2) = X(I) + A*H(I,1)
+ GOTO 560
+360 DA = FD(A,X,H,N,GRAD)
+ IF ( DA .GT. A6*G ) GOTO 410
+ GOTO 560
+370 Q = Y(I)
+ DO 380 K = I,J
+ IF ( Y(K) .LE. A ) GOTO 380
+ IF ( Y(K) .LT. Q ) Q = Y(K)
+380 CONTINUE
+ IF ( Q .LE. A5*A ) GOTO 560
+ F0 = DLOG(Q/A)
+ S = IDINT(F0*L3+.999)
+ F0 = 1.001*DEXP(F0/S)
+ S = A
+390 S = S*F0
+ IF ( S .GE. Q ) GOTO 320
+ P = FV(S,X,H,N,VALUE)
+ F1 = FA
+ CALL INS(S,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P .LT. F1 ) GOTO 390
+ IF ( A .GT. R ) GOTO 320
+ DO 400 I = 1,N
+400 H(I,2) = X(I) + A*H(I,1)
+ GOTO 560
+410 B = 0.
+ K = 1
+ I = K
+420 I = I + 1
+ IF ( I .GT. J ) GOTO 430
+ IF ( Y(I) .GE. A ) GOTO 420
+ IF ( Y(I) .LT. B ) GOTO 420
+ B = Y(I)
+ K = I
+ GOTO 420
+430 FB = Z(K)
+ DB = D
+ IF ( B .NE. 0. ) DB = FD(B,X,H,N,GRAD)
+440 W = 2.*DABS(B-A)
+ CALL CUB(C,A,B,FA,FB,DA,DB)
+ NC = 1
+ GOTO 480
+450 W = .5*W
+ IF ( W .LT. DABS(C0-C) ) GOTO 550
+ IF ( C0 .LT. C ) GOTO 460
+ IF ( D0 .GE. D ) GOTO 470
+ GOTO 550
+460 IF ( D0 .GT. D ) GOTO 550
+470 CALL CUB(C,C,C0,F,F0,D,D0)
+ NC = NC + 1
+ IF ( NC .GT. 30 ) GOTO 600
+480 R = DMAX1(A,B)
+ S = DMIN1(A,B)
+ IF ( C .GT. R ) GOTO 490
+ IF ( C .GT. S ) GOTO 500
+ C = S + (S-C)
+ S = .5*(A+B)
+ IF ( C .GT. S ) C = S
+ GOTO 500
+490 C = R - (C-R)
+ S = .5*(A+B)
+ IF ( C .LT. S ) C = S
+500 C0 = A
+ F0 = FA
+ D0 = DA
+ CALL FVD(F,D,C,X,H,N,BOTH)
+ IF ( F .LT. FA ) GOTO 510
+ B = C
+ FB = F
+ DB = D
+ GOTO 450
+510 IF ( C .LT. A ) GOTO 540
+ IF ( D .LT. 0. ) GOTO 530
+520 B = A
+ FB = FA
+ DB = DA
+530 A = C
+ FA = F
+ DA = D
+ IF ( D .GT. A6*G ) GOTO 450
+ GOTO 560
+540 IF ( D .LT. 0. ) GOTO 520
+ GOTO 530
+550 C = .5*(A+B)
+ NB = NB + 1
+ W = DABS(B-A)
+ GOTO 500
+560 E = 0.
+ DO 570 I = 1,N
+ IF ( DABS(H(I,3)) .GT. E ) E = DABS(H(I,3))
+570 X(I) = H(I,2)
+ IT = IT + 1
+ IF ( E .LE. T ) GOTO 660
+ IF ( IT .GE. LIMIT ) GOTO 660
+ F = FA
+ D = DA
+ A = A7*A
+ CALL PRE(H(1,2),H(1,3))
+ R = 0.
+ DO 580 I = 1,N
+580 R = R + H(I,2)*H(I,3)
+ IF ( R .LT. 0. ) GOTO 620
+ S = R/G
+ G = R
+ L = L + 1
+ IF ( L .GE. M ) GOTO 50
+ D = 0.
+ DO 590 I = 1,N
+ H(I,1) = -H(I,2) + S*H(I,1)
+590 D = D + H(I,1)*H(I,3)
+ GOTO 70
+600 IF ( D .LT. G ) GOTO 560
+ WRITE(6,*) 'UNABLE TO OBTAIN DESCENT DIRECTION'
+ STOP
+610 WRITE(6,*) 'THE FUNCTION DECREASES WITH NO MINIMUM'
+ STOP
+620 WRITE(6,*) 'PRECONDITIONER NOT POSITIVE DEFINITE'
+ STOP
+630 Q = Q*A3**25
+ ND = 0
+640 ND = ND + 1
+ IF ( ND .GT. 25 ) GOTO 650
+ Q = A3*Q
+ P = FV(Q,X,H,N,VALUE)
+ CALL INS(Q,P,A,B,C,FA,FB,FC,J,Y,Z)
+ IF ( P-F .GT. V*Q ) GOTO 640
+ GOTO 135
+650 WRITE(6,*) 'UNABLE TO SATISFY ARMIJO CONDITION'
+ RETURN
+660 STEP = A
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION FV(A,X,H,N,VALUE)
+ REAL*8 H(N,1),X(1),A,VALUE
+ EXTERNAL VALUE
+ DO 10 I = 1 , N
+10 H(I,2) = X(I) + A*H(I,1)
+ FV = VALUE(H(1,2))
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION FD(A,X,H,N,GRAD)
+ REAL*8 H(N,1),X(1),A,D
+ EXTERNAL GRAD
+ DO 10 I = 1 , N
+10 H(I,2) = X(I) + A*H(I,1)
+ CALL GRAD(H(1,3),H(1,2))
+ D = 0.
+ DO 20 I = 1,N
+20 D = D + H(I,1)*H(I,3)
+ FD = D
+ RETURN
+ END
+ SUBROUTINE FVD(V,D,A,X,H,N,BOTH)
+ REAL*8 H(N,1),X(1),A,D,V
+ EXTERNAL BOTH
+ DO 10 I = 1 , N
+10 H(I,2) = X(I) + A*H(I,1)
+ CALL BOTH(V,H(1,3),H(1,2))
+ D = 0.
+ DO 20 I = 1,N
+20 D = D + H(I,1)*H(I,3)
+ RETURN
+ END
+ SUBROUTINE CUB(X,A,B,C,D,E,F)
+ REAL*8 A,B,C,D,E,F,G,V,W,X,Y,Z
+ G = B - A
+ IF ( G .EQ. 0. ) GOTO 50
+ V = E + F - 3*(D-C)/G
+ W = V*V-E*F
+ IF ( W .LT. 0. ) W = 0.
+ W = DSIGN(DSQRT(W),G)
+ Y = E + V
+ Z = F + V
+ IF ( DSIGN(Y,G) .NE. Y ) GOTO 30
+ IF ( DSIGN(Z,G) .NE. Z ) GOTO 20
+ IF ( Z .EQ. 0. ) GOTO 20
+10 X = B - G*F/(Z+W)
+ RETURN
+20 IF ( C .LT. D ) X = A
+ IF ( C .GE. D ) X = B
+ RETURN
+30 IF ( DSIGN(Z,G) .NE. Z ) GOTO 40
+ IF ( DABS(E) .GT. DABS(F) ) GOTO 10
+40 X = A + G*E/(Y-W)
+ RETURN
+50 X = A
+ RETURN
+ END
+ SUBROUTINE INS(S,F,A,B,C,FA,FB,FC,J,Y,Z)
+ REAL*8 A,B,C,F,FA,FB,FC,S,Y(1),Z(1)
+ INTEGER J
+ J = J + 1
+ Y(J) = S
+ Z(J) = F
+ IF ( F .LE. FA ) GOTO 20
+ IF ( F .LE. FB ) GOTO 10
+ IF ( F .GT. FC ) RETURN
+ C = S
+ FC = F
+ RETURN
+10 C = B
+ B = S
+ FC = FB
+ FB = F
+ RETURN
+20 C = B
+ B = A
+ A = S
+ FC = FB
+ FB = FA
+ FA = F
+ RETURN
+ END
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..6ce657aba4f8627ba220626277a20423111a2ffc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.c
@@ -0,0 +1,255 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static complex c_1 = {1.f,0.f};
+
+/* Subroutine */ void cqrdc_(x, ldx, n, p, qraux, jpvt, work, job)
+complex *x;
+const integer *ldx, *n, *p;
+complex *qraux;
+integer *jpvt;
+complex *work;
+const integer *job;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ real r__1, r__2;
+ complex q__1;
+
+ /* Local variables */
+ static logical negj;
+ static integer maxj, j, l;
+ static complex t;
+ static logical swapj;
+ static complex nrmxl;
+ static integer jp, pl, pu;
+ static real tt, maxnrm;
+
+/************************************************************************/
+/* */
+/* cqrdc uses householder transformations to compute the qr */
+/* factorization of an n by p matrix x. column pivoting */
+/* based on the 2-norms of the reduced columns may be */
+/* performed at the users option. */
+/* */
+/* on entry */
+/* */
+/* x complex(ldx,p), where ldx .ge. n. */
+/* x contains the matrix whose decomposition is to be */
+/* computed. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* jpvt integer(p). */
+/* jpvt contains integers that control the selection */
+/* of the pivot columns. the k-th column x(k) of x */
+/* is placed in one of three classes according to the */
+/* value of jpvt(k). */
+/* */
+/* if jpvt(k) .gt. 0, then x(k) is an initial */
+/* column. */
+/* */
+/* if jpvt(k) .eq. 0, then x(k) is a free column. */
+/* */
+/* if jpvt(k) .lt. 0, then x(k) is a final column. */
+/* */
+/* before the decomposition is computed, initial columns */
+/* are moved to the beginning of the array x and final */
+/* columns to the end. both initial and final columns */
+/* are frozen in place during the computation and only */
+/* free columns are moved. at the k-th stage of the */
+/* reduction, if x(k) is occupied by a free column */
+/* it is interchanged with the free column of largest */
+/* reduced norm. jpvt is not referenced if */
+/* job .eq. 0. */
+/* */
+/* work complex(p). */
+/* work is a work array. work is not referenced if */
+/* job .eq. 0. */
+/* */
+/* job integer. */
+/* job is an integer that initiates column pivoting. */
+/* if job .eq. 0, no pivoting is done. */
+/* if job .ne. 0, pivoting is done. */
+/* */
+/* on return */
+/* */
+/* x x contains in its upper triangle the upper */
+/* triangular matrix r of the qr factorization. */
+/* below its diagonal x contains information from */
+/* which the unitary part of the decomposition */
+/* can be recovered. note that if pivoting has */
+/* been requested, the decomposition is not that */
+/* of the original matrix x but that of x */
+/* with its columns permuted as described by jpvt. */
+/* */
+/* qraux complex(p). */
+/* qraux contains further information required to recover*/
+/* the unitary part of the decomposition. */
+/* */
+/* jpvt jpvt(k) contains the index of the column of the */
+/* original matrix that has been interchanged into */
+/* the k-th column, if pivoting was requested. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+/* */
+/* cqrdc uses the following functions and subprograms. */
+/* */
+/* blas caxpy,cdotc,cscal,cswap,scnrm2 */
+/* fortran aimag,amax1,cabs,cmplx,csqrt,min0,real */
+/* */
+/************************************************************************/
+
+ pl = 0;
+ pu = -1;
+
+ if (*job != 0) {
+
+/* pivoting has been requested. rearrange the columns */
+/* according to jpvt. */
+
+ for (j = 0; j < *p; ++j) {
+ swapj = jpvt[j] > 0;
+ negj = jpvt[j] < 0;
+ jpvt[j] = j+1;
+ if (negj) {
+ jpvt[j] = -j-1;
+ }
+ if (! swapj) {
+ continue; /* next j */
+ }
+ if (j != pl) {
+ cswap_(n, &x[pl* *ldx], &c__1, &x[j* *ldx], &c__1);
+ }
+ jpvt[j] = jpvt[pl];
+ jpvt[pl] = j+1;
+ ++pl;
+ }
+ pu = *p - 1;
+ for (j = pu; j >= 0; --j) {
+ if (jpvt[j] >= 0) {
+ continue; /* next j */
+ }
+ jpvt[j] = -jpvt[j];
+ if (j == pu) {
+ --pu; continue; /* next j */
+ }
+ cswap_(n, &x[pu* *ldx], &c__1, &x[j* *ldx], &c__1);
+ jp = jpvt[pu];
+ jpvt[pu] = jpvt[j];
+ jpvt[j] = jp;
+ --pu;
+ }
+ }
+
+/* compute the norms of the free columns. */
+
+ for (j = pl; j <= pu; ++j) {
+ work[j].r = qraux[j].r = scnrm2_(n, &x[j* *ldx], &c__1),
+ work[j].i = qraux[j].i = 0.f;
+ }
+
+/* perform the householder reduction of x. */
+
+ for (l = 0; l < *n && l < *p; ++l) {
+ if (l < pl || l >= pu) {
+ goto L120;
+ }
+
+/* locate the column of largest norm and bring it */
+/* into the pivot position. */
+
+ maxnrm = 0.f;
+ maxj = l;
+ for (j = l; j <= pu; ++j) {
+ if (qraux[j].r > maxnrm) {
+ maxnrm = qraux[j].r;
+ maxj = j;
+ }
+ }
+ if (maxj != l) {
+ cswap_(n, &x[l* *ldx], &c__1, &x[maxj* *ldx], &c__1);
+ qraux[maxj].r = qraux[l].r, qraux[maxj].i = qraux[l].i;
+ work[maxj].r = work[l].r, work[maxj].i = work[l].i;
+ jp = jpvt[maxj];
+ jpvt[maxj] = jpvt[l];
+ jpvt[l] = jp;
+ }
+L120:
+ qraux[l].r = 0.f, qraux[l].i = 0.f;
+ if (l+1 == *n) {
+ continue; /* next l */
+ }
+
+/* compute the householder transformation for column l. */
+
+ i__1 = *n - l;
+ i__2 = l + l * *ldx;
+ nrmxl.r = scnrm2_(&i__1, &x[i__2], &c__1), nrmxl.i = 0.f;
+ if (nrmxl.r == 0.f) {
+ continue; /* next l */
+ }
+ if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
+ r__1 = c_abs(&nrmxl);
+ r__2 = c_abs(&x[i__2]);
+ nrmxl.r = r__1 * x[i__2].r / r__2,
+ nrmxl.i = r__1 * x[i__2].i / r__2;
+ }
+ c_div(&q__1, &c_1, &nrmxl);
+ cscal_(&i__1, &q__1, &x[i__2], &c__1);
+ x[i__2].r += 1.f;
+
+/* apply the transformation to the remaining columns, */
+/* updating the norms. */
+
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l;
+ i__2 = l + l * *ldx;
+ cdotc_(&q__1, &i__1, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ q__1.r = -q__1.r, q__1.i = -q__1.i;
+ c_div(&t, &q__1, &x[i__2]);
+ caxpy_(&i__1, &t, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ if (j < pl || j > pu) {
+ continue; /* next j */
+ }
+ if (qraux[j].r == 0.f && qraux[j].i == 0.f) {
+ continue; /* next j */
+ }
+ r__1 = c_abs(&x[l+j* *ldx]) / qraux[j].r;
+ tt = 1.f - r__1 * r__1;
+ if (tt < 0.f) tt = 0.f;
+ t.r = tt, t.i = 0.f;
+ r__1 = qraux[j].r / work[j].r;
+ tt = tt * .05f * (r__1 * r__1) + 1.f;
+ if (tt == 1.f) {
+ i__1 = *n - l - 1;
+ i__2 = l + 1 + j * *ldx;
+ work[j].r = qraux[j].r = scnrm2_(&i__1, &x[i__2], &c__1),
+ work[j].i = qraux[j].i = 0.f;
+ }
+ else {
+ r__1 = sqrtf(t.r);
+ qraux[j].r *= r__1, qraux[j].i *= r__1;
+ }
+ }
+
+/* save the transformation. */
+
+ i__1 = l + l * *ldx;
+ qraux[l].r = x[i__1].r, qraux[l].i = x[i__1].i;
+ x[i__1].r = -nrmxl.r, x[i__1].i = -nrmxl.i;
+ }
+} /* cqrdc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..41499e968f4e64478bdc0027c5342a97bedbbc09
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrdc.f
@@ -0,0 +1,213 @@
+ subroutine cqrdc(x,ldx,n,p,qraux,jpvt,work,job)
+ integer ldx,n,p,job
+ integer jpvt(1)
+ complex x(ldx,1),qraux(1),work(1)
+c
+c cqrdc uses householder transformations to compute the qr
+c factorization of an n by p matrix x. column pivoting
+c based on the 2-norms of the reduced columns may be
+c performed at the users option.
+c
+c on entry
+c
+c x complex(ldx,p), where ldx .ge. n.
+c x contains the matrix whose decomposition is to be
+c computed.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c jpvt integer(p).
+c jpvt contains integers that control the selection
+c of the pivot columns. the k-th column x(k) of x
+c is placed in one of three classes according to the
+c value of jpvt(k).
+c
+c if jpvt(k) .gt. 0, then x(k) is an initial
+c column.
+c
+c if jpvt(k) .eq. 0, then x(k) is a free column.
+c
+c if jpvt(k) .lt. 0, then x(k) is a final column.
+c
+c before the decomposition is computed, initial columns
+c are moved to the beginning of the array x and final
+c columns to the end. both initial and final columns
+c are frozen in place during the computation and only
+c free columns are moved. at the k-th stage of the
+c reduction, if x(k) is occupied by a free column
+c it is interchanged with the free column of largest
+c reduced norm. jpvt is not referenced if
+c job .eq. 0.
+c
+c work complex(p).
+c work is a work array. work is not referenced if
+c job .eq. 0.
+c
+c job integer.
+c job is an integer that initiates column pivoting.
+c if job .eq. 0, no pivoting is done.
+c if job .ne. 0, pivoting is done.
+c
+c on return
+c
+c x x contains in its upper triangle the upper
+c triangular matrix r of the qr factorization.
+c below its diagonal x contains information from
+c which the unitary part of the decomposition
+c can be recovered. note that if pivoting has
+c been requested, the decomposition is not that
+c of the original matrix x but that of x
+c with its columns permuted as described by jpvt.
+c
+c qraux complex(p).
+c qraux contains further information required to recover
+c the unitary part of the decomposition.
+c
+c jpvt jpvt(k) contains the index of the column of the
+c original matrix that has been interchanged into
+c the k-th column, if pivoting was requested.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c cqrdc uses the following functions and subprograms.
+c
+c blas caxpy,cdotc,cscal,cswap,scnrm2
+c fortran abs,aimag,amax1,cabs,cmplx,csqrt,min0,real
+c
+c internal variables
+c
+ integer j,jp,l,lp1,lup,maxj,pl,pu
+ real maxnrm,scnrm2,tt
+ complex cdotc,nrmxl,t
+ logical negj,swapj
+c
+ complex csign,zdum,zdum1,zdum2
+ real cabs1
+ csign(zdum1,zdum2) = cabs(zdum1)*(zdum2/cabs(zdum2))
+ cabs1(zdum) = abs(real(zdum)) + abs(aimag(zdum))
+c
+ pl = 1
+ pu = 0
+ if (job .eq. 0) go to 60
+c
+c pivoting has been requested. rearrange the columns
+c according to jpvt.
+c
+ do 20 j = 1, p
+ swapj = jpvt(j) .gt. 0
+ negj = jpvt(j) .lt. 0
+ jpvt(j) = j
+ if (negj) jpvt(j) = -j
+ if (.not.swapj) go to 10
+ if (j .ne. pl) call cswap(n,x(1,pl),1,x(1,j),1)
+ jpvt(j) = jpvt(pl)
+ jpvt(pl) = j
+ pl = pl + 1
+ 10 continue
+ 20 continue
+ pu = p
+ do 50 jj = 1, p
+ j = p - jj + 1
+ if (jpvt(j) .ge. 0) go to 40
+ jpvt(j) = -jpvt(j)
+ if (j .eq. pu) go to 30
+ call cswap(n,x(1,pu),1,x(1,j),1)
+ jp = jpvt(pu)
+ jpvt(pu) = jpvt(j)
+ jpvt(j) = jp
+ 30 continue
+ pu = pu - 1
+ 40 continue
+ 50 continue
+ 60 continue
+c
+c compute the norms of the free columns.
+c
+ if (pu .lt. pl) go to 80
+ do 70 j = pl, pu
+ qraux(j) = cmplx(scnrm2(n,x(1,j),1),0.0e0)
+ work(j) = qraux(j)
+ 70 continue
+ 80 continue
+c
+c perform the householder reduction of x.
+c
+ lup = min0(n,p)
+ do 200 l = 1, lup
+ if (l .lt. pl .or. l .ge. pu) go to 120
+c
+c locate the column of largest norm and bring it
+c into the pivot position.
+c
+ maxnrm = 0.0e0
+ maxj = l
+ do 100 j = l, pu
+ if (real(qraux(j)) .le. maxnrm) go to 90
+ maxnrm = real(qraux(j))
+ maxj = j
+ 90 continue
+ 100 continue
+ if (maxj .eq. l) go to 110
+ call cswap(n,x(1,l),1,x(1,maxj),1)
+ qraux(maxj) = qraux(l)
+ work(maxj) = work(l)
+ jp = jpvt(maxj)
+ jpvt(maxj) = jpvt(l)
+ jpvt(l) = jp
+ 110 continue
+ 120 continue
+ qraux(l) = (0.0e0,0.0e0)
+ if (l .eq. n) go to 190
+c
+c compute the householder transformation for column l.
+c
+ nrmxl = cmplx(scnrm2(n-l+1,x(l,l),1),0.0e0)
+ if (cabs1(nrmxl) .eq. 0.0e0) go to 180
+ if (cabs1(x(l,l)) .ne. 0.0e0)
+ * nrmxl = csign(nrmxl,x(l,l))
+ call cscal(n-l+1,(1.0e0,0.0e0)/nrmxl,x(l,l),1)
+ x(l,l) = (1.0e0,0.0e0) + x(l,l)
+c
+c apply the transformation to the remaining columns,
+c updating the norms.
+c
+ lp1 = l + 1
+ if (p .lt. lp1) go to 170
+ do 160 j = lp1, p
+ t = -cdotc(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call caxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ if (j .lt. pl .or. j .gt. pu) go to 150
+ if (cabs1(qraux(j)) .eq. 0.0e0) go to 150
+ tt = 1.0e0 - (cabs(x(l,j))/real(qraux(j)))**2
+ tt = amax1(tt,0.0e0)
+ t = cmplx(tt,0.0e0)
+ tt = 1.0e0
+ * + 0.05e0*tt*(real(qraux(j))/real(work(j)))**2
+ if (tt .eq. 1.0e0) go to 130
+ qraux(j) = qraux(j)*csqrt(t)
+ go to 140
+ 130 continue
+ qraux(j) = cmplx(scnrm2(n-l,x(l+1,j),1),0.0e0)
+ work(j) = qraux(j)
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c save the transformation.
+c
+ qraux(l) = x(l,l)
+ x(l,l) = -nrmxl
+ 180 continue
+ 190 continue
+ 200 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.c
new file mode 100644
index 0000000000000000000000000000000000000000..57f4b451bf645986e8ffacc737e87faddd6fae7f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.c
@@ -0,0 +1,312 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void cqrsl_(x, ldx, n, k, qraux, y, qy, qty, b, rsd, xb, job, info)
+const complex *x;
+const integer *ldx, *n, *k;
+const complex *qraux, *y;
+complex *qy, *qty, *b, *rsd, *xb;
+integer *job, *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static complex temp;
+ static logical cqty;
+ static integer i, j;
+ static complex t;
+ static logical cb;
+ static logical cr;
+ static integer ju;
+ static logical cxb, cqy;
+
+/************************************************************************/
+/* */
+/* cqrsl applies the output of cqrdc to compute coordinate */
+/* transformations, projections, and least squares solutions. */
+/* for k .le. min(n,p), let xk be the matrix */
+/* */
+/* xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) */
+/* */
+/* formed from columns jpvt(1), ... ,jpvt(k) of the original */
+/* n x p matrix x that was input to cqrdc (if no pivoting was */
+/* done, xk consists of the first k columns of x in their */
+/* original order). cqrdc produces a factored unitary matrix q */
+/* and an upper triangular matrix r such that */
+/* */
+/* xk = q * (r) */
+/* (0) */
+/* */
+/* this information is contained in coded form in the arrays */
+/* x and qraux. */
+/* */
+/* on entry */
+/* */
+/* x complex(ldx,p). */
+/* x contains the output of cqrdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix xk. it must */
+/* have the same value as n in cqrdc. */
+/* */
+/* k integer. */
+/* k is the number of columns of the matrix xk. k */
+/* must not be greater than min(n,p), where p is the */
+/* same as in the calling sequence to cqrdc. */
+/* */
+/* qraux complex(p). */
+/* qraux contains the auxiliary output from cqrdc. */
+/* */
+/* y complex(n) */
+/* y contains an n-vector that is to be manipulated */
+/* by cqrsl. */
+/* */
+/* job integer. */
+/* job specifies what is to be computed. job has */
+/* the decimal expansion abcde, with the following */
+/* meaning. */
+/* */
+/* if a.ne.0, compute qy. */
+/* if b,c,d, or e .ne. 0, compute qty. */
+/* if c.ne.0, compute b. */
+/* if d.ne.0, compute rsd. */
+/* if e.ne.0, compute xb. */
+/* */
+/* note that a request to compute b, rsd, or xb */
+/* automatically triggers the computation of qty, */
+/* for which an array must be provided in the */
+/* calling sequence. */
+/* */
+/* on return */
+/* */
+/* qy complex(n). */
+/* qy contains q*y, if its computation has been */
+/* requested. */
+/* */
+/* qty complex(n). */
+/* qty contains ctrans(q)*y, if its computation has */
+/* been requested. here ctrans(q) is the conjugate */
+/* transpose of the matrix q. */
+/* */
+/* b complex(k) */
+/* b contains the solution of the least squares problem */
+/* */
+/* minimize norm2(y - xk*b), */
+/* */
+/* if its computation has been requested. (note that */
+/* if pivoting was requested in cqrdc, the j-th */
+/* component of b will be associated with column jpvt(j) */
+/* of the original matrix x that was input into cqrdc.) */
+/* */
+/* rsd complex(n). */
+/* rsd contains the least squares residual y - xk*b, */
+/* if its computation has been requested. rsd is */
+/* also the orthogonal projection of y onto the */
+/* orthogonal complement of the column space of xk. */
+/* */
+/* xb complex(n). */
+/* xb contains the least squares approximation xk*b, */
+/* if its computation has been requested. xb is also */
+/* the orthogonal projection of y onto the column space */
+/* of x. */
+/* */
+/* info integer. */
+/* info is zero unless the computation of b has */
+/* been requested and r is exactly singular. in */
+/* this case, info is the index of the first zero */
+/* diagonal element of r and b is left unaltered. */
+/* */
+/* the parameters qy, qty, b, rsd, and xb are not referenced */
+/* if their computation is not requested and in this case */
+/* can be replaced by dummy variables in the calling program. */
+/* to save storage, the user may in some cases use the same */
+/* array for different parameters in the calling sequence. a */
+/* frequently occurring example is when one wishes to compute */
+/* any of b, rsd, or xb and does not need y or qty. in this */
+/* case one may identify y, qty, and one of b, rsd, or xb, while */
+/* providing separate arrays for anything else that is to be */
+/* computed. thus the calling sequence */
+/* */
+/* call cqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info) */
+/* */
+/* will result in the computation of b and rsd, with rsd */
+/* overwriting y. more generally, each item in the following */
+/* list contains groups of permissible identifications for */
+/* a single callinng sequence. */
+/* */
+/* 1. (y,qty,b) (rsd) (xb) (qy) */
+/* 2. (y,qty,rsd) (b) (xb) (qy) */
+/* 3. (y,qty,xb) (b) (rsd) (qy) */
+/* 4. (y,qy) (qty,b) (rsd) (xb) */
+/* 5. (y,qy) (qty,rsd) (b) (xb) */
+/* 6. (y,qy) (qty,xb) (b) (rsd) */
+/* */
+/* in any group the value returned in the array allocated to */
+/* the group corresponds to the last member of the group. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+/* */
+/* cqrsl uses the following functions and subprograms. */
+/* */
+/* blas caxpy,ccopy,cdotc */
+/* fortran aimag,min0,mod,real */
+/* */
+/************************************************************************/
+
+/* set info flag. */
+ *info = 0;
+
+/* determine what is to be computed. */
+
+ cqy = *job / 10000 != 0;
+ cqty = *job % 10000 != 0;
+ cb = *job % 1000 / 100 != 0;
+ cr = *job % 100 / 10 != 0;
+ cxb = *job % 10 != 0;
+ ju = min(*k, *n - 1);
+
+/* special action when n=1. */
+
+ if (ju == 0) {
+ if (cqy) {
+ qy[0].r = y[0].r, qy[0].i = y[0].i;
+ }
+ if (cqty) {
+ qty[0].r = y[0].r, qty[0].i = y[0].i;
+ }
+ if (cxb) {
+ xb[0].r = y[0].r, xb[0].i = y[0].i;
+ }
+ if (cb) {
+ if (x[0].r == 0.f && x[0].i == 0.f) {
+ *info = 1;
+ }
+ else {
+ c_div(b, y, x);
+ }
+ }
+ if (cr) {
+ rsd[0].r = 0.f, rsd[0].i = 0.f;
+ }
+ return;
+ }
+
+/* set up to compute qy or qty. */
+
+ if (cqy) {
+ ccopy_(n, y, &c__1, qy, &c__1);
+ }
+ if (cqty) {
+ ccopy_(n, y, &c__1, qty, &c__1);
+ }
+
+/* compute qy. */
+
+ if (cqy)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j].r == 0.f && qraux[j].i == 0.f) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((complex*)x)[i__1].r = qraux[j].r, ((complex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ cdotc_(&t, &i__2, &x[i__1], &c__1, &qy[j], &c__1);
+ c_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ caxpy_(&i__2, &t, &x[i__1], &c__1, &qy[j], &c__1);
+ ((complex*)x)[i__1].r = temp.r, ((complex*)x)[i__1].i = temp.i; /* restore original */
+ }
+
+/* compute ctrans(q)*y. */
+
+ if (cqty)
+ for (j = 0; j < ju; ++j) {
+ if (qraux[j].r == 0.f && qraux[j].i == 0.f) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((complex*)x)[i__1].r = qraux[j].r, ((complex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ cdotc_(&t, &i__2, &x[i__1], &c__1, &qty[j], &c__1);
+ c_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ caxpy_(&i__2, &t, &x[i__1], &c__1, &qty[j], &c__1);
+ ((complex*)x)[i__1].r = temp.r, ((complex*)x)[i__1].i = temp.i; /* restore original */
+ }
+
+/* set up to compute b, rsd, or xb. */
+
+ if (cb) {
+ ccopy_(k, qty, &c__1, b, &c__1);
+ }
+ if (cxb) {
+ ccopy_(k, qty, &c__1, xb, &c__1);
+ }
+ if (cr && *k < *n) {
+ i__2 = *n - *k;
+ ccopy_(&i__2, &qty[*k], &c__1, &rsd[*k], &c__1);
+ }
+ if (cxb && *k < *n)
+ for (i = *k; i < *n; ++i) {
+ xb[i].r = 0.f, xb[i].i = 0.f;
+ }
+ if (cr)
+ for (i = 0; i < *k; ++i) {
+ rsd[i].r = 0.f, rsd[i].i = 0.f;
+ }
+
+/* compute b. */
+
+ if (cb)
+ for (j = *k-1; j >= 0; --j) {
+ i__1 = j * *ldx + j; /* index [j,j] */
+ if (x[i__1].r == 0.f && x[i__1].i == 0.f) {
+ *info = j+1;
+ break; /* last j */
+ }
+ c_div(&b[j], &b[j], &x[i__1]);
+ if (j == 0) {
+ break; /* last j */
+ }
+ t.r = -b[j].r, t.i = -b[j].i;
+ caxpy_(&j, &t, &x[j* *ldx], &c__1, b, &c__1);
+ }
+
+/* compute rsd or xb as required. */
+
+ if (cr || cxb)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j].r == 0.f && qraux[j].i == 0.f) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((complex*)x)[i__1].r = qraux[j].r, ((complex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ if (cr) {
+ cdotc_(&t, &i__2, &x[i__1], &c__1, &rsd[j], &c__1);
+ c_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ caxpy_(&i__2, &t, &x[i__1], &c__1, &rsd[j], &c__1);
+ }
+ if (cxb) {
+ cdotc_(&t, &i__2, &x[i__1], &c__1, &xb[j], &c__1);
+ c_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ caxpy_(&i__2, &t, &x[i__1], &c__1, &xb[j], &c__1);
+ }
+ ((complex*)x)[i__1].r = temp.r, ((complex*)x)[i__1].i = temp.i; /* restore original */
+ }
+} /* cqrsl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.f
new file mode 100644
index 0000000000000000000000000000000000000000..9e848bfca37b5ac13114b9ae45efaaae29664cdf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cqrsl.f
@@ -0,0 +1,276 @@
+ subroutine cqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info)
+ integer ldx,n,k,job,info
+ complex x(ldx,1),qraux(1),y(1),qy(1),qty(1),b(1),rsd(1),xb(1)
+c
+c cqrsl applies the output of cqrdc to compute coordinate
+c transformations, projections, and least squares solutions.
+c for k .le. min(n,p), let xk be the matrix
+c
+c xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k)))
+c
+c formed from columns jpvt(1), ... ,jpvt(k) of the original
+c n x p matrix x that was input to cqrdc (if no pivoting was
+c done, xk consists of the first k columns of x in their
+c original order). cqrdc produces a factored unitary matrix q
+c and an upper triangular matrix r such that
+c
+c xk = q * (r)
+c (0)
+c
+c this information is contained in coded form in the arrays
+c x and qraux.
+c
+c on entry
+c
+c x complex(ldx,p).
+c x contains the output of cqrdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix xk. it must
+c have the same value as n in cqrdc.
+c
+c k integer.
+c k is the number of columns of the matrix xk. k
+c must nnot be greater than min(n,p), where p is the
+c same as in the calling sequence to cqrdc.
+c
+c qraux complex(p).
+c qraux contains the auxiliary output from cqrdc.
+c
+c y complex(n)
+c y contains an n-vector that is to be manipulated
+c by cqrsl.
+c
+c job integer.
+c job specifies what is to be computed. job has
+c the decimal expansion abcde, with the following
+c meaning.
+c
+c if a.ne.0, compute qy.
+c if b,c,d, or e .ne. 0, compute qty.
+c if c.ne.0, compute b.
+c if d.ne.0, compute rsd.
+c if e.ne.0, compute xb.
+c
+c note that a request to compute b, rsd, or xb
+c automatically triggers the computation of qty, for
+c which an array must be provided in the calling
+c sequence.
+c
+c on return
+c
+c qy complex(n).
+c qy contains q*y, if its computation has been
+c requested.
+c
+c qty complex(n).
+c qty contains ctrans(q)*y, if its computation has
+c been requested. here ctrans(q) is the conjugate
+c transpose of the matrix q.
+c
+c b complex(k)
+c b contains the solution of the least squares problem
+c
+c minimize norm2(y - xk*b),
+c
+c if its computation has been requested. (note that
+c if pivoting was requested in cqrdc, the j-th
+c component of b will be associated with column jpvt(j)
+c of the original matrix x that was input into cqrdc.)
+c
+c rsd complex(n).
+c rsd contains the least squares residual y - xk*b,
+c if its computation has been requested. rsd is
+c also the orthogonal projection of y onto the
+c orthogonal complement of the column space of xk.
+c
+c xb complex(n).
+c xb contains the least squares approximation xk*b,
+c if its computation has been requested. xb is also
+c the orthogonal projection of y onto the column space
+c of x.
+c
+c info integer.
+c info is zero unless the computation of b has
+c been requested and r is exactly singular. in
+c this case, info is the index of the first zero
+c diagonal element of r and b is left unaltered.
+c
+c the parameters qy, qty, b, rsd, and xb are not referenced
+c if their computation is not requested and in this case
+c can be replaced by dummy variables in the calling program.
+c to save storage, the user may in some cases use the same
+c array for different parameters in the calling sequence. a
+c frequently occurring example is when one wishes to compute
+c any of b, rsd, or xb and does not need y or qty. in this
+c case one may identify y, qty, and one of b, rsd, or xb, while
+c providing separate arrays for anything else that is to be
+c computed. thus the calling sequence
+c
+c call cqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info)
+c
+c will result in the computation of b and rsd, with rsd
+c overwriting y. more generally, each item in the following
+c list contains groups of permissible identifications for
+c a single callinng sequence.
+c
+c 1. (y,qty,b) (rsd) (xb) (qy)
+c
+c 2. (y,qty,rsd) (b) (xb) (qy)
+c
+c 3. (y,qty,xb) (b) (rsd) (qy)
+c
+c 4. (y,qy) (qty,b) (rsd) (xb)
+c
+c 5. (y,qy) (qty,rsd) (b) (xb)
+c
+c 6. (y,qy) (qty,xb) (b) (rsd)
+c
+c in any group the value returned in the array allocated to
+c the group corresponds to the last member of the group.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c cqrsl uses the following functions and subprograms.
+c
+c blas caxpy,ccopy,cdotc
+c fortran abs,aimag,min0,mod,real
+c
+c internal variables
+c
+ integer i,j,jj,ju,kp1
+ complex cdotc,t,temp
+ logical cb,cqy,cqty,cr,cxb
+c
+ complex zdum
+ real cabs1
+ cabs1(zdum) = abs(real(zdum)) + abs(aimag(zdum))
+c
+c set info flag.
+c
+ info = 0
+c
+c determine what is to be computed.
+c
+ cqy = job/10000 .ne. 0
+ cqty = mod(job,10000) .ne. 0
+ cb = mod(job,1000)/100 .ne. 0
+ cr = mod(job,100)/10 .ne. 0
+ cxb = mod(job,10) .ne. 0
+ ju = min0(k,n-1)
+c
+c special action when n=1.
+c
+ if (ju .ne. 0) go to 40
+ if (cqy) qy(1) = y(1)
+ if (cqty) qty(1) = y(1)
+ if (cxb) xb(1) = y(1)
+ if (.not.cb) go to 30
+ if (cabs1(x(1,1)) .ne. 0.0e0) go to 10
+ info = 1
+ go to 20
+ 10 continue
+ b(1) = y(1)/x(1,1)
+ 20 continue
+ 30 continue
+ if (cr) rsd(1) = (0.0e0,0.0e0)
+ go to 250
+ 40 continue
+c
+c set up to compute qy or qty.
+c
+ if (cqy) call ccopy(n,y,1,qy,1)
+ if (cqty) call ccopy(n,y,1,qty,1)
+ if (.not.cqy) go to 70
+c
+c compute qy.
+c
+ do 60 jj = 1, ju
+ j = ju - jj + 1
+ if (cabs1(qraux(j)) .eq. 0.0e0) go to 50
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -cdotc(n-j+1,x(j,j),1,qy(j),1)/x(j,j)
+ call caxpy(n-j+1,t,x(j,j),1,qy(j),1)
+ x(j,j) = temp
+ 50 continue
+ 60 continue
+ 70 continue
+ if (.not.cqty) go to 100
+c
+c compute ctrans(q)*y.
+c
+ do 90 j = 1, ju
+ if (cabs1(qraux(j)) .eq. 0.0e0) go to 80
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -cdotc(n-j+1,x(j,j),1,qty(j),1)/x(j,j)
+ call caxpy(n-j+1,t,x(j,j),1,qty(j),1)
+ x(j,j) = temp
+ 80 continue
+ 90 continue
+ 100 continue
+c
+c set up to compute b, rsd, or xb.
+c
+ if (cb) call ccopy(k,qty,1,b,1)
+ kp1 = k + 1
+ if (cxb) call ccopy(k,qty,1,xb,1)
+ if (cr .and. k .lt. n) call ccopy(n-k,qty(kp1),1,rsd(kp1),1)
+ if (.not.cxb .or. kp1 .gt. n) go to 120
+ do 110 i = kp1, n
+ xb(i) = (0.0e0,0.0e0)
+ 110 continue
+ 120 continue
+ if (.not.cr) go to 140
+ do 130 i = 1, k
+ rsd(i) = (0.0e0,0.0e0)
+ 130 continue
+ 140 continue
+ if (.not.cb) go to 190
+c
+c compute b.
+c
+ do 170 jj = 1, k
+ j = k - jj + 1
+ if (cabs1(x(j,j)) .ne. 0.0e0) go to 150
+ info = j
+c ......exit
+ go to 180
+ 150 continue
+ b(j) = b(j)/x(j,j)
+ if (j .eq. 1) go to 160
+ t = -b(j)
+ call caxpy(j-1,t,x(1,j),1,b,1)
+ 160 continue
+ 170 continue
+ 180 continue
+ 190 continue
+ if (.not.cr .and. .not.cxb) go to 240
+c
+c compute rsd or xb as required.
+c
+ do 230 jj = 1, ju
+ j = ju - jj + 1
+ if (cabs1(qraux(j)) .eq. 0.0e0) go to 220
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ if (.not.cr) go to 200
+ t = -cdotc(n-j+1,x(j,j),1,rsd(j),1)/x(j,j)
+ call caxpy(n-j+1,t,x(j,j),1,rsd(j),1)
+ 200 continue
+ if (.not.cxb) go to 210
+ t = -cdotc(n-j+1,x(j,j),1,xb(j),1)/x(j,j)
+ call caxpy(n-j+1,t,x(j,j),1,xb(j),1)
+ 210 continue
+ x(j,j) = temp
+ 220 continue
+ 230 continue
+ 240 continue
+ 250 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.c
new file mode 100644
index 0000000000000000000000000000000000000000..3980533a1a9cc9cbb02d390d447bc5ef3c40cc1c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void cscal_(n, ca, cx, incx)
+const integer *n;
+const complex *ca;
+complex *cx;
+const integer *incx;
+{
+ /* System generated locals */
+ complex q__1;
+
+ /* Local variables */
+ static integer i, ix;
+
+/* scales a vector by a constant. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0 || *incx <= 0) {
+ return;
+ }
+
+ if (*incx == 1) {
+ for (i = 0; i < *n; ++i) {
+ q__1.r = ca->r * cx[i].r - ca->i * cx[i].i,
+ q__1.i = ca->r * cx[i].i + ca->i * cx[i].r;
+ cx[i].r = q__1.r, cx[i].i = q__1.i;
+ }
+ }
+ else {
+ for (i = ix = 0; i < *n; ++i, ix += *incx) {
+ q__1.r = ca->r * cx[ix].r - ca->i * cx[ix].i,
+ q__1.i = ca->r * cx[ix].i + ca->i * cx[ix].r;
+ cx[ix].r = q__1.r, cx[ix].i = q__1.i;
+ }
+ }
+ return;
+} /* cscal_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.f
new file mode 100644
index 0000000000000000000000000000000000000000..56eeebac80de47c902075cc94916191cf2d0cf15
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cscal.f
@@ -0,0 +1,28 @@
+ subroutine cscal(n,ca,cx,incx)
+c
+c scales a vector by a constant.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ complex ca,cx(*)
+ integer i,incx,n,nincx
+c
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ cx(i) = ca*cx(i)
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 do 30 i = 1,n
+ cx(i) = ca*cx(i)
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.c
new file mode 100644
index 0000000000000000000000000000000000000000..1d7663ff70dd41c737583fa5495f42d59f4b8f29
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.c
@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void csrot_(n, cx, incx, cy, incy, c, s)
+const integer *n;
+complex *cx;
+const integer *incx;
+complex *cy;
+const integer *incy;
+const real *c, *s;
+{
+ /* Local variables */
+ static integer i;
+ static complex ctemp;
+ static integer ix, iy;
+
+/* applies a plane rotation, where the cos and sin (c and s) are real */
+/* and the vectors cx and cy are complex. */
+/* jack dongarra, linpack, 3/11/78. */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ctemp.r = *c * cx[i].r + *s * cy[i].r,
+ ctemp.i = *c * cx[i].i + *s * cy[i].i;
+ cy[i].r = *c * cy[i].r - *s * cx[i].r,
+ cy[i].i = *c * cy[i].i - *s * cx[i].i;
+ cx[i].r = ctemp.r, cx[i].i = ctemp.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ctemp.r = *c * cx[ix].r + *s * cy[iy].r,
+ ctemp.i = *c * cx[ix].i + *s * cy[iy].i;
+ cy[iy].r = *c * cy[iy].r - *s * cx[ix].r,
+ cy[iy].i = *c * cy[iy].i - *s * cx[ix].i;
+ cx[ix].r = ctemp.r, cx[ix].i = ctemp.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* csrot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.f
new file mode 100644
index 0000000000000000000000000000000000000000..d0a5f695e4014f2c38684600929469ce7f284b03
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/csrot.f
@@ -0,0 +1,38 @@
+ subroutine csrot (n,cx,incx,cy,incy,c,s)
+c
+c applies a plane rotation, where the cos and sin (c and s) are real
+c and the vectors cx and cy are complex.
+c jack dongarra, linpack, 3/11/78.
+c
+ complex cx(1),cy(1),ctemp
+ real c,s
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ctemp = c*cx(ix) + s*cy(iy)
+ cy(iy) = c*cy(iy) - s*cx(ix)
+ cx(ix) = ctemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ ctemp = c*cx(i) + s*cy(i)
+ cy(i) = c*cy(i) - s*cx(i)
+ cx(i) = ctemp
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..ed802d8af4940e34b222819c3e50c6f147d99e5c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.c
@@ -0,0 +1,579 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/*
+ * Calling this ensures that the operands are spilled to
+ * memory and thus avoids excessive precision when compiling
+ * for x86 with heavy optimization (gcc). It is better to do
+ * this than to turn on -ffloat-store.
+ */
+static int fsm_ieee_floats_equal(const real *x, const real *y);
+
+/* Table of constant values */
+static integer c__1 = 1;
+static complex c_1 = {1.f,0.f};
+static complex c_m1 = {-1.f,0.f};
+
+/* Subroutine */ void csvdc_(x, ldx, n, p, s, e, u, ldu, v, ldv, work, job, info)
+complex *x;
+const integer *ldx, *n, *p;
+complex *s, *e, *u;
+const integer *ldu;
+complex *v;
+const integer *ldv;
+complex *work;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ real r__1, r__2;
+ complex q__1;
+
+ /* Local variables */
+ static integer jobu, iter;
+ static real test;
+ static real b, c;
+ static real f, g;
+ static integer i, j, k, l, m;
+ static complex r, t;
+ static real scale;
+ static real shift;
+ static integer maxit;
+ static logical wantu, wantv;
+ static real t1, ztest;
+ static real el;
+ static real cs;
+ static integer mm, ls;
+ static real sl;
+ static integer lu;
+ static real sm, sn;
+ static integer nct, ncu, nrt;
+ static real emm1, smm1;
+
+/************************************************************************/
+/* */
+/* csvdc is a subroutine to reduce a complex nxp matrix x by */
+/* unitary transformations u and v to diagonal form. the */
+/* diagonal elements s(i) are the singular values of x. the */
+/* columns of u are the corresponding left singular vectors, */
+/* and the columns of v the right singular vectors. */
+/* */
+/* on entry */
+/* */
+/* x complex(ldx,p), where ldx.ge.n. */
+/* x contains the matrix whose singular value */
+/* decomposition is to be computed. x is */
+/* destroyed by csvdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* ldu integer. */
+/* ldu is the leading dimension of the array u */
+/* (see below). */
+/* */
+/* ldv integer. */
+/* ldv is the leading dimension of the array v */
+/* (see below). */
+/* */
+/* work complex(n). */
+/* work is a scratch array. */
+/* */
+/* job integer. */
+/* job controls the computation of the singular */
+/* vectors. it has the decimal expansion ab */
+/* with the following meaning */
+/* */
+/* a.eq.0 do not compute the left singular */
+/* vectors. */
+/* a.eq.1 return the n left singular vectors */
+/* in u. */
+/* a.ge.2 returns the first min(n,p) */
+/* left singular vectors in u. */
+/* b.eq.0 do not compute the right singular */
+/* vectors. */
+/* b.eq.1 return the right singular vectors */
+/* in v. */
+/* */
+/* on return */
+/* */
+/* s complex(mm), where mm=min(n+1,p). */
+/* the first min(n,p) entries of s contain the */
+/* singular values of x arranged in descending */
+/* order of magnitude. */
+/* */
+/* e complex(p). */
+/* e ordinarily contains zeros. however see the */
+/* discussion of info for exceptions. */
+/* */
+/* u complex(ldu,k), where ldu.ge.n. if joba.eq.1 */
+/* then k.eq.n, if joba.ge.2 then */
+/* k.eq.min(n,p). */
+/* u contains the matrix of left singular vectors. */
+/* u is not referenced if joba.eq.0. if n.le.p */
+/* or if joba.gt.2, then u may be identified with x */
+/* in the subroutine call. */
+/* */
+/* v complex(ldv,p), where ldv.ge.p. */
+/* v contains the matrix of right singular vectors. */
+/* v is not referenced if jobb.eq.0. if p.le.n, */
+/* then v may be identified whth x in the */
+/* subroutine call. */
+/* */
+/* info integer. */
+/* the singular values (and their corresponding */
+/* singular vectors) s(info+1),s(info+2),...,s(m) */
+/* are correct (here m=min(n,p)). thus if */
+/* info.eq.0, all the singular values and their */
+/* vectors are correct. in any event, the matrix */
+/* b = ctrans(u)*x*v is the bidiagonal matrix */
+/* with the elements of s on its diagonal and the */
+/* elements of e on its super-diagonal (ctrans(u) */
+/* is the conjugate-transpose of u). thus the */
+/* singular values of x and b are the same. */
+/* */
+/************************************************************************/
+
+/* linpack. this version dated 03/19/79 . */
+/* correction to shift calculation made 2/85. */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* csvdc uses the following functions and subprograms. */
+/* */
+/* external csrot */
+/* blas caxpy,cdotc,cscal,cswap,scnrm2,srotg */
+/* fortran aimag,amax1,cabs,cmplx */
+/* fortran conjg,max0,min0,mod,real,sqrt */
+
+/* set the maximum number of iterations. */
+ maxit = 30;
+
+/* determine what is to be computed. */
+
+ wantu = FALSE_;
+ wantv = FALSE_;
+ jobu = *job % 100 / 10;
+ ncu = *n;
+ if (jobu > 1) {
+ ncu = min(*n,*p);
+ }
+ if (jobu != 0) {
+ wantu = TRUE_;
+ }
+ if (*job % 10 != 0) {
+ wantv = TRUE_;
+ }
+
+/* reduce x to bidiagonal form, storing the diagonal elements */
+/* in s and the super-diagonal elements in e. */
+
+ *info = 0;
+ nct = min(*n - 1, *p);
+ nrt = max(0, min(*p - 2, *n));
+ lu = max(nct,nrt);
+
+ for (l = 0; l < lu; ++l) {
+ if (l > nct-1) {
+ goto L20;
+ }
+
+/* compute the transformation for the l-th column and */
+/* place the l-th diagonal in s(l). */
+
+ i__1 = *n - l;
+ s[l].r = scnrm2_(&i__1, &x[l+l* *ldx], &c__1);
+ s[l].i = 0.f;
+ if (s[l].r == 0.f) {
+ goto L10;
+ }
+ i__2 = l + l * *ldx; /* index [l,l] */
+ if (x[i__2].r != 0.f || x[i__2].i != 0.f) {
+ r__1 = c_abs(&s[l]);
+ r__2 = c_abs(&x[i__2]);
+ s[l].r = r__1 * x[i__2].r / r__2,
+ s[l].i = r__1 * x[i__2].i / r__2;
+ }
+ c_div(&q__1, &c_1, &s[l]);
+ i__1 = *n - l;
+ cscal_(&i__1, &q__1, &x[i__2], &c__1);
+ x[i__2].r += 1.f;
+L10:
+ s[l].r = -s[l].r, s[l].i = -s[l].i;
+L20:
+ for (j = l+1; j < *p; ++j) {
+
+/* apply the transformation. */
+
+ if (l < nct && (s[l].r != 0.f || s[l].i != 0.f)) {
+ i__1 = *n - l;
+ i__2 = l + l * *ldx; /* index [l,l] */
+ cdotc_(&t, &i__1, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ c_div(&t, &t, &x[i__2]);
+ caxpy_(&i__1, &t, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ }
+
+/* place the l-th row of x into e for the */
+/* subsequent calculation of the row transformation. */
+
+ r_cnjg(&e[j], &x[l+j* *ldx]);
+ }
+
+/* place the transformation in u for subsequent back */
+/* multiplication. */
+
+ if (wantu && l < nct)
+ for (i = l; i < *n; ++i) {
+ i__1 = i + l * *ldu; /* index [i,l] */
+ i__2 = i + l * *ldx; /* index [i,l] */
+ u[i__1].r = x[i__2].r, u[i__1].i = x[i__2].i;
+ }
+
+ if (l >= nrt) {
+ continue; /* next l */
+ }
+
+/* compute the l-th row transformation and place the */
+/* l-th super-diagonal in e(l). */
+
+ i__1 = *p - l - 1;
+ e[l].r = scnrm2_(&i__1, &e[l+1], &c__1);
+ e[l].i = 0.f;
+ if (e[l].r != 0.f) {
+ if (e[l+1].r != 0.f || e[l+1].i != 0.f) {
+ r__1 = c_abs(&e[l]); r__2 = c_abs(&e[l+1]);
+ e[l].r = r__1 * e[l+1].r / r__2,
+ e[l].i = r__1 * e[l+1].i / r__2;
+ }
+ i__1 = *p - l - 1;
+ c_div(&q__1, &c_1, &e[l]);
+ cscal_(&i__1, &q__1, &e[l+1], &c__1);
+ e[l+1].r += 1.f;
+ }
+ e[l].r = -e[l].r; /* e[l] = - conj(e[l]) */
+ if (l >= *n-1 || (e[l].r == 0.f && e[l].i == 0.f)) {
+ goto L120;
+ }
+
+/* apply the transformation. */
+
+ for (i = l+1; i < *n; ++i) {
+ work[i].r = 0.f, work[i].i = 0.f;
+ }
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l - 1;
+ caxpy_(&i__1, &e[j], &x[l+1 +j* *ldx], &c__1, &work[l+1], &c__1);
+ }
+ for (j = l+1; j < *p; ++j) {
+ q__1.r = -e[j].r, q__1.i = -e[j].i;
+ c_div(&q__1, &q__1, &e[l+1]);
+ q__1.i = -q__1.i; /* r_cnjg(&q__1, &q__1); */
+ i__1 = *n - l - 1;
+ caxpy_(&i__1, &q__1, &work[l+1], &c__1, &x[l+1 +j* *ldx], &c__1);
+ }
+
+/* place the transformation in v for subsequent */
+/* back multiplication. */
+
+L120:
+ if (wantv)
+ for (i = l+1; i < *p; ++i) {
+ i__1 = i + l * *ldv; /* index [i,l] */
+ v[i__1].r = e[i].r, v[i__1].i = e[i].i;
+ }
+ }
+
+/* set up the final bidiagonal matrix or order m. */
+
+ m = min(*p-1, *n);
+ if (nct < *p) {
+ i__1 = nct * (*ldx+1); /* index [nct,nct] */
+ s[nct].r = x[i__1].r, s[nct].i = x[i__1].i;
+ }
+ if (*n-1 < m) {
+ s[m].r = 0.f, s[m].i = 0.f;
+ }
+ if (nrt < m) {
+ i__1 = nrt + m * *ldx; /* index [nrt,m] */
+ e[nrt].r = x[i__1].r, e[nrt].i = x[i__1].i;
+ }
+ e[m].r = 0.f, e[m].i = 0.f;
+
+/* if required, generate u. */
+
+ if (wantu)
+ for (j = nct; j < ncu; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + j * *ldu; /* index [i,j] */
+ u[i__1].r = 0.f, u[i__1].i = 0.f;
+ }
+ i__1 = j + j * *ldu;
+ u[i__1].r = 1.f, u[i__1].i = 0.f;
+ }
+ if (wantu)
+ for (l = nct-1; l >= 0; --l) {
+ if (s[l].r == 0.f && s[l].i == 0.f) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + l * *ldu; /* index [i,l] */
+ u[i__1].r = 0.f, u[i__1].i = 0.f;
+ }
+ i__1 = l + l * *ldu; /* index [l,l] */
+ u[i__1].r = 1.f, u[i__1].i = 0.f;
+ continue; /* next l */
+ }
+ i__1 = *n - l;
+ i__2 = l + l * *ldu; /* index [l,l] */
+ for (j = l+1; j < ncu; ++j) {
+ cdotc_(&t, &i__1, &u[i__2], &c__1, &u[l+j* *ldu], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ c_div(&t, &t, &u[i__2]);
+ caxpy_(&i__1, &t, &u[i__2], &c__1, &u[l+j* *ldu], &c__1);
+ }
+ cscal_(&i__1, &c_m1, &u[i__2], &c__1);
+ u[i__2].r += 1.f;
+ for (i = 0; i < l; ++i) {
+ i__1 = i + l * *ldu;
+ u[i__1].r = 0.f, u[i__1].i = 0.f;
+ }
+ }
+
+/* if it is required, generate v. */
+
+ if (wantv)
+ for (l = *p-1; l >= 0; --l) {
+ if (l < nrt && (e[l].r != 0.f || e[l].i != 0.f))
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *p - l - 1;
+ i__2 = l+1 + l * *ldv; /* index [l+1,l] */
+ cdotc_(&t, &i__1, &v[i__2], &c__1, &v[l+1 +j* *ldv], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ c_div(&t, &t, &v[i__2]);
+ caxpy_(&i__1, &t, &v[i__2], &c__1, &v[l+1 +j* *ldv], &c__1);
+ }
+ for (i = 0; i < *p; ++i) {
+ i__1 = i + l * *ldv; /* index [i,l] */
+ v[i__1].r = 0.f, v[i__1].i = 0.f;
+ }
+ i__1 = l + l * *ldv; /* index [l,l] */
+ v[i__1].r = 1.f, v[i__1].i = 0.f;
+ }
+
+/* transform s and e so that they are real. */
+
+ for (i = 0; i <= m; ++i) {
+ if (s[i].r != 0.f || s[i].i != 0.f) {
+ t.r = c_abs(&s[i]), t.i = 0.f;
+ c_div(&r, &s[i], &t);
+ s[i].r = t.r, s[i].i = t.i;
+ if (i < m) {
+ c_div(&e[i], &e[i], &r);
+ }
+ if (wantu) {
+ cscal_(n, &r, &u[i* *ldu], &c__1);
+ }
+ }
+ if (i == m) {
+ break; /* last i */
+ }
+ if (e[i].r == 0.f && e[i].i == 0.f) {
+ continue; /* next i */
+ }
+ t.r = c_abs(&e[i]), t.i = 0.f;
+ c_div(&r, &t, &e[i]);
+ e[i].r = t.r, e[i].i = t.i;
+ q__1.r = s[i+1].r * r.r - s[i+1].i * r.i,
+ q__1.i = s[i+1].r * r.i + s[i+1].i * r.r;
+ s[i+1].r = q__1.r, s[i+1].i = q__1.i;
+ if (wantv) {
+ cscal_(p, &r, &v[(i+1)* *ldv], &c__1);
+ }
+ }
+
+/* main iteration loop for the singular values. */
+
+ mm = m;
+ iter = 0;
+
+/* quit if all the singular values have been found. */
+
+L400:
+ if (m == -1) {
+ return; /* exit from csvdc */
+ }
+
+/* if too many iterations have been performed, set */
+/* flag and return. */
+
+ if (iter >= maxit) {
+ *info = m+1;
+ return; /* exit from csvdc */
+ }
+
+/* this section of the program inspects for */
+/* negligible elements in the s and e arrays. on */
+/* completion the variables kase and l are set as follows. */
+
+/* kase = 1 if s(m) and e(l-1) are negligible and l.lt.m */
+/* kase = 2 if s(l) is negligible and l.lt.m */
+/* kase = 3 if e(l-1) is negligible, l.lt.m, and */
+/* s(l), ..., s(m) are not negligible (qr step). */
+/* kase = 4 if e(m-1) is negligible (convergence). */
+
+ for (l = m; l > 0; --l) {
+ test = c_abs(&s[l-1]) + c_abs(&s[l]);
+ ztest = test + c_abs(&e[l-1]);
+ if (fsm_ieee_floats_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ e[l-1].r = 0.f, e[l-1].i = 0.f;
+ break; /* last l */
+ }
+ }
+ if (l == m) { /* kase = 4 */ /* convergence. */
+
+/* make the singular value positive */
+
+ if (s[l].r < 0.f) {
+ s[l].r = -s[l].r, s[l].i = -s[l].i;
+ if (wantv) {
+ cscal_(p, &c_m1, &v[l* *ldv], &c__1);
+ }
+ }
+
+/* order the singular value. */
+
+ while (l != mm && s[l].r < s[l+1].r) {
+ t.r = s[l].r, t.i = s[l].i;
+ s[l].r = s[l+1].r, s[l].i = s[l+1].i;
+ s[l+1].r = t.r, s[l+1].i = t.i;
+ if (wantv && l < *p-1) {
+ cswap_(p, &v[l* *ldv], &c__1, &v[(l+1)* *ldv], &c__1);
+ }
+ if (wantu && l < *n-1) {
+ cswap_(n, &u[l* *ldu], &c__1, &u[(l+1)* *ldu], &c__1);
+ }
+ ++l;
+ }
+ iter = 0;
+ --m;
+ goto L400;
+ }
+ for (ls = m; ls >= l; --ls) {
+ test = 0.f;
+ if (ls != m) {
+ test += c_abs(&e[ls]);
+ }
+ if (ls != l) {
+ test += c_abs(&e[ls-1]);
+ }
+ ztest = test + c_abs(&s[ls]);
+ if (fsm_ieee_floats_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ s[ls].r = 0.f, s[ls].i = 0.f;
+ break; /* last ls */
+ }
+ }
+ if (ls == l-1) { /* kase = 3 */ /* perform one qr step. */
+
+/* calculate the shift. */
+
+ scale = c_abs(&s[m]),
+ scale = max(scale, c_abs(&s[m-1])),
+ scale = max(scale, c_abs(&e[m-1])),
+ scale = max(scale, c_abs(&s[l])),
+ scale = max(scale, c_abs(&e[l]));
+ sm = s[m].r / scale;
+ smm1 = s[m-1].r / scale;
+ emm1 = e[m-1].r / scale;
+ sl = s[l].r / scale;
+ el = e[l].r / scale;
+ b = ((smm1+sm) * (smm1-sm) + emm1*emm1) / 2.f;
+ c = sm * emm1; c *= c;
+ shift = 0.f;
+ if (b != 0.f || c != 0.f) {
+ shift = sqrtf(b*b + c);
+ if (b < 0.f) {
+ shift = -shift;
+ }
+ shift = c / (b + shift);
+ }
+ f = (sl + sm) * (sl - sm) + shift;
+ g = sl * el;
+
+/* chase zeros. */
+
+ for (k = l; k < m; ++k) {
+ srotg_(&f, &g, &cs, &sn);
+ if (k != l) {
+ e[k-1].r = f, e[k-1].i = 0.f;
+ }
+ f = cs * s[k].r + sn * e[k].r;
+ e[k].r = cs * e[k].r - sn * s[k].r,
+ e[k].i = cs * e[k].i - sn * s[k].i;
+ g = sn * s[k+1].r;
+ s[k+1].r *= cs, s[k+1].i *= cs;
+ if (wantv) {
+ csrot_(p, &v[k* *ldv], &c__1, &v[(k+1)* *ldv], &c__1, &cs, &sn);
+ }
+ srotg_(&f, &g, &cs, &sn);
+ s[k].r = f, s[k].i = 0.f;
+ f = cs * e[k].r + sn * s[k+1].r;
+ s[k+1].r = -sn * e[k].r + cs * s[k+1].r,
+ s[k+1].i = -sn * e[k].i + cs * s[k+1].i;
+ g = sn * e[k+1].r;
+ e[k+1].r *= cs, e[k+1].i *= cs;
+ if (wantu && k < *n-1) {
+ csrot_(n, &u[k* *ldu], &c__1, &u[(k+1)* *ldu], &c__1, &cs, &sn);
+ }
+ }
+ e[m-1].r = f, e[m-1].i = 0.f;
+ ++iter;
+ }
+ else if (ls == m) { /* kase = 1 */ /* deflate negligible s(m). */
+ f = e[m-1].r;
+ e[m-1].r = 0.f, e[m-1].i = 0.f;
+ for (k = m-1; k >= l; --k) {
+ t1 = s[k].r;
+ srotg_(&t1, &f, &cs, &sn);
+ s[k].r = t1, s[k].i = 0.f;
+ if (k != l) {
+ f = -sn * e[k-1].r;
+ e[k-1].r *= cs, e[k-1].i *= cs;
+ }
+ if (wantv) {
+ csrot_(p, &v[k* *ldv], &c__1, &v[m* *ldv], &c__1, &cs, &sn);
+ }
+ }
+ }
+ else { /* kase = 2 */ /* split at negligible s(l). */
+ /* l = ls + 1; */
+ f = e[ls].r;
+ e[ls].r = 0.f, e[ls].i = 0.f;
+ for (k = ls+1; k <= m; ++k) {
+ t1 = s[k].r;
+ srotg_(&t1, &f, &cs, &sn);
+ s[k].r = t1, s[k].i = 0.f;
+ f = -sn * e[k].r;
+ e[k].r *= cs, e[k].i *= cs;
+ if (wantu) {
+ csrot_(n, &u[k* *ldu], &c__1, &u[ls* *ldu], &c__1, &cs, &sn);
+ }
+ }
+ }
+ goto L400;
+
+} /* csvdc_ */
+
+static int fsm_ieee_floats_equal(const real *x, const real *y)
+{
+ return *x == *y;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..0a0eabc77dd73d7d5a68ed8122cf67c646207c10
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/csvdc.f
@@ -0,0 +1,509 @@
+ subroutine csvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info)
+ integer ldx,n,p,ldu,ldv,job,info
+ complex x(ldx,1),s(1),e(1),u(ldu,1),v(ldv,1),work(1)
+c
+c
+c csvdc is a subroutine to reduce a complex nxp matrix x by
+c unitary transformations u and v to diagonal form. the
+c diagonal elements s(i) are the singular values of x. the
+c columns of u are the corresponding left singular vectors,
+c and the columns of v the right singular vectors.
+c
+c on entry
+c
+c x complex(ldx,p), where ldx.ge.n.
+c x contains the matrix whose singular value
+c decomposition is to be computed. x is
+c destroyed by csvdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c ldu integer.
+c ldu is the leading dimension of the array u
+c (see below).
+c
+c ldv integer.
+c ldv is the leading dimension of the array v
+c (see below).
+c
+c work complex(n).
+c work is a scratch array.
+c
+c job integer.
+c job controls the computation of the singular
+c vectors. it has the decimal expansion ab
+c with the following meaning
+c
+c a.eq.0 do not compute the left singular
+c vectors.
+c a.eq.1 return the n left singular vectors
+c in u.
+c a.ge.2 returns the first min(n,p)
+c left singular vectors in u.
+c b.eq.0 do not compute the right singular
+c vectors.
+c b.eq.1 return the right singular vectors
+c in v.
+c
+c on return
+c
+c s complex(mm), where mm=min(n+1,p).
+c the first min(n,p) entries of s contain the
+c singular values of x arranged in descending
+c order of magnitude.
+c
+c e complex(p).
+c e ordinarily contains zeros. however see the
+c discussion of info for exceptions.
+c
+c u complex(ldu,k), where ldu.ge.n. if joba.eq.1 then
+c k.eq.n, if joba.ge.2 then
+c k.eq.min(n,p).
+c u contains the matrix of left singular vectors.
+c u is not referenced if joba.eq.0. if n.le.p
+c or if joba.gt.2, then u may be identified with x
+c in the subroutine call.
+c
+c v complex(ldv,p), where ldv.ge.p.
+c v contains the matrix of right singular vectors.
+c v is not referenced if jobb.eq.0. if p.le.n,
+c then v may be identified whth x in the
+c subroutine call.
+c
+c info integer.
+c the singular values (and their corresponding
+c singular vectors) s(info+1),s(info+2),...,s(m)
+c are correct (here m=min(n,p)). thus if
+c info.eq.0, all the singular values and their
+c vectors are correct. in any event, the matrix
+c b = ctrans(u)*x*v is the bidiagonal matrix
+c with the elements of s on its diagonal and the
+c elements of e on its super-diagonal (ctrans(u)
+c is the conjugate-transpose of u). thus the
+c singular values of x and b are the same.
+c
+c linpack. this version dated 03/19/79 .
+c correction to shift calculation made 2/85.
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c csvdc uses the following functions and subprograms.
+c
+c external csrot
+c blas caxpy,cdotc,cscal,cswap,scnrm2,srotg
+c fortran abs,aimag,amax1,cabs,cmplx
+c fortran conjg,max0,min0,mod,real,sqrt
+c
+c internal variables
+c
+ integer i,iter,j,jobu,k,kase,kk,l,ll,lls,lm1,lp1,ls,lu,m,maxit,
+ * mm,mm1,mp1,nct,nctp1,ncu,nrt,nrtp1
+ complex cdotc,t,r
+ real b,c,cs,el,emm1,f,g,scnrm2,scale,shift,sl,sm,sn,smm1,t1,test,
+ * ztest
+ logical wantu,wantv
+c
+ complex csign,zdum,zdum1,zdum2
+ real cabs1
+ cabs1(zdum) = abs(real(zdum)) + abs(aimag(zdum))
+ csign(zdum1,zdum2) = cabs(zdum1)*(zdum2/cabs(zdum2))
+c
+c set the maximum number of iterations.
+c
+ maxit = 30
+c
+c determine what is to be computed.
+c
+ wantu = .false.
+ wantv = .false.
+ jobu = mod(job,100)/10
+ ncu = n
+ if (jobu .gt. 1) ncu = min0(n,p)
+ if (jobu .ne. 0) wantu = .true.
+ if (mod(job,10) .ne. 0) wantv = .true.
+c
+c reduce x to bidiagonal form, storing the diagonal elements
+c in s and the super-diagonal elements in e.
+c
+ info = 0
+ nct = min0(n-1,p)
+ nrt = max0(0,min0(p-2,n))
+ lu = max0(nct,nrt)
+ if (lu .lt. 1) go to 170
+ do 160 l = 1, lu
+ lp1 = l + 1
+ if (l .gt. nct) go to 20
+c
+c compute the transformation for the l-th column and
+c place the l-th diagonal in s(l).
+c
+ s(l) = cmplx(scnrm2(n-l+1,x(l,l),1),0.0e0)
+ if (cabs1(s(l)) .eq. 0.0e0) go to 10
+ if (cabs1(x(l,l)) .ne. 0.0e0) s(l) = csign(s(l),x(l,l))
+ call cscal(n-l+1,1.0e0/s(l),x(l,l),1)
+ x(l,l) = (1.0e0,0.0e0) + x(l,l)
+ 10 continue
+ s(l) = -s(l)
+ 20 continue
+ if (p .lt. lp1) go to 50
+ do 40 j = lp1, p
+ if (l .gt. nct) go to 30
+ if (cabs1(s(l)) .eq. 0.0e0) go to 30
+c
+c apply the transformation.
+c
+ t = -cdotc(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call caxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ 30 continue
+c
+c place the l-th row of x into e for the
+c subsequent calculation of the row transformation.
+c
+ e(j) = conjg(x(l,j))
+ 40 continue
+ 50 continue
+ if (.not.wantu .or. l .gt. nct) go to 70
+c
+c place the transformation in u for subsequent back
+c multiplication.
+c
+ do 60 i = l, n
+ u(i,l) = x(i,l)
+ 60 continue
+ 70 continue
+ if (l .gt. nrt) go to 150
+c
+c compute the l-th row transformation and place the
+c l-th super-diagonal in e(l).
+c
+ e(l) = cmplx(scnrm2(p-l,e(lp1),1),0.0e0)
+ if (cabs1(e(l)) .eq. 0.0e0) go to 80
+ if (cabs1(e(lp1)) .ne. 0.0e0) e(l) = csign(e(l),e(lp1))
+ call cscal(p-l,1.0e0/e(l),e(lp1),1)
+ e(lp1) = (1.0e0,0.0e0) + e(lp1)
+ 80 continue
+ e(l) = -conjg(e(l))
+ if (lp1 .gt. n .or. cabs1(e(l)) .eq. 0.0e0) go to 120
+c
+c apply the transformation.
+c
+ do 90 i = lp1, n
+ work(i) = (0.0e0,0.0e0)
+ 90 continue
+ do 100 j = lp1, p
+ call caxpy(n-l,e(j),x(lp1,j),1,work(lp1),1)
+ 100 continue
+ do 110 j = lp1, p
+ call caxpy(n-l,conjg(-e(j)/e(lp1)),work(lp1),1,
+ * x(lp1,j),1)
+ 110 continue
+ 120 continue
+ if (.not.wantv) go to 140
+c
+c place the transformation in v for subsequent
+c back multiplication.
+c
+ do 130 i = lp1, p
+ v(i,l) = e(i)
+ 130 continue
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c set up the final bidiagonal matrix or order m.
+c
+ m = min0(p,n+1)
+ nctp1 = nct + 1
+ nrtp1 = nrt + 1
+ if (nct .lt. p) s(nctp1) = x(nctp1,nctp1)
+ if (n .lt. m) s(m) = (0.0e0,0.0e0)
+ if (nrtp1 .lt. m) e(nrtp1) = x(nrtp1,m)
+ e(m) = (0.0e0,0.0e0)
+c
+c if required, generate u.
+c
+ if (.not.wantu) go to 300
+ if (ncu .lt. nctp1) go to 200
+ do 190 j = nctp1, ncu
+ do 180 i = 1, n
+ u(i,j) = (0.0e0,0.0e0)
+ 180 continue
+ u(j,j) = (1.0e0,0.0e0)
+ 190 continue
+ 200 continue
+ if (nct .lt. 1) go to 290
+ do 280 ll = 1, nct
+ l = nct - ll + 1
+ if (cabs1(s(l)) .eq. 0.0e0) go to 250
+ lp1 = l + 1
+ if (ncu .lt. lp1) go to 220
+ do 210 j = lp1, ncu
+ t = -cdotc(n-l+1,u(l,l),1,u(l,j),1)/u(l,l)
+ call caxpy(n-l+1,t,u(l,l),1,u(l,j),1)
+ 210 continue
+ 220 continue
+ call cscal(n-l+1,(-1.0e0,0.0e0),u(l,l),1)
+ u(l,l) = (1.0e0,0.0e0) + u(l,l)
+ lm1 = l - 1
+ if (lm1 .lt. 1) go to 240
+ do 230 i = 1, lm1
+ u(i,l) = (0.0e0,0.0e0)
+ 230 continue
+ 240 continue
+ go to 270
+ 250 continue
+ do 260 i = 1, n
+ u(i,l) = (0.0e0,0.0e0)
+ 260 continue
+ u(l,l) = (1.0e0,0.0e0)
+ 270 continue
+ 280 continue
+ 290 continue
+ 300 continue
+c
+c if it is required, generate v.
+c
+ if (.not.wantv) go to 350
+ do 340 ll = 1, p
+ l = p - ll + 1
+ lp1 = l + 1
+ if (l .gt. nrt) go to 320
+ if (cabs1(e(l)) .eq. 0.0e0) go to 320
+ do 310 j = lp1, p
+ t = -cdotc(p-l,v(lp1,l),1,v(lp1,j),1)/v(lp1,l)
+ call caxpy(p-l,t,v(lp1,l),1,v(lp1,j),1)
+ 310 continue
+ 320 continue
+ do 330 i = 1, p
+ v(i,l) = (0.0e0,0.0e0)
+ 330 continue
+ v(l,l) = (1.0e0,0.0e0)
+ 340 continue
+ 350 continue
+c
+c transform s and e so that they are real.
+c
+ do 380 i = 1, m
+ if (cabs1(s(i)) .eq. 0.0e0) go to 360
+ t = cmplx(cabs(s(i)),0.0e0)
+ r = s(i)/t
+ s(i) = t
+ if (i .lt. m) e(i) = e(i)/r
+ if (wantu) call cscal(n,r,u(1,i),1)
+ 360 continue
+c ...exit
+ if (i .eq. m) go to 390
+ if (cabs1(e(i)) .eq. 0.0e0) go to 370
+ t = cmplx(cabs(e(i)),0.0e0)
+ r = t/e(i)
+ e(i) = t
+ s(i+1) = s(i+1)*r
+ if (wantv) call cscal(p,r,v(1,i+1),1)
+ 370 continue
+ 380 continue
+ 390 continue
+c
+c main iteration loop for the singular values.
+c
+ mm = m
+ iter = 0
+ 400 continue
+c
+c quit if all the singular values have been found.
+c
+c ...exit
+ if (m .eq. 0) go to 660
+c
+c if too many iterations have been performed, set
+c flag and return.
+c
+ if (iter .lt. maxit) go to 410
+ info = m
+c ......exit
+ go to 660
+ 410 continue
+c
+c this section of the program inspects for
+c negligible elements in the s and e arrays. on
+c completion the variables kase and l are set as follows.
+c
+c kase = 1 if s(m) and e(l-1) are negligible and l.lt.m
+c kase = 2 if s(l) is negligible and l.lt.m
+c kase = 3 if e(l-1) is negligible, l.lt.m, and
+c s(l), ..., s(m) are not negligible (qr step).
+c kase = 4 if e(m-1) is negligible (convergence).
+c
+ do 430 ll = 1, m
+ l = m - ll
+c ...exit
+ if (l .eq. 0) go to 440
+ test = cabs(s(l)) + cabs(s(l+1))
+ ztest = test + cabs(e(l))
+ if (ztest .ne. test) go to 420
+ e(l) = (0.0e0,0.0e0)
+c ......exit
+ go to 440
+ 420 continue
+ 430 continue
+ 440 continue
+ if (l .ne. m - 1) go to 450
+ kase = 4
+ go to 520
+ 450 continue
+ lp1 = l + 1
+ mp1 = m + 1
+ do 470 lls = lp1, mp1
+ ls = m - lls + lp1
+c ...exit
+ if (ls .eq. l) go to 480
+ test = 0.0e0
+ if (ls .ne. m) test = test + cabs(e(ls))
+ if (ls .ne. l + 1) test = test + cabs(e(ls-1))
+ ztest = test + cabs(s(ls))
+ if (ztest .ne. test) go to 460
+ s(ls) = (0.0e0,0.0e0)
+c ......exit
+ go to 480
+ 460 continue
+ 470 continue
+ 480 continue
+ if (ls .ne. l) go to 490
+ kase = 3
+ go to 510
+ 490 continue
+ if (ls .ne. m) go to 500
+ kase = 1
+ go to 510
+ 500 continue
+ kase = 2
+ l = ls
+ 510 continue
+ 520 continue
+ l = l + 1
+c
+c perform the task indicated by kase.
+c
+ go to (530, 560, 580, 610), kase
+c
+c deflate negligible s(m).
+c
+ 530 continue
+ mm1 = m - 1
+ f = real(e(m-1))
+ e(m-1) = (0.0e0,0.0e0)
+ do 550 kk = l, mm1
+ k = mm1 - kk + l
+ t1 = real(s(k))
+ call srotg(t1,f,cs,sn)
+ s(k) = cmplx(t1,0.0e0)
+ if (k .eq. l) go to 540
+ f = -sn*real(e(k-1))
+ e(k-1) = cs*e(k-1)
+ 540 continue
+ if (wantv) call csrot(p,v(1,k),1,v(1,m),1,cs,sn)
+ 550 continue
+ go to 650
+c
+c split at negligible s(l).
+c
+ 560 continue
+ f = real(e(l-1))
+ e(l-1) = (0.0e0,0.0e0)
+ do 570 k = l, m
+ t1 = real(s(k))
+ call srotg(t1,f,cs,sn)
+ s(k) = cmplx(t1,0.0e0)
+ f = -sn*real(e(k))
+ e(k) = cs*e(k)
+ if (wantu) call csrot(n,u(1,k),1,u(1,l-1),1,cs,sn)
+ 570 continue
+ go to 650
+c
+c perform one qr step.
+c
+ 580 continue
+c
+c calculate the shift.
+c
+ scale = amax1(cabs(s(m)),cabs(s(m-1)),cabs(e(m-1)),
+ * cabs(s(l)),cabs(e(l)))
+ sm = real(s(m))/scale
+ smm1 = real(s(m-1))/scale
+ emm1 = real(e(m-1))/scale
+ sl = real(s(l))/scale
+ el = real(e(l))/scale
+ b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0e0
+ c = (sm*emm1)**2
+ shift = 0.0e0
+ if (b .eq. 0.0e0 .and. c .eq. 0.0e0) go to 590
+ shift = sqrt(b**2+c)
+ if (b .lt. 0.0e0) shift = -shift
+ shift = c/(b + shift)
+ 590 continue
+ f = (sl + sm)*(sl - sm) + shift
+ g = sl*el
+c
+c chase zeros.
+c
+ mm1 = m - 1
+ do 600 k = l, mm1
+ call srotg(f,g,cs,sn)
+ if (k .ne. l) e(k-1) = cmplx(f,0.0e0)
+ f = cs*real(s(k)) + sn*real(e(k))
+ e(k) = cs*e(k) - sn*s(k)
+ g = sn*real(s(k+1))
+ s(k+1) = cs*s(k+1)
+ if (wantv) call csrot(p,v(1,k),1,v(1,k+1),1,cs,sn)
+ call srotg(f,g,cs,sn)
+ s(k) = cmplx(f,0.0e0)
+ f = cs*real(e(k)) + sn*real(s(k+1))
+ s(k+1) = -sn*e(k) + cs*s(k+1)
+ g = sn*real(e(k+1))
+ e(k+1) = cs*e(k+1)
+ if (wantu .and. k .lt. n)
+ * call csrot(n,u(1,k),1,u(1,k+1),1,cs,sn)
+ 600 continue
+ e(m-1) = cmplx(f,0.0e0)
+ iter = iter + 1
+ go to 650
+c
+c convergence.
+c
+ 610 continue
+c
+c make the singular value positive
+c
+ if (real(s(l)) .ge. 0.0e0) go to 620
+ s(l) = -s(l)
+ if (wantv) call cscal(p,(-1.0e0,0.0e0),v(1,l),1)
+ 620 continue
+c
+c order the singular value.
+c
+ 630 if (l .eq. mm) go to 640
+c ...exit
+ if (real(s(l)) .ge. real(s(l+1))) go to 640
+ t = s(l)
+ s(l) = s(l+1)
+ s(l+1) = t
+ if (wantv .and. l .lt. p)
+ * call cswap(p,v(1,l),1,v(1,l+1),1)
+ if (wantu .and. l .lt. n)
+ * call cswap(n,u(1,l),1,u(1,l+1),1)
+ l = l + 1
+ go to 630
+ 640 continue
+ iter = 0
+ m = m - 1
+ 650 continue
+ go to 400
+ 660 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.c
new file mode 100644
index 0000000000000000000000000000000000000000..0096f3e3d356986cf82975eee1ba845c8cf4aaa2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.c
@@ -0,0 +1,47 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void cswap_(n, cx, incx, cy, incy)
+const integer *n;
+complex *cx;
+const integer *incx;
+complex *cy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i;
+ static complex ctemp;
+ static integer ix, iy;
+
+/* interchanges two vectors. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ctemp.r = cx[i].r, ctemp.i = cx[i].i;
+ cx[i].r = cy[i].r, cx[i].i = cy[i].i;
+ cy[i].r = ctemp.r, cy[i].i = ctemp.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ctemp.r = cx[ix].r, ctemp.i = cx[ix].i;
+ cx[ix].r = cy[iy].r, cx[ix].i = cy[iy].i;
+ cy[iy].r = ctemp.r, cy[iy].i = ctemp.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* cswap_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.f
new file mode 100644
index 0000000000000000000000000000000000000000..ede4495f69c9405e8783ff0e8b3f93df293f8150
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/cswap.f
@@ -0,0 +1,36 @@
+ subroutine cswap (n,cx,incx,cy,incy)
+c
+c interchanges two vectors.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ complex cx(*),cy(*),ctemp
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ctemp = cx(ix)
+ cx(ix) = cy(iy)
+ cy(iy) = ctemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+ 20 do 30 i = 1,n
+ ctemp = cx(i)
+ cx(i) = cy(i)
+ cy(i) = ctemp
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/d_cnjg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_cnjg.c
new file mode 100644
index 0000000000000000000000000000000000000000..04e7d2a09bb774f20080d39e43c55c8e173abea5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_cnjg.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+#include "netlib.h"
+
+ VOID
+#ifdef KR_headers
+d_cnjg(r, z) doublecomplex *r; const doublecomplex *z;
+#else
+d_cnjg(doublecomplex *r, const doublecomplex *z)
+#endif
+{
+ r->r = z->r;
+ r->i = - z->i;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/d_imag.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_imag.c
new file mode 100644
index 0000000000000000000000000000000000000000..00b55cba1f368cf173ecbc5a7ac8bbdf758b5a14
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_imag.c
@@ -0,0 +1,7 @@
+#include "f2c.h"
+#include "netlib.h"
+
+doublereal d_imag(const doublecomplex *z)
+{
+ return z->i;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/d_lg10.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_lg10.c
new file mode 100644
index 0000000000000000000000000000000000000000..a7b991c8c795785e2216101950661ee19bdcd9ab
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_lg10.c
@@ -0,0 +1,15 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double d_lg10(x) const doublereal *x;
+#else
+extern double log(double); /* #include <math.h> */
+double d_lg10(const doublereal *x)
+#endif
+{
+ return( log10e * log(*x) );
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/d_sign.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_sign.c
new file mode 100644
index 0000000000000000000000000000000000000000..799f54791f0949d3c0236cfa5598a3ac9cfef6b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/d_sign.c
@@ -0,0 +1,8 @@
+#include "f2c.h"
+#include "netlib.h"
+
+double d_sign(const doublereal *a, const doublereal *b)
+{
+ double x = (*a >= 0 ? *a : - *a);
+ return *b >= 0 ? x : -x;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.c
new file mode 100644
index 0000000000000000000000000000000000000000..47a9723103ae8c340695739546cec198a8e5116c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+
+doublereal dasum_(n, dx, incx)
+const integer *n;
+const doublereal *dx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i, m, nincx;
+ static doublereal dtemp;
+
+/* takes the sum of the absolute values. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ dtemp = 0.;
+ if (*n <= 0 || *incx <= 0) {
+ return dtemp;
+ }
+ if (*incx == 1) {
+
+/* code for increment equal to 1 */
+
+ m = *n % 6;
+ for (i = 0; i < m; ++i) {
+ dtemp += abs(dx[i]);
+ }
+ for (i = m; i < *n; i += 6) {
+ dtemp += abs(dx[i]) + abs(dx[i+1]) + abs(dx[i+2]) + abs(dx[i+3]) + abs(dx[i+4]) + abs(dx[i+5]);
+ }
+ return dtemp;
+ }
+
+/* code for increment not equal to 1 */
+
+ nincx = *n * *incx;
+ for (i = 0; i < nincx; i += *incx) {
+ dtemp += abs(dx[i]);
+ }
+ return dtemp;
+} /* dasum_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.f
new file mode 100644
index 0000000000000000000000000000000000000000..28b128a846264b5052eb2a064d2c35245238cf9b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dasum.f
@@ -0,0 +1,43 @@
+ double precision function dasum(n,dx,incx)
+c
+c takes the sum of the absolute values.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dtemp
+ integer i,incx,m,mp1,n,nincx
+c
+ dasum = 0.0d0
+ dtemp = 0.0d0
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ dtemp = dtemp + dabs(dx(i))
+ 10 continue
+ dasum = dtemp
+ return
+c
+c code for increment equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,6)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dtemp = dtemp + dabs(dx(i))
+ 30 continue
+ if( n .lt. 6 ) go to 60
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,6
+ dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
+ * + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
+ 50 continue
+ 60 dasum = dtemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/daxpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/daxpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..f54c7e06a8ef5aed6e3ce92fabab7234d643725f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/daxpy.c
@@ -0,0 +1,48 @@
+#include "f2c.h"
+#include "netlib.h"
+#ifndef KR_headers
+void daxpy_(const integer *n, const doublereal *da, const doublereal *dx, const integer *incx, doublereal *dy, const integer *incy)
+#else
+/* Subroutine */ void daxpy_(n, da, dx, incx, dy, incy)
+const integer *n;
+const doublereal *da, *dx;
+const integer *incx;
+doublereal *dy;
+const integer *incy;
+#endif
+{
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* constant times a vector plus a vector. */
+/* uses unrolled loops for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*da == 0.) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ dy[i] += *da * dx[i];
+ }
+ }
+ else {
+ ix = 0;
+ iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ dy[iy] += *da * dx[ix];
+ ix += *incx; iy += *incy;
+ }
+ }
+ return;
+} /* daxpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dcopy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dcopy.c
new file mode 100644
index 0000000000000000000000000000000000000000..4f277d83ae614a0f41a58d3da7dd70321fe7b212
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dcopy.c
@@ -0,0 +1,44 @@
+#include "f2c.h"
+#include "netlib.h"
+#ifdef KR_headers
+/* Subroutine */ void dcopy_(n, dx, incx, dy, incy)
+const integer *n;
+const doublereal *dx;
+const integer *incx;
+doublereal *dy;
+const integer *incy;
+#else
+void dcopy_(const integer *n, const doublereal *dx, const integer *incx, doublereal *dy, const integer *incy)
+#endif
+{
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* copies a vector, x, to a vector, y. */
+/* uses unrolled loops for increments equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ dy[i] = dx[i];
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ dy[iy] = dx[ix];
+ ix += *incx; iy += *incy;
+ }
+ }
+ return;
+} /* dcopy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ddot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ddot.c
new file mode 100644
index 0000000000000000000000000000000000000000..ad53f546efdbe0dd43d5253d64ca00b0aca380b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ddot.c
@@ -0,0 +1,55 @@
+#include "f2c.h"
+#include "netlib.h"
+#ifdef KR_headers
+doublereal ddot_(n, dx, incx, dy, incy)
+const integer *n;
+const doublereal *dx;
+const integer *incx;
+const doublereal *dy;
+const integer *incy;
+#else
+doublereal ddot_(const integer *n, const doublereal *dx, const integer *incx, const doublereal *dy, const integer *incy)
+#endif
+{
+ /* Local variables */
+ static integer i, m;
+ static doublereal dtemp;
+ static integer ix, iy;
+
+/* forms the dot product of two vectors. */
+/* uses unrolled loops for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ dtemp = 0.;
+ if (*n <= 0) {
+ return dtemp;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 5;
+ for (i = 0; i < m; ++i) {
+ dtemp += dx[i] * dy[i];
+ }
+ for (i = m; i < *n; i += 5) {
+ dtemp += dx[i] * dy[i] +
+ dx[i + 1] * dy[i + 1] +
+ dx[i + 2] * dy[i + 2] +
+ dx[i + 3] * dy[i + 3] +
+ dx[i + 4] * dy[i + 4];
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ dtemp += dx[ix] * dy[iy];
+ ix += *incx; iy += *incy;
+ }
+ }
+ return dtemp;
+} /* ddot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.c
new file mode 100644
index 0000000000000000000000000000000000000000..539013e6baccd14b14215bcf2bc3913c8f6259c6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.c
@@ -0,0 +1,166 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dgecon_(norm, n, a, lda, anorm, rcond, work, iwork, info)
+char *norm;
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *anorm, *rcond, *work;
+integer *iwork, *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer kase, kase1;
+ static doublereal scale;
+ static doublereal sl;
+ static integer ix;
+ static doublereal su;
+ static doublereal ainvnm;
+ static logical onenrm;
+ static char normin[1];
+ static doublereal smlnum;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGECON estimates the reciprocal of the condition number of a general */
+/* real matrix A, in either the 1-norm or the infinity-norm, using */
+/* the LU factorization computed by DGETRF. */
+/* */
+/* An estimate is obtained for norm(inv(A)), and the reciprocal of the */
+/* condition number is computed as */
+/* RCOND = 1 / ( norm(A) * norm(inv(A)) ). */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies whether the 1-norm condition number or the */
+/* infinity-norm condition number is required: */
+/* = '1' or 'O': 1-norm; */
+/* = 'I': Infinity-norm. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The factors L and U from the factorization A = P*L*U */
+/* as computed by DGETRF. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* ANORM (input) DOUBLE PRECISION */
+/* If NORM = '1' or 'O', the 1-norm of the original matrix A. */
+/* If NORM = 'I', the infinity-norm of the original matrix A. */
+/* */
+/* RCOND (output) DOUBLE PRECISION */
+/* The reciprocal of the condition number of the matrix A, */
+/* computed as RCOND = 1/(norm(A) * norm(inv(A))). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (4*N) */
+/* */
+/* IWORK (workspace) INTEGER array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input parameters. */
+
+ *info = 0;
+ onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
+ if (! onenrm && ! lsame_(norm, "I")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if (*anorm < 0.) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGECON", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ *rcond = 0.;
+ if (*n == 0) {
+ *rcond = 1.;
+ return;
+ } else if (*anorm == 0.) {
+ return;
+ }
+
+ smlnum = dlamch_("Safe minimum");
+
+/* Estimate the norm of inv(A). */
+
+ ainvnm = 0.;
+ *(unsigned char *)normin = 'N';
+ if (onenrm) {
+ kase1 = 1;
+ } else {
+ kase1 = 2;
+ }
+ kase = 0;
+L10:
+ dlacon_(n, &work[*n], work, iwork, &ainvnm, &kase);
+ if (kase != 0) {
+ if (kase == kase1) {
+
+/* Multiply by inv(L). */
+
+ dlatrs_("Lower", "No transpose", "Unit", normin, n, a, lda, work, &sl, &work[*n << 1], info);
+
+/* Multiply by inv(U). */
+
+ dlatrs_("Upper", "No transpose", "Non-unit", normin, n, a, lda, work, &su, &work[*n * 3], info);
+ } else {
+
+/* Multiply by inv(U'). */
+
+ dlatrs_("Upper", "Transpose", "Non-unit", normin, n, a, lda, work, &su, &work[*n * 3], info);
+
+/* Multiply by inv(L'). */
+
+ dlatrs_("Lower", "Transpose", "Unit", normin, n, a, lda, work, &sl, &work[*n << 1], info);
+ }
+
+/* Divide X by 1/(SL*SU) if doing so will not cause overflow. */
+
+ scale = sl * su;
+ *(unsigned char *)normin = 'Y';
+ if (scale != 1.) {
+ ix = idamax_(n, work, &c__1) - 1;
+ if (scale < abs(work[ix]) * smlnum || scale == 0.) {
+ return;
+ }
+ drscl_(n, &scale, work, &c__1);
+ }
+ goto L10;
+ }
+
+/* Compute the estimate of the reciprocal condition number. */
+
+ if (ainvnm != 0.) {
+ *rcond = 1. / ainvnm / *anorm;
+ }
+} /* dgecon_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.f
new file mode 100644
index 0000000000000000000000000000000000000000..f6bd485f40492eab432c0e675b03a8e27c596a76
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgecon.f
@@ -0,0 +1,181 @@
+ SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
+ $ INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER INFO, LDA, N
+ DOUBLE PRECISION ANORM, RCOND
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGECON estimates the reciprocal of the condition number of a general
+* real matrix A, in either the 1-norm or the infinity-norm, using
+* the LU factorization computed by DGETRF.
+*
+* An estimate is obtained for norm(inv(A)), and the reciprocal of the
+* condition number is computed as
+* RCOND = 1 / ( norm(A) * norm(inv(A)) ).
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies whether the 1-norm condition number or the
+* infinity-norm condition number is required:
+* = '1' or 'O': 1-norm;
+* = 'I': Infinity-norm.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* The factors L and U from the factorization A = P*L*U
+* as computed by DGETRF.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* ANORM (input) DOUBLE PRECISION
+* If NORM = '1' or 'O', the 1-norm of the original matrix A.
+* If NORM = 'I', the infinity-norm of the original matrix A.
+*
+* RCOND (output) DOUBLE PRECISION
+* The reciprocal of the condition number of the matrix A,
+* computed as RCOND = 1/(norm(A) * norm(inv(A))).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+*
+* IWORK (workspace) INTEGER array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ONENRM
+ CHARACTER NORMIN
+ INTEGER IX, KASE, KASE1
+ DOUBLE PRECISION AINVNM, SCALE, SL, SMLNUM, SU
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL LSAME, IDAMAX, DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLACON, DLATRS, DRSCL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
+ IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF( ANORM.LT.ZERO ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGECON', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ RCOND = ZERO
+ IF( N.EQ.0 ) THEN
+ RCOND = ONE
+ RETURN
+ ELSE IF( ANORM.EQ.ZERO ) THEN
+ RETURN
+ END IF
+*
+ SMLNUM = DLAMCH( 'Safe minimum' )
+*
+* Estimate the norm of inv(A).
+*
+ AINVNM = ZERO
+ NORMIN = 'N'
+ IF( ONENRM ) THEN
+ KASE1 = 1
+ ELSE
+ KASE1 = 2
+ END IF
+ KASE = 0
+ 10 CONTINUE
+ CALL DLACON( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE )
+ IF( KASE.NE.0 ) THEN
+ IF( KASE.EQ.KASE1 ) THEN
+*
+* Multiply by inv(L).
+*
+ CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A,
+ $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
+*
+* Multiply by inv(U).
+*
+ CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
+ $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO )
+ ELSE
+*
+* Multiply by inv(U').
+*
+ CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
+ $ LDA, WORK, SU, WORK( 3*N+1 ), INFO )
+*
+* Multiply by inv(L').
+*
+ CALL DLATRS( 'Lower', 'Transpose', 'Unit', NORMIN, N, A,
+ $ LDA, WORK, SL, WORK( 2*N+1 ), INFO )
+ END IF
+*
+* Divide X by 1/(SL*SU) if doing so will not cause overflow.
+*
+ SCALE = SL*SU
+ NORMIN = 'Y'
+ IF( SCALE.NE.ONE ) THEN
+ IX = IDAMAX( N, WORK, 1 )
+ IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
+ $ GO TO 20
+ CALL DRSCL( N, SCALE, WORK, 1 )
+ END IF
+ GO TO 10
+ END IF
+*
+* Compute the estimate of the reciprocal condition number.
+*
+ IF( AINVNM.NE.ZERO )
+ $ RCOND = ( ONE / AINVNM ) / ANORM
+*
+ 20 CONTINUE
+ RETURN
+*
+* End of DGECON
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.c
new file mode 100644
index 0000000000000000000000000000000000000000..6a9b0cf4f7f19bee7ee9b1787fdb2495e19a678b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.c
@@ -0,0 +1,331 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dgemm_(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+const char *transa, *transb;
+const integer *m, *n, *k;
+doublereal *alpha, *a;
+const integer *lda;
+doublereal *b;
+const integer *ldb;
+doublereal *beta, *c;
+const integer *ldc;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer info;
+ static logical nota, notb;
+ static doublereal temp;
+ static integer i, j, l /*, ncola */;
+ static integer nrowa, nrowb;
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGEMM performs one of the matrix-matrix operations */
+/* */
+/* C := alpha*op( A )*op( B ) + beta*C, */
+/* */
+/* where op( X ) is one of */
+/* */
+/* op( X ) = X or op( X ) = X', */
+/* */
+/* alpha and beta are scalars, and A, B and C are matrices, with op( A ) */
+/* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+/* */
+/* TRANSA = 'N' or 'n', op( A ) = A. */
+/* */
+/* TRANSA = 'T' or 't', op( A ) = A'. */
+/* */
+/* TRANSA = 'C' or 'c', op( A ) = A'. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* TRANSB - CHARACTER*1. */
+/* On entry, TRANSB specifies the form of op( B ) to be used in */
+/* the matrix multiplication as follows: */
+/* */
+/* TRANSB = 'N' or 'n', op( B ) = B. */
+/* */
+/* TRANSB = 'T' or 't', op( B ) = B'. */
+/* */
+/* TRANSB = 'C' or 'c', op( B ) = B'. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix */
+/* op( A ) and of the matrix C. M must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix */
+/* op( B ) and the number of columns of the matrix C. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+/* */
+/* K - INTEGER. */
+/* On entry, K specifies the number of columns of the matrix */
+/* op( A ) and the number of rows of the matrix op( B ). K must */
+/* be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+/* */
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is */
+/* k when TRANSA = 'N' or 'n', and is m otherwise. */
+/* Before entry with TRANSA = 'N' or 'n', the leading m by k */
+/* part of the array A must contain the matrix A, otherwise */
+/* the leading k by m part of the array A must contain the */
+/* matrix A. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When TRANSA = 'N' or 'n' then */
+/* LDA must be at least max( 1, m ), otherwise LDA must be at */
+/* least max( 1, k ). */
+/* Unchanged on exit. */
+/* */
+/* B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is */
+/* n when TRANSB = 'N' or 'n', and is k otherwise. */
+/* Before entry with TRANSB = 'N' or 'n', the leading k by n */
+/* part of the array B must contain the matrix B, otherwise */
+/* the leading n by k part of the array B must contain the */
+/* matrix B. */
+/* Unchanged on exit. */
+/* */
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. When TRANSB = 'N' or 'n' then */
+/* LDB must be at least max( 1, k ), otherwise LDB must be at */
+/* least max( 1, n ). */
+/* Unchanged on exit. */
+/* */
+/* BETA - DOUBLE PRECISION. */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then C need not be set on input. */
+/* Unchanged on exit. */
+/* */
+/* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). */
+/* Before entry, the leading m by n part of the array C must */
+/* contain the matrix C, except when beta is zero, in which */
+/* case C need not be set on entry. */
+/* On exit, the array C is overwritten by the m by n matrix */
+/* ( alpha*op( A )*op( B ) + beta*C ). */
+/* */
+/* LDC - INTEGER. */
+/* On entry, LDC specifies the first dimension of C as declared */
+/* in the calling (sub) program. LDC must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c -= c_offset;
+
+/* Set NOTA and NOTB as true if A and B respectively are not */
+/* transposed and set NROWA, NCOLA and NROWB as the number of rows */
+/* and columns of A and the number of rows of B respectively. */
+
+ nota = lsame_(transa, "N");
+ notb = lsame_(transb, "N");
+ if (nota) {
+ nrowa = *m;
+/* ncola = *k; */
+ } else {
+ nrowa = *k;
+/* ncola = *m; */
+ }
+ if (notb) {
+ nrowb = *k;
+ } else {
+ nrowb = *n;
+ }
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (! nota && ! lsame_(transa, "C") && ! lsame_(transa, "T")) {
+ info = 1;
+ } else if (!notb && !lsame_(transb, "C") && !lsame_(transb, "T")) {
+ info = 2;
+ } else if (*m < 0) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < max(1,nrowa)) {
+ info = 8;
+ } else if (*ldb < max(1,nrowb)) {
+ info = 10;
+ } else if (*ldc < max(1,*m)) {
+ info = 13;
+ }
+ if (info != 0) {
+ xerbla_("DGEMM ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (*alpha * *k == 0 && *beta == 1.) ) {
+ return;
+ }
+
+/* And if alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] = 0.;
+ }
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] *= *beta;
+ }
+ }
+ }
+ return;
+ }
+
+/* Start the operations. */
+
+ if (notb) {
+ if (nota) {
+
+/* Form C := alpha*A*B + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] = 0.;
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] *= *beta;
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[l + j * b_dim1] != 0.) {
+ temp = *alpha * b[l + j * b_dim1];
+ i__3 = *m;
+ for (i = 1; i <= i__3; ++i) {
+ c[i + j * c_dim1] += temp * a[i + l * a_dim1];
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*B + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i * a_dim1] * b[l + j * b_dim1];
+ }
+ if (*beta == 0.) {
+ c[i + j * c_dim1] = *alpha * temp;
+ } else {
+ c[i + j * c_dim1] = *alpha * temp + *beta * c[i + j * c_dim1];
+ }
+ }
+ }
+ }
+ } else {
+ if (nota) {
+
+/* Form C := alpha*A*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] = 0.;
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ c[i + j * c_dim1] *= *beta;
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[j + l * b_dim1] != 0.) {
+ temp = *alpha * b[j + l * b_dim1];
+ i__3 = *m;
+ for (i = 1; i <= i__3; ++i) {
+ c[i + j * c_dim1] += temp * a[i + l * a_dim1];
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i * a_dim1] * b[j + l * b_dim1];
+ }
+ if (*beta == 0.) {
+ c[i + j * c_dim1] = *alpha * temp;
+ } else {
+ c[i + j * c_dim1] = *alpha * temp + *beta * c[i + j * c_dim1];
+ }
+ }
+ }
+ }
+ }
+
+} /* dgemm_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.f
new file mode 100644
index 0000000000000000000000000000000000000000..baabe4c52f2b7e5aae5203c00449629c3ff4c7b9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemm.f
@@ -0,0 +1,313 @@
+ SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
+ $ BETA, C, LDC )
+* .. Scalar Arguments ..
+ CHARACTER*1 TRANSA, TRANSB
+ INTEGER M, N, K, LDA, LDB, LDC
+ DOUBLE PRECISION ALPHA, BETA
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGEMM performs one of the matrix-matrix operations
+*
+* C := alpha*op( A )*op( B ) + beta*C,
+*
+* where op( X ) is one of
+*
+* op( X ) = X or op( X ) = X',
+*
+* alpha and beta are scalars, and A, B and C are matrices, with op( A )
+* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+*
+* Parameters
+* ==========
+*
+* TRANSA - CHARACTER*1.
+* On entry, TRANSA specifies the form of op( A ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSA = 'N' or 'n', op( A ) = A.
+*
+* TRANSA = 'T' or 't', op( A ) = A'.
+*
+* TRANSA = 'C' or 'c', op( A ) = A'.
+*
+* Unchanged on exit.
+*
+* TRANSB - CHARACTER*1.
+* On entry, TRANSB specifies the form of op( B ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSB = 'N' or 'n', op( B ) = B.
+*
+* TRANSB = 'T' or 't', op( B ) = B'.
+*
+* TRANSB = 'C' or 'c', op( B ) = B'.
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix
+* op( A ) and of the matrix C. M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix
+* op( B ) and the number of columns of the matrix C. N must be
+* at least zero.
+* Unchanged on exit.
+*
+* K - INTEGER.
+* On entry, K specifies the number of columns of the matrix
+* op( A ) and the number of rows of the matrix op( B ). K must
+* be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - DOUBLE PRECISION.
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+* k when TRANSA = 'N' or 'n', and is m otherwise.
+* Before entry with TRANSA = 'N' or 'n', the leading m by k
+* part of the array A must contain the matrix A, otherwise
+* the leading k by m part of the array A must contain the
+* matrix A.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. When TRANSA = 'N' or 'n' then
+* LDA must be at least max( 1, m ), otherwise LDA must be at
+* least max( 1, k ).
+* Unchanged on exit.
+*
+* B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+* n when TRANSB = 'N' or 'n', and is k otherwise.
+* Before entry with TRANSB = 'N' or 'n', the leading k by n
+* part of the array B must contain the matrix B, otherwise
+* the leading n by k part of the array B must contain the
+* matrix B.
+* Unchanged on exit.
+*
+* LDB - INTEGER.
+* On entry, LDB specifies the first dimension of B as declared
+* in the calling (sub) program. When TRANSB = 'N' or 'n' then
+* LDB must be at least max( 1, k ), otherwise LDB must be at
+* least max( 1, n ).
+* Unchanged on exit.
+*
+* BETA - DOUBLE PRECISION.
+* On entry, BETA specifies the scalar beta. When BETA is
+* supplied as zero then C need not be set on input.
+* Unchanged on exit.
+*
+* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+* Before entry, the leading m by n part of the array C must
+* contain the matrix C, except when beta is zero, in which
+* case C need not be set on entry.
+* On exit, the array C is overwritten by the m by n matrix
+* ( alpha*op( A )*op( B ) + beta*C ).
+*
+* LDC - INTEGER.
+* On entry, LDC specifies the first dimension of C as declared
+* in the calling (sub) program. LDC must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 3 Blas routine.
+*
+* -- Written on 8-February-1989.
+* Jack Dongarra, Argonne National Laboratory.
+* Iain Duff, AERE Harwell.
+* Jeremy Du Croz, Numerical Algorithms Group Ltd.
+* Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* .. Local Scalars ..
+ LOGICAL NOTA, NOTB
+ INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
+ DOUBLE PRECISION TEMP
+* .. Parameters ..
+ DOUBLE PRECISION ONE , ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Executable Statements ..
+*
+* Set NOTA and NOTB as true if A and B respectively are not
+* transposed and set NROWA, NCOLA and NROWB as the number of rows
+* and columns of A and the number of rows of B respectively.
+*
+ NOTA = LSAME( TRANSA, 'N' )
+ NOTB = LSAME( TRANSB, 'N' )
+ IF( NOTA )THEN
+ NROWA = M
+ NCOLA = K
+ ELSE
+ NROWA = K
+ NCOLA = M
+ END IF
+ IF( NOTB )THEN
+ NROWB = K
+ ELSE
+ NROWB = N
+ END IF
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF( ( .NOT.NOTA ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'C' ) ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'T' ) ) )THEN
+ INFO = 1
+ ELSE IF( ( .NOT.NOTB ).AND.
+ $ ( .NOT.LSAME( TRANSB, 'C' ) ).AND.
+ $ ( .NOT.LSAME( TRANSB, 'T' ) ) )THEN
+ INFO = 2
+ ELSE IF( M .LT.0 )THEN
+ INFO = 3
+ ELSE IF( N .LT.0 )THEN
+ INFO = 4
+ ELSE IF( K .LT.0 )THEN
+ INFO = 5
+ ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+ INFO = 8
+ ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
+ INFO = 10
+ ELSE IF( LDC.LT.MAX( 1, M ) )THEN
+ INFO = 13
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'DGEMM ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+ $ ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+ $ RETURN
+*
+* And if alpha.eq.zero.
+*
+ IF( ALPHA.EQ.ZERO )THEN
+ IF( BETA.EQ.ZERO )THEN
+ DO 20, J = 1, N
+ DO 10, I = 1, M
+ C( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ DO 40, J = 1, N
+ DO 30, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 30 CONTINUE
+ 40 CONTINUE
+ END IF
+ RETURN
+ END IF
+*
+* Start the operations.
+*
+ IF( NOTB )THEN
+ IF( NOTA )THEN
+*
+* Form C := alpha*A*B + beta*C.
+*
+ DO 90, J = 1, N
+ IF( BETA.EQ.ZERO )THEN
+ DO 50, I = 1, M
+ C( I, J ) = ZERO
+ 50 CONTINUE
+ ELSE IF( BETA.NE.ONE )THEN
+ DO 60, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 60 CONTINUE
+ END IF
+ DO 80, L = 1, K
+ IF( B( L, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( L, J )
+ DO 70, I = 1, M
+ C( I, J ) = C( I, J ) + TEMP*A( I, L )
+ 70 CONTINUE
+ END IF
+ 80 CONTINUE
+ 90 CONTINUE
+ ELSE
+*
+* Form C := alpha*A'*B + beta*C
+*
+ DO 120, J = 1, N
+ DO 110, I = 1, M
+ TEMP = ZERO
+ DO 100, L = 1, K
+ TEMP = TEMP + A( L, I )*B( L, J )
+ 100 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ ELSE
+ IF( NOTA )THEN
+*
+* Form C := alpha*A*B' + beta*C
+*
+ DO 170, J = 1, N
+ IF( BETA.EQ.ZERO )THEN
+ DO 130, I = 1, M
+ C( I, J ) = ZERO
+ 130 CONTINUE
+ ELSE IF( BETA.NE.ONE )THEN
+ DO 140, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 140 CONTINUE
+ END IF
+ DO 160, L = 1, K
+ IF( B( J, L ).NE.ZERO )THEN
+ TEMP = ALPHA*B( J, L )
+ DO 150, I = 1, M
+ C( I, J ) = C( I, J ) + TEMP*A( I, L )
+ 150 CONTINUE
+ END IF
+ 160 CONTINUE
+ 170 CONTINUE
+ ELSE
+*
+* Form C := alpha*A'*B' + beta*C
+*
+ DO 200, J = 1, N
+ DO 190, I = 1, M
+ TEMP = ZERO
+ DO 180, L = 1, K
+ TEMP = TEMP + A( L, I )*B( J, L )
+ 180 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 190 CONTINUE
+ 200 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DGEMM .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemv.c
new file mode 100644
index 0000000000000000000000000000000000000000..35d25ad7b924532c975ea24c9c7b3aefb90bd8e8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgemv.c
@@ -0,0 +1,245 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dgemv_(const char *trans, const integer *m, const integer *n, doublereal *alpha,
+ doublereal *a, const integer *lda, doublereal *x, const integer *incx,
+ doublereal *beta, doublereal *y, const integer *incy)
+{
+ /* Local variables */
+ static integer info;
+ static doublereal temp;
+ static integer lenx, leny, i, j;
+ static integer ix, iy, jx, jy, kx, ky;
+
+/*
+ Purpose
+ =======
+
+ DGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+*/
+
+/* Test the input parameters. */
+ info = 0;
+ if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DGEMV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return;
+ }
+
+/* Set LENX and LENY, the lengths of the vectors x and y, and set
+ up the start points in X and Y. */
+
+ if (lsame_(trans, "N")) { /* no transpose */
+ lenx = *n;
+ leny = *m;
+ } else { /* transpose */
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = - (lenx - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 0;
+ } else {
+ ky = - (leny - 1) * *incy;
+ }
+
+/* Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+
+ First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[i] = 0.;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ y[i] *= *beta;
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[iy] = 0.;
+ iy += *incy;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ y[iy] *= *beta;
+ iy += *incy;
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return;
+ }
+ if (lsame_(trans, "N")) { /* no transpose */
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ for (i = 0; i < *m; ++i) {
+ y[i] += temp * a[i + j* *lda];
+ }
+ }
+ jx += *incx;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ iy = ky;
+ for (i = 0; i < *m; ++i) {
+ y[iy] += temp * a[i + j* *lda];
+ iy += *incy;
+ }
+ }
+ jx += *incx;
+ }
+ }
+ } else { /* transpose */
+
+/* Form y := alpha*A'*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ temp = 0.;
+ for (i = 0; i < *m; ++i) {
+ temp += a[i + j* *lda] * x[i];
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ temp = 0.;
+ ix = kx;
+ for (i = 0; i < *m; ++i) {
+ temp += a[i + j* *lda] * x[ix];
+ ix += *incx;
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+ }
+ }
+ }
+} /* dgemv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.c
new file mode 100644
index 0000000000000000000000000000000000000000..4f5532829036f8dd927dc9f15846151565785e02
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.c
@@ -0,0 +1,214 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dgeqpf_(integer *m, integer *n, doublereal *a, integer *lda,
+ integer *jpvt, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static doublereal temp, temp2;
+ static integer i, j;
+ static integer itemp;
+ static integer ma, mn;
+ static doublereal aii;
+ static integer pvt;
+
+/* -- LAPACK test routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGEQPF computes a QR factorization with column pivoting of a */
+/* real M-by-N matrix A: A*P = Q*R. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0 */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, the upper triangle of the array contains the */
+/* min(M,N)-by-N upper triangular matrix R; the elements */
+/* below the diagonal, together with the array TAU, */
+/* represent the orthogonal matrix Q as a product of */
+/* min(m,n) elementary reflectors. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* JPVT (input/output) INTEGER array, dimension (N) */
+/* On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted */
+/* to the front of A*P (a leading column); if JPVT(i) = 0, */
+/* the i-th column of A is a free column. */
+/* On exit, if JPVT(i) = k, then the i-th column of A*P */
+/* was the k-th column of A. */
+/* */
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (3*N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(n) */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i). */
+/* */
+/* The matrix P is represented in jpvt as follows: If */
+/* jpvt(j) = i */
+/* then the jth column of P is the ith canonical unit vector. */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQPF", &i__1);
+ return;
+ }
+
+ mn = min(*m,*n);
+
+/* Move initial columns up front */
+
+ itemp = 0;
+ for (i = 0; i < *n; ++i) {
+ if (jpvt[i] != 0) {
+ if (i != itemp) {
+ dswap_(m, &a[i * *lda], &c__1, &a[itemp * *lda], &c__1);
+ jpvt[i] = jpvt[itemp];
+ jpvt[itemp] = i+1;
+ } else {
+ jpvt[i] = i+1;
+ }
+ ++itemp;
+ } else {
+ jpvt[i] = i+1;
+ }
+ }
+ --itemp;
+
+/* Compute the QR factorization and update remaining columns */
+
+ if (itemp >= 0) {
+ ma = min(itemp+1,*m);
+ dgeqr2_(m, &ma, a, lda, tau, work, info);
+ if (ma < *n) {
+ i__1 = *n - ma;
+ dorm2r_("Left", "Transpose", m, &i__1, &ma, a, lda, tau, &a[ma * *lda], lda, work, info);
+ }
+ }
+
+ if (itemp < mn-1) {
+
+/* Initialize partial column norms. The first n elements of */
+/* work store the exact column norms. */
+
+ for (i = itemp + 1; i < *n; ++i) {
+ i__1 = *m - itemp - 1;
+ work[i] = dnrm2_(&i__1, &a[itemp + 1 + i * *lda], &c__1);
+ work[*n + i] = work[i];
+ }
+
+/* Compute factorization */
+
+ for (i = itemp + 1; i < mn; ++i) {
+
+/* Determine ith pivot column and swap if necessary */
+
+ i__1 = *n - i;
+ pvt = i - 1 + idamax_(&i__1, &work[i], &c__1);
+
+ if (pvt != i) {
+ dswap_(m, &a[pvt * *lda], &c__1, &a[i * *lda], &c__1);
+ itemp = jpvt[pvt];
+ jpvt[pvt] = jpvt[i];
+ jpvt[i] = itemp;
+ work[pvt] = work[i];
+ work[*n + pvt] = work[*n + i];
+ }
+
+/* Generate elementary reflector H(i) */
+
+ if (i < *m - 1) {
+ i__1 = *m - i;
+ dlarfg_(&i__1, &a[i + i * *lda], &a[i + 1 + i * *lda], &c__1, &tau[i]);
+ } else {
+ i__1 = *m - 1;
+ dlarfg_(&c__1, &a[i__1 + i__1 * *lda], &a[i__1 + i__1 * *lda], &c__1, &tau[i__1]);
+ }
+
+ if (i < *n - 1) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.;
+ i__1 = *m - i;
+ i__2 = *n - i - 1;
+ dlarf_("LEFT", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i],
+ &a[i + (i + 1) * *lda], lda, &work[*n << 1]);
+ a[i + i * *lda] = aii;
+ }
+
+/* Update partial column norms */
+
+ for (j = i + 1; j < *n; ++j) {
+ if (work[j] != 0.) {
+ temp = abs(a[i + j * *lda]) / work[j];
+ temp = 1. - temp * temp;
+ temp = max(temp,0.);
+ temp2 = work[j] / work[*n + j];
+ temp2 = temp * .05 * (temp2 * temp2) + 1.;
+ if (temp2 == 1.) {
+ if (*m - i > 1) {
+ i__2 = *m - i - 1;
+ work[j] = dnrm2_(&i__2, &a[i + 1 + j * *lda], &c__1);
+ work[*n + j] = work[j];
+ } else {
+ work[j] = 0.;
+ work[*n + j] = 0.;
+ }
+ } else {
+ work[j] *= sqrt(temp);
+ }
+ }
+ }
+ }
+ }
+} /* dgeqpf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.f
new file mode 100644
index 0000000000000000000000000000000000000000..0ecf1d99d3fe7bab85e1369edf6847e457758bdd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqpf.f
@@ -0,0 +1,220 @@
+ SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
+*
+* -- LAPACK test routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ INTEGER JPVT( * )
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGEQPF computes a QR factorization with column pivoting of a
+* real M-by-N matrix A: A*P = Q*R.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, the upper triangle of the array contains the
+* min(M,N)-by-N upper triangular matrix R; the elements
+* below the diagonal, together with the array TAU,
+* represent the orthogonal matrix Q as a product of
+* min(m,n) elementary reflectors.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* JPVT (input/output) INTEGER array, dimension (N)
+* On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+* to the front of A*P (a leading column); if JPVT(i) = 0,
+* the i-th column of A is a free column.
+* On exit, if JPVT(i) = k, then the i-th column of A*P
+* was the k-th column of A.
+*
+* TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(n)
+*
+* Each H(i) has the form
+*
+* H = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+*
+* The matrix P is represented in jpvt as follows: If
+* jpvt(j) = i
+* then the jth column of P is the ith canonical unit vector.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, MA, MN, PVT
+ DOUBLE PRECISION AII, TEMP, TEMP2
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEQR2, DLARF, DLARFG, DORM2R, DSWAP, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ INTEGER IDAMAX
+ DOUBLE PRECISION DNRM2
+ EXTERNAL IDAMAX, DNRM2
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGEQPF', -INFO )
+ RETURN
+ END IF
+*
+ MN = MIN( M, N )
+*
+* Move initial columns up front
+*
+ ITEMP = 1
+ DO 10 I = 1, N
+ IF( JPVT( I ).NE.0 ) THEN
+ IF( I.NE.ITEMP ) THEN
+ CALL DSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
+ JPVT( I ) = JPVT( ITEMP )
+ JPVT( ITEMP ) = I
+ ELSE
+ JPVT( I ) = I
+ END IF
+ ITEMP = ITEMP + 1
+ ELSE
+ JPVT( I ) = I
+ END IF
+ 10 CONTINUE
+ ITEMP = ITEMP - 1
+*
+* Compute the QR factorization and update remaining columns
+*
+ IF( ITEMP.GT.0 ) THEN
+ MA = MIN( ITEMP, M )
+ CALL DGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
+ IF( MA.LT.N ) THEN
+ CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
+ $ A( 1, MA+1 ), LDA, WORK, INFO )
+ END IF
+ END IF
+*
+ IF( ITEMP.LT.MN ) THEN
+*
+* Initialize partial column norms. The first n elements of
+* work store the exact column norms.
+*
+ DO 20 I = ITEMP + 1, N
+ WORK( I ) = DNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
+ WORK( N+I ) = WORK( I )
+ 20 CONTINUE
+*
+* Compute factorization
+*
+ DO 40 I = ITEMP + 1, MN
+*
+* Determine ith pivot column and swap if necessary
+*
+ PVT = ( I-1 ) + IDAMAX( N-I+1, WORK( I ), 1 )
+*
+ IF( PVT.NE.I ) THEN
+ CALL DSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
+ ITEMP = JPVT( PVT )
+ JPVT( PVT ) = JPVT( I )
+ JPVT( I ) = ITEMP
+ WORK( PVT ) = WORK( I )
+ WORK( N+PVT ) = WORK( N+I )
+ END IF
+*
+* Generate elementary reflector H(i)
+*
+ IF( I.LT.M ) THEN
+ CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) )
+ ELSE
+ CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
+ END IF
+*
+ IF( I.LT.N ) THEN
+*
+* Apply H(i) to A(i:m,i+1:n) from the left
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK( 2*N+1 ) )
+ A( I, I ) = AII
+ END IF
+*
+* Update partial column norms
+*
+ DO 30 J = I + 1, N
+ IF( WORK( J ).NE.ZERO ) THEN
+ TEMP = ONE - ( ABS( A( I, J ) ) / WORK( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = ONE + 0.05D0*TEMP*
+ $ ( WORK( J ) / WORK( N+J ) )**2
+ IF( TEMP2.EQ.ONE ) THEN
+ IF( M-I.GT.0 ) THEN
+ WORK( J ) = DNRM2( M-I, A( I+1, J ), 1 )
+ WORK( N+J ) = WORK( J )
+ ELSE
+ WORK( J ) = ZERO
+ WORK( N+J ) = ZERO
+ END IF
+ ELSE
+ WORK( J ) = WORK( J )*SQRT( TEMP )
+ END IF
+ END IF
+ 30 CONTINUE
+*
+ 40 CONTINUE
+ END IF
+ RETURN
+*
+* End of DGEQPF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.c
new file mode 100644
index 0000000000000000000000000000000000000000..953407cb08eb125364aa6a0a7e969b3d914bad4e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.c
@@ -0,0 +1,110 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dgeqr2_(integer *m, integer *n, doublereal *a, integer *lda,
+ doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, ip1;
+ static doublereal aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGEQR2 computes a QR factorization of a real m by n matrix A: */
+/* A = Q * R. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, the elements on and above the diagonal of the array */
+/* contain the min(m,n) by n upper trapezoidal matrix R (R is */
+/* upper triangular if m >= n); the elements below the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of elementary reflectors (see Further Details). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
+/* and tau in TAU(i). */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQR2", &i__1);
+ return;
+ }
+
+ for (i = 0; i < *m && i < *n; ++i) {
+ ip1 = i + 1;
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__1 = *m - i;
+ dlarfg_(&i__1, &a[i + i * *lda], &a[min(ip1,*m-1) + i * *lda], &c__1, &tau[i]);
+ if (ip1 < *n) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.;
+ i__1 = *m - i;
+ i__2 = *n - ip1;
+ dlarf_("Left", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i], &a[i + ip1 * *lda], lda, work);
+ a[i + i * *lda] = aii;
+ }
+ }
+} /* dgeqr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.f
new file mode 100644
index 0000000000000000000000000000000000000000..9dc6435c51ff963fe20257e8c7c994ea1fc11752
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqr2.f
@@ -0,0 +1,122 @@
+ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGEQR2 computes a QR factorization of a real m by n matrix A:
+* A = Q * R.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the m by n matrix A.
+* On exit, the elements on and above the diagonal of the array
+* contain the min(m,n) by n upper trapezoidal matrix R (R is
+* upper triangular if m >= n); the elements below the diagonal,
+* with the array TAU, represent the orthogonal matrix Q as a
+* product of elementary reflectors (see Further Details).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+* and tau in TAU(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, K
+ DOUBLE PRECISION AII
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, DLARFG, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGEQR2', -INFO )
+ RETURN
+ END IF
+*
+ K = MIN( M, N )
+*
+ DO 10 I = 1, K
+*
+* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
+*
+ CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
+ $ TAU( I ) )
+ IF( I.LT.N ) THEN
+*
+* Apply H(i) to A(i:m,i+1:n) from the left
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK )
+ A( I, I ) = AII
+ END IF
+ 10 CONTINUE
+ RETURN
+*
+* End of DGEQR2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.c
new file mode 100644
index 0000000000000000000000000000000000000000..22ef7176a84d6abc38b60b4a38dfc11e9506589b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.c
@@ -0,0 +1,188 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+
+/* Subroutine */ void dgeqrf_(m, n, a, lda, tau, work, lwork, info)
+integer *m, *n;
+doublereal *a;
+integer *lda;
+doublereal *tau, *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i, k, nbmin, iinfo;
+ static integer ib, nb;
+ static integer nx;
+ static integer ldwork, lwkopt;
+ static logical lquery;
+ static integer iws, mmi;
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DGEQRF computes a QR factorization of a real M-by-N matrix A: */
+/* A = Q * R. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, the elements on and above the diagonal of the array */
+/* contain the min(M,N)-by-N upper trapezoidal matrix R (R is */
+/* upper triangular if m >= n); the elements below the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of min(m,n) elementary reflectors (see Further */
+/* Details). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* For optimum performance LWORK >= N*NB, where NB is */
+/* the optimal blocksize. */
+/* */
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
+/* and tau in TAU(i). */
+/* */
+/* ===================================================================== */
+
+ /* Test the input arguments */
+
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ lwkopt = *n * nb;
+ *work = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) *info = 1;
+ else if (*n < 0) *info = 2;
+ else if (*lda < max(1,*m)) *info = 4;
+ else if (*lwork < max(1,*n) && ! lquery) *info = 7;
+ if (*info != 0) {
+ xerbla_("DGEQRF", info);
+ *info = -(*info);
+ return;
+ }
+ else if (lquery)
+ return;
+
+ /* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ *work = 1.;
+ return;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if (nb > 1 && nb < k)
+ {
+ /* Determine when to cross over from blocked to unblocked code. */
+ nx = ilaenv_(&c__3, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ nx = max(0,nx);
+ if (nx < k)
+ {
+ /* Determine if workspace is large enough for blocked code. */
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws)
+ {
+ /* Not enough workspace to use optimal NB: */
+ /* reduce NB and determine the minimum value of NB. */
+ nb = *lwork / ldwork;
+ nbmin = ilaenv_(&c__2, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ nbmin = max(2,nbmin);
+ }
+ }
+ }
+
+ mmi = *m;
+ if (nb >= nbmin && nb < k && nx < k) /* nbmin is at least 2, so is nb */
+ {
+ /* Use blocked code initially */
+ for (i = 0; i < k-nx; i += nb, mmi -= nb) /* mmi == *m - i */
+ {
+ ib = min(k-i,nb);
+
+ /* Compute the QR factorization of the current block */
+ /* A(i:m,i:i+ib-1) */
+ dgeqr2_(&mmi, &ib, &a[i + i * *lda], lda, &tau[i], work, &iinfo);
+ if (i + ib < *n)
+ {
+ /* Form the triangular factor of the block reflector */
+ /* H = H(i) H(i+1) . . . H(i+ib-1) */
+ dlarft_("Forward", "Columnwise", &mmi, &ib, &a[i + i * *lda], lda, &tau[i], work, &ldwork);
+
+ /* Apply H' to A(i:m,i+ib:n) from the left */
+ i__1 = *n - i - ib;
+ dlarfb_("Left", "Transpose", "Forward", "Columnwise", &mmi, &i__1,
+ &ib, &a[i + i * *lda], lda, work, &ldwork,
+ &a[i + (i + ib) * *lda], lda, work+ib, &ldwork);
+ }
+ }
+ }
+ else
+ i = 0;
+
+ /* Use unblocked code to factor the last or only block. */
+ if (i < k) {
+ i__1 = *n - i;
+ dgeqr2_(&mmi, &i__1, &a[i + i * *lda], lda, &tau[i], work, &iinfo);
+ }
+
+ *work = (doublereal) iws;
+
+} /* dgeqrf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.f
new file mode 100644
index 0000000000000000000000000000000000000000..7a40b537fb865291ce2eec2eb95d30ccf77d072b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgeqrf.f
@@ -0,0 +1,197 @@
+ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, LWORK, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGEQRF computes a QR factorization of a real M-by-N matrix A:
+* A = Q * R.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, the elements on and above the diagonal of the array
+* contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+* upper triangular if m >= n); the elements below the diagonal,
+* with the array TAU, represent the orthogonal matrix Q as a
+* product of min(m,n) elementary reflectors (see Further
+* Details).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= max(1,N).
+* For optimum performance LWORK >= N*NB, where NB is
+* the optimal blocksize.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+* and tau in TAU(i).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL LQUERY
+ INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+ $ NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
+ LWKOPT = N*NB
+ WORK( 1 ) = LWKOPT
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+ INFO = -7
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGEQRF', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ K = MIN( M, N )
+ IF( K.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ NBMIN = 2
+ NX = 0
+ IWS = N
+ IF( NB.GT.1 .AND. NB.LT.K ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+*
+ NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
+ IF( NX.LT.K ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ LDWORK = N
+ IWS = LDWORK*NB
+ IF( LWORK.LT.IWS ) THEN
+*
+* Not enough workspace to use optimal NB: reduce NB and
+* determine the minimum value of NB.
+*
+ NB = LWORK / LDWORK
+ NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
+ $ -1 ) )
+ END IF
+ END IF
+ END IF
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
+*
+* Use blocked code initially
+*
+ DO 10 I = 1, K - NX, NB
+ IB = MIN( K-I+1, NB )
+*
+* Compute the QR factorization of the current block
+* A(i:m,i:i+ib-1)
+*
+ CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
+ $ IINFO )
+ IF( I+IB.LE.N ) THEN
+*
+* Form the triangular factor of the block reflector
+* H = H(i) H(i+1) . . . H(i+ib-1)
+*
+ CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+ $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
+*
+* Apply H' to A(i:m,i+ib:n) from the left
+*
+ CALL DLARFB( 'Left', 'Transpose', 'Forward',
+ $ 'Columnwise', M-I+1, N-I-IB+1, IB,
+ $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
+ $ LDA, WORK( IB+1 ), LDWORK )
+ END IF
+ 10 CONTINUE
+ ELSE
+ I = 1
+ END IF
+*
+* Use unblocked code to factor the last or only block.
+*
+ IF( I.LE.K )
+ $ CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
+ $ IINFO )
+*
+ WORK( 1 ) = IWS
+ RETURN
+*
+* End of DGEQRF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dger.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dger.c
new file mode 100644
index 0000000000000000000000000000000000000000..18d5a04e7fac3dfcff2f1eeba7935b2444c0c78c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dger.c
@@ -0,0 +1,148 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dger_(const integer *m, const integer *n, doublereal *alpha,
+ doublereal *x, const integer *incx, doublereal *y, const integer *incy,
+ doublereal *a, const integer *lda)
+{
+ /* Local variables */
+ static integer info;
+ static doublereal temp;
+ static integer i, j, ix, jy, kx;
+
+/*
+ Purpose
+ =======
+
+ DGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Parameters
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+*/
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DGER ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || *alpha == 0.) {
+ return;
+ }
+
+/* Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A. */
+
+ if (*incy > 0) {
+ jy = 0;
+ } else {
+ jy = (1 - *n) * *incy;
+ }
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ for (i = 0; i < *m; ++i) {
+ a[i + j* *lda] += x[i] * temp;
+ }
+ }
+ jy += *incy;
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = (1 - *m) * *incx;
+ }
+ for (j = 0; j < *n; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ ix = kx;
+ for (i = 0; i < *m; ++i) {
+ a[i + j* *lda] += x[ix] * temp;
+ ix += *incx;
+ }
+ }
+ jy += *incy;
+ }
+ }
+} /* dger_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.c
new file mode 100644
index 0000000000000000000000000000000000000000..28868e2147733352d48b74240c1b491c268ca831
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.c
@@ -0,0 +1,102 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Subroutine */ void dgerq2_(const integer *m, const integer *n, doublereal *a, const integer *lda,
+ doublereal *tau, doublereal *work, integer *info)
+{
+ /* Local variables */
+ static integer i, k, k1, k2, k3;
+ static doublereal aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGERQ2 computes an RQ factorization of a real m by n matrix A: */
+/* A = R * Q. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, if m <= n, the upper triangle of the subarray */
+/* A(1:m,n-m+1:n) contains the m by m upper triangular matrix R; */
+/* if m >= n, the elements on and above the (m-n)-th subdiagonal */
+/* contain the m by n upper trapezoidal matrix R; the remaining */
+/* elements, with the array TAU, represent the orthogonal matrix */
+/* Q as a product of elementary reflectors (see Further */
+/* Details). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (M) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in */
+/* A(m-k+i,1:n-k+i-1), and tau in TAU(i). */
+/* */
+/* ===================================================================== */
+
+ /* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) *info = 1;
+ else if (*n < 0) *info = 2;
+ else if (*lda < max(1,*m)) *info = 4;
+ if (*info != 0) {
+ xerbla_("DGERQ2", info);
+ *info = -(*info);
+ return;
+ }
+
+ k = min(*m,*n);
+ k1 = *m;
+ k2 = *n + 1;
+ k3 = *m + *n * *lda;
+
+ for (i = k-1; i >= 0; --i)
+ {
+ --k1; --k2; k3 -= *lda + 1;
+
+ /* Generate elementary reflector H(i) to annihilate A(m-k+i,1:n-k+i-1) */
+ dlarfg_(&k2, &a[k3], &a[k1], lda, &tau[i]);
+
+ /* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right */
+ aii = a[k3]; a[k3] = 1.;
+ dlarf_("Right", &k1, &k2, &a[k1], lda, &tau[i], a, lda, work);
+ a[k3] = aii;
+ }
+} /* dgerq2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.f
new file mode 100644
index 0000000000000000000000000000000000000000..c772b1d8e5a3c69459c59b81532d16e2c064aa7e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgerq2.f
@@ -0,0 +1,123 @@
+ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGERQ2 computes an RQ factorization of a real m by n matrix A:
+* A = R * Q.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the m by n matrix A.
+* On exit, if m <= n, the upper triangle of the subarray
+* A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+* if m >= n, the elements on and above the (m-n)-th subdiagonal
+* contain the m by n upper trapezoidal matrix R; the remaining
+* elements, with the array TAU, represent the orthogonal matrix
+* Q as a product of elementary reflectors (see Further
+* Details).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (M)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+* A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, K
+ DOUBLE PRECISION AII
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, DLARFG, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGERQ2', -INFO )
+ RETURN
+ END IF
+*
+ K = MIN( M, N )
+*
+ DO 10 I = K, 1, -1
+*
+* Generate elementary reflector H(i) to annihilate
+* A(m-k+i,1:n-k+i-1)
+*
+ CALL DLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
+ $ TAU( I ) )
+*
+* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
+*
+ AII = A( M-K+I, N-K+I )
+ A( M-K+I, N-K+I ) = ONE
+ CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
+ $ TAU( I ), A, LDA, WORK )
+ A( M-K+I, N-K+I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of DGERQ2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.c
new file mode 100644
index 0000000000000000000000000000000000000000..54f7102404193e61c906af3b86d6f315ab18ebd5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.c
@@ -0,0 +1,124 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+
+/* Subroutine */ void dgesc2_(n, a, lda, rhs, ipiv, jpiv, scale)
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *rhs;
+integer *ipiv, *jpiv;
+doublereal *scale;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal temp;
+ static integer i, j;
+ static doublereal bignum;
+ static doublereal smlnum, eps;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGESC2 solves a system of linear equations */
+/* */
+/* A * X = scale* RHS */
+/* */
+/* with a general N-by-N matrix A using the LU factorization with */
+/* complete pivoting computed by DGETC2. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the LU part of the factorization of the n-by-n */
+/* matrix A computed by DGETC2: A = P * L * U * Q */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1, N). */
+/* */
+/* RHS (input/output) DOUBLE PRECISION array, dimension (N). */
+/* On entry, the right hand side vector b. */
+/* On exit, the solution vector X. */
+/* */
+/* IPIV (iput) INTEGER array, dimension (N). */
+/* The pivot indices; for 1 <= i <= N, row i of the */
+/* matrix has been interchanged with row IPIV(i). */
+/* */
+/* JPIV (iput) INTEGER array, dimension (N). */
+/* The pivot indices; for 1 <= j <= N, column j of the */
+/* matrix has been interchanged with column JPIV(j). */
+/* */
+/* SCALE (output) DOUBLE PRECISION */
+/* On exit, SCALE contains the scale factor. SCALE is chosen */
+/* 0 <= SCALE <= 1 to prevent owerflow in the solution. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+/* */
+/* ===================================================================== */
+
+/* Set constant to control owerflow */
+
+ eps = dlamch_("P");
+ smlnum = dlamch_("S") / eps;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Apply permutations IPIV to RHS */
+
+ i__1 = *n - 1;
+ dlaswp_(&c__1, rhs, lda, &c__1, &i__1, ipiv, &c__1);
+
+/* Solve for L part */
+
+ for (i = 0; i < *n - 1; ++i) {
+ for (j = i + 1; j < *n; ++j) {
+ rhs[j] -= a[j + i * *lda] * rhs[i];
+ }
+ }
+
+/* Solve for U part */
+
+ *scale = 1.;
+
+/* Check for scaling */
+
+ i = idamax_(n, rhs, &c__1) - 1;
+ if (smlnum * 2. * abs(rhs[i]) > abs(a[*n-1 + (*n-1) * *lda])) {
+ temp = .5 / abs(rhs[i]);
+ dscal_(n, &temp, rhs, &c__1);
+ *scale *= temp;
+ }
+
+ for (i = *n-1; i >= 0; --i) {
+ temp = 1. / a[i + i * *lda];
+ rhs[i] *= temp;
+ for (j = i + 1; j < *n; ++j) {
+ rhs[i] -= rhs[j] * (a[i + j * *lda] * temp);
+ }
+ }
+
+/* Apply permutations JPIV to the solution (RHS) */
+
+ i__1 = *n - 1;
+ dlaswp_(&c__1, rhs, lda, &c__1, &i__1, jpiv, &c_n1);
+
+} /* dgesc2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.f
new file mode 100644
index 0000000000000000000000000000000000000000..33ac0e603c6dcd1ce196b91521672fac26585b14
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgesc2.f
@@ -0,0 +1,133 @@
+ SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER LDA, N
+ DOUBLE PRECISION SCALE
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), JPIV( * )
+ DOUBLE PRECISION A( LDA, * ), RHS( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGESC2 solves a system of linear equations
+*
+* A * X = scale* RHS
+*
+* with a general N-by-N matrix A using the LU factorization with
+* complete pivoting computed by DGETC2.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix A.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the LU part of the factorization of the n-by-n
+* matrix A computed by DGETC2: A = P * L * U * Q
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1, N).
+*
+* RHS (input/output) DOUBLE PRECISION array, dimension (N).
+* On entry, the right hand side vector b.
+* On exit, the solution vector X.
+*
+* IPIV (iput) INTEGER array, dimension (N).
+* The pivot indices; for 1 <= i <= N, row i of the
+* matrix has been interchanged with row IPIV(i).
+*
+* JPIV (iput) INTEGER array, dimension (N).
+* The pivot indices; for 1 <= j <= N, column j of the
+* matrix has been interchanged with column JPIV(j).
+*
+* SCALE (output) DOUBLE PRECISION
+* On exit, SCALE contains the scale factor. SCALE is chosen
+* 0 <= SCALE <= 1 to prevent owerflow in the solution.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, TWO
+ PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLASWP, DSCAL
+* ..
+* .. External Functions ..
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL IDAMAX, DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+* Set constant to control owerflow
+*
+ EPS = DLAMCH( 'P' )
+ SMLNUM = DLAMCH( 'S' ) / EPS
+ BIGNUM = ONE / SMLNUM
+ CALL DLABAD( SMLNUM, BIGNUM )
+*
+* Apply permutations IPIV to RHS
+*
+ CALL DLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
+*
+* Solve for L part
+*
+ DO 20 I = 1, N - 1
+ DO 10 J = I + 1, N
+ RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
+ 10 CONTINUE
+ 20 CONTINUE
+*
+* Solve for U part
+*
+ SCALE = ONE
+*
+* Check for scaling
+*
+ I = IDAMAX( N, RHS, 1 )
+ IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
+ TEMP = ( ONE / TWO ) / ABS( RHS( I ) )
+ CALL DSCAL( N, TEMP, RHS( 1 ), 1 )
+ SCALE = SCALE*TEMP
+ END IF
+*
+ DO 40 I = N, 1, -1
+ TEMP = ONE / A( I, I )
+ RHS( I ) = RHS( I )*TEMP
+ DO 30 J = I + 1, N
+ RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
+ 30 CONTINUE
+ 40 CONTINUE
+*
+* Apply permutations JPIV to the solution (RHS)
+*
+ CALL DLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
+ RETURN
+*
+* End of DGESC2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.c
new file mode 100644
index 0000000000000000000000000000000000000000..9960a2e4f7ecb3e7468911badf7ac6b6b3481248
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.c
@@ -0,0 +1,136 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b10 = -1.;
+
+/* Subroutine */ void dgetc2_(n, a, lda, ipiv, jpiv, info)
+integer *n;
+doublereal *a;
+integer *lda, *ipiv, *jpiv, *info;
+{
+ /* Local variables */
+ static doublereal smin, xmax;
+ static integer i, j;
+ static integer ip, jp;
+ static doublereal bignum, smlnum, eps;
+ static integer ipv, jpv;
+
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGETC2 computes an LU factorization with complete pivoting of the */
+/* n-by-n matrix A. The factorization has the form A = P * L * U * Q, */
+/* where P and Q are permutation matrices, L is lower triangular with */
+/* unit diagonal elements and U is upper triangular. */
+/* */
+/* This is the Level 2 BLAS algorithm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
+/* On entry, the n-by-n matrix A to be factored. */
+/* On exit, the factors L and U from the factorization */
+/* A = P*L*U*Q; the unit diagonal elements of L are not stored. */
+/* If U(k, k) appears to be less than SMIN, U(k, k) is given the */
+/* value of SMIN, i.e., giving a nonsingular perturbed system. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* IPIV (output) INTEGER array, dimension(N). */
+/* The pivot indices; for 1 <= i <= N, row i of the */
+/* matrix has been interchanged with row IPIV(i). */
+/* */
+/* JPIV (output) INTEGER array, dimension(N). */
+/* The pivot indices; for 1 <= j <= N, column j of the */
+/* matrix has been interchanged with column JPIV(j). */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* > 0: if INFO = k, U(k, k) is likely to produce owerflow if */
+/* we try to solve for x in Ax = b. So U is perturbed to */
+/* avoid the overflow. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+/* */
+/* ===================================================================== */
+
+/* Set constants to control overflow */
+
+ *info = 0;
+ eps = dlamch_("P");
+ smlnum = dlamch_("S") / eps;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Factorize A using complete pivoting. */
+/* Set pivots less than SMIN to SMIN. */
+
+ for (i = 0; i < *n - 1; ++i) {
+
+/* Find max element in matrix A */
+
+ xmax = 0.;
+ for (ip = i; ip < *n; ++ip) {
+ for (jp = i; jp < *n; ++jp) {
+ if (abs(a[ip + jp * *lda]) >= xmax) {
+ xmax = abs(a[ip + jp * *lda]);
+ ipv = ip;
+ jpv = jp;
+ }
+ }
+ }
+ if (i == 0) {
+ smin = max(eps*xmax, smlnum);
+ }
+
+/* Swap rows */
+
+ if (ipv != i) {
+ dswap_(n, &a[ipv], lda, &a[i], lda);
+ }
+ ipiv[i] = ipv+1;
+
+/* Swap columns */
+
+ if (jpv != i) {
+ dswap_(n, &a[jpv * *lda], &c__1, &a[i * *lda], &c__1);
+ }
+ jpiv[i] = jpv+1;
+
+/* Check for singularity */
+
+ if (abs(a[i + i * *lda]) < smin) {
+ *info = i + 1;
+ a[i + i * *lda] = smin;
+ }
+ for (j = i + 1; j < *n; ++j) {
+ a[j + i * *lda] /= a[i + i * *lda];
+ }
+ j = *n - i - 1;
+ dger_(&j, &j, &c_b10, &a[i + 1 + i * *lda], &c__1,
+ &a[i + (i + 1) * *lda], lda, &a[i + 1 + (i + 1) * *lda], lda);
+ }
+
+ if (abs(a[*n-1 + (*n-1) * *lda]) < smin) {
+ *info = *n;
+ a[*n-1 + (*n-1) * *lda] = smin;
+ }
+} /* dgetc2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.f
new file mode 100644
index 0000000000000000000000000000000000000000..d7ac5868a2a412f53bbe186a5f97c5ec0afda1c9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgetc2.f
@@ -0,0 +1,147 @@
+ SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, N
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), JPIV( * )
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGETC2 computes an LU factorization with complete pivoting of the
+* n-by-n matrix A. The factorization has the form A = P * L * U * Q,
+* where P and Q are permutation matrices, L is lower triangular with
+* unit diagonal elements and U is upper triangular.
+*
+* This is the Level 2 BLAS algorithm.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+* On entry, the n-by-n matrix A to be factored.
+* On exit, the factors L and U from the factorization
+* A = P*L*U*Q; the unit diagonal elements of L are not stored.
+* If U(k, k) appears to be less than SMIN, U(k, k) is given the
+* value of SMIN, i.e., giving a nonsingular perturbed system.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* IPIV (output) INTEGER array, dimension(N).
+* The pivot indices; for 1 <= i <= N, row i of the
+* matrix has been interchanged with row IPIV(i).
+*
+* JPIV (output) INTEGER array, dimension(N).
+* The pivot indices; for 1 <= j <= N, column j of the
+* matrix has been interchanged with column JPIV(j).
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* > 0: if INFO = k, U(k, k) is likely to produce owerflow if
+* we try to solve for x in Ax = b. So U is perturbed to
+* avoid the overflow.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, IP, IPV, J, JP, JPV
+ DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGER, DSWAP
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX
+* ..
+* .. Executable Statements ..
+*
+* Set constants to control overflow
+*
+ INFO = 0
+ EPS = DLAMCH( 'P' )
+ SMLNUM = DLAMCH( 'S' ) / EPS
+ BIGNUM = ONE / SMLNUM
+ CALL DLABAD( SMLNUM, BIGNUM )
+*
+* Factorize A using complete pivoting.
+* Set pivots less than SMIN to SMIN.
+*
+ DO 40 I = 1, N - 1
+*
+* Find max element in matrix A
+*
+ XMAX = ZERO
+ DO 20 IP = I, N
+ DO 10 JP = I, N
+ IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
+ XMAX = ABS( A( IP, JP ) )
+ IPV = IP
+ JPV = JP
+ END IF
+ 10 CONTINUE
+ 20 CONTINUE
+ IF( I.EQ.1 )
+ $ SMIN = MAX( EPS*XMAX, SMLNUM )
+*
+* Swap rows
+*
+ IF( IPV.NE.I )
+ $ CALL DSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
+ IPIV( I ) = IPV
+*
+* Swap columns
+*
+ IF( JPV.NE.I )
+ $ CALL DSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
+ JPIV( I ) = JPV
+*
+* Check for singularity
+*
+ IF( ABS( A( I, I ) ).LT.SMIN ) THEN
+ INFO = I
+ A( I, I ) = SMIN
+ END IF
+ DO 30 J = I + 1, N
+ A( J, I ) = A( J, I ) / A( I, I )
+ 30 CONTINUE
+ CALL DGER( N-I, N-I, -ONE, A( I+1, I ), 1, A( I, I+1 ), LDA,
+ $ A( I+1, I+1 ), LDA )
+ 40 CONTINUE
+*
+ IF( ABS( A( N, N ) ).LT.SMIN ) THEN
+ INFO = N
+ A( N, N ) = SMIN
+ END IF
+*
+ RETURN
+*
+* End of DGETC2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.c
new file mode 100644
index 0000000000000000000000000000000000000000..8bd79c6125e7063ac10561f0f55c81fe6b2b89cf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.c
@@ -0,0 +1,202 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dggbak_(job, side, n, ilo, ihi, lscale, rscale, m, v, ldv, info)
+const char *job, *side;
+const integer *n;
+integer *ilo, *ihi;
+doublereal *lscale, *rscale;
+const integer *m;
+doublereal *v;
+const integer *ldv;
+integer *info;
+{
+ /* System generated locals */
+ integer v_dim1, v_offset, i__1;
+
+ /* Local variables */
+ static integer i, k;
+ static logical leftv;
+ static logical rightv;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+
+/* DGGBAK forms the right or left eigenvectors of a real generalized */
+/* eigenvalue problem A*x = lambda*B*x, by backward transformation on */
+/* the computed eigenvectors of the balanced pair of matrices output by */
+/* DGGBAL. */
+
+/* Arguments */
+/* ========= */
+
+/* JOB (input) CHARACTER*1 */
+/* Specifies the type of backward transformation required: */
+/* = 'N': do nothing, return immediately; */
+/* = 'P': do backward transformation for permutation only; */
+/* = 'S': do backward transformation for scaling only; */
+/* = 'B': do backward transformations for both permutation and */
+/* scaling. */
+/* JOB must be the same as the argument JOB supplied to DGGBAL. */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'R': V contains right eigenvectors; */
+/* = 'L': V contains left eigenvectors. */
+
+/* N (input) INTEGER */
+/* The number of rows of the matrix V. N >= 0. */
+
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* The integers ILO and IHI determined by DGGBAL. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+
+/* LSCALE (input) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutations and/or scaling factors applied */
+/* to the left side of A and B, as returned by DGGBAL. */
+
+/* RSCALE (input) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutations and/or scaling factors applied */
+/* to the right side of A and B, as returned by DGGBAL. */
+
+/* M (input) INTEGER */
+/* The number of columns of the matrix V. M >= 0. */
+
+/* V (input/output) DOUBLE PRECISION array, dimension (LDV,M) */
+/* On entry, the matrix of right or left eigenvectors to be */
+/* transformed, as returned by DTGEVC. */
+/* On exit, V is overwritten by the transformed eigenvectors. */
+
+/* LDV (input) INTEGER */
+/* The leading dimension of the matrix V. LDV >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit. */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+
+/* Further Details */
+/* =============== */
+
+/* See R.C. Ward, Balancing the generalized eigenvalue problem, */
+/* SIAM J. Sci. Stat. Comp. 2 (1981), 141-152. */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ --lscale;
+ --rscale;
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+
+/* Test the input parameters */
+
+ rightv = lsame_(side, "R");
+ leftv = lsame_(side, "L");
+
+ *info = 0;
+ if (! lsame_(job, "N") && ! lsame_(job, "P") && ! lsame_(job, "S") && ! lsame_(job, "B")) {
+ *info = -1;
+ } else if (! rightv && ! leftv) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1) {
+ *info = -4;
+ } else if (*ihi < *ilo || *ihi > max(1,*n)) {
+ *info = -5;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*ldv < max(1,*n)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGGBAK", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+ if (*m == 0) {
+ return;
+ }
+ if (lsame_(job, "N")) {
+ return;
+ }
+
+ if (*ilo == *ihi) {
+ goto L30;
+ }
+
+/* Backward balance */
+
+ if (lsame_(job, "S") || lsame_(job, "B")) {
+
+/* Backward transformation on right eigenvectors */
+
+ if (rightv) {
+ for (i = *ilo; i <= *ihi; ++i) {
+ dscal_(m, &rscale[i], &v[i + v_dim1], ldv);
+ }
+ }
+
+/* Backward transformation on left eigenvectors */
+
+ if (leftv) {
+ for (i = *ilo; i <= *ihi; ++i) {
+ dscal_(m, &lscale[i], &v[i + v_dim1], ldv);
+ }
+ }
+ }
+
+/* Backward permutation */
+
+L30:
+ if (lsame_(job, "P") || lsame_(job, "B")) {
+
+/* Backward permutation on right eigenvectors */
+
+ if (rightv) {
+ for (i = *ilo - 1; i >= 1; --i) {
+ k = (integer) rscale[i];
+ if (k != i) {
+ dswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+ }
+ }
+ for (i = *ihi + 1; i <= *n; ++i) {
+ k = (integer) rscale[i];
+ if (k != i) {
+ dswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+ }
+ }
+ }
+
+/* Backward permutation on left eigenvectors */
+
+ if (leftv) {
+ for (i = *ilo - 1; i >= 1; --i) {
+ k = (integer) lscale[i];
+ if (k != i) {
+ dswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+ }
+ }
+
+ for (i = *ihi + 1; i <= *n; ++i) {
+ k = (integer) lscale[i];
+ if (k != i) {
+ dswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+ }
+ }
+ }
+ }
+} /* dggbak_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.f
new file mode 100644
index 0000000000000000000000000000000000000000..75ffd51e3c8b5a3a8dfdcbe702a0fa45fdb1a394
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbak.f
@@ -0,0 +1,216 @@
+ SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
+ $ LDV, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOB, SIDE
+ INTEGER IHI, ILO, INFO, LDV, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION LSCALE( * ), RSCALE( * ), V( LDV, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGGBAK forms the right or left eigenvectors of a real generalized
+* eigenvalue problem A*x = lambda*B*x, by backward transformation on
+* the computed eigenvectors of the balanced pair of matrices output by
+* DGGBAL.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* Specifies the type of backward transformation required:
+* = 'N': do nothing, return immediately;
+* = 'P': do backward transformation for permutation only;
+* = 'S': do backward transformation for scaling only;
+* = 'B': do backward transformations for both permutation and
+* scaling.
+* JOB must be the same as the argument JOB supplied to DGGBAL.
+*
+* SIDE (input) CHARACTER*1
+* = 'R': V contains right eigenvectors;
+* = 'L': V contains left eigenvectors.
+*
+* N (input) INTEGER
+* The number of rows of the matrix V. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* The integers ILO and IHI determined by DGGBAL.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* LSCALE (input) DOUBLE PRECISION array, dimension (N)
+* Details of the permutations and/or scaling factors applied
+* to the left side of A and B, as returned by DGGBAL.
+*
+* RSCALE (input) DOUBLE PRECISION array, dimension (N)
+* Details of the permutations and/or scaling factors applied
+* to the right side of A and B, as returned by DGGBAL.
+*
+* M (input) INTEGER
+* The number of columns of the matrix V. M >= 0.
+*
+* V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+* On entry, the matrix of right or left eigenvectors to be
+* transformed, as returned by DTGEVC.
+* On exit, V is overwritten by the transformed eigenvectors.
+*
+* LDV (input) INTEGER
+* The leading dimension of the matrix V. LDV >= max(1,N).
+*
+* INFO (output) INTEGER
+* = 0: successful exit.
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* See R.C. Ward, Balancing the generalized eigenvalue problem,
+* SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL LEFTV, RIGHTV
+ INTEGER I, K
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSCAL, DSWAP, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ RIGHTV = LSAME( SIDE, 'R' )
+ LEFTV = LSAME( SIDE, 'L' )
+*
+ INFO = 0
+ IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+ $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( ILO.LT.1 ) THEN
+ INFO = -4
+ ELSE IF( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGBAK', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+ IF( M.EQ.0 )
+ $ RETURN
+ IF( LSAME( JOB, 'N' ) )
+ $ RETURN
+*
+ IF( ILO.EQ.IHI )
+ $ GO TO 30
+*
+* Backward balance
+*
+ IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
+*
+* Backward transformation on right eigenvectors
+*
+ IF( RIGHTV ) THEN
+ DO 10 I = ILO, IHI
+ CALL DSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
+ 10 CONTINUE
+ END IF
+*
+* Backward transformation on left eigenvectors
+*
+ IF( LEFTV ) THEN
+ DO 20 I = ILO, IHI
+ CALL DSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
+ 20 CONTINUE
+ END IF
+ END IF
+*
+* Backward permutation
+*
+ 30 CONTINUE
+ IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
+*
+* Backward permutation on right eigenvectors
+*
+ IF( RIGHTV ) THEN
+ IF( ILO.EQ.1 )
+ $ GO TO 50
+*
+ DO 40 I = ILO - 1, 1, -1
+ K = RSCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 40
+ CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 40 CONTINUE
+*
+ 50 CONTINUE
+ IF( IHI.EQ.N )
+ $ GO TO 70
+ DO 60 I = IHI + 1, N
+ K = RSCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 60
+ CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 60 CONTINUE
+ END IF
+*
+* Backward permutation on left eigenvectors
+*
+ 70 CONTINUE
+ IF( LEFTV ) THEN
+ IF( ILO.EQ.1 )
+ $ GO TO 90
+ DO 80 I = ILO - 1, 1, -1
+ K = LSCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 80
+ CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 80 CONTINUE
+*
+ 90 CONTINUE
+ IF( IHI.EQ.N )
+ $ GO TO 110
+ DO 100 I = IHI + 1, N
+ K = LSCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 100
+ CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 100 CONTINUE
+ END IF
+ END IF
+*
+ 110 CONTINUE
+*
+ RETURN
+*
+* End of DGGBAK
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.c
new file mode 100644
index 0000000000000000000000000000000000000000..64ed6645f8c6be35c8d8c4052129e2eefcbe71e3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.c
@@ -0,0 +1,514 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b34 = 10.;
+static doublereal c_b70 = .5;
+
+/* Subroutine */ void dggbal_(job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work, info)
+const char *job;
+const integer *n;
+doublereal *a;
+const integer *lda;
+doublereal *b;
+const integer *ldb;
+integer *ilo, *ihi;
+doublereal *lscale, *rscale, *work;
+integer *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer lcab;
+ static doublereal beta, coef;
+ static integer irab, lrab;
+ static doublereal basl, cmax;
+ static doublereal coef2, coef5;
+ static integer i, j, k, l, m;
+ static doublereal gamma, t, alpha;
+ static doublereal sfmin, sfmax;
+ static integer iflow;
+ static integer kount, jc;
+ static doublereal ta, tb, tc;
+ static integer ir, it;
+ static doublereal ew;
+ static integer nr;
+ static doublereal pgamma;
+ static integer lsfmin, lsfmax, ip1, jp1, lm1;
+ static doublereal cab, rab, ewc, cor, sum;
+ static integer nrp2, icab;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGGBAL balances a pair of general real matrices (A,B). This */
+/* involves, first, permuting A and B by similarity transformations to */
+/* isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N */
+/* elements on the diagonal; and second, applying a diagonal similarity */
+/* transformation to rows and columns ILO to IHI to make the rows */
+/* and columns as close in norm as possible. Both steps are optional. */
+/* */
+/* Balancing may reduce the 1-norm of the matrices, and improve the */
+/* accuracy of the computed eigenvalues and/or eigenvectors in the */
+/* generalized eigenvalue problem A*x = lambda*B*x. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOB (input) CHARACTER*1 */
+/* Specifies the operations to be performed on A and B: */
+/* = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0 */
+/* and RSCALE(I) = 1.0 for i = 1,...,N. */
+/* = 'P': permute only; */
+/* = 'S': scale only; */
+/* = 'B': both permute and scale. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrices A and B. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the input matrix A. */
+/* On exit, A is overwritten by the balanced matrix. */
+/* If JOB = 'N', A is not referenced. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On entry, the input matrix B. */
+/* On exit, B is overwritten by the balanced matrix. */
+/* If JOB = 'N', B is not referenced. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+/* */
+/* ILO (output) INTEGER */
+/* IHI (output) INTEGER */
+/* ILO and IHI are set to integers such that on exit */
+/* A(i,j) = 0 and B(i,j) = 0 if i > j and */
+/* j = 1,...,ILO-1 or i = IHI+1,...,N. */
+/* If JOB = 'N' or 'S', ILO = 1 and IHI = N. */
+/* */
+/* LSCALE (output) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutations and scaling factors applied */
+/* to the left side of A and B. If P(j) is the index of the */
+/* row interchanged with row j, and D(j) */
+/* is the scaling factor applied to row j, then */
+/* LSCALE(j) = P(j) for J = 1,...,ILO-1 */
+/* = D(j) for J = ILO,...,IHI */
+/* = P(j) for J = IHI+1,...,N. */
+/* The order in which the interchanges are made is N to IHI+1, */
+/* then 1 to ILO-1. */
+/* */
+/* RSCALE (output) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutations and scaling factors applied */
+/* to the right side of A and B. If P(j) is the index of the */
+/* column interchanged with column j, and D(j) */
+/* is the scaling factor applied to column j, then */
+/* LSCALE(j) = P(j) for J = 1,...,ILO-1 */
+/* = D(j) for J = ILO,...,IHI */
+/* = P(j) for J = IHI+1,...,N. */
+/* The order in which the interchanges are made is N to IHI+1, */
+/* then 1 to ILO-1. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (6*N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* See R.C. WARD, Balancing the generalized eigenvalue problem, */
+/* SIAM J. Sci. Stat. Comp. 2 (1981), 141-152. */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --lscale;
+ --rscale;
+ --work;
+
+/* Test the input parameters */
+
+ *info = 0;
+ if (! lsame_(job, "N") && ! lsame_(job, "P") && ! lsame_(job, "S") && ! lsame_(job, "B")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if (*ldb < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGGBAL", &i__1);
+ return;
+ }
+
+ k = 1;
+ l = *n;
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+
+ if (lsame_(job, "N")) {
+ *ilo = 1;
+ *ihi = *n;
+ for (i = 1; i <= *n; ++i) {
+ lscale[i] = 1.;
+ rscale[i] = 1.;
+ }
+ return;
+ }
+
+ if (k == l) {
+ *ilo = 1;
+ *ihi = 1;
+ lscale[1] = 1.;
+ rscale[1] = 1.;
+ return;
+ }
+
+ if (lsame_(job, "S")) {
+ goto L190;
+ }
+
+ goto L30;
+
+/* Permute the matrices A and B to isolate the eigenvalues. */
+
+/* Find row with one nonzero in columns 1 through L */
+
+L20:
+ l = lm1;
+ if (l != 1) {
+ goto L30;
+ }
+
+ rscale[1] = 1.;
+ lscale[1] = 1.;
+ goto L190;
+
+L30:
+ lm1 = l - 1;
+ for (i = l; i >= 1; --i) {
+ for (j = 1; j <= lm1; ++j) {
+ jp1 = j + 1;
+ if (a[i + j * a_dim1] != 0. || b[i + j * b_dim1] != 0.) {
+ goto L50;
+ }
+ }
+ j = l;
+ goto L70;
+
+L50:
+ for (j = jp1; j <= l; ++j) {
+ if (a[i + j * a_dim1] != 0. || b[i + j * b_dim1] != 0.) {
+ goto L80;
+ }
+ }
+ j = jp1 - 1;
+
+L70:
+ m = l;
+ iflow = 1;
+ goto L160;
+L80:
+ ;
+ }
+ goto L100;
+
+/* Find column with one nonzero in rows K through N */
+
+L90:
+ ++k;
+
+L100:
+ for (j = k; j <= l; ++j) {
+ for (i = k; i <= lm1; ++i) {
+ ip1 = i + 1;
+ if (a[i + j * a_dim1] != 0. || b[i + j * b_dim1] != 0.) {
+ goto L120;
+ }
+ }
+ i = l;
+ goto L140;
+L120:
+ for (i = ip1; i <= l; ++i) {
+ if (a[i + j * a_dim1] != 0. || b[i + j * b_dim1] != 0.) {
+ goto L150;
+ }
+ }
+ i = ip1 - 1;
+L140:
+ m = k;
+ iflow = 2;
+ goto L160;
+L150:
+ ;
+ }
+ goto L190;
+
+/* Permute rows M and I */
+
+L160:
+ lscale[m] = (doublereal) i;
+ if (i == m) {
+ goto L170;
+ }
+ i__1 = *n - k + 1;
+ dswap_(&i__1, &a[i + k * a_dim1], lda, &a[m + k * a_dim1], lda);
+ dswap_(&i__1, &b[i + k * b_dim1], ldb, &b[m + k * b_dim1], ldb);
+
+/* Permute columns M and J */
+
+L170:
+ rscale[m] = (doublereal) j;
+ if (j == m) {
+ goto L180;
+ }
+ dswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1);
+ dswap_(&l, &b[j * b_dim1 + 1], &c__1, &b[m * b_dim1 + 1], &c__1);
+
+L180:
+ switch ((int)iflow) {
+ case 1: goto L20;
+ case 2: goto L90;
+ }
+
+L190:
+ *ilo = k;
+ *ihi = l;
+
+ if (*ilo == *ihi) {
+ return;
+ }
+
+ if (lsame_(job, "P")) {
+ return;
+ }
+
+/* Balance the submatrix in rows ILO to IHI. */
+
+ nr = *ihi - *ilo + 1;
+ for (i = *ilo; i <= *ihi; ++i) {
+ rscale[i] = 0.;
+ lscale[i] = 0.;
+
+ work[i] = 0.;
+ work[i + *n] = 0.;
+ work[i + *n * 2] = 0.;
+ work[i + *n * 3] = 0.;
+ work[i + *n * 4] = 0.;
+ work[i + *n * 5] = 0.;
+ }
+
+/* Compute right side vector in resulting linear equations */
+
+ basl = d_lg10(&c_b34);
+ for (i = *ilo; i <= *ihi; ++i) {
+ for (j = *ilo; j <= *ihi; ++j) {
+ tb = b[i + j * b_dim1];
+ ta = a[i + j * a_dim1];
+ if (ta == 0.) {
+ goto L210;
+ }
+ d__1 = abs(ta);
+ ta = d_lg10(&d__1) / basl;
+L210:
+ if (tb == 0.) {
+ goto L220;
+ }
+ d__1 = abs(tb);
+ tb = d_lg10(&d__1) / basl;
+L220:
+ work[i + *n * 4] -= ta + tb;
+ work[j + *n * 5] -= ta + tb;
+ }
+ }
+
+ coef = 1. / (doublereal) (nr << 1);
+ coef2 = coef * coef;
+ coef5 = coef2 * .5;
+ nrp2 = nr + 2;
+ beta = 0.;
+ it = 1;
+
+/* Start generalized conjugate gradient iteration */
+
+L250:
+
+ gamma = ddot_(&nr, &work[*ilo + *n * 4], &c__1, &work[*ilo + *n * 4], &c__1)
+ + ddot_(&nr, &work[*ilo + *n * 5], &c__1, &work[*ilo + *n * 5], &c__1);
+
+ ew = 0.;
+ ewc = 0.;
+ for (i = *ilo; i <= *ihi; ++i) {
+ ew += work[i + *n * 4];
+ ewc += work[i + *n * 5];
+ }
+
+ gamma = coef * gamma - coef2 * (ew*ew + ewc*ewc) - coef5 * ((ew-ewc)*(ew-ewc));
+ if (gamma == 0.) {
+ goto L350;
+ }
+ if (it != 1) {
+ beta = gamma / pgamma;
+ }
+ t = coef5 * (ewc - ew * 3.);
+ tc = coef5 * (ew - ewc * 3.);
+
+ dscal_(&nr, &beta, &work[*ilo], &c__1);
+ dscal_(&nr, &beta, &work[*ilo + *n], &c__1);
+
+ daxpy_(&nr, &coef, &work[*ilo + *n * 4], &c__1, &work[*ilo + *n], &c__1);
+ daxpy_(&nr, &coef, &work[*ilo + *n * 5], &c__1, &work[*ilo], &c__1);
+
+ for (i = *ilo; i <= *ihi; ++i) {
+ work[i] += tc;
+ work[i + *n] += t;
+ }
+
+/* Apply matrix to vector */
+
+ for (i = *ilo; i <= *ihi; ++i) {
+ kount = 0;
+ sum = 0.;
+ for (j = *ilo; j <= *ihi; ++j) {
+ if (a[i + j * a_dim1] == 0.) {
+ goto L280;
+ }
+ ++kount;
+ sum += work[j];
+L280:
+ if (b[i + j * b_dim1] == 0.) {
+ goto L290;
+ }
+ ++kount;
+ sum += work[j];
+L290:
+ ;
+ }
+ work[i + *n * 2] = (doublereal) kount * work[i + *n] + sum;
+ }
+
+ for (j = *ilo; j <= *ihi; ++j) {
+ kount = 0;
+ sum = 0.;
+ for (i = *ilo; i <= *ihi; ++i) {
+ if (a[i + j * a_dim1] == 0.) {
+ goto L310;
+ }
+ ++kount;
+ sum += work[i + *n];
+L310:
+ if (b[i + j * b_dim1] == 0.) {
+ goto L320;
+ }
+ ++kount;
+ sum += work[i + *n];
+L320:
+ ;
+ }
+ work[j + *n * 3] = (doublereal) kount * work[j] + sum;
+ }
+
+ sum = ddot_(&nr, &work[*ilo + *n], &c__1, &work[*ilo + *n * 2], &c__1)
+ + ddot_(&nr, &work[*ilo ], &c__1, &work[*ilo + *n * 3], &c__1);
+ alpha = gamma / sum;
+
+/* Determine correction to current iteration */
+
+ cmax = 0.;
+ for (i = *ilo; i <= *ihi; ++i) {
+ cor = alpha * work[i + *n];
+ if (abs(cor) > cmax) {
+ cmax = abs(cor);
+ }
+ lscale[i] += cor;
+ cor = alpha * work[i];
+ if (abs(cor) > cmax) {
+ cmax = abs(cor);
+ }
+ rscale[i] += cor;
+ }
+ if (cmax < .5) {
+ goto L350;
+ }
+
+ d__1 = -alpha;
+ daxpy_(&nr, &d__1, &work[*ilo + *n * 2], &c__1, &work[*ilo + *n * 4], &c__1);
+ d__1 = -alpha;
+ daxpy_(&nr, &d__1, &work[*ilo + *n * 3], &c__1, &work[*ilo + *n * 5], &c__1);
+
+ pgamma = gamma;
+ ++it;
+ if (it <= nrp2) {
+ goto L250;
+ }
+
+/* End generalized conjugate gradient iteration */
+
+L350:
+ sfmin = dlamch_("S");
+ sfmax = 1. / sfmin;
+ lsfmin = (integer) (d_lg10(&sfmin) / basl + 1.);
+ lsfmax = (integer) (d_lg10(&sfmax) / basl);
+ for (i = *ilo; i <= *ihi; ++i) {
+ i__1 = *n - *ilo + 1;
+ irab = idamax_(&i__1, &a[i + *ilo * a_dim1], lda);
+ rab = abs(a[i + (irab + *ilo - 1) * a_dim1]);
+ irab = idamax_(&i__1, &b[i + *ilo * b_dim1], lda);
+ rab = max(rab, abs(b[i + (irab + *ilo - 1) * b_dim1]));
+ d__1 = rab + sfmin;
+ lrab = (integer) (d_lg10(&d__1) / basl + 1.);
+ ir = (integer) (lscale[i] + d_sign(&c_b70, &lscale[i]));
+ ir = min(min(max(ir,lsfmin),lsfmax),lsfmax-lrab);
+ lscale[i] = pow_di(&c_b34, &ir);
+ icab = idamax_(ihi, &a[i * a_dim1 + 1], &c__1);
+ cab = abs(a[icab + i * a_dim1]);
+ icab = idamax_(ihi, &b[i * b_dim1 + 1], &c__1);
+ cab = max(cab, abs(b[icab + i * b_dim1]));
+ d__1 = cab + sfmin;
+ lcab = (integer) (d_lg10(&d__1) / basl + 1.);
+ jc = (integer) (rscale[i] + d_sign(&c_b70, &rscale[i]));
+ jc = min(min(max(jc,lsfmin),lsfmax),lsfmax-lcab);
+ rscale[i] = pow_di(&c_b34, &jc);
+ }
+
+/* Row scaling of matrices A and B */
+
+ for (i = *ilo; i <= *ihi; ++i) {
+ i__1 = *n - *ilo + 1;
+ dscal_(&i__1, &lscale[i], &a[i + *ilo * a_dim1], lda);
+ dscal_(&i__1, &lscale[i], &b[i + *ilo * b_dim1], ldb);
+ }
+
+/* Column scaling of matrices A and B */
+
+ for (j = *ilo; j <= *ihi; ++j) {
+ dscal_(ihi, &rscale[j], &a[j * a_dim1 + 1], &c__1);
+ dscal_(ihi, &rscale[j], &b[j * b_dim1 + 1], &c__1);
+ }
+} /* dggbal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.f
new file mode 100644
index 0000000000000000000000000000000000000000..03fd5450698cdf25f0e2761fbddc8713f91b17e3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggbal.f
@@ -0,0 +1,461 @@
+ SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE,
+ $ RSCALE, WORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOB
+ INTEGER IHI, ILO, INFO, LDA, LDB, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), LSCALE( * ),
+ $ RSCALE( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGGBAL balances a pair of general real matrices (A,B). This
+* involves, first, permuting A and B by similarity transformations to
+* isolate eigenvalues in the first 1 to ILO$-$1 and last IHI+1 to N
+* elements on the diagonal; and second, applying a diagonal similarity
+* transformation to rows and columns ILO to IHI to make the rows
+* and columns as close in norm as possible. Both steps are optional.
+*
+* Balancing may reduce the 1-norm of the matrices, and improve the
+* accuracy of the computed eigenvalues and/or eigenvectors in the
+* generalized eigenvalue problem A*x = lambda*B*x.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* Specifies the operations to be performed on A and B:
+* = 'N': none: simply set ILO = 1, IHI = N, LSCALE(I) = 1.0
+* and RSCALE(I) = 1.0 for i = 1,...,N.
+* = 'P': permute only;
+* = 'S': scale only;
+* = 'B': both permute and scale.
+*
+* N (input) INTEGER
+* The order of the matrices A and B. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the input matrix A.
+* On exit, A is overwritten by the balanced matrix.
+* If JOB = 'N', A is not referenced.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+* On entry, the input matrix B.
+* On exit, B is overwritten by the balanced matrix.
+* If JOB = 'N', B is not referenced.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,N).
+*
+* ILO (output) INTEGER
+* IHI (output) INTEGER
+* ILO and IHI are set to integers such that on exit
+* A(i,j) = 0 and B(i,j) = 0 if i > j and
+* j = 1,...,ILO-1 or i = IHI+1,...,N.
+* If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+*
+* LSCALE (output) DOUBLE PRECISION array, dimension (N)
+* Details of the permutations and scaling factors applied
+* to the left side of A and B. If P(j) is the index of the
+* row interchanged with row j, and D(j)
+* is the scaling factor applied to row j, then
+* LSCALE(j) = P(j) for J = 1,...,ILO-1
+* = D(j) for J = ILO,...,IHI
+* = P(j) for J = IHI+1,...,N.
+* The order in which the interchanges are made is N to IHI+1,
+* then 1 to ILO-1.
+*
+* RSCALE (output) DOUBLE PRECISION array, dimension (N)
+* Details of the permutations and scaling factors applied
+* to the right side of A and B. If P(j) is the index of the
+* column interchanged with column j, and D(j)
+* is the scaling factor applied to column j, then
+* LSCALE(j) = P(j) for J = 1,...,ILO-1
+* = D(j) for J = ILO,...,IHI
+* = P(j) for J = IHI+1,...,N.
+* The order in which the interchanges are made is N to IHI+1,
+* then 1 to ILO-1.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (6*N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* See R.C. WARD, Balancing the generalized eigenvalue problem,
+* SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, HALF, ONE
+ PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
+ DOUBLE PRECISION THREE, SCLFAC
+ PARAMETER ( THREE = 3.0D+0, SCLFAC = 1.0D+1 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ICAB, IFLOW, IP1, IR, IRAB, IT, J, JC, JP1,
+ $ K, KOUNT, L, LCAB, LM1, LRAB, LSFMAX, LSFMIN,
+ $ M, NR, NRP2
+ DOUBLE PRECISION ALPHA, BASL, BETA, CAB, CMAX, COEF, COEF2,
+ $ COEF5, COR, EW, EWC, GAMMA, PGAMMA, RAB, SFMAX,
+ $ SFMIN, SUM, T, TA, TB, TC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IDAMAX
+ DOUBLE PRECISION DDOT, DLAMCH
+ EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL DAXPY, DSCAL, DSWAP, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, INT, LOG10, MAX, MIN, SIGN
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+ $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGBAL', -INFO )
+ RETURN
+ END IF
+*
+ K = 1
+ L = N
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( JOB, 'N' ) ) THEN
+ ILO = 1
+ IHI = N
+ DO 10 I = 1, N
+ LSCALE( I ) = ONE
+ RSCALE( I ) = ONE
+ 10 CONTINUE
+ RETURN
+ END IF
+*
+ IF( K.EQ.L ) THEN
+ ILO = 1
+ IHI = 1
+ LSCALE( 1 ) = ONE
+ RSCALE( 1 ) = ONE
+ RETURN
+ END IF
+*
+ IF( LSAME( JOB, 'S' ) )
+ $ GO TO 190
+*
+ GO TO 30
+*
+* Permute the matrices A and B to isolate the eigenvalues.
+*
+* Find row with one nonzero in columns 1 through L
+*
+ 20 CONTINUE
+ L = LM1
+ IF( L.NE.1 )
+ $ GO TO 30
+*
+ RSCALE( 1 ) = 1
+ LSCALE( 1 ) = 1
+ GO TO 190
+*
+ 30 CONTINUE
+ LM1 = L - 1
+ DO 80 I = L, 1, -1
+ DO 40 J = 1, LM1
+ JP1 = J + 1
+ IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
+ $ GO TO 50
+ 40 CONTINUE
+ J = L
+ GO TO 70
+*
+ 50 CONTINUE
+ DO 60 J = JP1, L
+ IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
+ $ GO TO 80
+ 60 CONTINUE
+ J = JP1 - 1
+*
+ 70 CONTINUE
+ M = L
+ IFLOW = 1
+ GO TO 160
+ 80 CONTINUE
+ GO TO 100
+*
+* Find column with one nonzero in rows K through N
+*
+ 90 CONTINUE
+ K = K + 1
+*
+ 100 CONTINUE
+ DO 150 J = K, L
+ DO 110 I = K, LM1
+ IP1 = I + 1
+ IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
+ $ GO TO 120
+ 110 CONTINUE
+ I = L
+ GO TO 140
+ 120 CONTINUE
+ DO 130 I = IP1, L
+ IF( A( I, J ).NE.ZERO .OR. B( I, J ).NE.ZERO )
+ $ GO TO 150
+ 130 CONTINUE
+ I = IP1 - 1
+ 140 CONTINUE
+ M = K
+ IFLOW = 2
+ GO TO 160
+ 150 CONTINUE
+ GO TO 190
+*
+* Permute rows M and I
+*
+ 160 CONTINUE
+ LSCALE( M ) = I
+ IF( I.EQ.M )
+ $ GO TO 170
+ CALL DSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA )
+ CALL DSWAP( N-K+1, B( I, K ), LDB, B( M, K ), LDB )
+*
+* Permute columns M and J
+*
+ 170 CONTINUE
+ RSCALE( M ) = J
+ IF( J.EQ.M )
+ $ GO TO 180
+ CALL DSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
+ CALL DSWAP( L, B( 1, J ), 1, B( 1, M ), 1 )
+*
+ 180 CONTINUE
+ GO TO ( 20, 90 )IFLOW
+*
+ 190 CONTINUE
+ ILO = K
+ IHI = L
+*
+ IF( ILO.EQ.IHI )
+ $ RETURN
+*
+ IF( LSAME( JOB, 'P' ) )
+ $ RETURN
+*
+* Balance the submatrix in rows ILO to IHI.
+*
+ NR = IHI - ILO + 1
+ DO 200 I = ILO, IHI
+ RSCALE( I ) = ZERO
+ LSCALE( I ) = ZERO
+*
+ WORK( I ) = ZERO
+ WORK( I+N ) = ZERO
+ WORK( I+2*N ) = ZERO
+ WORK( I+3*N ) = ZERO
+ WORK( I+4*N ) = ZERO
+ WORK( I+5*N ) = ZERO
+ 200 CONTINUE
+*
+* Compute right side vector in resulting linear equations
+*
+ BASL = LOG10( SCLFAC )
+ DO 240 I = ILO, IHI
+ DO 230 J = ILO, IHI
+ TB = B( I, J )
+ TA = A( I, J )
+ IF( TA.EQ.ZERO )
+ $ GO TO 210
+ TA = LOG10( ABS( TA ) ) / BASL
+ 210 CONTINUE
+ IF( TB.EQ.ZERO )
+ $ GO TO 220
+ TB = LOG10( ABS( TB ) ) / BASL
+ 220 CONTINUE
+ WORK( I+4*N ) = WORK( I+4*N ) - TA - TB
+ WORK( J+5*N ) = WORK( J+5*N ) - TA - TB
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ COEF = ONE / DBLE( 2*NR )
+ COEF2 = COEF*COEF
+ COEF5 = HALF*COEF2
+ NRP2 = NR + 2
+ BETA = ZERO
+ IT = 1
+*
+* Start generalized conjugate gradient iteration
+*
+ 250 CONTINUE
+*
+ GAMMA = DDOT( NR, WORK( ILO+4*N ), 1, WORK( ILO+4*N ), 1 ) +
+ $ DDOT( NR, WORK( ILO+5*N ), 1, WORK( ILO+5*N ), 1 )
+*
+ EW = ZERO
+ EWC = ZERO
+ DO 260 I = ILO, IHI
+ EW = EW + WORK( I+4*N )
+ EWC = EWC + WORK( I+5*N )
+ 260 CONTINUE
+*
+ GAMMA = COEF*GAMMA - COEF2*( EW**2+EWC**2 ) - COEF5*( EW-EWC )**2
+ IF( GAMMA.EQ.ZERO )
+ $ GO TO 350
+ IF( IT.NE.1 )
+ $ BETA = GAMMA / PGAMMA
+ T = COEF5*( EWC-THREE*EW )
+ TC = COEF5*( EW-THREE*EWC )
+*
+ CALL DSCAL( NR, BETA, WORK( ILO ), 1 )
+ CALL DSCAL( NR, BETA, WORK( ILO+N ), 1 )
+*
+ CALL DAXPY( NR, COEF, WORK( ILO+4*N ), 1, WORK( ILO+N ), 1 )
+ CALL DAXPY( NR, COEF, WORK( ILO+5*N ), 1, WORK( ILO ), 1 )
+*
+ DO 270 I = ILO, IHI
+ WORK( I ) = WORK( I ) + TC
+ WORK( I+N ) = WORK( I+N ) + T
+ 270 CONTINUE
+*
+* Apply matrix to vector
+*
+ DO 300 I = ILO, IHI
+ KOUNT = 0
+ SUM = ZERO
+ DO 290 J = ILO, IHI
+ IF( A( I, J ).EQ.ZERO )
+ $ GO TO 280
+ KOUNT = KOUNT + 1
+ SUM = SUM + WORK( J )
+ 280 CONTINUE
+ IF( B( I, J ).EQ.ZERO )
+ $ GO TO 290
+ KOUNT = KOUNT + 1
+ SUM = SUM + WORK( J )
+ 290 CONTINUE
+ WORK( I+2*N ) = DBLE( KOUNT )*WORK( I+N ) + SUM
+ 300 CONTINUE
+*
+ DO 330 J = ILO, IHI
+ KOUNT = 0
+ SUM = ZERO
+ DO 320 I = ILO, IHI
+ IF( A( I, J ).EQ.ZERO )
+ $ GO TO 310
+ KOUNT = KOUNT + 1
+ SUM = SUM + WORK( I+N )
+ 310 CONTINUE
+ IF( B( I, J ).EQ.ZERO )
+ $ GO TO 320
+ KOUNT = KOUNT + 1
+ SUM = SUM + WORK( I+N )
+ 320 CONTINUE
+ WORK( J+3*N ) = DBLE( KOUNT )*WORK( J ) + SUM
+ 330 CONTINUE
+*
+ SUM = DDOT( NR, WORK( ILO+N ), 1, WORK( ILO+2*N ), 1 ) +
+ $ DDOT( NR, WORK( ILO ), 1, WORK( ILO+3*N ), 1 )
+ ALPHA = GAMMA / SUM
+*
+* Determine correction to current iteration
+*
+ CMAX = ZERO
+ DO 340 I = ILO, IHI
+ COR = ALPHA*WORK( I+N )
+ IF( ABS( COR ).GT.CMAX )
+ $ CMAX = ABS( COR )
+ LSCALE( I ) = LSCALE( I ) + COR
+ COR = ALPHA*WORK( I )
+ IF( ABS( COR ).GT.CMAX )
+ $ CMAX = ABS( COR )
+ RSCALE( I ) = RSCALE( I ) + COR
+ 340 CONTINUE
+ IF( CMAX.LT.HALF )
+ $ GO TO 350
+*
+ CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 )
+ CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 )
+*
+ PGAMMA = GAMMA
+ IT = IT + 1
+ IF( IT.LE.NRP2 )
+ $ GO TO 250
+*
+* End generalized conjugate gradient iteration
+*
+ 350 CONTINUE
+ SFMIN = DLAMCH( 'S' )
+ SFMAX = ONE / SFMIN
+ LSFMIN = INT( LOG10( SFMIN ) / BASL+ONE )
+ LSFMAX = INT( LOG10( SFMAX ) / BASL )
+ DO 360 I = ILO, IHI
+ IRAB = IDAMAX( N-ILO+1, A( I, ILO ), LDA )
+ RAB = ABS( A( I, IRAB+ILO-1 ) )
+ IRAB = IDAMAX( N-ILO+1, B( I, ILO ), LDA )
+ RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) )
+ LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE )
+ IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) )
+ IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB )
+ LSCALE( I ) = SCLFAC**IR
+ ICAB = IDAMAX( IHI, A( 1, I ), 1 )
+ CAB = ABS( A( ICAB, I ) )
+ ICAB = IDAMAX( IHI, B( 1, I ), 1 )
+ CAB = MAX( CAB, ABS( B( ICAB, I ) ) )
+ LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE )
+ JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) )
+ JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB )
+ RSCALE( I ) = SCLFAC**JC
+ 360 CONTINUE
+*
+* Row scaling of matrices A and B
+*
+ DO 370 I = ILO, IHI
+ CALL DSCAL( N-ILO+1, LSCALE( I ), A( I, ILO ), LDA )
+ CALL DSCAL( N-ILO+1, LSCALE( I ), B( I, ILO ), LDB )
+ 370 CONTINUE
+*
+* Column scaling of matrices A and B
+*
+ DO 380 J = ILO, IHI
+ CALL DSCAL( IHI, RSCALE( J ), A( 1, J ), 1 )
+ CALL DSCAL( IHI, RSCALE( J ), B( 1, J ), 1 )
+ 380 CONTINUE
+*
+ RETURN
+*
+* End of DGGBAL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.c
new file mode 100644
index 0000000000000000000000000000000000000000..2836215250707b5d287f9899e0f43edac6ccdb23
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.c
@@ -0,0 +1,550 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c_n1 = -1;
+static doublereal c_b33 = 0.;
+static doublereal c_b34 = 1.;
+
+/* Subroutine */
+void dgges_(jobvsl, jobvsr, sort, delctg, n, a, lda, b, ldb,
+ sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork, info)
+const char *jobvsl, *jobvsr, *sort;
+logical (*delctg) (doublereal*,doublereal*,doublereal*);
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb, *sdim;
+doublereal *alphar, *alphai, *beta, *vsl;
+integer *ldvsl;
+doublereal *vsr;
+integer *ldvsr;
+doublereal *work;
+integer *lwork;
+logical *bwork;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal anrm, bnrm;
+ static integer idum[1], ierr, itau, iwrk;
+ static doublereal pvsl, pvsr;
+ static integer i;
+ static integer ileft, icols;
+ static logical cursl, ilvsl, ilvsr;
+ static integer irows;
+ static logical lst2sl;
+ static integer ip;
+ static logical ilascl, ilbscl;
+ static doublereal safmin;
+ static doublereal safmax;
+ static doublereal bignum;
+ static integer ijobvl, iright, ijobvr;
+ static doublereal anrmto, bnrmto;
+ static logical lastsl;
+ static integer minwrk, maxwrk;
+ static doublereal smlnum;
+ static logical wantst, lquery;
+ static doublereal dif[2];
+ static integer ihi, ilo;
+ static doublereal eps;
+
+
+/* -- LAPACK driver routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B), */
+/* the generalized eigenvalues, the generalized real Schur form (S,T), */
+/* optionally, the left and/or right matrices of Schur vectors (VSL and */
+/* VSR). This gives the generalized Schur factorization */
+/* */
+/* (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T ) */
+/* */
+/* Optionally, it also orders the eigenvalues so that a selected cluster */
+/* of eigenvalues appears in the leading diagonal blocks of the upper */
+/* quasi-triangular matrix S and the upper triangular matrix T.The */
+/* leading columns of VSL and VSR then form an orthonormal basis for the */
+/* corresponding left and right eigenspaces (deflating subspaces). */
+/* */
+/* (If only the generalized eigenvalues are needed, use the driver */
+/* DGGEV instead, which is faster.) */
+/* */
+/* A generalized eigenvalue for a pair of matrices (A,B) is a scalar w */
+/* or a ratio alpha/beta = w, such that A - w*B is singular. It is */
+/* usually represented as the pair (alpha,beta), as there is a */
+/* reasonable interpretation for beta=0 or both being zero. */
+/* */
+/* A pair of matrices (S,T) is in generalized real Schur form if T is */
+/* upper triangular with non-negative diagonal and S is block upper */
+/* triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond */
+/* to real generalized eigenvalues, while 2-by-2 blocks of S will be */
+/* "standardized" by making the corresponding elements of T have the */
+/* form: */
+/* [ a 0 ] */
+/* [ 0 b ] */
+/* */
+/* and the pair of corresponding 2-by-2 blocks in S and T will have a */
+/* complex conjugate pair of generalized eigenvalues. */
+/* */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBVSL (input) CHARACTER*1 */
+/* = 'N': do not compute the left Schur vectors; */
+/* = 'V': compute the left Schur vectors. */
+/* */
+/* JOBVSR (input) CHARACTER*1 */
+/* = 'N': do not compute the right Schur vectors; */
+/* = 'V': compute the right Schur vectors. */
+/* */
+/* SORT (input) CHARACTER*1 */
+/* Specifies whether or not to order the eigenvalues on the */
+/* diagonal of the generalized Schur form. */
+/* = 'N': Eigenvalues are not ordered; */
+/* = 'S': Eigenvalues are ordered (see DELZTG); */
+/* */
+/* DELZTG (input) LOGICAL FUNCTION of three DOUBLE PRECISION arguments */
+/* DELZTG must be declared EXTERNAL in the calling subroutine. */
+/* If SORT = 'N', DELZTG is not referenced. */
+/* If SORT = 'S', DELZTG is used to select eigenvalues to sort */
+/* to the top left of the Schur form. */
+/* An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if */
+/* DELZTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either */
+/* one of a complex conjugate pair of eigenvalues is selected, */
+/* then both complex eigenvalues are selected. */
+/* */
+/* Note that in the ill-conditioned case, a selected complex */
+/* eigenvalue may no longer satisfy DELZTG(ALPHAR(j),ALPHAI(j), */
+/* BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2 */
+/* in this case. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrices A, B, VSL, and VSR. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
+/* On entry, the first of the pair of matrices. */
+/* On exit, A has been overwritten by its generalized Schur */
+/* form S. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of A. LDA >= max(1,N). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB, N) */
+/* On entry, the second of the pair of matrices. */
+/* On exit, B has been overwritten by its generalized Schur */
+/* form T. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of B. LDB >= max(1,N). */
+/* */
+/* SDIM (output) INTEGER */
+/* If SORT = 'N', SDIM = 0. */
+/* If SORT = 'S', SDIM = number of eigenvalues (after sorting) */
+/* for which DELZTG is true. (Complex conjugate pairs for which */
+/* DELZTG is true for either eigenvalue count as 2.) */
+/* */
+/* ALPHAR (output) DOUBLE PRECISION array, dimension (N) */
+/* ALPHAI (output) DOUBLE PRECISION array, dimension (N) */
+/* BETA (output) DOUBLE PRECISION array, dimension (N) */
+/* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will */
+/* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i, */
+/* and BETA(j),j=1,...,N are the diagonals of the complex Schur */
+/* form (S,T) that would result if the 2-by-2 diagonal blocks of */
+/* the real Schur form of (A,B) were further reduced to */
+/* triangular form using 2-by-2 complex unitary transformations. */
+/* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if */
+/* positive, then the j-th and (j+1)-st eigenvalues are a */
+/* complex conjugate pair, with ALPHAI(j+1) negative. */
+/* */
+/* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j) */
+/* may easily over- or underflow, and BETA(j) may even be zero. */
+/* Thus, the user should avoid naively computing the ratio. */
+/* However, ALPHAR and ALPHAI will be always less than and */
+/* usually comparable with norm(A) in magnitude, and BETA always */
+/* less than and usually comparable with norm(B). */
+/* */
+/* VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N) */
+/* If JOBVSL = 'V', VSL will contain the left Schur vectors. */
+/* Not referenced if JOBVSL = 'N'. */
+/* */
+/* LDVSL (input) INTEGER */
+/* The leading dimension of the matrix VSL. LDVSL >=1, and */
+/* if JOBVSL = 'V', LDVSL >= N. */
+/* */
+/* VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N) */
+/* If JOBVSR = 'V', VSR will contain the right Schur vectors. */
+/* Not referenced if JOBVSR = 'N'. */
+/* */
+/* LDVSR (input) INTEGER */
+/* The leading dimension of the matrix VSR. LDVSR >= 1, and */
+/* if JOBVSR = 'V', LDVSR >= N. */
+/* */
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= 8*N+16. */
+/* */
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+/* */
+/* BWORK (workspace) LOGICAL array, dimension (N) */
+/* Not referenced if SORT = 'N'. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* = 1,...,N: */
+/* The QZ iteration failed. (A,B) are not in Schur */
+/* form, but ALPHAR(j), ALPHAI(j), and BETA(j) should */
+/* be correct for j=INFO+1,...,N. */
+/* > N: =N+1: other than QZ iteration failed in DHGEQZ. */
+/* =N+2: after reordering, roundoff changed values of */
+/* some complex eigenvalues so that leading */
+/* eigenvalues in the Generalized Schur form no */
+/* longer satisfy DELZTG=.TRUE. This could also */
+/* be caused due to scaling. */
+/* =N+3: reordering failed in DTGSEN. */
+/* */
+/* ===================================================================== */
+
+/* Decode the input arguments */
+
+ if (lsame_(jobvsl, "N")) {
+ ijobvl = 1;
+ ilvsl = FALSE_;
+ } else if (lsame_(jobvsl, "V")) {
+ ijobvl = 2;
+ ilvsl = TRUE_;
+ } else {
+ ijobvl = -1;
+ ilvsl = FALSE_;
+ }
+
+ if (lsame_(jobvsr, "N")) {
+ ijobvr = 1;
+ ilvsr = FALSE_;
+ } else if (lsame_(jobvsr, "V")) {
+ ijobvr = 2;
+ ilvsr = TRUE_;
+ } else {
+ ijobvr = -1;
+ ilvsr = FALSE_;
+ }
+
+ wantst = lsame_(sort, "S");
+
+/* Test the input arguments */
+
+ *info = 0;
+ lquery = *lwork == -1;
+ if (ijobvl <= 0) {
+ *info = -1;
+ } else if (ijobvr <= 0) {
+ *info = -2;
+ } else if (! wantst && ! lsame_(sort, "N")) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,*n)) {
+ *info = -7;
+ } else if (*ldb < max(1,*n)) {
+ *info = -9;
+ } else if (*ldvsl < 1 || (ilvsl && *ldvsl < *n)) {
+ *info = -15;
+ } else if (*ldvsr < 1 || (ilvsr && *ldvsr < *n)) {
+ *info = -17;
+ }
+
+/* Compute workspace */
+/* (Note: Comments in the code beginning "Workspace:" describe the */
+/* minimal amount of workspace needed at that point in the code, */
+/* as well as the preferred amount for good performance. */
+/* NB refers to the optimal block size for the immediately */
+/* following subroutine, as returned by ILAENV.) */
+
+ minwrk = 1;
+ if (*info == 0 && (*lwork >= 1 || lquery)) {
+ minwrk = (*n + 1) * 7 + 16;
+ maxwrk = (*n + 1) * 7 + *n * ilaenv_(&c__1, "DGEQRF", " ", n, &c__1, n, &c__0) + 16;
+ if (ilvsl) {
+ i__1 = (*n + 1) * 7 + *n * ilaenv_(&c__1, "DORGQR", " ", n, &c__1, n, &c_n1);
+ maxwrk = max(maxwrk,i__1);
+ }
+ work[0] = (doublereal) maxwrk;
+ }
+
+ if (*lwork < minwrk && ! lquery) {
+ *info = -19;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGGES ", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ *sdim = 0;
+ return;
+ }
+
+/* Get machine constants */
+
+ eps = dlamch_("P");
+ safmin = dlamch_("S");
+ safmax = 1. / safmin;
+ dlabad_(&safmin, &safmax);
+ smlnum = sqrt(safmin) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = dlange_("M", n, n, a, lda, work);
+ ilascl = FALSE_;
+ if (anrm > 0. && anrm < smlnum) {
+ anrmto = smlnum;
+ ilascl = TRUE_;
+ } else if (anrm > bignum) {
+ anrmto = bignum;
+ ilascl = TRUE_;
+ }
+ if (ilascl) {
+ dlascl_("G", &c__0, &c__0, &anrm, &anrmto, n, n, a, lda, &ierr);
+ }
+
+/* Scale B if max element outside range [SMLNUM,BIGNUM] */
+
+ bnrm = dlange_("M", n, n, b, ldb, work);
+ ilbscl = FALSE_;
+ if (bnrm > 0. && bnrm < smlnum) {
+ bnrmto = smlnum;
+ ilbscl = TRUE_;
+ } else if (bnrm > bignum) {
+ bnrmto = bignum;
+ ilbscl = TRUE_;
+ }
+ if (ilbscl) {
+ dlascl_("G", &c__0, &c__0, &bnrm, &bnrmto, n, n, b, ldb, &ierr);
+ }
+
+/* Permute the matrix to make it more nearly triangular */
+/* (Workspace: need 6*N + 2*N space for storing balancing factors) */
+
+ ileft = 0;
+ iright = *n;
+ iwrk = iright + *n;
+ dggbal_("P", n, a, lda, b, ldb, &ilo, &ihi, &work[ileft], &work[iright], &work[iwrk], &ierr);
+ --ilo;
+
+/* Reduce B to triangular form (QR decomposition of B) */
+/* (Workspace: need N, prefer N*NB) */
+
+ irows = ihi - ilo;
+ icols = *n - ilo;
+ itau = iwrk;
+ iwrk = itau + irows;
+ i__1 = *lwork - iwrk;
+ dgeqrf_(&irows, &icols, &b[ilo + ilo * *ldb], ldb, &work[itau], &work[iwrk], &i__1, &ierr);
+
+/* Apply the orthogonal transformation to matrix A */
+/* (Workspace: need N, prefer N*NB) */
+
+ i__1 = *lwork - iwrk;
+ dormqr_("L", "T", &irows, &icols, &irows, &b[ilo + ilo * *ldb], ldb, &work[itau],
+ &a[ilo + ilo * *lda], lda, &work[iwrk], &i__1, &ierr);
+
+/* Initialize VSL */
+/* (Workspace: need N, prefer N*NB) */
+
+ if (ilvsl) {
+ dlaset_("Full", n, n, &c_b33, &c_b34, vsl, ldvsl);
+ i__1 = irows - 1;
+ dlacpy_("L", &i__1, &i__1, &b[ilo + 1 + ilo * *ldb], ldb, &vsl[ilo + 1 + ilo * *ldvsl], ldvsl);
+ i__1 = *lwork - iwrk;
+ dorgqr_(&irows, &irows, &irows, &vsl[ilo + ilo * *ldvsl], ldvsl, &work[itau], &work[iwrk], &i__1, &ierr);
+ }
+
+/* Initialize VSR */
+
+ if (ilvsr) {
+ dlaset_("Full", n, n, &c_b33, &c_b34, vsr, ldvsr);
+ }
+
+/* Reduce to generalized Hessenberg form */
+/* (Workspace: none needed) */
+
+ ++ilo;
+ dgghrd_(jobvsl, jobvsr, n, &ilo, &ihi, a, lda, b, ldb, vsl, ldvsl, vsr, ldvsr, &ierr);
+
+/* Perform QZ algorithm, computing Schur vectors if desired */
+/* (Workspace: need N) */
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk;
+ dhgeqz_("S", jobvsl, jobvsr, n, &ilo, &ihi, a, lda, b, ldb, alphar, alphai, beta,
+ vsl, ldvsl, vsr, ldvsr, &work[iwrk], &i__1, &ierr);
+ if (ierr != 0) {
+ if (ierr > 0 && ierr <= *n) {
+ *info = ierr;
+ } else if (ierr > *n && ierr <= *n << 1) {
+ *info = ierr - *n;
+ } else {
+ *info = *n + 1;
+ }
+ work[0] = (doublereal) maxwrk;
+ return;
+ }
+
+/* Sort eigenvalues ALPHA/BETA if desired */
+/* (Workspace: need 4*N+16 ) */
+
+ *sdim = 0;
+ if (wantst) {
+
+/* Undo scaling on eigenvalues before DELZTGing */
+
+ if (ilascl) {
+ dlascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, alphar, n, &ierr);
+ dlascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, alphai, n, &ierr);
+ }
+ if (ilbscl) {
+ dlascl_("G", &c__0, &c__0, &bnrmto, &bnrm, n, &c__1, beta, n, &ierr);
+ }
+
+/* Select eigenvalues */
+
+ for (i = 0; i < *n; ++i) {
+ bwork[i] = (*delctg)(&alphar[i], &alphai[i], &beta[i]);
+ }
+
+ i__1 = *lwork - iwrk;
+ dtgsen_(&c__0, &ilvsl, &ilvsr, bwork, n, a, lda, b, ldb, alphar, alphai, beta,
+ vsl, ldvsl, vsr, ldvsr, sdim, &pvsl, &pvsr, dif, &work[iwrk], &i__1, idum, &c__1, &ierr);
+ if (ierr == 1) {
+ *info = *n + 3;
+ }
+ }
+
+/* Apply back-permutation to VSL and VSR */
+/* (Workspace: none needed) */
+
+ if (ilvsl) {
+ dggbak_("P", "L", n, &ilo, &ihi, &work[ileft], &work[iright], n, vsl, ldvsl, &ierr);
+ }
+
+ if (ilvsr) {
+ dggbak_("P", "R", n, &ilo, &ihi, &work[ileft], &work[iright], n, vsr, ldvsr, &ierr);
+ }
+
+/* Check if unscaling would cause over/underflow, if so, rescale */
+/* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of */
+/* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I) */
+
+ if (ilascl) {
+ for (i = 0; i < *n; ++i) {
+ if (alphai[i] != 0.) {
+ if (alphar[i] / safmax > anrmto / anrm || safmin / alphar[i] > anrm / anrmto) {
+ work[0] = abs(a[i + i * *lda] / alphar[i]);
+ beta[i] *= work[0];
+ alphar[i] *= work[0];
+ alphai[i] *= work[0];
+ } else if (alphai[i] / safmax > anrmto / anrm || safmin / alphai[i] > anrm / anrmto) {
+ work[0] = abs(a[i + (i+1) * *lda] / alphai[i]);
+ beta[i] *= work[0];
+ alphar[i] *= work[0];
+ alphai[i] *= work[0];
+ }
+ }
+ }
+ }
+
+ if (ilbscl) {
+ for (i = 0; i < *n; ++i) {
+ if (alphai[i] != 0.) {
+ if (beta[i] / safmax > bnrmto / bnrm || safmin / beta[i] > bnrm / bnrmto) {
+ work[0] = abs(b[i + i * *ldb] / beta[i]);
+ beta[i] *= work[0];
+ alphar[i] *= work[0];
+ alphai[i] *= work[0];
+ }
+ }
+ }
+ }
+
+/* Undo scaling */
+
+ if (ilascl) {
+ dlascl_("H", &c__0, &c__0, &anrmto, &anrm, n, n, a, lda, &ierr);
+ dlascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, alphar, n, &ierr);
+ dlascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, alphai, n, &ierr);
+ }
+
+ if (ilbscl) {
+ dlascl_("U", &c__0, &c__0, &bnrmto, &bnrm, n, n, b, ldb, &ierr);
+ dlascl_("G", &c__0, &c__0, &bnrmto, &bnrm, n, &c__1, beta, n, &ierr);
+ }
+
+ if (wantst) {
+
+/* Check if reordering is correct */
+
+ lastsl = TRUE_;
+ lst2sl = TRUE_;
+ *sdim = 0;
+ ip = 0;
+ for (i = 0; i < *n; ++i) {
+ cursl = (*delctg)(&alphar[i], &alphai[i], &beta[i]);
+ if (alphai[i] == 0.) {
+ if (cursl) {
+ ++(*sdim);
+ }
+ ip = 0;
+ if (cursl && ! lastsl) {
+ *info = *n + 2;
+ }
+ } else {
+ if (ip == 1) {
+
+/* Last eigenvalue of conjugate pair */
+
+ cursl = cursl || lastsl;
+ lastsl = cursl;
+ if (cursl) {
+ *sdim += 2;
+ }
+ ip = -1;
+ if (cursl && ! lst2sl) {
+ *info = *n + 2;
+ }
+ } else {
+
+/* First eigenvalue of conjugate pair */
+
+ ip = 1;
+ }
+ }
+ lst2sl = lastsl;
+ lastsl = cursl;
+ }
+ }
+ work[0] = (doublereal) maxwrk;
+
+} /* dgges_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.f
new file mode 100644
index 0000000000000000000000000000000000000000..ce29aa527bb5d32c426a08a7970287eb8a818f4a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgges.f
@@ -0,0 +1,550 @@
+ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, DELCTG, N, A, LDA, B, LDB,
+ $ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR,
+ $ LDVSR, WORK, LWORK, BWORK, INFO )
+*
+* -- LAPACK driver routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBVSL, JOBVSR, SORT
+ INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
+* ..
+* .. Array Arguments ..
+ LOGICAL BWORK( * )
+ DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
+ $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
+ $ VSR( LDVSR, * ), WORK( * )
+* ..
+* .. Function Arguments ..
+ LOGICAL DELCTG
+ EXTERNAL DELCTG
+* ..
+*
+* Purpose
+* =======
+*
+* DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
+* the generalized eigenvalues, the generalized real Schur form (S,T),
+* optionally, the left and/or right matrices of Schur vectors (VSL and
+* VSR). This gives the generalized Schur factorization
+*
+* (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )
+*
+* Optionally, it also orders the eigenvalues so that a selected cluster
+* of eigenvalues appears in the leading diagonal blocks of the upper
+* quasi-triangular matrix S and the upper triangular matrix T.The
+* leading columns of VSL and VSR then form an orthonormal basis for the
+* corresponding left and right eigenspaces (deflating subspaces).
+*
+* (If only the generalized eigenvalues are needed, use the driver
+* DGGEV instead, which is faster.)
+*
+* A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
+* or a ratio alpha/beta = w, such that A - w*B is singular. It is
+* usually represented as the pair (alpha,beta), as there is a
+* reasonable interpretation for beta=0 or both being zero.
+*
+* A pair of matrices (S,T) is in generalized real Schur form if T is
+* upper triangular with non-negative diagonal and S is block upper
+* triangular with 1-by-1 and 2-by-2 blocks. 1-by-1 blocks correspond
+* to real generalized eigenvalues, while 2-by-2 blocks of S will be
+* "standardized" by making the corresponding elements of T have the
+* form:
+* [ a 0 ]
+* [ 0 b ]
+*
+* and the pair of corresponding 2-by-2 blocks in S and T will have a
+* complex conjugate pair of generalized eigenvalues.
+*
+*
+* Arguments
+* =========
+*
+* JOBVSL (input) CHARACTER*1
+* = 'N': do not compute the left Schur vectors;
+* = 'V': compute the left Schur vectors.
+*
+* JOBVSR (input) CHARACTER*1
+* = 'N': do not compute the right Schur vectors;
+* = 'V': compute the right Schur vectors.
+*
+* SORT (input) CHARACTER*1
+* Specifies whether or not to order the eigenvalues on the
+* diagonal of the generalized Schur form.
+* = 'N': Eigenvalues are not ordered;
+* = 'S': Eigenvalues are ordered (see DELZTG);
+*
+* DELZTG (input) LOGICAL FUNCTION of three DOUBLE PRECISION arguments
+* DELZTG must be declared EXTERNAL in the calling subroutine.
+* If SORT = 'N', DELZTG is not referenced.
+* If SORT = 'S', DELZTG is used to select eigenvalues to sort
+* to the top left of the Schur form.
+* An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
+* DELZTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
+* one of a complex conjugate pair of eigenvalues is selected,
+* then both complex eigenvalues are selected.
+*
+* Note that in the ill-conditioned case, a selected complex
+* eigenvalue may no longer satisfy DELZTG(ALPHAR(j),ALPHAI(j),
+* BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
+* in this case.
+*
+* N (input) INTEGER
+* The order of the matrices A, B, VSL, and VSR. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+* On entry, the first of the pair of matrices.
+* On exit, A has been overwritten by its generalized Schur
+* form S.
+*
+* LDA (input) INTEGER
+* The leading dimension of A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+* On entry, the second of the pair of matrices.
+* On exit, B has been overwritten by its generalized Schur
+* form T.
+*
+* LDB (input) INTEGER
+* The leading dimension of B. LDB >= max(1,N).
+*
+* SDIM (output) INTEGER
+* If SORT = 'N', SDIM = 0.
+* If SORT = 'S', SDIM = number of eigenvalues (after sorting)
+* for which DELZTG is true. (Complex conjugate pairs for which
+* DELZTG is true for either eigenvalue count as 2.)
+*
+* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i,
+* and BETA(j),j=1,...,N are the diagonals of the complex Schur
+* form (S,T) that would result if the 2-by-2 diagonal blocks of
+* the real Schur form of (A,B) were further reduced to
+* triangular form using 2-by-2 complex unitary transformations.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) negative.
+*
+* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
+* may easily over- or underflow, and BETA(j) may even be zero.
+* Thus, the user should avoid naively computing the ratio.
+* However, ALPHAR and ALPHAI will be always less than and
+* usually comparable with norm(A) in magnitude, and BETA always
+* less than and usually comparable with norm(B).
+*
+* VSL (output) DOUBLE PRECISION array, dimension (LDVSL,N)
+* If JOBVSL = 'V', VSL will contain the left Schur vectors.
+* Not referenced if JOBVSL = 'N'.
+*
+* LDVSL (input) INTEGER
+* The leading dimension of the matrix VSL. LDVSL >=1, and
+* if JOBVSL = 'V', LDVSL >= N.
+*
+* VSR (output) DOUBLE PRECISION array, dimension (LDVSR,N)
+* If JOBVSR = 'V', VSR will contain the right Schur vectors.
+* Not referenced if JOBVSR = 'N'.
+*
+* LDVSR (input) INTEGER
+* The leading dimension of the matrix VSR. LDVSR >= 1, and
+* if JOBVSR = 'V', LDVSR >= N.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= 8*N+16.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* BWORK (workspace) LOGICAL array, dimension (N)
+* Not referenced if SORT = 'N'.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* = 1,...,N:
+* The QZ iteration failed. (A,B) are not in Schur
+* form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
+* be correct for j=INFO+1,...,N.
+* > N: =N+1: other than QZ iteration failed in DHGEQZ.
+* =N+2: after reordering, roundoff changed values of
+* some complex eigenvalues so that leading
+* eigenvalues in the Generalized Schur form no
+* longer satisfy DELZTG=.TRUE. This could also
+* be caused due to scaling.
+* =N+3: reordering failed in DTGSEN.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL,
+ $ LQUERY, LST2SL, WANTST
+ INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT,
+ $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, MAXWRK,
+ $ MINWRK
+ DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL,
+ $ PVSR, SAFMAX, SAFMIN, SMLNUM
+* ..
+* .. Local Arrays ..
+ INTEGER IDUM( 1 )
+ DOUBLE PRECISION DIF( 2 )
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
+ $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN,
+ $ XERBLA
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ DOUBLE PRECISION DLAMCH, DLANGE
+ EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Decode the input arguments
+*
+ IF( LSAME( JOBVSL, 'N' ) ) THEN
+ IJOBVL = 1
+ ILVSL = .FALSE.
+ ELSE IF( LSAME( JOBVSL, 'V' ) ) THEN
+ IJOBVL = 2
+ ILVSL = .TRUE.
+ ELSE
+ IJOBVL = -1
+ ILVSL = .FALSE.
+ END IF
+*
+ IF( LSAME( JOBVSR, 'N' ) ) THEN
+ IJOBVR = 1
+ ILVSR = .FALSE.
+ ELSE IF( LSAME( JOBVSR, 'V' ) ) THEN
+ IJOBVR = 2
+ ILVSR = .TRUE.
+ ELSE
+ IJOBVR = -1
+ ILVSR = .FALSE.
+ END IF
+*
+ WANTST = LSAME( SORT, 'S' )
+*
+* Test the input arguments
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( IJOBVL.LE.0 ) THEN
+ INFO = -1
+ ELSE IF( IJOBVR.LE.0 ) THEN
+ INFO = -2
+ ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -9
+ ELSE IF( LDVSL.LT.1 .OR. ( ILVSL .AND. LDVSL.LT.N ) ) THEN
+ INFO = -15
+ ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN
+ INFO = -17
+ END IF
+*
+* Compute workspace
+* (Note: Comments in the code beginning "Workspace:" describe the
+* minimal amount of workspace needed at that point in the code,
+* as well as the preferred amount for good performance.
+* NB refers to the optimal block size for the immediately
+* following subroutine, as returned by ILAENV.)
+*
+ MINWRK = 1
+ IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) ) THEN
+ MINWRK = 7*( N+1 ) + 16
+ MAXWRK = 7*( N+1 ) + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) +
+ $ 16
+ IF( ILVSL ) THEN
+ MAXWRK = MAX( MAXWRK, 7*( N+1 )+N*
+ $ ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) )
+ END IF
+ WORK( 1 ) = MAXWRK
+ END IF
+*
+ IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY )
+ $ INFO = -19
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGES ', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ SDIM = 0
+ RETURN
+ END IF
+*
+* Get machine constants
+*
+ EPS = DLAMCH( 'P' )
+ SAFMIN = DLAMCH( 'S' )
+ SAFMAX = ONE / SAFMIN
+ CALL DLABAD( SAFMIN, SAFMAX )
+ SMLNUM = SQRT( SAFMIN ) / EPS
+ BIGNUM = ONE / SMLNUM
+*
+* Scale A if max element outside range [SMLNUM,BIGNUM]
+*
+ ANRM = DLANGE( 'M', N, N, A, LDA, WORK )
+ ILASCL = .FALSE.
+ IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+ ANRMTO = SMLNUM
+ ILASCL = .TRUE.
+ ELSE IF( ANRM.GT.BIGNUM ) THEN
+ ANRMTO = BIGNUM
+ ILASCL = .TRUE.
+ END IF
+ IF( ILASCL )
+ $ CALL DLASCL( 'G', 0, 0, ANRM, ANRMTO, N, N, A, LDA, IERR )
+*
+* Scale B if max element outside range [SMLNUM,BIGNUM]
+*
+ BNRM = DLANGE( 'M', N, N, B, LDB, WORK )
+ ILBSCL = .FALSE.
+ IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+ BNRMTO = SMLNUM
+ ILBSCL = .TRUE.
+ ELSE IF( BNRM.GT.BIGNUM ) THEN
+ BNRMTO = BIGNUM
+ ILBSCL = .TRUE.
+ END IF
+ IF( ILBSCL )
+ $ CALL DLASCL( 'G', 0, 0, BNRM, BNRMTO, N, N, B, LDB, IERR )
+*
+* Permute the matrix to make it more nearly triangular
+* (Workspace: need 6*N + 2*N space for storing balancing factors)
+*
+ ILEFT = 1
+ IRIGHT = N + 1
+ IWRK = IRIGHT + N
+ CALL DGGBAL( 'P', N, A, LDA, B, LDB, ILO, IHI, WORK( ILEFT ),
+ $ WORK( IRIGHT ), WORK( IWRK ), IERR )
+*
+* Reduce B to triangular form (QR decomposition of B)
+* (Workspace: need N, prefer N*NB)
+*
+ IROWS = IHI + 1 - ILO
+ ICOLS = N + 1 - ILO
+ ITAU = IWRK
+ IWRK = ITAU + IROWS
+ CALL DGEQRF( IROWS, ICOLS, B( ILO, ILO ), LDB, WORK( ITAU ),
+ $ WORK( IWRK ), LWORK+1-IWRK, IERR )
+*
+* Apply the orthogonal transformation to matrix A
+* (Workspace: need N, prefer N*NB)
+*
+ CALL DORMQR( 'L', 'T', IROWS, ICOLS, IROWS, B( ILO, ILO ), LDB,
+ $ WORK( ITAU ), A( ILO, ILO ), LDA, WORK( IWRK ),
+ $ LWORK+1-IWRK, IERR )
+*
+* Initialize VSL
+* (Workspace: need N, prefer N*NB)
+*
+ IF( ILVSL ) THEN
+ CALL DLASET( 'Full', N, N, ZERO, ONE, VSL, LDVSL )
+ CALL DLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB,
+ $ VSL( ILO+1, ILO ), LDVSL )
+ CALL DORGQR( IROWS, IROWS, IROWS, VSL( ILO, ILO ), LDVSL,
+ $ WORK( ITAU ), WORK( IWRK ), LWORK+1-IWRK, IERR )
+ END IF
+*
+* Initialize VSR
+*
+ IF( ILVSR )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, VSR, LDVSR )
+*
+* Reduce to generalized Hessenberg form
+* (Workspace: none needed)
+*
+ CALL DGGHRD( JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB, VSL,
+ $ LDVSL, VSR, LDVSR, IERR )
+*
+* Perform QZ algorithm, computing Schur vectors if desired
+* (Workspace: need N)
+*
+ IWRK = ITAU
+ CALL DHGEQZ( 'S', JOBVSL, JOBVSR, N, ILO, IHI, A, LDA, B, LDB,
+ $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR,
+ $ WORK( IWRK ), LWORK+1-IWRK, IERR )
+ IF( IERR.NE.0 ) THEN
+ IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
+ INFO = IERR
+ ELSE IF( IERR.GT.N .AND. IERR.LE.2*N ) THEN
+ INFO = IERR - N
+ ELSE
+ INFO = N + 1
+ END IF
+ GO TO 50
+ END IF
+*
+* Sort eigenvalues ALPHA/BETA if desired
+* (Workspace: need 4*N+16 )
+*
+ SDIM = 0
+ IF( WANTST ) THEN
+*
+* Undo scaling on eigenvalues before DELZTGing
+*
+ IF( ILASCL ) THEN
+ CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N,
+ $ IERR )
+ CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N,
+ $ IERR )
+ END IF
+ IF( ILBSCL )
+ $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
+*
+* Select eigenvalues
+*
+ DO 10 I = 1, N
+ BWORK( I ) = DELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
+ 10 CONTINUE
+*
+ CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR,
+ $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL,
+ $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1,
+ $ IERR )
+ IF( IERR.EQ.1 )
+ $ INFO = N + 3
+*
+ END IF
+*
+* Apply back-permutation to VSL and VSR
+* (Workspace: none needed)
+*
+ IF( ILVSL )
+ $ CALL DGGBAK( 'P', 'L', N, ILO, IHI, WORK( ILEFT ),
+ $ WORK( IRIGHT ), N, VSL, LDVSL, IERR )
+*
+ IF( ILVSR )
+ $ CALL DGGBAK( 'P', 'R', N, ILO, IHI, WORK( ILEFT ),
+ $ WORK( IRIGHT ), N, VSR, LDVSR, IERR )
+*
+* Check if unscaling would cause over/underflow, if so, rescale
+* (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
+* B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
+*
+ IF( ILASCL ) THEN
+ DO 20 I = 1, N
+ IF( ALPHAI( I ).NE.ZERO ) THEN
+ IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR.
+ $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) THEN
+ WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) )
+ BETA( I ) = BETA( I )*WORK( 1 )
+ ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
+ ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
+ ELSE IF( ( ALPHAI( I ) / SAFMAX ).GT.
+ $ ( ANRMTO / ANRM ) .OR.
+ $ ( SAFMIN / ALPHAI( I ) ).GT.( ANRM / ANRMTO ) )
+ $ THEN
+ WORK( 1 ) = ABS( A( I, I+1 ) / ALPHAI( I ) )
+ BETA( I ) = BETA( I )*WORK( 1 )
+ ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
+ ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
+ END IF
+ END IF
+ 20 CONTINUE
+ END IF
+*
+ IF( ILBSCL ) THEN
+ DO 30 I = 1, N
+ IF( ALPHAI( I ).NE.ZERO ) THEN
+ IF( ( BETA( I ) / SAFMAX ).GT.( BNRMTO / BNRM ) .OR.
+ $ ( SAFMIN / BETA( I ) ).GT.( BNRM / BNRMTO ) ) THEN
+ WORK( 1 ) = ABS( B( I, I ) / BETA( I ) )
+ BETA( I ) = BETA( I )*WORK( 1 )
+ ALPHAR( I ) = ALPHAR( I )*WORK( 1 )
+ ALPHAI( I ) = ALPHAI( I )*WORK( 1 )
+ END IF
+ END IF
+ 30 CONTINUE
+ END IF
+*
+* Undo scaling
+*
+ IF( ILASCL ) THEN
+ CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR )
+ CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR )
+ CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR )
+ END IF
+*
+ IF( ILBSCL ) THEN
+ CALL DLASCL( 'U', 0, 0, BNRMTO, BNRM, N, N, B, LDB, IERR )
+ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR )
+ END IF
+*
+ IF( WANTST ) THEN
+*
+* Check if reordering is correct
+*
+ LASTSL = .TRUE.
+ LST2SL = .TRUE.
+ SDIM = 0
+ IP = 0
+ DO 40 I = 1, N
+ CURSL = DELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) )
+ IF( ALPHAI( I ).EQ.ZERO ) THEN
+ IF( CURSL )
+ $ SDIM = SDIM + 1
+ IP = 0
+ IF( CURSL .AND. .NOT.LASTSL )
+ $ INFO = N + 2
+ ELSE
+ IF( IP.EQ.1 ) THEN
+*
+* Last eigenvalue of conjugate pair
+*
+ CURSL = CURSL .OR. LASTSL
+ LASTSL = CURSL
+ IF( CURSL )
+ $ SDIM = SDIM + 2
+ IP = -1
+ IF( CURSL .AND. .NOT.LST2SL )
+ $ INFO = N + 2
+ ELSE
+*
+* First eigenvalue of conjugate pair
+*
+ IP = 1
+ END IF
+ END IF
+ LST2SL = LASTSL
+ LASTSL = CURSL
+ 40 CONTINUE
+*
+ END IF
+*
+ 50 CONTINUE
+*
+ WORK( 1 ) = MAXWRK
+*
+ RETURN
+*
+* End of DGGES
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..336a98b8e0b6de5e56f27cab98793cbc8ca831a3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.c
@@ -0,0 +1,268 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+
+static doublereal c_b10 = 0.;
+static doublereal c_b11 = 1.;
+static integer c__1 = 1;
+
+/* Subroutine */ void dgghrd_(compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, info)
+const char *compq, *compz;
+const integer *n;
+integer *ilo, *ihi;
+doublereal *a;
+const integer *lda;
+doublereal *b;
+const integer *ldb;
+doublereal *q;
+const integer *ldq;
+doublereal *z;
+const integer *ldz;
+integer *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, z_dim1, z_offset, i__1;
+
+ /* Local variables */
+ static integer jcol;
+ static doublereal temp;
+ static integer jrow;
+ static doublereal c, s;
+ static integer icompq, icompz;
+ static logical ilq, ilz;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+
+/* DGGHRD reduces a pair of real matrices (A,B) to generalized upper */
+/* Hessenberg form using orthogonal transformations, where A is a */
+/* general matrix and B is upper triangular: Q' * A * Z = H and */
+/* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular, */
+/* and Q and Z are orthogonal, and ' means transpose. */
+
+/* The orthogonal matrices Q and Z are determined as products of Givens */
+/* rotations. They may either be formed explicitly, or they may be */
+/* postmultiplied into input matrices Q1 and Z1, so that */
+
+/* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)' */
+/* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)' */
+
+/* Arguments */
+/* ========= */
+
+/* COMPQ (input) CHARACTER*1 */
+/* = 'N': do not compute Q; */
+/* = 'I': Q is initialized to the unit matrix, and the */
+/* orthogonal matrix Q is returned; */
+/* = 'V': Q must contain an orthogonal matrix Q1 on entry, */
+/* and the product Q1*Q is returned. */
+
+/* COMPZ (input) CHARACTER*1 */
+/* = 'N': do not compute Z; */
+/* = 'I': Z is initialized to the unit matrix, and the */
+/* orthogonal matrix Z is returned; */
+/* = 'V': Z must contain an orthogonal matrix Z1 on entry, */
+/* and the product Z1*Z is returned. */
+
+/* N (input) INTEGER */
+/* The order of the matrices A and B. N >= 0. */
+
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that A is already upper triangular in rows and */
+/* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set */
+/* by a previous call to DGGBAL; otherwise they should be set */
+/* to 1 and N respectively. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
+/* On entry, the N-by-N general matrix to be reduced. */
+/* On exit, the upper triangle and the first subdiagonal of A */
+/* are overwritten with the upper Hessenberg matrix H, and the */
+/* rest is set to zero. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB, N) */
+/* On entry, the N-by-N upper triangular matrix B. */
+/* On exit, the upper triangular matrix T = Q' B Z. The */
+/* elements below the diagonal are set to zero. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N) */
+/* If COMPQ='N': Q is not referenced. */
+/* If COMPQ='I': on entry, Q need not be set, and on exit it */
+/* contains the orthogonal matrix Q, where Q' */
+/* is the product of the Givens transformations */
+/* which are applied to A and B on the left. */
+/* If COMPQ='V': on entry, Q must contain an orthogonal matrix */
+/* Q1, and on exit this is overwritten by Q1*Q. */
+
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. */
+/* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise. */
+
+/* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N) */
+/* If COMPZ='N': Z is not referenced. */
+/* If COMPZ='I': on entry, Z need not be set, and on exit it */
+/* contains the orthogonal matrix Z, which is */
+/* the product of the Givens transformations */
+/* which are applied to A and B on the right. */
+/* If COMPZ='V': on entry, Z must contain an orthogonal matrix */
+/* Z1, and on exit this is overwritten by Z1*Z. */
+
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. */
+/* LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit. */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+
+/* Further Details */
+/* =============== */
+
+/* This routine reduces A to Hessenberg and B to triangular form by */
+/* an unblocked reduction, as described in _Matrix_Computations_, */
+/* by Golub and Van Loan (Johns Hopkins Press.) */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z -= z_offset;
+
+/* Decode COMPQ */
+
+ if (lsame_(compq, "N")) {
+ ilq = FALSE_;
+ icompq = 1;
+ } else if (lsame_(compq, "V")) {
+ ilq = TRUE_;
+ icompq = 2;
+ } else if (lsame_(compq, "I")) {
+ ilq = TRUE_;
+ icompq = 3;
+ } else {
+ icompq = 0;
+ }
+
+/* Decode COMPZ */
+
+ if (lsame_(compz, "N")) {
+ ilz = FALSE_;
+ icompz = 1;
+ } else if (lsame_(compz, "V")) {
+ ilz = TRUE_;
+ icompz = 2;
+ } else if (lsame_(compz, "I")) {
+ ilz = TRUE_;
+ icompz = 3;
+ } else {
+ icompz = 0;
+ }
+
+/* Test the input parameters. */
+
+ *info = 0;
+ if (icompq <= 0) {
+ *info = -1;
+ } else if (icompz <= 0) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1) {
+ *info = -4;
+ } else if (*ihi > *n || *ihi < *ilo - 1) {
+ *info = -5;
+ } else if (*lda < max(1,*n)) {
+ *info = -7;
+ } else if (*ldb < max(1,*n)) {
+ *info = -9;
+ } else if ( (ilq && *ldq < *n ) || *ldq < 1) {
+ *info = -11;
+ } else if ( (ilz && *ldz < *n ) || *ldz < 1) {
+ *info = -13;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGGHRD", &i__1);
+ return;
+ }
+
+/* Initialize Q and Z if desired. */
+
+ if (icompq == 3) {
+ dlaset_("Full", n, n, &c_b10, &c_b11, &q[q_offset], ldq);
+ }
+ if (icompz == 3) {
+ dlaset_("Full", n, n, &c_b10, &c_b11, &z[z_offset], ldz);
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ return;
+ }
+
+/* Zero out lower triangle of B */
+
+ for (jcol = 1; jcol <= *n - 1; ++jcol) {
+ for (jrow = jcol + 1; jrow <= *n; ++jrow) {
+ b[jrow + jcol * b_dim1] = 0.;
+ }
+ }
+
+/* Reduce A and B */
+
+ for (jcol = *ilo; jcol <= *ihi - 2; ++jcol) {
+
+ for (jrow = *ihi; jrow >= jcol + 2; --jrow) {
+
+/* Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL) */
+
+ temp = a[jrow - 1 + jcol * a_dim1];
+ dlartg_(&temp, &a[jrow + jcol * a_dim1], &c, &s, &a[jrow - 1 + jcol * a_dim1]);
+ a[jrow + jcol * a_dim1] = 0.;
+ i__1 = *n - jcol;
+ drot_(&i__1, &a[jrow - 1 + (jcol + 1) * a_dim1], lda, &a[jrow + (jcol + 1) * a_dim1], lda, &c, &s);
+ i__1 = *n + 2 - jrow;
+ drot_(&i__1, &b[jrow - 1 + (jrow - 1) * b_dim1], ldb, &b[jrow + (jrow - 1) * b_dim1], ldb, &c, &s);
+ if (ilq) {
+ drot_(n, &q[(jrow - 1) * q_dim1 + 1], &c__1, &q[jrow * q_dim1 + 1], &c__1, &c, &s);
+ }
+
+/* Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1) */
+
+ temp = b[jrow + jrow * b_dim1];
+ dlartg_(&temp, &b[jrow + (jrow - 1) * b_dim1], &c, &s, &b[jrow + jrow * b_dim1]);
+ b[jrow + (jrow - 1) * b_dim1] = 0.;
+ drot_(ihi, &a[jrow * a_dim1 + 1], &c__1, &a[(jrow - 1) * a_dim1 + 1], &c__1, &c, &s);
+ i__1 = jrow - 1;
+ drot_(&i__1, &b[jrow * b_dim1 + 1], &c__1, &b[(jrow - 1) * b_dim1 + 1], &c__1, &c, &s);
+ if (ilz) {
+ drot_(n, &z[jrow * z_dim1 + 1], &c__1, &z[(jrow - 1) * z_dim1 + 1], &c__1, &c, &s);
+ }
+ }
+ }
+} /* dgghrd_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.f
new file mode 100644
index 0000000000000000000000000000000000000000..9473fb580adbd580d38bea7bbf3a4567c2f0f41e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgghrd.f
@@ -0,0 +1,253 @@
+ SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
+ $ LDQ, Z, LDZ, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER COMPQ, COMPZ
+ INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
+ $ Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGGHRD reduces a pair of real matrices (A,B) to generalized upper
+* Hessenberg form using orthogonal transformations, where A is a
+* general matrix and B is upper triangular: Q' * A * Z = H and
+* Q' * B * Z = T, where H is upper Hessenberg, T is upper triangular,
+* and Q and Z are orthogonal, and ' means transpose.
+*
+* The orthogonal matrices Q and Z are determined as products of Givens
+* rotations. They may either be formed explicitly, or they may be
+* postmultiplied into input matrices Q1 and Z1, so that
+*
+* Q1 * A * Z1' = (Q1*Q) * H * (Z1*Z)'
+* Q1 * B * Z1' = (Q1*Q) * T * (Z1*Z)'
+*
+* Arguments
+* =========
+*
+* COMPQ (input) CHARACTER*1
+* = 'N': do not compute Q;
+* = 'I': Q is initialized to the unit matrix, and the
+* orthogonal matrix Q is returned;
+* = 'V': Q must contain an orthogonal matrix Q1 on entry,
+* and the product Q1*Q is returned.
+*
+* COMPZ (input) CHARACTER*1
+* = 'N': do not compute Z;
+* = 'I': Z is initialized to the unit matrix, and the
+* orthogonal matrix Z is returned;
+* = 'V': Z must contain an orthogonal matrix Z1 on entry,
+* and the product Z1*Z is returned.
+*
+* N (input) INTEGER
+* The order of the matrices A and B. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that A is already upper triangular in rows and
+* columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set
+* by a previous call to DGGBAL; otherwise they should be set
+* to 1 and N respectively.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+* On entry, the N-by-N general matrix to be reduced.
+* On exit, the upper triangle and the first subdiagonal of A
+* are overwritten with the upper Hessenberg matrix H, and the
+* rest is set to zero.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+* On entry, the N-by-N upper triangular matrix B.
+* On exit, the upper triangular matrix T = Q' B Z. The
+* elements below the diagonal are set to zero.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,N).
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+* If COMPQ='N': Q is not referenced.
+* If COMPQ='I': on entry, Q need not be set, and on exit it
+* contains the orthogonal matrix Q, where Q'
+* is the product of the Givens transformations
+* which are applied to A and B on the left.
+* If COMPQ='V': on entry, Q must contain an orthogonal matrix
+* Q1, and on exit this is overwritten by Q1*Q.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q.
+* LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise.
+*
+* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+* If COMPZ='N': Z is not referenced.
+* If COMPZ='I': on entry, Z need not be set, and on exit it
+* contains the orthogonal matrix Z, which is
+* the product of the Givens transformations
+* which are applied to A and B on the right.
+* If COMPZ='V': on entry, Z must contain an orthogonal matrix
+* Z1, and on exit this is overwritten by Z1*Z.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z.
+* LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise.
+*
+* INFO (output) INTEGER
+* = 0: successful exit.
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* This routine reduces A to Hessenberg and B to triangular form by
+* an unblocked reduction, as described in _Matrix_Computations_,
+* by Golub and Van Loan (Johns Hopkins Press.)
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ILQ, ILZ
+ INTEGER ICOMPQ, ICOMPZ, JCOL, JROW
+ DOUBLE PRECISION C, S, TEMP
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARTG, DLASET, DROT, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Decode COMPQ
+*
+ IF( LSAME( COMPQ, 'N' ) ) THEN
+ ILQ = .FALSE.
+ ICOMPQ = 1
+ ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
+ ILQ = .TRUE.
+ ICOMPQ = 2
+ ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
+ ILQ = .TRUE.
+ ICOMPQ = 3
+ ELSE
+ ICOMPQ = 0
+ END IF
+*
+* Decode COMPZ
+*
+ IF( LSAME( COMPZ, 'N' ) ) THEN
+ ILZ = .FALSE.
+ ICOMPZ = 1
+ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
+ ILZ = .TRUE.
+ ICOMPZ = 2
+ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
+ ILZ = .TRUE.
+ ICOMPZ = 3
+ ELSE
+ ICOMPZ = 0
+ END IF
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF( ICOMPQ.LE.0 ) THEN
+ INFO = -1
+ ELSE IF( ICOMPZ.LE.0 ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( ILO.LT.1 ) THEN
+ INFO = -4
+ ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -9
+ ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN
+ INFO = -11
+ ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
+ INFO = -13
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGHRD', -INFO )
+ RETURN
+ END IF
+*
+* Initialize Q and Z if desired.
+*
+ IF( ICOMPQ.EQ.3 )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+ IF( ICOMPZ.EQ.3 )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
+*
+* Quick return if possible
+*
+ IF( N.LE.1 )
+ $ RETURN
+*
+* Zero out lower triangle of B
+*
+ DO 20 JCOL = 1, N - 1
+ DO 10 JROW = JCOL + 1, N
+ B( JROW, JCOL ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+*
+* Reduce A and B
+*
+ DO 40 JCOL = ILO, IHI - 2
+*
+ DO 30 JROW = IHI, JCOL + 2, -1
+*
+* Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL)
+*
+ TEMP = A( JROW-1, JCOL )
+ CALL DLARTG( TEMP, A( JROW, JCOL ), C, S,
+ $ A( JROW-1, JCOL ) )
+ A( JROW, JCOL ) = ZERO
+ CALL DROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA,
+ $ A( JROW, JCOL+1 ), LDA, C, S )
+ CALL DROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB,
+ $ B( JROW, JROW-1 ), LDB, C, S )
+ IF( ILQ )
+ $ CALL DROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S )
+*
+* Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1)
+*
+ TEMP = B( JROW, JROW )
+ CALL DLARTG( TEMP, B( JROW, JROW-1 ), C, S,
+ $ B( JROW, JROW ) )
+ B( JROW, JROW-1 ) = ZERO
+ CALL DROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S )
+ CALL DROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C,
+ $ S )
+ IF( ILZ )
+ $ CALL DROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S )
+ 30 CONTINUE
+ 40 CONTINUE
+*
+ RETURN
+*
+* End of DGGHRD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.c
new file mode 100644
index 0000000000000000000000000000000000000000..6bd32c978cd6d56855e5f6fb774bb92cafaf1300
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.c
@@ -0,0 +1,277 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, doublereal *alpha, doublereal *beta, doublereal *u, integer *ldu,
+ doublereal *v, integer *ldv, doublereal *q, integer *ldq,
+ doublereal *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal tola, tolb, unfl;
+ static doublereal anorm, bnorm;
+ static logical wantq, wantu, wantv;
+ static integer ncycle;
+ static doublereal ulp;
+
+/* -- LAPACK driver routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGGSVD computes the generalized singular value decomposition (GSVD) */
+/* of an M-by-N real matrix A and P-by-N real matrix B: */
+/* */
+/* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ) */
+/* */
+/* where U, V and Q are orthogonal matrices, and Z' is the transpose */
+/* of Z. Let K+L = the effective numerical rank of the matrix (A',B')', */
+/* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and */
+/* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the */
+/* following structures, respectively: */
+/* */
+/* If M-K-L >= 0, */
+/* */
+/* K L */
+/* D1 = K ( I 0 ) */
+/* L ( 0 C ) */
+/* M-K-L ( 0 0 ) */
+/* */
+/* K L */
+/* D2 = L ( 0 S ) */
+/* P-L ( 0 0 ) */
+/* */
+/* N-K-L K L */
+/* ( 0 R ) = K ( 0 R11 R12 ) */
+/* L ( 0 0 R22 ) */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */
+/* S = diag( BETA(K+1), ... , BETA(K+L) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R is stored in A(1:K+L,N-K-L+1:N) on exit. */
+/* */
+/* If M-K-L < 0, */
+/* */
+/* K M-K K+L-M */
+/* D1 = K ( I 0 0 ) */
+/* M-K ( 0 C 0 ) */
+/* */
+/* K M-K K+L-M */
+/* D2 = M-K ( 0 S 0 ) */
+/* K+L-M ( 0 0 I ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* N-K-L K M-K K+L-M */
+/* ( 0 R ) = K ( 0 R11 R12 R13 ) */
+/* M-K ( 0 0 R22 R23 ) */
+/* K+L-M ( 0 0 0 R33 ) */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */
+/* S = diag( BETA(K+1), ... , BETA(M) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored */
+/* ( 0 R22 R23 ) */
+/* in B(M-K+1:L,N+M-K-L+1:N) on exit. */
+/* */
+/* The routine computes C, S, R, and optionally the orthogonal */
+/* transformation matrices U, V and Q. */
+/* */
+/* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of */
+/* A and B implicitly gives the SVD of A*inv(B): */
+/* A*inv(B) = U*(D1*inv(D2))*V'. */
+/* If ( A',B')' has orthonormal columns, then the GSVD of A and B is */
+/* also equal to the CS decomposition of A and B. Furthermore, the GSVD */
+/* can be used to derive the solution of the eigenvalue problem: */
+/* A'*A x = lambda* B'*B x. */
+/* In some literature, the GSVD of A and B is presented in the form */
+/* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 ) */
+/* where U and V are orthogonal and X is nonsingular, D1 and D2 are */
+/* ``diagonal''. The former GSVD form can be converted to the latter */
+/* form by taking the nonsingular matrix X as */
+/* */
+/* X = Q*( I 0 ) */
+/* ( 0 inv(R) ). */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': Orthogonal matrix U is computed; */
+/* = 'N': U is not computed. */
+/* */
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': Orthogonal matrix V is computed; */
+/* = 'N': V is not computed. */
+/* */
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Orthogonal matrix Q is computed; */
+/* = 'N': Q is not computed. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+/* */
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+/* */
+/* K (output) INTEGER */
+/* L (output) INTEGER */
+/* On exit, K and L specify the dimension of the subblocks */
+/* described in the Purpose section. */
+/* K + L = effective numerical rank of (A',B')'. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A contains the triangular matrix R, or part of R. */
+/* See Purpose for details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, B contains the triangular matrix R if M-K-L < 0. */
+/* See Purpose for details. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDA >= max(1,P). */
+/* */
+/* ALPHA (output) DOUBLE PRECISION array, dimension (N) */
+/* BETA (output) DOUBLE PRECISION array, dimension (N) */
+/* On exit, ALPHA and BETA contain the generalized singular */
+/* value pairs of A and B; */
+/* ALPHA(1:K) = 1, */
+/* BETA(1:K) = 0, */
+/* and if M-K-L >= 0, */
+/* ALPHA(K+1:K+L) = C, */
+/* BETA(K+1:K+L) = S, */
+/* or if M-K-L < 0, */
+/* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0 */
+/* BETA(K+1:M) =S, BETA(M+1:K+L) =1 */
+/* and */
+/* ALPHA(K+L+1:N) = 0 */
+/* BETA(K+L+1:N) = 0 */
+/* */
+/* U (output) DOUBLE PRECISION array, dimension (LDU,M) */
+/* If JOBU = 'U', U contains the M-by-M orthogonal matrix U. */
+/* If JOBU = 'N', U is not referenced. */
+/* */
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+/* */
+/* V (output) DOUBLE PRECISION array, dimension (LDV,P) */
+/* If JOBV = 'V', V contains the P-by-P orthogonal matrix V. */
+/* If JOBV = 'N', V is not referenced. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+/* */
+/* Q (output) DOUBLE PRECISION array, dimension (LDQ,N) */
+/* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, */
+/* dimension (max(3*N,M,P)+N) */
+/* */
+/* IWORK (workspace) INTEGER array, dimension (N) */
+/* */
+/* INFO (output)INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* > 0: if INFO = 1, the Jacobi-type procedure failed to */
+/* converge. For further details, see subroutine DTGSJA. */
+/* */
+/* Internal Parameters */
+/* =================== */
+/* */
+/* TOLA DOUBLE PRECISION */
+/* TOLB DOUBLE PRECISION */
+/* TOLA and TOLB are the thresholds to determine the effective */
+/* rank of (A',B')'. Generally, they are set to */
+/* TOLA = MAX(M,N)*norm(A)*MACHEPS, */
+/* TOLB = MAX(P,N)*norm(B)*MACHEPS. */
+/* The size of TOLA and TOLB may affect the size of backward */
+/* errors of the decomposition. */
+/* */
+/* ===================================================================== */
+
+/* Test the input parameters */
+
+ wantu = lsame_(jobu, "U");
+ wantv = lsame_(jobv, "V");
+ wantq = lsame_(jobq, "Q");
+
+ *info = 0;
+ if (! (wantu || lsame_(jobu, "N"))) {
+ *info = -1;
+ } else if (! (wantv || lsame_(jobv, "N"))) {
+ *info = -2;
+ } else if (! (wantq || lsame_(jobq, "N"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*p < 0) {
+ *info = -6;
+ } else if (*lda < max(1,*m)) {
+ *info = -10;
+ } else if (*ldb < max(1,*p)) {
+ *info = -12;
+ } else if (*ldu < 1 || (wantu && *ldu < *m)) {
+ *info = -16;
+ } else if (*ldv < 1 || (wantv && *ldv < *p)) {
+ *info = -18;
+ } else if (*ldq < 1 || (wantq && *ldq < *n)) {
+ *info = -20;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGGSVD", &i__1);
+ return;
+ }
+
+/* Compute the Frobenius norm of matrices A and B */
+
+ anorm = dlange_("1", m, n, a, lda, work);
+ bnorm = dlange_("1", p, n, b, ldb, work);
+
+/* Get machine precision and set up threshold for determining */
+/* the effective numerical rank of the matrices A and B. */
+
+ ulp = dlamch_("Precision");
+ unfl = dlamch_("Safe Minimum");
+ tola = max(*m,*n) * max(anorm,unfl) * ulp;
+ tolb = max(*p,*n) * max(bnorm,unfl) * ulp;
+
+/* Preprocessing */
+
+ dggsvp_(jobu, jobv, jobq, m, p, n, a, lda, b, ldb, &tola, &tolb, k, l,
+ u, ldu, v, ldv, q, ldq, iwork, work, &work[*n], info);
+
+/* Compute the GSVD of two upper "triangular" matrices */
+
+ dtgsja_(jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, &tola, &tolb,
+ alpha, beta, u, ldu, v, ldv, q, ldq, work, &ncycle, info);
+
+} /* dggsvd_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.f
new file mode 100644
index 0000000000000000000000000000000000000000..32a2d7dcc94515f2f4a29ee984419b3f16942f56
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvd.f
@@ -0,0 +1,296 @@
+ SUBROUTINE DGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
+ $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
+ $ IWORK, INFO )
+*
+* -- LAPACK driver routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
+ $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
+ $ V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGGSVD computes the generalized singular value decomposition (GSVD)
+* of an M-by-N real matrix A and P-by-N real matrix B:
+*
+* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+*
+* where U, V and Q are orthogonal matrices, and Z' is the transpose
+* of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+* following structures, respectively:
+*
+* If M-K-L >= 0,
+*
+* K L
+* D1 = K ( I 0 )
+* L ( 0 C )
+* M-K-L ( 0 0 )
+*
+* K L
+* D2 = L ( 0 S )
+* P-L ( 0 0 )
+*
+* N-K-L K L
+* ( 0 R ) = K ( 0 R11 R12 )
+* L ( 0 0 R22 )
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+* S = diag( BETA(K+1), ... , BETA(K+L) ),
+* C**2 + S**2 = I.
+*
+* R is stored in A(1:K+L,N-K-L+1:N) on exit.
+*
+* If M-K-L < 0,
+*
+* K M-K K+L-M
+* D1 = K ( I 0 0 )
+* M-K ( 0 C 0 )
+*
+* K M-K K+L-M
+* D2 = M-K ( 0 S 0 )
+* K+L-M ( 0 0 I )
+* P-L ( 0 0 0 )
+*
+* N-K-L K M-K K+L-M
+* ( 0 R ) = K ( 0 R11 R12 R13 )
+* M-K ( 0 0 R22 R23 )
+* K+L-M ( 0 0 0 R33 )
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+* S = diag( BETA(K+1), ... , BETA(M) ),
+* C**2 + S**2 = I.
+*
+* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+* ( 0 R22 R23 )
+* in B(M-K+1:L,N+M-K-L+1:N) on exit.
+*
+* The routine computes C, S, R, and optionally the orthogonal
+* transformation matrices U, V and Q.
+*
+* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+* A and B implicitly gives the SVD of A*inv(B):
+* A*inv(B) = U*(D1*inv(D2))*V'.
+* If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+* also equal to the CS decomposition of A and B. Furthermore, the GSVD
+* can be used to derive the solution of the eigenvalue problem:
+* A'*A x = lambda* B'*B x.
+* In some literature, the GSVD of A and B is presented in the form
+* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+* where U and V are orthogonal and X is nonsingular, D1 and D2 are
+* ``diagonal''. The former GSVD form can be converted to the latter
+* form by taking the nonsingular matrix X as
+*
+* X = Q*( I 0 )
+* ( 0 inv(R) ).
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': Orthogonal matrix U is computed;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': Orthogonal matrix V is computed;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Orthogonal matrix Q is computed;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* K (output) INTEGER
+* L (output) INTEGER
+* On exit, K and L specify the dimension of the subblocks
+* described in the Purpose section.
+* K + L = effective numerical rank of (A',B')'.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A contains the triangular matrix R, or part of R.
+* See Purpose for details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, B contains the triangular matrix R if M-K-L < 0.
+* See Purpose for details.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDA >= max(1,P).
+*
+* ALPHA (output) DOUBLE PRECISION array, dimension (N)
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* On exit, ALPHA and BETA contain the generalized singular
+* value pairs of A and B;
+* ALPHA(1:K) = 1,
+* BETA(1:K) = 0,
+* and if M-K-L >= 0,
+* ALPHA(K+1:K+L) = C,
+* BETA(K+1:K+L) = S,
+* or if M-K-L < 0,
+* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+* BETA(K+1:M) =S, BETA(M+1:K+L) =1
+* and
+* ALPHA(K+L+1:N) = 0
+* BETA(K+L+1:N) = 0
+*
+* U (output) DOUBLE PRECISION array, dimension (LDU,M)
+* If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (output) DOUBLE PRECISION array, dimension (LDV,P)
+* If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* WORK (workspace) DOUBLE PRECISION array,
+* dimension (max(3*N,M,P)+N)
+*
+* IWORK (workspace) INTEGER array, dimension (N)
+*
+* INFO (output)INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* > 0: if INFO = 1, the Jacobi-type procedure failed to
+* converge. For further details, see subroutine DTGSJA.
+*
+* Internal Parameters
+* ===================
+*
+* TOLA DOUBLE PRECISION
+* TOLB DOUBLE PRECISION
+* TOLA and TOLB are the thresholds to determine the effective
+* rank of (A',B')'. Generally, they are set to
+* TOLA = MAX(M,N)*norm(A)*MACHEPS,
+* TOLB = MAX(P,N)*norm(B)*MACHEPS.
+* The size of TOLA and TOLB may affect the size of backward
+* errors of the decomposition.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL WANTQ, WANTU, WANTV
+ INTEGER NCYCLE
+ DOUBLE PRECISION ANORM, BNORM, TOLA, TOLB, ULP, UNFL
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH, DLANGE
+ EXTERNAL LSAME, DLAMCH, DLANGE
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGGSVP, DTGSJA, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ WANTU = LSAME( JOBU, 'U' )
+ WANTV = LSAME( JOBV, 'V' )
+ WANTQ = LSAME( JOBQ, 'Q' )
+*
+ INFO = 0
+ IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -12
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -16
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -18
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -20
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGSVD', -INFO )
+ RETURN
+ END IF
+*
+* Compute the Frobenius norm of matrices A and B
+*
+ ANORM = DLANGE( '1', M, N, A, LDA, WORK )
+ BNORM = DLANGE( '1', P, N, B, LDB, WORK )
+*
+* Get machine precision and set up threshold for determining
+* the effective numerical rank of the matrices A and B.
+*
+ ULP = DLAMCH( 'Precision' )
+ UNFL = DLAMCH( 'Safe Minimum' )
+ TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP
+ TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP
+*
+* Preprocessing
+*
+ CALL DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
+ $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK,
+ $ WORK( N+1 ), INFO )
+*
+* Compute the GSVD of two upper "triangular" matrices
+*
+ CALL DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB,
+ $ TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
+ $ WORK, NCYCLE, INFO )
+*
+ RETURN
+*
+* End of DGGSVD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.c
new file mode 100644
index 0000000000000000000000000000000000000000..9f9be4bd9f67f89c96fe80b1b93af67ac3fad637
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.c
@@ -0,0 +1,341 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+
+static doublereal c_b12 = 0.;
+static doublereal c_b22 = 1.;
+
+/* Subroutine */
+void dggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *tola, doublereal *tolb, integer *k, integer *l, doublereal *u, integer *ldu,
+ doublereal *v, integer *ldv, doublereal *q, integer *ldq, integer *iwork, doublereal *tau,
+ doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, j;
+ static logical wantq, wantu, wantv;
+ static logical forwrd;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DGGSVP computes orthogonal matrices U, V and Q such that */
+/* */
+/* N-K-L K L */
+/* U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0; */
+/* L ( 0 0 A23 ) */
+/* M-K-L ( 0 0 0 ) */
+/* */
+/* N-K-L K L */
+/* = K ( 0 A12 A13 ) if M-K-L < 0; */
+/* M-K ( 0 0 A23 ) */
+/* */
+/* N-K-L K L */
+/* V'*B*Q = L ( 0 0 B13 ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular */
+/* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, */
+/* otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective */
+/* numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the */
+/* transpose of Z. */
+/* */
+/* This decomposition is the preprocessing step for computing the */
+/* Generalized Singular Value Decomposition (GSVD), see subroutine */
+/* DGGSVD. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': Orthogonal matrix U is computed; */
+/* = 'N': U is not computed. */
+/* */
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': Orthogonal matrix V is computed; */
+/* = 'N': V is not computed. */
+/* */
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Orthogonal matrix Q is computed; */
+/* = 'N': Q is not computed. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A contains the triangular (or trapezoidal) matrix */
+/* described in the Purpose section. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, B contains the triangular matrix described in */
+/* the Purpose section. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,P). */
+/* */
+/* TOLA (input) DOUBLE PRECISION */
+/* TOLB (input) DOUBLE PRECISION */
+/* TOLA and TOLB are the thresholds to determine the effective */
+/* numerical rank of matrix B and a subblock of A. Generally, */
+/* they are set to */
+/* TOLA = MAX(M,N)*norm(A)*MACHEPS, */
+/* TOLB = MAX(P,N)*norm(B)*MACHEPS. */
+/* The size of TOLA and TOLB may affect the size of backward */
+/* errors of the decomposition. */
+/* */
+/* K (output) INTEGER */
+/* L (output) INTEGER */
+/* On exit, K and L specify the dimension of the subblocks */
+/* described in Purpose. */
+/* K + L = effective numerical rank of (A',B')'. */
+/* */
+/* U (output) DOUBLE PRECISION array, dimension (LDU,M) */
+/* If JOBU = 'U', U contains the orthogonal matrix U. */
+/* If JOBU = 'N', U is not referenced. */
+/* */
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+/* */
+/* V (output) DOUBLE PRECISION array, dimension (LDV,M) */
+/* If JOBV = 'V', V contains the orthogonal matrix V. */
+/* If JOBV = 'N', V is not referenced. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+/* */
+/* Q (output) DOUBLE PRECISION array, dimension (LDQ,N) */
+/* If JOBQ = 'Q', Q contains the orthogonal matrix Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+/* */
+/* IWORK (workspace) INTEGER array, dimension (N) */
+/* */
+/* TAU (workspace) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (max(3*N,M,P)) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The subroutine uses LAPACK subroutine DGEQPF for the QR factorization */
+/* with column pivoting to detect the effective numerical rank of the */
+/* a matrix. It may be replaced by a better rank determination strategy. */
+/* */
+/* ===================================================================== */
+
+ /* Test the input parameters */
+
+ wantu = lsame_(jobu, "U");
+ wantv = lsame_(jobv, "V");
+ wantq = lsame_(jobq, "Q");
+ forwrd = TRUE_;
+
+ *info = 0;
+ if (! (wantu || lsame_(jobu, "N"))) *info = 1;
+ else if (! (wantv || lsame_(jobv, "N"))) *info = 2;
+ else if (! (wantq || lsame_(jobq, "N"))) *info = 3;
+ else if (*m < 0) *info = 4;
+ else if (*p < 0) *info = 5;
+ else if (*n < 0) *info = 6;
+ else if (*lda < max(1,*m)) *info = 8;
+ else if (*ldb < max(1,*p)) *info = 10;
+ else if (*ldu < 1 || (wantu && *ldu < *m) ) *info = 16;
+ else if (*ldv < 1 || (wantv && *ldv < *p) ) *info = 18;
+ else if (*ldq < 1 || (wantq && *ldq < *n) ) *info = 20;
+ if (*info != 0) {
+ xerbla_("DGGSVP", info);
+ *info = -(*info);
+ return;
+ }
+
+ /* QR with column pivoting of B: B*P = V*( S11 S12 ) */
+ /* ( 0 0 ) */
+ for (i = 0; i < *n; ++i) iwork[i] = 0;
+ dgeqpf_(p, n, b, ldb, iwork, tau, work, info);
+
+ /* Update A := A*P */
+ dlapmt_(&forwrd, m, n, a, lda, iwork);
+
+ /* Determine the effective rank of matrix B. */
+ *l = 0;
+ for (i = 0; i < *p && i < *n; ++i)
+ if (abs(b[i + i * *ldb]) > *tolb)
+ ++(*l);
+
+ if (wantv)
+ {
+ /* Copy the details of V, and form V. */
+ dlaset_("Full", p, p, &c_b12, &c_b12, v, ldv);
+ if (*p > 1) {
+ i__1 = *p - 1;
+ dlacpy_("Lower", &i__1, n, b+1, ldb, v+1, ldv);
+ }
+ i__1 = min(*p,*n);
+ dorg2r_(p, p, &i__1, v, ldv, tau, work, info);
+ }
+
+ /* Clean up B */
+ for (j = 0; j < *l; ++j)
+ for (i = j + 1; i < *l; ++i)
+ b[i + j * *ldb] = 0.;
+ if (*p > *l) {
+ i__1 = *p - *l;
+ dlaset_("Full", &i__1, n, &c_b12, &c_b12, &b[*l], ldb);
+ }
+
+ if (wantq)
+ {
+ /* Set Q = I and Update Q := Q*P */
+ dlaset_("Full", n, n, &c_b12, &c_b22, q, ldq);
+ dlapmt_(&forwrd, n, n, q, ldq, iwork);
+ }
+
+ if (*p >= *l && *n != *l)
+ {
+ /* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z */
+ dgerq2_(l, n, b, ldb, tau, work, info);
+
+ /* Update A := A*Z' */
+ dormr2_("Right", "Transpose", m, n, l, b, ldb, tau, a, lda, work, info);
+
+ if (wantq)
+ {
+ /* Update Q := Q*Z' */
+ dormr2_("Right", "Transpose", n, n, l, b, ldb, tau, q, ldq, work, info);
+ }
+
+ /* Clean up B */
+ i__1 = *n - *l;
+ dlaset_("Full", l, &i__1, &c_b12, &c_b12, b, ldb);
+ for (j = *n - *l; j < *n; ++j)
+ for (i = j - *n + *l + 1; i < *l; ++i)
+ b[i + j * *ldb] = 0.;
+ }
+
+ /* Let N-L L */
+ /* A = ( A11 A12 ) M, */
+ /* */
+ /* then the following does the complete QR decomposition of A11: */
+ /* */
+ /* A11 = U*( 0 T12 )*P1' */
+ /* ( 0 0 ) */
+ for (i = 0; i < *n - *l; ++i) iwork[i] = 0;
+ i__1 = *n - *l;
+ dgeqpf_(m, &i__1, a, lda, iwork, tau, work, info);
+
+ /* Determine the effective rank of A11 */
+ *k = 0;
+ for (i = 0; i < *m && i < *n - *l; ++i)
+ if (abs(a[i + i * *lda]) > *tola)
+ ++(*k);
+
+ /* Update A12 := U'*A12, where A12 = A( 1:M, N-L+1:N ) */
+ i__1 = min(*m,*n - *l);
+ dorm2r_("Left", "Transpose", m, l, &i__1, a, lda, tau, &a[(*n - *l) * *lda], lda, work, info);
+
+ if (wantu)
+ {
+ /* Copy the details of U, and form U */
+ dlaset_("Full", m, m, &c_b12, &c_b12, u, ldu);
+ if (*m > 1) {
+ i__1 = *m - 1;
+ i__2 = *n - *l;
+ dlacpy_("Lower", &i__1, &i__2, a+1, lda, u+1, ldu);
+ }
+ i__1 = min(*m,*n - *l);
+ dorg2r_(m, m, &i__1, u, ldu, tau, work, info);
+ }
+
+ if (wantq)
+ {
+ /* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1 */
+ i__1 = *n - *l;
+ dlapmt_(&forwrd, n, &i__1, q, ldq, iwork);
+ }
+
+ /* Clean up A: set the strictly lower triangular part of */
+ /* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0. */
+ for (j = 0; j < *k; ++j)
+ for (i = j + 1; i < *k; ++i)
+ a[i + j * *lda] = 0.;
+ if (*m > *k) {
+ i__1 = *m - *k;
+ i__2 = *n - *l;
+ dlaset_("Full", &i__1, &i__2, &c_b12, &c_b12, &a[*k], lda);
+ }
+
+ if (*n - *l > *k)
+ {
+ /* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1 */
+ i__1 = *n - *l;
+ dgerq2_(k, &i__1, a, lda, tau, work, info);
+
+ if (wantq)
+ {
+ /* Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1' */
+ i__1 = *n - *l;
+ dormr2_("Right", "Transpose", n, &i__1, k, a, lda, tau, q, ldq, work, info);
+ }
+
+ /* Clean up A */
+ i__1 = *n - *l - *k;
+ dlaset_("Full", k, &i__1, &c_b12, &c_b12, a, lda);
+ for (j = *n - *l - *k; j < *n - *l; ++j)
+ for (i = j - *n + *l + *k + 1; i < *k; ++i)
+ a[i + j * *lda] = 0.;
+ }
+
+ if (*m > *k)
+ {
+ /* QR factorization of A( K+1:M,N-L+1:N ) */
+ i__1 = *m - *k;
+ dgeqr2_(&i__1, l, &a[*k + (*n - *l) * *lda], lda, tau, work, info);
+
+ if (wantu)
+ {
+ /* Update U(:,K+1:M) := U(:,K+1:M)*U1 */
+ i__1 = *m - *k;
+ i__2 = min(i__1,*l);
+ dorm2r_("Right", "No transpose", m, &i__1, &i__2,
+ &a[*k + (*n - *l) * *lda], lda, tau, &u[*k * *ldu], ldu, work, info);
+ }
+
+ /* Clean up */
+ for (j = *n - *l; j < *n; ++j)
+ for (i = j - *n + *k + *l + 1; i < *m; ++i)
+ a[i + j * *lda] = 0.;
+ }
+} /* dggsvp_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.f
new file mode 100644
index 0000000000000000000000000000000000000000..36ab54588c0adbaa7897a57f7004c1c6b6a67f16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dggsvp.f
@@ -0,0 +1,394 @@
+ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
+ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
+ $ IWORK, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
+ DOUBLE PRECISION TOLA, TOLB
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
+ $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DGGSVP computes orthogonal matrices U, V and Q such that
+*
+* N-K-L K L
+* U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+* L ( 0 0 A23 )
+* M-K-L ( 0 0 0 )
+*
+* N-K-L K L
+* = K ( 0 A12 A13 ) if M-K-L < 0;
+* M-K ( 0 0 A23 )
+*
+* N-K-L K L
+* V'*B*Q = L ( 0 0 B13 )
+* P-L ( 0 0 0 )
+*
+* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+* otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+* numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+* transpose of Z.
+*
+* This decomposition is the preprocessing step for computing the
+* Generalized Singular Value Decomposition (GSVD), see subroutine
+* DGGSVD.
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': Orthogonal matrix U is computed;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': Orthogonal matrix V is computed;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Orthogonal matrix Q is computed;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A contains the triangular (or trapezoidal) matrix
+* described in the Purpose section.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, B contains the triangular matrix described in
+* the Purpose section.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,P).
+*
+* TOLA (input) DOUBLE PRECISION
+* TOLB (input) DOUBLE PRECISION
+* TOLA and TOLB are the thresholds to determine the effective
+* numerical rank of matrix B and a subblock of A. Generally,
+* they are set to
+* TOLA = MAX(M,N)*norm(A)*MACHEPS,
+* TOLB = MAX(P,N)*norm(B)*MACHEPS.
+* The size of TOLA and TOLB may affect the size of backward
+* errors of the decomposition.
+*
+* K (output) INTEGER
+* L (output) INTEGER
+* On exit, K and L specify the dimension of the subblocks
+* described in Purpose.
+* K + L = effective numerical rank of (A',B')'.
+*
+* U (output) DOUBLE PRECISION array, dimension (LDU,M)
+* If JOBU = 'U', U contains the orthogonal matrix U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (output) DOUBLE PRECISION array, dimension (LDV,M)
+* If JOBV = 'V', V contains the orthogonal matrix V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+* If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* IWORK (workspace) INTEGER array, dimension (N)
+*
+* TAU (workspace) DOUBLE PRECISION array, dimension (N)
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (max(3*N,M,P))
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+*
+* Further Details
+* ===============
+*
+* The subroutine uses LAPACK subroutine DGEQPF for the QR factorization
+* with column pivoting to detect the effective numerical rank of the
+* a matrix. It may be replaced by a better rank determination strategy.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FORWRD, WANTQ, WANTU, WANTV
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEQPF, DGEQR2, DGERQ2, DLACPY, DLAPMT, DLASET,
+ $ DORG2R, DORM2R, DORMR2, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ WANTU = LSAME( JOBU, 'U' )
+ WANTV = LSAME( JOBV, 'V' )
+ WANTQ = LSAME( JOBQ, 'Q' )
+ FORWRD = .TRUE.
+*
+ INFO = 0
+ IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -10
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -16
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -18
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -20
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGGSVP', -INFO )
+ RETURN
+ END IF
+*
+* QR with column pivoting of B: B*P = V*( S11 S12 )
+* ( 0 0 )
+*
+ DO 10 I = 1, N
+ IWORK( I ) = 0
+ 10 CONTINUE
+ CALL DGEQPF( P, N, B, LDB, IWORK, TAU, WORK, INFO )
+*
+* Update A := A*P
+*
+ CALL DLAPMT( FORWRD, M, N, A, LDA, IWORK )
+*
+* Determine the effective rank of matrix B.
+*
+ L = 0
+ DO 20 I = 1, MIN( P, N )
+ IF( ABS( B( I, I ) ).GT.TOLB )
+ $ L = L + 1
+ 20 CONTINUE
+*
+ IF( WANTV ) THEN
+*
+* Copy the details of V, and form V.
+*
+ CALL DLASET( 'Full', P, P, ZERO, ZERO, V, LDV )
+ IF( P.GT.1 )
+ $ CALL DLACPY( 'Lower', P-1, N, B( 2, 1 ), LDB, V( 2, 1 ),
+ $ LDV )
+ CALL DORG2R( P, P, MIN( P, N ), V, LDV, TAU, WORK, INFO )
+ END IF
+*
+* Clean up B
+*
+ DO 40 J = 1, L - 1
+ DO 30 I = J + 1, L
+ B( I, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ IF( P.GT.L )
+ $ CALL DLASET( 'Full', P-L, N, ZERO, ZERO, B( L+1, 1 ), LDB )
+*
+ IF( WANTQ ) THEN
+*
+* Set Q = I and Update Q := Q*P
+*
+ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+ CALL DLAPMT( FORWRD, N, N, Q, LDQ, IWORK )
+ END IF
+*
+ IF( P.GE.L .AND. N.NE.L ) THEN
+*
+* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z
+*
+ CALL DGERQ2( L, N, B, LDB, TAU, WORK, INFO )
+*
+* Update A := A*Z'
+*
+ CALL DORMR2( 'Right', 'Transpose', M, N, L, B, LDB, TAU, A,
+ $ LDA, WORK, INFO )
+*
+ IF( WANTQ ) THEN
+*
+* Update Q := Q*Z'
+*
+ CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q,
+ $ LDQ, WORK, INFO )
+ END IF
+*
+* Clean up B
+*
+ CALL DLASET( 'Full', L, N-L, ZERO, ZERO, B, LDB )
+ DO 60 J = N - L + 1, N
+ DO 50 I = J - N + L + 1, L
+ B( I, J ) = ZERO
+ 50 CONTINUE
+ 60 CONTINUE
+*
+ END IF
+*
+* Let N-L L
+* A = ( A11 A12 ) M,
+*
+* then the following does the complete QR decomposition of A11:
+*
+* A11 = U*( 0 T12 )*P1'
+* ( 0 0 )
+*
+ DO 70 I = 1, N - L
+ IWORK( I ) = 0
+ 70 CONTINUE
+ CALL DGEQPF( M, N-L, A, LDA, IWORK, TAU, WORK, INFO )
+*
+* Determine the effective rank of A11
+*
+ K = 0
+ DO 80 I = 1, MIN( M, N-L )
+ IF( ABS( A( I, I ) ).GT.TOLA )
+ $ K = K + 1
+ 80 CONTINUE
+*
+* Update A12 := U'*A12, where A12 = A( 1:M, N-L+1:N )
+*
+ CALL DORM2R( 'Left', 'Transpose', M, L, MIN( M, N-L ), A, LDA,
+ $ TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
+*
+ IF( WANTU ) THEN
+*
+* Copy the details of U, and form U
+*
+ CALL DLASET( 'Full', M, M, ZERO, ZERO, U, LDU )
+ IF( M.GT.1 )
+ $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ),
+ $ LDU )
+ CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
+ END IF
+*
+ IF( WANTQ ) THEN
+*
+* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1
+*
+ CALL DLAPMT( FORWRD, N, N-L, Q, LDQ, IWORK )
+ END IF
+*
+* Clean up A: set the strictly lower triangular part of
+* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0.
+*
+ DO 100 J = 1, K - 1
+ DO 90 I = J + 1, K
+ A( I, J ) = ZERO
+ 90 CONTINUE
+ 100 CONTINUE
+ IF( M.GT.K )
+ $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA )
+*
+ IF( N-L.GT.K ) THEN
+*
+* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1
+*
+ CALL DGERQ2( K, N-L, A, LDA, TAU, WORK, INFO )
+*
+ IF( WANTQ ) THEN
+*
+* Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1'
+*
+ CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU,
+ $ Q, LDQ, WORK, INFO )
+ END IF
+*
+* Clean up A
+*
+ CALL DLASET( 'Full', K, N-L-K, ZERO, ZERO, A, LDA )
+ DO 120 J = N - L - K + 1, N - L
+ DO 110 I = J - N + L + K + 1, K
+ A( I, J ) = ZERO
+ 110 CONTINUE
+ 120 CONTINUE
+*
+ END IF
+*
+ IF( M.GT.K ) THEN
+*
+* QR factorization of A( K+1:M,N-L+1:N )
+*
+ CALL DGEQR2( M-K, L, A( K+1, N-L+1 ), LDA, TAU, WORK, INFO )
+*
+ IF( WANTU ) THEN
+*
+* Update U(:,K+1:M) := U(:,K+1:M)*U1
+*
+ CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ),
+ $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU,
+ $ WORK, INFO )
+ END IF
+*
+* Clean up
+*
+ DO 140 J = N - L + 1, N
+ DO 130 I = J - N + K + L + 1, M
+ A( I, J ) = ZERO
+ 130 CONTINUE
+ 140 CONTINUE
+*
+ END IF
+*
+ RETURN
+*
+* End of DGGSVP
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa.c
new file mode 100644
index 0000000000000000000000000000000000000000..20e77d32c615878d8a16baaaaa1d998683c62467
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa.c
@@ -0,0 +1,89 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c__3 = 3;
+
+/* SUBROUTINE 'GPFA' */
+/* SELF-SORTING IN-PLACE GENERALIZED PRIME FACTOR (COMPLEX) FFT */
+/* */
+/* This is the version to be translated into C++ */
+/* using f2c with the following parameters: */
+/* f2c -c -C++ -P -r8 */
+/* where -c == include fortran code as comments */
+/* -C++ == gen. C++ code */
+/* -P == gen prototypes */
+/* -r8 == gen double (instead of float) */
+/* */
+/* CALL GPFA(A,B,TRIGS,INC,JUMP,N,LOT,ISIGN,NIPQ,INFO) */
+/* */
+/* A IS FIRST REAL INPUT/OUTPUT VECTOR */
+/* B IS FIRST IMAGINARY INPUT/OUTPUT VECTOR */
+/* TRIGS IS A TABLE OF TWIDDLE FACTORS, PRECALCULATED */
+/* BY CALLING SUBROUTINE 'SETGPFA' */
+/* INC IS THE INCREMENT WITHIN EACH DATA VECTOR */
+/* JUMP IS THE INCREMENT BETWEEN DATA VECTORS */
+/* N IS THE LENGTH OF THE TRANSFORMS: */
+/* ----------------------------------- */
+/* N = (2**IP) * (3**IQ) * (5**IR) */
+/* ----------------------------------- */
+/* LOT IS THE NUMBER OF TRANSFORMS */
+/* ISIGN = +1 FOR FORWARD TRANSFORM */
+/* = -1 FOR INVERSE TRANSFORM */
+/* NPQR is an array containing the number of factors (for */
+/* power of 2,3 and 5 */
+/* INFO is set to -1 if there is a problem, 0 otherwise */
+/* */
+/* WRITTEN BY CLIVE TEMPERTON */
+/* RECHERCHE EN PREVISION NUMERIQUE */
+/* ATMOSPHERIC ENVIRONMENT SERVICE, CANADA */
+/* */
+/* ---------------------------------------------------------------------- */
+/* */
+/* DEFINITION OF TRANSFORM */
+/* ----------------------- */
+/* */
+/* X(J) = SUM(K=0,...,N-1)(C(K)*EXP(ISIGN*2*I*J*K*PI/N)) */
+/* */
+/* --------------------------------------------------------------------- */
+/* */
+/* FOR A MATHEMATICAL DEVELOPMENT OF THE ALGORITHM USED, */
+/* SEE: */
+/* */
+/* C TEMPERTON : "A GENERALIZED PRIME FACTOR FFT ALGORITHM */
+/* FOR ANY N = (2**P)(3**Q)(5**R)", */
+/* SIAM J. SCI. STAT. COMP., MAY 1992. */
+/* */
+/* ---------------------------------------------------------------------- */
+
+/* Subroutine */ void dgpfa_(doublereal *a, doublereal *b, const doublereal *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *lot,
+ const integer *isign, const integer *npqr, integer *info)
+{
+ /* Local variables */
+ static integer i, ip, iq, ir;
+
+ ip = npqr[0];
+ iq = npqr[1];
+ ir = npqr[2];
+
+/* COMPUTE THE TRANSFORM */
+/* --------------------- */
+/* IMPORTANT: call the *double* versions (and not the floats) */
+/* i.e. calls to *D*gpfaxf instead of gpfaxf */
+
+ i = 0;
+ if (ip > 0) {
+ dgpfa2f_(a, b, trigs, inc, jump, n, &ip, lot, isign);
+ i += pow_ii(&c__2, &ip) << 1;
+ }
+ if (iq > 0) {
+ dgpfa3f_(a, b, &trigs[i], inc, jump, n, &iq, lot, isign);
+ i += pow_ii(&c__3, &iq) << 1;
+ }
+ if (ir > 0) {
+ dgpfa5f_(a, b, &trigs[i], inc, jump, n, &ir, lot, isign);
+ }
+ *info = 0;
+} /* dgpfa_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa2f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa2f.c
new file mode 100644
index 0000000000000000000000000000000000000000..9a59c4104b22123bd9989561032dac430bf89daa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa2f.c
@@ -0,0 +1,1179 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+
+/* fortran version of *dgpfa2* - */
+/* radix-2 section of self-sorting, in-place, generalized pfa */
+/* central radix-2 and radix-8 passes included */
+/* so that transform length can be any power of 2 */
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void dgpfa2f_(doublereal *a, doublereal *b, const doublereal *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *mm, const integer *lot, const integer *isign)
+{
+ /* Initialized data */
+ static integer lvr = 1024;
+
+ /* System generated locals */
+ integer i__2, i__3, i__4, i__5, i__6, i__7, i__8;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static doublereal s;
+ static integer ipass, nblox;
+ static doublereal c1;
+ static integer jstep;
+ static doublereal c2, c3;
+ static integer m2, n2;
+ static doublereal t0;
+ static integer m8;
+ static doublereal t2, t1, t3, u0, u2, u1, u3;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, jj, jk, jl, jm, jn, jo, jp;
+ static integer la, nb, mh, kk, ll, mu, nu, laincl;
+ static doublereal ss;
+ static integer jstepl;
+ static doublereal co1, co2, co3;
+ static integer istart;
+ static doublereal co4, co5, co6, co7;
+ static integer jstepx;
+ static doublereal si1, si2, si3, si4, si5, si6, si7, aja, ajb, ajc, ajd,
+ bja, bjc, bjb, bjd, aje, ajg, ajf, ajh, bje, bjg, bjf, bjh, aji;
+ static integer jjj;
+ static doublereal bjm, ajj;
+ static integer ink;
+ static doublereal bjj, ajk, ajl, bji, bjk;
+ static integer inq;
+ static doublereal ajo, bjl, bjo, ajm, ajn, ajp, bjn, bjp;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n2 = pow_ii(&c__2, mm);
+ inq = *n / n2;
+ jstepx = (n2 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+
+ m2 = 0;
+ m8 = 0;
+ if (*mm % 2 == 0) {
+ m = *mm / 2;
+ } else if (*mm % 4 == 1) {
+ m = (*mm - 1) / 2;
+ m2 = 1;
+ } else if (*mm % 4 == 3) {
+ m = (*mm - 3) / 2;
+ m8 = 1;
+ }
+ mh = (m + 1) / 2;
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (doublereal) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+/* -------------------------------- */
+ for (nb = 0; nb < nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-4 passes */
+/* ----------------------------- */
+ mu = inq % 4;
+ if (*isign == -1) {
+ mu = 4 - mu;
+ }
+ ss = 1.;
+ if (mu == 3) {
+ ss = -1.;
+ }
+
+ if (mh == 0) {
+ goto L200;
+ }
+
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la << 2);
+ jstepl = jstep - ninc;
+
+/* k = 0 loop (no twiddle factors) */
+/* ------------------------------- */
+ i__3 = (*n - 1) * *inc;
+ i__4 = jstep << 2;
+ for (jjj = 0; i__4 < 0 ? jjj >= i__3 : jjj <= i__3; jjj += i__4) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ a[ja + j] = t0 + t1;
+ a[jc + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ b[jc + j] = u0 - u1;
+ a[jb + j] = t2 - u3;
+ a[jd + j] = t2 + u3;
+ b[jb + j] = u2 + t3;
+ b[jd + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n2 = 4 */
+/* ------------------ */
+ if (n2 == 4) {
+ goto L490;
+ }
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__4 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+
+/* loop along transform */
+/* -------------------- */
+ i__5 = (*n - 1) * *inc;
+ i__6 = jstep << 2;
+ for (jjj = k; i__6 < 0 ? jjj >= i__5 : jjj <= i__5; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep,shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[jb + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jb + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jc + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jc + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jd + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jd + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+ j += *jump;
+ }
+/* -----( end of loop across transforms ) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+/* -----( end of loop along transforms ) */
+ kk += la << 1;
+ }
+/* -----( end of loop on nonzero k ) */
+ la <<= 2;
+ }
+/* -----( end of loop on type I radix-4 passes) */
+
+/* central radix-2 pass */
+/* -------------------- */
+L200:
+ if (m2 == 0) {
+ goto L300;
+ }
+
+ jstep = *n * *inc / (la << 1);
+ jstepl = jstep - ninc;
+
+/* k=0 loop (no twiddle factors) */
+/* ----------------------------- */
+ i__2 = (*n - 1) * *inc;
+ i__3 = jstep << 1;
+ for (jjj = 0; i__3 < 0 ? jjj >= i__2 : jjj <= i__2; jjj += i__3) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = aja - ajb;
+ a[ja + j] = aja + ajb;
+ a[jb + j] = t0;
+ bja = b[ja + j];
+ bjb = b[jb + j];
+ u0 = bja - bjb;
+ b[ja + j] = bja + bjb;
+ b[jb + j] = u0;
+ j += *jump;
+ }
+/* -----(end of loop across transforms) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n2=2 */
+/* ---------------- */
+ if (n2 == 2) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__3 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__3 : k <= i__3; k += ink) {
+ co1 = trigs[kk];
+ si1 = s * trigs[kk + 1];
+
+/* loop along transforms */
+/* --------------------- */
+ i__4 = (*n - 1) * *inc;
+ i__6 = jstep << 1;
+ for (jjj = k; i__6 < 0 ? jjj >= i__4 : jjj <= i__4; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+ if (kk == n2 / 2) {
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = ss * (aja - ajb);
+ a[ja + j] = aja + ajb;
+ bjb = b[jb + j];
+ bja = b[ja + j];
+ a[jb + j] = ss * (bjb - bja);
+ b[ja + j] = bja + bjb;
+ b[jb + j] = t0;
+ j += *jump;
+ }
+ } else {
+
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = aja - ajb;
+ a[ja + j] = aja + ajb;
+ bja = b[ja + j];
+ bjb = b[jb + j];
+ u0 = bja - bjb;
+ b[ja + j] = bja + bjb;
+ a[jb + j] = co1 * t0 - si1 * u0;
+ b[jb + j] = si1 * t0 + co1 * u0;
+ j += *jump;
+ }
+ }
+
+/* -----(end of loop across transforms) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+/* -----(end of loop along transforms) */
+ kk += la << 1;
+ }
+/* -----(end of loop on nonzero k) */
+/* -----(end of radix-2 pass) */
+
+ la <<= 1;
+ goto L400;
+
+/* central radix-8 pass */
+/* -------------------- */
+L300:
+ if (m8 == 0) {
+ goto L400;
+ }
+ jstep = *n * *inc / (la << 3);
+ jstepl = jstep - ninc;
+ mu = inq % 8;
+ if (*isign == -1) {
+ mu = 8 - mu;
+ }
+ c1 = 1.;
+ if (mu == 3 || mu == 7) {
+ c1 = -1.;
+ }
+ c2 = sqrt(.5);
+ if (mu == 3 || mu == 5) {
+ c2 = -c2;
+ }
+ c3 = c1 * c2;
+
+/* stage 1 */
+/* ------- */
+ i__2 = jstep - ink;
+ for (k = 0; ink < 0 ? k >= i__2 : k <= i__2; k += ink) {
+ i__6 = (*n - 1) * *inc;
+ i__4 = jstep << 3;
+ for (jjj = k; i__4 < 0 ? jjj >= i__6 : jjj <= i__6; jjj += i__4) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja - aje;
+ a[ja + j] = aja + aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = c1 * (ajc - ajg);
+ a[je + j] = ajc + ajg;
+ ajb = a[jb + j];
+ ajf = a[jf + j];
+ t2 = ajb - ajf;
+ a[jc + j] = ajb + ajf;
+ ajd = a[jd + j];
+ ajh = a[jh + j];
+ t3 = ajd - ajh;
+ a[jg + j] = ajd + ajh;
+ a[jb + j] = t0;
+ a[jf + j] = t1;
+ a[jd + j] = c2 * (t2 - t3);
+ a[jh + j] = c3 * (t2 + t3);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja - bje;
+ b[ja + j] = bja + bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = c1 * (bjc - bjg);
+ b[je + j] = bjc + bjg;
+ bjb = b[jb + j];
+ bjf = b[jf + j];
+ u2 = bjb - bjf;
+ b[jc + j] = bjb + bjf;
+ bjd = b[jd + j];
+ bjh = b[jh + j];
+ u3 = bjd - bjh;
+ b[jg + j] = bjd + bjh;
+ b[jb + j] = u0;
+ b[jf + j] = u1;
+ b[jd + j] = c2 * (u2 - u3);
+ b[jh + j] = c3 * (u2 + u3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+
+/* stage 2 */
+/* ------- */
+
+/* k=0 (no twiddle factors) */
+/* ------------------------ */
+ i__3 = (*n - 1) * *inc;
+ i__2 = jstep << 3;
+ for (jjj = 0; i__2 < 0 ? jjj >= i__3 : jjj <= i__3; jjj += i__2) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja + aje;
+ t2 = aja - aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = ajc + ajg;
+ t3 = c1 * (ajc - ajg);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja + bje;
+ u2 = bja - bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = bjc + bjg;
+ u3 = c1 * (bjc - bjg);
+ a[ja + j] = t0 + t1;
+ a[je + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ b[je + j] = u0 - u1;
+ a[jc + j] = t2 - u3;
+ a[jg + j] = t2 + u3;
+ b[jc + j] = u2 + t3;
+ b[jg + j] = u2 - t3;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t0 = ajb + ajd;
+ t2 = ajb - ajd;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf - ajh;
+ t3 = ajf + ajh;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u0 = bjb + bjd;
+ u2 = bjb - bjd;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf - bjh;
+ u3 = bjf + bjh;
+ a[jb + j] = t0 - u3;
+ a[jh + j] = t0 + u3;
+ b[jb + j] = u0 + t3;
+ b[jh + j] = u0 - t3;
+ a[jd + j] = t2 + u1;
+ a[jf + j] = t2 - u1;
+ b[jd + j] = u2 - t1;
+ b[jf + j] = u2 + t1;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+ if (n2 == 8) {
+ goto L490;
+ }
+
+/* loop on nonzero k */
+/* ----------------- */
+ kk = la << 1;
+
+ i__2 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__2 : k <= i__2; k += ink) {
+
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ co5 = trigs[kk * 5]; si5 = s * trigs[kk * 5 + 1];
+ co6 = trigs[kk * 6]; si6 = s * trigs[kk * 6 + 1];
+ co7 = trigs[kk * 7]; si7 = s * trigs[kk * 7 + 1];
+
+ i__4 = (*n - 1) * *inc;
+ i__6 = jstep << 3;
+ for (jjj = k; i__6 < 0 ? jjj >= i__4 : jjj <= i__4; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja + aje;
+ t2 = aja - aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = ajc + ajg;
+ t3 = c1 * (ajc - ajg);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja + bje;
+ u2 = bja - bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = bjc + bjg;
+ u3 = c1 * (bjc - bjg);
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[je + j] = co4 * (t0 - t1) - si4 * (u0 - u1);
+ b[je + j] = si4 * (t0 - t1) + co4 * (u0 - u1);
+ a[jc + j] = co2 * (t2 - u3) - si2 * (u2 + t3);
+ b[jc + j] = si2 * (t2 - u3) + co2 * (u2 + t3);
+ a[jg + j] = co6 * (t2 + u3) - si6 * (u2 - t3);
+ b[jg + j] = si6 * (t2 + u3) + co6 * (u2 - t3);
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t0 = ajb + ajd;
+ t2 = ajb - ajd;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf - ajh;
+ t3 = ajf + ajh;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u0 = bjb + bjd;
+ u2 = bjb - bjd;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf - bjh;
+ u3 = bjf + bjh;
+ a[jb + j] = co1 * (t0 - u3) - si1 * (u0 + t3);
+ b[jb + j] = si1 * (t0 - u3) + co1 * (u0 + t3);
+ a[jh + j] = co7 * (t0 + u3) - si7 * (u0 - t3);
+ b[jh + j] = si7 * (t0 + u3) + co7 * (u0 - t3);
+ a[jd + j] = co3 * (t2 + u1) - si3 * (u2 - t1);
+ b[jd + j] = si3 * (t2 + u1) + co3 * (u2 - t1);
+ a[jf + j] = co5 * (t2 - u1) - si5 * (u2 + t1);
+ b[jf + j] = si5 * (t2 - u1) + co5 * (u2 + t1);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+
+ la <<= 3;
+
+/* loop on type II radix-4 passes */
+/* ------------------------------ */
+L400:
+ mu = inq % 4;
+ if (*isign == -1) {
+ mu = 4 - mu;
+ }
+ ss = 1.;
+ if (mu == 3) {
+ ss = -1.;
+ }
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la << 2);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+
+/* k=0 loop (no twiddle factors) */
+/* ----------------------------- */
+ i__2 = (la - 1) * ink;
+ i__6 = jstep << 2;
+ for (ll = 0; i__6 < 0 ? ll >= i__2 : ll <= i__2; ll += i__6) {
+
+ i__4 = (*n - 1) * *inc;
+ i__5 = (la << 2) * ink;
+ for (jjj = ll; i__5 < 0 ? jjj >= i__4 : jjj <= i__4; jjj += i__5) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = ja + laincl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = je + laincl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jj + jstepl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = ji + laincl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jo + jstepl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ aji = a[ji + j];
+ ajc = aji;
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ aje = a[je + j];
+ ajb = aje;
+ a[ja + j] = t0 + t1;
+ a[ji + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ bjc = u0 - u1;
+ bjm = b[jm + j];
+ bjd = bjm;
+ a[je + j] = t2 - u3;
+ ajd = t2 + u3;
+ bjb = u2 + t3;
+ b[jm + j] = u2 - t3;
+/* ---------------------- */
+ ajg = a[jg + j];
+ t0 = ajb + ajg;
+ t2 = ajb - ajg;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf + ajh;
+ t3 = ss * (ajf - ajh);
+ ajj = a[jj + j];
+ ajg = ajj;
+ bje = b[je + j];
+ bjg = b[jg + j];
+ u0 = bje + bjg;
+ u2 = bje - bjg;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf + bjh;
+ u3 = ss * (bjf - bjh);
+ b[je + j] = bjb;
+ a[jb + j] = t0 + t1;
+ a[jj + j] = t0 - t1;
+ bjj = b[jj + j];
+ bjg = bjj;
+ b[jb + j] = u0 + u1;
+ b[jj + j] = u0 - u1;
+ a[jf + j] = t2 - u3;
+ ajh = t2 + u3;
+ b[jf + j] = u2 + t3;
+ bjh = u2 - t3;
+/* ---------------------- */
+ ajk = a[jk + j];
+ t0 = ajc + ajk;
+ t2 = ajc - ajk;
+ ajl = a[jl + j];
+ t1 = ajg + ajl;
+ t3 = ss * (ajg - ajl);
+ bji = b[ji + j];
+ bjk = b[jk + j];
+ u0 = bji + bjk;
+ u2 = bji - bjk;
+ ajo = a[jo + j];
+ ajl = ajo;
+ bjl = b[jl + j];
+ u1 = bjg + bjl;
+ u3 = ss * (bjg - bjl);
+ b[ji + j] = bjc;
+ a[jc + j] = t0 + t1;
+ a[jk + j] = t0 - t1;
+ bjo = b[jo + j];
+ bjl = bjo;
+ b[jc + j] = u0 + u1;
+ b[jk + j] = u0 - u1;
+ a[jg + j] = t2 - u3;
+ a[jo + j] = t2 + u3;
+ b[jg + j] = u2 + t3;
+ b[jo + j] = u2 - t3;
+/* ---------------------- */
+ ajm = a[jm + j];
+ t0 = ajm + ajl;
+ t2 = ajm - ajl;
+ ajn = a[jn + j];
+ ajp = a[jp + j];
+ t1 = ajn + ajp;
+ t3 = ss * (ajn - ajp);
+ a[jm + j] = ajd;
+ u0 = bjd + bjl;
+ u2 = bjd - bjl;
+ bjn = b[jn + j];
+ bjp = b[jp + j];
+ u1 = bjn + bjp;
+ u3 = ss * (bjn - bjp);
+ a[jn + j] = ajh;
+ a[jd + j] = t0 + t1;
+ a[jl + j] = t0 - t1;
+ b[jd + j] = u0 + u1;
+ b[jl + j] = u0 - u1;
+ b[jn + j] = bjh;
+ a[jh + j] = t2 - u3;
+ a[jp + j] = t2 + u3;
+ b[jh + j] = u2 + t3;
+ b[jp + j] = u2 - t3;
+ j += *jump;
+ }
+/* -----( end of loop across transforms ) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+/* -----( end of double loop for k=0 ) */
+
+/* finished if last pass */
+/* --------------------- */
+ if (ipass == m-1) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__6 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__6 : k <= i__6; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+
+/* double loop along first transform in block */
+/* ------------------------------------------ */
+ i__5 = (la - 1) * ink;
+ i__4 = jstep << 2;
+ for (ll = k; i__4 < 0 ? ll >= i__5 : ll <= i__5; ll += i__4) {
+
+ i__7 = (*n - 1) * *inc;
+ i__8 = (la << 2) * ink;
+ for (jjj = ll; i__8 < 0 ? jjj >= i__7 : jjj <= i__7; jjj += i__8) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = ja + laincl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = je + laincl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jj + jstepl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = ji + laincl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jo + jstepl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ aji = a[ji + j];
+ ajc = aji;
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ aje = a[je + j];
+ ajb = aje;
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[je + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ bjb = si1 * (t2 - u3) + co1 * (u2 + t3);
+ bjm = b[jm + j];
+ bjd = bjm;
+ a[ji + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ bjc = si2 * (t0 - t1) + co2 * (u0 - u1);
+ ajd = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jm + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+/* ---------------------------------------- */
+ ajg = a[jg + j];
+ t0 = ajb + ajg;
+ t2 = ajb - ajg;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf + ajh;
+ t3 = ss * (ajf - ajh);
+ ajj = a[jj + j];
+ ajg = ajj;
+ bje = b[je + j];
+ bjg = b[jg + j];
+ u0 = bje + bjg;
+ u2 = bje - bjg;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf + bjh;
+ u3 = ss * (bjf - bjh);
+ b[je + j] = bjb;
+ a[jb + j] = t0 + t1;
+ b[jb + j] = u0 + u1;
+ bjj = b[jj + j];
+ bjg = bjj;
+ a[jf + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jf + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jj + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jj + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ ajh = co3 * (t2 + u3) - si3 * (u2 - t3);
+ bjh = si3 * (t2 + u3) + co3 * (u2 - t3);
+/* ---------------------------------------- */
+ ajk = a[jk + j];
+ t0 = ajc + ajk;
+ t2 = ajc - ajk;
+ ajl = a[jl + j];
+ t1 = ajg + ajl;
+ t3 = ss * (ajg - ajl);
+ bji = b[ji + j];
+ bjk = b[jk + j];
+ u0 = bji + bjk;
+ u2 = bji - bjk;
+ ajo = a[jo + j];
+ ajl = ajo;
+ bjl = b[jl + j];
+ u1 = bjg + bjl;
+ u3 = ss * (bjg - bjl);
+ b[ji + j] = bjc;
+ a[jc + j] = t0 + t1;
+ b[jc + j] = u0 + u1;
+ bjo = b[jo + j];
+ bjl = bjo;
+ a[jg + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jg + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jk + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jk + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jo + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jo + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+/* ---------------------------------------- */
+ ajm = a[jm + j];
+ t0 = ajm + ajl;
+ t2 = ajm - ajl;
+ ajn = a[jn + j];
+ ajp = a[jp + j];
+ t1 = ajn + ajp;
+ t3 = ss * (ajn - ajp);
+ a[jm + j] = ajd;
+ u0 = bjd + bjl;
+ u2 = bjd - bjl;
+ a[jn + j] = ajh;
+ bjn = b[jn + j];
+ bjp = b[jp + j];
+ u1 = bjn + bjp;
+ u3 = ss * (bjn - bjp);
+ b[jn + j] = bjh;
+ a[jd + j] = t0 + t1;
+ b[jd + j] = u0 + u1;
+ a[jh + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jh + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jl + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jl + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jp + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jp + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+ j += *jump;
+ }
+/* -----(end of loop across transforms) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+/* -----( end of double loop for this k ) */
+ kk += la << 1;
+ }
+/* -----( end of loop over values of k ) */
+ la <<= 2;
+ }
+/* -----( end of loop on type II radix-4 passes ) */
+/* -----( nvex transforms completed) */
+L490:
+ istart += nvex * *jump;
+ }
+/* -----( end of loop on blocks of transforms ) */
+} /* dgpfa2f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa3f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa3f.c
new file mode 100644
index 0000000000000000000000000000000000000000..13e06c5bd4b3f7cb54a05f8070eb029961219a5f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa3f.c
@@ -0,0 +1,506 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__3 = 3;
+
+/* fortran version of *dgpfa3* - */
+/* radix-3 section of self-sorting, in-place */
+/* generalized PFA */
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void dgpfa3f_(doublereal *a, doublereal *b, const doublereal *trigs,
+ const integer *inc, const integer *jump, const integer *n, const integer *mm, const integer *lot,
+ const integer *isign)
+{
+ /* Initialized data */
+ static doublereal sin60 = .866025403784437;
+ static integer lvr = 128;
+
+ /* System generated locals */
+ integer i__3, i__4, i__5, i__6, i__7, i__8;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static doublereal s;
+ static integer ipass, nblox;
+ static doublereal c1;
+ static integer jstep, n3;
+ static doublereal t1, t2, t3, u1, u2, u3;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, la, nb, mh, kk, ll, mu, nu, laincl, jstepl;
+ static doublereal co1, co2;
+ static integer istart, jstepx;
+ static doublereal si1, si2, aja, ajb, ajc, bjb, bjc, bja, ajd, bjd, aje,
+ ajf, ajh, bje, bjf, bjh, aji, ajg, bji;
+ static integer jjj;
+ static doublereal bjg;
+ static integer ink, inq;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n3 = pow_ii(&c__3, mm);
+ inq = *n / n3;
+ jstepx = (n3 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+ mu = inq % 3;
+ if (*isign == -1) {
+ mu = 3 - mu;
+ }
+ m = *mm;
+ mh = (m + 1) / 2;
+ s = (doublereal) (*isign);
+ c1 = sin60;
+ if (mu == 2) {
+ c1 = -c1;
+ }
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (doublereal) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+/* -------------------------------- */
+ for (nb = 1; nb <= nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-3 passes */
+/* ----------------------------- */
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la * 3);
+ jstepl = jstep - ninc;
+
+/* k = 0 loop (no twiddle factors) */
+/* ------------------------------- */
+ i__3 = (*n - 1) * *inc;
+ i__4 = jstep * 3;
+ for (jjj = 0; i__4 < 0 ? jjj >= i__3 : jjj <= i__3; jjj += i__4) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5;
+ t3 = c1 * (ajb - ajc);
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5;
+ u3 = c1 * (bjb - bjc);
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jb + j] = t2 - u3;
+ b[jb + j] = u2 + t3;
+ a[jc + j] = t2 + u3;
+ b[jc + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n3 = 3 */
+/* ------------------ */
+ if (n3 == 3) {
+ goto L490;
+ }
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__4 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[(kk << 1) + 1];
+
+/* loop along transform */
+/* -------------------- */
+ i__5 = (*n - 1) * *inc;
+ i__6 = jstep * 3;
+ for (jjj = k; i__6 < 0 ? jjj >= i__5 : jjj <= i__5; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep,shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5;
+ t3 = c1 * (ajb - ajc);
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5;
+ u3 = c1 * (bjb - bjc);
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jb + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jb + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jc + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[jc + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+ j += *jump;
+ }
+/* -----( end of loop across transforms ) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+/* -----( end of loop along transforms ) */
+ kk += la << 1;
+ }
+/* -----( end of loop on nonzero k ) */
+ la *= 3;
+ }
+/* -----( end of loop on type I radix-3 passes) */
+
+/* loop on type II radix-3 passes */
+/* ------------------------------ */
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la * 3);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+
+/* k=0 loop (no twiddle factors) */
+/* ----------------------------- */
+ i__3 = (la - 1) * ink;
+ i__4 = jstep * 3;
+ for (ll = 0; i__4 < 0 ? ll >= i__3 : ll <= i__3; ll += i__4) {
+
+ i__6 = (*n - 1) * *inc;
+ i__5 = la * 3 * ink;
+ for (jjj = ll; i__5 < 0 ? jjj >= i__6 : jjj <= i__6; jjj += i__5) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = ja + laincl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jd + laincl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5;
+ t3 = c1 * (ajb - ajc);
+ ajd = a[jd + j];
+ ajb = ajd;
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5;
+ u3 = c1 * (bjb - bjc);
+ bjd = b[jd + j];
+ bjb = bjd;
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jd + j] = t2 - u3;
+ b[jd + j] = u2 + t3;
+ ajc = t2 + u3;
+ bjc = u2 - t3;
+/* ---------------------- */
+ aje = a[je + j];
+ ajf = a[jf + j];
+ t1 = aje + ajf;
+ t2 = ajb - t1 * .5;
+ t3 = c1 * (aje - ajf);
+ ajh = a[jh + j];
+ ajf = ajh;
+ bje = b[je + j];
+ bjf = b[jf + j];
+ u1 = bje + bjf;
+ u2 = bjb - u1 * .5;
+ u3 = c1 * (bje - bjf);
+ bjh = b[jh + j];
+ bjf = bjh;
+ a[jb + j] = ajb + t1;
+ b[jb + j] = bjb + u1;
+ a[je + j] = t2 - u3;
+ b[je + j] = u2 + t3;
+ a[jh + j] = t2 + u3;
+ b[jh + j] = u2 - t3;
+/* ---------------------- */
+ aji = a[ji + j];
+ t1 = ajf + aji;
+ ajg = a[jg + j];
+ t2 = ajg - t1 * .5;
+ t3 = c1 * (ajf - aji);
+ t1 += ajg;
+ a[jg + j] = ajc;
+ bji = b[ji + j];
+ u1 = bjf + bji;
+ bjg = b[jg + j];
+ u2 = bjg - u1 * .5;
+ u3 = c1 * (bjf - bji);
+ u1 += bjg;
+ b[jg + j] = bjc;
+ a[jc + j] = t1;
+ b[jc + j] = u1;
+ a[jf + j] = t2 - u3;
+ b[jf + j] = u2 + t3;
+ a[ji + j] = t2 + u3;
+ b[ji + j] = u2 - t3;
+ j += *jump;
+ }
+/* -----( end of loop across transforms ) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+/* -----( end of double loop for k=0 ) */
+
+/* finished if last pass */
+/* --------------------- */
+ if (ipass == m-1) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__4 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+
+/* double loop along first transform in block */
+/* ------------------------------------------ */
+ i__5 = (la - 1) * ink;
+ i__6 = jstep * 3;
+ for (ll = k; i__6 < 0 ? ll >= i__5 : ll <= i__5; ll += i__6) {
+
+ i__7 = (*n - 1) * *inc;
+ i__8 = la * 3 * ink;
+ for (jjj = ll; i__8 < 0 ? jjj >= i__7 : jjj <= i__7; jjj += i__8) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = ja + laincl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jd + laincl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5;
+ t3 = c1 * (ajb - ajc);
+ ajd = a[jd + j];
+ ajb = ajd;
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5;
+ u3 = c1 * (bjb - bjc);
+ bjd = b[jd + j];
+ bjb = bjd;
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jd + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jd + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ ajc = co2 * (t2 + u3) - si2 * (u2 - t3);
+ bjc = si2 * (t2 + u3) + co2 * (u2 - t3);
+/* ---------------------- */
+ aje = a[je + j];
+ ajf = a[jf + j];
+ t1 = aje + ajf;
+ t2 = ajb - t1 * .5;
+ t3 = c1 * (aje - ajf);
+ ajh = a[jh + j];
+ ajf = ajh;
+ bje = b[je + j];
+ bjf = b[jf + j];
+ u1 = bje + bjf;
+ u2 = bjb - u1 * .5;
+ u3 = c1 * (bje - bjf);
+ bjh = b[jh + j];
+ bjf = bjh;
+ a[jb + j] = ajb + t1;
+ b[jb + j] = bjb + u1;
+ a[je + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[je + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jh + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[jh + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+/* ---------------------- */
+ aji = a[ji + j];
+ t1 = ajf + aji;
+ ajg = a[jg + j];
+ t2 = ajg - t1 * .5;
+ t3 = c1 * (ajf - aji);
+ t1 += ajg;
+ a[jg + j] = ajc;
+ bji = b[ji + j];
+ u1 = bjf + bji;
+ bjg = b[jg + j];
+ u2 = bjg - u1 * .5;
+ u3 = c1 * (bjf - bji);
+ u1 += bjg;
+ b[jg + j] = bjc;
+ a[jc + j] = t1;
+ b[jc + j] = u1;
+ a[jf + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jf + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[ji + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[ji + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+ j += *jump;
+ }
+/* -----(end of loop across transforms) */
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+/* -----( end of double loop for this k ) */
+ kk += la << 1;
+ }
+/* -----( end of loop over values of k ) */
+ la *= 3;
+ }
+/* -----( end of loop on type II radix-3 passes ) */
+/* -----( nvex transforms completed) */
+L490:
+ istart += nvex * *jump;
+ }
+/* -----( end of loop on blocks of transforms ) */
+
+} /* dgpfa3f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa5f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa5f.c
new file mode 100644
index 0000000000000000000000000000000000000000..2a04376349ffbdd57341b518e3f777979c2491fe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dgpfa5f.c
@@ -0,0 +1,922 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__5 = 5;
+
+/* fortran version of *dgpfa5* - */
+/* radix-5 section of self-sorting, in-place, */
+/* generalized pfa */
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void dgpfa5f_(doublereal *a, doublereal *b, const doublereal *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *mm, const integer *lot, const integer *isign)
+{
+ /* Initialized data */
+ static doublereal sin36 = .587785252292473;
+ static doublereal sin72 = .951056516295154;
+ static doublereal qrt5 = .559016994374947;
+ static integer lvr = 128;
+
+ /* System generated locals */
+ integer i__3, i__4, i__5, i__6, i__7, i__8;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static doublereal s;
+ static integer ipass, nblox;
+ static doublereal c1, c2, c3;
+ static integer jstep, n5;
+ static doublereal t1, t2, t3, t4, t5, t6, t7, t8, t9, u1, u2, u3, u4, u5, u6, u7, u8, u9;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, jj, jk, jl, jm, jn, jo, jp, jq, jr, js, jt, ju, jv, jw, jx, jy;
+ static doublereal t10, t11, u10, u11;
+ static integer la, nb, mh, kk, ll, mu, nu, laincl;
+ static doublereal ax, bx;
+ static integer jstepl;
+ static doublereal co1, co2, co3;
+ static integer istart;
+ static doublereal co4;
+ static integer jstepx;
+ static doublereal si1, si2, si3, si4, aja, ajb, ajc, ajd, aje, bjb, bje, bjc, bjd, bja, ajf, ajk, bjf, bjk, ajg, ajj, ajh;
+ static integer jjj;
+ static doublereal aji, ajl;
+ static integer ink;
+ static doublereal ajq, bjg, bjj, bjh, bji;
+ static integer inq;
+ static doublereal bjl, bjq, ajo, ajm, ajn, ajr, ajw, bjo, bjm, bjn, bjr,
+ bjw, ajt, ajs, ajx, ajp, bjt, bjs, bjx, bjp, ajv, ajy, aju, bjv,
+ bjy, bju;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n5 = pow_ii(&c__5, mm);
+ inq = *n / n5;
+ jstepx = (n5 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+ mu = inq % 5;
+ if (*isign == -1) {
+ mu = 5 - mu;
+ }
+
+ m = *mm;
+ mh = (m + 1) / 2;
+ s = (doublereal) (*isign);
+ c1 = qrt5;
+ c2 = sin72;
+ c3 = sin36;
+ if (mu == 2 || mu == 3) {
+ c1 = -c1;
+ c2 = sin36;
+ c3 = sin72;
+ }
+ if (mu == 3 || mu == 4) {
+ c2 = -c2;
+ }
+ if (mu == 2 || mu == 4) {
+ c3 = -c3;
+ }
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (doublereal) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+/* -------------------------------- */
+ for (nb = 1; nb <= nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-5 passes */
+/* ----------------------------- */
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la * 5);
+ jstepl = jstep - ninc;
+ kk = 0;
+
+/* loop on k */
+/* --------- */
+ i__3 = jstep - ink;
+ for (k = 0; ink < 0 ? k >= i__3 : k <= i__3; k += ink) {
+
+ if (k > 0) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ }
+
+/* loop along transform */
+/* -------------------- */
+ i__5 = (*n - 1) * *inc;
+ i__6 = jstep * 5;
+ for (jjj = k; i__6 < 0 ? jjj >= i__5 : jjj <= i__5; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+ if (k == 0) {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jb + j] = t8 - u11;
+ b[jb + j] = u8 + t11;
+ a[je + j] = t8 + u11;
+ b[je + j] = u8 - t11;
+ a[jc + j] = t9 - u10;
+ b[jc + j] = u9 + t10;
+ a[jd + j] = t9 + u10;
+ b[jd + j] = u9 - t10;
+ j += *jump;
+ }
+
+ } else {
+
+/* dir$ ivdep,shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jb + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jb + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[je + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[je + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jc + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jc + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jd + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jd + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+ j += *jump;
+ }
+ }
+/* -----( end of loop across transforms ) */
+
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+/* -----( end of loop along transforms ) */
+ kk += la << 1;
+ }
+/* -----( end of loop on nonzero k ) */
+ la *= 5;
+ }
+/* -----( end of loop on type I radix-5 passes) */
+
+ if (*n == 5) {
+ goto L490;
+ }
+
+/* loop on type II radix-5 passes */
+/* ------------------------------ */
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la * 5);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+ kk = 0;
+
+/* loop on k */
+/* --------- */
+ i__4 = jstep - ink;
+ for (k = 0; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+
+ if (k > 0) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ }
+
+/* double loop along first transform in block */
+/* ------------------------------------------ */
+ i__6 = (la - 1) * ink;
+ i__5 = jstep * 5;
+ for (ll = k; i__5 < 0 ? ll >= i__6 : ll <= i__6; ll += i__5) {
+
+ i__7 = (*n - 1) * *inc;
+ i__8 = la * 5 * ink;
+ for (jjj = ll; i__8 < 0 ? jjj >= i__7 : jjj <= i__7; jjj += i__8) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = ja + laincl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jf + laincl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = jl + jstepl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jk + laincl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ jq = jp + jstepl;
+ if (jq < istart) {
+ jq += ninc;
+ }
+ jr = jq + jstepl;
+ if (jr < istart) {
+ jr += ninc;
+ }
+ js = jr + jstepl;
+ if (js < istart) {
+ js += ninc;
+ }
+ jt = js + jstepl;
+ if (jt < istart) {
+ jt += ninc;
+ }
+ ju = jp + laincl;
+ if (ju < istart) {
+ ju += ninc;
+ }
+ jv = ju + jstepl;
+ if (jv < istart) {
+ jv += ninc;
+ }
+ jw = jv + jstepl;
+ if (jw < istart) {
+ jw += ninc;
+ }
+ jx = jw + jstepl;
+ if (jx < istart) {
+ jx += ninc;
+ }
+ jy = jx + jstepl;
+ if (jy < istart) {
+ jy += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+ if (k == 0) {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ ajf = a[jf + j];
+ ajb = ajf;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajk = a[jk + j];
+ ajc = ajk;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ bjf = b[jf + j];
+ bjb = bjf;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjk = b[jk + j];
+ bjc = bjk;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jf + j] = t8 - u11;
+ b[jf + j] = u8 + t11;
+ aje = t8 + u11;
+ bje = u8 - t11;
+ a[jk + j] = t9 - u10;
+ b[jk + j] = u9 + t10;
+ ajd = t9 + u10;
+ bjd = u9 - t10;
+/* ---------------------- */
+ ajg = a[jg + j];
+ ajj = a[jj + j];
+ t1 = ajg + ajj;
+ ajh = a[jh + j];
+ aji = a[ji + j];
+ t2 = ajh + aji;
+ t3 = ajg - ajj;
+ t4 = ajh - aji;
+ ajl = a[jl + j];
+ ajh = ajl;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajb - t5 * .25;
+ a[jb + j] = ajb + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajq = a[jq + j];
+ aji = ajq;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjg = b[jg + j];
+ bjj = b[jj + j];
+ u1 = bjg + bjj;
+ bjh = b[jh + j];
+ bji = b[ji + j];
+ u2 = bjh + bji;
+ u3 = bjg - bjj;
+ u4 = bjh - bji;
+ bjl = b[jl + j];
+ bjh = bjl;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjb - u5 * .25;
+ b[jb + j] = bjb + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjq = b[jq + j];
+ bji = bjq;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jg + j] = t8 - u11;
+ b[jg + j] = u8 + t11;
+ ajj = t8 + u11;
+ bjj = u8 - t11;
+ a[jl + j] = t9 - u10;
+ b[jl + j] = u9 + t10;
+ a[jq + j] = t9 + u10;
+ b[jq + j] = u9 - t10;
+/* ---------------------- */
+ ajo = a[jo + j];
+ t1 = ajh + ajo;
+ ajm = a[jm + j];
+ ajn = a[jn + j];
+ t2 = ajm + ajn;
+ t3 = ajh - ajo;
+ t4 = ajm - ajn;
+ ajr = a[jr + j];
+ ajn = ajr;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajc - t5 * .25;
+ a[jc + j] = ajc + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajw = a[jw + j];
+ ajo = ajw;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjo = b[jo + j];
+ u1 = bjh + bjo;
+ bjm = b[jm + j];
+ bjn = b[jn + j];
+ u2 = bjm + bjn;
+ u3 = bjh - bjo;
+ u4 = bjm - bjn;
+ bjr = b[jr + j];
+ bjn = bjr;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjc - u5 * .25;
+ b[jc + j] = bjc + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjw = b[jw + j];
+ bjo = bjw;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jh + j] = t8 - u11;
+ b[jh + j] = u8 + t11;
+ a[jw + j] = t8 + u11;
+ b[jw + j] = u8 - t11;
+ a[jm + j] = t9 - u10;
+ b[jm + j] = u9 + t10;
+ a[jr + j] = t9 + u10;
+ b[jr + j] = u9 - t10;
+/* ---------------------- */
+ ajt = a[jt + j];
+ t1 = aji + ajt;
+ ajs = a[js + j];
+ t2 = ajn + ajs;
+ t3 = aji - ajt;
+ t4 = ajn - ajs;
+ ajx = a[jx + j];
+ ajt = ajx;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ ajp = a[jp + j];
+ t7 = ajp - t5 * .25;
+ ax = ajp + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[jp + j] = ajd;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[jd + j] = ax;
+ bjt = b[jt + j];
+ u1 = bji + bjt;
+ bjs = b[js + j];
+ u2 = bjn + bjs;
+ u3 = bji - bjt;
+ u4 = bjn - bjs;
+ bjx = b[jx + j];
+ bjt = bjx;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bjp = b[jp + j];
+ u7 = bjp - u5 * .25;
+ bx = bjp + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[jp + j] = bjd;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[jd + j] = bx;
+ a[ji + j] = t8 - u11;
+ b[ji + j] = u8 + t11;
+ a[jx + j] = t8 + u11;
+ b[jx + j] = u8 - t11;
+ a[jn + j] = t9 - u10;
+ b[jn + j] = u9 + t10;
+ a[js + j] = t9 + u10;
+ b[js + j] = u9 - t10;
+/* ---------------------- */
+ ajv = a[jv + j];
+ ajy = a[jy + j];
+ t1 = ajv + ajy;
+ t2 = ajo + ajt;
+ t3 = ajv - ajy;
+ t4 = ajo - ajt;
+ a[jv + j] = ajj;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aju = a[ju + j];
+ t7 = aju - t5 * .25;
+ ax = aju + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[ju + j] = aje;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[je + j] = ax;
+ bjv = b[jv + j];
+ bjy = b[jy + j];
+ u1 = bjv + bjy;
+ u2 = bjo + bjt;
+ u3 = bjv - bjy;
+ u4 = bjo - bjt;
+ b[jv + j] = bjj;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bju = b[ju + j];
+ u7 = bju - u5 * .25;
+ bx = bju + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[ju + j] = bje;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[je + j] = bx;
+ a[jj + j] = t8 - u11;
+ b[jj + j] = u8 + t11;
+ a[jy + j] = t8 + u11;
+ b[jy + j] = u8 - t11;
+ a[jo + j] = t9 - u10;
+ b[jo + j] = u9 + t10;
+ a[jt + j] = t9 + u10;
+ b[jt + j] = u9 - t10;
+ j += *jump;
+ }
+
+ } else {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ ajf = a[jf + j];
+ ajb = ajf;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajk = a[jk + j];
+ ajc = ajk;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ bjf = b[jf + j];
+ bjb = bjf;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjk = b[jk + j];
+ bjc = bjk;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jf + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jf + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ aje = co4 * (t8 + u11) - si4 * (u8 - t11);
+ bje = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jk + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jk + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ ajd = co3 * (t9 + u10) - si3 * (u9 - t10);
+ bjd = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajg = a[jg + j];
+ ajj = a[jj + j];
+ t1 = ajg + ajj;
+ ajh = a[jh + j];
+ aji = a[ji + j];
+ t2 = ajh + aji;
+ t3 = ajg - ajj;
+ t4 = ajh - aji;
+ ajl = a[jl + j];
+ ajh = ajl;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajb - t5 * .25;
+ a[jb + j] = ajb + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajq = a[jq + j];
+ aji = ajq;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjg = b[jg + j];
+ bjj = b[jj + j];
+ u1 = bjg + bjj;
+ bjh = b[jh + j];
+ bji = b[ji + j];
+ u2 = bjh + bji;
+ u3 = bjg - bjj;
+ u4 = bjh - bji;
+ bjl = b[jl + j];
+ bjh = bjl;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjb - u5 * .25;
+ b[jb + j] = bjb + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjq = b[jq + j];
+ bji = bjq;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jg + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jg + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ ajj = co4 * (t8 + u11) - si4 * (u8 - t11);
+ bjj = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jl + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jl + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jq + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jq + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajo = a[jo + j];
+ t1 = ajh + ajo;
+ ajm = a[jm + j];
+ ajn = a[jn + j];
+ t2 = ajm + ajn;
+ t3 = ajh - ajo;
+ t4 = ajm - ajn;
+ ajr = a[jr + j];
+ ajn = ajr;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajc - t5 * .25;
+ a[jc + j] = ajc + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajw = a[jw + j];
+ ajo = ajw;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjo = b[jo + j];
+ u1 = bjh + bjo;
+ bjm = b[jm + j];
+ bjn = b[jn + j];
+ u2 = bjm + bjn;
+ u3 = bjh - bjo;
+ u4 = bjm - bjn;
+ bjr = b[jr + j];
+ bjn = bjr;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjc - u5 * .25;
+ b[jc + j] = bjc + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjw = b[jw + j];
+ bjo = bjw;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jh + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jh + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jw + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jw + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jm + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jm + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jr + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jr + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajt = a[jt + j];
+ t1 = aji + ajt;
+ ajs = a[js + j];
+ t2 = ajn + ajs;
+ t3 = aji - ajt;
+ t4 = ajn - ajs;
+ ajx = a[jx + j];
+ ajt = ajx;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ ajp = a[jp + j];
+ t7 = ajp - t5 * .25;
+ ax = ajp + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[jp + j] = ajd;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[jd + j] = ax;
+ bjt = b[jt + j];
+ u1 = bji + bjt;
+ bjs = b[js + j];
+ u2 = bjn + bjs;
+ u3 = bji - bjt;
+ u4 = bjn - bjs;
+ bjx = b[jx + j];
+ bjt = bjx;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bjp = b[jp + j];
+ u7 = bjp - u5 * .25;
+ bx = bjp + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[jp + j] = bjd;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[jd + j] = bx;
+ a[ji + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[ji + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jx + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jx + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jn + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jn + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[js + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[js + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajv = a[jv + j];
+ ajy = a[jy + j];
+ t1 = ajv + ajy;
+ t2 = ajo + ajt;
+ t3 = ajv - ajy;
+ t4 = ajo - ajt;
+ a[jv + j] = ajj;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aju = a[ju + j];
+ t7 = aju - t5 * .25;
+ ax = aju + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[ju + j] = aje;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[je + j] = ax;
+ bjv = b[jv + j];
+ bjy = b[jy + j];
+ u1 = bjv + bjy;
+ u2 = bjo + bjt;
+ u3 = bjv - bjy;
+ u4 = bjo - bjt;
+ b[jv + j] = bjj;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bju = b[ju + j];
+ u7 = bju - u5 * .25;
+ bx = bju + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[ju + j] = bje;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[je + j] = bx;
+ a[jj + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jj + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jy + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jy + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jo + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jo + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jt + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jt + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+ j += *jump;
+ }
+ }
+
+/* -----(end of loop across transforms) */
+
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+/* -----( end of double loop for this k ) */
+ kk += la << 1;
+ }
+/* -----( end of loop over values of k ) */
+ la *= 5;
+ }
+/* -----( end of loop on type II radix-5 passes ) */
+/* -----( nvex transforms completed) */
+L490:
+ istart += nvex * *jump;
+ }
+/* -----( end of loop on blocks of transforms ) */
+} /* dgpfa5f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.c
new file mode 100644
index 0000000000000000000000000000000000000000..9f7fb1cdc69cdb6877a12fcd92f96ec6fa9f27dc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.c
@@ -0,0 +1,1160 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublereal c_b12 = 0.;
+static doublereal c_b13 = 1.;
+static integer c__1 = 1;
+static integer c__3 = 3;
+
+/* Subroutine */ void dhgeqz_(job, compq, compz, n, ilo, ihi, a, lda, b, ldb,
+ alphar, alphai, beta, q, ldq, z, ldz, work, lwork, info)
+const char *job, *compq, *compz;
+integer *n, *ilo, *ihi;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *alphar, *alphai, *beta, *q;
+integer *ldq;
+doublereal *z;
+integer *ldz;
+doublereal *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal ad11l, ad12l, ad21l, ad22l, ad32l, wabs, atol, btol, temp;
+ static doublereal temp2, s1inv, c;
+ static integer j;
+ static doublereal s, t, v[3], scale;
+ static integer iiter, ilast, jiter;
+ static doublereal anorm, bnorm;
+ static integer maxit;
+ static doublereal tempi, tempr, s1, s2, u1, u2;
+ static logical ilazr2;
+ static doublereal a11, a12, a21, a22, b11, b22, c12, c21;
+ static integer jc;
+ static doublereal an, bn, cl, cq, cr;
+ static integer in;
+ static doublereal ascale, bscale, u12, w11;
+ static integer jr;
+ static doublereal cz, sl, w12, w21, w22, wi;
+ static doublereal sr;
+ static doublereal vs, wr;
+ static doublereal safmin;
+ static doublereal safmax;
+ static doublereal eshift;
+ static logical ilschr;
+ static doublereal b1a, b2a;
+ static integer icompq, ilastm;
+ static doublereal a1i;
+ static integer ischur;
+ static doublereal a2i, b1i;
+ static logical ilazro;
+ static integer icompz, ifirst;
+ static doublereal b2i;
+ static integer ifrstm;
+ static doublereal a1r;
+ static integer istart;
+ static logical ilpivt;
+ static doublereal a2r, b1r, b2r;
+ static logical lquery;
+ static doublereal wr2, ad11, ad12, ad21, ad22, c11i, c22i;
+ static integer jch;
+ static doublereal c11r, c22r, u12l;
+ static logical ilq;
+ static doublereal tau, sqi;
+ static logical ilz;
+ static doublereal ulp, sqr, szi, szr;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DHGEQZ implements a single-/double-shift version of the QZ method for */
+/* finding the generalized eigenvalues */
+/* */
+/* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation */
+/* */
+/* det( A - w(i) B ) = 0 */
+/* */
+/* In addition, the pair A,B may be reduced to generalized Schur form: */
+/* B is upper triangular, and A is block upper triangular, where the */
+/* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having */
+/* complex generalized eigenvalues (see the description of the argument */
+/* JOB.) */
+/* */
+/* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur */
+/* form by applying one orthogonal transformation (usually called Q) on */
+/* the left and another (usually called Z) on the right. The 2-by-2 */
+/* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks */
+/* of A will be reduced to positive diagonal matrices. (I.e., */
+/* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and */
+/* B(j+1,j+1) will be positive.) */
+/* */
+/* If JOB='E', then at each iteration, the same transformations */
+/* are computed, but they are only applied to those parts of A and B */
+/* which are needed to compute ALPHAR, ALPHAI, and BETAR. */
+/* */
+/* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal */
+/* transformations used to reduce (A,B) are accumulated into the arrays */
+/* Q and Z s.t.: */
+/* */
+/* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)* */
+/* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)* */
+/* */
+/* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix */
+/* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973), */
+/* pp. 241--256. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOB (input) CHARACTER*1 */
+/* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will */
+/* not necessarily be put into generalized Schur form. */
+/* = 'S': put A and B into generalized Schur form, as well */
+/* as computing ALPHAR, ALPHAI, and BETA. */
+/* */
+/* COMPQ (input) CHARACTER*1 */
+/* = 'N': do not modify Q. */
+/* = 'V': multiply the array Q on the right by the transpose of */
+/* the orthogonal transformation that is applied to the */
+/* left side of A and B to reduce them to Schur form. */
+/* = 'I': like COMPQ='V', except that Q will be initialized to */
+/* the identity first. */
+/* */
+/* COMPZ (input) CHARACTER*1 */
+/* = 'N': do not modify Z. */
+/* = 'V': multiply the array Z on the right by the orthogonal */
+/* transformation that is applied to the right side of */
+/* A and B to reduce them to Schur form. */
+/* = 'I': like COMPZ='V', except that Z will be initialized to */
+/* the identity first. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrices A, B, Q, and Z. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that A is already upper triangular in rows and */
+/* columns 1:ILO-1 and IHI+1:N. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
+/* On entry, the N-by-N upper Hessenberg matrix A. Elements */
+/* below the subdiagonal must be zero. */
+/* If JOB='S', then on exit A and B will have been */
+/* simultaneously reduced to generalized Schur form. */
+/* If JOB='E', then on exit A will have been destroyed. */
+/* The diagonal blocks will be correct, but the off-diagonal */
+/* portion will be meaningless. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max( 1, N ). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB, N) */
+/* On entry, the N-by-N upper triangular matrix B. Elements */
+/* below the diagonal must be zero. 2-by-2 blocks in B */
+/* corresponding to 2-by-2 blocks in A will be reduced to */
+/* positive diagonal form. (I.e., if A(j+1,j) is non-zero, */
+/* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be */
+/* positive.) */
+/* If JOB='S', then on exit A and B will have been */
+/* simultaneously reduced to Schur form. */
+/* If JOB='E', then on exit B will have been destroyed. */
+/* Elements corresponding to diagonal blocks of A will be */
+/* correct, but the off-diagonal portion will be meaningless. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max( 1, N ). */
+/* */
+/* ALPHAR (output) DOUBLE PRECISION array, dimension (N) */
+/* ALPHAR(1:N) will be set to real parts of the diagonal */
+/* elements of A that would result from reducing A and B to */
+/* Schur form and then further reducing them both to triangular */
+/* form using unitary transformations s.t. the diagonal of B */
+/* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block */
+/* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j). */
+/* Note that the (real or complex) values */
+/* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the */
+/* generalized eigenvalues of the matrix pencil A - wB. */
+/* */
+/* ALPHAI (output) DOUBLE PRECISION array, dimension (N) */
+/* ALPHAI(1:N) will be set to imaginary parts of the diagonal */
+/* elements of A that would result from reducing A and B to */
+/* Schur form and then further reducing them both to triangular */
+/* form using unitary transformations s.t. the diagonal of B */
+/* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block */
+/* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0. */
+/* Note that the (real or complex) values */
+/* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the */
+/* generalized eigenvalues of the matrix pencil A - wB. */
+/* */
+/* BETA (output) DOUBLE PRECISION array, dimension (N) */
+/* BETA(1:N) will be set to the (real) diagonal elements of B */
+/* that would result from reducing A and B to Schur form and */
+/* then further reducing them both to triangular form using */
+/* unitary transformations s.t. the diagonal of B was */
+/* non-negative real. Thus, if A(j,j) is in a 1-by-1 block */
+/* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j). */
+/* Note that the (real or complex) values */
+/* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the */
+/* generalized eigenvalues of the matrix pencil A - wB. */
+/* (Note that BETA(1:N) will always be non-negative, and no */
+/* BETAI is necessary.) */
+/* */
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N) */
+/* If COMPQ='N', then Q will not be referenced. */
+/* If COMPQ='V' or 'I', then the transpose of the orthogonal */
+/* transformations which are applied to A and B on the left */
+/* will be applied to the array Q on the right. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= 1. */
+/* If COMPQ='V' or 'I', then LDQ >= N. */
+/* */
+/* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N) */
+/* If COMPZ='N', then Z will not be referenced. */
+/* If COMPZ='V' or 'I', then the orthogonal transformations */
+/* which are applied to A and B on the right will be applied */
+/* to the array Z on the right. */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDZ >= 1. */
+/* If COMPZ='V' or 'I', then LDZ >= N. */
+/* */
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO >= 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* */
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* = 1,...,N: the QZ iteration did not converge. (A,B) is not */
+/* in Schur form, but ALPHAR(i), ALPHAI(i), and */
+/* BETA(i), i=INFO+1,...,N should be correct. */
+/* = N+1,...,2*N: the shift calculation failed. (A,B) is not */
+/* in Schur form, but ALPHAR(i), ALPHAI(i), and */
+/* BETA(i), i=INFO-N+1,...,N should be correct. */
+/* > 2*N: various "impossible" errors. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Iteration counters: */
+/* */
+/* JITER -- counts iterations. */
+/* IITER -- counts iterations run since ILAST was last */
+/* changed. This is therefore reset only when a 1-by-1 or */
+/* 2-by-2 block deflates off the bottom. */
+/* */
+/* ===================================================================== */
+
+ /* Decode JOB, COMPQ, COMPZ */
+
+ if (lsame_(job, "E")) ischur = 1, ilschr = FALSE_;
+ else if (lsame_(job, "S")) ischur = 2, ilschr = TRUE_;
+ else ischur = 0;
+
+ if (lsame_(compq, "N")) icompq = 1, ilq = FALSE_;
+ else if (lsame_(compq, "V")) icompq = 2, ilq = TRUE_;
+ else if (lsame_(compq, "I")) icompq = 3, ilq = TRUE_;
+ else icompq = 0;
+
+ if (lsame_(compz, "N")) icompz = 1, ilz = FALSE_;
+ else if (lsame_(compz, "V")) icompz = 2, ilz = TRUE_;
+ else if (lsame_(compz, "I")) icompz = 3, ilz = TRUE_;
+ else icompz = 0;
+
+ /* Check Argument Values */
+
+ *info = 0;
+ *work = (doublereal) max(1,*n);
+ lquery = *lwork == -1;
+ if (ischur == 0) *info = 1;
+ else if (icompq == 0) *info = 2;
+ else if (icompz == 0) *info = 3;
+ else if (*n < 0) *info = 4;
+ else if (*ilo < 1) *info = 5;
+ else if (*ihi > *n || *ihi < *ilo - 1) *info = 6;
+ else if (*lda < *n) *info = 8;
+ else if (*ldb < *n) *info = 10;
+ else if (*ldq < 1 || ( ilq && *ldq < *n) ) *info = 15;
+ else if (*ldz < 1 || ( ilz && *ldz < *n) ) *info = 17;
+ else if (*lwork < max(1,*n) && ! lquery) *info = 19;
+ if (*info != 0) {
+ xerbla_("DHGEQZ", info);
+ *info = -(*info);
+ return;
+ }
+ else if (lquery)
+ return;
+
+ /* Quick return if possible */
+ if (*n <= 0) {
+ *work = 1.;
+ return;
+ }
+
+ /* Initialize Q and Z */
+ if (icompq == 3) dlaset_("Full", n, n, &c_b12, &c_b13, q, ldq);
+ if (icompz == 3) dlaset_("Full", n, n, &c_b12, &c_b13, z, ldz);
+
+ /* Machine Constants */
+ in = *ihi + 1 - *ilo;
+ safmin = dlamch_("S");
+ safmax = 1. / safmin;
+ ulp = dlamch_("E") * dlamch_("B");
+ anorm = dlanhs_("F", &in, &a[(*ilo-1) * (*lda+1)], lda, work);
+ bnorm = dlanhs_("F", &in, &b[(*ilo-1) * (*ldb+1)], ldb, work);
+ atol = max(safmin, ulp*anorm);
+ btol = max(safmin, ulp*bnorm);
+ ascale = 1. / max(safmin,anorm);
+ bscale = 1. / max(safmin,bnorm);
+
+ /* Set Eigenvalues IHI+1:N */
+ for (j = *ihi; j < *n; ++j) {
+ if (b[j + j * *ldb] < 0.) {
+ if (ilschr) {
+ for (jr = 0; jr <= j; ++jr) {
+ a[jr + j * *lda] = -a[jr + j * *lda];
+ b[jr + j * *ldb] = -b[jr + j * *ldb];
+ }
+ }
+ else {
+ a[j + j * *lda] = -a[j + j * *lda];
+ b[j + j * *ldb] = -b[j + j * *ldb];
+ }
+ if (ilz) {
+ for (jr = 0; jr < *n; ++jr)
+ z[jr + j * *ldz] = -z[jr + j * *ldz];
+ }
+ }
+ alphar[j] = a[j + j * *lda];
+ alphai[j] = 0.;
+ beta[j] = b[j + j * *ldb];
+ }
+
+ /* If IHI < ILO, skip QZ steps */
+ if (*ihi < *ilo)
+ goto L380;
+
+ /* MAIN QZ ITERATION LOOP */
+
+ /* Initialize dynamic indices */
+
+ /* Eigenvalues ILAST+1:N have been found. */
+ /* Column operations modify rows IFRSTM:whatever. */
+ /* Row operations modify columns whatever:ILASTM. */
+
+ /* If only eigenvalues are being computed, then */
+ /* IFRSTM is the row of the last splitting row above row ILAST; */
+ /* this is always at least ILO. */
+ /* IITER counts iterations since the last eigenvalue was found, */
+ /* to tell when to use an extraordinary shift. */
+ /* MAXIT is the maximum number of QZ sweeps allowed. */
+
+ ilast = *ihi - 1;
+ if (ilschr) { ifrstm = 1; ilastm = *n; }
+ else { ifrstm = *ilo; ilastm = *ihi; }
+ iiter = 0;
+ eshift = 0.;
+ maxit = (*ihi - *ilo + 1) * 30;
+
+ for (jiter = 1; jiter <= maxit; ++jiter)
+ {
+ /* Split the matrix if possible. */
+
+ /* Two tests: */
+ /* 1: A(j,j-1)=0 or j=ILO */
+ /* 2: B(j,j)=0 */
+
+ if (ilast+1 == *ilo) /* Special case: j=ILAST */
+ goto L80;
+ else if (abs(a[ilast + (ilast-1) * *lda]) <= atol) {
+ a[ilast + (ilast-1) * *lda] = 0.;
+ goto L80;
+ }
+ else if (abs(b[ilast + ilast * *ldb]) <= btol) {
+ b[ilast + ilast * *ldb] = 0.;
+ goto L70;
+ }
+
+ /* General case: j<ILAST */
+ for (j = ilast; j >= *ilo; --j)
+ {
+ /* Test 1: for A(j,j-1)=0 or j=ILO */
+
+ if (j == *ilo)
+ ilazro = TRUE_;
+ else if (abs(a[j-1 + (j-2) * *lda]) <= atol) {
+ a[j-1 + (j-2) * *lda] = 0.;
+ ilazro = TRUE_;
+ }
+ else
+ ilazro = FALSE_;
+
+ /* Test 2: for B(j,j)=0 */
+
+ if (abs(b[j-1 + (j-1) * *ldb]) < btol)
+ {
+ b[j-1 + (j-1) * *ldb] = 0.;
+
+ /* Test 1a: Check for 2 consecutive small subdiagonals in A */
+
+ ilazr2 = FALSE_;
+ if (! ilazro) {
+ temp = abs(a[j-1 + (j-2) * *lda]);
+ temp2 = abs(a[j-1 + (j-1) * *lda]);
+ tempr = max(temp,temp2);
+ if (tempr < 1. && tempr != 0.) {
+ temp /= tempr;
+ temp2 /= tempr;
+ }
+ if (temp * (ascale * abs(a[j + (j-1) * *lda])) <= temp2 * (ascale * atol))
+ ilazr2 = TRUE_;
+ }
+
+ /* If both tests pass (1 & 2), i.e., the leading diagonal */
+ /* element of B in the block is zero, split a 1x1 block off */
+ /* at the top. (I.e., at the J-th row/column) The leading */
+ /* diagonal element of the remainder can also be zero, so */
+ /* this may have to be done repeatedly. */
+
+ if (ilazro || ilazr2)
+ {
+ for (jch = j; jch <= ilast; ++jch) {
+ temp = a[jch-1 + (jch-1) * *lda];
+ dlartg_(&temp, &a[jch + (jch-1) * *lda], &c, &s, &a[jch-1 + (jch-1) * *lda]);
+ a[jch + (jch-1) * *lda] = 0.;
+ i__1 = ilastm - jch;
+ drot_(&i__1, &a[jch-1 + jch * *lda], lda, &a[jch + jch * *lda], lda, &c, &s);
+ drot_(&i__1, &b[jch-1 + jch * *ldb], ldb, &b[jch + jch * *ldb], ldb, &c, &s);
+ if (ilq)
+ drot_(n, &q[(jch-1) * *ldq], &c__1, &q[jch * *ldq], &c__1, &c, &s);
+ if (ilazr2)
+ a[jch-1 + (jch-2) * *lda] *= c;
+ ilazr2 = FALSE_;
+ if (abs(b[jch + jch * *ldb]) >= btol) {
+ if (jch >= ilast)
+ goto L80;
+ else {
+ ifirst = jch + 1;
+ goto L110;
+ }
+ }
+ b[jch + jch * *ldb] = 0.;
+ }
+ goto L70;
+ }
+ else
+ {
+ /* Only test 2 passed -- chase the zero to B(ILAST,ILAST) */
+ /* Then process as in the case B(ILAST,ILAST)=0 */
+
+ for (jch = j; jch <= ilast+1; ++jch)
+ {
+ temp = b[jch-1 + jch * *ldb];
+ dlartg_(&temp, &b[jch + jch * *ldb], &c, &s, &b[jch-1 + jch * *ldb]);
+ b[jch + jch * *ldb] = 0.;
+ if (jch < ilastm - 1) {
+ i__1 = ilastm - jch - 1;
+ drot_(&i__1, &b[jch-1 + (jch+1) * *ldb], ldb, &b[jch + (jch+1) * *ldb], ldb, &c, &s);
+ }
+ i__1 = ilastm - jch + 2;
+ drot_(&i__1, &a[jch-1 + (jch-2) * *lda], lda, &a[jch + (jch-2) * *lda], lda, &c, &s);
+ if (ilq)
+ drot_(n, &q[(jch-1) * *ldq], &c__1, &q[jch * *ldq], &c__1, &c, &s);
+ temp = a[jch + (jch-1) * *lda];
+ dlartg_(&temp, &a[jch + (jch-2) * *lda], &c, &s, &a[jch + (jch-1) * *lda]);
+ a[jch + (jch-2) * *lda] = 0.;
+ i__1 = jch + 1 - ifrstm;
+ drot_(&i__1, &a[ifrstm-1 + (jch-1) * *lda], &c__1, &a[ifrstm-1 + (jch-2) * *lda], &c__1, &c, &s);
+ i__1 = jch - ifrstm;
+ drot_(&i__1, &b[ifrstm-1 + (jch-1) * *ldb], &c__1, &b[ifrstm-1 + (jch-2) * *ldb], &c__1, &c, &s);
+ if (ilz)
+ drot_(n, &z[(jch-1) * *ldz], &c__1, &z[(jch-2) * *ldz], &c__1, &c, &s);
+ }
+ goto L70;
+ }
+ }
+ else if (ilazro)
+ {
+ /* Only test 1 passed -- work on J:ILAST */
+ ifirst = j;
+ goto L110;
+ }
+ /* Neither test passed -- try next J */
+ }
+
+ /* (Drop-through is "impossible") */
+
+ *info = *n + 1;
+ *work = (doublereal) (*n);
+ return;
+
+ /* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a 1x1 block. */
+
+L70:
+ temp = a[ilast + ilast * *lda];
+ dlartg_(&temp, &a[ilast + (ilast-1) * *lda], &c, &s, &a[ilast + ilast * *lda]);
+ a[ilast + (ilast-1) * *lda] = 0.;
+ i__1 = ilast + 1 - ifrstm;
+ drot_(&i__1, &a[ifrstm-1 + ilast * *lda], &c__1, &a[ifrstm-1 + (ilast-1) * *lda], &c__1, &c, &s);
+ drot_(&i__1, &b[ifrstm-1 + ilast * *ldb], &c__1, &b[ifrstm-1 + (ilast-1) * *ldb], &c__1, &c, &s);
+ if (ilz)
+ drot_(n, &z[ilast * *ldz], &c__1, &z[(ilast-1) * *ldz], &c__1, &c, &s);
+
+ /* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI, and BETA */
+
+L80:
+ if (b[ilast + ilast * *ldb] < 0.) {
+ if (ilschr) {
+ for (j = ifrstm-1; j <= ilast; ++j) {
+ a[j + ilast * *lda] = -a[j + ilast * *lda];
+ b[j + ilast * *ldb] = -b[j + ilast * *ldb];
+ }
+ }
+ else {
+ a[ilast + ilast * *lda] = -a[ilast + ilast * *lda];
+ b[ilast + ilast * *ldb] = -b[ilast + ilast * *ldb];
+ }
+ if (ilz) {
+ for (j = 0; j < *n; ++j)
+ z[j + ilast * *ldz] = -z[j + ilast * *ldz];
+ }
+ }
+ alphar[ilast] = a[ilast + ilast * *lda];
+ alphai[ilast] = 0.;
+ beta[ilast] = b[ilast + ilast * *ldb];
+
+ /* Go to next block -- exit if finished. */
+
+ --ilast;
+ if (ilast+1 < *ilo)
+ goto L380;
+
+ /* Reset counters */
+
+ iiter = 0;
+ eshift = 0.;
+ if (! ilschr) {
+ ilastm = ilast+1;
+ if (ifrstm > ilast+1)
+ ifrstm = *ilo;
+ }
+ continue; /* next iterator loop */
+
+ /* QZ step */
+
+ /* This iteration only involves rows/columns IFIRST:ILAST. We */
+ /* assume IFIRST < ILAST, and that the diagonal of B is non-zero. */
+
+L110:
+ ++iiter;
+ if (! ilschr)
+ ifrstm = ifirst;
+
+ /* Compute single shifts. */
+
+ /* At this point, IFIRST < ILAST, and the diagonal elements of */
+ /* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in */
+ /* magnitude) */
+
+ if (iiter / 10 * 10 == iiter)
+ {
+ /* Exceptional shift. Chosen for no particularly good reason. */
+ /* (Single shift only.) */
+
+ if ((doublereal) maxit * safmin * abs(a[ilast-1 + ilast * *lda])
+ < abs(b[ilast-1 + (ilast-1) * *ldb]))
+ eshift += a[ilast-1 + ilast * *lda] / b[ilast-1 + (ilast-1) * *ldb];
+ else
+ eshift += 1. / (safmin * (doublereal) maxit);
+ s1 = 1.;
+ wr = eshift;
+ }
+ else
+ {
+ /* Shifts based on the generalized eigenvalues of the */
+ /* bottom-right 2x2 block of A and B. The first eigenvalue */
+ /* returned by DLAG2 is the Wilkinson shift (AEP p.512), */
+
+ d__1 = safmin * 100.;
+ dlag2_(&a[ilast-1 + (ilast-1) * *lda], lda, &b[ilast-1 + (ilast-1) * *ldb],
+ ldb, &d__1, &s1, &s2, &wr, &wr2, &wi);
+
+ temp = max(s1, safmin * max(max(1.,abs(wr)),abs(wi)));
+ if (wi != 0.)
+ goto L200;
+ }
+
+ /* Fiddle with shift to avoid overflow */
+ temp = min(ascale,1.) * (safmax * .5);
+ if (s1 > temp)
+ scale = temp / s1;
+ else
+ scale = 1.;
+
+ temp = min(bscale,1.) * (safmax * .5);
+ if (abs(wr) > temp)
+ scale = min(scale, temp/abs(wr));
+ s1 *= scale;
+ wr *= scale;
+
+ /* Now check for two consecutive small subdiagonals. */
+
+ for (j = ilast; j > ifirst; --j) {
+ istart = j;
+ temp = abs(s1 * a[j-1 + (j-2) * *lda]);
+ temp2 = abs(s1 * a[j-1 + (j-1) * *lda] - wr * b[j-1 + (j-1) * *ldb]);
+ tempr = max(temp,temp2);
+ if (tempr < 1. && tempr != 0.) {
+ temp /= tempr;
+ temp2 /= tempr;
+ }
+ if (abs(ascale * a[j + (j-1) * *lda] * temp) <= ascale * atol * temp2)
+ break;
+ }
+
+ istart = ifirst;
+
+ /* Do an implicit single-shift QZ sweep. */
+
+ /* Initial Q */
+
+ temp = s1 * a[istart-1 + (istart-1) * *lda] - wr * b[istart-1 + (istart-1) * *ldb];
+ temp2 = s1 * a[istart + (istart-1) * *lda];
+ dlartg_(&temp, &temp2, &c, &s, &tempr);
+
+ /* Sweep */
+
+ for (j = istart; j <= ilast; ++j) {
+ if (j > istart) {
+ temp = a[j-1 + (j-2) * *lda];
+ dlartg_(&temp, &a[j + (j-2) * *lda], &c, &s, &a[j-1 + (j-2) * *lda]);
+ a[j + (j-2) * *lda] = 0.;
+ }
+
+ for (jc = j; jc <= ilastm; ++jc) {
+ temp = c * a[j-1 + (jc-1) * *lda] + s * a[j+1-1 + (jc-1) * *lda];
+ a[j + (jc-1) * *lda] = -s * a[j-1 + (jc-1) * *lda] + c * a[j + (jc-1) * *lda];
+ a[j-1 + (jc-1) * *lda] = temp;
+ temp2 = c * b[j-1 + (jc-1) * *ldb] + s * b[j+1-1 + (jc-1) * *ldb];
+ b[j + (jc-1) * *ldb] = -s * b[j-1 + (jc-1) * *ldb] + c * b[j + (jc-1) * *ldb];
+ b[j-1 + (jc-1) * *ldb] = temp2;
+ }
+ if (ilq) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = c * q[jr + (j-1) * *ldq] + s * q[jr + j * *ldq];
+ q[jr + j * *ldq] = -s * q[jr + (j-1) * *ldq] + c * q[jr + j * *ldq];
+ q[jr + (j-1) * *ldq] = temp;
+ }
+ }
+
+ temp = b[j + j * *ldb];
+ dlartg_(&temp, &b[j + (j-1) * *ldb], &c, &s, &b[j + j * *ldb]);
+ b[j + (j-1) * *ldb] = 0.;
+
+ for (jr = ifrstm-1; jr <= min(j+1, ilast); ++jr) {
+ temp = c * a[jr + j * *lda] + s * a[jr + (j-1) * *lda];
+ a[jr + (j-1) * *lda] = -s * a[jr + j * *lda] + c * a[jr + (j-1) * *lda];
+ a[jr + j * *lda] = temp;
+ }
+ for (jr = ifrstm-1; jr < j; ++jr) {
+ temp = c * b[jr + ((j-1) + 1) * *ldb] + s * b[jr + (j-1) * *ldb];
+ b[jr + (j-1) * *ldb] = -s * b[jr + j * *ldb] + c * b[jr + (j-1) * *ldb];
+ b[jr + j * *ldb] = temp;
+ }
+ if (ilz) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = c * z[jr + j * *ldz] + s * z[jr + (j-1) * *ldz];
+ z[jr + (j-1) * *ldz] = -s * z[jr + j * *ldz] + c * z[jr + (j-1) * *ldz];
+ z[jr + j * *ldz] = temp;
+ }
+ }
+ }
+
+ continue; /* next iterator loop */
+
+ /* Use Francis double-shift */
+
+ /* Note: the Francis double-shift should work with real shifts, */
+ /* but only if the block is at least 3x3. */
+ /* This code may break if this point is reached with */
+ /* a 2x2 block with real eigenvalues. */
+
+L200:
+ if (ifirst == ilast)
+ {
+ /* Special case -- 2x2 block with complex eigenvectors */
+
+ /* Step 1: Standardize, that is, rotate so that */
+ /* ( B11 0 ) */
+ /* B = ( ) with B11 non-negative. */
+ /* ( 0 B22 ) */
+
+ dlasv2_(&b[ilast-1 + (ilast-1) * *ldb], &b[ilast-1 + ilast * *ldb],
+ &b[ilast + ilast * *ldb], &b22, &b11, &sr, &cr, &sl, &cl);
+
+ if (b11 < 0.) {
+ cr = -cr;
+ sr = -sr;
+ b11 = -b11;
+ b22 = -b22;
+ }
+
+ i__1 = ilastm + 1 - ifirst;
+ drot_(&i__1, &a[ilast-1 + (ilast-1) * *lda], lda, &a[ilast + (ilast-1) * *lda], lda, &cl, &sl);
+ i__1 = ilast + 2 - ifrstm;
+ drot_(&i__1, &a[ifrstm-1 + (ilast-1) * *lda], &c__1, &a[ifrstm-1 + ilast * *lda], &c__1, &cr, &sr);
+
+ if (ilast + 1 < ilastm) {
+ i__1 = ilastm - ilast - 1;
+ drot_(&i__1, &b[ilast-1 + (ilast+1) * *ldb], ldb, &b[ilast + (ilast+1) * *ldb], lda, &cl, &sl);
+ }
+ if (ifrstm < ilast) {
+ i__1 = ifirst - ifrstm;
+ drot_(&i__1, &b[ifrstm-1 + (ilast-1) * *ldb], &c__1, &b[ifrstm-1 + ilast * *ldb], &c__1, &cr, &sr);
+ }
+
+ if (ilq)
+ drot_(n, &q[(ilast-1) * *ldq], &c__1, &q[ilast * *ldq], &c__1, &cl, &sl);
+ if (ilz)
+ drot_(n, &z[(ilast-1) * *ldz], &c__1, &z[ilast * *ldz], &c__1, &cr, &sr);
+
+ b[ilast-1 + (ilast-1) * *ldb] = b11;
+ b[ilast-1 + ilast * *ldb] = 0.;
+ b[ilast + (ilast-1) * *ldb] = 0.;
+ b[ilast + ilast * *ldb] = b22;
+
+ /* If B22 is negative, negate column ILAST */
+
+ if (b22 < 0.) {
+ for (j = ifrstm-1; j <= ilast; ++j) {
+ a[j + ilast * *lda] = -a[j + ilast * *lda];
+ b[j + ilast * *ldb] = -b[j + ilast * *ldb];
+ }
+
+ if (ilz) {
+ for (j = 0; j < *n; ++j)
+ z[j + ilast * *ldz] = -z[j + ilast * *ldz];
+ }
+ }
+
+ /* Step 2: Compute ALPHAR, ALPHAI, and BETA (see refs.) */
+
+ /* Recompute shift */
+
+ d__1 = safmin * 100.;
+ dlag2_(&a[ilast-1 + (ilast-1) * *lda], lda, &b[ilast-1 + (ilast-1) * *ldb],
+ ldb, &d__1, &s1, &temp, &wr, &temp2, &wi);
+
+ /* If standardization has perturbed the shift onto real line, */
+ /* do another (real single-shift) QR step. */
+
+ if (wi == 0.)
+ continue; /* next iterator loop */
+ s1inv = 1. / s1;
+
+ /* Do EISPACK (QZVAL) computation of alpha and beta */
+
+ a11 = a[ilast-1 + (ilast-1) * *lda];
+ a21 = a[ilast + (ilast-1) * *lda];
+ a12 = a[ilast-1 + ilast * *lda];
+ a22 = a[ilast + ilast * *lda];
+
+ /* Compute complex Givens rotation on right */
+ /* (Assume some element of C = (sA - wB) > unfl ) */
+ /* __ */
+ /* (sA - wB) ( CZ -SZ ) */
+ /* ( SZ CZ ) */
+
+ c11r = s1 * a11 - wr * b11;
+ c11i = -wi * b11;
+ c12 = s1 * a12;
+ c21 = s1 * a21;
+ c22r = s1 * a22 - wr * b22;
+ c22i = -wi * b22;
+
+ if (abs(c11r) + abs(c11i) + abs(c12) > abs(c21) + abs(c22r) + abs(c22i)) {
+ t = dlapy3_(&c12, &c11r, &c11i);
+ cz = c12 / t;
+ szr = -c11r / t;
+ szi = -c11i / t;
+ }
+ else {
+ cz = dlapy2_(&c22r, &c22i);
+ if (cz <= safmin) {
+ cz = 0.;
+ szr = 1.;
+ szi = 0.;
+ }
+ else {
+ tempr = c22r / cz;
+ tempi = c22i / cz;
+ t = dlapy2_(&cz, &c21);
+ cz /= t;
+ szr = -c21 * tempr / t;
+ szi = c21 * tempi / t;
+ }
+ }
+
+ /* Compute Givens rotation on left */
+
+ /* ( CQ SQ ) */
+ /* ( __ ) A or B */
+ /* ( -SQ CQ ) */
+
+ an = abs(a11) + abs(a12) + abs(a21) + abs(a22);
+ bn = abs(b11) + abs(b22);
+ wabs = abs(wr) + abs(wi);
+ if (s1 * an > wabs * bn) {
+ cq = cz * b11;
+ sqr = szr * b22;
+ sqi = -szi * b22;
+ }
+ else {
+ a1r = cz * a11 + szr * a12;
+ a1i = szi * a12;
+ a2r = cz * a21 + szr * a22;
+ a2i = szi * a22;
+ cq = dlapy2_(&a1r, &a1i);
+ if (cq <= safmin) {
+ cq = 0.;
+ sqr = 1.;
+ sqi = 0.;
+ }
+ else {
+ tempr = a1r / cq;
+ tempi = a1i / cq;
+ sqr = tempr * a2r + tempi * a2i;
+ sqi = tempi * a2r - tempr * a2i;
+ }
+ }
+ t = dlapy3_(&cq, &sqr, &sqi);
+ cq /= t;
+ sqr /= t;
+ sqi /= t;
+
+ /* Compute diagonal elements of QBZ */
+
+ tempr = sqr * szr - sqi * szi;
+ tempi = sqr * szi + sqi * szr;
+ b1r = cq * cz * b11 + tempr * b22;
+ b1i = tempi * b22;
+ b1a = dlapy2_(&b1r, &b1i);
+ b2r = cq * cz * b22 + tempr * b11;
+ b2i = -tempi * b11;
+ b2a = dlapy2_(&b2r, &b2i);
+
+ /* Normalize so beta > 0, and Im( alpha1 ) > 0 */
+
+ beta[ilast-1] = b1a;
+ beta[ilast] = b2a;
+ alphar[ilast-1] = wr * b1a * s1inv;
+ alphai[ilast-1] = wi * b1a * s1inv;
+ alphar[ilast] = wr * b2a * s1inv;
+ alphai[ilast] = -(wi * b2a) * s1inv;
+
+ /* Step 3: Go to next block -- exit if finished. */
+
+ ilast = ifirst - 2;
+ if (ilast + 1 < *ilo)
+ goto L380;
+
+ /* Reset counters */
+
+ iiter = 0;
+ eshift = 0.;
+ if (! ilschr) {
+ ilastm = ilast + 1;
+ if (ifrstm > ilast + 1)
+ ifrstm = *ilo;
+ }
+ }
+ else
+ {
+ /* Usual case: 3x3 or larger block, using Francis implicit double-shift */
+
+ /* Eigenvalue equation is w^2 - c w + d = 0, */
+
+ /* so compute 1st column of (A B^-1)^2 - c A B^-1 + d */
+ /* using the formula in QZIT (from EISPACK) */
+
+ /* We assume that the block is at least 3x3 */
+
+ ad11 = ascale * a[ilast-1 + (ilast-1) * *lda] / (bscale * b[ilast-1 + (ilast-1) * *ldb]);
+ ad21 = ascale * a[ilast + (ilast-1) * *lda] / (bscale * b[ilast-1 + (ilast-1) * *ldb]);
+ ad12 = ascale * a[ilast-1 + ilast * *lda] / (bscale * b[ilast + ilast * *ldb]);
+ ad22 = ascale * a[ilast + ilast * *lda] / (bscale * b[ilast + ilast * *ldb]);
+ u12 = b[ilast-1 + ilast * *ldb] / b[ilast + ilast * *ldb];
+ ad11l = ascale * a[ifirst-1 + (ifirst-1) * *lda] / (bscale * b[ifirst-1 + (ifirst-1) * *ldb]);
+ ad21l = ascale * a[ifirst + (ifirst-1) * *lda] / (bscale * b[ifirst-1 + (ifirst-1) * *ldb]);
+ ad12l = ascale * a[ifirst-1 + ifirst * *lda] / (bscale * b[ifirst + ifirst * *ldb]);
+ ad22l = ascale * a[ifirst + ifirst * *lda] / (bscale * b[ifirst + ifirst * *ldb]);
+ ad32l = ascale * a[ifirst+1 + ifirst * *lda] / (bscale * b[ifirst + ifirst * *ldb]);
+ u12l = b[ifirst-1 + ifirst * *ldb] / b[ifirst + ifirst * *ldb];
+
+ v[0] = (ad11 - ad11l) * (ad22 - ad11l) - ad12 * ad21 + ad21 * u12 * ad11l + (ad12l - ad11l * u12l) * ad21l;
+ v[1] = (ad22l - ad11l - ad21l * u12l - (ad11 - ad11l) - (ad22 - ad11l) + ad21 * u12) * ad21l;
+ v[2] = ad32l * ad21l;
+
+ istart = ifirst;
+
+ dlarfg_(&c__3, v, &v[1], &c__1, &tau);
+ v[0] = 1.;
+
+ /* Sweep */
+
+ for (j = istart; j < ilast; ++j)
+ {
+ /* All but last elements: use 3x3 Householder transforms. */
+
+ /* Zero (j-1)st column of A */
+
+ if (j > istart) {
+ v[0] = a[j-1 + (j-2) * *lda];
+ v[1] = a[j + (j-2) * *lda];
+ v[2] = a[j+1 + (j-2) * *lda];
+
+ dlarfg_(&c__3, &a[j-1 + (j-2) * *lda], &v[1], &c__1, &tau);
+ v[0] = 1.;
+ a[j + (j-2) * *lda] = 0.;
+ a[j+1 + (j-2) * *lda] = 0.;
+ }
+
+ for (jc = j; jc <= ilastm; ++jc) {
+ temp = tau * (a[j-1 + (jc-1) * *lda] + v[1] * a[j + (jc-1) * *lda] + v[2] * a[j+1 + (jc-1) * *lda]);
+ a[j-1 + (jc-1) * *lda] -= temp;
+ a[j + (jc-1) * *lda] -= temp * v[1];
+ a[j+1 + (jc-1) * *lda] -= temp * v[2];
+ temp2 = tau * (b[j-1 + (jc-1) * *ldb] + v[1] * b[j + (jc-1) * *ldb] + v[2] * b[j+1 + (jc-1) * *ldb]);
+ b[j-1 + (jc-1) * *ldb] -= temp2;
+ b[j + (jc-1) * *ldb] -= temp2 * v[1];
+ b[j+1 + (jc-1) * *ldb] -= temp2 * v[2];
+ }
+ if (ilq) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = tau * (q[jr + (j-1) * *ldq] + v[1] * q[jr + j * *ldq] + v[2] * q[jr + (j+1) * *ldq]);
+ q[jr + (j-1) * *ldq] -= temp;
+ q[jr + j * *ldq] -= temp * v[1];
+ q[jr + (j+1) * *ldq] -= temp * v[2];
+ }
+ }
+
+ /* Zero j-th column of B (see DLAGBC for details) */
+
+ /* Swap rows to pivot */
+
+ ilpivt = FALSE_;
+ temp = max(abs(b[j+1-1 + ((j+1)-1) * *ldb]), abs(b[j+1-1 + ((j+2)-1) * *ldb]));
+ temp2 = max(abs(b[j+2-1 + ((j+1)-1) * *ldb]), abs(b[j+2-1 + ((j+2)-1) * *ldb]));
+ if (max(temp,temp2) < safmin) {
+ scale = 0.;
+ u1 = 1.;
+ u2 = 0.;
+ goto L250;
+ }
+ else if (temp >= temp2) {
+ w11 = b[j + j * *ldb];
+ w21 = b[j+1 + j * *ldb];
+ w12 = b[j + (j+1) * *ldb];
+ w22 = b[j+1 + (j+1) * *ldb];
+ u1 = b[j + (j-1) * *ldb];
+ u2 = b[j+1 + (j-1) * *ldb];
+ }
+ else {
+ w21 = b[j + j * *ldb];
+ w11 = b[j+1 + j * *ldb];
+ w22 = b[j + (j+1) * *ldb];
+ w12 = b[j+1 + (j+1) * *ldb];
+ u2 = b[j + (j-1) * *ldb];
+ u1 = b[j+1 + (j-1) * *ldb];
+ }
+
+ /* Swap columns if nec. */
+
+ if (abs(w12) > abs(w11)) {
+ ilpivt = TRUE_;
+ temp = w12;
+ temp2 = w22;
+ w12 = w11;
+ w22 = w21;
+ w11 = temp;
+ w21 = temp2;
+ }
+
+ /* LU-factor */
+
+ temp = w21 / w11;
+ u2 -= temp * u1;
+ w22 -= temp * w12;
+ w21 = 0.;
+
+ /* Compute SCALE */
+
+ scale = 1.;
+ if (abs(w22) < safmin) {
+ scale = 0.;
+ u2 = 1.;
+ u1 = -w12 / w11;
+ }
+ else {
+ if (abs(w22) < abs(u2)) scale = abs(w22 / u2);
+ if (abs(w11) < abs(u1)) scale = min(scale, abs(w11/u1));
+
+ /* Solve */
+ u2 = scale * u2 / w22;
+ u1 = (scale * u1 - w12 * u2) / w11;
+ }
+L250:
+ if (ilpivt) {
+ temp = u2;
+ u2 = u1;
+ u1 = temp;
+ }
+
+ /* Compute Householder Vector */
+
+ t = sqrt(scale * scale + u1 * u1 + u2 * u2);
+ tau = scale / t + 1.;
+ vs = -1. / (scale + t);
+ v[0] = 1.;
+ v[1] = vs * u1;
+ v[2] = vs * u2;
+
+ /* Apply transformations from the right. */
+
+ for (jr = ifrstm-1; jr <= min(j+2, ilast); ++jr) {
+ temp = tau * (a[jr + (j-1) * *lda] + v[1] * a[jr + j * *lda] + v[2] * a[jr + (j+1) * *lda]);
+ a[jr + (j-1) * *lda] -= temp;
+ a[jr + j * *lda] -= temp * v[1];
+ a[jr + (j+1) * *lda] -= temp * v[2];
+ }
+ for (jr = ifrstm-1; jr < j+2; ++jr) {
+ temp = tau * (b[jr + (j-1) * *ldb] + v[1] * b[jr + j * *ldb] + v[2] * b[jr + (j+1) * *ldb]);
+ b[jr + (j-1) * *ldb] -= temp;
+ b[jr + j * *ldb] -= temp * v[1];
+ b[jr + (j+1) * *ldb] -= temp * v[2];
+ }
+ if (ilz) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = tau * (z[jr + (j-1) * *ldz] + v[1] * z[jr + j * *ldz] + v[2] * z[jr + (j+1) * *ldz]);
+ z[jr + (j-1) * *ldz] -= temp;
+ z[jr + j * *ldz] -= temp * v[1];
+ z[jr + (j+1) * *ldz] -= temp * v[2];
+ }
+ }
+ b[j + (j-1) * *ldb] = 0.;
+ b[j+1 + (j-1) * *ldb] = 0.;
+ }
+
+ /* Last elements: Use Givens rotations */
+
+ /* Rotations from the left */
+
+ j = ilast;
+ temp = a[j-1 + (j-2) * *lda];
+ dlartg_(&temp, &a[j + (j-2) * *lda], &c, &s, &a[j-1 + (j-2) * *lda]);
+ a[j + (j-2) * *lda] = 0.;
+
+ for (jc = j; jc <= ilastm; ++jc) {
+ temp = c * a[j-1 + (jc-1) * *lda] + s * a[j + (jc-1) * *lda];
+ a[j + (jc-1) * *lda] = -s * a[j-1 + (jc-1) * *lda] + c * a[j + (jc-1) * *lda];
+ a[j-1 + (jc-1) * *lda] = temp;
+ temp2 = c * b[j-1 + (jc-1) * *ldb] + s * b[j + (jc-1) * *ldb];
+ b[j + (jc-1) * *ldb] = -s * b[j-1 + (jc-1) * *ldb] + c * b[j + (jc-1) * *ldb];
+ b[j-1 + (jc-1) * *ldb] = temp2;
+ }
+ if (ilq) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = c * q[jr + (j-1) * *ldq] + s * q[jr + j * *ldq];
+ q[jr + j * *ldq] = -s * q[jr + (j-1) * *ldq] + c * q[jr + j * *ldq];
+ q[jr + (j-1) * *ldq] = temp;
+ }
+ }
+
+ /* Rotations from the right. */
+
+ temp = b[j + ((j-1) + 1) * *ldb];
+ dlartg_(&temp, &b[j + (j-1) * *ldb], &c, &s, &b[j + ((j-1) + 1) * *ldb]);
+ b[j + (j-1) * *ldb] = 0.;
+
+ for (jr = ifrstm-1; jr <= ilast; ++jr) {
+ temp = c * a[jr + j * *lda] + s * a[jr + (j-1) * *lda];
+ a[jr + (j-1) * *lda] = -s * a[jr + j * *lda] + c * a[jr + (j-1) * *lda];
+ a[jr + j * *lda] = temp;
+ }
+ for (jr = ifrstm-1; jr < ilast; ++jr) {
+ temp = c * b[jr + j * *ldb] + s * b[jr + (j-1) * *ldb];
+ b[jr + (j-1) * *ldb] = -s * b[jr + j * *ldb] + c * b[jr + (j-1) * *ldb];
+ b[jr + j * *ldb] = temp;
+ }
+ if (ilz) {
+ for (jr = 0; jr < *n; ++jr) {
+ temp = c * z[jr + j * *ldz] + s * z[jr + (j-1) * *ldz];
+ z[jr + (j-1) * *ldz] = -s * z[jr + j * *ldz] + c * z[jr + (j-1) * *ldz];
+ z[jr + j * *ldz] = temp;
+ }
+ }
+ } /* End of Double-Shift code */
+ } /* End of iteration loop */
+
+ /* Drop-through = non-convergence */
+
+ *info = ilast + 1;
+ *work = (doublereal) (*n);
+ return;
+
+ /* Successful completion of all QZ steps */
+L380:
+ /* Set Eigenvalues 1:ILO-1 */
+
+ for (j = 0; j+1 < *ilo; ++j) {
+ if (b[j + j * *ldb] < 0.) {
+ if (ilschr) {
+ for (jr = 0; jr <= j; ++jr) {
+ a[jr + j * *lda] = -a[jr + j * *lda];
+ b[jr + j * *ldb] = -b[jr + j * *ldb];
+ }
+ }
+ else {
+ a[j + j * *lda] = -a[j + j * *lda];
+ b[j + j * *ldb] = -b[j + j * *ldb];
+ }
+ if (ilz)
+ for (jr = 0; jr < *n; ++jr)
+ z[jr + j * *ldz] = -z[jr + j * *ldz];
+ }
+ alphar[j] = a[j + j * *lda];
+ alphai[j] = 0.;
+ beta[j] = b[j + j * *ldb];
+ }
+
+ /* Normal Termination */
+
+ *info = 0;
+ *work = (doublereal) (*n);
+
+} /* dhgeqz_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.f
new file mode 100644
index 0000000000000000000000000000000000000000..723098c55a737603f5c8e8caf0c8ea8253bb603f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dhgeqz.f
@@ -0,0 +1,1243 @@
+ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB,
+ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK,
+ $ LWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ CHARACTER COMPQ, COMPZ, JOB
+ INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
+ $ B( LDB, * ), BETA( * ), Q( LDQ, * ), WORK( * ),
+ $ Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DHGEQZ implements a single-/double-shift version of the QZ method for
+* finding the generalized eigenvalues
+*
+* w(j)=(ALPHAR(j) + i*ALPHAI(j))/BETAR(j) of the equation
+*
+* det( A - w(i) B ) = 0
+*
+* In addition, the pair A,B may be reduced to generalized Schur form:
+* B is upper triangular, and A is block upper triangular, where the
+* diagonal blocks are either 1-by-1 or 2-by-2, the 2-by-2 blocks having
+* complex generalized eigenvalues (see the description of the argument
+* JOB.)
+*
+* If JOB='S', then the pair (A,B) is simultaneously reduced to Schur
+* form by applying one orthogonal transformation (usually called Q) on
+* the left and another (usually called Z) on the right. The 2-by-2
+* upper-triangular diagonal blocks of B corresponding to 2-by-2 blocks
+* of A will be reduced to positive diagonal matrices. (I.e.,
+* if A(j+1,j) is non-zero, then B(j+1,j)=B(j,j+1)=0 and B(j,j) and
+* B(j+1,j+1) will be positive.)
+*
+* If JOB='E', then at each iteration, the same transformations
+* are computed, but they are only applied to those parts of A and B
+* which are needed to compute ALPHAR, ALPHAI, and BETAR.
+*
+* If JOB='S' and COMPQ and COMPZ are 'V' or 'I', then the orthogonal
+* transformations used to reduce (A,B) are accumulated into the arrays
+* Q and Z s.t.:
+*
+* Q(in) A(in) Z(in)* = Q(out) A(out) Z(out)*
+* Q(in) B(in) Z(in)* = Q(out) B(out) Z(out)*
+*
+* Ref: C.B. Moler & G.W. Stewart, "An Algorithm for Generalized Matrix
+* Eigenvalue Problems", SIAM J. Numer. Anal., 10(1973),
+* pp. 241--256.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* = 'E': compute only ALPHAR, ALPHAI, and BETA. A and B will
+* not necessarily be put into generalized Schur form.
+* = 'S': put A and B into generalized Schur form, as well
+* as computing ALPHAR, ALPHAI, and BETA.
+*
+* COMPQ (input) CHARACTER*1
+* = 'N': do not modify Q.
+* = 'V': multiply the array Q on the right by the transpose of
+* the orthogonal transformation that is applied to the
+* left side of A and B to reduce them to Schur form.
+* = 'I': like COMPQ='V', except that Q will be initialized to
+* the identity first.
+*
+* COMPZ (input) CHARACTER*1
+* = 'N': do not modify Z.
+* = 'V': multiply the array Z on the right by the orthogonal
+* transformation that is applied to the right side of
+* A and B to reduce them to Schur form.
+* = 'I': like COMPZ='V', except that Z will be initialized to
+* the identity first.
+*
+* N (input) INTEGER
+* The order of the matrices A, B, Q, and Z. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that A is already upper triangular in rows and
+* columns 1:ILO-1 and IHI+1:N.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+* On entry, the N-by-N upper Hessenberg matrix A. Elements
+* below the subdiagonal must be zero.
+* If JOB='S', then on exit A and B will have been
+* simultaneously reduced to generalized Schur form.
+* If JOB='E', then on exit A will have been destroyed.
+* The diagonal blocks will be correct, but the off-diagonal
+* portion will be meaningless.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max( 1, N ).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB, N)
+* On entry, the N-by-N upper triangular matrix B. Elements
+* below the diagonal must be zero. 2-by-2 blocks in B
+* corresponding to 2-by-2 blocks in A will be reduced to
+* positive diagonal form. (I.e., if A(j+1,j) is non-zero,
+* then B(j+1,j)=B(j,j+1)=0 and B(j,j) and B(j+1,j+1) will be
+* positive.)
+* If JOB='S', then on exit A and B will have been
+* simultaneously reduced to Schur form.
+* If JOB='E', then on exit B will have been destroyed.
+* Elements corresponding to diagonal blocks of A will be
+* correct, but the off-diagonal portion will be meaningless.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max( 1, N ).
+*
+* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+* ALPHAR(1:N) will be set to real parts of the diagonal
+* elements of A that would result from reducing A and B to
+* Schur form and then further reducing them both to triangular
+* form using unitary transformations s.t. the diagonal of B
+* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
+* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=A(j,j).
+* Note that the (real or complex) values
+* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
+* generalized eigenvalues of the matrix pencil A - wB.
+*
+* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+* ALPHAI(1:N) will be set to imaginary parts of the diagonal
+* elements of A that would result from reducing A and B to
+* Schur form and then further reducing them both to triangular
+* form using unitary transformations s.t. the diagonal of B
+* was non-negative real. Thus, if A(j,j) is in a 1-by-1 block
+* (i.e., A(j+1,j)=A(j,j+1)=0), then ALPHAR(j)=0.
+* Note that the (real or complex) values
+* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
+* generalized eigenvalues of the matrix pencil A - wB.
+*
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* BETA(1:N) will be set to the (real) diagonal elements of B
+* that would result from reducing A and B to Schur form and
+* then further reducing them both to triangular form using
+* unitary transformations s.t. the diagonal of B was
+* non-negative real. Thus, if A(j,j) is in a 1-by-1 block
+* (i.e., A(j+1,j)=A(j,j+1)=0), then BETA(j)=B(j,j).
+* Note that the (real or complex) values
+* (ALPHAR(j) + i*ALPHAI(j))/BETA(j), j=1,...,N, are the
+* generalized eigenvalues of the matrix pencil A - wB.
+* (Note that BETA(1:N) will always be non-negative, and no
+* BETAI is necessary.)
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+* If COMPQ='N', then Q will not be referenced.
+* If COMPQ='V' or 'I', then the transpose of the orthogonal
+* transformations which are applied to A and B on the left
+* will be applied to the array Q on the right.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= 1.
+* If COMPQ='V' or 'I', then LDQ >= N.
+*
+* Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+* If COMPZ='N', then Z will not be referenced.
+* If COMPZ='V' or 'I', then the orthogonal transformations
+* which are applied to A and B on the right will be applied
+* to the array Z on the right.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDZ >= 1.
+* If COMPZ='V' or 'I', then LDZ >= N.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= max(1,N).
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+* = 1,...,N: the QZ iteration did not converge. (A,B) is not
+* in Schur form, but ALPHAR(i), ALPHAI(i), and
+* BETA(i), i=INFO+1,...,N should be correct.
+* = N+1,...,2*N: the shift calculation failed. (A,B) is not
+* in Schur form, but ALPHAR(i), ALPHAI(i), and
+* BETA(i), i=INFO-N+1,...,N should be correct.
+* > 2*N: various "impossible" errors.
+*
+* Further Details
+* ===============
+*
+* Iteration counters:
+*
+* JITER -- counts iterations.
+* IITER -- counts iterations run since ILAST was last
+* changed. This is therefore reset only when a 1-by-1 or
+* 2-by-2 block deflates off the bottom.
+*
+* =====================================================================
+*
+* .. Parameters ..
+* $ SAFETY = 1.0E+0 )
+ DOUBLE PRECISION HALF, ZERO, ONE, SAFETY
+ PARAMETER ( HALF = 0.5D+0, ZERO = 0.0D+0, ONE = 1.0D+0,
+ $ SAFETY = 1.0D+2 )
+* ..
+* .. Local Scalars ..
+ LOGICAL ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
+ $ LQUERY
+ INTEGER ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
+ $ ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
+ $ JR, MAXIT
+ DOUBLE PRECISION A11, A12, A1I, A1R, A21, A22, A2I, A2R, AD11,
+ $ AD11L, AD12, AD12L, AD21, AD21L, AD22, AD22L,
+ $ AD32L, AN, ANORM, ASCALE, ATOL, B11, B1A, B1I,
+ $ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
+ $ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
+ $ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
+ $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T,
+ $ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
+ $ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
+ $ WR2
+* ..
+* .. Local Arrays ..
+ DOUBLE PRECISION V( 3 )
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH, DLANHS, DLAPY2, DLAPY3
+ EXTERNAL LSAME, DLAMCH, DLANHS, DLAPY2, DLAPY3
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAG2, DLARFG, DLARTG, DLASET, DLASV2, DROT,
+ $ XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Decode JOB, COMPQ, COMPZ
+*
+ IF( LSAME( JOB, 'E' ) ) THEN
+ ILSCHR = .FALSE.
+ ISCHUR = 1
+ ELSE IF( LSAME( JOB, 'S' ) ) THEN
+ ILSCHR = .TRUE.
+ ISCHUR = 2
+ ELSE
+ ISCHUR = 0
+ END IF
+*
+ IF( LSAME( COMPQ, 'N' ) ) THEN
+ ILQ = .FALSE.
+ ICOMPQ = 1
+ ELSE IF( LSAME( COMPQ, 'V' ) ) THEN
+ ILQ = .TRUE.
+ ICOMPQ = 2
+ ELSE IF( LSAME( COMPQ, 'I' ) ) THEN
+ ILQ = .TRUE.
+ ICOMPQ = 3
+ ELSE
+ ICOMPQ = 0
+ END IF
+*
+ IF( LSAME( COMPZ, 'N' ) ) THEN
+ ILZ = .FALSE.
+ ICOMPZ = 1
+ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
+ ILZ = .TRUE.
+ ICOMPZ = 2
+ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
+ ILZ = .TRUE.
+ ICOMPZ = 3
+ ELSE
+ ICOMPZ = 0
+ END IF
+*
+* Check Argument Values
+*
+ INFO = 0
+ WORK( 1 ) = MAX( 1, N )
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( ISCHUR.EQ.0 ) THEN
+ INFO = -1
+ ELSE IF( ICOMPQ.EQ.0 ) THEN
+ INFO = -2
+ ELSE IF( ICOMPZ.EQ.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( ILO.LT.1 ) THEN
+ INFO = -5
+ ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.N ) THEN
+ INFO = -8
+ ELSE IF( LDB.LT.N ) THEN
+ INFO = -10
+ ELSE IF( LDQ.LT.1 .OR. ( ILQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -15
+ ELSE IF( LDZ.LT.1 .OR. ( ILZ .AND. LDZ.LT.N ) ) THEN
+ INFO = -17
+ ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+ INFO = -19
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DHGEQZ', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ WORK( 1 ) = DBLE( 1 )
+ RETURN
+ END IF
+*
+* Initialize Q and Z
+*
+ IF( ICOMPQ.EQ.3 )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+ IF( ICOMPZ.EQ.3 )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
+*
+* Machine Constants
+*
+ IN = IHI + 1 - ILO
+ SAFMIN = DLAMCH( 'S' )
+ SAFMAX = ONE / SAFMIN
+ ULP = DLAMCH( 'E' )*DLAMCH( 'B' )
+ ANORM = DLANHS( 'F', IN, A( ILO, ILO ), LDA, WORK )
+ BNORM = DLANHS( 'F', IN, B( ILO, ILO ), LDB, WORK )
+ ATOL = MAX( SAFMIN, ULP*ANORM )
+ BTOL = MAX( SAFMIN, ULP*BNORM )
+ ASCALE = ONE / MAX( SAFMIN, ANORM )
+ BSCALE = ONE / MAX( SAFMIN, BNORM )
+*
+* Set Eigenvalues IHI+1:N
+*
+ DO 30 J = IHI + 1, N
+ IF( B( J, J ).LT.ZERO ) THEN
+ IF( ILSCHR ) THEN
+ DO 10 JR = 1, J
+ A( JR, J ) = -A( JR, J )
+ B( JR, J ) = -B( JR, J )
+ 10 CONTINUE
+ ELSE
+ A( J, J ) = -A( J, J )
+ B( J, J ) = -B( J, J )
+ END IF
+ IF( ILZ ) THEN
+ DO 20 JR = 1, N
+ Z( JR, J ) = -Z( JR, J )
+ 20 CONTINUE
+ END IF
+ END IF
+ ALPHAR( J ) = A( J, J )
+ ALPHAI( J ) = ZERO
+ BETA( J ) = B( J, J )
+ 30 CONTINUE
+*
+* If IHI < ILO, skip QZ steps
+*
+ IF( IHI.LT.ILO )
+ $ GO TO 380
+*
+* MAIN QZ ITERATION LOOP
+*
+* Initialize dynamic indices
+*
+* Eigenvalues ILAST+1:N have been found.
+* Column operations modify rows IFRSTM:whatever.
+* Row operations modify columns whatever:ILASTM.
+*
+* If only eigenvalues are being computed, then
+* IFRSTM is the row of the last splitting row above row ILAST;
+* this is always at least ILO.
+* IITER counts iterations since the last eigenvalue was found,
+* to tell when to use an extraordinary shift.
+* MAXIT is the maximum number of QZ sweeps allowed.
+*
+ ILAST = IHI
+ IF( ILSCHR ) THEN
+ IFRSTM = 1
+ ILASTM = N
+ ELSE
+ IFRSTM = ILO
+ ILASTM = IHI
+ END IF
+ IITER = 0
+ ESHIFT = ZERO
+ MAXIT = 30*( IHI-ILO+1 )
+*
+ DO 360 JITER = 1, MAXIT
+*
+* Split the matrix if possible.
+*
+* Two tests:
+* 1: A(j,j-1)=0 or j=ILO
+* 2: B(j,j)=0
+*
+ IF( ILAST.EQ.ILO ) THEN
+*
+* Special case: j=ILAST
+*
+ GO TO 80
+ ELSE
+ IF( ABS( A( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
+ A( ILAST, ILAST-1 ) = ZERO
+ GO TO 80
+ END IF
+ END IF
+*
+ IF( ABS( B( ILAST, ILAST ) ).LE.BTOL ) THEN
+ B( ILAST, ILAST ) = ZERO
+ GO TO 70
+ END IF
+*
+* General case: j<ILAST
+*
+ DO 60 J = ILAST - 1, ILO, -1
+*
+* Test 1: for A(j,j-1)=0 or j=ILO
+*
+ IF( J.EQ.ILO ) THEN
+ ILAZRO = .TRUE.
+ ELSE
+ IF( ABS( A( J, J-1 ) ).LE.ATOL ) THEN
+ A( J, J-1 ) = ZERO
+ ILAZRO = .TRUE.
+ ELSE
+ ILAZRO = .FALSE.
+ END IF
+ END IF
+*
+* Test 2: for B(j,j)=0
+*
+ IF( ABS( B( J, J ) ).LT.BTOL ) THEN
+ B( J, J ) = ZERO
+*
+* Test 1a: Check for 2 consecutive small subdiagonals in A
+*
+ ILAZR2 = .FALSE.
+ IF( .NOT.ILAZRO ) THEN
+ TEMP = ABS( A( J, J-1 ) )
+ TEMP2 = ABS( A( J, J ) )
+ TEMPR = MAX( TEMP, TEMP2 )
+ IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
+ TEMP = TEMP / TEMPR
+ TEMP2 = TEMP2 / TEMPR
+ END IF
+ IF( TEMP*( ASCALE*ABS( A( J+1, J ) ) ).LE.TEMP2*
+ $ ( ASCALE*ATOL ) )ILAZR2 = .TRUE.
+ END IF
+*
+* If both tests pass (1 & 2), i.e., the leading diagonal
+* element of B in the block is zero, split a 1x1 block off
+* at the top. (I.e., at the J-th row/column) The leading
+* diagonal element of the remainder can also be zero, so
+* this may have to be done repeatedly.
+*
+ IF( ILAZRO .OR. ILAZR2 ) THEN
+ DO 40 JCH = J, ILAST - 1
+ TEMP = A( JCH, JCH )
+ CALL DLARTG( TEMP, A( JCH+1, JCH ), C, S,
+ $ A( JCH, JCH ) )
+ A( JCH+1, JCH ) = ZERO
+ CALL DROT( ILASTM-JCH, A( JCH, JCH+1 ), LDA,
+ $ A( JCH+1, JCH+1 ), LDA, C, S )
+ CALL DROT( ILASTM-JCH, B( JCH, JCH+1 ), LDB,
+ $ B( JCH+1, JCH+1 ), LDB, C, S )
+ IF( ILQ )
+ $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
+ $ C, S )
+ IF( ILAZR2 )
+ $ A( JCH, JCH-1 ) = A( JCH, JCH-1 )*C
+ ILAZR2 = .FALSE.
+ IF( ABS( B( JCH+1, JCH+1 ) ).GE.BTOL ) THEN
+ IF( JCH+1.GE.ILAST ) THEN
+ GO TO 80
+ ELSE
+ IFIRST = JCH + 1
+ GO TO 110
+ END IF
+ END IF
+ B( JCH+1, JCH+1 ) = ZERO
+ 40 CONTINUE
+ GO TO 70
+ ELSE
+*
+* Only test 2 passed -- chase the zero to B(ILAST,ILAST)
+* Then process as in the case B(ILAST,ILAST)=0
+*
+ DO 50 JCH = J, ILAST - 1
+ TEMP = B( JCH, JCH+1 )
+ CALL DLARTG( TEMP, B( JCH+1, JCH+1 ), C, S,
+ $ B( JCH, JCH+1 ) )
+ B( JCH+1, JCH+1 ) = ZERO
+ IF( JCH.LT.ILASTM-1 )
+ $ CALL DROT( ILASTM-JCH-1, B( JCH, JCH+2 ), LDB,
+ $ B( JCH+1, JCH+2 ), LDB, C, S )
+ CALL DROT( ILASTM-JCH+2, A( JCH, JCH-1 ), LDA,
+ $ A( JCH+1, JCH-1 ), LDA, C, S )
+ IF( ILQ )
+ $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1,
+ $ C, S )
+ TEMP = A( JCH+1, JCH )
+ CALL DLARTG( TEMP, A( JCH+1, JCH-1 ), C, S,
+ $ A( JCH+1, JCH ) )
+ A( JCH+1, JCH-1 ) = ZERO
+ CALL DROT( JCH+1-IFRSTM, A( IFRSTM, JCH ), 1,
+ $ A( IFRSTM, JCH-1 ), 1, C, S )
+ CALL DROT( JCH-IFRSTM, B( IFRSTM, JCH ), 1,
+ $ B( IFRSTM, JCH-1 ), 1, C, S )
+ IF( ILZ )
+ $ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1,
+ $ C, S )
+ 50 CONTINUE
+ GO TO 70
+ END IF
+ ELSE IF( ILAZRO ) THEN
+*
+* Only test 1 passed -- work on J:ILAST
+*
+ IFIRST = J
+ GO TO 110
+ END IF
+*
+* Neither test passed -- try next J
+*
+ 60 CONTINUE
+*
+* (Drop-through is "impossible")
+*
+ INFO = N + 1
+ GO TO 420
+*
+* B(ILAST,ILAST)=0 -- clear A(ILAST,ILAST-1) to split off a
+* 1x1 block.
+*
+ 70 CONTINUE
+ TEMP = A( ILAST, ILAST )
+ CALL DLARTG( TEMP, A( ILAST, ILAST-1 ), C, S,
+ $ A( ILAST, ILAST ) )
+ A( ILAST, ILAST-1 ) = ZERO
+ CALL DROT( ILAST-IFRSTM, A( IFRSTM, ILAST ), 1,
+ $ A( IFRSTM, ILAST-1 ), 1, C, S )
+ CALL DROT( ILAST-IFRSTM, B( IFRSTM, ILAST ), 1,
+ $ B( IFRSTM, ILAST-1 ), 1, C, S )
+ IF( ILZ )
+ $ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S )
+*
+* A(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI,
+* and BETA
+*
+ 80 CONTINUE
+ IF( B( ILAST, ILAST ).LT.ZERO ) THEN
+ IF( ILSCHR ) THEN
+ DO 90 J = IFRSTM, ILAST
+ A( J, ILAST ) = -A( J, ILAST )
+ B( J, ILAST ) = -B( J, ILAST )
+ 90 CONTINUE
+ ELSE
+ A( ILAST, ILAST ) = -A( ILAST, ILAST )
+ B( ILAST, ILAST ) = -B( ILAST, ILAST )
+ END IF
+ IF( ILZ ) THEN
+ DO 100 J = 1, N
+ Z( J, ILAST ) = -Z( J, ILAST )
+ 100 CONTINUE
+ END IF
+ END IF
+ ALPHAR( ILAST ) = A( ILAST, ILAST )
+ ALPHAI( ILAST ) = ZERO
+ BETA( ILAST ) = B( ILAST, ILAST )
+*
+* Go to next block -- exit if finished.
+*
+ ILAST = ILAST - 1
+ IF( ILAST.LT.ILO )
+ $ GO TO 380
+*
+* Reset counters
+*
+ IITER = 0
+ ESHIFT = ZERO
+ IF( .NOT.ILSCHR ) THEN
+ ILASTM = ILAST
+ IF( IFRSTM.GT.ILAST )
+ $ IFRSTM = ILO
+ END IF
+ GO TO 350
+*
+* QZ step
+*
+* This iteration only involves rows/columns IFIRST:ILAST. We
+* assume IFIRST < ILAST, and that the diagonal of B is non-zero.
+*
+ 110 CONTINUE
+ IITER = IITER + 1
+ IF( .NOT.ILSCHR ) THEN
+ IFRSTM = IFIRST
+ END IF
+*
+* Compute single shifts.
+*
+* At this point, IFIRST < ILAST, and the diagonal elements of
+* B(IFIRST:ILAST,IFIRST,ILAST) are larger than BTOL (in
+* magnitude)
+*
+ IF( ( IITER / 10 )*10.EQ.IITER ) THEN
+*
+* Exceptional shift. Chosen for no particularly good reason.
+* (Single shift only.)
+*
+ IF( ( DBLE( MAXIT )*SAFMIN )*ABS( A( ILAST-1, ILAST ) ).LT.
+ $ ABS( B( ILAST-1, ILAST-1 ) ) ) THEN
+ ESHIFT = ESHIFT + A( ILAST-1, ILAST ) /
+ $ B( ILAST-1, ILAST-1 )
+ ELSE
+ ESHIFT = ESHIFT + ONE / ( SAFMIN*DBLE( MAXIT ) )
+ END IF
+ S1 = ONE
+ WR = ESHIFT
+*
+ ELSE
+*
+* Shifts based on the generalized eigenvalues of the
+* bottom-right 2x2 block of A and B. The first eigenvalue
+* returned by DLAG2 is the Wilkinson shift (AEP p.512),
+*
+ CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
+ $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ $ S2, WR, WR2, WI )
+*
+ TEMP = MAX( S1, SAFMIN*MAX( ONE, ABS( WR ), ABS( WI ) ) )
+ IF( WI.NE.ZERO )
+ $ GO TO 200
+ END IF
+*
+* Fiddle with shift to avoid overflow
+*
+ TEMP = MIN( ASCALE, ONE )*( HALF*SAFMAX )
+ IF( S1.GT.TEMP ) THEN
+ SCALE = TEMP / S1
+ ELSE
+ SCALE = ONE
+ END IF
+*
+ TEMP = MIN( BSCALE, ONE )*( HALF*SAFMAX )
+ IF( ABS( WR ).GT.TEMP )
+ $ SCALE = MIN( SCALE, TEMP / ABS( WR ) )
+ S1 = SCALE*S1
+ WR = SCALE*WR
+*
+* Now check for two consecutive small subdiagonals.
+*
+ DO 120 J = ILAST - 1, IFIRST + 1, -1
+ ISTART = J
+ TEMP = ABS( S1*A( J, J-1 ) )
+ TEMP2 = ABS( S1*A( J, J )-WR*B( J, J ) )
+ TEMPR = MAX( TEMP, TEMP2 )
+ IF( TEMPR.LT.ONE .AND. TEMPR.NE.ZERO ) THEN
+ TEMP = TEMP / TEMPR
+ TEMP2 = TEMP2 / TEMPR
+ END IF
+ IF( ABS( ( ASCALE*A( J+1, J ) )*TEMP ).LE.( ASCALE*ATOL )*
+ $ TEMP2 )GO TO 130
+ 120 CONTINUE
+*
+ ISTART = IFIRST
+ 130 CONTINUE
+*
+* Do an implicit single-shift QZ sweep.
+*
+* Initial Q
+*
+ TEMP = S1*A( ISTART, ISTART ) - WR*B( ISTART, ISTART )
+ TEMP2 = S1*A( ISTART+1, ISTART )
+ CALL DLARTG( TEMP, TEMP2, C, S, TEMPR )
+*
+* Sweep
+*
+ DO 190 J = ISTART, ILAST - 1
+ IF( J.GT.ISTART ) THEN
+ TEMP = A( J, J-1 )
+ CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
+ A( J+1, J-1 ) = ZERO
+ END IF
+*
+ DO 140 JC = J, ILASTM
+ TEMP = C*A( J, JC ) + S*A( J+1, JC )
+ A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
+ A( J, JC ) = TEMP
+ TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
+ B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
+ B( J, JC ) = TEMP2
+ 140 CONTINUE
+ IF( ILQ ) THEN
+ DO 150 JR = 1, N
+ TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
+ Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
+ Q( JR, J ) = TEMP
+ 150 CONTINUE
+ END IF
+*
+ TEMP = B( J+1, J+1 )
+ CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
+ B( J+1, J ) = ZERO
+*
+ DO 160 JR = IFRSTM, MIN( J+2, ILAST )
+ TEMP = C*A( JR, J+1 ) + S*A( JR, J )
+ A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
+ A( JR, J+1 ) = TEMP
+ 160 CONTINUE
+ DO 170 JR = IFRSTM, J
+ TEMP = C*B( JR, J+1 ) + S*B( JR, J )
+ B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
+ B( JR, J+1 ) = TEMP
+ 170 CONTINUE
+ IF( ILZ ) THEN
+ DO 180 JR = 1, N
+ TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
+ Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
+ Z( JR, J+1 ) = TEMP
+ 180 CONTINUE
+ END IF
+ 190 CONTINUE
+*
+ GO TO 350
+*
+* Use Francis double-shift
+*
+* Note: the Francis double-shift should work with real shifts,
+* but only if the block is at least 3x3.
+* This code may break if this point is reached with
+* a 2x2 block with real eigenvalues.
+*
+ 200 CONTINUE
+ IF( IFIRST+1.EQ.ILAST ) THEN
+*
+* Special case -- 2x2 block with complex eigenvectors
+*
+* Step 1: Standardize, that is, rotate so that
+*
+* ( B11 0 )
+* B = ( ) with B11 non-negative.
+* ( 0 B22 )
+*
+ CALL DLASV2( B( ILAST-1, ILAST-1 ), B( ILAST-1, ILAST ),
+ $ B( ILAST, ILAST ), B22, B11, SR, CR, SL, CL )
+*
+ IF( B11.LT.ZERO ) THEN
+ CR = -CR
+ SR = -SR
+ B11 = -B11
+ B22 = -B22
+ END IF
+*
+ CALL DROT( ILASTM+1-IFIRST, A( ILAST-1, ILAST-1 ), LDA,
+ $ A( ILAST, ILAST-1 ), LDA, CL, SL )
+ CALL DROT( ILAST+1-IFRSTM, A( IFRSTM, ILAST-1 ), 1,
+ $ A( IFRSTM, ILAST ), 1, CR, SR )
+*
+ IF( ILAST.LT.ILASTM )
+ $ CALL DROT( ILASTM-ILAST, B( ILAST-1, ILAST+1 ), LDB,
+ $ B( ILAST, ILAST+1 ), LDA, CL, SL )
+ IF( IFRSTM.LT.ILAST-1 )
+ $ CALL DROT( IFIRST-IFRSTM, B( IFRSTM, ILAST-1 ), 1,
+ $ B( IFRSTM, ILAST ), 1, CR, SR )
+*
+ IF( ILQ )
+ $ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL,
+ $ SL )
+ IF( ILZ )
+ $ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR,
+ $ SR )
+*
+ B( ILAST-1, ILAST-1 ) = B11
+ B( ILAST-1, ILAST ) = ZERO
+ B( ILAST, ILAST-1 ) = ZERO
+ B( ILAST, ILAST ) = B22
+*
+* If B22 is negative, negate column ILAST
+*
+ IF( B22.LT.ZERO ) THEN
+ DO 210 J = IFRSTM, ILAST
+ A( J, ILAST ) = -A( J, ILAST )
+ B( J, ILAST ) = -B( J, ILAST )
+ 210 CONTINUE
+*
+ IF( ILZ ) THEN
+ DO 220 J = 1, N
+ Z( J, ILAST ) = -Z( J, ILAST )
+ 220 CONTINUE
+ END IF
+ END IF
+*
+* Step 2: Compute ALPHAR, ALPHAI, and BETA (see refs.)
+*
+* Recompute shift
+*
+ CALL DLAG2( A( ILAST-1, ILAST-1 ), LDA,
+ $ B( ILAST-1, ILAST-1 ), LDB, SAFMIN*SAFETY, S1,
+ $ TEMP, WR, TEMP2, WI )
+*
+* If standardization has perturbed the shift onto real line,
+* do another (real single-shift) QR step.
+*
+ IF( WI.EQ.ZERO )
+ $ GO TO 350
+ S1INV = ONE / S1
+*
+* Do EISPACK (QZVAL) computation of alpha and beta
+*
+ A11 = A( ILAST-1, ILAST-1 )
+ A21 = A( ILAST, ILAST-1 )
+ A12 = A( ILAST-1, ILAST )
+ A22 = A( ILAST, ILAST )
+*
+* Compute complex Givens rotation on right
+* (Assume some element of C = (sA - wB) > unfl )
+* __
+* (sA - wB) ( CZ -SZ )
+* ( SZ CZ )
+*
+ C11R = S1*A11 - WR*B11
+ C11I = -WI*B11
+ C12 = S1*A12
+ C21 = S1*A21
+ C22R = S1*A22 - WR*B22
+ C22I = -WI*B22
+*
+ IF( ABS( C11R )+ABS( C11I )+ABS( C12 ).GT.ABS( C21 )+
+ $ ABS( C22R )+ABS( C22I ) ) THEN
+ T = DLAPY3( C12, C11R, C11I )
+ CZ = C12 / T
+ SZR = -C11R / T
+ SZI = -C11I / T
+ ELSE
+ CZ = DLAPY2( C22R, C22I )
+ IF( CZ.LE.SAFMIN ) THEN
+ CZ = ZERO
+ SZR = ONE
+ SZI = ZERO
+ ELSE
+ TEMPR = C22R / CZ
+ TEMPI = C22I / CZ
+ T = DLAPY2( CZ, C21 )
+ CZ = CZ / T
+ SZR = -C21*TEMPR / T
+ SZI = C21*TEMPI / T
+ END IF
+ END IF
+*
+* Compute Givens rotation on left
+*
+* ( CQ SQ )
+* ( __ ) A or B
+* ( -SQ CQ )
+*
+ AN = ABS( A11 ) + ABS( A12 ) + ABS( A21 ) + ABS( A22 )
+ BN = ABS( B11 ) + ABS( B22 )
+ WABS = ABS( WR ) + ABS( WI )
+ IF( S1*AN.GT.WABS*BN ) THEN
+ CQ = CZ*B11
+ SQR = SZR*B22
+ SQI = -SZI*B22
+ ELSE
+ A1R = CZ*A11 + SZR*A12
+ A1I = SZI*A12
+ A2R = CZ*A21 + SZR*A22
+ A2I = SZI*A22
+ CQ = DLAPY2( A1R, A1I )
+ IF( CQ.LE.SAFMIN ) THEN
+ CQ = ZERO
+ SQR = ONE
+ SQI = ZERO
+ ELSE
+ TEMPR = A1R / CQ
+ TEMPI = A1I / CQ
+ SQR = TEMPR*A2R + TEMPI*A2I
+ SQI = TEMPI*A2R - TEMPR*A2I
+ END IF
+ END IF
+ T = DLAPY3( CQ, SQR, SQI )
+ CQ = CQ / T
+ SQR = SQR / T
+ SQI = SQI / T
+*
+* Compute diagonal elements of QBZ
+*
+ TEMPR = SQR*SZR - SQI*SZI
+ TEMPI = SQR*SZI + SQI*SZR
+ B1R = CQ*CZ*B11 + TEMPR*B22
+ B1I = TEMPI*B22
+ B1A = DLAPY2( B1R, B1I )
+ B2R = CQ*CZ*B22 + TEMPR*B11
+ B2I = -TEMPI*B11
+ B2A = DLAPY2( B2R, B2I )
+*
+* Normalize so beta > 0, and Im( alpha1 ) > 0
+*
+ BETA( ILAST-1 ) = B1A
+ BETA( ILAST ) = B2A
+ ALPHAR( ILAST-1 ) = ( WR*B1A )*S1INV
+ ALPHAI( ILAST-1 ) = ( WI*B1A )*S1INV
+ ALPHAR( ILAST ) = ( WR*B2A )*S1INV
+ ALPHAI( ILAST ) = -( WI*B2A )*S1INV
+*
+* Step 3: Go to next block -- exit if finished.
+*
+ ILAST = IFIRST - 1
+ IF( ILAST.LT.ILO )
+ $ GO TO 380
+*
+* Reset counters
+*
+ IITER = 0
+ ESHIFT = ZERO
+ IF( .NOT.ILSCHR ) THEN
+ ILASTM = ILAST
+ IF( IFRSTM.GT.ILAST )
+ $ IFRSTM = ILO
+ END IF
+ GO TO 350
+ ELSE
+*
+* Usual case: 3x3 or larger block, using Francis implicit
+* double-shift
+*
+* 2
+* Eigenvalue equation is w - c w + d = 0,
+*
+* -1 2 -1
+* so compute 1st column of (A B ) - c A B + d
+* using the formula in QZIT (from EISPACK)
+*
+* We assume that the block is at least 3x3
+*
+ AD11 = ( ASCALE*A( ILAST-1, ILAST-1 ) ) /
+ $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
+ AD21 = ( ASCALE*A( ILAST, ILAST-1 ) ) /
+ $ ( BSCALE*B( ILAST-1, ILAST-1 ) )
+ AD12 = ( ASCALE*A( ILAST-1, ILAST ) ) /
+ $ ( BSCALE*B( ILAST, ILAST ) )
+ AD22 = ( ASCALE*A( ILAST, ILAST ) ) /
+ $ ( BSCALE*B( ILAST, ILAST ) )
+ U12 = B( ILAST-1, ILAST ) / B( ILAST, ILAST )
+ AD11L = ( ASCALE*A( IFIRST, IFIRST ) ) /
+ $ ( BSCALE*B( IFIRST, IFIRST ) )
+ AD21L = ( ASCALE*A( IFIRST+1, IFIRST ) ) /
+ $ ( BSCALE*B( IFIRST, IFIRST ) )
+ AD12L = ( ASCALE*A( IFIRST, IFIRST+1 ) ) /
+ $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
+ AD22L = ( ASCALE*A( IFIRST+1, IFIRST+1 ) ) /
+ $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
+ AD32L = ( ASCALE*A( IFIRST+2, IFIRST+1 ) ) /
+ $ ( BSCALE*B( IFIRST+1, IFIRST+1 ) )
+ U12L = B( IFIRST, IFIRST+1 ) / B( IFIRST+1, IFIRST+1 )
+*
+ V( 1 ) = ( AD11-AD11L )*( AD22-AD11L ) - AD12*AD21 +
+ $ AD21*U12*AD11L + ( AD12L-AD11L*U12L )*AD21L
+ V( 2 ) = ( ( AD22L-AD11L )-AD21L*U12L-( AD11-AD11L )-
+ $ ( AD22-AD11L )+AD21*U12 )*AD21L
+ V( 3 ) = AD32L*AD21L
+*
+ ISTART = IFIRST
+*
+ CALL DLARFG( 3, V( 1 ), V( 2 ), 1, TAU )
+ V( 1 ) = ONE
+*
+* Sweep
+*
+ DO 290 J = ISTART, ILAST - 2
+*
+* All but last elements: use 3x3 Householder transforms.
+*
+* Zero (j-1)st column of A
+*
+ IF( J.GT.ISTART ) THEN
+ V( 1 ) = A( J, J-1 )
+ V( 2 ) = A( J+1, J-1 )
+ V( 3 ) = A( J+2, J-1 )
+*
+ CALL DLARFG( 3, A( J, J-1 ), V( 2 ), 1, TAU )
+ V( 1 ) = ONE
+ A( J+1, J-1 ) = ZERO
+ A( J+2, J-1 ) = ZERO
+ END IF
+*
+ DO 230 JC = J, ILASTM
+ TEMP = TAU*( A( J, JC )+V( 2 )*A( J+1, JC )+V( 3 )*
+ $ A( J+2, JC ) )
+ A( J, JC ) = A( J, JC ) - TEMP
+ A( J+1, JC ) = A( J+1, JC ) - TEMP*V( 2 )
+ A( J+2, JC ) = A( J+2, JC ) - TEMP*V( 3 )
+ TEMP2 = TAU*( B( J, JC )+V( 2 )*B( J+1, JC )+V( 3 )*
+ $ B( J+2, JC ) )
+ B( J, JC ) = B( J, JC ) - TEMP2
+ B( J+1, JC ) = B( J+1, JC ) - TEMP2*V( 2 )
+ B( J+2, JC ) = B( J+2, JC ) - TEMP2*V( 3 )
+ 230 CONTINUE
+ IF( ILQ ) THEN
+ DO 240 JR = 1, N
+ TEMP = TAU*( Q( JR, J )+V( 2 )*Q( JR, J+1 )+V( 3 )*
+ $ Q( JR, J+2 ) )
+ Q( JR, J ) = Q( JR, J ) - TEMP
+ Q( JR, J+1 ) = Q( JR, J+1 ) - TEMP*V( 2 )
+ Q( JR, J+2 ) = Q( JR, J+2 ) - TEMP*V( 3 )
+ 240 CONTINUE
+ END IF
+*
+* Zero j-th column of B (see DLAGBC for details)
+*
+* Swap rows to pivot
+*
+ ILPIVT = .FALSE.
+ TEMP = MAX( ABS( B( J+1, J+1 ) ), ABS( B( J+1, J+2 ) ) )
+ TEMP2 = MAX( ABS( B( J+2, J+1 ) ), ABS( B( J+2, J+2 ) ) )
+ IF( MAX( TEMP, TEMP2 ).LT.SAFMIN ) THEN
+ SCALE = ZERO
+ U1 = ONE
+ U2 = ZERO
+ GO TO 250
+ ELSE IF( TEMP.GE.TEMP2 ) THEN
+ W11 = B( J+1, J+1 )
+ W21 = B( J+2, J+1 )
+ W12 = B( J+1, J+2 )
+ W22 = B( J+2, J+2 )
+ U1 = B( J+1, J )
+ U2 = B( J+2, J )
+ ELSE
+ W21 = B( J+1, J+1 )
+ W11 = B( J+2, J+1 )
+ W22 = B( J+1, J+2 )
+ W12 = B( J+2, J+2 )
+ U2 = B( J+1, J )
+ U1 = B( J+2, J )
+ END IF
+*
+* Swap columns if nec.
+*
+ IF( ABS( W12 ).GT.ABS( W11 ) ) THEN
+ ILPIVT = .TRUE.
+ TEMP = W12
+ TEMP2 = W22
+ W12 = W11
+ W22 = W21
+ W11 = TEMP
+ W21 = TEMP2
+ END IF
+*
+* LU-factor
+*
+ TEMP = W21 / W11
+ U2 = U2 - TEMP*U1
+ W22 = W22 - TEMP*W12
+ W21 = ZERO
+*
+* Compute SCALE
+*
+ SCALE = ONE
+ IF( ABS( W22 ).LT.SAFMIN ) THEN
+ SCALE = ZERO
+ U2 = ONE
+ U1 = -W12 / W11
+ GO TO 250
+ END IF
+ IF( ABS( W22 ).LT.ABS( U2 ) )
+ $ SCALE = ABS( W22 / U2 )
+ IF( ABS( W11 ).LT.ABS( U1 ) )
+ $ SCALE = MIN( SCALE, ABS( W11 / U1 ) )
+*
+* Solve
+*
+ U2 = ( SCALE*U2 ) / W22
+ U1 = ( SCALE*U1-W12*U2 ) / W11
+*
+ 250 CONTINUE
+ IF( ILPIVT ) THEN
+ TEMP = U2
+ U2 = U1
+ U1 = TEMP
+ END IF
+*
+* Compute Householder Vector
+*
+ T = SQRT( SCALE**2+U1**2+U2**2 )
+ TAU = ONE + SCALE / T
+ VS = -ONE / ( SCALE+T )
+ V( 1 ) = ONE
+ V( 2 ) = VS*U1
+ V( 3 ) = VS*U2
+*
+* Apply transformations from the right.
+*
+ DO 260 JR = IFRSTM, MIN( J+3, ILAST )
+ TEMP = TAU*( A( JR, J )+V( 2 )*A( JR, J+1 )+V( 3 )*
+ $ A( JR, J+2 ) )
+ A( JR, J ) = A( JR, J ) - TEMP
+ A( JR, J+1 ) = A( JR, J+1 ) - TEMP*V( 2 )
+ A( JR, J+2 ) = A( JR, J+2 ) - TEMP*V( 3 )
+ 260 CONTINUE
+ DO 270 JR = IFRSTM, J + 2
+ TEMP = TAU*( B( JR, J )+V( 2 )*B( JR, J+1 )+V( 3 )*
+ $ B( JR, J+2 ) )
+ B( JR, J ) = B( JR, J ) - TEMP
+ B( JR, J+1 ) = B( JR, J+1 ) - TEMP*V( 2 )
+ B( JR, J+2 ) = B( JR, J+2 ) - TEMP*V( 3 )
+ 270 CONTINUE
+ IF( ILZ ) THEN
+ DO 280 JR = 1, N
+ TEMP = TAU*( Z( JR, J )+V( 2 )*Z( JR, J+1 )+V( 3 )*
+ $ Z( JR, J+2 ) )
+ Z( JR, J ) = Z( JR, J ) - TEMP
+ Z( JR, J+1 ) = Z( JR, J+1 ) - TEMP*V( 2 )
+ Z( JR, J+2 ) = Z( JR, J+2 ) - TEMP*V( 3 )
+ 280 CONTINUE
+ END IF
+ B( J+1, J ) = ZERO
+ B( J+2, J ) = ZERO
+ 290 CONTINUE
+*
+* Last elements: Use Givens rotations
+*
+* Rotations from the left
+*
+ J = ILAST - 1
+ TEMP = A( J, J-1 )
+ CALL DLARTG( TEMP, A( J+1, J-1 ), C, S, A( J, J-1 ) )
+ A( J+1, J-1 ) = ZERO
+*
+ DO 300 JC = J, ILASTM
+ TEMP = C*A( J, JC ) + S*A( J+1, JC )
+ A( J+1, JC ) = -S*A( J, JC ) + C*A( J+1, JC )
+ A( J, JC ) = TEMP
+ TEMP2 = C*B( J, JC ) + S*B( J+1, JC )
+ B( J+1, JC ) = -S*B( J, JC ) + C*B( J+1, JC )
+ B( J, JC ) = TEMP2
+ 300 CONTINUE
+ IF( ILQ ) THEN
+ DO 310 JR = 1, N
+ TEMP = C*Q( JR, J ) + S*Q( JR, J+1 )
+ Q( JR, J+1 ) = -S*Q( JR, J ) + C*Q( JR, J+1 )
+ Q( JR, J ) = TEMP
+ 310 CONTINUE
+ END IF
+*
+* Rotations from the right.
+*
+ TEMP = B( J+1, J+1 )
+ CALL DLARTG( TEMP, B( J+1, J ), C, S, B( J+1, J+1 ) )
+ B( J+1, J ) = ZERO
+*
+ DO 320 JR = IFRSTM, ILAST
+ TEMP = C*A( JR, J+1 ) + S*A( JR, J )
+ A( JR, J ) = -S*A( JR, J+1 ) + C*A( JR, J )
+ A( JR, J+1 ) = TEMP
+ 320 CONTINUE
+ DO 330 JR = IFRSTM, ILAST - 1
+ TEMP = C*B( JR, J+1 ) + S*B( JR, J )
+ B( JR, J ) = -S*B( JR, J+1 ) + C*B( JR, J )
+ B( JR, J+1 ) = TEMP
+ 330 CONTINUE
+ IF( ILZ ) THEN
+ DO 340 JR = 1, N
+ TEMP = C*Z( JR, J+1 ) + S*Z( JR, J )
+ Z( JR, J ) = -S*Z( JR, J+1 ) + C*Z( JR, J )
+ Z( JR, J+1 ) = TEMP
+ 340 CONTINUE
+ END IF
+*
+* End of Double-Shift code
+*
+ END IF
+*
+ GO TO 350
+*
+* End of iteration loop
+*
+ 350 CONTINUE
+ 360 CONTINUE
+*
+* Drop-through = non-convergence
+*
+ 370 CONTINUE
+ INFO = ILAST
+ GO TO 420
+*
+* Successful completion of all QZ steps
+*
+ 380 CONTINUE
+*
+* Set Eigenvalues 1:ILO-1
+*
+ DO 410 J = 1, ILO - 1
+ IF( B( J, J ).LT.ZERO ) THEN
+ IF( ILSCHR ) THEN
+ DO 390 JR = 1, J
+ A( JR, J ) = -A( JR, J )
+ B( JR, J ) = -B( JR, J )
+ 390 CONTINUE
+ ELSE
+ A( J, J ) = -A( J, J )
+ B( J, J ) = -B( J, J )
+ END IF
+ IF( ILZ ) THEN
+ DO 400 JR = 1, N
+ Z( JR, J ) = -Z( JR, J )
+ 400 CONTINUE
+ END IF
+ END IF
+ ALPHAR( J ) = A( J, J )
+ ALPHAI( J ) = ZERO
+ BETA( J ) = B( J, J )
+ 410 CONTINUE
+*
+* Normal Termination
+*
+ INFO = 0
+*
+* Exit (other than argument error) -- return optimal workspace size
+*
+ 420 CONTINUE
+ WORK( 1 ) = DBLE( N )
+ RETURN
+*
+* End of DHGEQZ
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.c
new file mode 100644
index 0000000000000000000000000000000000000000..bdefaef357f1f0a6efcc96b312b96852b2d33460
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.c
@@ -0,0 +1,47 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void dlabad_(small, large)
+doublereal *small, *large;
+{
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DLABAD takes as input the values computed by SLAMCH for underflow and */
+/* overflow, and returns the square root of each of these values if the */
+/* log of LARGE is sufficiently large. This subroutine is intended to */
+/* identify machines with a large exponent range, such as the Crays, and */
+/* redefine the underflow and overflow limits to be the square roots of */
+/* the values computed by DLAMCH. This subroutine is needed because */
+/* DLAMCH does not compensate for poor arithmetic in the upper half of */
+/* the exponent range, as is found on a Cray. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SMALL (input/output) DOUBLE PRECISION */
+/* On entry, the underflow threshold as computed by DLAMCH. */
+/* On exit, if LOG10(LARGE) is sufficiently large, the square */
+/* root of SMALL, otherwise unchanged. */
+/* */
+/* LARGE (input/output) DOUBLE PRECISION */
+/* On entry, the overflow threshold as computed by DLAMCH. */
+/* On exit, if LOG10(LARGE) is sufficiently large, the square */
+/* root of LARGE, otherwise unchanged. */
+/* */
+/* ===================================================================== */
+
+/* If it looks like we're on a Cray, take the square root of */
+/* SMALL and LARGE to avoid overflow and underflow problems. */
+
+ if (d_lg10(large) > 2e3) {
+ *small = sqrt(*small);
+ *large = sqrt(*large);
+ }
+} /* dlabad_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.f
new file mode 100644
index 0000000000000000000000000000000000000000..1f453d222483722b52034292580d3a5162edb070
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlabad.f
@@ -0,0 +1,56 @@
+ SUBROUTINE DLABAD( SMALL, LARGE )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION LARGE, SMALL
+* ..
+*
+* Purpose
+* =======
+*
+* DLABAD takes as input the values computed by SLAMCH for underflow and
+* overflow, and returns the square root of each of these values if the
+* log of LARGE is sufficiently large. This subroutine is intended to
+* identify machines with a large exponent range, such as the Crays, and
+* redefine the underflow and overflow limits to be the square roots of
+* the values computed by DLAMCH. This subroutine is needed because
+* DLAMCH does not compensate for poor arithmetic in the upper half of
+* the exponent range, as is found on a Cray.
+*
+* Arguments
+* =========
+*
+* SMALL (input/output) DOUBLE PRECISION
+* On entry, the underflow threshold as computed by DLAMCH.
+* On exit, if LOG10(LARGE) is sufficiently large, the square
+* root of SMALL, otherwise unchanged.
+*
+* LARGE (input/output) DOUBLE PRECISION
+* On entry, the overflow threshold as computed by DLAMCH.
+* On exit, if LOG10(LARGE) is sufficiently large, the square
+* root of LARGE, otherwise unchanged.
+*
+* =====================================================================
+*
+* .. Intrinsic Functions ..
+ INTRINSIC LOG10, SQRT
+* ..
+* .. Executable Statements ..
+*
+* If it looks like we're on a Cray, take the square root of
+* SMALL and LARGE to avoid overflow and underflow problems.
+*
+ IF( LOG10( LARGE ).GT.2000.D0 ) THEN
+ SMALL = SQRT( SMALL )
+ LARGE = SQRT( LARGE )
+ END IF
+*
+ RETURN
+*
+* End of DLABAD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.c
new file mode 100644
index 0000000000000000000000000000000000000000..6ac6dd0e28774b76c6598f96ea9cba6a58afd4e4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.c
@@ -0,0 +1,197 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b11 = 1.;
+
+/* Subroutine */ void dlacon_(n, v, x, isgn, est, kase)
+integer *n;
+doublereal *v, *x;
+integer *isgn;
+doublereal *est;
+integer *kase;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static integer iter;
+ static doublereal temp;
+ static integer jump, i, j;
+ static integer jlast;
+ static doublereal altsgn, estold;
+
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLACON estimates the 1-norm of a square, real matrix A. */
+/* Reverse communication is used for evaluating matrix-vector products. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix. N >= 1. */
+/* */
+/* V (workspace) DOUBLE PRECISION array, dimension (N) */
+/* On the final return, V = A*W, where EST = norm(V)/norm(W) */
+/* (W is not returned). */
+/* */
+/* X (input/output) DOUBLE PRECISION array, dimension (N) */
+/* On an intermediate return, X should be overwritten by */
+/* A * X, if KASE=1, */
+/* A' * X, if KASE=2, */
+/* and DLACON must be re-called with all the other parameters */
+/* unchanged. */
+/* */
+/* ISGN (workspace) INTEGER array, dimension (N) */
+/* */
+/* EST (output) DOUBLE PRECISION */
+/* An estimate (a lower bound) for norm(A). */
+/* */
+/* KASE (input/output) INTEGER */
+/* On the initial call to DLACON, KASE should be 0. */
+/* On an intermediate return, KASE will be 1 or 2, indicating */
+/* whether X should be overwritten by A * X or A' * X. */
+/* On the final return from DLACON, KASE will again be 0. */
+/* */
+/* Further Details */
+/* ======= ======= */
+/* */
+/* Contributed by Nick Higham, University of Manchester. */
+/* Originally named SONEST, dated March 16, 1988. */
+/* */
+/* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of */
+/* a real or complex matrix, with applications to condition estimation", */
+/* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. */
+/* */
+/* ===================================================================== */
+
+ if (*kase == 0) {
+ for (i = 0; i < *n; ++i) {
+ x[i] = 1. / (doublereal) (*n);
+ }
+ *kase = 1;
+ jump = 1;
+ return;
+ }
+
+ switch ((int)jump) {
+ case 1: goto L20;
+ case 2: goto L40;
+ case 3: goto L70;
+ case 4: goto L110;
+ case 5: goto L140;
+ }
+
+/* ................ ENTRY (JUMP = 1) */
+/* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. */
+
+L20:
+ if (*n == 1) {
+ v[0] = x[0];
+ *est = abs(v[0]);
+ *kase = 0;
+ return;
+ }
+ *est = dasum_(n, x, &c__1);
+
+ for (i = 0; i < *n; ++i) {
+ x[i] = d_sign(&c_b11, &x[i]);
+ isgn[i] = i_dnnt(&x[i]);
+ }
+ *kase = 2;
+ jump = 2;
+ return;
+
+/* ................ ENTRY (JUMP = 2) */
+/* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */
+
+L40:
+ j = idamax_(n, x, &c__1) - 1;
+ iter = 2;
+
+/* MAIN LOOP - ITERATIONS 2,3,...,ITMAX. */
+
+L50:
+ for (i = 0; i < *n; ++i) {
+ x[i] = 0.;
+ }
+ x[j] = 1.;
+ *kase = 1;
+ jump = 3;
+ return;
+
+/* ................ ENTRY (JUMP = 3) */
+/* X HAS BEEN OVERWRITTEN BY A*X. */
+
+L70:
+ dcopy_(n, x, &c__1, v, &c__1);
+ estold = *est;
+ *est = dasum_(n, v, &c__1);
+ for (i = 0; i < *n; ++i) {
+ d__1 = d_sign(&c_b11, &x[i]);
+ if (i_dnnt(&d__1) != isgn[i]) {
+ goto L90;
+ }
+ }
+/* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. */
+ goto L120;
+
+L90:
+/* TEST FOR CYCLING. */
+ if (*est <= estold) {
+ goto L120;
+ }
+
+ for (i = 0; i < *n; ++i) {
+ x[i] = d_sign(&c_b11, &x[i]);
+ isgn[i] = i_dnnt(&x[i]);
+ }
+ *kase = 2;
+ jump = 4;
+ return;
+
+/* ................ ENTRY (JUMP = 4) */
+/* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X. */
+
+L110:
+ jlast = j;
+ j = idamax_(n, x, &c__1) - 1;
+ if (x[jlast] != abs(x[j]) && iter < 5) {
+ ++iter;
+ goto L50;
+ }
+
+/* ITERATION COMPLETE. FINAL STAGE. */
+
+L120:
+ altsgn = 1.;
+ for (i = 0; i < *n; ++i) {
+ x[i] = altsgn * ((doublereal) i / (doublereal) (*n - 1) + 1.);
+ altsgn = -altsgn;
+ }
+ *kase = 1;
+ jump = 5;
+ return;
+
+/* ................ ENTRY (JUMP = 5) */
+/* X HAS BEEN OVERWRITTEN BY A*X. */
+
+L140:
+ temp = dasum_(n, x, &c__1) / (doublereal) (*n * 3) * 2.;
+ if (temp > *est) {
+ dcopy_(n, x, &c__1, v, &c__1);
+ *est = temp;
+ }
+
+ *kase = 0;
+
+} /* dlacon_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.f
new file mode 100644
index 0000000000000000000000000000000000000000..481abb96b18512c037731cb68810ec972e205c5a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacon.f
@@ -0,0 +1,204 @@
+ SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER KASE, N
+ DOUBLE PRECISION EST
+* ..
+* .. Array Arguments ..
+ INTEGER ISGN( * )
+ DOUBLE PRECISION V( * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLACON estimates the 1-norm of a square, real matrix A.
+* Reverse communication is used for evaluating matrix-vector products.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix. N >= 1.
+*
+* V (workspace) DOUBLE PRECISION array, dimension (N)
+* On the final return, V = A*W, where EST = norm(V)/norm(W)
+* (W is not returned).
+*
+* X (input/output) DOUBLE PRECISION array, dimension (N)
+* On an intermediate return, X should be overwritten by
+* A * X, if KASE=1,
+* A' * X, if KASE=2,
+* and DLACON must be re-called with all the other parameters
+* unchanged.
+*
+* ISGN (workspace) INTEGER array, dimension (N)
+*
+* EST (output) DOUBLE PRECISION
+* An estimate (a lower bound) for norm(A).
+*
+* KASE (input/output) INTEGER
+* On the initial call to DLACON, KASE should be 0.
+* On an intermediate return, KASE will be 1 or 2, indicating
+* whether X should be overwritten by A * X or A' * X.
+* On the final return from DLACON, KASE will again be 0.
+*
+* Further Details
+* ======= =======
+*
+* Contributed by Nick Higham, University of Manchester.
+* Originally named SONEST, dated March 16, 1988.
+*
+* Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of
+* a real or complex matrix, with applications to condition estimation",
+* ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER ITMAX
+ PARAMETER ( ITMAX = 5 )
+ DOUBLE PRECISION ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITER, J, JLAST, JUMP
+ DOUBLE PRECISION ALTSGN, ESTOLD, TEMP
+* ..
+* .. External Functions ..
+ INTEGER IDAMAX
+ DOUBLE PRECISION DASUM
+ EXTERNAL IDAMAX, DASUM
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, NINT, SIGN
+* ..
+* .. Save statement ..
+ SAVE
+* ..
+* .. Executable Statements ..
+*
+ IF( KASE.EQ.0 ) THEN
+ DO 10 I = 1, N
+ X( I ) = ONE / DBLE( N )
+ 10 CONTINUE
+ KASE = 1
+ JUMP = 1
+ RETURN
+ END IF
+*
+ GO TO ( 20, 40, 70, 110, 140 )JUMP
+*
+* ................ ENTRY (JUMP = 1)
+* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
+*
+ 20 CONTINUE
+ IF( N.EQ.1 ) THEN
+ V( 1 ) = X( 1 )
+ EST = ABS( V( 1 ) )
+* ... QUIT
+ GO TO 150
+ END IF
+ EST = DASUM( N, X, 1 )
+*
+ DO 30 I = 1, N
+ X( I ) = SIGN( ONE, X( I ) )
+ ISGN( I ) = NINT( X( I ) )
+ 30 CONTINUE
+ KASE = 2
+ JUMP = 2
+ RETURN
+*
+* ................ ENTRY (JUMP = 2)
+* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
+*
+ 40 CONTINUE
+ J = IDAMAX( N, X, 1 )
+ ITER = 2
+*
+* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
+*
+ 50 CONTINUE
+ DO 60 I = 1, N
+ X( I ) = ZERO
+ 60 CONTINUE
+ X( J ) = ONE
+ KASE = 1
+ JUMP = 3
+ RETURN
+*
+* ................ ENTRY (JUMP = 3)
+* X HAS BEEN OVERWRITTEN BY A*X.
+*
+ 70 CONTINUE
+ CALL DCOPY( N, X, 1, V, 1 )
+ ESTOLD = EST
+ EST = DASUM( N, V, 1 )
+ DO 80 I = 1, N
+ IF( NINT( SIGN( ONE, X( I ) ) ).NE.ISGN( I ) )
+ $ GO TO 90
+ 80 CONTINUE
+* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
+ GO TO 120
+*
+ 90 CONTINUE
+* TEST FOR CYCLING.
+ IF( EST.LE.ESTOLD )
+ $ GO TO 120
+*
+ DO 100 I = 1, N
+ X( I ) = SIGN( ONE, X( I ) )
+ ISGN( I ) = NINT( X( I ) )
+ 100 CONTINUE
+ KASE = 2
+ JUMP = 4
+ RETURN
+*
+* ................ ENTRY (JUMP = 4)
+* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
+*
+ 110 CONTINUE
+ JLAST = J
+ J = IDAMAX( N, X, 1 )
+ IF( ( X( JLAST ).NE.ABS( X( J ) ) ) .AND. ( ITER.LT.ITMAX ) ) THEN
+ ITER = ITER + 1
+ GO TO 50
+ END IF
+*
+* ITERATION COMPLETE. FINAL STAGE.
+*
+ 120 CONTINUE
+ ALTSGN = ONE
+ DO 130 I = 1, N
+ X( I ) = ALTSGN*( ONE+DBLE( I-1 ) / DBLE( N-1 ) )
+ ALTSGN = -ALTSGN
+ 130 CONTINUE
+ KASE = 1
+ JUMP = 5
+ RETURN
+*
+* ................ ENTRY (JUMP = 5)
+* X HAS BEEN OVERWRITTEN BY A*X.
+*
+ 140 CONTINUE
+ TEMP = TWO*( DASUM( N, X, 1 ) / DBLE( 3*N ) )
+ IF( TEMP.GT.EST ) THEN
+ CALL DCOPY( N, X, 1, V, 1 )
+ EST = TEMP
+ END IF
+*
+ 150 CONTINUE
+ KASE = 0
+ RETURN
+*
+* End of DLACON
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..f8796e78f4cd0cf066f95bfac74a51aeeeb59aa0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.c
@@ -0,0 +1,71 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlacpy_(const char *uplo, const integer *m, const integer *n,
+ doublereal *a, const integer *lda, doublereal *b, const integer *ldb)
+{
+ /* Local variables */
+ static integer i, j;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLACPY copies all or part of a two-dimensional matrix A to another */
+/* matrix B. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be copied to B. */
+/* = 'U': Upper triangular part */
+/* = 'L': Lower triangular part */
+/* Otherwise: All of the matrix A */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The m by n matrix A. If UPLO = 'U', only the upper triangle */
+/* or trapezoid is accessed; if UPLO = 'L', only the lower */
+/* triangle or trapezoid is accessed. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On exit, B = A in the locations specified by UPLO. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j && i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ } else if (lsame_(uplo, "L")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ }
+} /* dlacpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..6820d45fbf82caaedcdf037281fa6822dad3936d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlacpy.f
@@ -0,0 +1,88 @@
+ SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDB, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLACPY copies all or part of a two-dimensional matrix A to another
+* matrix B.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be copied to B.
+* = 'U': Upper triangular part
+* = 'L': Lower triangular part
+* Otherwise: All of the matrix A
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* The m by n matrix A. If UPLO = 'U', only the upper triangle
+* or trapezoid is accessed; if UPLO = 'L', only the lower
+* triangle or trapezoid is accessed.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (output) DOUBLE PRECISION array, dimension (LDB,N)
+* On exit, B = A in the locations specified by UPLO.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 20 J = 1, N
+ DO 10 I = 1, MIN( J, M )
+ B( I, J ) = A( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+ DO 40 J = 1, N
+ DO 30 I = J, M
+ B( I, J ) = A( I, J )
+ 30 CONTINUE
+ 40 CONTINUE
+ ELSE
+ DO 60 J = 1, N
+ DO 50 I = 1, M
+ B( I, J ) = A( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+ RETURN
+*
+* End of DLACPY
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.c
new file mode 100644
index 0000000000000000000000000000000000000000..2be4f706cccade0fed5e8c24678a748325483c75
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.c
@@ -0,0 +1,58 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001, to allow p/q being equal to a,b,c or d */
+
+/* Subroutine */ void dladiv_(a, b, c, d, p, q)
+const doublereal *a, *b, *c, *d;
+doublereal *p, *q;
+{
+ static doublereal e, f, t;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLADIV performs complex division in real arithmetic */
+/* */
+/* a + i*b */
+/* p + i*q = --------- */
+/* c + i*d */
+/* */
+/* The algorithm is due to Robert L. Smith and can be found */
+/* in D. Knuth, The art of Computer Programming, Vol.2, p.195 */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* A (input) DOUBLE PRECISION */
+/* B (input) DOUBLE PRECISION */
+/* C (input) DOUBLE PRECISION */
+/* D (input) DOUBLE PRECISION */
+/* The scalars a, b, c, and d in the above expression. */
+/* */
+/* P (output) DOUBLE PRECISION */
+/* Q (output) DOUBLE PRECISION */
+/* The scalars p and q in the above expression. */
+/* */
+/* ===================================================================== */
+
+ if (abs(*d) < abs(*c)) {
+ e = *d / *c;
+ f = *c + *d * e;
+ t = (*a + *b * e) / f;
+ *q = (*b - *a * e) / f;
+ *p = t;
+ } else {
+ e = *c / *d;
+ f = *d + *c * e;
+ t = (*a * e + *b) / f;
+ *q = (*b * e - *a) / f;
+ *p = t;
+ }
+} /* dladiv_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.f
new file mode 100644
index 0000000000000000000000000000000000000000..9a66d34118da9fbcf846fd6b08fe407d3ee54f19
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dladiv.f
@@ -0,0 +1,63 @@
+ SUBROUTINE DLADIV( A, B, C, D, P, Q )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION A, B, C, D, P, Q
+* ..
+*
+* Purpose
+* =======
+*
+* DLADIV performs complex division in real arithmetic
+*
+* a + i*b
+* p + i*q = ---------
+* c + i*d
+*
+* The algorithm is due to Robert L. Smith and can be found
+* in D. Knuth, The art of Computer Programming, Vol.2, p.195
+*
+* Arguments
+* =========
+*
+* A (input) DOUBLE PRECISION
+* B (input) DOUBLE PRECISION
+* C (input) DOUBLE PRECISION
+* D (input) DOUBLE PRECISION
+* The scalars a, b, c, and d in the above expression.
+*
+* P (output) DOUBLE PRECISION
+* Q (output) DOUBLE PRECISION
+* The scalars p and q in the above expression.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ DOUBLE PRECISION E, F
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( ABS( D ).LT.ABS( C ) ) THEN
+ E = D / C
+ F = C + D*E
+ P = ( A+B*E ) / F
+ Q = ( B-A*E ) / F
+ ELSE
+ E = C / D
+ F = D + C*E
+ P = ( B+A*E ) / F
+ Q = ( -A+B*E ) / F
+ END IF
+*
+ RETURN
+*
+* End of DLADIV
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.c
new file mode 100644
index 0000000000000000000000000000000000000000..d57d5df3bfbdcee1d0131fe2dcb326c95a8a190a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.c
@@ -0,0 +1,283 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void dlag2_(a, lda, b, ldb, safmin, scale1, scale2, wr1, wr2, wi)
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *safmin, *scale1, *scale2, *wr1, *wr2, *wi;
+{
+ /* Local variables */
+ static doublereal diff, bmin, wbig, wabs, wdet, r, binv11, binv22,
+ discr, anorm, bnorm, bsize, shift, c1, c2, c3, c4, c5, rtmin,
+ rtmax, wsize, s1, s2, a11, a12, a21, a22, b11, b12, b22, ascale,
+ bscale, pp, qq, ss, wscale, safmax, wsmall, as11, as12, as22, sum,
+ abi22;
+
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue */
+/* problem A - w B, with scaling as necessary to avoid over-/underflow. */
+/* */
+/* The scaling factor "s" results in a modified eigenvalue equation */
+/* */
+/* s A - w B */
+/* */
+/* where s is a non-negative scaling factor chosen so that w, w B, */
+/* and s A do not overflow and, if possible, do not underflow, either. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA, 2) */
+/* On entry, the 2 x 2 matrix A. It is assumed that its 1-norm */
+/* is less than 1/SAFMIN. Entries less than */
+/* sqrt(SAFMIN)*norm(A) are subject to being treated as zero. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= 2. */
+/* */
+/* B (input) DOUBLE PRECISION array, dimension (LDB, 2) */
+/* On entry, the 2 x 2 upper triangular matrix B. It is */
+/* assumed that the one-norm of B is less than 1/SAFMIN. The */
+/* diagonals should be at least sqrt(SAFMIN) times the largest */
+/* element of B (in absolute value); if a diagonal is smaller */
+/* than that, then +/- sqrt(SAFMIN) will be used instead of */
+/* that diagonal. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= 2. */
+/* */
+/* SAFMIN (input) DOUBLE PRECISION */
+/* The smallest positive number s.t. 1/SAFMIN does not */
+/* overflow. (This should always be DLAMCH('S') -- it is an */
+/* argument in order to avoid having to call DLAMCH frequently.) */
+/* */
+/* SCALE1 (output) DOUBLE PRECISION */
+/* A scaling factor used to avoid over-/underflow in the */
+/* eigenvalue equation which defines the first eigenvalue. If */
+/* the eigenvalues are complex, then the eigenvalues are */
+/* ( WR1 +/- WI i ) / SCALE1 (which may lie outside the */
+/* exponent range of the machine), SCALE1=SCALE2, and SCALE1 */
+/* will always be positive. If the eigenvalues are real, then */
+/* the first (real) eigenvalue is WR1 / SCALE1 , but this may */
+/* overflow or underflow, and in fact, SCALE1 may be zero or */
+/* less than the underflow threshhold if the exact eigenvalue */
+/* is sufficiently large. */
+/* */
+/* SCALE2 (output) DOUBLE PRECISION */
+/* A scaling factor used to avoid over-/underflow in the */
+/* eigenvalue equation which defines the second eigenvalue. If */
+/* the eigenvalues are complex, then SCALE2=SCALE1. If the */
+/* eigenvalues are real, then the second (real) eigenvalue is */
+/* WR2 / SCALE2 , but this may overflow or underflow, and in */
+/* fact, SCALE2 may be zero or less than the underflow */
+/* threshhold if the exact eigenvalue is sufficiently large. */
+/* */
+/* WR1 (output) DOUBLE PRECISION */
+/* If the eigenvalue is real, then WR1 is SCALE1 times the */
+/* eigenvalue closest to the (2,2) element of A B**(-1). If the */
+/* eigenvalue is complex, then WR1=WR2 is SCALE1 times the real */
+/* part of the eigenvalues. */
+/* */
+/* WR2 (output) DOUBLE PRECISION */
+/* If the eigenvalue is real, then WR2 is SCALE2 times the */
+/* other eigenvalue. If the eigenvalue is complex, then */
+/* WR1=WR2 is SCALE1 times the real part of the eigenvalues. */
+/* */
+/* WI (output) DOUBLE PRECISION */
+/* If the eigenvalue is real, then WI is zero. If the */
+/* eigenvalue is complex, then WI is SCALE1 times the imaginary */
+/* part of the eigenvalues. WI will always be non-negative. */
+/* */
+/* ===================================================================== */
+
+ rtmin = sqrt(*safmin);
+ rtmax = 1. / rtmin;
+ safmax = 1. / *safmin;
+
+/* Scale A */
+
+ anorm = abs(a[0]) + abs(a[1]),
+ anorm = max(anorm, abs(a[*lda]) + abs(a[*lda + 1]));
+ anorm = max(anorm, *safmin);
+ ascale = 1. / anorm;
+ a11 = ascale * a[0];
+ a21 = ascale * a[1];
+ a12 = ascale * a[*lda];
+ a22 = ascale * a[*lda + 1];
+
+/* Perturb B if necessary to insure non-singularity */
+
+ b11 = b[0];
+ b12 = b[*ldb];
+ b22 = b[*ldb + 1];
+ bmin = rtmin * max(max(max(abs(b11),abs(b12)),abs(b22)),rtmin);
+ if (abs(b11) < bmin) {
+ b11 = d_sign(&bmin, &b11);
+ }
+ if (abs(b22) < bmin) {
+ b22 = d_sign(&bmin, &b22);
+ }
+
+/* Scale B */
+
+ bnorm = max(max(abs(b11), abs(b12)+abs(b22)), *safmin);
+ bsize = max(abs(b11),abs(b22));
+ bscale = 1. / bsize;
+ b11 *= bscale;
+ b12 *= bscale;
+ b22 *= bscale;
+
+/* Compute larger eigenvalue by method described by C. van Loan */
+
+/* ( AS is A shifted by -SHIFT*B ) */
+
+ binv11 = 1. / b11;
+ binv22 = 1. / b22;
+ s1 = a11 * binv11;
+ s2 = a22 * binv22;
+ if (abs(s1) <= abs(s2)) {
+ as12 = a12 - s1 * b12;
+ as22 = a22 - s1 * b22;
+ ss = a21 * (binv11 * binv22);
+ abi22 = as22 * binv22 - ss * b12;
+ pp = abi22 * .5;
+ shift = s1;
+ } else {
+ as12 = a12 - s2 * b12;
+ as11 = a11 - s2 * b11;
+ ss = a21 * (binv11 * binv22);
+ abi22 = -ss * b12;
+ pp = (as11 * binv11 + abi22) * .5;
+ shift = s2;
+ }
+ qq = ss * as12;
+ if (abs(pp * rtmin) >= 1.) {
+ discr = rtmin * pp; discr = discr * discr + qq * *safmin;
+ r = sqrt((abs(discr))) * rtmax;
+ } else {
+ if (pp * pp + abs(qq) <= *safmin) {
+ discr = rtmax * pp; discr = discr * discr + qq * safmax;
+ r = sqrt((abs(discr))) * rtmin;
+ } else {
+ discr = pp * pp + qq;
+ r = sqrt((abs(discr)));
+ }
+ }
+
+/* Note: the test of R in the following IF is to cover the case when */
+/* DISCR is small and negative and is flushed to zero during */
+/* the calculation of R. On machines which have a consistent */
+/* flush-to-zero threshhold and handle numbers above that */
+/* threshhold correctly, it would not be necessary. */
+
+ if (discr >= 0. || r == 0.) {
+ sum = pp + d_sign(&r, &pp);
+ diff = pp - d_sign(&r, &pp);
+ wbig = shift + sum;
+
+/* Compute smaller eigenvalue */
+
+ wsmall = shift + diff;
+ if (abs(wbig) * .5 > max(abs(wsmall),*safmin)) {
+ wdet = (a11 * a22 - a12 * a21) * (binv11 * binv22);
+ wsmall = wdet / wbig;
+ }
+
+/* Choose (real) eigenvalue closest to 2,2 element of A*B**(-1) */
+/* for WR1. */
+
+ if (pp > abi22) {
+ *wr1 = min(wbig,wsmall);
+ *wr2 = max(wbig,wsmall);
+ } else {
+ *wr1 = max(wbig,wsmall);
+ *wr2 = min(wbig,wsmall);
+ }
+ *wi = 0.;
+ } else {
+
+/* Complex eigenvalues */
+
+ *wr1 = shift + pp;
+ *wr2 = *wr1;
+ *wi = r;
+ }
+
+/* Further scaling to avoid underflow and overflow in computing */
+/* SCALE1 and overflow in computing w*B. */
+
+/* This scale factor (WSCALE) is bounded from above using C1 and C2, */
+/* and from below using C3 and C4. */
+/* C1 implements the condition s A must never overflow. */
+/* C2 implements the condition w B must never overflow. */
+/* C3, with C2, */
+/* implement the condition that s A - w B must never overflow. */
+/* C4 implements the condition s should not underflow. */
+/* C5 implements the condition max(s,|w|) should be at least 2. */
+
+ c1 = bsize * (*safmin * max(1.,ascale));
+ c2 = *safmin * max(1.,bnorm);
+ c3 = bsize * *safmin;
+ if (ascale <= 1. && bsize <= 1.) {
+ c4 = min(1., ascale / *safmin * bsize);
+ } else {
+ c4 = 1.;
+ }
+ if (ascale <= 1. || bsize <= 1.) {
+ c5 = min(1., ascale * bsize);
+ } else {
+ c5 = 1.;
+ }
+
+/* Scale first eigenvalue */
+
+ wabs = abs(*wr1) + abs(*wi);
+ wsize = min(c4, max(wabs,c5) * .5);
+ wsize = max(max(max(*safmin,c1), (wabs * c2 + c3) * 1.0000100000000001), wsize);
+ if (wsize != 1.) {
+ wscale = 1. / wsize;
+ if (wsize > 1.) {
+ *scale1 = max(ascale,bsize) * wscale * min(ascale,bsize);
+ } else {
+ *scale1 = min(ascale,bsize) * wscale * max(ascale,bsize);
+ }
+ *wr1 *= wscale;
+ if (*wi != 0.) {
+ *wi *= wscale;
+ *wr2 = *wr1;
+ *scale2 = *scale1;
+ }
+ } else {
+ *scale1 = ascale * bsize;
+ *scale2 = *scale1;
+ }
+
+/* Scale second eigenvalue (if real) */
+
+ if (*wi == 0.) {
+ wsize = min(c4, max(abs(*wr2),c5) * .5);
+ wsize = max(max(max(*safmin,c1),(abs(*wr2) * c2 + c3) * 1.0000100000000001), wsize);
+ if (wsize != 1.) {
+ wscale = 1. / wsize;
+ if (wsize > 1.) {
+ *scale2 = max(ascale,bsize) * wscale * min(ascale,bsize);
+ } else {
+ *scale2 = min(ascale,bsize) * wscale * max(ascale,bsize);
+ }
+ *wr2 *= wscale;
+ } else {
+ *scale2 = ascale * bsize;
+ }
+ }
+} /* dlag2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.f
new file mode 100644
index 0000000000000000000000000000000000000000..3cce61bb16389870389ce5624d12693e94f18146
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlag2.f
@@ -0,0 +1,301 @@
+ SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
+ $ WR2, WI )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ INTEGER LDA, LDB
+ DOUBLE PRECISION SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLAG2 computes the eigenvalues of a 2 x 2 generalized eigenvalue
+* problem A - w B, with scaling as necessary to avoid over-/underflow.
+*
+* The scaling factor "s" results in a modified eigenvalue equation
+*
+* s A - w B
+*
+* where s is a non-negative scaling factor chosen so that w, w B,
+* and s A do not overflow and, if possible, do not underflow, either.
+*
+* Arguments
+* =========
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA, 2)
+* On entry, the 2 x 2 matrix A. It is assumed that its 1-norm
+* is less than 1/SAFMIN. Entries less than
+* sqrt(SAFMIN)*norm(A) are subject to being treated as zero.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= 2.
+*
+* B (input) DOUBLE PRECISION array, dimension (LDB, 2)
+* On entry, the 2 x 2 upper triangular matrix B. It is
+* assumed that the one-norm of B is less than 1/SAFMIN. The
+* diagonals should be at least sqrt(SAFMIN) times the largest
+* element of B (in absolute value); if a diagonal is smaller
+* than that, then +/- sqrt(SAFMIN) will be used instead of
+* that diagonal.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= 2.
+*
+* SAFMIN (input) DOUBLE PRECISION
+* The smallest positive number s.t. 1/SAFMIN does not
+* overflow. (This should always be DLAMCH('S') -- it is an
+* argument in order to avoid having to call DLAMCH frequently.)
+*
+* SCALE1 (output) DOUBLE PRECISION
+* A scaling factor used to avoid over-/underflow in the
+* eigenvalue equation which defines the first eigenvalue. If
+* the eigenvalues are complex, then the eigenvalues are
+* ( WR1 +/- WI i ) / SCALE1 (which may lie outside the
+* exponent range of the machine), SCALE1=SCALE2, and SCALE1
+* will always be positive. If the eigenvalues are real, then
+* the first (real) eigenvalue is WR1 / SCALE1 , but this may
+* overflow or underflow, and in fact, SCALE1 may be zero or
+* less than the underflow threshhold if the exact eigenvalue
+* is sufficiently large.
+*
+* SCALE2 (output) DOUBLE PRECISION
+* A scaling factor used to avoid over-/underflow in the
+* eigenvalue equation which defines the second eigenvalue. If
+* the eigenvalues are complex, then SCALE2=SCALE1. If the
+* eigenvalues are real, then the second (real) eigenvalue is
+* WR2 / SCALE2 , but this may overflow or underflow, and in
+* fact, SCALE2 may be zero or less than the underflow
+* threshhold if the exact eigenvalue is sufficiently large.
+*
+* WR1 (output) DOUBLE PRECISION
+* If the eigenvalue is real, then WR1 is SCALE1 times the
+* eigenvalue closest to the (2,2) element of A B**(-1). If the
+* eigenvalue is complex, then WR1=WR2 is SCALE1 times the real
+* part of the eigenvalues.
+*
+* WR2 (output) DOUBLE PRECISION
+* If the eigenvalue is real, then WR2 is SCALE2 times the
+* other eigenvalue. If the eigenvalue is complex, then
+* WR1=WR2 is SCALE1 times the real part of the eigenvalues.
+*
+* WI (output) DOUBLE PRECISION
+* If the eigenvalue is real, then WI is zero. If the
+* eigenvalue is complex, then WI is SCALE1 times the imaginary
+* part of the eigenvalues. WI will always be non-negative.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+ DOUBLE PRECISION HALF
+ PARAMETER ( HALF = ONE / TWO )
+ DOUBLE PRECISION FUZZY1
+ PARAMETER ( FUZZY1 = ONE+1.0D-5 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION A11, A12, A21, A22, ABI22, ANORM, AS11, AS12,
+ $ AS22, ASCALE, B11, B12, B22, BINV11, BINV22,
+ $ BMIN, BNORM, BSCALE, BSIZE, C1, C2, C3, C4, C5,
+ $ DIFF, DISCR, PP, QQ, R, RTMAX, RTMIN, S1, S2,
+ $ SAFMAX, SHIFT, SS, SUM, WABS, WBIG, WDET,
+ $ WSCALE, WSIZE, WSMALL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SIGN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ RTMIN = SQRT( SAFMIN )
+ RTMAX = ONE / RTMIN
+ SAFMAX = ONE / SAFMIN
+*
+* Scale A
+*
+ ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
+ $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
+ ASCALE = ONE / ANORM
+ A11 = ASCALE*A( 1, 1 )
+ A21 = ASCALE*A( 2, 1 )
+ A12 = ASCALE*A( 1, 2 )
+ A22 = ASCALE*A( 2, 2 )
+*
+* Perturb B if necessary to insure non-singularity
+*
+ B11 = B( 1, 1 )
+ B12 = B( 1, 2 )
+ B22 = B( 2, 2 )
+ BMIN = RTMIN*MAX( ABS( B11 ), ABS( B12 ), ABS( B22 ), RTMIN )
+ IF( ABS( B11 ).LT.BMIN )
+ $ B11 = SIGN( BMIN, B11 )
+ IF( ABS( B22 ).LT.BMIN )
+ $ B22 = SIGN( BMIN, B22 )
+*
+* Scale B
+*
+ BNORM = MAX( ABS( B11 ), ABS( B12 )+ABS( B22 ), SAFMIN )
+ BSIZE = MAX( ABS( B11 ), ABS( B22 ) )
+ BSCALE = ONE / BSIZE
+ B11 = B11*BSCALE
+ B12 = B12*BSCALE
+ B22 = B22*BSCALE
+*
+* Compute larger eigenvalue by method described by C. van Loan
+*
+* ( AS is A shifted by -SHIFT*B )
+*
+ BINV11 = ONE / B11
+ BINV22 = ONE / B22
+ S1 = A11*BINV11
+ S2 = A22*BINV22
+ IF( ABS( S1 ).LE.ABS( S2 ) ) THEN
+ AS12 = A12 - S1*B12
+ AS22 = A22 - S1*B22
+ SS = A21*( BINV11*BINV22 )
+ ABI22 = AS22*BINV22 - SS*B12
+ PP = HALF*ABI22
+ SHIFT = S1
+ ELSE
+ AS12 = A12 - S2*B12
+ AS11 = A11 - S2*B11
+ SS = A21*( BINV11*BINV22 )
+ ABI22 = -SS*B12
+ PP = HALF*( AS11*BINV11+ABI22 )
+ SHIFT = S2
+ END IF
+ QQ = SS*AS12
+ IF( ABS( PP*RTMIN ).GE.ONE ) THEN
+ DISCR = ( RTMIN*PP )**2 + QQ*SAFMIN
+ R = SQRT( ABS( DISCR ) )*RTMAX
+ ELSE
+ IF( PP**2+ABS( QQ ).LE.SAFMIN ) THEN
+ DISCR = ( RTMAX*PP )**2 + QQ*SAFMAX
+ R = SQRT( ABS( DISCR ) )*RTMIN
+ ELSE
+ DISCR = PP**2 + QQ
+ R = SQRT( ABS( DISCR ) )
+ END IF
+ END IF
+*
+* Note: the test of R in the following IF is to cover the case when
+* DISCR is small and negative and is flushed to zero during
+* the calculation of R. On machines which have a consistent
+* flush-to-zero threshhold and handle numbers above that
+* threshhold correctly, it would not be necessary.
+*
+ IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN
+ SUM = PP + SIGN( R, PP )
+ DIFF = PP - SIGN( R, PP )
+ WBIG = SHIFT + SUM
+*
+* Compute smaller eigenvalue
+*
+ WSMALL = SHIFT + DIFF
+ IF( HALF*ABS( WBIG ).GT.MAX( ABS( WSMALL ), SAFMIN ) ) THEN
+ WDET = ( A11*A22-A12*A21 )*( BINV11*BINV22 )
+ WSMALL = WDET / WBIG
+ END IF
+*
+* Choose (real) eigenvalue closest to 2,2 element of A*B**(-1)
+* for WR1.
+*
+ IF( PP.GT.ABI22 ) THEN
+ WR1 = MIN( WBIG, WSMALL )
+ WR2 = MAX( WBIG, WSMALL )
+ ELSE
+ WR1 = MAX( WBIG, WSMALL )
+ WR2 = MIN( WBIG, WSMALL )
+ END IF
+ WI = ZERO
+ ELSE
+*
+* Complex eigenvalues
+*
+ WR1 = SHIFT + PP
+ WR2 = WR1
+ WI = R
+ END IF
+*
+* Further scaling to avoid underflow and overflow in computing
+* SCALE1 and overflow in computing w*B.
+*
+* This scale factor (WSCALE) is bounded from above using C1 and C2,
+* and from below using C3 and C4.
+* C1 implements the condition s A must never overflow.
+* C2 implements the condition w B must never overflow.
+* C3, with C2,
+* implement the condition that s A - w B must never overflow.
+* C4 implements the condition s should not underflow.
+* C5 implements the condition max(s,|w|) should be at least 2.
+*
+ C1 = BSIZE*( SAFMIN*MAX( ONE, ASCALE ) )
+ C2 = SAFMIN*MAX( ONE, BNORM )
+ C3 = BSIZE*SAFMIN
+ IF( ASCALE.LE.ONE .AND. BSIZE.LE.ONE ) THEN
+ C4 = MIN( ONE, ( ASCALE / SAFMIN )*BSIZE )
+ ELSE
+ C4 = ONE
+ END IF
+ IF( ASCALE.LE.ONE .OR. BSIZE.LE.ONE ) THEN
+ C5 = MIN( ONE, ASCALE*BSIZE )
+ ELSE
+ C5 = ONE
+ END IF
+*
+* Scale first eigenvalue
+*
+ WABS = ABS( WR1 ) + ABS( WI )
+ WSIZE = MAX( SAFMIN, C1, FUZZY1*( WABS*C2+C3 ),
+ $ MIN( C4, HALF*MAX( WABS, C5 ) ) )
+ IF( WSIZE.NE.ONE ) THEN
+ WSCALE = ONE / WSIZE
+ IF( WSIZE.GT.ONE ) THEN
+ SCALE1 = ( MAX( ASCALE, BSIZE )*WSCALE )*
+ $ MIN( ASCALE, BSIZE )
+ ELSE
+ SCALE1 = ( MIN( ASCALE, BSIZE )*WSCALE )*
+ $ MAX( ASCALE, BSIZE )
+ END IF
+ WR1 = WR1*WSCALE
+ IF( WI.NE.ZERO ) THEN
+ WI = WI*WSCALE
+ WR2 = WR1
+ SCALE2 = SCALE1
+ END IF
+ ELSE
+ SCALE1 = ASCALE*BSIZE
+ SCALE2 = SCALE1
+ END IF
+*
+* Scale second eigenvalue (if real)
+*
+ IF( WI.EQ.ZERO ) THEN
+ WSIZE = MAX( SAFMIN, C1, FUZZY1*( ABS( WR2 )*C2+C3 ),
+ $ MIN( C4, HALF*MAX( ABS( WR2 ), C5 ) ) )
+ IF( WSIZE.NE.ONE ) THEN
+ WSCALE = ONE / WSIZE
+ IF( WSIZE.GT.ONE ) THEN
+ SCALE2 = ( MAX( ASCALE, BSIZE )*WSCALE )*
+ $ MIN( ASCALE, BSIZE )
+ ELSE
+ SCALE2 = ( MIN( ASCALE, BSIZE )*WSCALE )*
+ $ MAX( ASCALE, BSIZE )
+ END IF
+ WR2 = WR2*WSCALE
+ ELSE
+ SCALE2 = ASCALE*BSIZE
+ END IF
+ END IF
+*
+* End of DLAG2
+*
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.c
new file mode 100644
index 0000000000000000000000000000000000000000..16ad1eb59ee324a1f2385896e0508dcbcd51eba4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.c
@@ -0,0 +1,250 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlags2_(logical *upper, doublereal *a1, doublereal *a2, doublereal *a3,
+ doublereal *b1, doublereal *b2, doublereal *b3, doublereal *csu, doublereal *snu,
+ doublereal *csv, doublereal *snv, doublereal *csq, doublereal *snq)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal aua11, aua12, aua21, aua22, avb11, avb12, avb21, avb22,
+ ua11r, ua22r, vb11r, vb22r, a, b, c, d, r, s1, s2;
+ static doublereal ua11, ua12, ua21, ua22, vb11, vb12, vb21, vb22, csl, csr, snl, snr;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such */
+/* that if ( UPPER ) then */
+/* */
+/* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 ) */
+/* ( 0 A3 ) ( x x ) */
+/* and */
+/* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 ) */
+/* ( 0 B3 ) ( x x ) */
+/* */
+/* or if ( .NOT.UPPER ) then */
+/* */
+/* U'*A*Q = U'*( A1 0 )*Q = ( x x ) */
+/* ( A2 A3 ) ( 0 x ) */
+/* and */
+/* V'*B*Q = V'*( B1 0 )*Q = ( x x ) */
+/* ( B2 B3 ) ( 0 x ) */
+/* */
+/* The rows of the transformed A and B are parallel, where */
+/* */
+/* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) */
+/* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) */
+/* */
+/* Z' denotes the transpose of Z. */
+/* */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPPER (input) LOGICAL */
+/* = .TRUE.: the input matrices A and B are upper triangular. */
+/* = .FALSE.: the input matrices A and B are lower triangular. */
+/* */
+/* A1 (input) DOUBLE PRECISION */
+/* A2 (input) DOUBLE PRECISION */
+/* A3 (input) DOUBLE PRECISION */
+/* On entry, A1, A2 and A3 are elements of the input 2-by-2 */
+/* upper (lower) triangular matrix A. */
+/* */
+/* B1 (input) DOUBLE PRECISION */
+/* B2 (input) DOUBLE PRECISION */
+/* B3 (input) DOUBLE PRECISION */
+/* On entry, B1, B2 and B3 are elements of the input 2-by-2 */
+/* upper (lower) triangular matrix B. */
+/* */
+/* CSU (output) DOUBLE PRECISION */
+/* SNU (output) DOUBLE PRECISION */
+/* The desired orthogonal matrix U. */
+/* */
+/* CSV (output) DOUBLE PRECISION */
+/* SNV (output) DOUBLE PRECISION */
+/* The desired orthogonal matrix V. */
+/* */
+/* CSQ (output) DOUBLE PRECISION */
+/* SNQ (output) DOUBLE PRECISION */
+/* The desired orthogonal matrix Q. */
+/* */
+/* ===================================================================== */
+
+ if (*upper) {
+
+/* Input matrices A and B are upper triangular matrices */
+
+/* Form matrix C = A*adj(B) = ( a b ) */
+/* ( 0 d ) */
+
+ a = *a1 * *b3;
+ d = *a3 * *b1;
+ b = *a2 * *b1 - *a1 * *b2;
+
+/* The SVD of real 2-by-2 triangular C */
+
+/* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 ) */
+/* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T ) */
+
+ dlasv2_(&a, &b, &d, &s1, &s2, &snr, &csr, &snl, &csl);
+
+ if (abs(csl) >= abs(snl) || abs(csr) >= abs(snr)) {
+
+/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, */
+/* and (1,2) element of |U|'*|A| and |V|'*|B|. */
+
+ ua11r = csl * *a1;
+ ua12 = csl * *a2 + snl * *a3;
+
+ vb11r = csr * *b1;
+ vb12 = csr * *b2 + snr * *b3;
+
+ aua12 = abs(csl) * abs(*a2) + abs(snl) * abs(*a3);
+ avb12 = abs(csr) * abs(*b2) + abs(snr) * abs(*b3);
+
+/* zero (1,2) elements of U'*A and V'*B */
+
+ if (abs(ua11r) + abs(ua12) != 0.) {
+ if (aua12 / (abs(ua11r) + abs(ua12)) <= avb12 / (abs(vb11r) + abs(vb12))) {
+ d__1 = -ua11r;
+ dlartg_(&d__1, &ua12, csq, snq, &r);
+ } else {
+ d__1 = -vb11r;
+ dlartg_(&d__1, &vb12, csq, snq, &r);
+ }
+ } else {
+ d__1 = -vb11r;
+ dlartg_(&d__1, &vb12, csq, snq, &r);
+ }
+
+ *csu = csl;
+ *snu = -snl;
+ *csv = csr;
+ *snv = -snr;
+
+ } else {
+
+/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, */
+/* and (2,2) element of |U|'*|A| and |V|'*|B|. */
+
+ ua21 = -snl * *a1;
+ ua22 = -snl * *a2 + csl * *a3;
+
+ vb21 = -snr * *b1;
+ vb22 = -snr * *b2 + csr * *b3;
+
+ aua22 = abs(snl) * abs(*a2) + abs(csl) * abs(*a3);
+ avb22 = abs(snr) * abs(*b2) + abs(csr) * abs(*b3);
+
+/* zero (2,2) elements of U'*A and V'*B, and then swap. */
+
+ if (abs(ua21) + abs(ua22) != 0.) {
+ if (aua22 / (abs(ua21) + abs(ua22)) <= avb22 / (abs(vb21) + abs(vb22))) {
+ d__1 = -ua21;
+ dlartg_(&d__1, &ua22, csq, snq, &r);
+ } else {
+ d__1 = -vb21;
+ dlartg_(&d__1, &vb22, csq, snq, &r);
+ }
+ } else {
+ d__1 = -vb21;
+ dlartg_(&d__1, &vb22, csq, snq, &r);
+ }
+
+ *csu = snl;
+ *snu = csl;
+ *csv = snr;
+ *snv = csr;
+ }
+
+ } else {
+
+/* Input matrices A and B are lower triangular matrices */
+
+/* Form matrix C = A*adj(B) = ( a 0 ) */
+/* ( c d ) */
+
+ a = *a1 * *b3;
+ d = *a3 * *b1;
+ c = *a2 * *b3 - *a3 * *b2;
+
+/* The SVD of real 2-by-2 triangular C */
+
+/* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 ) */
+/* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T ) */
+
+ dlasv2_(&a, &c, &d, &s1, &s2, &snr, &csr, &snl, &csl);
+
+ if (abs(csr) >= abs(snr) || abs(csl) >= abs(snl)) {
+
+/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, */
+/* and (2,1) element of |U|'*|A| and |V|'*|B|. */
+
+ ua21 = -snr * *a1 + csr * *a2;
+ ua22r = csr * *a3;
+
+ vb21 = -snl * *b1 + csl * *b2;
+ vb22r = csl * *b3;
+
+ aua21 = abs(snr) * abs(*a1) + abs(csr) * abs(*a2);
+ avb21 = abs(snl) * abs(*b1) + abs(csl) * abs(*b2);
+
+/* zero (2,1) elements of U'*A and V'*B. */
+
+ if (abs(ua21) + abs(ua22r) != 0.) {
+ if (aua21 / (abs(ua21) + abs(ua22r)) <= avb21 / (abs(vb21) + abs(vb22r))) {
+ dlartg_(&ua22r, &ua21, csq, snq, &r);
+ } else {
+ dlartg_(&vb22r, &vb21, csq, snq, &r);
+ }
+ } else {
+ dlartg_(&vb22r, &vb21, csq, snq, &r);
+ }
+
+ *csu = csr;
+ *snu = -snr;
+ *csv = csl;
+ *snv = -snl;
+
+ } else {
+
+/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, */
+/* and (1,1) element of |U|'*|A| and |V|'*|B|. */
+
+ ua11 = csr * *a1 + snr * *a2;
+ ua12 = snr * *a3;
+
+ vb11 = csl * *b1 + snl * *b2;
+ vb12 = snl * *b3;
+
+ aua11 = abs(csr) * abs(*a1) + abs(snr) * abs(*a2);
+ avb11 = abs(csl) * abs(*b1) + abs(snl) * abs(*b2);
+
+/* zero (1,1) elements of U'*A and V'*B, and then swap. */
+
+ if (abs(ua11) + abs(ua12) != 0.) {
+ if (aua11 / (abs(ua11) + abs(ua12)) <= avb11 / (abs(vb11) + abs(vb12))) {
+ dlartg_(&ua12, &ua11, csq, snq, &r);
+ } else {
+ dlartg_(&vb12, &vb11, csq, snq, &r);
+ }
+ } else {
+ dlartg_(&vb12, &vb11, csq, snq, &r);
+ }
+
+ *csu = snr;
+ *snu = csr;
+ *csv = snl;
+ *snv = csl;
+ }
+ }
+} /* dlags2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.f
new file mode 100644
index 0000000000000000000000000000000000000000..5b7d4e6a6eaf34d63384de8572d02819a17410b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlags2.f
@@ -0,0 +1,270 @@
+ SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
+ $ SNV, CSQ, SNQ )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ LOGICAL UPPER
+ DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
+ $ SNU, SNV
+* ..
+*
+* Purpose
+* =======
+*
+* DLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+* that if ( UPPER ) then
+*
+* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+* ( 0 A3 ) ( x x )
+* and
+* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+* ( 0 B3 ) ( x x )
+*
+* or if ( .NOT.UPPER ) then
+*
+* U'*A*Q = U'*( A1 0 )*Q = ( x x )
+* ( A2 A3 ) ( 0 x )
+* and
+* V'*B*Q = V'*( B1 0 )*Q = ( x x )
+* ( B2 B3 ) ( 0 x )
+*
+* The rows of the transformed A and B are parallel, where
+*
+* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+*
+* Z' denotes the transpose of Z.
+*
+*
+* Arguments
+* =========
+*
+* UPPER (input) LOGICAL
+* = .TRUE.: the input matrices A and B are upper triangular.
+* = .FALSE.: the input matrices A and B are lower triangular.
+*
+* A1 (input) DOUBLE PRECISION
+* A2 (input) DOUBLE PRECISION
+* A3 (input) DOUBLE PRECISION
+* On entry, A1, A2 and A3 are elements of the input 2-by-2
+* upper (lower) triangular matrix A.
+*
+* B1 (input) DOUBLE PRECISION
+* B2 (input) DOUBLE PRECISION
+* B3 (input) DOUBLE PRECISION
+* On entry, B1, B2 and B3 are elements of the input 2-by-2
+* upper (lower) triangular matrix B.
+*
+* CSU (output) DOUBLE PRECISION
+* SNU (output) DOUBLE PRECISION
+* The desired orthogonal matrix U.
+*
+* CSV (output) DOUBLE PRECISION
+* SNV (output) DOUBLE PRECISION
+* The desired orthogonal matrix V.
+*
+* CSQ (output) DOUBLE PRECISION
+* SNQ (output) DOUBLE PRECISION
+* The desired orthogonal matrix Q.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION A, AUA11, AUA12, AUA21, AUA22, AVB12, AVB11,
+ $ AVB21, AVB22, B, C, CSL, CSR, D, R, S1, S2,
+ $ SNL, SNR, UA11, UA11R, UA12, UA21, UA22,
+ $ UA22R, VB11, VB11R, VB12, VB21, VB22, VB22R
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARTG, DLASV2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( UPPER ) THEN
+*
+* Input matrices A and B are upper triangular matrices
+*
+* Form matrix C = A*adj(B) = ( a b )
+* ( 0 d )
+*
+ A = A1*B3
+ D = A3*B1
+ B = A2*B1 - A1*B2
+*
+* The SVD of real 2-by-2 triangular C
+*
+* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 )
+* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T )
+*
+ CALL DLASV2( A, B, D, S1, S2, SNR, CSR, SNL, CSL )
+*
+ IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) )
+ $ THEN
+*
+* Compute the (1,1) and (1,2) elements of U'*A and V'*B,
+* and (1,2) element of |U|'*|A| and |V|'*|B|.
+*
+ UA11R = CSL*A1
+ UA12 = CSL*A2 + SNL*A3
+*
+ VB11R = CSR*B1
+ VB12 = CSR*B2 + SNR*B3
+*
+ AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 )
+ AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 )
+*
+* zero (1,2) elements of U'*A and V'*B
+*
+ IF( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN
+ IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 /
+ $ ( ABS( VB11R )+ABS( VB12 ) ) ) THEN
+ CALL DLARTG( -UA11R, UA12, CSQ, SNQ, R )
+ ELSE
+ CALL DLARTG( -VB11R, VB12, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL DLARTG( -VB11R, VB12, CSQ, SNQ, R )
+ END IF
+*
+ CSU = CSL
+ SNU = -SNL
+ CSV = CSR
+ SNV = -SNR
+*
+ ELSE
+*
+* Compute the (2,1) and (2,2) elements of U'*A and V'*B,
+* and (2,2) element of |U|'*|A| and |V|'*|B|.
+*
+ UA21 = -SNL*A1
+ UA22 = -SNL*A2 + CSL*A3
+*
+ VB21 = -SNR*B1
+ VB22 = -SNR*B2 + CSR*B3
+*
+ AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 )
+ AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 )
+*
+* zero (2,2) elements of U'*A and V'*B, and then swap.
+*
+ IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN
+ IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 /
+ $ ( ABS( VB21 )+ABS( VB22 ) ) ) THEN
+ CALL DLARTG( -UA21, UA22, CSQ, SNQ, R )
+ ELSE
+ CALL DLARTG( -VB21, VB22, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL DLARTG( -VB21, VB22, CSQ, SNQ, R )
+ END IF
+*
+ CSU = SNL
+ SNU = CSL
+ CSV = SNR
+ SNV = CSR
+*
+ END IF
+*
+ ELSE
+*
+* Input matrices A and B are lower triangular matrices
+*
+* Form matrix C = A*adj(B) = ( a 0 )
+* ( c d )
+*
+ A = A1*B3
+ D = A3*B1
+ C = A2*B3 - A3*B2
+*
+* The SVD of real 2-by-2 triangular C
+*
+* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 )
+* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T )
+*
+ CALL DLASV2( A, C, D, S1, S2, SNR, CSR, SNL, CSL )
+*
+ IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) )
+ $ THEN
+*
+* Compute the (2,1) and (2,2) elements of U'*A and V'*B,
+* and (2,1) element of |U|'*|A| and |V|'*|B|.
+*
+ UA21 = -SNR*A1 + CSR*A2
+ UA22R = CSR*A3
+*
+ VB21 = -SNL*B1 + CSL*B2
+ VB22R = CSL*B3
+*
+ AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 )
+ AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 )
+*
+* zero (2,1) elements of U'*A and V'*B.
+*
+ IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN
+ IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 /
+ $ ( ABS( VB21 )+ABS( VB22R ) ) ) THEN
+ CALL DLARTG( UA22R, UA21, CSQ, SNQ, R )
+ ELSE
+ CALL DLARTG( VB22R, VB21, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL DLARTG( VB22R, VB21, CSQ, SNQ, R )
+ END IF
+*
+ CSU = CSR
+ SNU = -SNR
+ CSV = CSL
+ SNV = -SNL
+*
+ ELSE
+*
+* Compute the (1,1) and (1,2) elements of U'*A and V'*B,
+* and (1,1) element of |U|'*|A| and |V|'*|B|.
+*
+ UA11 = CSR*A1 + SNR*A2
+ UA12 = SNR*A3
+*
+ VB11 = CSL*B1 + SNL*B2
+ VB12 = SNL*B3
+*
+ AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 )
+ AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 )
+*
+* zero (1,1) elements of U'*A and V'*B, and then swap.
+*
+ IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN
+ IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /
+ $ ( ABS( VB11 )+ABS( VB12 ) ) ) THEN
+ CALL DLARTG( UA12, UA11, CSQ, SNQ, R )
+ ELSE
+ CALL DLARTG( VB12, VB11, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL DLARTG( VB12, VB11, CSQ, SNQ, R )
+ END IF
+*
+ CSU = SNR
+ SNU = CSR
+ CSV = SNL
+ SNV = CSL
+*
+ END IF
+*
+ END IF
+*
+ RETURN
+*
+* End of DLAGS2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.c
new file mode 100644
index 0000000000000000000000000000000000000000..3d99ae313130775686883bb23abdbb07a1d6fa0a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.c
@@ -0,0 +1,254 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+
+static integer c__2 = 2;
+static integer c__1 = 1;
+
+/* Subroutine */ void dlagv2_(a, lda, b, ldb, alphar, alphai, beta, csl, snl, csr, snr)
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *alphar, *alphai, *beta, *csl, *snl, *csr, *snr;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal r, t, anorm, bnorm, h1, h2, h3, scale1, scale2;
+ static doublereal ascale, bscale;
+ static doublereal wi, qq, rr, safmin;
+ static doublereal wr1, wr2, ulp;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 */
+/* matrix pencil (A,B) where B is upper triangular. This routine */
+/* computes orthogonal (rotation) matrices given by CSL, SNL and CSR, */
+/* SNR such that */
+/* */
+/* 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0 */
+/* types), then */
+/* */
+/* [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] */
+/* [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] */
+/* */
+/* [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] */
+/* [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ], */
+/* */
+/* 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues, */
+/* then */
+/* */
+/* [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ] */
+/* [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ] */
+/* */
+/* [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ] */
+/* [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ] */
+/* */
+/* where b11 >= b22 > 0. */
+/* */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA, 2) */
+/* On entry, the 2 x 2 matrix A. */
+/* On exit, A is overwritten by the ``A-part'' of the */
+/* generalized Schur form. */
+/* */
+/* LDA (input) INTEGER */
+/* THe leading dimension of the array A. LDA >= 2. */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB, 2) */
+/* On entry, the upper triangular 2 x 2 matrix B. */
+/* On exit, B is overwritten by the ``B-part'' of the */
+/* generalized Schur form. */
+/* */
+/* LDB (input) INTEGER */
+/* THe leading dimension of the array B. LDB >= 2. */
+/* */
+/* ALPHAR (output) DOUBLE PRECISION array, dimension (2) */
+/* ALPHAI (output) DOUBLE PRECISION array, dimension (2) */
+/* BETA (output) DOUBLE PRECISION array, dimension (2) */
+/* (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the */
+/* pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may */
+/* be zero. */
+/* */
+/* CSL (output) DOUBLE PRECISION */
+/* The cosine of the left rotation matrix. */
+/* */
+/* SNL (output) DOUBLE PRECISION */
+/* The sine of the left rotation matrix. */
+/* */
+/* CSR (output) DOUBLE PRECISION */
+/* The cosine of the right rotation matrix. */
+/* */
+/* SNR (output) DOUBLE PRECISION */
+/* The sine of the right rotation matrix. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Based on contributions by */
+/* Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA */
+/* */
+/* ===================================================================== */
+
+ safmin = dlamch_("S");
+ ulp = dlamch_("P");
+
+ /* Scale A */
+
+ anorm = max(max(abs(a[0]) + abs(a[1]), abs(a[*lda]) + abs(a[*lda + 1])), safmin);
+ ascale = 1. / anorm;
+ a[0] *= ascale;
+ a[1] *= ascale;
+ a[*lda] *= ascale;
+ a[*lda + 1] *= ascale;
+
+ /* Scale B */
+
+ bnorm = max(max(abs(b[0]), abs(b[*ldb]) + abs(b[*ldb + 1])), safmin);
+ bscale = 1. / bnorm;
+ b[0] *= bscale;
+ b[*ldb] *= bscale;
+ b[*ldb + 1] *= bscale;
+
+ /* Check if A can be deflated */
+
+ if (abs(a[1]) <= ulp) {
+ *csl = 1.;
+ *snl = 0.;
+ *csr = 1.;
+ *snr = 0.;
+ a[1] = 0.;
+ b[1] = 0.;
+ }
+
+ /* Check if B is singular */
+
+ else if (abs(b[0]) <= ulp) {
+ dlartg_(a, a+1, csl, snl, &r);
+ *csr = 1.;
+ *snr = 0.;
+ drot_(&c__2, a, lda, a+1, lda, csl, snl);
+ drot_(&c__2, b, ldb, b+1, ldb, csl, snl);
+ a[1] = 0.;
+ b[0] = 0.;
+ b[1] = 0.;
+ }
+ else if (abs(b[*ldb + 1]) <= ulp) {
+ dlartg_(&a[*lda + 1], a+1, csr, snr, &t);
+ *snr = -(*snr);
+ drot_(&c__2, a, &c__1, &a[*lda], &c__1, csr, snr);
+ drot_(&c__2, b, &c__1, &b[*ldb], &c__1, csr, snr);
+ *csl = 1.;
+ *snl = 0.;
+ a[1] = 0.;
+ b[1] = 0.;
+ b[*ldb + 1] = 0.;
+ }
+ else
+ {
+ /* B is nonsingular, first compute the eigenvalues of (A,B) */
+ dlag2_(a, lda, b, ldb, &safmin, &scale1, &scale2, &wr1, &wr2, &wi);
+
+ if (wi == 0.)
+ {
+ /* two real eigenvalues, compute s*A-w*B */
+ h1 = scale1 * a[0] - wr1 * b[0];
+ h2 = scale1 * a[*lda ] - wr1 * b[*ldb ];
+ h3 = scale1 * a[*lda + 1] - wr1 * b[*ldb + 1];
+
+ rr = dlapy2_(&h1, &h2);
+ d__1 = scale1 * a[1];
+ qq = dlapy2_(&d__1, &h3);
+
+ if (rr > qq) /* find right rotation matrix to zero 1,1 element of (sA - wB) */
+ dlartg_(&h2, &h1, csr, snr, &t);
+ else /* find right rotation matrix to zero 2,1 element of (sA - wB) */
+ {
+ d__1 = scale1 * a[1];
+ dlartg_(&h3, &d__1, csr, snr, &t);
+ }
+
+ *snr = -(*snr);
+ drot_(&c__2, a, &c__1, &a[*lda], &c__1, csr, snr);
+ drot_(&c__2, b, &c__1, &b[*ldb], &c__1, csr, snr);
+
+ /* compute inf norms of A and B */
+
+ h1 = max(abs(a[0]) + abs(a[*lda]),
+ abs(a[1]) + abs(a[*lda + 1]));
+ h2 = max(abs(b[0]) + abs(b[*ldb]),
+ abs(b[1]) + abs(b[*ldb + 1]));
+
+ if (scale1 * h1 >= abs(wr1) * h2) /* find left rotation matrix Q to zero out B(2,1) */
+ dlartg_(b, b+1, csl, snl, &r);
+ else /* find left rotation matrix Q to zero out A(2,1) */
+ dlartg_(a, a+1, csl, snl, &r);
+
+ drot_(&c__2, a, lda, a+1, lda, csl, snl);
+ drot_(&c__2, b, ldb, b+1, ldb, csl, snl);
+
+ a[1] = 0.;
+ b[1] = 0.;
+ }
+ else
+ {
+ /* a pair of complex conjugate eigenvalues */
+ /* first compute the SVD of the matrix B */
+
+ dlasv2_(b, &b[*ldb], &b[*ldb + 1], &r, &t, snr, csr, snl, csl);
+
+ /* Form (A,B) := Q(A,B)Z' where Q is left rotation matrix and */
+ /* Z is right rotation matrix computed from DLASV2 */
+
+ drot_(&c__2, a, lda, a+1, lda, csl, snl);
+ drot_(&c__2, b, ldb, b+1, ldb, csl, snl);
+ drot_(&c__2, a, &c__1, &a[*lda], &c__1, csr, snr);
+ drot_(&c__2, b, &c__1, &b[*ldb], &c__1, csr, snr);
+
+ b[1] = 0.;
+ b[*ldb] = 0.;
+ }
+ }
+
+ /* Unscaling */
+
+ a[0] *= anorm;
+ a[1] *= anorm;
+ a[*lda] *= anorm;
+ a[*lda + 1] *= anorm;
+ b[0] *= bnorm;
+ b[1] *= bnorm;
+ b[*ldb] *= bnorm;
+ b[*ldb + 1] *= bnorm;
+
+ if (wi == 0.) {
+ alphar[0] = a[0];
+ alphar[1] = a[*lda + 1];
+ alphai[0] = 0.;
+ alphai[1] = 0.;
+ beta[0] = b[0];
+ beta[1] = b[*ldb + 1];
+ }
+ else {
+ alphar[0] = anorm * wr1 / scale1 / bnorm;
+ alphai[0] = anorm * wi / scale1 / bnorm;
+ alphar[1] = alphar[0];
+ alphai[1] = -alphai[0];
+ beta[0] = 1.;
+ beta[1] = 1.;
+ }
+} /* dlagv2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.f
new file mode 100644
index 0000000000000000000000000000000000000000..2ed2473b0936213a1cb08debd5a6fa9c879649ae
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlagv2.f
@@ -0,0 +1,290 @@
+ SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
+ $ CSR, SNR )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER LDA, LDB
+ DOUBLE PRECISION CSL, CSR, SNL, SNR
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
+ $ B( LDB, * ), BETA( 2 )
+* ..
+*
+* Purpose
+* =======
+*
+* DLAGV2 computes the Generalized Schur factorization of a real 2-by-2
+* matrix pencil (A,B) where B is upper triangular. This routine
+* computes orthogonal (rotation) matrices given by CSL, SNL and CSR,
+* SNR such that
+*
+* 1) if the pencil (A,B) has two real eigenvalues (include 0/0 or 1/0
+* types), then
+*
+* [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+* [ 0 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+*
+* [ b11 b12 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+* [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ],
+*
+* 2) if the pencil (A,B) has a pair of complex conjugate eigenvalues,
+* then
+*
+* [ a11 a12 ] := [ CSL SNL ] [ a11 a12 ] [ CSR -SNR ]
+* [ a21 a22 ] [ -SNL CSL ] [ a21 a22 ] [ SNR CSR ]
+*
+* [ b11 0 ] := [ CSL SNL ] [ b11 b12 ] [ CSR -SNR ]
+* [ 0 b22 ] [ -SNL CSL ] [ 0 b22 ] [ SNR CSR ]
+*
+* where b11 >= b22 > 0.
+*
+*
+* Arguments
+* =========
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA, 2)
+* On entry, the 2 x 2 matrix A.
+* On exit, A is overwritten by the ``A-part'' of the
+* generalized Schur form.
+*
+* LDA (input) INTEGER
+* THe leading dimension of the array A. LDA >= 2.
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB, 2)
+* On entry, the upper triangular 2 x 2 matrix B.
+* On exit, B is overwritten by the ``B-part'' of the
+* generalized Schur form.
+*
+* LDB (input) INTEGER
+* THe leading dimension of the array B. LDB >= 2.
+*
+* ALPHAR (output) DOUBLE PRECISION array, dimension (2)
+* ALPHAI (output) DOUBLE PRECISION array, dimension (2)
+* BETA (output) DOUBLE PRECISION array, dimension (2)
+* (ALPHAR(k)+i*ALPHAI(k))/BETA(k) are the eigenvalues of the
+* pencil (A,B), k=1,2, i = sqrt(-1). Note that BETA(k) may
+* be zero.
+*
+* CSL (output) DOUBLE PRECISION
+* The cosine of the left rotation matrix.
+*
+* SNL (output) DOUBLE PRECISION
+* The sine of the left rotation matrix.
+*
+* CSR (output) DOUBLE PRECISION
+* The cosine of the right rotation matrix.
+*
+* SNR (output) DOUBLE PRECISION
+* The sine of the right rotation matrix.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION ANORM, ASCALE, BNORM, BSCALE, H1, H2, H3, QQ,
+ $ R, RR, SAFMIN, SCALE1, SCALE2, T, ULP, WI, WR1,
+ $ WR2
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAG2, DLARTG, DLASV2, DROT
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY2
+ EXTERNAL DLAMCH, DLAPY2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX
+* ..
+* .. Executable Statements ..
+*
+ SAFMIN = DLAMCH( 'S' )
+ ULP = DLAMCH( 'P' )
+*
+* Scale A
+*
+ ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
+ $ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
+ ASCALE = ONE / ANORM
+ A( 1, 1 ) = ASCALE*A( 1, 1 )
+ A( 1, 2 ) = ASCALE*A( 1, 2 )
+ A( 2, 1 ) = ASCALE*A( 2, 1 )
+ A( 2, 2 ) = ASCALE*A( 2, 2 )
+*
+* Scale B
+*
+ BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 1, 2 ) )+ABS( B( 2, 2 ) ),
+ $ SAFMIN )
+ BSCALE = ONE / BNORM
+ B( 1, 1 ) = BSCALE*B( 1, 1 )
+ B( 1, 2 ) = BSCALE*B( 1, 2 )
+ B( 2, 2 ) = BSCALE*B( 2, 2 )
+*
+* Check if A can be deflated
+*
+ IF( ABS( A( 2, 1 ) ).LE.ULP ) THEN
+ CSL = ONE
+ SNL = ZERO
+ CSR = ONE
+ SNR = ZERO
+ A( 2, 1 ) = ZERO
+ B( 2, 1 ) = ZERO
+*
+* Check if B is singular
+*
+ ELSE IF( ABS( B( 1, 1 ) ).LE.ULP ) THEN
+ CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
+ CSR = ONE
+ SNR = ZERO
+ CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
+ CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
+ A( 2, 1 ) = ZERO
+ B( 1, 1 ) = ZERO
+ B( 2, 1 ) = ZERO
+*
+ ELSE IF( ABS( B( 2, 2 ) ).LE.ULP ) THEN
+ CALL DLARTG( A( 2, 2 ), A( 2, 1 ), CSR, SNR, T )
+ SNR = -SNR
+ CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
+ CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
+ CSL = ONE
+ SNL = ZERO
+ A( 2, 1 ) = ZERO
+ B( 2, 1 ) = ZERO
+ B( 2, 2 ) = ZERO
+*
+ ELSE
+*
+* B is nonsingular, first compute the eigenvalues of (A,B)
+*
+ CALL DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2,
+ $ WI )
+*
+ IF( WI.EQ.ZERO ) THEN
+*
+* two real eigenvalues, compute s*A-w*B
+*
+ H1 = SCALE1*A( 1, 1 ) - WR1*B( 1, 1 )
+ H2 = SCALE1*A( 1, 2 ) - WR1*B( 1, 2 )
+ H3 = SCALE1*A( 2, 2 ) - WR1*B( 2, 2 )
+*
+ RR = DLAPY2( H1, H2 )
+ QQ = DLAPY2( SCALE1*A( 2, 1 ), H3 )
+*
+ IF( RR.GT.QQ ) THEN
+*
+* find right rotation matrix to zero 1,1 element of
+* (sA - wB)
+*
+ CALL DLARTG( H2, H1, CSR, SNR, T )
+*
+ ELSE
+*
+* find right rotation matrix to zero 2,1 element of
+* (sA - wB)
+*
+ CALL DLARTG( H3, SCALE1*A( 2, 1 ), CSR, SNR, T )
+*
+ END IF
+*
+ SNR = -SNR
+ CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
+ CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
+*
+* compute inf norms of A and B
+*
+ H1 = MAX( ABS( A( 1, 1 ) )+ABS( A( 1, 2 ) ),
+ $ ABS( A( 2, 1 ) )+ABS( A( 2, 2 ) ) )
+ H2 = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
+ $ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
+*
+ IF( ( SCALE1*H1 ).GE.ABS( WR1 )*H2 ) THEN
+*
+* find left rotation matrix Q to zero out B(2,1)
+*
+ CALL DLARTG( B( 1, 1 ), B( 2, 1 ), CSL, SNL, R )
+*
+ ELSE
+*
+* find left rotation matrix Q to zero out A(2,1)
+*
+ CALL DLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
+*
+ END IF
+*
+ CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
+ CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
+*
+ A( 2, 1 ) = ZERO
+ B( 2, 1 ) = ZERO
+*
+ ELSE
+*
+* a pair of complex conjugate eigenvalues
+* first compute the SVD of the matrix B
+*
+ CALL DLASV2( B( 1, 1 ), B( 1, 2 ), B( 2, 2 ), R, T, SNR,
+ $ CSR, SNL, CSL )
+*
+* Form (A,B) := Q(A,B)Z' where Q is left rotation matrix and
+* Z is right rotation matrix computed from DLASV2
+*
+ CALL DROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
+ CALL DROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
+ CALL DROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
+ CALL DROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
+*
+ B( 2, 1 ) = ZERO
+ B( 1, 2 ) = ZERO
+*
+ END IF
+*
+ END IF
+*
+* Unscaling
+*
+ A( 1, 1 ) = ANORM*A( 1, 1 )
+ A( 2, 1 ) = ANORM*A( 2, 1 )
+ A( 1, 2 ) = ANORM*A( 1, 2 )
+ A( 2, 2 ) = ANORM*A( 2, 2 )
+ B( 1, 1 ) = BNORM*B( 1, 1 )
+ B( 2, 1 ) = BNORM*B( 2, 1 )
+ B( 1, 2 ) = BNORM*B( 1, 2 )
+ B( 2, 2 ) = BNORM*B( 2, 2 )
+*
+ IF( WI.EQ.ZERO ) THEN
+ ALPHAR( 1 ) = A( 1, 1 )
+ ALPHAR( 2 ) = A( 2, 2 )
+ ALPHAI( 1 ) = ZERO
+ ALPHAI( 2 ) = ZERO
+ BETA( 1 ) = B( 1, 1 )
+ BETA( 2 ) = B( 2, 2 )
+ ELSE
+ ALPHAR( 1 ) = ANORM*WR1 / SCALE1 / BNORM
+ ALPHAI( 1 ) = ANORM*WI / SCALE1 / BNORM
+ ALPHAR( 2 ) = ALPHAR( 1 )
+ ALPHAI( 2 ) = -ALPHAI( 1 )
+ BETA( 1 ) = ONE
+ BETA( 2 ) = ONE
+ END IF
+*
+ 10 CONTINUE
+*
+ RETURN
+*
+* End of DLAGV2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.c
new file mode 100644
index 0000000000000000000000000000000000000000..c89b36dc515223edb6843c58e9073ea7d112ee02
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.c
@@ -0,0 +1,805 @@
+#include "f2c.h"
+#include "netlib.h"
+#include <stdio.h>
+
+/* There are too many problems in this file created by the MSVC
+ optimizer. Just disable it. */
+#if defined(_MSC_VER)
+# pragma optimize("", off)
+#endif
+
+/* The same optimization issues hold for the intel compiler */
+#if defined(__INTEL_COMPILER)
+# pragma optimize("", off)
+#endif
+
+void dlamc1_(integer *beta, integer *t, logical *rnd, logical *ieee1);
+void dlamc2_(integer *beta, integer *t, logical *rnd, doublereal *eps,
+ integer *emin, doublereal *rmin, integer *emax, doublereal *rmax);
+doublereal dlamc3_(doublereal *a, doublereal *b);
+void dlamc4_(integer *emin, doublereal *start, integer *base);
+void dlamc5_(integer *beta, integer *p, integer *emin, logical *ieee, integer *emax, doublereal *rmax);
+doublereal dlamc33_(doublereal *a, doublereal *b);
+
+doublereal dlamch_(const char *cmach)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ DLAMCH determines double precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by DLAMCH:
+ = 'E' or 'e', DLAMCH := eps
+ = 'S' or 's , DLAMCH := sfmin
+ = 'B' or 'b', DLAMCH := base
+ = 'P' or 'p', DLAMCH := eps*base
+ = 'N' or 'n', DLAMCH := t
+ = 'R' or 'r', DLAMCH := rnd
+ = 'M' or 'm', DLAMCH := emin
+ = 'U' or 'u', DLAMCH := rmin
+ = 'L' or 'l', DLAMCH := emax
+ = 'O' or 'o', DLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+*/
+ /* Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ integer i__1;
+ /* Local variables */
+ static doublereal base;
+ static integer beta;
+ static doublereal emin, prec, emax;
+ static integer imin, imax;
+ static logical lrnd;
+ static doublereal rmin, rmax, t, rmach;
+ static doublereal small, sfmin;
+ static integer it;
+ static doublereal rnd, eps;
+
+ if (first) {
+ first = FALSE_;
+ dlamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);
+ base = (doublereal) beta;
+ t = (doublereal) it;
+ if (lrnd) {
+ rnd = 1.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1) / 2;
+ } else {
+ rnd = 0.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1);
+ }
+ prec = eps * base;
+ emin = (doublereal) imin;
+ emax = (doublereal) imax;
+ sfmin = rmin;
+ small = 1. / rmax;
+ if (small >= sfmin) {
+
+/* Use SMALL plus a bit, to avoid the possibility of rounding
+ causing overflow when computing 1/sfmin.
+*/
+
+ sfmin = small * (eps + 1.);
+ }
+ }
+
+ if (lsame_(cmach, "E")) {
+ rmach = eps;
+ } else if (lsame_(cmach, "S")) {
+ rmach = sfmin;
+ } else if (lsame_(cmach, "B")) {
+ rmach = base;
+ } else if (lsame_(cmach, "P")) {
+ rmach = prec;
+ } else if (lsame_(cmach, "N")) {
+ rmach = t;
+ } else if (lsame_(cmach, "R")) {
+ rmach = rnd;
+ } else if (lsame_(cmach, "M")) {
+ rmach = emin;
+ } else if (lsame_(cmach, "U")) {
+ rmach = rmin;
+ } else if (lsame_(cmach, "L")) {
+ rmach = emax;
+ } else if (lsame_(cmach, "O")) {
+ rmach = rmax;
+ }
+
+ return rmach;
+
+} /* dlamch_ */
+
+/* Subroutine */
+void dlamc1_(integer *beta, integer *t, logical *rnd, logical *ieee1)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ DLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+*/
+ /* Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ doublereal d__1, d__2;
+ /* Local variables */
+ static logical lrnd;
+ static doublereal a, b, c, f;
+ static integer lbeta;
+ static doublereal savec;
+ static logical lieee1;
+ static doublereal t1, t2;
+ static integer lt;
+ static doublereal one = 1., qtr;
+
+ if (first) {
+ first = FALSE_;
+
+/* LBETA, LIEEE1, LT and LRND are the local values of BETA,
+ IEEE1, T and RND.
+
+ Throughout this routine we use the function DLAMC3 to ensure
+ that relevant values are stored and not held in registers, or
+ are not affected by optimizers.
+
+ Compute a = 2.0**m with the smallest positive integer m such
+ that
+ fl( a + 1.0 ) = a.
+*/
+
+ a = c = one;
+
+ while (c == one) {
+ a *= 2;
+ c = dlamc3_(&a, &one);
+ c = dlamc33_(&c, &a);
+ }
+
+/* Now compute b = 2.0**m with the smallest positive integer m
+ such that
+ fl( a + b ) .gt. a.
+*/
+
+ b = one;
+
+ do {
+ b *= 2;
+ c = dlamc3_(&a, &b);
+ } while (c == a);
+
+/* Now compute the base. a and c are neighbouring floating point
+ numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
+ their difference is beta. Adding 0.25 to c is to ensure that it
+ is truncated to beta and not ( beta - 1 ).
+*/
+
+ qtr = one / 4;
+ savec = c;
+ c = dlamc33_(&c, &a);
+ lbeta = (integer) (c + qtr);
+
+/* Now determine whether rounding or chopping occurs, by adding a
+ bit less than beta/2 and a bit more than beta/2 to a.
+*/
+
+ b = (doublereal) lbeta;
+ d__1 = b / 2;
+ d__2 = -b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c = dlamc3_(&f, &a);
+ if (c == a) {
+ lrnd = TRUE_;
+ } else {
+ lrnd = FALSE_;
+ }
+ d__1 = b / 2;
+ d__2 = b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c = dlamc3_(&f, &a);
+ if (lrnd && c == a) {
+ lrnd = FALSE_;
+ }
+
+/* Try and decide whether rounding is done in the IEEE 'round to
+ nearest' style. B/2 is half a unit in the last place of the two
+ numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
+ zero, and SAVEC is odd. Thus adding B/2 to A should not change
+ A, but adding B/2 to SAVEC should change SAVEC.
+*/
+
+ d__1 = b / 2;
+ t1 = dlamc3_(&d__1, &a);
+ d__1 = b / 2;
+ t2 = dlamc3_(&d__1, &savec);
+ lieee1 = t1 == a && t2 > savec && lrnd;
+
+/* Now find the mantissa, t. It should be the integer part of
+ log to the base beta of a, however it is safer to determine t
+ by powering. So we find t as the smallest positive integer for
+ which
+
+ fl( beta**t + 1.0 ) = 1.0.
+*/
+
+ lt = 0;
+ a = c = one;
+
+ while (c == one) {
+ ++lt;
+ a *= lbeta;
+ c = dlamc3_(&a, &one);
+ c = dlamc33_(&c, &a);
+ }
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *ieee1 = lieee1;
+} /* dlamc1_ */
+
+/* Subroutine */
+void dlamc2_(integer *beta, integer *t, logical *rnd,
+ doublereal *eps, integer *emin, doublereal *rmin,
+ integer *emax, doublereal *rmax)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) DOUBLE PRECISION
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) DOUBLE PRECISION
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) DOUBLE PRECISION
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+*/
+
+ /* Initialized data */
+ static logical first = TRUE_;
+ static logical iwarn = FALSE_;
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+ /* Local variables */
+ static logical ieee;
+ static doublereal half = 0.5;
+ static logical lrnd;
+ static doublereal leps, zero = 0., a, b, c;
+ static integer i, lbeta;
+ static doublereal rbase;
+ static integer lemin, lemax, gnmin;
+ static doublereal small;
+ static integer gpmin;
+ static doublereal third, lrmin, lrmax, sixth;
+ static logical lieee1;
+ static integer lt, ngnmin, ngpmin;
+ static doublereal one = 1.;
+
+ if (first) {
+ first = FALSE_;
+
+/* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
+ BETA, T, RND, EPS, EMIN and RMIN.
+
+ Throughout this routine we use the function DLAMC3 to ensure
+ that relevant values are stored and not held in registers, or
+ are not affected by optimizers.
+
+ DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
+*/
+
+ dlamc1_(&lbeta, <, &lrnd, &lieee1);
+
+/* Start to find EPS. */
+
+ b = (doublereal) lbeta;
+ i__1 = -lt;
+ a = pow_di(&b, &i__1);
+ leps = a;
+
+/* Try some tricks to see whether or not this is the correct EPS. */
+
+ b = 2. / 3;
+ sixth = dlamc33_(&b, &half);
+ third = dlamc3_(&sixth, &sixth);
+ b = dlamc33_(&third, &half);
+ b = dlamc3_(&b, &sixth);
+ b = abs(b);
+ if (b < leps) {
+ b = leps;
+ }
+
+ leps = one;
+
+ while (leps > b && b > zero) {
+ leps = b;
+ d__1 = half * leps;
+ d__2 = 32. * (leps * leps);
+ c = dlamc3_(&d__1, &d__2);
+ c = dlamc33_(&half, &c);
+ b = dlamc3_(&half, &c);
+ c = dlamc33_(&half, &b);
+ b = dlamc3_(&half, &c);
+ }
+
+ if (a < leps) {
+ leps = a;
+ }
+
+/* Computation of EPS complete.
+
+ Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
+ Keep dividing A by BETA until (gradual) underflow occurs. This
+ is detected when we cannot recover the previous A.
+*/
+
+ rbase = one / lbeta;
+ small = one;
+ for (i = 1; i <= 3; ++i) {
+ d__1 = small * rbase;
+ small = dlamc3_(&d__1, &zero);
+ }
+ a = dlamc3_(&one, &small);
+ dlamc4_(&ngpmin, &one, &lbeta);
+ d__1 = -one;
+ dlamc4_(&ngnmin, &d__1, &lbeta);
+ dlamc4_(&gpmin, &a, &lbeta);
+ d__1 = -a;
+ dlamc4_(&gnmin, &d__1, &lbeta);
+ ieee = FALSE_;
+
+ if (ngpmin == ngnmin && gpmin == gnmin) {
+ if (ngpmin == gpmin) {
+ lemin = ngpmin;
+/* ( Non twos-complement machines, no gradual underflow; e.g., VAX ) */
+ } else if (gpmin - ngpmin == 3) {
+ lemin = ngpmin - 1 + lt;
+ ieee = TRUE_;
+/* ( Non twos-complement machines, with gradual underflow; e.g., IEEE standard followers ) */
+ } else {
+ lemin = min(ngpmin,gpmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else if (ngpmin == gpmin && ngnmin == gnmin) {
+ if (abs(ngpmin - ngnmin) == 1) {
+ lemin = max(ngpmin,ngnmin);
+/* ( Twos-complement machines, no gradual underflow; e.g., CYBER 205 ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ } else if (abs(ngpmin - ngnmin) == 1 && gpmin == gnmin) {
+ if (gpmin - min(ngpmin,ngnmin) == 3) {
+ lemin = max(ngpmin,ngnmin) - 1 + lt;
+/* ( Twos-complement machines with gradual underflow; no known machine ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ } else {
+ lemin = min(min(min(ngpmin,ngnmin),gpmin),gnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+/* ** Comment out this if block if EMIN is ok */
+ if (iwarn) {
+ first = TRUE_;
+ printf("\n\n WARNING. The value EMIN may be incorrect: - ");
+ printf("EMIN = %8i\n",lemin);
+ printf("If, after inspection, the value EMIN looks acceptable ");
+ printf("please comment out\n the IF block as marked within the ");
+ printf("code of routine DLAMC2,\n otherwise supply EMIN ");
+ printf("explicitly.\n");
+ }
+/* ** Assume IEEE arithmetic if we found denormalised numbers above,
+ or if arithmetic seems to round in the IEEE style, determined
+ in routine DLAMC1. A true IEEE machine should have both things
+ true; however, faulty machines may have one or the other.
+*/
+
+ ieee = ieee || lieee1;
+
+/* Compute RMIN by successive division by BETA. We could compute
+ RMIN as BASE**( EMIN - 1 ), but some machines underflow during
+ this computation.
+*/
+
+ lrmin = one;
+ for (i = 1; i <= 1-lemin; ++i) {
+ d__1 = lrmin * rbase;
+ lrmin = dlamc3_(&d__1, &zero);
+ }
+
+/* Finally, call DLAMC5 to compute EMAX and RMAX. */
+
+ dlamc5_(&lbeta, <, &lemin, &ieee, &lemax, &lrmax);
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *eps = leps;
+ *emin = lemin;
+ *rmin = lrmin;
+ *emax = lemax;
+ *rmax = lrmax;
+} /* dlamc2_ */
+
+doublereal dlamc3_(doublereal *a, doublereal *b)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ DLAMC3 is intended to force A and B to be stored prior to doing
+ the addition of A and B , for use in situations where optimizers
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A, B (input) DOUBLE PRECISION
+ The values A and B.
+
+ =====================================================================
+*/
+
+ return *a + *b;
+} /* dlamc3_ */
+
+doublereal dlamc33_(doublereal *a, doublereal *b)
+{
+/* Purpose
+ =======
+
+ As DLAMC3, but subtract A and B instead of adding them.
+
+ Arguments
+ =========
+
+ A, B (input) DOUBLE PRECISION
+ The values A and B.
+
+ =====================================================================
+*/
+ return *a - *b;
+
+} /* dlamc33_ */
+
+/* Subroutine */
+void dlamc4_(integer *emin, doublereal *start, integer *base)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ DLAMC4 is a service routine for DLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) EMIN
+ The minimum exponent before (gradual) underflow, computed by
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) DOUBLE PRECISION
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+*/
+ /* System generated locals */
+ doublereal d__1;
+ /* Local variables */
+ static doublereal zero = 0., a;
+ static integer i;
+ static doublereal rbase, b1, b2, c1, c2, d1, d2;
+ static doublereal one = 1.;
+
+ a = *start;
+ rbase = one / *base;
+ *emin = 1;
+ d__1 = a * rbase;
+ b1 = dlamc3_(&d__1, &zero);
+ c1 = c2 = d1 = d2 = a;
+ while (c1 == a && c2 == a && d1 == a && d2 == a) {
+ --(*emin);
+ a = b1;
+ d__1 = a / *base;
+ b1 = dlamc3_(&d__1, &zero);
+ d__1 = b1 * *base;
+ c1 = dlamc3_(&d__1, &zero);
+ d1 = zero;
+ for (i = 1; i <= *base; ++i) {
+ d1 += b1;
+ }
+ d__1 = a * rbase;
+ b2 = dlamc3_(&d__1, &zero);
+ d__1 = b2 / rbase;
+ c2 = dlamc3_(&d__1, &zero);
+ d2 = zero;
+ for (i = 1; i <= *base; ++i) {
+ d2 += b2;
+ }
+ }
+} /* dlamc4_ */
+
+/* Subroutine */
+void dlamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, doublereal *rmax)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ DLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) DOUBLE PRECISION
+ The largest machine floating-point number.
+
+ =====================================================================
+*/
+
+ /* Table of constant values */
+ static doublereal c_b5 = 0.;
+ /* System generated locals */
+ doublereal d__1;
+ /* Local variables */
+ static integer lexp;
+ static doublereal oldy;
+ static integer uexp, i;
+ static doublereal y, z;
+ static integer nbits;
+ static doublereal recbas;
+ static integer exbits, expsum, try;
+
+/* First compute LEXP and UEXP, two powers of 2 that bound
+ abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+ approximately to the bound that is closest to abs(EMIN).
+ (EMAX is the exponent of the required number RMAX).
+*/
+
+ lexp = 1;
+ exbits = 1;
+ while ((try = lexp << 1) <= -(*emin)) {
+ lexp = try;
+ ++exbits;
+ }
+ if (lexp == -(*emin)) {
+ uexp = lexp;
+ } else {
+ uexp = try;
+ ++exbits;
+ }
+
+/* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+ than or equal to EMIN. EXBITS is the number of bits needed to
+ store the exponent.
+*/
+
+ if (uexp + *emin > -lexp - *emin) {
+ expsum = lexp << 1;
+ } else {
+ expsum = uexp << 1;
+ }
+
+/* EXPSUM is the exponent range, approximately equal to EMAX - EMIN + 1 . */
+
+ *emax = expsum + *emin - 1;
+ nbits = exbits + 1 + *p;
+
+/* NBITS is the total number of bits needed to store a floating-point number. */
+
+ if (nbits % 2 == 1 && *beta == 2) {
+
+/* Either there are an odd number of bits used to store a
+ floating-point number, which is unlikely, or some bits are
+ not used in the representation of numbers, which is possible,
+ (e.g. Cray machines) or the mantissa has an implicit bit,
+ (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+ most likely. We have to assume the last alternative.
+ If this is true, then we need to reduce EMAX by one because
+ there must be some way of representing zero in an implicit-bit
+ system. On machines like Cray, we are reducing EMAX by one
+ unnecessarily.
+*/
+
+ --(*emax);
+ }
+
+ if (*ieee) {
+
+/* Assume we are on an IEEE machine which reserves one exponent for infinity and NaN. */
+
+ --(*emax);
+ }
+
+/* Now create RMAX, the largest machine number, which should
+ be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
+
+ First compute 1.0 - BETA**(-P), being careful that the result is less than 1.0 . */
+
+ recbas = 1. / *beta;
+ z = *beta - 1.;
+ y = 0.;
+ for (i = 1; i <= *p; ++i) {
+ z *= recbas;
+ if (y < 1.) {
+ oldy = y;
+ }
+ y = dlamc3_(&y, &z);
+ }
+ if (y >= 1.) {
+ y = oldy;
+ }
+
+/* Now multiply by BETA**EMAX to get RMAX. */
+
+ for (i = 1; i <= *emax; ++i) {
+ d__1 = y * *beta;
+ y = dlamc3_(&d__1, &c_b5);
+ }
+
+ *rmax = y;
+} /* dlamc5_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.f
new file mode 100644
index 0000000000000000000000000000000000000000..e293aa8c7b528e8b7a29b4662a508c62ec8e1b8e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlamch.f
@@ -0,0 +1,857 @@
+ DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER CMACH
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMCH determines double precision machine parameters.
+*
+* Arguments
+* =========
+*
+* CMACH (input) CHARACTER*1
+* Specifies the value to be returned by DLAMCH:
+* = 'E' or 'e', DLAMCH := eps
+* = 'S' or 's , DLAMCH := sfmin
+* = 'B' or 'b', DLAMCH := base
+* = 'P' or 'p', DLAMCH := eps*base
+* = 'N' or 'n', DLAMCH := t
+* = 'R' or 'r', DLAMCH := rnd
+* = 'M' or 'm', DLAMCH := emin
+* = 'U' or 'u', DLAMCH := rmin
+* = 'L' or 'l', DLAMCH := emax
+* = 'O' or 'o', DLAMCH := rmax
+*
+* where
+*
+* eps = relative machine precision
+* sfmin = safe minimum, such that 1/sfmin does not overflow
+* base = base of the machine
+* prec = eps*base
+* t = number of (base) digits in the mantissa
+* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+* emin = minimum exponent before (gradual) underflow
+* rmin = underflow threshold - base**(emin-1)
+* emax = largest exponent before overflow
+* rmax = overflow threshold - (base**emax)*(1-eps)
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FIRST, LRND
+ INTEGER BETA, IMAX, IMIN, IT
+ DOUBLE PRECISION BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
+ $ RND, SFMIN, SMALL, T
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAMC2
+* ..
+* .. Save statement ..
+ SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
+ $ EMAX, RMAX, PREC
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ CALL DLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
+ BASE = BETA
+ T = IT
+ IF( LRND ) THEN
+ RND = ONE
+ EPS = ( BASE**( 1-IT ) ) / 2
+ ELSE
+ RND = ZERO
+ EPS = BASE**( 1-IT )
+ END IF
+ PREC = EPS*BASE
+ EMIN = IMIN
+ EMAX = IMAX
+ SFMIN = RMIN
+ SMALL = ONE / RMAX
+ IF( SMALL.GE.SFMIN ) THEN
+*
+* Use SMALL plus a bit, to avoid the possibility of rounding
+* causing overflow when computing 1/sfmin.
+*
+ SFMIN = SMALL*( ONE+EPS )
+ END IF
+ END IF
+*
+ IF( LSAME( CMACH, 'E' ) ) THEN
+ RMACH = EPS
+ ELSE IF( LSAME( CMACH, 'S' ) ) THEN
+ RMACH = SFMIN
+ ELSE IF( LSAME( CMACH, 'B' ) ) THEN
+ RMACH = BASE
+ ELSE IF( LSAME( CMACH, 'P' ) ) THEN
+ RMACH = PREC
+ ELSE IF( LSAME( CMACH, 'N' ) ) THEN
+ RMACH = T
+ ELSE IF( LSAME( CMACH, 'R' ) ) THEN
+ RMACH = RND
+ ELSE IF( LSAME( CMACH, 'M' ) ) THEN
+ RMACH = EMIN
+ ELSE IF( LSAME( CMACH, 'U' ) ) THEN
+ RMACH = RMIN
+ ELSE IF( LSAME( CMACH, 'L' ) ) THEN
+ RMACH = EMAX
+ ELSE IF( LSAME( CMACH, 'O' ) ) THEN
+ RMACH = RMAX
+ END IF
+*
+ DLAMCH = RMACH
+ RETURN
+*
+* End of DLAMCH
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE DLAMC1( BETA, T, RND, IEEE1 )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL IEEE1, RND
+ INTEGER BETA, T
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMC1 determines the machine parameters given by BETA, T, RND, and
+* IEEE1.
+*
+* Arguments
+* =========
+*
+* BETA (output) INTEGER
+* The base of the machine.
+*
+* T (output) INTEGER
+* The number of ( BETA ) digits in the mantissa.
+*
+* RND (output) LOGICAL
+* Specifies whether proper rounding ( RND = .TRUE. ) or
+* chopping ( RND = .FALSE. ) occurs in addition. This may not
+* be a reliable guide to the way in which the machine performs
+* its arithmetic.
+*
+* IEEE1 (output) LOGICAL
+* Specifies whether rounding appears to be done in the IEEE
+* 'round to nearest' style.
+*
+* Further Details
+* ===============
+*
+* The routine is based on the routine ENVRON by Malcolm and
+* incorporates suggestions by Gentleman and Marovich. See
+*
+* Malcolm M. A. (1972) Algorithms to reveal properties of
+* floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+*
+* Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+* that reveal properties of floating point arithmetic units.
+* Comms. of the ACM, 17, 276-277.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL FIRST, LIEEE1, LRND
+ INTEGER LBETA, LT
+ DOUBLE PRECISION A, B, C, F, ONE, QTR, SAVEC, T1, T2
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMC3
+ EXTERNAL DLAMC3
+* ..
+* .. Save statement ..
+ SAVE FIRST, LIEEE1, LBETA, LRND, LT
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ ONE = 1
+*
+* LBETA, LIEEE1, LT and LRND are the local values of BETA,
+* IEEE1, T and RND.
+*
+* Throughout this routine we use the function DLAMC3 to ensure
+* that relevant values are stored and not held in registers, or
+* are not affected by optimizers.
+*
+* Compute a = 2.0**m with the smallest positive integer m such
+* that
+*
+* fl( a + 1.0 ) = a.
+*
+ A = 1
+ C = 1
+*
+*+ WHILE( C.EQ.ONE )LOOP
+ 10 CONTINUE
+ IF( C.EQ.ONE ) THEN
+ A = 2*A
+ C = DLAMC3( A, ONE )
+ C = DLAMC3( C, -A )
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+* Now compute b = 2.0**m with the smallest positive integer m
+* such that
+*
+* fl( a + b ) .gt. a.
+*
+ B = 1
+ C = DLAMC3( A, B )
+*
+*+ WHILE( C.EQ.A )LOOP
+ 20 CONTINUE
+ IF( C.EQ.A ) THEN
+ B = 2*B
+ C = DLAMC3( A, B )
+ GO TO 20
+ END IF
+*+ END WHILE
+*
+* Now compute the base. a and c are neighbouring floating point
+* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
+* their difference is beta. Adding 0.25 to c is to ensure that it
+* is truncated to beta and not ( beta - 1 ).
+*
+ QTR = ONE / 4
+ SAVEC = C
+ C = DLAMC3( C, -A )
+ LBETA = C + QTR
+*
+* Now determine whether rounding or chopping occurs, by adding a
+* bit less than beta/2 and a bit more than beta/2 to a.
+*
+ B = LBETA
+ F = DLAMC3( B / 2, -B / 100 )
+ C = DLAMC3( F, A )
+ IF( C.EQ.A ) THEN
+ LRND = .TRUE.
+ ELSE
+ LRND = .FALSE.
+ END IF
+ F = DLAMC3( B / 2, B / 100 )
+ C = DLAMC3( F, A )
+ IF( ( LRND ) .AND. ( C.EQ.A ) )
+ $ LRND = .FALSE.
+*
+* Try and decide whether rounding is done in the IEEE 'round to
+* nearest' style. B/2 is half a unit in the last place of the two
+* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
+* zero, and SAVEC is odd. Thus adding B/2 to A should not change
+* A, but adding B/2 to SAVEC should change SAVEC.
+*
+ T1 = DLAMC3( B / 2, A )
+ T2 = DLAMC3( B / 2, SAVEC )
+ LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
+*
+* Now find the mantissa, t. It should be the integer part of
+* log to the base beta of a, however it is safer to determine t
+* by powering. So we find t as the smallest positive integer for
+* which
+*
+* fl( beta**t + 1.0 ) = 1.0.
+*
+ LT = 0
+ A = 1
+ C = 1
+*
+*+ WHILE( C.EQ.ONE )LOOP
+ 30 CONTINUE
+ IF( C.EQ.ONE ) THEN
+ LT = LT + 1
+ A = A*LBETA
+ C = DLAMC3( A, ONE )
+ C = DLAMC3( C, -A )
+ GO TO 30
+ END IF
+*+ END WHILE
+*
+ END IF
+*
+ BETA = LBETA
+ T = LT
+ RND = LRND
+ IEEE1 = LIEEE1
+ RETURN
+*
+* End of DLAMC1
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE DLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL RND
+ INTEGER BETA, EMAX, EMIN, T
+ DOUBLE PRECISION EPS, RMAX, RMIN
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMC2 determines the machine parameters specified in its argument
+* list.
+*
+* Arguments
+* =========
+*
+* BETA (output) INTEGER
+* The base of the machine.
+*
+* T (output) INTEGER
+* The number of ( BETA ) digits in the mantissa.
+*
+* RND (output) LOGICAL
+* Specifies whether proper rounding ( RND = .TRUE. ) or
+* chopping ( RND = .FALSE. ) occurs in addition. This may not
+* be a reliable guide to the way in which the machine performs
+* its arithmetic.
+*
+* EPS (output) DOUBLE PRECISION
+* The smallest positive number such that
+*
+* fl( 1.0 - EPS ) .LT. 1.0,
+*
+* where fl denotes the computed value.
+*
+* EMIN (output) INTEGER
+* The minimum exponent before (gradual) underflow occurs.
+*
+* RMIN (output) DOUBLE PRECISION
+* The smallest normalized number for the machine, given by
+* BASE**( EMIN - 1 ), where BASE is the floating point value
+* of BETA.
+*
+* EMAX (output) INTEGER
+* The maximum exponent before overflow occurs.
+*
+* RMAX (output) DOUBLE PRECISION
+* The largest positive number for the machine, given by
+* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+* value of BETA.
+*
+* Further Details
+* ===============
+*
+* The computation of EPS is based on a routine PARANOIA by
+* W. Kahan of the University of California at Berkeley.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
+ INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
+ $ NGNMIN, NGPMIN
+ DOUBLE PRECISION A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
+ $ SIXTH, SMALL, THIRD, TWO, ZERO
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMC3
+ EXTERNAL DLAMC3
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAMC1, DLAMC4, DLAMC5
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. Save statement ..
+ SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
+ $ LRMIN, LT
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. / , IWARN / .FALSE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ ZERO = 0
+ ONE = 1
+ TWO = 2
+*
+* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
+* BETA, T, RND, EPS, EMIN and RMIN.
+*
+* Throughout this routine we use the function DLAMC3 to ensure
+* that relevant values are stored and not held in registers, or
+* are not affected by optimizers.
+*
+* DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
+*
+ CALL DLAMC1( LBETA, LT, LRND, LIEEE1 )
+*
+* Start to find EPS.
+*
+ B = LBETA
+ A = B**( -LT )
+ LEPS = A
+*
+* Try some tricks to see whether or not this is the correct EPS.
+*
+ B = TWO / 3
+ HALF = ONE / 2
+ SIXTH = DLAMC3( B, -HALF )
+ THIRD = DLAMC3( SIXTH, SIXTH )
+ B = DLAMC3( THIRD, -HALF )
+ B = DLAMC3( B, SIXTH )
+ B = ABS( B )
+ IF( B.LT.LEPS )
+ $ B = LEPS
+*
+ LEPS = 1
+*
+*+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
+ 10 CONTINUE
+ IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
+ LEPS = B
+ C = DLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
+ C = DLAMC3( HALF, -C )
+ B = DLAMC3( HALF, C )
+ C = DLAMC3( HALF, -B )
+ B = DLAMC3( HALF, C )
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+ IF( A.LT.LEPS )
+ $ LEPS = A
+*
+* Computation of EPS complete.
+*
+* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
+* Keep dividing A by BETA until (gradual) underflow occurs. This
+* is detected when we cannot recover the previous A.
+*
+ RBASE = ONE / LBETA
+ SMALL = ONE
+ DO 20 I = 1, 3
+ SMALL = DLAMC3( SMALL*RBASE, ZERO )
+ 20 CONTINUE
+ A = DLAMC3( ONE, SMALL )
+ CALL DLAMC4( NGPMIN, ONE, LBETA )
+ CALL DLAMC4( NGNMIN, -ONE, LBETA )
+ CALL DLAMC4( GPMIN, A, LBETA )
+ CALL DLAMC4( GNMIN, -A, LBETA )
+ IEEE = .FALSE.
+*
+ IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
+ IF( NGPMIN.EQ.GPMIN ) THEN
+ LEMIN = NGPMIN
+* ( Non twos-complement machines, no gradual underflow;
+* e.g., VAX )
+ ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
+ LEMIN = NGPMIN - 1 + LT
+ IEEE = .TRUE.
+* ( Non twos-complement machines, with gradual underflow;
+* e.g., IEEE standard followers )
+ ELSE
+ LEMIN = MIN( NGPMIN, GPMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
+ IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
+ LEMIN = MAX( NGPMIN, NGNMIN )
+* ( Twos-complement machines, no gradual underflow;
+* e.g., CYBER 205 )
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
+ $ ( GPMIN.EQ.GNMIN ) ) THEN
+ IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
+ LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
+* ( Twos-complement machines with gradual underflow;
+* no known machine )
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+***
+* Comment out this if block if EMIN is ok
+ IF( IWARN ) THEN
+ FIRST = .TRUE.
+ WRITE( 6, FMT = 9999 )LEMIN
+ END IF
+***
+*
+* Assume IEEE arithmetic if we found denormalised numbers above,
+* or if arithmetic seems to round in the IEEE style, determined
+* in routine DLAMC1. A true IEEE machine should have both things
+* true; however, faulty machines may have one or the other.
+*
+ IEEE = IEEE .OR. LIEEE1
+*
+* Compute RMIN by successive division by BETA. We could compute
+* RMIN as BASE**( EMIN - 1 ), but some machines underflow during
+* this computation.
+*
+ LRMIN = 1
+ DO 30 I = 1, 1 - LEMIN
+ LRMIN = DLAMC3( LRMIN*RBASE, ZERO )
+ 30 CONTINUE
+*
+* Finally, call DLAMC5 to compute EMAX and RMAX.
+*
+ CALL DLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
+ END IF
+*
+ BETA = LBETA
+ T = LT
+ RND = LRND
+ EPS = LEPS
+ EMIN = LEMIN
+ RMIN = LRMIN
+ EMAX = LEMAX
+ RMAX = LRMAX
+*
+ RETURN
+*
+ 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
+ $ ' EMIN = ', I8, /
+ $ ' If, after inspection, the value EMIN looks',
+ $ ' acceptable please comment out ',
+ $ / ' the IF block as marked within the code of routine',
+ $ ' DLAMC2,', / ' otherwise supply EMIN explicitly.', / )
+*
+* End of DLAMC2
+*
+ END
+*
+************************************************************************
+*
+ DOUBLE PRECISION FUNCTION DLAMC3( A, B )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION A, B
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMC3 is intended to force A and B to be stored prior to doing
+* the addition of A and B , for use in situations where optimizers
+* might hold one of these in a register.
+*
+* Arguments
+* =========
+*
+* A, B (input) DOUBLE PRECISION
+* The values A and B.
+*
+* =====================================================================
+*
+* .. Executable Statements ..
+*
+ DLAMC3 = A + B
+*
+ RETURN
+*
+* End of DLAMC3
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE DLAMC4( EMIN, START, BASE )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER BASE, EMIN
+ DOUBLE PRECISION START
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMC4 is a service routine for DLAMC2.
+*
+* Arguments
+* =========
+*
+* EMIN (output) EMIN
+* The minimum exponent before (gradual) underflow, computed by
+* setting A = START and dividing by BASE until the previous A
+* can not be recovered.
+*
+* START (input) DOUBLE PRECISION
+* The starting point for determining EMIN.
+*
+* BASE (input) INTEGER
+* The base of the machine.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I
+ DOUBLE PRECISION A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMC3
+ EXTERNAL DLAMC3
+* ..
+* .. Executable Statements ..
+*
+ A = START
+ ONE = 1
+ RBASE = ONE / BASE
+ ZERO = 0
+ EMIN = 1
+ B1 = DLAMC3( A*RBASE, ZERO )
+ C1 = A
+ C2 = A
+ D1 = A
+ D2 = A
+*+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
+* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
+ 10 CONTINUE
+ IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
+ $ ( D2.EQ.A ) ) THEN
+ EMIN = EMIN - 1
+ A = B1
+ B1 = DLAMC3( A / BASE, ZERO )
+ C1 = DLAMC3( B1*BASE, ZERO )
+ D1 = ZERO
+ DO 20 I = 1, BASE
+ D1 = D1 + B1
+ 20 CONTINUE
+ B2 = DLAMC3( A*RBASE, ZERO )
+ C2 = DLAMC3( B2 / RBASE, ZERO )
+ D2 = ZERO
+ DO 30 I = 1, BASE
+ D2 = D2 + B2
+ 30 CONTINUE
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+ RETURN
+*
+* End of DLAMC4
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE DLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL IEEE
+ INTEGER BETA, EMAX, EMIN, P
+ DOUBLE PRECISION RMAX
+* ..
+*
+* Purpose
+* =======
+*
+* DLAMC5 attempts to compute RMAX, the largest machine floating-point
+* number, without overflow. It assumes that EMAX + abs(EMIN) sum
+* approximately to a power of 2. It will fail on machines where this
+* assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+* EMAX = 28718). It will also fail if the value supplied for EMIN is
+* too large (i.e. too close to zero), probably with overflow.
+*
+* Arguments
+* =========
+*
+* BETA (input) INTEGER
+* The base of floating-point arithmetic.
+*
+* P (input) INTEGER
+* The number of base BETA digits in the mantissa of a
+* floating-point value.
+*
+* EMIN (input) INTEGER
+* The minimum exponent before (gradual) underflow.
+*
+* IEEE (input) LOGICAL
+* A logical flag specifying whether or not the arithmetic
+* system is thought to comply with the IEEE standard.
+*
+* EMAX (output) INTEGER
+* The largest exponent before overflow
+*
+* RMAX (output) DOUBLE PRECISION
+* The largest machine floating-point number.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
+ DOUBLE PRECISION OLDY, RECBAS, Y, Z
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMC3
+ EXTERNAL DLAMC3
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MOD
+* ..
+* .. Executable Statements ..
+*
+* First compute LEXP and UEXP, two powers of 2 that bound
+* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+* approximately to the bound that is closest to abs(EMIN).
+* (EMAX is the exponent of the required number RMAX).
+*
+ LEXP = 1
+ EXBITS = 1
+ 10 CONTINUE
+ TRY = LEXP*2
+ IF( TRY.LE.( -EMIN ) ) THEN
+ LEXP = TRY
+ EXBITS = EXBITS + 1
+ GO TO 10
+ END IF
+ IF( LEXP.EQ.-EMIN ) THEN
+ UEXP = LEXP
+ ELSE
+ UEXP = TRY
+ EXBITS = EXBITS + 1
+ END IF
+*
+* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+* than or equal to EMIN. EXBITS is the number of bits needed to
+* store the exponent.
+*
+ IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
+ EXPSUM = 2*LEXP
+ ELSE
+ EXPSUM = 2*UEXP
+ END IF
+*
+* EXPSUM is the exponent range, approximately equal to
+* EMAX - EMIN + 1 .
+*
+ EMAX = EXPSUM + EMIN - 1
+ NBITS = 1 + EXBITS + P
+*
+* NBITS is the total number of bits needed to store a
+* floating-point number.
+*
+ IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
+*
+* Either there are an odd number of bits used to store a
+* floating-point number, which is unlikely, or some bits are
+* not used in the representation of numbers, which is possible,
+* (e.g. Cray machines) or the mantissa has an implicit bit,
+* (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+* most likely. We have to assume the last alternative.
+* If this is true, then we need to reduce EMAX by one because
+* there must be some way of representing zero in an implicit-bit
+* system. On machines like Cray, we are reducing EMAX by one
+* unnecessarily.
+*
+ EMAX = EMAX - 1
+ END IF
+*
+ IF( IEEE ) THEN
+*
+* Assume we are on an IEEE machine which reserves one exponent
+* for infinity and NaN.
+*
+ EMAX = EMAX - 1
+ END IF
+*
+* Now create RMAX, the largest machine number, which should
+* be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
+*
+* First compute 1.0 - BETA**(-P), being careful that the
+* result is less than 1.0 .
+*
+ RECBAS = ONE / BETA
+ Z = BETA - ONE
+ Y = ZERO
+ DO 20 I = 1, P
+ Z = Z*RECBAS
+ IF( Y.LT.ONE )
+ $ OLDY = Y
+ Y = DLAMC3( Y, Z )
+ 20 CONTINUE
+ IF( Y.GE.ONE )
+ $ Y = OLDY
+*
+* Now multiply by BETA**EMAX to get RMAX.
+*
+ DO 30 I = 1, EMAX
+ Y = DLAMC3( Y*BETA, ZERO )
+ 30 CONTINUE
+*
+ RMAX = Y
+ RETURN
+*
+* End of DLAMC5
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.c
new file mode 100644
index 0000000000000000000000000000000000000000..c16379a4d57b44872502bbd6108e332986ecd7b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.c
@@ -0,0 +1,126 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+doublereal dlange_(const char *norm, const integer *m, const integer *n, doublereal *a, const integer *lda, doublereal *work)
+{
+ /* Local variables */
+ static integer i, j;
+ static doublereal value;
+ static doublereal sum;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLANGE returns the value of the one norm, or the Frobenius norm, or */
+/* the infinity norm, or the element of largest absolute value of a */
+/* real matrix A. */
+/* */
+/* Description */
+/* =========== */
+/* */
+/* DLANGE returns the value */
+/* */
+/* DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+/* */
+/* where norm1 denotes the one norm of a matrix (maximum column sum), */
+/* normI denotes the infinity norm of a matrix (maximum row sum) and */
+/* normF denotes the Frobenius norm of a matrix (square root of sum of */
+/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in DLANGE as described */
+/* above. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. When M = 0, */
+/* DLANGE is set to zero. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. When N = 0, */
+/* DLANGE is set to zero. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The m by n matrix A. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(M,1). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK), */
+/* where LWORK >= M when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+/* */
+/* ===================================================================== */
+
+ value = 0.;
+ if (*m == 0 || *n == 0) {
+ return value;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ if (value < abs(a[i + j * *lda]))
+ value = abs(a[i + j * *lda]);
+ }
+ }
+ } else if (lsame_(norm, "O") || *norm == '1') {
+
+/* Find norm1(A). */
+
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ for (i = 0; i < *m; ++i) {
+ sum += abs(a[i + j * *lda]);
+ }
+ if (value < sum)
+ value = sum;
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ for (i = 0; i < *m; ++i) {
+ work[i] = 0.;
+ }
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ work[i] += abs(a[i + j * *lda]);
+ }
+ }
+ for (i = 0; i < *m; ++i) {
+ if (value < work[i])
+ value = work[i];
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ sum = 1.;
+ for (j = 0; j < *n; ++j) {
+ dlassq_(m, &a[j * *lda], &c__1, &value, &sum);
+ }
+ value *= sqrt(sum);
+ }
+
+ return value;
+
+} /* dlange_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.f
new file mode 100644
index 0000000000000000000000000000000000000000..0737f03ea996a9b48306cd6973f00770008a35f6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlange.f
@@ -0,0 +1,145 @@
+ DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLANGE returns the value of the one norm, or the Frobenius norm, or
+* the infinity norm, or the element of largest absolute value of a
+* real matrix A.
+*
+* Description
+* ===========
+*
+* DLANGE returns the value
+*
+* DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+* (
+* ( norm1(A), NORM = '1', 'O' or 'o'
+* (
+* ( normI(A), NORM = 'I' or 'i'
+* (
+* ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+*
+* where norm1 denotes the one norm of a matrix (maximum column sum),
+* normI denotes the infinity norm of a matrix (maximum row sum) and
+* normF denotes the Frobenius norm of a matrix (square root of sum of
+* squares). Note that max(abs(A(i,j))) is not a matrix norm.
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies the value to be returned in DLANGE as described
+* above.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0. When M = 0,
+* DLANGE is set to zero.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0. When N = 0,
+* DLANGE is set to zero.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* The m by n matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(M,1).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+* where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+* referenced.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION SCALE, SUM, VALUE
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLASSQ
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( MIN( M, N ).EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ DO 20 J = 1, N
+ DO 10 I = 1, M
+ VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+* Find norm1(A).
+*
+ VALUE = ZERO
+ DO 40 J = 1, N
+ SUM = ZERO
+ DO 30 I = 1, M
+ SUM = SUM + ABS( A( I, J ) )
+ 30 CONTINUE
+ VALUE = MAX( VALUE, SUM )
+ 40 CONTINUE
+ ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+* Find normI(A).
+*
+ DO 50 I = 1, M
+ WORK( I ) = ZERO
+ 50 CONTINUE
+ DO 70 J = 1, N
+ DO 60 I = 1, M
+ WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+ 60 CONTINUE
+ 70 CONTINUE
+ VALUE = ZERO
+ DO 80 I = 1, M
+ VALUE = MAX( VALUE, WORK( I ) )
+ 80 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ DO 90 J = 1, N
+ CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM )
+ 90 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ DLANGE = VALUE
+ RETURN
+*
+* End of DLANGE
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.c
new file mode 100644
index 0000000000000000000000000000000000000000..b387234131989809a87d425a4404b8593016ee26
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.c
@@ -0,0 +1,134 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+doublereal dlanhs_(norm, n, a, lda, work)
+const char *norm;
+const integer *n;
+doublereal *a;
+const integer *lda;
+doublereal *work;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i, j;
+ static doublereal scale;
+ static doublereal value;
+ static doublereal sum;
+
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLANHS returns the value of the one norm, or the Frobenius norm, or*/
+/* the infinity norm, or the element of largest absolute value of a*/
+/* Hessenberg matrix A. */
+/* */
+/* Description */
+/* =========== */
+/* */
+/* DLANHS returns the value */
+/* */
+/* DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+/* */
+/* where norm1 denotes the one norm of a matrix (maximum column sum),*/
+/* normI denotes the infinity norm of a matrix (maximum row sum) and*/
+/* normF denotes the Frobenius norm of a matrix (square root of sum of*/
+/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in DLANHS as described */
+/* above. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. When N = 0, DLANHS is */
+/* set to zero. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The n by n upper Hessenberg matrix A; the part of A below the*/
+/* first sub-diagonal is not referenced. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(N,1). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK), */
+/* where LWORK >= N when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+/* */
+/* ===================================================================== */
+
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < min(*n,j + 2); ++i) {
+ value = max(value, abs(a[i + j * *lda]));
+ }
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ for (i = 0; i < min(*n,j + 2); ++i) {
+ sum += abs(a[i + j * *lda]);
+ }
+ value = max(value,sum);
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ for (i = 0; i < *n; ++i) {
+ work[i] = 0.;
+ }
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < min(*n,j + 2); ++i) {
+ work[i] += abs(a[i + j * *lda]);
+ }
+ }
+ value = 0.;
+ for (i = 0; i < *n; ++i) {
+ value = max(value, work[i]);
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ for (j = 0; j < *n; ++j) {
+ i__1 = min(*n,j + 2);
+ dlassq_(&i__1, &a[j * *lda], &c__1, &scale, &sum);
+ }
+ value = scale * sqrt(sum);
+ }
+
+ return value;
+
+} /* dlanhs_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.f
new file mode 100644
index 0000000000000000000000000000000000000000..45939f0ab96dfd4f8ddcd827ca468d2851d30f81
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlanhs.f
@@ -0,0 +1,142 @@
+ DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER LDA, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLANHS returns the value of the one norm, or the Frobenius norm, or
+* the infinity norm, or the element of largest absolute value of a
+* Hessenberg matrix A.
+*
+* Description
+* ===========
+*
+* DLANHS returns the value
+*
+* DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+* (
+* ( norm1(A), NORM = '1', 'O' or 'o'
+* (
+* ( normI(A), NORM = 'I' or 'i'
+* (
+* ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+*
+* where norm1 denotes the one norm of a matrix (maximum column sum),
+* normI denotes the infinity norm of a matrix (maximum row sum) and
+* normF denotes the Frobenius norm of a matrix (square root of sum of
+* squares). Note that max(abs(A(i,j))) is not a matrix norm.
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies the value to be returned in DLANHS as described
+* above.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0. When N = 0, DLANHS is
+* set to zero.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* The n by n upper Hessenberg matrix A; the part of A below the
+* first sub-diagonal is not referenced.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(N,1).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+* where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+* referenced.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION SCALE, SUM, VALUE
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLASSQ
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( N.EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ DO 20 J = 1, N
+ DO 10 I = 1, MIN( N, J+1 )
+ VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+* Find norm1(A).
+*
+ VALUE = ZERO
+ DO 40 J = 1, N
+ SUM = ZERO
+ DO 30 I = 1, MIN( N, J+1 )
+ SUM = SUM + ABS( A( I, J ) )
+ 30 CONTINUE
+ VALUE = MAX( VALUE, SUM )
+ 40 CONTINUE
+ ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+* Find normI(A).
+*
+ DO 50 I = 1, N
+ WORK( I ) = ZERO
+ 50 CONTINUE
+ DO 70 J = 1, N
+ DO 60 I = 1, MIN( N, J+1 )
+ WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+ 60 CONTINUE
+ 70 CONTINUE
+ VALUE = ZERO
+ DO 80 I = 1, N
+ VALUE = MAX( VALUE, WORK( I ) )
+ 80 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ DO 90 J = 1, N
+ CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
+ 90 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ DLANHS = VALUE
+ RETURN
+*
+* End of DLANHS
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.c
new file mode 100644
index 0000000000000000000000000000000000000000..c09b416f48424b92e3d7bead91416ba2727e8a40
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.c
@@ -0,0 +1,82 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlapll_(integer *n, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *ssmin)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal c, ssmax, a11, a12, a22, tau;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* Given two column vectors X and Y, let */
+/* */
+/* A = ( X Y ). */
+/* */
+/* The subroutine first computes the QR factorization of A = Q*R, */
+/* and then computes the SVD of the 2-by-2 upper triangular matrix R. */
+/* The smaller singular value of R is returned in SSMIN, which is used */
+/* as the measurement of the linear dependency of the vectors X and Y. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The length of the vectors X and Y. */
+/* */
+/* X (input/output) DOUBLE PRECISION array, */
+/* dimension (1+(N-1)*INCX) */
+/* On entry, X contains the N-vector X. */
+/* On exit, X is overwritten. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive elements of X. INCX > 0. */
+/* */
+/* Y (input/output) DOUBLE PRECISION array, */
+/* dimension (1+(N-1)*INCY) */
+/* On entry, Y contains the N-vector Y. */
+/* On exit, Y is overwritten. */
+/* */
+/* INCY (input) INTEGER */
+/* The increment between successive elements of Y. INCY > 0. */
+/* */
+/* SSMIN (output) DOUBLE PRECISION */
+/* The smallest singular value of the N-by-2 matrix A = (X Y). */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ *ssmin = 0.;
+ return;
+ }
+
+/* Compute the QR factorization of the N-by-2 matrix ( X Y ) */
+
+ dlarfg_(n, x, &x[*incx], incx, &tau);
+ a11 = x[0];
+ x[0] = 1.;
+
+ c = -tau * ddot_(n, x, incx, y, incy);
+ daxpy_(n, &c, x, incx, y, incy);
+
+ i__1 = *n - 1;
+ dlarfg_(&i__1, &y[*incy], &y[2 * *incy], incy, &tau);
+
+ a12 = y[0];
+ a22 = y[*incy];
+
+/* Compute the SVD of 2-by-2 Upper triangular matrix. */
+
+ dlas2_(&a11, &a12, &a22, ssmin, &ssmax);
+
+} /* dlapll_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.f
new file mode 100644
index 0000000000000000000000000000000000000000..a2e02fa8e33d9b7f1b4fcf799d32e957b05c67bd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapll.f
@@ -0,0 +1,100 @@
+ SUBROUTINE DLAPLL( N, X, INCX, Y, INCY, SSMIN )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, INCY, N
+ DOUBLE PRECISION SSMIN
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* Given two column vectors X and Y, let
+*
+* A = ( X Y ).
+*
+* The subroutine first computes the QR factorization of A = Q*R,
+* and then computes the SVD of the 2-by-2 upper triangular matrix R.
+* The smaller singular value of R is returned in SSMIN, which is used
+* as the measurement of the linear dependency of the vectors X and Y.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The length of the vectors X and Y.
+*
+* X (input/output) DOUBLE PRECISION array,
+* dimension (1+(N-1)*INCX)
+* On entry, X contains the N-vector X.
+* On exit, X is overwritten.
+*
+* INCX (input) INTEGER
+* The increment between successive elements of X. INCX > 0.
+*
+* Y (input/output) DOUBLE PRECISION array,
+* dimension (1+(N-1)*INCY)
+* On entry, Y contains the N-vector Y.
+* On exit, Y is overwritten.
+*
+* INCY (input) INTEGER
+* The increment between successive elements of Y. INCY > 0.
+*
+* SSMIN (output) DOUBLE PRECISION
+* The smallest singular value of the N-by-2 matrix A = ( X Y ).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION A11, A12, A22, C, SSMAX, TAU
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DDOT
+ EXTERNAL DDOT
+* ..
+* .. External Subroutines ..
+ EXTERNAL DAXPY, DLARFG, DLAS2
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.LE.1 ) THEN
+ SSMIN = ZERO
+ RETURN
+ END IF
+*
+* Compute the QR factorization of the N-by-2 matrix ( X Y )
+*
+ CALL DLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
+ A11 = X( 1 )
+ X( 1 ) = ONE
+*
+ C = -TAU*DDOT( N, X, INCX, Y, INCY )
+ CALL DAXPY( N, C, X, INCX, Y, INCY )
+*
+ CALL DLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
+*
+ A12 = Y( 1 )
+ A22 = Y( 1+INCY )
+*
+* Compute the SVD of 2-by-2 Upper triangular matrix.
+*
+ CALL DLAS2( A11, A12, A22, SSMIN, SSMAX )
+*
+ RETURN
+*
+* End of DLAPLL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.c
new file mode 100644
index 0000000000000000000000000000000000000000..a42eee4412c46692f67c37b6314b8d4cdb38a1e9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.c
@@ -0,0 +1,138 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlapmt_(logical *forwrd, integer *m, integer *n, doublereal *x, integer *ldx, integer *k)
+{
+ /* System generated locals */
+ integer x_dim1, x_offset, i__1, i__2;
+
+ /* Local variables */
+ static doublereal temp;
+ static integer i, j, ii, in;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DLAPMT rearranges the columns of the M by N matrix X as specified */
+/* by the permutation K(1),K(2),...,K(N) of the integers 1,...,N. */
+/* If FORWRD = .TRUE., forward permutation: */
+/* */
+/* X(*,K(J)) is moved X(*,J) for J = 1,2,...,N. */
+/* */
+/* If FORWRD = .FALSE., backward permutation: */
+/* */
+/* X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* FORWRD (input) LOGICAL */
+/* = .TRUE., forward permutation */
+/* = .FALSE., backward permutation */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix X. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix X. N >= 0. */
+/* */
+/* X (input/output) DOUBLE PRECISION array, dimension (LDX,N) */
+/* On entry, the M by N matrix X. */
+/* On exit, X contains the permuted matrix X. */
+/* */
+/* LDX (input) INTEGER */
+/* The leading dimension of the array X, LDX >= MAX(1,M). */
+/* */
+/* K (input) INTEGER array, dimension (N) */
+/* On entry, K contains the permutation vector. */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ --k;
+ x_dim1 = *ldx;
+ x_offset = x_dim1 + 1;
+ x -= x_offset;
+
+ if (*n <= 1) {
+ return;
+ }
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+ k[i] = -k[i];
+ }
+
+ if (*forwrd) {
+
+/* Forward permutation */
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+
+ if (k[i] > 0) {
+ goto L40;
+ }
+
+ j = i;
+ k[j] = -k[j];
+ in = k[j];
+L20:
+ if (k[in] > 0) {
+ goto L40;
+ }
+
+ i__2 = *m;
+ for (ii = 1; ii <= i__2; ++ii) {
+ temp = x[ii + j * x_dim1];
+ x[ii + j * x_dim1] = x[ii + in * x_dim1];
+ x[ii + in * x_dim1] = temp;
+ }
+
+ k[in] = -k[in];
+ j = in;
+ in = k[in];
+ goto L20;
+L40:
+ ;
+ }
+
+ } else {
+
+/* Backward permutation */
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+
+ if (k[i] > 0) {
+ goto L80;
+ }
+
+ k[i] = -k[i];
+ j = k[i];
+L60:
+ if (j == i) {
+ goto L80;
+ }
+
+ i__2 = *m;
+ for (ii = 1; ii <= i__2; ++ii) {
+ temp = x[ii + i * x_dim1];
+ x[ii + i * x_dim1] = x[ii + j * x_dim1];
+ x[ii + j * x_dim1] = temp;
+ }
+
+ k[j] = -k[j];
+ j = k[j];
+ goto L60;
+L80:
+ ;
+ }
+ }
+} /* dlapmt_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.f
new file mode 100644
index 0000000000000000000000000000000000000000..b48da369e3336c331347d47443df02571eb09e61
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapmt.f
@@ -0,0 +1,135 @@
+ SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ LOGICAL FORWRD
+ INTEGER LDX, M, N
+* ..
+* .. Array Arguments ..
+ INTEGER K( * )
+ DOUBLE PRECISION X( LDX, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLAPMT rearranges the columns of the M by N matrix X as specified
+* by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+* If FORWRD = .TRUE., forward permutation:
+*
+* X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+*
+* If FORWRD = .FALSE., backward permutation:
+*
+* X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+*
+* Arguments
+* =========
+*
+* FORWRD (input) LOGICAL
+* = .TRUE., forward permutation
+* = .FALSE., backward permutation
+*
+* M (input) INTEGER
+* The number of rows of the matrix X. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix X. N >= 0.
+*
+* X (input/output) DOUBLE PRECISION array, dimension (LDX,N)
+* On entry, the M by N matrix X.
+* On exit, X contains the permuted matrix X.
+*
+* LDX (input) INTEGER
+* The leading dimension of the array X, LDX >= MAX(1,M).
+*
+* K (input) INTEGER array, dimension (N)
+* On entry, K contains the permutation vector.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, II, IN, J
+ DOUBLE PRECISION TEMP
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 )
+ $ RETURN
+*
+ DO 10 I = 1, N
+ K( I ) = -K( I )
+ 10 CONTINUE
+*
+ IF( FORWRD ) THEN
+*
+* Forward permutation
+*
+ DO 50 I = 1, N
+*
+ IF( K( I ).GT.0 )
+ $ GO TO 40
+*
+ J = I
+ K( J ) = -K( J )
+ IN = K( J )
+*
+ 20 CONTINUE
+ IF( K( IN ).GT.0 )
+ $ GO TO 40
+*
+ DO 30 II = 1, M
+ TEMP = X( II, J )
+ X( II, J ) = X( II, IN )
+ X( II, IN ) = TEMP
+ 30 CONTINUE
+*
+ K( IN ) = -K( IN )
+ J = IN
+ IN = K( IN )
+ GO TO 20
+*
+ 40 CONTINUE
+*
+ 50 CONTINUE
+*
+ ELSE
+*
+* Backward permutation
+*
+ DO 90 I = 1, N
+*
+ IF( K( I ).GT.0 )
+ $ GO TO 80
+*
+ K( I ) = -K( I )
+ J = K( I )
+ 60 CONTINUE
+ IF( J.EQ.I )
+ $ GO TO 80
+*
+ DO 70 II = 1, M
+ TEMP = X( II, I )
+ X( II, I ) = X( II, J )
+ X( II, J ) = TEMP
+ 70 CONTINUE
+*
+ K( J ) = -K( J )
+ J = K( J )
+ GO TO 60
+*
+ 80 CONTINUE
+*
+ 90 CONTINUE
+*
+ END IF
+*
+ RETURN
+*
+* End of DLAPMT
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.c
new file mode 100644
index 0000000000000000000000000000000000000000..305d3d940b5b659980ec56e1c36378766ed8365d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.c
@@ -0,0 +1,40 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+doublereal dlapy2_(const doublereal *x, const doublereal *y)
+{
+ /* Local variables */
+ static doublereal xabs, yabs, w, z;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary */
+/* overflow. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* X (input) DOUBLE PRECISION */
+/* Y (input) DOUBLE PRECISION */
+/* X and Y specify the values x and y. */
+/* */
+/* ===================================================================== */
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ w = max(xabs,yabs);
+ z = min(xabs,yabs);
+ if (z == 0.) {
+ return w;
+ } else {
+ z /= w;
+ return w * sqrt(z * z + 1.);
+ }
+} /* dlapy2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.f
new file mode 100644
index 0000000000000000000000000000000000000000..d38196132cf2b6f41209f96296e30c97d62f3dca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy2.f
@@ -0,0 +1,54 @@
+ DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION X, Y
+* ..
+*
+* Purpose
+* =======
+*
+* DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+* overflow.
+*
+* Arguments
+* =========
+*
+* X (input) DOUBLE PRECISION
+* Y (input) DOUBLE PRECISION
+* X and Y specify the values x and y.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION W, XABS, YABS, Z
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ DLAPY2 = W
+ ELSE
+ DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
+ RETURN
+*
+* End of DLAPY2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.c
new file mode 100644
index 0000000000000000000000000000000000000000..e664d859a754eb55fbb3fe28fab1d4a272880af4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.c
@@ -0,0 +1,42 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+doublereal dlapy3_(x, y, z)
+const doublereal *x, *y, *z;
+{
+ /* Local variables */
+ static doublereal xabs, yabs, zabs, w;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause */
+/* unnecessary overflow. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* X (input) DOUBLE PRECISION */
+/* Y (input) DOUBLE PRECISION */
+/* Z (input) DOUBLE PRECISION */
+/* X, Y and Z specify the values x, y and z. */
+/* */
+/* ===================================================================== */
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ zabs = abs(*z);
+ w = max(max(xabs,yabs),zabs);
+ if (w == 0.) {
+ return 0;
+ } else {
+ xabs /= w; yabs /= w; zabs /= w;
+ return w * sqrt(xabs * xabs + yabs * yabs + zabs * zabs);
+ }
+} /* dlapy3_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.f
new file mode 100644
index 0000000000000000000000000000000000000000..da63b413df945660649f144f752ae5e79a3b7e7d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlapy3.f
@@ -0,0 +1,54 @@
+ DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION X, Y, Z
+* ..
+*
+* Purpose
+* =======
+*
+* DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+* unnecessary overflow.
+*
+* Arguments
+* =========
+*
+* X (input) DOUBLE PRECISION
+* Y (input) DOUBLE PRECISION
+* Z (input) DOUBLE PRECISION
+* X, Y and Z specify the values x, y and z.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION W, XABS, YABS, ZABS
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ ZABS = ABS( Z )
+ W = MAX( XABS, YABS, ZABS )
+ IF( W.EQ.ZERO ) THEN
+ DLAPY3 = ZERO
+ ELSE
+ DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
+ $ ( ZABS / W )**2 )
+ END IF
+ RETURN
+*
+* End of DLAPY3
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.c
new file mode 100644
index 0000000000000000000000000000000000000000..91263e8739ae2f86c5de7d3561303e4a87b471de
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.c
@@ -0,0 +1,102 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static doublereal c_b4 = 1.;
+static doublereal c_b5 = 0.;
+static integer c__1 = 1;
+
+/* Subroutine */ void dlarf_(const char *side, const integer *m, const integer *n, doublereal *v, const integer *incv,
+ const doublereal *tau, doublereal *c, const integer *ldc, doublereal *work)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLARF applies a real elementary reflector H to a real m by n matrix */
+/* C, from either the left or the right. H is represented in the form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a real scalar and v is a real vector. */
+/* */
+/* If tau = 0, then H is taken to be the unit matrix. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': form H * C */
+/* = 'R': form C * H */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* V (input) DOUBLE PRECISION array, dimension */
+/* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
+/* or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
+/* The vector v in the representation of H. V is not used if */
+/* TAU = 0. */
+/* */
+/* INCV (input) INTEGER */
+/* The increment between elements of v. INCV <> 0. */
+/* */
+/* TAU (input) DOUBLE PRECISION */
+/* The value tau in the representation of H. */
+/* */
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
+/* or C * H if SIDE = 'R'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L' */
+/* or (M) if SIDE = 'R' */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C */
+
+ if (*tau != 0.) {
+
+/* w := C' * v */
+
+ dgemv_("Transpose", m, n, &c_b4, c, ldc, v, incv, &c_b5, work, &c__1);
+
+/* C := C - v * w' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, v, incv, work, &c__1, c, ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (*tau != 0.) {
+
+/* w := C * v */
+
+ dgemv_("No transpose", m, n, &c_b4, c, ldc, v, incv, &c_b5, work, &c__1);
+
+/* C := C - w * v' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, work, &c__1, v, incv, c, ldc);
+ }
+ }
+} /* dlarf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.f
new file mode 100644
index 0000000000000000000000000000000000000000..1bb357f9b906964ed146a0f714255b9d5bb9b1fd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarf.f
@@ -0,0 +1,116 @@
+ SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ DOUBLE PRECISION TAU
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLARF applies a real elementary reflector H to a real m by n matrix
+* C, from either the left or the right. H is represented in the form
+*
+* H = I - tau * v * v'
+*
+* where tau is a real scalar and v is a real vector.
+*
+* If tau = 0, then H is taken to be the unit matrix.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': form H * C
+* = 'R': form C * H
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* V (input) DOUBLE PRECISION array, dimension
+* (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+* or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+* The vector v in the representation of H. V is not used if
+* TAU = 0.
+*
+* INCV (input) INTEGER
+* The increment between elements of v. INCV <> 0.
+*
+* TAU (input) DOUBLE PRECISION
+* The value tau in the representation of H.
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+* or C * H if SIDE = 'R'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension
+* (N) if SIDE = 'L'
+* or (M) if SIDE = 'R'
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEMV, DGER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C' * v
+*
+ CALL DGEMV( 'Transpose', M, N, ONE, C, LDC, V, INCV, ZERO,
+ $ WORK, 1 )
+*
+* C := C - v * w'
+*
+ CALL DGER( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C * v
+*
+ CALL DGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
+ $ ZERO, WORK, 1 )
+*
+* C := C - w * v'
+*
+ CALL DGER( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of DLARF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.c
new file mode 100644
index 0000000000000000000000000000000000000000..a940162714ff2c897071445ee55fe18c87b76056
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.c
@@ -0,0 +1,552 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b14 = 1.;
+static doublereal c_b25 = -1.;
+
+/* Subroutine */ void dlarfb_(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
+const char *side, *trans, *direct, *storev;
+const integer *m, *n, *k;
+doublereal *v;
+const integer *ldv;
+doublereal *t;
+const integer *ldt;
+doublereal *c;
+const integer *ldc;
+doublereal *work;
+const integer *ldwork;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i, j;
+ static char transt[1];
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLARFB applies a real block reflector H or its transpose H' to a */
+/* real m by n matrix C, from either the left or the right. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply H or H' from the Left */
+/* = 'R': apply H or H' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply H (No transpose) */
+/* = 'T': apply H' (Transpose) */
+/* */
+/* DIRECT (input) CHARACTER*1 */
+/* Indicates how H is formed from a product of elementary */
+/* reflectors */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+/* */
+/* STOREV (input) CHARACTER*1 */
+/* Indicates how the vectors which define the elementary */
+/* reflectors are stored: */
+/* = 'C': Columnwise */
+/* = 'R': Rowwise */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* K (input) INTEGER */
+/* The order of the matrix T (= the number of elementary */
+/* reflectors whose product defines the block reflector). */
+/* */
+/* V (input) DOUBLE PRECISION array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,M) if STOREV = 'R' and SIDE = 'L' */
+/* (LDV,N) if STOREV = 'R' and SIDE = 'R' */
+/* The matrix V. See further details. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); */
+/* if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); */
+/* if STOREV = 'R', LDV >= K. */
+/* */
+/* T (input) DOUBLE PRECISION array, dimension (LDT,K) */
+/* The triangular k by k matrix T in the representation of the */
+/* block reflector. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+/* */
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by H*C or H'*C or C*H or C*H'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDA >= max(1,M). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K) */
+/* */
+/* LDWORK (input) INTEGER */
+/* The leading dimension of the array WORK. */
+/* If SIDE = 'L', LDWORK >= max(1,N); */
+/* if SIDE = 'R', LDWORK >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+
+ if (*m <= 0 || *n <= 0) {
+ return;
+ }
+
+ if (lsame_(trans, "N")) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ if (lsame_(storev, "C")) {
+
+ if (lsame_(direct, "F")) {
+
+/* Let V = ( V1 ) (first K rows) */
+/* ( V2 ) */
+/* where V1 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C1' */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(n, &c[j], ldc, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, v, ldv, work, ldwork);
+
+ if (*m > *k) {
+
+/* W := W + C2'*V2 */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, &c[*k], ldc, &v[*k], ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2 * W' */
+
+ i__1 = *m - *k;
+ dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, &v[*k], ldv, work, ldwork, &c_b14, &c[*k], ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, v, ldv, work, ldwork);
+
+/* C1 := C1 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ c[j + i * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C1 */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(m, &c[j * *ldc], &c__1, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, v, ldv, work, ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, k, &i__1, &c_b14,
+ &c[*k * *ldc], ldc, &v[*k], ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, work, ldwork,
+ &v[*k], ldv, &c_b14, &c[*k * *ldc], ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, v, ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ c[i + j * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+ }
+ } else {
+
+/* Let V = ( V1 ) */
+/* ( V2 ) (last K rows) */
+/* where V2 is unit upper triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C2' */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(n, &c[*m - *k + j], ldc, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, &v[*m - *k], ldv, work, ldwork);
+
+ if (*m > *k) {
+
+/* W := W + C1'*V1 */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b14, c, ldc, v, ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1 * W' */
+
+ i__1 = *m - *k;
+ dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b25, v, ldv, work, ldwork, &c_b14, c, ldc);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, &v[*m - *k], ldv, work, ldwork);
+
+/* C2 := C2 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ c[*m - *k + j + i * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C2 */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(m, &c[(*n - *k + j) * *ldc], &c__1, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, &v[*n - *k], ldv, work, ldwork);
+
+ if (*n > *k) {
+
+/* W := W + C1 * V1 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, k, &i__1, &c_b14, c, ldc, v, ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b25, work, ldwork, v, ldv, &c_b14, c, ldc);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, &v[*n - *k], ldv, work, ldwork);
+
+/* C2 := C2 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ c[i + (*n - *k + j) * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+ }
+ }
+ } else if (lsame_(storev, "R")) {
+
+ if (lsame_(direct, "F"))
+ {
+/* Let V = ( V1 V2 ) (V1: first K columns) */
+/* where V1 is unit upper triangular. */
+
+ if (lsame_(side, "L"))
+ {
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C1' */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(n, &c[j], ldc, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b14, v, ldv, work, ldwork);
+
+ if (*m > *k)
+ {
+/* W := W + C2'*V2' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, &c[*k], ldc, &v[*k * *ldv], ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2' * W' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, &v[*k * *ldv], ldv, work, ldwork, &c_b14, &c[*k], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b14, v, ldv, work, ldwork);
+
+/* C1 := C1 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ c[j + i * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C1 */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(m, &c[j * *ldc], &c__1, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b14, v, ldv, work, ldwork);
+
+ if (*n > *k)
+ {
+/* W := W + C2 * V2' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14,
+ &c[*k * *ldc], ldc, &v[*k **ldv], ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k)
+ {
+/* C2 := C2 - W * V2 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, &i__1, k, &c_b25,
+ work, ldwork, &v[*k * *ldv], ldv, &c_b14, &c[*k * *ldc], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b14, v, ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ c[i + j * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+ }
+ } else {
+/* Let V = ( V1 V2 ) (V2: last K columns) */
+/* where V2 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C2' */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(n, &c[*m - *k + j], ldc, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b14, &v[(*m - *k) * *ldv], ldv, work, ldwork);
+
+ if (*m > *k) {
+
+/* W := W + C1'*V1' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b14, c, ldc, v, ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+/* C1 := C1 - V1' * W' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b25, v, ldv, work, ldwork, &c_b14, c, ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b14, &v[(*m - *k) * *ldv], ldv, work, ldwork);
+
+/* C2 := C2 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ c[*m - *k + j + i * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C2 */
+
+ for (j = 0; j < *k; ++j) {
+ dcopy_(m, &c[(*n - *k + j) * *ldc], &c__1, &work[j * *ldwork], &c__1);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b14, &v[(*n - *k) * *ldv], ldv, work, ldwork);
+
+ if (*n > *k) {
+
+/* W := W + C1 * V1' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b14, c, ldc, v, ldv, &c_b14, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b14, t, ldt, work, ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, &i__1, k, &c_b25, work, ldwork, v, ldv, &c_b14, c, ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b14, &v[(*n - *k) * *ldv], ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ c[i + (*n - *k + j) * *ldc] -= work[i + j * *ldwork];
+ }
+ }
+ }
+ }
+ }
+} /* dlarfb_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.f
new file mode 100644
index 0000000000000000000000000000000000000000..e36a7fd5f23fc9c370f3f13980b5618c8b7df37d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfb.f
@@ -0,0 +1,588 @@
+ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLARFB applies a real block reflector H or its transpose H' to a
+* real m by n matrix C, from either the left or the right.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply H or H' from the Left
+* = 'R': apply H or H' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply H (No transpose)
+* = 'T': apply H' (Transpose)
+*
+* DIRECT (input) CHARACTER*1
+* Indicates how H is formed from a product of elementary
+* reflectors
+* = 'F': H = H(1) H(2) . . . H(k) (Forward)
+* = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*
+* STOREV (input) CHARACTER*1
+* Indicates how the vectors which define the elementary
+* reflectors are stored:
+* = 'C': Columnwise
+* = 'R': Rowwise
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* K (input) INTEGER
+* The order of the matrix T (= the number of elementary
+* reflectors whose product defines the block reflector).
+*
+* V (input) DOUBLE PRECISION array, dimension
+* (LDV,K) if STOREV = 'C'
+* (LDV,M) if STOREV = 'R' and SIDE = 'L'
+* (LDV,N) if STOREV = 'R' and SIDE = 'R'
+* The matrix V. See further details.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V.
+* If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+* if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+* if STOREV = 'R', LDV >= K.
+*
+* T (input) DOUBLE PRECISION array, dimension (LDT,K)
+* The triangular k by k matrix T in the representation of the
+* block reflector.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= K.
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDA >= max(1,M).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+*
+* LDWORK (input) INTEGER
+* The leading dimension of the array WORK.
+* If SIDE = 'L', LDWORK >= max(1,N);
+* if SIDE = 'R', LDWORK >= max(1,M).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY, DGEMM, DTRMM
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'T'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+*
+* W := C1'
+*
+ DO 10 J = 1, K
+ CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C2'*V2
+*
+ CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
+ $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2 * W'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
+ $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
+ $ C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1'
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
+ $ ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W'
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, N
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V'
+*
+ IF( N.GT.K ) THEN
+*
+* C2 := C2 - W * V2'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
+ $ C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1'
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
+ $ ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, M
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+*
+* W := C2'
+*
+ DO 70 J = 1, K
+ CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+ $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1'*V1
+*
+ CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1 * W'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
+ $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2'
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
+ $ ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
+*
+* C2 := C2 - W'
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, N
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+ $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V'
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
+ END IF
+*
+* W := W * V2'
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
+ $ ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, M
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+*
+* W := C1'
+*
+ DO 130 J = 1, K
+ CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1'
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
+ $ ONE, V, LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C2'*V2'
+*
+ CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
+ $ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
+ $ WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V' * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2' * W'
+*
+ CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
+ $ V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
+ $ C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W'
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, N
+ C( J, I ) = C( J, I ) - WORK( I, J )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1'
+*
+ CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
+ $ ONE, V, LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C2 * V2'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
+ $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( N.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
+ $ C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, M
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+*
+* W := C2'
+*
+ DO 190 J = 1, K
+ CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2'
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
+ $ ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1'*V1'
+*
+ CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
+ $ C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V' * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1' * W'
+*
+ CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
+ $ V, LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+ $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
+*
+* C2 := C2 - W'
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, N
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2'
+*
+ CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
+ $ ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1'
+*
+ CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+ $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, M
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DLARFB
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.c
new file mode 100644
index 0000000000000000000000000000000000000000..ea0bcf9d37a0565aaa5ef8bfff1d835643cf7fb3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.c
@@ -0,0 +1,122 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlarfg_(const integer *n, doublereal *alpha, doublereal *x, const integer *incx, doublereal *tau)
+{
+ /* System generated locals */
+ const integer nm1 = *n - 1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal beta;
+ static integer j;
+ static doublereal xnorm;
+ static doublereal safmin, rsafmn;
+ static integer knt;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLARFG generates a real elementary reflector H of order n, such */
+/* that */
+/* */
+/* H * ( alpha ) = ( beta ), H' * H = I. */
+/* ( x ) ( 0 ) */
+/* */
+/* where alpha and beta are scalars, and x is an (n-1)-element real */
+/* vector. H is represented in the form */
+/* */
+/* H = I - tau * ( 1 ) * ( 1 v' ) , */
+/* ( v ) */
+/* */
+/* where tau is a real scalar and v is a real (n-1)-element */
+/* vector. */
+/* */
+/* If the elements of x are all zero, then tau = 0 and H is taken to be */
+/* the unit matrix. */
+/* */
+/* Otherwise 1 <= tau <= 2. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the elementary reflector. */
+/* */
+/* ALPHA (input/output) DOUBLE PRECISION */
+/* On entry, the value alpha. */
+/* On exit, it is overwritten with the value beta. */
+/* */
+/* X (input/output) DOUBLE PRECISION array, dimension */
+/* (1+(N-2)*abs(INCX)) */
+/* On entry, the vector x. */
+/* On exit, it is overwritten with the vector v. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between elements of X. INCX > 0. */
+/* */
+/* TAU (output) DOUBLE PRECISION */
+/* The value tau. */
+/* */
+/* ===================================================================== */
+
+ if (*n <= 1) {
+ *tau = 0.;
+ return;
+ }
+
+ xnorm = dnrm2_(&nm1, x, incx);
+
+ if (xnorm == 0.) {
+
+/* H = I */
+
+ *tau = 0.;
+ } else {
+
+/* general case */
+
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = -d_sign(&d__1, alpha);
+ safmin = dlamch_("S") / dlamch_("E");
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ rsafmn = 1. / safmin;
+ knt = 0;
+ do {
+ ++knt;
+ dscal_(&nm1, &rsafmn, x, incx);
+ beta *= rsafmn;
+ *alpha *= rsafmn;
+ } while (abs(beta) < safmin);
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ xnorm = dnrm2_(&nm1, x, incx);
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = -d_sign(&d__1, alpha);
+ *tau = (beta - *alpha) / beta;
+ d__1 = 1. / (*alpha - beta);
+ dscal_(&nm1, &d__1, x, incx);
+
+/* If ALPHA is subnormal, it may lose relative accuracy */
+
+ *alpha = beta;
+ for (j = 0; j < knt; ++j) {
+ *alpha *= safmin;
+ }
+ } else {
+ *tau = (beta - *alpha) / beta;
+ d__1 = 1. / (*alpha - beta);
+ dscal_(&nm1, &d__1, x, incx);
+ *alpha = beta;
+ }
+ }
+} /* dlarfg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.f
new file mode 100644
index 0000000000000000000000000000000000000000..a8e64c1b98c6d4a1b30f5ae94630385c403b7bc9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarfg.f
@@ -0,0 +1,138 @@
+ SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLARFG generates a real elementary reflector H of order n, such
+* that
+*
+* H * ( alpha ) = ( beta ), H' * H = I.
+* ( x ) ( 0 )
+*
+* where alpha and beta are scalars, and x is an (n-1)-element real
+* vector. H is represented in the form
+*
+* H = I - tau * ( 1 ) * ( 1 v' ) ,
+* ( v )
+*
+* where tau is a real scalar and v is a real (n-1)-element
+* vector.
+*
+* If the elements of x are all zero, then tau = 0 and H is taken to be
+* the unit matrix.
+*
+* Otherwise 1 <= tau <= 2.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the elementary reflector.
+*
+* ALPHA (input/output) DOUBLE PRECISION
+* On entry, the value alpha.
+* On exit, it is overwritten with the value beta.
+*
+* X (input/output) DOUBLE PRECISION array, dimension
+* (1+(N-2)*abs(INCX))
+* On entry, the vector x.
+* On exit, it is overwritten with the vector v.
+*
+* INCX (input) INTEGER
+* The increment between elements of X. INCX > 0.
+*
+* TAU (output) DOUBLE PRECISION
+* The value tau.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ DOUBLE PRECISION BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY2, DNRM2
+ EXTERNAL DLAMCH, DLAPY2, DNRM2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = DNRM2( N-1, X, INCX )
+*
+ IF( XNORM.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
+ SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ RSAFMN = ONE / SAFMIN
+ KNT = 0
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL DSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHA = ALPHA*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = DNRM2( N-1, X, INCX )
+ BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ ALPHA = BETA
+ DO 20 J = 1, KNT
+ ALPHA = ALPHA*SAFMIN
+ 20 CONTINUE
+ ELSE
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+ ALPHA = BETA
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DLARFG
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.c
new file mode 100644
index 0000000000000000000000000000000000000000..07bf7f9a6883ee2cfc469de753e35a4927bef47d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.c
@@ -0,0 +1,233 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b8 = 0.;
+
+/* Subroutine */ void dlarft_(direct, storev, n, k, v, ldv, tau, t, ldt)
+const char *direct, *storev;
+const integer *n, *k;
+doublereal *v;
+const integer *ldv;
+const doublereal *tau;
+doublereal *t;
+const integer *ldt;
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j;
+ static doublereal vii;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLARFT forms the triangular factor T of a real block reflector H */
+/* of order n, which is defined as a product of k elementary reflectors. */
+/* */
+/* If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; */
+/* */
+/* If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. */
+/* */
+/* If STOREV = 'C', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th column of the array V, and */
+/* */
+/* H = I - V * T * V' */
+/* */
+/* If STOREV = 'R', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th row of the array V, and */
+/* */
+/* H = I - V' * T * V */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* DIRECT (input) CHARACTER*1 */
+/* Specifies the order in which the elementary reflectors are */
+/* multiplied to form the block reflector: */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+/* */
+/* STOREV (input) CHARACTER*1 */
+/* Specifies how the vectors which define the elementary */
+/* reflectors are stored (see also Further Details): */
+/* = 'C': columnwise */
+/* = 'R': rowwise */
+/* */
+/* N (input) INTEGER */
+/* The order of the block reflector H. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The order of the triangular factor T (= the number of */
+/* elementary reflectors). K >= 1. */
+/* */
+/* V (input/output) DOUBLE PRECISION array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,N) if STOREV = 'R' */
+/* The matrix V. See further details. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i). */
+/* */
+/* T (output) DOUBLE PRECISION array, dimension (LDT,K) */
+/* The k by k triangular factor T of the block reflector. */
+/* If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is */
+/* lower triangular. The rest of the array is not used. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The shape of the matrix V and the storage of the vectors which define */
+/* the H(i) is best illustrated by the following example with n = 5 and */
+/* k = 3. The elements equal to 1 are not stored; the corresponding */
+/* array elements are modified but restored on exit. The rest of the */
+/* array is not used. */
+/* */
+/* DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': */
+/* */
+/* V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) */
+/* ( v1 1 ) ( 1 v2 v2 v2 ) */
+/* ( v1 v2 1 ) ( 1 v3 v3 ) */
+/* ( v1 v2 v3 ) */
+/* ( v1 v2 v3 ) */
+/* */
+/* DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': */
+/* */
+/* V = ( v1 v2 v3 ) V = ( v1 v1 1 ) */
+/* ( v1 v2 v3 ) ( v2 v2 v2 1 ) */
+/* ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) */
+/* ( 1 v3 ) */
+/* ( 1 ) */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+ --tau;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+
+ if (lsame_(direct, "F")) {
+ i__1 = *k;
+ for (i = 1; i <= i__1; ++i) {
+ if (tau[i] == 0.) {
+
+/* H(i) = I */
+
+ i__2 = i;
+ for (j = 1; j <= i__2; ++j) {
+ t[j + i * t_dim1] = 0.;
+ }
+ } else {
+
+/* general case */
+
+ vii = v[i + i * v_dim1];
+ v[i + i * v_dim1] = 1.;
+ if (lsame_(storev, "C")) {
+
+/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */
+
+ i__2 = *n - i + 1;
+ i__3 = i - 1;
+ d__1 = -tau[i];
+ dgemv_("Transpose", &i__2, &i__3, &d__1, &v[i + v_dim1], ldv,
+ &v[i + i * v_dim1], &c__1, &c_b8, &t[i * t_dim1 + 1], &c__1);
+ } else {
+
+/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */
+
+ i__2 = i - 1;
+ i__3 = *n - i + 1;
+ d__1 = -tau[i];
+ dgemv_("No transpose", &i__2, &i__3, &d__1, &v[i * v_dim1 + 1], ldv,
+ &v[i + i * v_dim1], ldv, &c_b8, &t[i * t_dim1 + 1], &c__1);
+ }
+ v[i + i * v_dim1] = vii;
+
+/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */
+
+ i__2 = i - 1;
+ dtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[t_offset], ldt, &t[i * t_dim1 + 1], &c__1);
+ t[i + i * t_dim1] = tau[i];
+ }
+ }
+ } else {
+ for (i = *k; i >= 1; --i) {
+ if (tau[i] == 0.) {
+
+/* H(i) = I */
+
+ i__1 = *k;
+ for (j = i; j <= i__1; ++j) {
+ t[j + i * t_dim1] = 0.;
+ }
+ } else {
+
+/* general case */
+
+ if (i < *k) {
+ if (lsame_(storev, "C")) {
+ vii = v[*n - *k + i + i * v_dim1];
+ v[*n - *k + i + i * v_dim1] = 1.;
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i) */
+
+ i__1 = *n - *k + i;
+ i__2 = *k - i;
+ d__1 = -tau[i];
+ dgemv_("Transpose", &i__1, &i__2, &d__1, &v[(i + 1) * v_dim1 + 1], ldv,
+ &v[i * v_dim1 + 1], &c__1, &c_b8, &t[i + 1 + i * t_dim1], &c__1);
+ v[*n - *k + i + i * v_dim1] = vii;
+ } else {
+ vii = v[i + (*n - *k + i) * v_dim1];
+ v[i + (*n - *k + i) * v_dim1] = 1.;
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)' */
+
+ i__1 = *k - i;
+ i__2 = *n - *k + i;
+ d__1 = -tau[i];
+ dgemv_("No transpose", &i__1, &i__2, &d__1, &v[i + 1 + v_dim1], ldv,
+ &v[i + v_dim1], ldv, &c_b8, &t[i + 1 + i * t_dim1], &c__1);
+ v[i + (*n - *k + i) * v_dim1] = vii;
+ }
+
+/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */
+
+ i__1 = *k - i;
+ dtrmv_("Lower", "No transpose", "Non-unit", &i__1, &t[i+1+(i+1)*t_dim1], ldt, &t[i+1+i*t_dim1], &c__1);
+ }
+ t[i + i * t_dim1] = tau[i];
+ }
+ }
+ }
+} /* dlarft_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.f
new file mode 100644
index 0000000000000000000000000000000000000000..147b22d95cecef8530f1d66a1e3c87f1a90b3265
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlarft.f
@@ -0,0 +1,218 @@
+ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLARFT forms the triangular factor T of a real block reflector H
+* of order n, which is defined as a product of k elementary reflectors.
+*
+* If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*
+* If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*
+* If STOREV = 'C', the vector which defines the elementary reflector
+* H(i) is stored in the i-th column of the array V, and
+*
+* H = I - V * T * V'
+*
+* If STOREV = 'R', the vector which defines the elementary reflector
+* H(i) is stored in the i-th row of the array V, and
+*
+* H = I - V' * T * V
+*
+* Arguments
+* =========
+*
+* DIRECT (input) CHARACTER*1
+* Specifies the order in which the elementary reflectors are
+* multiplied to form the block reflector:
+* = 'F': H = H(1) H(2) . . . H(k) (Forward)
+* = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*
+* STOREV (input) CHARACTER*1
+* Specifies how the vectors which define the elementary
+* reflectors are stored (see also Further Details):
+* = 'C': columnwise
+* = 'R': rowwise
+*
+* N (input) INTEGER
+* The order of the block reflector H. N >= 0.
+*
+* K (input) INTEGER
+* The order of the triangular factor T (= the number of
+* elementary reflectors). K >= 1.
+*
+* V (input/output) DOUBLE PRECISION array, dimension
+* (LDV,K) if STOREV = 'C'
+* (LDV,N) if STOREV = 'R'
+* The matrix V. See further details.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V.
+* If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i).
+*
+* T (output) DOUBLE PRECISION array, dimension (LDT,K)
+* The k by k triangular factor T of the block reflector.
+* If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+* lower triangular. The rest of the array is not used.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= K.
+*
+* Further Details
+* ===============
+*
+* The shape of the matrix V and the storage of the vectors which define
+* the H(i) is best illustrated by the following example with n = 5 and
+* k = 3. The elements equal to 1 are not stored; the corresponding
+* array elements are modified but restored on exit. The rest of the
+* array is not used.
+*
+* DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*
+* V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+* ( v1 1 ) ( 1 v2 v2 v2 )
+* ( v1 v2 1 ) ( 1 v3 v3 )
+* ( v1 v2 v3 )
+* ( v1 v2 v3 )
+*
+* DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*
+* V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+* ( v1 v2 v3 ) ( v2 v2 v2 1 )
+* ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+* ( 1 v3 )
+* ( 1 )
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION VII
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEMV, DTRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ DO 20 I = 1, K
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO 10 J = 1, I
+ T( J, I ) = ZERO
+ 10 CONTINUE
+ ELSE
+*
+* general case
+*
+ VII = V( I, I )
+ V( I, I ) = ONE
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i)
+*
+ CALL DGEMV( 'Transpose', N-I+1, I-1, -TAU( I ),
+ $ V( I, 1 ), LDV, V( I, I ), 1, ZERO,
+ $ T( 1, I ), 1 )
+ ELSE
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)'
+*
+ CALL DGEMV( 'No transpose', I-1, N-I+1, -TAU( I ),
+ $ V( 1, I ), LDV, V( I, I ), LDV, ZERO,
+ $ T( 1, I ), 1 )
+ END IF
+ V( I, I ) = VII
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ END IF
+ 20 CONTINUE
+ ELSE
+ DO 40 I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO 30 J = I, K
+ T( J, I ) = ZERO
+ 30 CONTINUE
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+ VII = V( N-K+I, I )
+ V( N-K+I, I ) = ONE
+*
+* T(i+1:k,i) :=
+* - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
+*
+ CALL DGEMV( 'Transpose', N-K+I, K-I, -TAU( I ),
+ $ V( 1, I+1 ), LDV, V( 1, I ), 1, ZERO,
+ $ T( I+1, I ), 1 )
+ V( N-K+I, I ) = VII
+ ELSE
+ VII = V( I, N-K+I )
+ V( I, N-K+I ) = ONE
+*
+* T(i+1:k,i) :=
+* - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
+*
+ CALL DGEMV( 'No transpose', K-I, N-K+I, -TAU( I ),
+ $ V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
+ $ T( I+1, I ), 1 )
+ V( I, N-K+I ) = VII
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ 40 CONTINUE
+ END IF
+ RETURN
+*
+* End of DLARFT
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.c
new file mode 100644
index 0000000000000000000000000000000000000000..b85c4f48efdff43c357f94451cef5ac04b9786e5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.c
@@ -0,0 +1,120 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double log(double), sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void dlartg_(doublereal *f, doublereal *g, doublereal *cs, doublereal *sn, doublereal *r)
+{
+ /* Initialized data */
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i;
+ static doublereal scale;
+ static integer count;
+ static doublereal f1, g1, safmn2, safmx2;
+ static doublereal safmin, eps;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLARTG generate a plane rotation so that */
+/* */
+/* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. */
+/* [ -SN CS ] [ G ] [ 0 ] */
+/* */
+/* This is a slower, more accurate version of the BLAS1 routine DROTG, */
+/* with the following other differences: */
+/* F and G are unchanged on return. */
+/* If G=0, then CS=1 and SN=0. */
+/* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any */
+/* floating point operations (saves work in DBDSQR when */
+/* there are zeros on the diagonal). */
+/* */
+/* If F exceeds G in magnitude, CS will be positive. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) DOUBLE PRECISION */
+/* The first component of vector to be rotated. */
+/* */
+/* G (input) DOUBLE PRECISION */
+/* The second component of vector to be rotated. */
+/* */
+/* CS (output) DOUBLE PRECISION */
+/* The cosine of the rotation. */
+/* */
+/* SN (output) DOUBLE PRECISION */
+/* The sine of the rotation. */
+/* */
+/* R (output) DOUBLE PRECISION */
+/* The nonzero component of the rotated vector. */
+/* */
+/* ===================================================================== */
+
+ if (first) {
+ first = FALSE_;
+ safmin = dlamch_("S");
+ eps = dlamch_("E");
+ d__1 = dlamch_("B");
+ i__1 = (integer) (log(safmin / eps) / log(dlamch_("B")) / 2.);
+ safmn2 = pow_di(&d__1, &i__1);
+ safmx2 = 1. / safmn2;
+ }
+ if (*g == 0.) {
+ *cs = 1.; *sn = 0.;
+ *r = *f;
+ } else if (*f == 0.) {
+ *cs = 0.; *sn = 1.;
+ *r = *g;
+ } else {
+ f1 = *f; g1 = *g;
+ scale = max(abs(f1),abs(g1));
+ count = 0;
+ if (scale >= safmx2) {
+ while (scale >= safmx2) {
+ ++count;
+ f1 *= safmn2;
+ g1 *= safmn2;
+ scale = max(abs(f1),abs(g1));
+ }
+ *r = sqrt(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ for (i = 1; i <= count; ++i) {
+ *r *= safmx2;
+ }
+ } else if (scale <= safmn2) {
+ while (scale <= safmn2) {
+ ++count;
+ f1 *= safmx2;
+ g1 *= safmx2;
+ scale = max(abs(f1),abs(g1));
+ }
+ *r = sqrt(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ for (i = 1; i <= count; ++i) {
+ *r *= safmn2;
+ }
+ } else {
+ *r = sqrt(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ }
+ if (abs(*f) > abs(*g) && *cs < 0.) {
+ *cs = -(*cs);
+ *sn = -(*sn);
+ *r = -(*r);
+ }
+ }
+} /* dlartg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.f
new file mode 100644
index 0000000000000000000000000000000000000000..502f13eeb3f564b0a2b8a72c44421902bbb33250
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlartg.f
@@ -0,0 +1,143 @@
+ SUBROUTINE DLARTG( F, G, CS, SN, R )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION CS, F, G, R, SN
+* ..
+*
+* Purpose
+* =======
+*
+* DLARTG generate a plane rotation so that
+*
+* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+* [ -SN CS ] [ G ] [ 0 ]
+*
+* This is a slower, more accurate version of the BLAS1 routine DROTG,
+* with the following other differences:
+* F and G are unchanged on return.
+* If G=0, then CS=1 and SN=0.
+* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+* floating point operations (saves work in DBDSQR when
+* there are zeros on the diagonal).
+*
+* If F exceeds G in magnitude, CS will be positive.
+*
+* Arguments
+* =========
+*
+* F (input) DOUBLE PRECISION
+* The first component of vector to be rotated.
+*
+* G (input) DOUBLE PRECISION
+* The second component of vector to be rotated.
+*
+* CS (output) DOUBLE PRECISION
+* The cosine of the rotation.
+*
+* SN (output) DOUBLE PRECISION
+* The sine of the rotation.
+*
+* R (output) DOUBLE PRECISION
+* The nonzero component of the rotated vector.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D0 )
+ DOUBLE PRECISION TWO
+ PARAMETER ( TWO = 2.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FIRST
+ INTEGER COUNT, I
+ DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, INT, LOG, MAX, SQRT
+* ..
+* .. Save statement ..
+ SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ SAFMIN = DLAMCH( 'S' )
+ EPS = DLAMCH( 'E' )
+ SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
+ $ LOG( DLAMCH( 'B' ) ) / TWO )
+ SAFMX2 = ONE / SAFMN2
+ END IF
+ IF( G.EQ.ZERO ) THEN
+ CS = ONE
+ SN = ZERO
+ R = F
+ ELSE IF( F.EQ.ZERO ) THEN
+ CS = ZERO
+ SN = ONE
+ R = G
+ ELSE
+ F1 = F
+ G1 = G
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.GE.SAFMX2 ) THEN
+ COUNT = 0
+ 10 CONTINUE
+ COUNT = COUNT + 1
+ F1 = F1*SAFMN2
+ G1 = G1*SAFMN2
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.GE.SAFMX2 )
+ $ GO TO 10
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ DO 20 I = 1, COUNT
+ R = R*SAFMX2
+ 20 CONTINUE
+ ELSE IF( SCALE.LE.SAFMN2 ) THEN
+ COUNT = 0
+ 30 CONTINUE
+ COUNT = COUNT + 1
+ F1 = F1*SAFMX2
+ G1 = G1*SAFMX2
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.LE.SAFMN2 )
+ $ GO TO 30
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ DO 40 I = 1, COUNT
+ R = R*SAFMN2
+ 40 CONTINUE
+ ELSE
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ END IF
+ IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
+ CS = -CS
+ SN = -SN
+ R = -R
+ END IF
+ END IF
+ RETURN
+*
+* End of DLARTG
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.c
new file mode 100644
index 0000000000000000000000000000000000000000..f4c3d27d0061d55d436d2d8ad060a7c30206c378
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.c
@@ -0,0 +1,105 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void dlas2_(doublereal *f, doublereal *g, doublereal *h, doublereal *ssmin, doublereal *ssmax)
+{
+ /* Local variables */
+ static doublereal fhmn, fhmx, c, fa, ga, ha, as, at, au;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLAS2 computes the singular values of the 2-by-2 matrix */
+/* [ F G ] */
+/* [ 0 H ]. */
+/* On return, SSMIN is the smaller singular value and SSMAX is the */
+/* larger singular value. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) DOUBLE PRECISION */
+/* The (1,1) element of the 2-by-2 matrix. */
+/* */
+/* G (input) DOUBLE PRECISION */
+/* The (1,2) element of the 2-by-2 matrix. */
+/* */
+/* H (input) DOUBLE PRECISION */
+/* The (2,2) element of the 2-by-2 matrix. */
+/* */
+/* SSMIN (output) DOUBLE PRECISION */
+/* The smaller singular value. */
+/* */
+/* SSMAX (output) DOUBLE PRECISION */
+/* The larger singular value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Barring over/underflow, all output quantities are correct to within */
+/* a few units in the last place (ulps), even in the absence of a guard */
+/* digit in addition/subtraction. */
+/* */
+/* In IEEE arithmetic, the code works correctly if one matrix element is*/
+/* infinite. */
+/* */
+/* Overflow will not occur unless the largest singular value itself */
+/* overflows, or is within a few ulps of overflow. (On machines with */
+/* partial overflow, like the Cray, overflow may occur if the largest */
+/* singular value is within a factor of 2 of overflow.) */
+/* */
+/* Underflow is harmless if underflow is gradual. Otherwise, results */
+/* may correspond to a matrix modified by perturbations of size near */
+/* the underflow threshold. */
+/* */
+/* ==================================================================== */
+
+ fa = abs(*f);
+ ga = abs(*g);
+ ha = abs(*h);
+ fhmn = min(fa,ha);
+ fhmx = max(fa,ha);
+ if (fhmn == 0.) {
+ *ssmin = 0.;
+ if (fhmx == 0.) {
+ *ssmax = ga;
+ } else {
+ au = min(fhmx,ga) / max(fhmx,ga);
+ *ssmax = max(fhmx,ga) * sqrt(au * au + 1.);
+ }
+ } else {
+ if (ga < fhmx) {
+ as = fhmn / fhmx + 1.;
+ at = (fhmx - fhmn) / fhmx;
+ au = ga / fhmx; au *= au;
+ c = 2. / (sqrt(as * as + au) + sqrt(at * at + au));
+ *ssmin = fhmn * c;
+ *ssmax = fhmx / c;
+ } else {
+ au = fhmx / ga;
+ if (au == 0.) {
+
+/* Avoid possible harmful underflow if exponent range asymmetric */
+/* (true SSMIN may not underflow even if AU underflows) */
+
+ *ssmin = fhmn * fhmx / ga;
+ *ssmax = ga;
+ } else {
+ as = fhmn / fhmx + 1.;
+ at = (fhmx - fhmn) / fhmx;
+ as *= au;
+ at *= au;
+ c = 1. / (sqrt(as * as + 1.) + sqrt(at * at + 1.));
+ *ssmin = fhmn * c * au;
+ *ssmin += *ssmin;
+ *ssmax = ga / (c + c);
+ }
+ }
+ }
+} /* dlas2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.f
new file mode 100644
index 0000000000000000000000000000000000000000..ad2f337dcf9d19a2db6ce99eb095e64c006095f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlas2.f
@@ -0,0 +1,122 @@
+ SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION F, G, H, SSMAX, SSMIN
+* ..
+*
+* Purpose
+* =======
+*
+* DLAS2 computes the singular values of the 2-by-2 matrix
+* [ F G ]
+* [ 0 H ].
+* On return, SSMIN is the smaller singular value and SSMAX is the
+* larger singular value.
+*
+* Arguments
+* =========
+*
+* F (input) DOUBLE PRECISION
+* The (1,1) element of the 2-by-2 matrix.
+*
+* G (input) DOUBLE PRECISION
+* The (1,2) element of the 2-by-2 matrix.
+*
+* H (input) DOUBLE PRECISION
+* The (2,2) element of the 2-by-2 matrix.
+*
+* SSMIN (output) DOUBLE PRECISION
+* The smaller singular value.
+*
+* SSMAX (output) DOUBLE PRECISION
+* The larger singular value.
+*
+* Further Details
+* ===============
+*
+* Barring over/underflow, all output quantities are correct to within
+* a few units in the last place (ulps), even in the absence of a guard
+* digit in addition/subtraction.
+*
+* In IEEE arithmetic, the code works correctly if one matrix element is
+* infinite.
+*
+* Overflow will not occur unless the largest singular value itself
+* overflows, or is within a few ulps of overflow. (On machines with
+* partial overflow, like the Cray, overflow may occur if the largest
+* singular value is within a factor of 2 of overflow.)
+*
+* Underflow is harmless if underflow is gradual. Otherwise, results
+* may correspond to a matrix modified by perturbations of size near
+* the underflow threshold.
+*
+* ====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D0 )
+ DOUBLE PRECISION TWO
+ PARAMETER ( TWO = 2.0D0 )
+* ..
+* .. Local Scalars ..
+ DOUBLE PRECISION AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ FA = ABS( F )
+ GA = ABS( G )
+ HA = ABS( H )
+ FHMN = MIN( FA, HA )
+ FHMX = MAX( FA, HA )
+ IF( FHMN.EQ.ZERO ) THEN
+ SSMIN = ZERO
+ IF( FHMX.EQ.ZERO ) THEN
+ SSMAX = GA
+ ELSE
+ SSMAX = MAX( FHMX, GA )*SQRT( ONE+
+ $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
+ END IF
+ ELSE
+ IF( GA.LT.FHMX ) THEN
+ AS = ONE + FHMN / FHMX
+ AT = ( FHMX-FHMN ) / FHMX
+ AU = ( GA / FHMX )**2
+ C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
+ SSMIN = FHMN*C
+ SSMAX = FHMX / C
+ ELSE
+ AU = FHMX / GA
+ IF( AU.EQ.ZERO ) THEN
+*
+* Avoid possible harmful underflow if exponent range
+* asymmetric (true SSMIN may not underflow even if
+* AU underflows)
+*
+ SSMIN = ( FHMN*FHMX ) / GA
+ SSMAX = GA
+ ELSE
+ AS = ONE + FHMN / FHMX
+ AT = ( FHMX-FHMN ) / FHMX
+ C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
+ $ SQRT( ONE+( AT*AU )**2 ) )
+ SSMIN = ( FHMN*C )*AU
+ SSMIN = SSMIN + SSMIN
+ SSMAX = GA / ( C+C )
+ END IF
+ END IF
+ END IF
+ RETURN
+*
+* End of DLAS2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.c
new file mode 100644
index 0000000000000000000000000000000000000000..9812f144d3dc703ca8e645ab09fd8b224f53bbbb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.c
@@ -0,0 +1,248 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlascl_(type, kl, ku, cfrom, cto, m, n, a, lda, info)
+const char *type;
+const integer *kl, *ku;
+doublereal *cfrom, *cto;
+const integer *m, *n;
+doublereal *a;
+const integer *lda;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical done;
+ static doublereal ctoc;
+ static integer i, j;
+ static integer itype;
+ static doublereal cfrom1;
+ static doublereal cfromc;
+ static doublereal bignum, smlnum, mul, cto1;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLASCL multiplies the M by N real matrix A by the real scalar */
+/* CTO/CFROM. This is done without over/underflow as long as the final */
+/* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that */
+/* A may be full, upper triangular, lower triangular, upper Hessenberg, */
+/* or banded. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* TYPE (input) CHARACTER*1 */
+/* TYPE indices the storage type of the input matrix. */
+/* = 'G': A is a full matrix. */
+/* = 'L': A is a lower triangular matrix. */
+/* = 'U': A is an upper triangular matrix. */
+/* = 'H': A is an upper Hessenberg matrix. */
+/* = 'B': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the lower */
+/* half stored. */
+/* = 'Q': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the upper */
+/* half stored. */
+/* = 'Z': A is a band matrix with lower bandwidth KL and upper */
+/* bandwidth KU. */
+/* */
+/* KL (input) INTEGER */
+/* The lower bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+/* */
+/* KU (input) INTEGER */
+/* The upper bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+/* */
+/* CFROM (input) DOUBLE PRECISION */
+/* CTO (input) DOUBLE PRECISION */
+/* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed */
+/* without over/underflow if the final result CTO*A(I,J)/CFROM */
+/* can be represented without over/underflow. CFROM must be */
+/* nonzero. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,M) */
+/* The matrix to be multiplied by CTO/CFROM. See TYPE for the */
+/* storage type. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* INFO (output) INTEGER */
+/* 0 - successful exit */
+/* <0 - if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+
+ if (lsame_(type, "G")) {
+ itype = 0;
+ } else if (lsame_(type, "L")) {
+ itype = 1;
+ } else if (lsame_(type, "U")) {
+ itype = 2;
+ } else if (lsame_(type, "H")) {
+ itype = 3;
+ } else if (lsame_(type, "B")) {
+ itype = 4;
+ } else if (lsame_(type, "Q")) {
+ itype = 5;
+ } else if (lsame_(type, "Z")) {
+ itype = 6;
+ } else {
+ itype = -1;
+ }
+
+ if (itype == -1) {
+ *info = -1;
+ } else if (*cfrom == 0.) {
+ *info = -4;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*n < 0 || ( ( itype == 4 || itype == 5 ) && *n != *m) ) {
+ *info = -7;
+ } else if (itype <= 3 && *lda < max(1,*m)) {
+ *info = -9;
+ } else if (itype >= 4) {
+ if (*kl < 0 || *kl > max(*m - 1,0)) {
+ *info = -2;
+ } else /* if(complicated condition) */ {
+ if (*ku < 0 || *ku > max(*n - 1,0) || ( (itype == 4 || itype == 5) && *kl != *ku) ) {
+ *info = -3;
+ } else if ( (itype == 4 && *lda < *kl + 1 ) ||
+ (itype == 5 && *lda < * ku + 1 ) ||
+ (itype == 6 && *lda < (*kl << 1) + *ku + 1) ) {
+ *info = -9;
+ }
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASCL", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *m == 0) {
+ return;
+ }
+
+/* Get machine parameters */
+
+ smlnum = dlamch_("S");
+ bignum = 1. / smlnum;
+
+ cfromc = *cfrom;
+ ctoc = *cto;
+
+L10:
+ cfrom1 = cfromc * smlnum;
+ cto1 = ctoc / bignum;
+ if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
+ mul = smlnum;
+ done = FALSE_;
+ cfromc = cfrom1;
+ } else if (abs(cto1) > abs(cfromc)) {
+ mul = bignum;
+ done = FALSE_;
+ ctoc = cto1;
+ } else {
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ }
+
+ if (itype == 0) {
+
+/* Full matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 1) {
+
+/* Lower triangular matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *m; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 2) {
+
+/* Upper triangular matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j && i < *m; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 3) {
+
+/* Upper Hessenberg matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j+1 && i < *m; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 4) {
+
+/* Lower half of a symmetric band matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < min(*kl+1,*n-j); ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 5) {
+
+/* Upper half of a symmetric band matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = max(*ku-j,0); i <= *ku; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+
+ } else if (itype == 6) {
+
+/* Band matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = max(*kl + *ku - j,*kl); i <= *kl*2 + *ku && i < *kl + *ku + *m - j; ++i) {
+ a[i + j * *lda] *= mul;
+ }
+ }
+ }
+
+ if (! done) {
+ goto L10;
+ }
+
+} /* dlascl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.f
new file mode 100644
index 0000000000000000000000000000000000000000..4c05d4d797a9ea5636b403259c04b39b90097ffb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlascl.f
@@ -0,0 +1,268 @@
+ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER TYPE
+ INTEGER INFO, KL, KU, LDA, M, N
+ DOUBLE PRECISION CFROM, CTO
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLASCL multiplies the M by N real matrix A by the real scalar
+* CTO/CFROM. This is done without over/underflow as long as the final
+* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+* A may be full, upper triangular, lower triangular, upper Hessenberg,
+* or banded.
+*
+* Arguments
+* =========
+*
+* TYPE (input) CHARACTER*1
+* TYPE indices the storage type of the input matrix.
+* = 'G': A is a full matrix.
+* = 'L': A is a lower triangular matrix.
+* = 'U': A is an upper triangular matrix.
+* = 'H': A is an upper Hessenberg matrix.
+* = 'B': A is a symmetric band matrix with lower bandwidth KL
+* and upper bandwidth KU and with the only the lower
+* half stored.
+* = 'Q': A is a symmetric band matrix with lower bandwidth KL
+* and upper bandwidth KU and with the only the upper
+* half stored.
+* = 'Z': A is a band matrix with lower bandwidth KL and upper
+* bandwidth KU.
+*
+* KL (input) INTEGER
+* The lower bandwidth of A. Referenced only if TYPE = 'B',
+* 'Q' or 'Z'.
+*
+* KU (input) INTEGER
+* The upper bandwidth of A. Referenced only if TYPE = 'B',
+* 'Q' or 'Z'.
+*
+* CFROM (input) DOUBLE PRECISION
+* CTO (input) DOUBLE PRECISION
+* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+* without over/underflow if the final result CTO*A(I,J)/CFROM
+* can be represented without over/underflow. CFROM must be
+* nonzero.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+* The matrix to be multiplied by CTO/CFROM. See TYPE for the
+* storage type.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* INFO (output) INTEGER
+* 0 - successful exit
+* <0 - if INFO = -i, the i-th argument had an illegal value.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL DONE
+ INTEGER I, ITYPE, J, K1, K2, K3, K4
+ DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL LSAME, DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+*
+ IF( LSAME( TYPE, 'G' ) ) THEN
+ ITYPE = 0
+ ELSE IF( LSAME( TYPE, 'L' ) ) THEN
+ ITYPE = 1
+ ELSE IF( LSAME( TYPE, 'U' ) ) THEN
+ ITYPE = 2
+ ELSE IF( LSAME( TYPE, 'H' ) ) THEN
+ ITYPE = 3
+ ELSE IF( LSAME( TYPE, 'B' ) ) THEN
+ ITYPE = 4
+ ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
+ ITYPE = 5
+ ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
+ ITYPE = 6
+ ELSE
+ ITYPE = -1
+ END IF
+*
+ IF( ITYPE.EQ.-1 ) THEN
+ INFO = -1
+ ELSE IF( CFROM.EQ.ZERO ) THEN
+ INFO = -4
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
+ $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
+ INFO = -7
+ ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -9
+ ELSE IF( ITYPE.GE.4 ) THEN
+ IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
+ INFO = -2
+ ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
+ $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
+ $ THEN
+ INFO = -3
+ ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
+ $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
+ $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
+ INFO = -9
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DLASCL', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. M.EQ.0 )
+ $ RETURN
+*
+* Get machine parameters
+*
+ SMLNUM = DLAMCH( 'S' )
+ BIGNUM = ONE / SMLNUM
+*
+ CFROMC = CFROM
+ CTOC = CTO
+*
+ 10 CONTINUE
+ CFROM1 = CFROMC*SMLNUM
+ CTO1 = CTOC / BIGNUM
+ IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
+ MUL = SMLNUM
+ DONE = .FALSE.
+ CFROMC = CFROM1
+ ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
+ MUL = BIGNUM
+ DONE = .FALSE.
+ CTOC = CTO1
+ ELSE
+ MUL = CTOC / CFROMC
+ DONE = .TRUE.
+ END IF
+*
+ IF( ITYPE.EQ.0 ) THEN
+*
+* Full matrix
+*
+ DO 30 J = 1, N
+ DO 20 I = 1, M
+ A( I, J ) = A( I, J )*MUL
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.1 ) THEN
+*
+* Lower triangular matrix
+*
+ DO 50 J = 1, N
+ DO 40 I = J, M
+ A( I, J ) = A( I, J )*MUL
+ 40 CONTINUE
+ 50 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.2 ) THEN
+*
+* Upper triangular matrix
+*
+ DO 70 J = 1, N
+ DO 60 I = 1, MIN( J, M )
+ A( I, J ) = A( I, J )*MUL
+ 60 CONTINUE
+ 70 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.3 ) THEN
+*
+* Upper Hessenberg matrix
+*
+ DO 90 J = 1, N
+ DO 80 I = 1, MIN( J+1, M )
+ A( I, J ) = A( I, J )*MUL
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.4 ) THEN
+*
+* Lower half of a symmetric band matrix
+*
+ K3 = KL + 1
+ K4 = N + 1
+ DO 110 J = 1, N
+ DO 100 I = 1, MIN( K3, K4-J )
+ A( I, J ) = A( I, J )*MUL
+ 100 CONTINUE
+ 110 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.5 ) THEN
+*
+* Upper half of a symmetric band matrix
+*
+ K1 = KU + 2
+ K3 = KU + 1
+ DO 130 J = 1, N
+ DO 120 I = MAX( K1-J, 1 ), K3
+ A( I, J ) = A( I, J )*MUL
+ 120 CONTINUE
+ 130 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.6 ) THEN
+*
+* Band matrix
+*
+ K1 = KL + KU + 2
+ K2 = KL + 1
+ K3 = 2*KL + KU + 1
+ K4 = KL + KU + 1 + M
+ DO 150 J = 1, N
+ DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
+ A( I, J ) = A( I, J )*MUL
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ END IF
+*
+ IF( .NOT.DONE )
+ $ GO TO 10
+*
+ RETURN
+*
+* End of DLASCL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.c
new file mode 100644
index 0000000000000000000000000000000000000000..9a13536859a062bff1dd82c1494e20df2e838df5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.c
@@ -0,0 +1,96 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlaset_(const char *uplo, const integer *m, const integer *n,
+ doublereal *alpha, doublereal *beta, doublereal *a, const integer *lda)
+{
+ /* Local variables */
+ static integer i, j;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLASET initializes an m-by-n matrix A to BETA on the diagonal and */
+/* ALPHA on the offdiagonals. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be set. */
+/* = 'U': Upper triangular part is set; the strictly lower */
+/* triangular part of A is not changed. */
+/* = 'L': Lower triangular part is set; the strictly upper */
+/* triangular part of A is not changed. */
+/* Otherwise: All of the matrix A is set. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* ALPHA (input) DOUBLE PRECISION */
+/* The constant to which the offdiagonal elements are to be set.*/
+/* */
+/* BETA (input) DOUBLE PRECISION */
+/* The constant to which the diagonal elements are to be set. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On exit, the leading m-by-n submatrix of A is set as follows:*/
+/* */
+/* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, */
+/* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, */
+/* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, */
+/* */
+/* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+
+/* Set the strictly upper triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ for (j = 1; j < *n; ++j) {
+ for (i = 0; i < j && i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/* Set the strictly lower triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ for (j = 0; j < *m && j < *n; ++j) {
+ for (i = j + 1; i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+
+ } else {
+
+/* Set the leading m-by-n submatrix to ALPHA. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+ }
+
+/* Set the first min(M,N) diagonal elements to BETA. */
+
+ for (i = 0; i < *m && i < *n; ++i) {
+ a[i + i * *lda] = *beta;
+ }
+} /* dlaset_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.f
new file mode 100644
index 0000000000000000000000000000000000000000..c086b61592e79e327a1185fc5cb5f03205cb7a16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaset.f
@@ -0,0 +1,115 @@
+ SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, M, N
+ DOUBLE PRECISION ALPHA, BETA
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLASET initializes an m-by-n matrix A to BETA on the diagonal and
+* ALPHA on the offdiagonals.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be set.
+* = 'U': Upper triangular part is set; the strictly lower
+* triangular part of A is not changed.
+* = 'L': Lower triangular part is set; the strictly upper
+* triangular part of A is not changed.
+* Otherwise: All of the matrix A is set.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* ALPHA (input) DOUBLE PRECISION
+* The constant to which the offdiagonal elements are to be set.
+*
+* BETA (input) DOUBLE PRECISION
+* The constant to which the diagonal elements are to be set.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On exit, the leading m-by-n submatrix of A is set as follows:
+*
+* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+*
+* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+*
+* Set the strictly upper triangular or trapezoidal part of the
+* array to ALPHA.
+*
+ DO 20 J = 2, N
+ DO 10 I = 1, MIN( J-1, M )
+ A( I, J ) = ALPHA
+ 10 CONTINUE
+ 20 CONTINUE
+*
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+*
+* Set the strictly lower triangular or trapezoidal part of the
+* array to ALPHA.
+*
+ DO 40 J = 1, MIN( M, N )
+ DO 30 I = J + 1, M
+ A( I, J ) = ALPHA
+ 30 CONTINUE
+ 40 CONTINUE
+*
+ ELSE
+*
+* Set the leading m-by-n submatrix to ALPHA.
+*
+ DO 60 J = 1, N
+ DO 50 I = 1, M
+ A( I, J ) = ALPHA
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+* Set the first min(M,N) diagonal elements to BETA.
+*
+ DO 70 I = 1, MIN( M, N )
+ A( I, I ) = BETA
+ 70 CONTINUE
+*
+ RETURN
+*
+* End of DLASET
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.c
new file mode 100644
index 0000000000000000000000000000000000000000..c5d9f7e8ae01da9749ec5c81f091bdb87aa78627
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.c
@@ -0,0 +1,73 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlassq_(const integer *n, const doublereal *x, const integer *incx, doublereal *scale, doublereal *sumsq)
+{
+ /* Local variables */
+ static doublereal absxi;
+ static integer ix;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLASSQ returns the values scl and smsq such that */
+/* */
+/* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,*/
+/* */
+/* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is */
+/* assumed to be non-negative and scl returns the value */
+/* */
+/* scl = max( scale, abs( x( i ) ) ). */
+/* */
+/* scale and sumsq must be supplied in SCALE and SUMSQ and */
+/* scl and smsq are overwritten on SCALE and SUMSQ respectively. */
+/* */
+/* The routine makes only one pass through the vector x. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of elements to be used from the vector X. */
+/* */
+/* X (input) DOUBLE PRECISION */
+/* The vector for which a scaled sum of squares is computed. */
+/* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector X. */
+/* INCX > 0. */
+/* */
+/* SCALE (input/output) DOUBLE PRECISION */
+/* On entry, the value scale in the equation above. */
+/* On exit, SCALE is overwritten with scl , the scaling factor*/
+/* for the sum of squares. */
+/* */
+/* SUMSQ (input/output) DOUBLE PRECISION */
+/* On entry, the value sumsq in the equation above. */
+/* On exit, SUMSQ is overwritten with smsq , the basic sum of */
+/* squares from which scl has been factored out. */
+/* */
+/* =====================================================================*/
+
+ if (*n > 0) {
+ for (ix = 0; *incx < 0 ? ix > *n * *incx : ix < *n * *incx; ix += *incx) {
+ if (x[ix] != 0.) {
+ absxi = abs(x[ix]);
+ if (*scale < absxi) {
+ *scale /= absxi;
+ *sumsq = *sumsq * *scale * *scale + 1;
+ *scale = absxi;
+ } else {
+ absxi /= *scale;
+ *sumsq += absxi * absxi;
+ }
+ }
+ }
+ }
+} /* dlassq_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.f
new file mode 100644
index 0000000000000000000000000000000000000000..9518d06ab01e8cc65ebd111d1dff6d6f37b563ee
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlassq.f
@@ -0,0 +1,89 @@
+ SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION SCALE, SUMSQ
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLASSQ returns the values scl and smsq such that
+*
+* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+*
+* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+* assumed to be non-negative and scl returns the value
+*
+* scl = max( scale, abs( x( i ) ) ).
+*
+* scale and sumsq must be supplied in SCALE and SUMSQ and
+* scl and smsq are overwritten on SCALE and SUMSQ respectively.
+*
+* The routine makes only one pass through the vector x.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of elements to be used from the vector X.
+*
+* X (input) DOUBLE PRECISION
+* The vector for which a scaled sum of squares is computed.
+* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+*
+* INCX (input) INTEGER
+* The increment between successive values of the vector X.
+* INCX > 0.
+*
+* SCALE (input/output) DOUBLE PRECISION
+* On entry, the value scale in the equation above.
+* On exit, SCALE is overwritten with scl , the scaling factor
+* for the sum of squares.
+*
+* SUMSQ (input/output) DOUBLE PRECISION
+* On entry, the value sumsq in the equation above.
+* On exit, SUMSQ is overwritten with smsq , the basic sum of
+* squares from which scl has been factored out.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER IX
+ DOUBLE PRECISION ABSXI
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( N.GT.0 ) THEN
+ DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
+ IF( X( IX ).NE.ZERO ) THEN
+ ABSXI = ABS( X( IX ) )
+ IF( SCALE.LT.ABSXI ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
+ SCALE = ABSXI
+ ELSE
+ SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ END IF
+ RETURN
+*
+* End of DLASSQ
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.c
new file mode 100644
index 0000000000000000000000000000000000000000..4b6d2149cf601ca2ca7f25de28cc3e258758671c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.c
@@ -0,0 +1,239 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static doublereal c_b3 = 2.;
+static doublereal c_b4 = 1.;
+
+/* Subroutine */ void dlasv2_(doublereal *f, doublereal *g, doublereal *h,
+ doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *csr, doublereal *snl, doublereal *csl)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static integer pmax;
+ static doublereal temp;
+ static logical swap;
+ static doublereal a, d, l, m, r, s, t, tsign, fa, ga, ha, ft, gt, ht, mm;
+ static logical gasmal;
+ static doublereal tt, clt, crt, slt, srt;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLASV2 computes the singular value decomposition of a 2-by-2 */
+/* triangular matrix */
+/* [ F G ] */
+/* [ 0 H ]. */
+/* On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the*/
+/* smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and */
+/* right singular vectors for abs(SSMAX), giving the decomposition */
+/* */
+/* [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] */
+/* [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) DOUBLE PRECISION */
+/* The (1,1) element of the 2-by-2 matrix. */
+/* */
+/* G (input) DOUBLE PRECISION */
+/* The (1,2) element of the 2-by-2 matrix. */
+/* */
+/* H (input) DOUBLE PRECISION */
+/* The (2,2) element of the 2-by-2 matrix. */
+/* */
+/* SSMIN (output) DOUBLE PRECISION */
+/* abs(SSMIN) is the smaller singular value. */
+/* */
+/* SSMAX (output) DOUBLE PRECISION */
+/* abs(SSMAX) is the larger singular value. */
+/* */
+/* SNL (output) DOUBLE PRECISION */
+/* CSL (output) DOUBLE PRECISION */
+/* The vector (CSL, SNL) is a unit left singular vector for the */
+/* singular value abs(SSMAX). */
+/* */
+/* SNR (output) DOUBLE PRECISION */
+/* CSR (output) DOUBLE PRECISION */
+/* The vector (CSR, SNR) is a unit right singular vector for the*/
+/* singular value abs(SSMAX). */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Any input parameter may be aliased with any output parameter. */
+/* */
+/* Barring over/underflow and assuming a guard digit in subtraction, all*/
+/* output quantities are correct to within a few units in the last */
+/* place (ulps). */
+/* */
+/* In IEEE arithmetic, the code works correctly if one matrix element is*/
+/* infinite. */
+/* */
+/* Overflow will not occur unless the largest singular value itself */
+/* overflows or is within a few ulps of overflow. (On machines with */
+/* partial overflow, like the Cray, overflow may occur if the largest */
+/* singular value is within a factor of 2 of overflow.) */
+/* */
+/* Underflow is harmless if underflow is gradual. Otherwise, results */
+/* may correspond to a matrix modified by perturbations of size near */
+/* the underflow threshold. */
+/* */
+/* ===================================================================== */
+
+ ft = *f;
+ fa = abs(ft);
+ ht = *h;
+ ha = abs(*h);
+
+/* PMAX points to the maximum absolute element of matrix */
+/* PMAX = 1 if F largest in absolute values */
+/* PMAX = 2 if G largest in absolute values */
+/* PMAX = 3 if H largest in absolute values */
+
+ pmax = 1;
+ swap = ha > fa;
+ if (swap) {
+ pmax = 3;
+ temp = ft;
+ ft = ht;
+ ht = temp;
+ temp = fa;
+ fa = ha;
+ ha = temp;
+ }
+
+/* Now FA .ge. HA */
+
+ gt = *g;
+ ga = abs(gt);
+ if (ga == 0.) {
+
+/* Diagonal matrix */
+
+ *ssmin = ha;
+ *ssmax = fa;
+ clt = 1.;
+ crt = 1.;
+ slt = 0.;
+ srt = 0.;
+ } else {
+ gasmal = TRUE_;
+ if (ga > fa) {
+ pmax = 2;
+ if (fa / ga < dlamch_("EPS")) {
+
+/* Case of very large GA */
+
+ gasmal = FALSE_;
+ *ssmax = ga;
+ if (ha > 1.) {
+ *ssmin = fa / (ga / ha);
+ } else {
+ *ssmin = fa / ga * ha;
+ }
+ clt = 1.;
+ slt = ht / gt;
+ srt = 1.;
+ crt = ft / gt;
+ }
+ }
+ if (gasmal) {
+
+/* Normal case */
+
+ d = fa - ha;
+ if (d == fa) {
+
+/* Copes with infinite F or H */
+
+ l = 1.;
+ } else {
+ l = d / fa;
+ }
+
+/* Note that 0 .le. L .le. 1 */
+
+ m = gt / ft;
+
+/* Note that abs(M) .le. 1/macheps */
+
+ t = 2. - l;
+
+/* Note that T .ge. 1 */
+
+ mm = m * m;
+ tt = t * t;
+ s = sqrt(tt + mm);
+
+/* Note that 1 .le. S .le. 1 + 1/macheps */
+
+ if (l == 0.) {
+ r = abs(m);
+ } else {
+ r = sqrt(l * l + mm);
+ }
+
+/* Note that 0 .le. R .le. 1 + 1/macheps */
+
+ a = (s + r) * .5;
+
+/* Note that 1 .le. A .le. 1 + abs(M) */
+
+ *ssmin = ha / a;
+ *ssmax = fa * a;
+ if (mm == 0.) {
+
+/* Note that M is very tiny */
+
+ if (l == 0.) {
+ t = d_sign(&c_b3, &ft) * d_sign(&c_b4, >);
+ } else {
+ t = gt / d_sign(&d, &ft) + m / t;
+ }
+ } else {
+ t = (m / (s + t) + m / (r + l)) * (a + 1.);
+ }
+ l = sqrt(t * t + 4.);
+ crt = 2. / l;
+ srt = t / l;
+ clt = (crt + srt * m) / a;
+ slt = ht / ft * srt / a;
+ }
+ }
+ if (swap) {
+ *csl = srt;
+ *snl = crt;
+ *csr = slt;
+ *snr = clt;
+ } else {
+ *csl = clt;
+ *snl = slt;
+ *csr = crt;
+ *snr = srt;
+ }
+
+/* Correct signs of SSMAX and SSMIN */
+
+ if (pmax == 1) {
+ tsign = d_sign(&c_b4, csr) * d_sign(&c_b4, csl) * d_sign(&c_b4, f);
+ }
+ if (pmax == 2) {
+ tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, csl) * d_sign(&c_b4, g);
+ }
+ if (pmax == 3) {
+ tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, snl) * d_sign(&c_b4, h);
+ }
+ *ssmax = d_sign(ssmax, &tsign);
+ d__1 = tsign * d_sign(&c_b4, f) * d_sign(&c_b4, h);
+ *ssmin = d_sign(ssmin, &d__1);
+} /* dlasv2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.f
new file mode 100644
index 0000000000000000000000000000000000000000..0fc7835dc2ed9d28389c7ccd9332c2dd7dff3b4a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlasv2.f
@@ -0,0 +1,250 @@
+ SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
+* ..
+*
+* Purpose
+* =======
+*
+* DLASV2 computes the singular value decomposition of a 2-by-2
+* triangular matrix
+* [ F G ]
+* [ 0 H ].
+* On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+* smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+* right singular vectors for abs(SSMAX), giving the decomposition
+*
+* [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+* [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+*
+* Arguments
+* =========
+*
+* F (input) DOUBLE PRECISION
+* The (1,1) element of the 2-by-2 matrix.
+*
+* G (input) DOUBLE PRECISION
+* The (1,2) element of the 2-by-2 matrix.
+*
+* H (input) DOUBLE PRECISION
+* The (2,2) element of the 2-by-2 matrix.
+*
+* SSMIN (output) DOUBLE PRECISION
+* abs(SSMIN) is the smaller singular value.
+*
+* SSMAX (output) DOUBLE PRECISION
+* abs(SSMAX) is the larger singular value.
+*
+* SNL (output) DOUBLE PRECISION
+* CSL (output) DOUBLE PRECISION
+* The vector (CSL, SNL) is a unit left singular vector for the
+* singular value abs(SSMAX).
+*
+* SNR (output) DOUBLE PRECISION
+* CSR (output) DOUBLE PRECISION
+* The vector (CSR, SNR) is a unit right singular vector for the
+* singular value abs(SSMAX).
+*
+* Further Details
+* ===============
+*
+* Any input parameter may be aliased with any output parameter.
+*
+* Barring over/underflow and assuming a guard digit in subtraction, all
+* output quantities are correct to within a few units in the last
+* place (ulps).
+*
+* In IEEE arithmetic, the code works correctly if one matrix element is
+* infinite.
+*
+* Overflow will not occur unless the largest singular value itself
+* overflows or is within a few ulps of overflow. (On machines with
+* partial overflow, like the Cray, overflow may occur if the largest
+* singular value is within a factor of 2 of overflow.)
+*
+* Underflow is harmless if underflow is gradual. Otherwise, results
+* may correspond to a matrix modified by perturbations of size near
+* the underflow threshold.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D0 )
+ DOUBLE PRECISION HALF
+ PARAMETER ( HALF = 0.5D0 )
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D0 )
+ DOUBLE PRECISION TWO
+ PARAMETER ( TWO = 2.0D0 )
+ DOUBLE PRECISION FOUR
+ PARAMETER ( FOUR = 4.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL GASMAL, SWAP
+ INTEGER PMAX
+ DOUBLE PRECISION A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
+ $ MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN, SQRT
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. Executable Statements ..
+*
+ FT = F
+ FA = ABS( FT )
+ HT = H
+ HA = ABS( H )
+*
+* PMAX points to the maximum absolute element of matrix
+* PMAX = 1 if F largest in absolute values
+* PMAX = 2 if G largest in absolute values
+* PMAX = 3 if H largest in absolute values
+*
+ PMAX = 1
+ SWAP = ( HA.GT.FA )
+ IF( SWAP ) THEN
+ PMAX = 3
+ TEMP = FT
+ FT = HT
+ HT = TEMP
+ TEMP = FA
+ FA = HA
+ HA = TEMP
+*
+* Now FA .ge. HA
+*
+ END IF
+ GT = G
+ GA = ABS( GT )
+ IF( GA.EQ.ZERO ) THEN
+*
+* Diagonal matrix
+*
+ SSMIN = HA
+ SSMAX = FA
+ CLT = ONE
+ CRT = ONE
+ SLT = ZERO
+ SRT = ZERO
+ ELSE
+ GASMAL = .TRUE.
+ IF( GA.GT.FA ) THEN
+ PMAX = 2
+ IF( ( FA / GA ).LT.DLAMCH( 'EPS' ) ) THEN
+*
+* Case of very large GA
+*
+ GASMAL = .FALSE.
+ SSMAX = GA
+ IF( HA.GT.ONE ) THEN
+ SSMIN = FA / ( GA / HA )
+ ELSE
+ SSMIN = ( FA / GA )*HA
+ END IF
+ CLT = ONE
+ SLT = HT / GT
+ SRT = ONE
+ CRT = FT / GT
+ END IF
+ END IF
+ IF( GASMAL ) THEN
+*
+* Normal case
+*
+ D = FA - HA
+ IF( D.EQ.FA ) THEN
+*
+* Copes with infinite F or H
+*
+ L = ONE
+ ELSE
+ L = D / FA
+ END IF
+*
+* Note that 0 .le. L .le. 1
+*
+ M = GT / FT
+*
+* Note that abs(M) .le. 1/macheps
+*
+ T = TWO - L
+*
+* Note that T .ge. 1
+*
+ MM = M*M
+ TT = T*T
+ S = SQRT( TT+MM )
+*
+* Note that 1 .le. S .le. 1 + 1/macheps
+*
+ IF( L.EQ.ZERO ) THEN
+ R = ABS( M )
+ ELSE
+ R = SQRT( L*L+MM )
+ END IF
+*
+* Note that 0 .le. R .le. 1 + 1/macheps
+*
+ A = HALF*( S+R )
+*
+* Note that 1 .le. A .le. 1 + abs(M)
+*
+ SSMIN = HA / A
+ SSMAX = FA*A
+ IF( MM.EQ.ZERO ) THEN
+*
+* Note that M is very tiny
+*
+ IF( L.EQ.ZERO ) THEN
+ T = SIGN( TWO, FT )*SIGN( ONE, GT )
+ ELSE
+ T = GT / SIGN( D, FT ) + M / T
+ END IF
+ ELSE
+ T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
+ END IF
+ L = SQRT( T*T+FOUR )
+ CRT = TWO / L
+ SRT = T / L
+ CLT = ( CRT+SRT*M ) / A
+ SLT = ( HT / FT )*SRT / A
+ END IF
+ END IF
+ IF( SWAP ) THEN
+ CSL = SRT
+ SNL = CRT
+ CSR = SLT
+ SNR = CLT
+ ELSE
+ CSL = CLT
+ SNL = SLT
+ CSR = CRT
+ SNR = SRT
+ END IF
+*
+* Correct signs of SSMAX and SSMIN
+*
+ IF( PMAX.EQ.1 )
+ $ TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
+ IF( PMAX.EQ.2 )
+ $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
+ IF( PMAX.EQ.3 )
+ $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
+ SSMAX = SIGN( SSMAX, TSIGN )
+ SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
+ RETURN
+*
+* End of DLASV2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.c
new file mode 100644
index 0000000000000000000000000000000000000000..627eb4ff719270becc8e532a074d01a042072407
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.c
@@ -0,0 +1,111 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dlaswp_(n, a, lda, k1, k2, ipiv, incx)
+integer *n;
+doublereal *a;
+integer *lda, *k1, *k2, *ipiv, *incx;
+{
+ /* Local variables */
+ static doublereal temp;
+ static integer i, j, k, i1, i2, n32, ip, ix, ix0, inc;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLASWP performs a series of row interchanges on the matrix A. */
+/* One row interchange is initiated for each of rows K1 through K2 of A. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the matrix of column dimension N to which the row */
+/* interchanges will be applied. */
+/* On exit, the permuted matrix. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* */
+/* K1 (input) INTEGER */
+/* The first element of IPIV for which a row interchange will */
+/* be done. */
+/* */
+/* K2 (input) INTEGER */
+/* The last element of IPIV for which a row interchange will */
+/* be done. */
+/* */
+/* IPIV (input) INTEGER array, dimension (M*abs(INCX)) */
+/* The vector of pivot indices. Only the elements in positions */
+/* K1 through K2 of IPIV are accessed. */
+/* IPIV(K) = L implies rows K and L are to be interchanged. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive values of IPIV. If IPIV */
+/* is negative, the pivots are applied in reverse order. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Modified by */
+/* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
+/* */
+/* ===================================================================== */
+
+/* Interchange row I with row IPIV(I) for each of rows K1 through K2. */
+
+ if (*incx > 0) {
+ i1 = *k1 - 1;
+ ix0 = i1;
+ i2 = *k2 - 1;
+ inc = 1;
+ } else if (*incx < 0) {
+ i1 = *k2 - 1;
+ ix0 = - i1 * *incx;
+ i2 = *k1 - 1;
+ inc = -1;
+ } else {
+ return;
+ }
+
+ n32 = *n / 32 << 5;
+ if (n32 != 0) {
+ for (j = 0; j < n32; j += 32) {
+ ix = ix0;
+ for (i = i1; inc < 0 ? i >= i2 : i <= i2; i += inc) {
+ ip = ipiv[ix] - 1;
+ if (ip != i) {
+ for (k = j; k < j + 32; ++k) {
+ temp = a[i + k * *lda];
+ a[i + k * *lda] = a[ip + k * *lda];
+ a[ip + k * *lda] = temp;
+ }
+ }
+ ix += *incx;
+ }
+ }
+ }
+ if (n32 != *n) {
+ ++n32;
+ ix = ix0;
+ for (i = i1; inc < 0 ? i >= i2 : i <= i2; i += inc) {
+ ip = ipiv[ix] - 1;
+ if (ip != i) {
+ for (k = n32-1; k < *n; ++k) {
+ temp = a[i + k * *lda];
+ a[i + k * *lda] = a[ip + k * *lda];
+ a[ip + k * *lda] = temp;
+ }
+ }
+ ix += *incx;
+ }
+ }
+} /* dlaswp_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.f
new file mode 100644
index 0000000000000000000000000000000000000000..99c0dda27e689735f679834dde87708be258597b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlaswp.f
@@ -0,0 +1,120 @@
+ SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, K1, K2, LDA, N
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * )
+ DOUBLE PRECISION A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLASWP performs a series of row interchanges on the matrix A.
+* One row interchange is initiated for each of rows K1 through K2 of A.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of columns of the matrix A.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the matrix of column dimension N to which the row
+* interchanges will be applied.
+* On exit, the permuted matrix.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A.
+*
+* K1 (input) INTEGER
+* The first element of IPIV for which a row interchange will
+* be done.
+*
+* K2 (input) INTEGER
+* The last element of IPIV for which a row interchange will
+* be done.
+*
+* IPIV (input) INTEGER array, dimension (M*abs(INCX))
+* The vector of pivot indices. Only the elements in positions
+* K1 through K2 of IPIV are accessed.
+* IPIV(K) = L implies rows K and L are to be interchanged.
+*
+* INCX (input) INTEGER
+* The increment between successive values of IPIV. If IPIV
+* is negative, the pivots are applied in reverse order.
+*
+* Further Details
+* ===============
+*
+* Modified by
+* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
+ DOUBLE PRECISION TEMP
+* ..
+* .. Executable Statements ..
+*
+* Interchange row I with row IPIV(I) for each of rows K1 through K2.
+*
+ IF( INCX.GT.0 ) THEN
+ IX0 = K1
+ I1 = K1
+ I2 = K2
+ INC = 1
+ ELSE IF( INCX.LT.0 ) THEN
+ IX0 = 1 + ( 1-K2 )*INCX
+ I1 = K2
+ I2 = K1
+ INC = -1
+ ELSE
+ RETURN
+ END IF
+*
+ N32 = ( N / 32 )*32
+ IF( N32.NE.0 ) THEN
+ DO 30 J = 1, N32, 32
+ IX = IX0
+ DO 20 I = I1, I2, INC
+ IP = IPIV( IX )
+ IF( IP.NE.I ) THEN
+ DO 10 K = J, J + 31
+ TEMP = A( I, K )
+ A( I, K ) = A( IP, K )
+ A( IP, K ) = TEMP
+ 10 CONTINUE
+ END IF
+ IX = IX + INCX
+ 20 CONTINUE
+ 30 CONTINUE
+ END IF
+ IF( N32.NE.N ) THEN
+ N32 = N32 + 1
+ IX = IX0
+ DO 50 I = I1, I2, INC
+ IP = IPIV( IX )
+ IF( IP.NE.I ) THEN
+ DO 40 K = N32, N
+ TEMP = A( I, K )
+ A( I, K ) = A( IP, K )
+ A( IP, K ) = TEMP
+ 40 CONTINUE
+ END IF
+ IX = IX + INCX
+ 50 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of DLASWP
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.c
new file mode 100644
index 0000000000000000000000000000000000000000..52f830a242695cd5d2e01f28a98f61fd9f20e563
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.c
@@ -0,0 +1,229 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static doublereal c_b23 = 1.;
+static doublereal c_b37 = -1.;
+
+/* Subroutine */ void dlatdf_(ijob, n, z, ldz, rhs, rdsum, rdscal, ipiv, jpiv)
+integer *ijob, *n;
+doublereal *z;
+integer *ldz;
+doublereal *rhs, *rdsum, *rdscal;
+integer *ipiv, *jpiv;
+{
+ /* System generated locals */
+ integer nm1;
+
+ /* Local variables */
+ static integer info;
+ static doublereal temp, work[32];
+ static integer i, j, k;
+ static doublereal pmone;
+ static doublereal sminu;
+ static integer iwork[8];
+ static doublereal splus;
+ static doublereal bm, bp;
+ static doublereal xm[8], xp[8];
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLATDF uses the LU factorization of the n-by-n matrix Z computed by */
+/* DGETC2 and computes a contribution to the reciprocal Dif-estimate */
+/* by solving Z * x = b for x, and choosing the r.h.s. b such that */
+/* the norm of x is as large as possible. On entry RHS = b holds the */
+/* contribution from earlier solved sub-systems, and on return RHS = x. */
+/* */
+/* The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q, */
+/* where P and Q are permutation matrices. L is lower triangular with */
+/* unit diagonal elements and U is upper triangular. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* IJOB (input) INTEGER */
+/* IJOB = 2: First compute an approximative null-vector e */
+/* of Z using DGECON, e is normalized and solve for */
+/* Zx = +-e - f with the sign giving the greater value */
+/* of 2-norm(x). About 5 times as expensive as Default. */
+/* IJOB .ne. 2: Local look ahead strategy where all entries of */
+/* the r.h.s. b is choosen as either +1 or -1 (Default). */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Z. */
+/* */
+/* Z (input) DOUBLE PRECISION array, dimension (LDZ, N) */
+/* On entry, the LU part of the factorization of the n-by-n */
+/* matrix Z computed by DGETC2: Z = P * L * U * Q */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDA >= max(1, N). */
+/* */
+/* RHS (input/output) DOUBLE PRECISION array, dimension N. */
+/* On entry, RHS contains contributions from other subsystems. */
+/* On exit, RHS contains the solution of the subsystem with */
+/* entries acoording to the value of IJOB (see above). */
+/* */
+/* RDSUM (input/output) DOUBLE PRECISION */
+/* On entry, the sum of squares of computed contributions to */
+/* the Dif-estimate under computation by DTGSYL, where the */
+/* scaling factor RDSCAL (see below) has been factored out. */
+/* On exit, the corresponding sum of squares updated with the */
+/* contributions from the current sub-system. */
+/* If TRANS = 'T' RDSUM is not touched. */
+/* NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL. */
+/* */
+/* RDSCAL (input/output) DOUBLE PRECISION */
+/* On entry, scaling factor used to prevent overflow in RDSUM. */
+/* On exit, RDSCAL is updated w.r.t. the current contributions */
+/* in RDSUM. */
+/* If TRANS = 'T', RDSCAL is not touched. */
+/* NOTE: RDSCAL only makes sense when DTGSY2 is called by */
+/* DTGSYL. */
+/* */
+/* IPIV (input) INTEGER array, dimension (N). */
+/* The pivot indices; for 1 <= i <= N, row i of the */
+/* matrix has been interchanged with row IPIV(i). */
+/* */
+/* JPIV (input) INTEGER array, dimension (N). */
+/* The pivot indices; for 1 <= j <= N, column j of the */
+/* matrix has been interchanged with column JPIV(j). */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+/* */
+/* This routine is a further developed implementation of algorithm */
+/* BSOLVE in [1] using complete pivoting in the LU factorization. */
+/* */
+/* [1] Bo Kagstrom and Lars Westin, */
+/* Generalized Schur Methods with Condition Estimators for */
+/* Solving the Generalized Sylvester Equation, IEEE Transactions */
+/* on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751. */
+/* */
+/* [2] Peter Poromaa, */
+/* On Efficient and Robust Estimators for the Separation */
+/* between two Regular Matrix Pairs with Applications in */
+/* Condition Estimation. Report IMINF-95.05, Departement of */
+/* Computing Science, Umea University, S-901 87 Umea, Sweden, 1995. */
+/* */
+/* ===================================================================== */
+
+ if (*ijob != 2) {
+
+/* Apply permutations IPIV to RHS */
+
+ nm1 = *n - 1;
+ dlaswp_(&c__1, rhs, ldz, &c__1, &nm1, ipiv, &c__1);
+
+/* Solve for L-part choosing RHS either to +1 or -1. */
+
+ pmone = -1.;
+
+ for (j = 0; j < *n-1; ++j) {
+ bp = rhs[j] + 1.;
+ bm = rhs[j] - 1.;
+ splus = 1.;
+
+/* Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and */
+/* SMIN computed more efficiently than in BSOLVE [1]. */
+
+ nm1 = *n - j - 1;
+ splus += ddot_(&nm1, &z[j+1 + j * *ldz], &c__1, &z[j+1 + j * *ldz], &c__1);
+ sminu = ddot_(&nm1, &z[j+1 + j * *ldz], &c__1, &rhs[j+1], &c__1);
+ splus *= rhs[j];
+ if (splus > sminu) {
+ rhs[j] = bp;
+ } else if (sminu > splus) {
+ rhs[j] = bm;
+ } else {
+
+/* In this case the updating sums are equal and we can */
+/* choose RHS(J) +1 or -1. The first time this happens */
+/* we choose -1, thereafter +1. This is a simple way to */
+/* get good estimates of matrices like Byers well-known */
+/* example (see [1]). (Not done in BSOLVE.) */
+
+ rhs[j] += pmone;
+ pmone = 1.;
+ }
+
+/* Compute the remaining r.h.s. */
+
+ temp = -rhs[j];
+ daxpy_(&nm1, &temp, &z[j+1 + j * *ldz], &c__1, &rhs[j+1], &c__1);
+ }
+
+/* Solve for U-part, look-ahead for RHS(N) = +-1. This is not done */
+/* in BSOLVE and will hopefully give us a better estimate because */
+/* any ill-conditioning of the original matrix is transfered to U */
+/* and not to L. U(N, N) is an approximation to sigma_min(LU). */
+
+ nm1 = *n - 1;
+ dcopy_(&nm1, rhs, &c__1, xp, &c__1);
+ xp[nm1] = rhs[nm1] + 1.;
+ rhs[nm1] += -1.;
+ splus = 0.;
+ sminu = 0.;
+ for (i = *n-1; i >= 0; --i) {
+ temp = 1. / z[i + i * *ldz];
+ xp[i] *= temp;
+ rhs[i] *= temp;
+ for (k = i+1; k < *n; ++k) {
+ xp[i] -= xp[k] * (z[i + k * *ldz] * temp);
+ rhs[i] -= rhs[k] * (z[i + k * *ldz] * temp);
+ }
+ splus += abs(xp[i]);
+ sminu += abs(rhs[i]);
+ }
+ if (splus > sminu) {
+ dcopy_(n, xp, &c__1, rhs, &c__1);
+ }
+
+/* Apply the permutations JPIV to the computed solution (RHS) */
+
+ dlaswp_(&c__1, rhs, ldz, &c__1, &nm1, jpiv, &c_n1);
+
+/* Compute the sum of squares */
+
+ dlassq_(n, rhs, &c__1, rdscal, rdsum);
+
+ } else {
+
+/* IJOB = 2, Compute approximate nullvector XM of Z */
+
+ dgecon_("I", n, z, ldz, &c_b23, &temp, work, iwork, &info);
+ dcopy_(n, &work[*n], &c__1, xm, &c__1);
+
+/* Compute RHS */
+
+ nm1 = *n - 1;
+ dlaswp_(&c__1, xm, ldz, &c__1, &nm1, ipiv, &c_n1);
+ temp = 1. / sqrt(ddot_(n, xm, &c__1, xm, &c__1));
+ dscal_(n, &temp, xm, &c__1);
+ dcopy_(n, xm, &c__1, xp, &c__1);
+ daxpy_(n, &c_b23, rhs, &c__1, xp, &c__1);
+ daxpy_(n, &c_b37, xm, &c__1, rhs, &c__1);
+ dgesc2_(n, z, ldz, rhs, ipiv, jpiv, &temp);
+ dgesc2_(n, z, ldz, xp, ipiv, jpiv, &temp);
+ if (dasum_(n, xp, &c__1) > dasum_(n, rhs, &c__1)) {
+ dcopy_(n, xp, &c__1, rhs, &c__1);
+ }
+
+/* Compute the sum of squares */
+
+ dlassq_(n, rhs, &c__1, rdscal, rdsum);
+ }
+} /* dlatdf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.f
new file mode 100644
index 0000000000000000000000000000000000000000..728fd3a4bc28d5789a664110039c40f22c0d15df
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatdf.f
@@ -0,0 +1,238 @@
+ SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
+ $ JPIV )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER IJOB, LDZ, N
+ DOUBLE PRECISION RDSCAL, RDSUM
+* ..
+* .. Array Arguments ..
+ INTEGER IPIV( * ), JPIV( * )
+ DOUBLE PRECISION RHS( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLATDF uses the LU factorization of the n-by-n matrix Z computed by
+* DGETC2 and computes a contribution to the reciprocal Dif-estimate
+* by solving Z * x = b for x, and choosing the r.h.s. b such that
+* the norm of x is as large as possible. On entry RHS = b holds the
+* contribution from earlier solved sub-systems, and on return RHS = x.
+*
+* The factorization of Z returned by DGETC2 has the form Z = P*L*U*Q,
+* where P and Q are permutation matrices. L is lower triangular with
+* unit diagonal elements and U is upper triangular.
+*
+* Arguments
+* =========
+*
+* IJOB (input) INTEGER
+* IJOB = 2: First compute an approximative null-vector e
+* of Z using DGECON, e is normalized and solve for
+* Zx = +-e - f with the sign giving the greater value
+* of 2-norm(x). About 5 times as expensive as Default.
+* IJOB .ne. 2: Local look ahead strategy where all entries of
+* the r.h.s. b is choosen as either +1 or -1 (Default).
+*
+* N (input) INTEGER
+* The number of columns of the matrix Z.
+*
+* Z (input) DOUBLE PRECISION array, dimension (LDZ, N)
+* On entry, the LU part of the factorization of the n-by-n
+* matrix Z computed by DGETC2: Z = P * L * U * Q
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDA >= max(1, N).
+*
+* RHS (input/output) DOUBLE PRECISION array, dimension N.
+* On entry, RHS contains contributions from other subsystems.
+* On exit, RHS contains the solution of the subsystem with
+* entries acoording to the value of IJOB (see above).
+*
+* RDSUM (input/output) DOUBLE PRECISION
+* On entry, the sum of squares of computed contributions to
+* the Dif-estimate under computation by DTGSYL, where the
+* scaling factor RDSCAL (see below) has been factored out.
+* On exit, the corresponding sum of squares updated with the
+* contributions from the current sub-system.
+* If TRANS = 'T' RDSUM is not touched.
+* NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
+*
+* RDSCAL (input/output) DOUBLE PRECISION
+* On entry, scaling factor used to prevent overflow in RDSUM.
+* On exit, RDSCAL is updated w.r.t. the current contributions
+* in RDSUM.
+* If TRANS = 'T', RDSCAL is not touched.
+* NOTE: RDSCAL only makes sense when DTGSY2 is called by
+* DTGSYL.
+*
+* IPIV (input) INTEGER array, dimension (N).
+* The pivot indices; for 1 <= i <= N, row i of the
+* matrix has been interchanged with row IPIV(i).
+*
+* JPIV (input) INTEGER array, dimension (N).
+* The pivot indices; for 1 <= j <= N, column j of the
+* matrix has been interchanged with column JPIV(j).
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* This routine is a further developed implementation of algorithm
+* BSOLVE in [1] using complete pivoting in the LU factorization.
+*
+* [1] Bo Kagstrom and Lars Westin,
+* Generalized Schur Methods with Condition Estimators for
+* Solving the Generalized Sylvester Equation, IEEE Transactions
+* on Automatic Control, Vol. 34, No. 7, July 1989, pp 745-751.
+*
+* [2] Peter Poromaa,
+* On Efficient and Robust Estimators for the Separation
+* between two Regular Matrix Pairs with Applications in
+* Condition Estimation. Report IMINF-95.05, Departement of
+* Computing Science, Umea University, S-901 87 Umea, Sweden, 1995.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER MAXDIM
+ PARAMETER ( MAXDIM = 8 )
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, INFO, J, K
+ DOUBLE PRECISION BM, BP, PMONE, SMINU, SPLUS, TEMP
+* ..
+* .. Local Arrays ..
+ INTEGER IWORK( MAXDIM )
+ DOUBLE PRECISION WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
+* ..
+* .. External Subroutines ..
+ EXTERNAL DAXPY, DCOPY, DGECON, DGESC2, DLASSQ, DLASWP,
+ $ DSCAL
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DASUM, DDOT
+ EXTERNAL DASUM, DDOT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( IJOB.NE.2 ) THEN
+*
+* Apply permutations IPIV to RHS
+*
+ CALL DLASWP( 1, RHS, LDZ, 1, N-1, IPIV, 1 )
+*
+* Solve for L-part choosing RHS either to +1 or -1.
+*
+ PMONE = -ONE
+*
+ DO 10 J = 1, N - 1
+ BP = RHS( J ) + ONE
+ BM = RHS( J ) - ONE
+ SPLUS = ONE
+*
+* Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and
+* SMIN computed more efficiently than in BSOLVE [1].
+*
+ SPLUS = SPLUS + DDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 )
+ SMINU = DDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 )
+ SPLUS = SPLUS*RHS( J )
+ IF( SPLUS.GT.SMINU ) THEN
+ RHS( J ) = BP
+ ELSE IF( SMINU.GT.SPLUS ) THEN
+ RHS( J ) = BM
+ ELSE
+*
+* In this case the updating sums are equal and we can
+* choose RHS(J) +1 or -1. The first time this happens
+* we choose -1, thereafter +1. This is a simple way to
+* get good estimates of matrices like Byers well-known
+* example (see [1]). (Not done in BSOLVE.)
+*
+ RHS( J ) = RHS( J ) + PMONE
+ PMONE = ONE
+ END IF
+*
+* Compute the remaining r.h.s.
+*
+ TEMP = -RHS( J )
+ CALL DAXPY( N-J, TEMP, Z( J+1, J ), 1, RHS( J+1 ), 1 )
+*
+ 10 CONTINUE
+*
+* Solve for U-part, look-ahead for RHS(N) = +-1. This is not done
+* in BSOLVE and will hopefully give us a better estimate because
+* any ill-conditioning of the original matrix is transfered to U
+* and not to L. U(N, N) is an approximation to sigma_min(LU).
+*
+ CALL DCOPY( N-1, RHS, 1, XP, 1 )
+ XP( N ) = RHS( N ) + ONE
+ RHS( N ) = RHS( N ) - ONE
+ SPLUS = ZERO
+ SMINU = ZERO
+ DO 30 I = N, 1, -1
+ TEMP = ONE / Z( I, I )
+ XP( I ) = XP( I )*TEMP
+ RHS( I ) = RHS( I )*TEMP
+ DO 20 K = I + 1, N
+ XP( I ) = XP( I ) - XP( K )*( Z( I, K )*TEMP )
+ RHS( I ) = RHS( I ) - RHS( K )*( Z( I, K )*TEMP )
+ 20 CONTINUE
+ SPLUS = SPLUS + ABS( XP( I ) )
+ SMINU = SMINU + ABS( RHS( I ) )
+ 30 CONTINUE
+ IF( SPLUS.GT.SMINU )
+ $ CALL DCOPY( N, XP, 1, RHS, 1 )
+*
+* Apply the permutations JPIV to the computed solution (RHS)
+*
+ CALL DLASWP( 1, RHS, LDZ, 1, N-1, JPIV, -1 )
+*
+* Compute the sum of squares
+*
+ CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
+*
+ ELSE
+*
+* IJOB = 2, Compute approximate nullvector XM of Z
+*
+ CALL DGECON( 'I', N, Z, LDZ, ONE, TEMP, WORK, IWORK, INFO )
+ CALL DCOPY( N, WORK( N+1 ), 1, XM, 1 )
+*
+* Compute RHS
+*
+ CALL DLASWP( 1, XM, LDZ, 1, N-1, IPIV, -1 )
+ TEMP = ONE / SQRT( DDOT( N, XM, 1, XM, 1 ) )
+ CALL DSCAL( N, TEMP, XM, 1 )
+ CALL DCOPY( N, XM, 1, XP, 1 )
+ CALL DAXPY( N, ONE, RHS, 1, XP, 1 )
+ CALL DAXPY( N, -ONE, XM, 1, RHS, 1 )
+ CALL DGESC2( N, Z, LDZ, RHS, IPIV, JPIV, TEMP )
+ CALL DGESC2( N, Z, LDZ, XP, IPIV, JPIV, TEMP )
+ IF( DASUM( N, XP, 1 ).GT.DASUM( N, RHS, 1 ) )
+ $ CALL DCOPY( N, XP, 1, RHS, 1 )
+*
+* Compute the sum of squares
+*
+ CALL DLASSQ( N, RHS, 1, RDSCAL, RDSUM )
+*
+ END IF
+*
+ RETURN
+*
+* End of DLATDF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.c
new file mode 100644
index 0000000000000000000000000000000000000000..166ab505183fb7178a8e92b19a0d1346ea141904
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.c
@@ -0,0 +1,656 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b36 = .5;
+
+/* Subroutine */ void dlatrs_(uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info)
+const char *uplo, *trans, *diag, *normin;
+const integer *n;
+const doublereal *a;
+const integer *lda;
+doublereal *x, *scale, *cnorm;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer jinc;
+ static doublereal xbnd;
+ static integer imax;
+ static doublereal tmax, tjjs, xmax, grow, sumj;
+ static integer i, j;
+ static doublereal tscal, uscal;
+ static integer jlast;
+ static logical upper;
+ static doublereal xj;
+ static doublereal bignum;
+ static logical notran;
+ static integer jfirst;
+ static doublereal smlnum;
+ static logical nounit;
+ static doublereal rec, tjj;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DLATRS solves one of the triangular systems */
+/* */
+/* A *x = s*b or A'*x = s*b */
+/* */
+/* with scaling to prevent overflow. Here A is an upper or lower */
+/* triangular matrix, A' denotes the transpose of A, x and b are */
+/* n-element vectors, and s is a scaling factor, usually less than */
+/* or equal to 1, chosen so that the components of x will be less than */
+/* the overflow threshold. If the unscaled problem will not cause */
+/* overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A */
+/* is singular (A(j,j) = 0 for some j), then s is set to 0 and a */
+/* non-trivial solution to A*x = 0 is returned. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the matrix A is upper or lower triangular. */
+/* = 'U': Upper triangular */
+/* = 'L': Lower triangular */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* Specifies the operation applied to A. */
+/* = 'N': Solve A * x = s*b (No transpose) */
+/* = 'T': Solve A'* x = s*b (Transpose) */
+/* = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose) */
+/* */
+/* DIAG (input) CHARACTER*1 */
+/* Specifies whether or not the matrix A is unit triangular. */
+/* = 'N': Non-unit triangular */
+/* = 'U': Unit triangular */
+/* */
+/* NORMIN (input) CHARACTER*1 */
+/* Specifies whether CNORM has been set or not. */
+/* = 'Y': CNORM contains the column norms on entry */
+/* = 'N': CNORM is not set on entry. On exit, the norms will */
+/* be computed and stored in CNORM. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The triangular matrix A. If UPLO = 'U', the leading n by n */
+/* upper triangular part of the array A contains the upper */
+/* triangular matrix, and the strictly lower triangular part of */
+/* A is not referenced. If UPLO = 'L', the leading n by n lower */
+/* triangular part of the array A contains the lower triangular */
+/* matrix, and the strictly upper triangular part of A is not */
+/* referenced. If DIAG = 'U', the diagonal elements of A are */
+/* also not referenced and are assumed to be 1. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max (1,N). */
+/* */
+/* X (input/output) DOUBLE PRECISION array, dimension (N) */
+/* On entry, the right hand side b of the triangular system. */
+/* On exit, X is overwritten by the solution vector x. */
+/* */
+/* SCALE (output) DOUBLE PRECISION */
+/* The scaling factor s for the triangular system */
+/* A * x = s*b or A'* x = s*b. */
+/* If SCALE = 0, the matrix A is singular or badly scaled, and */
+/* the vector x is an exact or approximate solution to A*x = 0. */
+/* */
+/* CNORM (input or output) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) */
+/* contains the norm of the off-diagonal part of the j-th column */
+/* of A. If TRANS = 'N', CNORM(j) must be greater than or equal */
+/* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) */
+/* must be greater than or equal to the 1-norm. */
+/* */
+/* If NORMIN = 'N', CNORM is an output argument and CNORM(j) */
+/* returns the 1-norm of the offdiagonal part of the j-th column */
+/* of A. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -k, the k-th argument had an illegal value */
+/* */
+/* Further Details */
+/* ======= ======= */
+/* */
+/* A rough bound on x is computed; if that is less than overflow, DTRSV */
+/* is called, otherwise, specific code is used which checks for possible */
+/* overflow or divide-by-zero at every operation. */
+/* */
+/* A columnwise scheme is used for solving A*x = b. The basic algorithm */
+/* if A is lower triangular is */
+/* */
+/* x[1:n] := b[1:n] */
+/* for j = 1, ..., n */
+/* x(j) := x(j) / A(j,j) */
+/* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] */
+/* end */
+/* */
+/* Define bounds on the components of x after j iterations of the loop: */
+/* M(j) = bound on x[1:j] */
+/* G(j) = bound on x[j+1:n] */
+/* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. */
+/* */
+/* Then for iteration j+1 we have */
+/* M(j+1) <= G(j) / | A(j+1,j+1) | */
+/* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | */
+/* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) */
+/* */
+/* where CNORM(j+1) is greater than or equal to the infinity-norm of */
+/* column j+1 of A, not counting the diagonal. Hence */
+/* */
+/* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) */
+/* 1<=i<=j */
+/* and */
+/* */
+/* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) */
+/* 1<=i< j */
+/* */
+/* Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the */
+/* reciprocal of the largest M(j), j=1,..,n, is larger than */
+/* max(underflow, 1/overflow). */
+/* */
+/* The bound on x(j) is also used to determine when a step in the */
+/* columnwise method can be performed without fear of overflow. If */
+/* the computed bound is greater than a large constant, x is scaled to */
+/* prevent overflow, but if the bound overflows, x is set to 0, x(j) to */
+/* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. */
+/* */
+/* Similarly, a row-wise scheme is used to solve A'*x = b. The basic */
+/* algorithm for A upper triangular is */
+/* */
+/* for j = 1, ..., n */
+/* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) */
+/* end */
+/* */
+/* We simultaneously compute two bounds */
+/* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j */
+/* M(j) = bound on x(i), 1<=i<=j */
+/* */
+/* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we */
+/* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. */
+/* Then the bound on x(j) is */
+/* */
+/* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | */
+/* */
+/* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) */
+/* 1<=i<=j */
+/* */
+/* and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater */
+/* than max(underflow, 1/overflow). */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ notran = lsame_(trans, "N");
+ nounit = lsame_(diag, "N");
+
+ /* Test the input parameters. */
+
+ if (!upper && !lsame_(uplo, "L")) *info = 1;
+ else if (!notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = 2;
+ else if (!nounit && !lsame_(diag, "U")) *info = 3;
+ else if ( !lsame_(normin, "Y") && !lsame_(normin, "N")) *info = 4;
+ else if (*n < 0) *info = 5;
+ else if (*lda < max(1,*n)) *info = 7;
+ if (*info != 0) {
+ xerbla_("DLATRS", info);
+ *info = -(*info);
+ return;
+ }
+
+ /* Quick return if possible */
+
+ if (*n == 0)
+ return;
+
+ /* Determine machine dependent parameters to control overflow. */
+
+ smlnum = dlamch_("Safe minimum") / dlamch_("Precision");
+ bignum = 1. / smlnum;
+ *scale = 1.;
+
+ if (lsame_(normin, "N"))
+ {
+ /* Compute the 1-norm of each column, not including the diagonal. */
+
+ if (upper) /* A is upper triangular. */
+ {
+ for (j = 0; j < *n; ++j)
+ cnorm[j] = dasum_(&j, &a[j * *lda], &c__1);
+ }
+ else /* A is lower triangular. */
+ {
+ for (j = 0; j < *n - 1; ++j) {
+ i__1 = *n - j - 1;
+ cnorm[j] = dasum_(&i__1, &a[j + 1 + j * *lda], &c__1);
+ }
+ cnorm[*n-1] = 0.;
+ }
+ }
+
+ /* Scale the column norms by TSCAL if the maximum element in CNORM is greater than BIGNUM. */
+
+ imax = idamax_(n, cnorm, &c__1);
+ tmax = cnorm[imax-1];
+ if (tmax <= bignum)
+ tscal = 1.;
+ else {
+ tscal = 1. / (smlnum * tmax);
+ dscal_(n, &tscal, cnorm, &c__1);
+ }
+
+ /* Compute a bound on the computed solution vector to see if the */
+ /* Level 2 BLAS routine DTRSV can be used. */
+
+ j = idamax_(n, x, &c__1) - 1;
+ xmax = abs(x[j]);
+ xbnd = xmax;
+ if (notran)
+ {
+ /* Compute the growth in A * x = b. */
+
+ if (upper) {
+ jfirst = *n;
+ jlast = 1;
+ jinc = -1;
+ }
+ else {
+ jfirst = 1;
+ jlast = *n;
+ jinc = 1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L50;
+ }
+
+ if (nounit)
+ {
+ /* A is non-unit triangular. */
+
+ /* Compute GROW = 1/G(j) and XBND = 1/M(j). */
+ /* Initially, G(0) = max{x(i), i=1,...,n}. */
+
+ grow = 1. / max(xbnd,smlnum);
+ xbnd = grow;
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Exit the loop if the growth factor is too small. */
+ if (grow <= smlnum)
+ goto L50;
+
+ /* M(j) = G(j-1) / abs(A(j,j)) */
+ tjj = abs(a[j + j * *lda]);
+ xbnd = min(xbnd, min(1.,tjj) * grow);
+ if (tjj + cnorm[j] >= smlnum)
+ {
+ /* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) */
+ grow *= tjj / (tjj + cnorm[j]);
+ }
+ else
+ {
+ /* G(j) could overflow, set GROW to 0. */
+ grow = 0.;
+ }
+ }
+ grow = xbnd;
+ }
+ else
+ {
+ /* A is unit triangular. */
+
+ /* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. */
+
+ grow = min(1., 1./max(xbnd,smlnum));
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Exit the loop if the growth factor is too small. */
+ if (grow <= smlnum)
+ goto L50;
+
+ /* G(j) = G(j-1)*( 1 + CNORM(j) ) */
+ grow *= 1. / (cnorm[j] + 1.);
+ }
+ }
+ }
+ else
+ {
+ /* Compute the growth in A' * x = b. */
+
+ if (upper) {
+ jfirst = 1;
+ jlast = *n;
+ jinc = 1;
+ }
+ else {
+ jfirst = *n;
+ jlast = 1;
+ jinc = -1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L50;
+ }
+
+ if (nounit)
+ {
+ /* A is non-unit triangular. */
+
+ /* Compute GROW = 1/G(j) and XBND = 1/M(j). */
+ /* Initially, M(0) = max{x(i), i=1,...,n}. */
+
+ grow = 1. / max(xbnd,smlnum);
+ xbnd = grow;
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Exit the loop if the growth factor is too small. */
+ if (grow <= smlnum)
+ goto L50;
+
+ /* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) */
+ xj = cnorm[j] + 1.;
+ grow = min(grow, xbnd / xj);
+
+ /* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) */
+ tjj = abs(a[j + j * *lda]);
+ if (xj > tjj)
+ xbnd *= tjj / xj;
+ }
+ grow = min(grow,xbnd);
+ }
+ else
+ {
+ /* A is unit triangular. */
+
+ /* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. */
+
+ grow = min(1., 1./max(xbnd,smlnum));
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Exit the loop if the growth factor is too small. */
+ if (grow <= smlnum)
+ goto L50;
+
+ /* G(j) = ( 1 + CNORM(j) )*G(j-1) */
+ xj = cnorm[j] + 1.;
+ grow /= xj;
+ }
+ }
+ }
+L50:
+ if (grow * tscal > smlnum)
+ {
+ /* Use the Level 2 BLAS solve if the reciprocal of the bound on */
+ /* elements of X is not too small. */
+
+ dtrsv_(uplo, trans, diag, n, a, lda, x, &c__1);
+ }
+ else
+ {
+ /* Use a Level 1 BLAS solve, scaling intermediate results. */
+
+ if (xmax > bignum)
+ {
+ /* Scale X so that its components are less than or equal to BIGNUM in absolute value. */
+ *scale = bignum / xmax;
+ dscal_(n, scale, x, &c__1);
+ xmax = bignum;
+ }
+
+ if (notran)
+ {
+ /* Solve A * x = b */
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Compute x(j) = b(j) / A(j,j), scaling x if necessary. */
+ xj = abs(x[j]);
+ if (nounit)
+ tjjs = a[j + j * *lda] * tscal;
+ else {
+ tjjs = tscal;
+ if (tscal == 1.)
+ goto L100;
+ }
+ tjj = abs(tjjs);
+ if (tjj > smlnum)
+ {
+ /* abs(A(j,j)) > SMLNUM: */
+ if (tjj < 1.) {
+ if (xj > tjj * bignum)
+ {
+ /* Scale x by 1/b(j). */
+ rec = 1. / xj;
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ x[j] /= tjjs;
+ xj = abs(x[j]);
+ }
+ else if (tjj > 0.)
+ {
+ /* 0 < abs(A(j,j)) <= SMLNUM: */
+ if (xj > tjj * bignum)
+ {
+ /* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM */
+ /* to avoid overflow when dividing by A(j,j). */
+
+ rec = tjj * bignum / xj;
+ if (cnorm[j] > 1.)
+ {
+ /* Scale by 1/CNORM(j) to avoid overflow when */
+ /* multiplying x(j) times column j. */
+ rec /= cnorm[j];
+ }
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ x[j] /= tjjs;
+ xj = abs(x[j]);
+ }
+ else
+ {
+ /* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
+ /* scale = 0, and compute a solution to A*x = 0. */
+ for (i = 0; i < *n; ++i)
+ x[i] = 0.;
+ x[j] = 1.;
+ xj = 1.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L100:
+
+ /* Scale x if necessary to avoid overflow when adding a */
+ /* multiple of column j of A. */
+
+ if (xj > 1.) {
+ rec = 1. / xj;
+ if (cnorm[j] > (bignum - xmax) * rec)
+ {
+ /* Scale x by 1/(2*abs(x(j))). */
+ rec *= .5;
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ }
+ }
+ else if (xj * cnorm[j] > bignum - xmax)
+ {
+ /* Scale x by 1/2. */
+ dscal_(n, &c_b36, x, &c__1);
+ *scale *= .5;
+ }
+
+ if (upper) {
+ if (j > 0)
+ {
+ /* Compute the update */
+ /* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) */
+ d__1 = -x[j] * tscal;
+ daxpy_(&j, &d__1, &a[j * *lda], &c__1, x, &c__1);
+ i = idamax_(&j, x, &c__1) - 1;
+ xmax = abs(x[i]);
+ }
+ }
+ else {
+ if (j+1 < *n)
+ {
+ /* Compute the update */
+ /* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) */
+ i__1 = *n - j - 1;
+ d__1 = -x[j] * tscal;
+ daxpy_(&i__1, &d__1, &a[j + 1 + j * *lda], &c__1, &x[j+1], &c__1);
+ i = j + idamax_(&i__1, &x[j+1], &c__1);
+ xmax = abs(x[i]);
+ }
+ }
+ }
+ }
+ else
+ {
+ /* Solve A' * x = b */
+ for (j = jfirst-1; jinc < 0 ? j > jlast-2 : j < jlast; j += jinc)
+ {
+ /* Compute x(j) = b(j) - sum A(k,j)*x(k). */
+ /* k!=j */
+
+ xj = abs(x[j]);
+ uscal = tscal;
+ rec = 1. / max(xmax,1.);
+ if (cnorm[j] > (bignum - xj) * rec)
+ {
+ /* If x(j) could overflow, scale x by 1/(2*XMAX). */
+ rec *= .5;
+ if (nounit)
+ tjjs = a[j + j * *lda] * tscal;
+ else
+ tjjs = tscal;
+ tjj = abs(tjjs);
+ if (tjj > 1.)
+ {
+ /* Divide by A(j,j) when scaling x if A(j,j) > 1. */
+ rec = min(1., rec * tjj);
+ uscal /= tjjs;
+ }
+ if (rec < 1.) {
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+
+ sumj = 0.;
+ if (uscal == 1.)
+ {
+ /* If the scaling needed for A in the dot product is 1, */
+ /* call DDOT to perform the dot product. */
+ if (upper)
+ sumj = ddot_(&j, &a[j * *lda], &c__1, x, &c__1);
+ else if (j < *n) {
+ i__1 = *n - j - 1;
+ sumj = ddot_(&i__1, &a[j + 1 + j * *lda], &c__1, &x[j+1], &c__1);
+ }
+ }
+ else
+ {
+ /* Otherwise, use in-line code for the dot product. */
+ if (upper)
+ for (i = 0; i < j; ++i)
+ sumj += a[i + j * *lda] * uscal * x[i];
+ else if (j+1 < *n)
+ for (i = j + 1; i < *n; ++i)
+ sumj += a[i + j * *lda] * uscal * x[i];
+ }
+
+ if (uscal == tscal)
+ {
+ /* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j) */
+ /* was not used to scale the dotproduct. */
+ x[j] -= sumj;
+ xj = abs(x[j]);
+ if (nounit)
+ tjjs = a[j + j * *lda] * tscal;
+ else {
+ tjjs = tscal;
+ if (tscal == 1.)
+ goto L150;
+ }
+
+ /* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
+ tjj = abs(tjjs);
+ if (tjj > smlnum)
+ {
+ /* abs(A(j,j)) > SMLNUM: */
+ if (tjj < 1. && xj > tjj * bignum)
+ {
+ /* Scale X by 1/abs(x(j)). */
+ rec = 1. / xj;
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ x[j] /= tjjs;
+ }
+ else if (tjj > 0.)
+ {
+ /* 0 < abs(A(j,j)) <= SMLNUM: */
+ if (xj > tjj * bignum)
+ {
+ /* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
+ rec = tjj * bignum / xj;
+ dscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ x[j] /= tjjs;
+ }
+ else
+ {
+ /* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
+ /* scale = 0, and compute a solution to A'*x = 0. */
+ for (i = 0; i < *n; ++i)
+ x[i] = 0.;
+ x[j] = 1.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+ }
+ else
+ {
+ /* Compute x(j) := x(j) / A(j,j) - sumj if the dot */
+ /* product has already been divided by 1/A(j,j). */
+ x[j] = x[j] / tjjs - sumj;
+ }
+L150:
+ xmax = max(xmax, abs(x[j]));
+ }
+ }
+ *scale /= tscal;
+ }
+
+ /* Scale the column norms by 1/TSCAL for return. */
+ if (tscal != 1.) {
+ d__1 = 1. / tscal;
+ dscal_(n, &d__1, cnorm, &c__1);
+ }
+} /* dlatrs_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.f
new file mode 100644
index 0000000000000000000000000000000000000000..591c966d203aacd584ec4b9da4178aa0632c1d8e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dlatrs.f
@@ -0,0 +1,702 @@
+ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
+ $ CNORM, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER DIAG, NORMIN, TRANS, UPLO
+ INTEGER INFO, LDA, N
+ DOUBLE PRECISION SCALE
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), CNORM( * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DLATRS solves one of the triangular systems
+*
+* A *x = s*b or A'*x = s*b
+*
+* with scaling to prevent overflow. Here A is an upper or lower
+* triangular matrix, A' denotes the transpose of A, x and b are
+* n-element vectors, and s is a scaling factor, usually less than
+* or equal to 1, chosen so that the components of x will be less than
+* the overflow threshold. If the unscaled problem will not cause
+* overflow, the Level 2 BLAS routine DTRSV is called. If the matrix A
+* is singular (A(j,j) = 0 for some j), then s is set to 0 and a
+* non-trivial solution to A*x = 0 is returned.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies whether the matrix A is upper or lower triangular.
+* = 'U': Upper triangular
+* = 'L': Lower triangular
+*
+* TRANS (input) CHARACTER*1
+* Specifies the operation applied to A.
+* = 'N': Solve A * x = s*b (No transpose)
+* = 'T': Solve A'* x = s*b (Transpose)
+* = 'C': Solve A'* x = s*b (Conjugate transpose = Transpose)
+*
+* DIAG (input) CHARACTER*1
+* Specifies whether or not the matrix A is unit triangular.
+* = 'N': Non-unit triangular
+* = 'U': Unit triangular
+*
+* NORMIN (input) CHARACTER*1
+* Specifies whether CNORM has been set or not.
+* = 'Y': CNORM contains the column norms on entry
+* = 'N': CNORM is not set on entry. On exit, the norms will
+* be computed and stored in CNORM.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,N)
+* The triangular matrix A. If UPLO = 'U', the leading n by n
+* upper triangular part of the array A contains the upper
+* triangular matrix, and the strictly lower triangular part of
+* A is not referenced. If UPLO = 'L', the leading n by n lower
+* triangular part of the array A contains the lower triangular
+* matrix, and the strictly upper triangular part of A is not
+* referenced. If DIAG = 'U', the diagonal elements of A are
+* also not referenced and are assumed to be 1.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max (1,N).
+*
+* X (input/output) DOUBLE PRECISION array, dimension (N)
+* On entry, the right hand side b of the triangular system.
+* On exit, X is overwritten by the solution vector x.
+*
+* SCALE (output) DOUBLE PRECISION
+* The scaling factor s for the triangular system
+* A * x = s*b or A'* x = s*b.
+* If SCALE = 0, the matrix A is singular or badly scaled, and
+* the vector x is an exact or approximate solution to A*x = 0.
+*
+* CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+*
+* If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+* contains the norm of the off-diagonal part of the j-th column
+* of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+* must be greater than or equal to the 1-norm.
+*
+* If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+* returns the 1-norm of the offdiagonal part of the j-th column
+* of A.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -k, the k-th argument had an illegal value
+*
+* Further Details
+* ======= =======
+*
+* A rough bound on x is computed; if that is less than overflow, DTRSV
+* is called, otherwise, specific code is used which checks for possible
+* overflow or divide-by-zero at every operation.
+*
+* A columnwise scheme is used for solving A*x = b. The basic algorithm
+* if A is lower triangular is
+*
+* x[1:n] := b[1:n]
+* for j = 1, ..., n
+* x(j) := x(j) / A(j,j)
+* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+* end
+*
+* Define bounds on the components of x after j iterations of the loop:
+* M(j) = bound on x[1:j]
+* G(j) = bound on x[j+1:n]
+* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+*
+* Then for iteration j+1 we have
+* M(j+1) <= G(j) / | A(j+1,j+1) |
+* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+*
+* where CNORM(j+1) is greater than or equal to the infinity-norm of
+* column j+1 of A, not counting the diagonal. Hence
+*
+* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+* 1<=i<=j
+* and
+*
+* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+* 1<=i< j
+*
+* Since |x(j)| <= M(j), we use the Level 2 BLAS routine DTRSV if the
+* reciprocal of the largest M(j), j=1,..,n, is larger than
+* max(underflow, 1/overflow).
+*
+* The bound on x(j) is also used to determine when a step in the
+* columnwise method can be performed without fear of overflow. If
+* the computed bound is greater than a large constant, x is scaled to
+* prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+*
+* Similarly, a row-wise scheme is used to solve A'*x = b. The basic
+* algorithm for A upper triangular is
+*
+* for j = 1, ..., n
+* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+* end
+*
+* We simultaneously compute two bounds
+* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+* M(j) = bound on x(i), 1<=i<=j
+*
+* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+* Then the bound on x(j) is
+*
+* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+*
+* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+* 1<=i<=j
+*
+* and we can safely call DTRSV if 1/M(n) and 1/G(n) are both greater
+* than max(underflow, 1/overflow).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, HALF, ONE
+ PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL NOTRAN, NOUNIT, UPPER
+ INTEGER I, IMAX, J, JFIRST, JINC, JLAST
+ DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, SUMJ, TJJ, TJJS,
+ $ TMAX, TSCAL, USCAL, XBND, XJ, XMAX
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IDAMAX
+ DOUBLE PRECISION DASUM, DDOT, DLAMCH
+ EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ NOTRAN = LSAME( TRANS, 'N' )
+ NOUNIT = LSAME( DIAG, 'N' )
+*
+* Test the input parameters.
+*
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
+ $ LSAME( TRANS, 'C' ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
+ INFO = -3
+ ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
+ $ LSAME( NORMIN, 'N' ) ) THEN
+ INFO = -4
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DLATRS', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* Determine machine dependent parameters to control overflow.
+*
+ SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
+ BIGNUM = ONE / SMLNUM
+ SCALE = ONE
+*
+ IF( LSAME( NORMIN, 'N' ) ) THEN
+*
+* Compute the 1-norm of each column, not including the diagonal.
+*
+ IF( UPPER ) THEN
+*
+* A is upper triangular.
+*
+ DO 10 J = 1, N
+ CNORM( J ) = DASUM( J-1, A( 1, J ), 1 )
+ 10 CONTINUE
+ ELSE
+*
+* A is lower triangular.
+*
+ DO 20 J = 1, N - 1
+ CNORM( J ) = DASUM( N-J, A( J+1, J ), 1 )
+ 20 CONTINUE
+ CNORM( N ) = ZERO
+ END IF
+ END IF
+*
+* Scale the column norms by TSCAL if the maximum element in CNORM is
+* greater than BIGNUM.
+*
+ IMAX = IDAMAX( N, CNORM, 1 )
+ TMAX = CNORM( IMAX )
+ IF( TMAX.LE.BIGNUM ) THEN
+ TSCAL = ONE
+ ELSE
+ TSCAL = ONE / ( SMLNUM*TMAX )
+ CALL DSCAL( N, TSCAL, CNORM, 1 )
+ END IF
+*
+* Compute a bound on the computed solution vector to see if the
+* Level 2 BLAS routine DTRSV can be used.
+*
+ J = IDAMAX( N, X, 1 )
+ XMAX = ABS( X( J ) )
+ XBND = XMAX
+ IF( NOTRAN ) THEN
+*
+* Compute the growth in A * x = b.
+*
+ IF( UPPER ) THEN
+ JFIRST = N
+ JLAST = 1
+ JINC = -1
+ ELSE
+ JFIRST = 1
+ JLAST = N
+ JINC = 1
+ END IF
+*
+ IF( TSCAL.NE.ONE ) THEN
+ GROW = ZERO
+ GO TO 50
+ END IF
+*
+ IF( NOUNIT ) THEN
+*
+* A is non-unit triangular.
+*
+* Compute GROW = 1/G(j) and XBND = 1/M(j).
+* Initially, G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = ONE / MAX( XBND, SMLNUM )
+ XBND = GROW
+ DO 30 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 50
+*
+* M(j) = G(j-1) / abs(A(j,j))
+*
+ TJJ = ABS( A( J, J ) )
+ XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
+ IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
+*
+* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
+*
+ GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
+ ELSE
+*
+* G(j) could overflow, set GROW to 0.
+*
+ GROW = ZERO
+ END IF
+ 30 CONTINUE
+ GROW = XBND
+ ELSE
+*
+* A is unit triangular.
+*
+* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
+ DO 40 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 50
+*
+* G(j) = G(j-1)*( 1 + CNORM(j) )
+*
+ GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
+ 40 CONTINUE
+ END IF
+ 50 CONTINUE
+*
+ ELSE
+*
+* Compute the growth in A' * x = b.
+*
+ IF( UPPER ) THEN
+ JFIRST = 1
+ JLAST = N
+ JINC = 1
+ ELSE
+ JFIRST = N
+ JLAST = 1
+ JINC = -1
+ END IF
+*
+ IF( TSCAL.NE.ONE ) THEN
+ GROW = ZERO
+ GO TO 80
+ END IF
+*
+ IF( NOUNIT ) THEN
+*
+* A is non-unit triangular.
+*
+* Compute GROW = 1/G(j) and XBND = 1/M(j).
+* Initially, M(0) = max{x(i), i=1,...,n}.
+*
+ GROW = ONE / MAX( XBND, SMLNUM )
+ XBND = GROW
+ DO 60 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 80
+*
+* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
+*
+ XJ = ONE + CNORM( J )
+ GROW = MIN( GROW, XBND / XJ )
+*
+* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
+*
+ TJJ = ABS( A( J, J ) )
+ IF( XJ.GT.TJJ )
+ $ XBND = XBND*( TJJ / XJ )
+ 60 CONTINUE
+ GROW = MIN( GROW, XBND )
+ ELSE
+*
+* A is unit triangular.
+*
+* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = MIN( ONE, ONE / MAX( XBND, SMLNUM ) )
+ DO 70 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 80
+*
+* G(j) = ( 1 + CNORM(j) )*G(j-1)
+*
+ XJ = ONE + CNORM( J )
+ GROW = GROW / XJ
+ 70 CONTINUE
+ END IF
+ 80 CONTINUE
+ END IF
+*
+ IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
+*
+* Use the Level 2 BLAS solve if the reciprocal of the bound on
+* elements of X is not too small.
+*
+ CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
+ ELSE
+*
+* Use a Level 1 BLAS solve, scaling intermediate results.
+*
+ IF( XMAX.GT.BIGNUM ) THEN
+*
+* Scale X so that its components are less than or equal to
+* BIGNUM in absolute value.
+*
+ SCALE = BIGNUM / XMAX
+ CALL DSCAL( N, SCALE, X, 1 )
+ XMAX = BIGNUM
+ END IF
+*
+ IF( NOTRAN ) THEN
+*
+* Solve A * x = b
+*
+ DO 110 J = JFIRST, JLAST, JINC
+*
+* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
+*
+ XJ = ABS( X( J ) )
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ IF( TSCAL.EQ.ONE )
+ $ GO TO 100
+ END IF
+ TJJ = ABS( TJJS )
+ IF( TJJ.GT.SMLNUM ) THEN
+*
+* abs(A(j,j)) > SMLNUM:
+*
+ IF( TJJ.LT.ONE ) THEN
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by 1/b(j).
+*
+ REC = ONE / XJ
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+ X( J ) = X( J ) / TJJS
+ XJ = ABS( X( J ) )
+ ELSE IF( TJJ.GT.ZERO ) THEN
+*
+* 0 < abs(A(j,j)) <= SMLNUM:
+*
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
+* to avoid overflow when dividing by A(j,j).
+*
+ REC = ( TJJ*BIGNUM ) / XJ
+ IF( CNORM( J ).GT.ONE ) THEN
+*
+* Scale by 1/CNORM(j) to avoid overflow when
+* multiplying x(j) times column j.
+*
+ REC = REC / CNORM( J )
+ END IF
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ X( J ) = X( J ) / TJJS
+ XJ = ABS( X( J ) )
+ ELSE
+*
+* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+* scale = 0, and compute a solution to A*x = 0.
+*
+ DO 90 I = 1, N
+ X( I ) = ZERO
+ 90 CONTINUE
+ X( J ) = ONE
+ XJ = ONE
+ SCALE = ZERO
+ XMAX = ZERO
+ END IF
+ 100 CONTINUE
+*
+* Scale x if necessary to avoid overflow when adding a
+* multiple of column j of A.
+*
+ IF( XJ.GT.ONE ) THEN
+ REC = ONE / XJ
+ IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
+*
+* Scale x by 1/(2*abs(x(j))).
+*
+ REC = REC*HALF
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ END IF
+ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
+*
+* Scale x by 1/2.
+*
+ CALL DSCAL( N, HALF, X, 1 )
+ SCALE = SCALE*HALF
+ END IF
+*
+ IF( UPPER ) THEN
+ IF( J.GT.1 ) THEN
+*
+* Compute the update
+* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
+*
+ CALL DAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
+ $ 1 )
+ I = IDAMAX( J-1, X, 1 )
+ XMAX = ABS( X( I ) )
+ END IF
+ ELSE
+ IF( J.LT.N ) THEN
+*
+* Compute the update
+* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
+*
+ CALL DAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
+ $ X( J+1 ), 1 )
+ I = J + IDAMAX( N-J, X( J+1 ), 1 )
+ XMAX = ABS( X( I ) )
+ END IF
+ END IF
+ 110 CONTINUE
+*
+ ELSE
+*
+* Solve A' * x = b
+*
+ DO 160 J = JFIRST, JLAST, JINC
+*
+* Compute x(j) = b(j) - sum A(k,j)*x(k).
+* k<>j
+*
+ XJ = ABS( X( J ) )
+ USCAL = TSCAL
+ REC = ONE / MAX( XMAX, ONE )
+ IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
+*
+* If x(j) could overflow, scale x by 1/(2*XMAX).
+*
+ REC = REC*HALF
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ END IF
+ TJJ = ABS( TJJS )
+ IF( TJJ.GT.ONE ) THEN
+*
+* Divide by A(j,j) when scaling x if A(j,j) > 1.
+*
+ REC = MIN( ONE, REC*TJJ )
+ USCAL = USCAL / TJJS
+ END IF
+ IF( REC.LT.ONE ) THEN
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+*
+ SUMJ = ZERO
+ IF( USCAL.EQ.ONE ) THEN
+*
+* If the scaling needed for A in the dot product is 1,
+* call DDOT to perform the dot product.
+*
+ IF( UPPER ) THEN
+ SUMJ = DDOT( J-1, A( 1, J ), 1, X, 1 )
+ ELSE IF( J.LT.N ) THEN
+ SUMJ = DDOT( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
+ END IF
+ ELSE
+*
+* Otherwise, use in-line code for the dot product.
+*
+ IF( UPPER ) THEN
+ DO 120 I = 1, J - 1
+ SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
+ 120 CONTINUE
+ ELSE IF( J.LT.N ) THEN
+ DO 130 I = J + 1, N
+ SUMJ = SUMJ + ( A( I, J )*USCAL )*X( I )
+ 130 CONTINUE
+ END IF
+ END IF
+*
+ IF( USCAL.EQ.TSCAL ) THEN
+*
+* Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j)
+* was not used to scale the dotproduct.
+*
+ X( J ) = X( J ) - SUMJ
+ XJ = ABS( X( J ) )
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ IF( TSCAL.EQ.ONE )
+ $ GO TO 150
+ END IF
+*
+* Compute x(j) = x(j) / A(j,j), scaling if necessary.
+*
+ TJJ = ABS( TJJS )
+ IF( TJJ.GT.SMLNUM ) THEN
+*
+* abs(A(j,j)) > SMLNUM:
+*
+ IF( TJJ.LT.ONE ) THEN
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale X by 1/abs(x(j)).
+*
+ REC = ONE / XJ
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+ X( J ) = X( J ) / TJJS
+ ELSE IF( TJJ.GT.ZERO ) THEN
+*
+* 0 < abs(A(j,j)) <= SMLNUM:
+*
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
+*
+ REC = ( TJJ*BIGNUM ) / XJ
+ CALL DSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ X( J ) = X( J ) / TJJS
+ ELSE
+*
+* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+* scale = 0, and compute a solution to A'*x = 0.
+*
+ DO 140 I = 1, N
+ X( I ) = ZERO
+ 140 CONTINUE
+ X( J ) = ONE
+ SCALE = ZERO
+ XMAX = ZERO
+ END IF
+ 150 CONTINUE
+ ELSE
+*
+* Compute x(j) := x(j) / A(j,j) - sumj if the dot
+* product has already been divided by 1/A(j,j).
+*
+ X( J ) = X( J ) / TJJS - SUMJ
+ END IF
+ XMAX = MAX( XMAX, ABS( X( J ) ) )
+ 160 CONTINUE
+ END IF
+ SCALE = SCALE / TSCAL
+ END IF
+*
+* Scale the column norms by 1/TSCAL for return.
+*
+ IF( TSCAL.NE.ONE ) THEN
+ CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
+ END IF
+*
+ RETURN
+*
+* End of DLATRS
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.c
new file mode 100644
index 0000000000000000000000000000000000000000..1208c91ff2e7137a2e6935f2ea6c972cb804d471
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.c
@@ -0,0 +1,1873 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+static void dlabax_(const integer *n, const integer *nband, doublereal *a, doublereal *x, doublereal *y);
+static void dlabcm_(const integer *n, const integer *nband, const integer *nl, const integer *nr,
+ doublereal *a, doublereal *eigval, const integer *lde, doublereal *eigvec,
+ doublereal *atol, doublereal *artol, doublereal *bound, doublereal *atemp, doublereal *d, doublereal *vtemp);
+static void dlabfc_(const integer *n, const integer *nband, doublereal *a, doublereal *sigma, const integer *number,
+ const integer *lde, doublereal *eigvec, integer *numl, integer *ldad,
+ doublereal *atemp, doublereal *d, doublereal *atol);
+static void dlaeig_(const integer *n, const integer *nband, const integer *nl, const integer *nr,
+ doublereal *a, doublereal *eigval, const integer *lde,
+ doublereal *eigvec, doublereal *bound, doublereal *atemp, doublereal *d,
+ doublereal *vtemp, doublereal *eps, doublereal *tmin, doublereal *tmax);
+static void dlager_(const integer *n, const integer *nband, const integer *nstart,
+ doublereal *a, doublereal *tmin, doublereal *tmax);
+static void dlaran_(const integer *n, doublereal *x);
+static void dmvpc_(const integer *nblock, const doublereal *bet, const integer *maxj, const integer *j,
+ const doublereal *s, const integer *number, doublereal *resnrm, doublereal *orthcf, doublereal *rv);
+static void dnppla_(void (*op)(const integer*,const integer*,const doublereal*,doublereal*),
+ void (*iovect)(const integer*,const integer*,doublereal*,const integer*,const integer*),
+ const integer *n, const integer *nperm, integer *nop, const integer *nmval,
+ doublereal *val, const integer *nmvec, doublereal *vec, const integer *nblock,
+ doublereal *h, doublereal *hv, doublereal *p, doublereal *q, doublereal *bound,
+ doublereal *d, doublereal *delta, logical *small, logical *raritz, doublereal *eps);
+static void dnwla_(void (*op)(const integer*,const integer*,const doublereal*,doublereal*),
+ void (*iovect)(const integer*,const integer*,doublereal*,const integer*,const integer*),
+ const integer *n, const integer *nband, const integer *nval,
+ const integer *nfig, integer *nperm, doublereal *val, const integer *nmvec, doublereal *vec,
+ const integer *nblock, const integer *maxop, const integer *maxj, integer *nop,
+ doublereal *p1, doublereal *p0, doublereal *res, doublereal *tau, doublereal *otau,
+ doublereal *t, doublereal *alp, doublereal *bet, doublereal *s, doublereal *p2,
+ doublereal *bound, doublereal *atemp, doublereal *vtemp,
+ doublereal *d, integer *ind, logical *small, logical *raritz,
+ doublereal *delta, doublereal *eps, integer *ierr);
+static void dortqr_(const integer *nz, const integer *n, const integer *nblock, doublereal *z, doublereal *b);
+static void dvsort_(const integer *num, doublereal *val, doublereal *res, const integer *iflag,
+ doublereal *v, const integer *nmvec, const integer *n, doublereal *vec);
+
+/* Table of constant values */
+static integer c__0 = 0;
+static integer c__1 = 1;
+static doublereal c__10 = 0.1;
+static doublereal c__00 = 0.0;
+
+/* VERSION 2 DOES NOT USE EISPACK */
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+void dnlaso_(op, iovect, n, nval, nfig, nperm, nmval, val, nmvec, vec, nblock, maxop, maxj, work, ind, ierr)
+void (*op) (const integer* n,const integer* m,const doublereal* p,doublereal* q);
+void (*iovect) (const integer* n,const integer* m,doublereal* q,const integer* j,const integer* k);
+const integer *n, *nval, *nfig, *nmval;
+integer *nperm;
+doublereal *val;
+const integer *nmvec;
+doublereal *vec;
+const integer *nblock, *maxop, *maxj;
+doublereal *work;
+integer *ind, *ierr;
+{
+ /* Local variables */
+ static doublereal temp, tarr;
+ static integer i, m, nband;
+ static doublereal delta;
+ static logical small;
+ static integer i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, nv;
+ static logical raritz;
+ static doublereal eps;
+ static integer nop;
+
+/* AUTHOR/IMPLEMENTER D.S.SCOTT-B.N.PARLETT/D.S.SCOTT */
+/* */
+/* COMPUTER SCIENCES DEPARTMENT */
+/* UNIVERSITY OF TEXAS AT AUSTIN */
+/* AUSTIN, TX 78712 */
+/* */
+/* VERSION 2 ORIGINATED APRIL 1982 */
+/* */
+/* CURRENT VERSION JUNE 1983 */
+
+/* DNLASO FINDS A FEW EIGENVALUES AND EIGENVECTORS AT EITHER END OF */
+/* THE SPECTRUM OF A LARGE SPARSE SYMMETRIC MATRIX. THE SUBROUTINE */
+/* DNLASO IS PRIMARILY A DRIVER FOR SUBROUTINE DNWLA WHICH IMPLEMENTS */
+/* THE LANCZOS ALGORITHM WITH SELECTIVE ORTHOGONALIZATION AND */
+/* SUBROUTINE DNPPLA WHICH POST PROCESSES THE OUTPUT OF DNWLA. */
+/* HOWEVER DNLASO DOES CHECK FOR INCONSISTENCIES IN THE CALLING */
+/* PARAMETERS AND DOES PREPROCESS ANY USER SUPPLIED EIGENPAIRS. */
+/* DNLASO ALWAYS LOOKS FOR THE SMALLEST (LEFTMOST) EIGENVALUES. IF */
+/* THE LARGEST EIGENVALUES ARE DESIRED DNLASO IMPLICITLY USES THE */
+/* NEGATIVE OF THE MATRIX. */
+/* */
+/* ON INPUT */
+/* */
+/* OP A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE */
+/* OP(N,M,P,Q). P AND Q ARE N X M MATRICES AND Q IS */
+/* RETURNED AS THE MATRIX TIMES P. */
+/* */
+/* IOVECT A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE */
+/* IOVECT(N,M,Q,J,K). Q IS AN N X M MATRIX. IF K = 0 */
+/* THE COLUMNS OF Q ARE STORED AS THE (J-M+1)TH THROUGH */
+/* THE JTH LANCZOS VECTORS. IF K = 1 THEN Q IS RETURNED */
+/* AS THE (J-M+1)TH THROUGH THE JTH LANCZOS VECTORS. SEE */
+/* DOCUMENTATION FOR FURTHER DETAILS AND EXAMPLES. */
+/* */
+/* N THE ORDER OF THE MATRIX. */
+/* */
+/* NVAL NVAL SPECIFIES THE EIGENVALUES TO BE FOUND. */
+/* DABS(NVAL) IS THE NUMBER OF EIGENVALUES DESIRED. */
+/* IF NVAL < 0 THE ALGEBRAICALLY SMALLEST (LEFTMOST) */
+/* EIGENVALUES ARE FOUND. IF NVAL > 0 THE ALGEBRAICALLY */
+/* LARGEST (RIGHTMOST) EIGENVALUES ARE FOUND. NVAL MUST NOT */
+/* BE ZERO. DABS(NVAL) MUST BE LESS THAN MAXJ/2. */
+/* */
+/* NFIG THE NUMBER OF DECIMAL DIGITS OF ACCURACY DESIRED IN THE */
+/* EIGENVALUES. NFIG MUST BE GREATER THAN OR EQUAL TO 1. */
+/* */
+/* NPERM AN INTEGER VARIABLE WHICH SPECIFIES THE NUMBER OF USER */
+/* SUPPLIED EIGENPAIRS. IN MOST CASES NPERM WILL BE ZERO. SEE */
+/* DOCUMENTAION FOR FURTHER DETAILS OF USING NPERM GREATER */
+/* THAN ZERO. NPERM MUST NOT BE LESS THAN ZERO. */
+/* */
+/* NMVAL THE ROW DIMENSION OF THE ARRAY VAL. NMVAL MUST BE GREATER */
+/* THAN OR EQUAL TO DABS(NVAL). */
+/* */
+/* VAL A TWO DIMENSIONAL DOUBLE PRECISION ARRAY OF ROW */
+/* DIMENSION NMVAL AND COLUMN DIMENSION AT LEAST 4. IF NPERM */
+/* IS GREATER THAN ZERO THEN CERTAIN INFORMATION MUST BE STORED */
+/* IN VAL. SEE DOCUMENTATION FOR DETAILS. */
+/* */
+/* NMVEC THE ROW DIMENSION OF THE ARRAY VEC. NMVEC MUST BE GREATER */
+/* THAN OR EQUAL TO N. */
+/* */
+/* VEC A TWO DIMENSIONAL DOUBLE PRECISION ARRAY OF ROW */
+/* DIMENSION NMVEC AND COLUMN DIMENSION AT LEAST DABS(NVAL). IF */
+/* NPERM > 0 THEN THE FIRST NPERM COLUMNS OF VEC MUST */
+/* CONTAIN THE USER SUPPLIED EIGENVECTORS. */
+/* */
+/* NBLOCK THE BLOCK SIZE. SEE DOCUMENTATION FOR CHOOSING */
+/* AN APPROPRIATE VALUE FOR NBLOCK. NBLOCK MUST BE GREATER */
+/* THAN ZERO AND LESS THAN MAXJ/6. */
+/* */
+/* MAXOP AN UPPER BOUND ON THE NUMBER OF CALLS TO THE SUBROUTINE */
+/* OP. DNLASO TERMINATES WHEN MAXOP IS EXCEEDED. SEE */
+/* DOCUMENTATION FOR GUIDELINES IN CHOOSING A VALUE FOR MAXOP. */
+/* */
+/* MAXJ AN INDICATION OF THE AVAILABLE STORAGE (SEE WORK AND */
+/* DOCUMENTATION ON IOVECT). FOR THE FASTEST CONVERGENCE MAXJ */
+/* SHOULD BE AS LARGE AS POSSIBLE, ALTHOUGH IT IS USELESS TO HAVE */
+/* MAXJ LARGER THAN MAXOP*NBLOCK. */
+/* */
+/* WORK A DOUBLE PRECISION ARRAY OF DIMENSION AT LEAST AS */
+/* LARGE AS */
+/* */
+/* 2*N*NBLOCK + MAXJ*(NBLOCK+NV+2) + 2*NBLOCK*NBLOCK + 3*NV */
+/* */
+/* + THE MAXIMUM OF */
+/* N*NBLOCK */
+/* AND */
+/* MAXJ*(2*NBLOCK+3) + 2*NV + 6 + (2*NBLOCK+2)*(NBLOCK+1) */
+/* */
+/* WHERE NV = DABS(NVAL) */
+/* */
+/* THE FIRST N*NBLOCK ELEMENTS OF WORK MUST CONTAIN THE DESIRED */
+/* STARTING VECTORS. SEE DOCUMENTATION FOR GUIDELINES IN */
+/* CHOOSING STARTING VECTORS. */
+/* */
+/* IND AN INTEGER ARRAY OF DIMENSION AT LEAST DABS(NVAL). */
+/* */
+/* IERR AN INTEGER VARIABLE. */
+/* */
+/* ON OUTPUT */
+/* */
+/* NPERM THE NUMBER OF EIGENPAIRS NOW KNOWN. */
+/* */
+/* VEC THE FIRST NPERM COLUMNS OF VEC CONTAIN THE EIGENVECTORS. */
+/* */
+/* VAL THE FIRST COLUMN OF VAL CONTAINS THE CORRESPONDING */
+/* EIGENVALUES. THE SECOND COLUMN CONTAINS THE RESIDUAL NORMS OF */
+/* THE EIGENPAIRS WHICH ARE BOUNDS ON THE ACCURACY OF THE EIGEN- */
+/* VALUES. THE THIRD COLUMN CONTAINS MORE REALISTIC ESTIMATES */
+/* OF THE ACCURACY OF THE EIGENVALUES. THE FOURTH COLUMN CONTAINS */
+/* ESTIMATES OF THE ACCURACY OF THE EIGENVECTORS. SEE */
+/* DOCUMENTATION FOR FURTHER INFORMATION ON THESE QUANTITIES. */
+/* */
+/* WORK IF WORK IS TERMINATED BEFORE COMPLETION (IERR = -2) */
+/* THE FIRST N*NBLOCK ELEMENTS OF WORK CONTAIN THE BEST VECTORS */
+/* FOR RESTARTING THE ALGORITHM AND DNLASO CAN BE IMMEDIATELY */
+/* RECALLED TO CONTINUE WORKING ON THE PROBLEM. */
+/* */
+/* IND IND(1) CONTAINS THE ACTUAL NUMBER OF CALLS TO OP. ON SOME */
+/* OCCASIONS THE NUMBER OF CALLS TO OP MAY BE SLIGHTLY LARGER */
+/* THAN MAXOP. */
+/* */
+/* IERR AN ERROR COMPLETION CODE. THE NORMAL COMPLETION CODE IS */
+/* ZERO. SEE THE DOCUMENTATION FOR INTERPRETATIONS OF NON-ZERO */
+/* COMPLETION CODES. */
+/* */
+/* INTERNAL VARIABLES. */
+/* */
+/* NOP RETURNED FROM DNWLA AS THE NUMBER OF CALLS TO THE */
+/* SUBROUTINE OP. */
+/* */
+/* NV SET EQUAL TO DABS(NVAL), THE NUMBER OF EIGENVALUES DESIRED, */
+/* AND PASSED TO DNWLA. */
+/* */
+/* SMALL SET TO .TRUE. IF THE SMALLEST EIGENVALUES ARE DESIRED. */
+/* */
+/* RARITZ RETURNED FROM DNWLA AND PASSED TO DNPPLA. RARITZ IS .TRUE. */
+/* IF A FINAL RAYLEIGH-RITZ PROCEDURE IS NEEDED. */
+/* */
+/* DELTA RETURNED FROM DNWLA AS THE EIGENVALUE OF THE MATRIX */
+/* WHICH IS CLOSEST TO THE DESIRED EIGENVALUES. */
+/* */
+/* DNPPLA A SUBROUTINE FOR POST-PROCESSING THE EIGENVECTORS COMPUTED */
+/* BY DNWLA. */
+/* */
+/* DNWLA A SUBROUTINE FOR IMPLEMENTING THE LANCZOS ALGORITHM */
+/* WITH SELECTIVE ORTHOGONALIZATION. */
+/* */
+/* DMVPC A SUBROUTINE FOR COMPUTING THE RESIDUAL NORM AND */
+/* ORTHOGONALITY COEFFICIENT OF GIVEN RITZ VECTORS. */
+/* */
+/* DORTQR A SUBROUTINE FOR ORTHONORMALIZING A BLOCK OF VECTORS */
+/* USING HOUSEHOLDER REFLECTIONS. */
+/* */
+/* DAXPY,DCOPY,DDOT,DNRM2,DSCAL,DSWAP A SUBSET OF THE BASIC LINEAR */
+/* ALGEBRA SUBPROGRAMS USED FOR VECTOR MANIPULATION. */
+/* */
+/* DLARAN A SUBROUTINE TO GENERATE RANDOM VECTORS */
+/* */
+/* DLAEIG, DLAGER, DLABCM, DLABFC SUBROUTINES FOR BAND EIGENVALUE */
+/* CALCULATIONS. */
+/* */
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CHECKS FOR INCONSISTENCY IN THE INPUT PARAMETERS. */
+
+ nv = abs(*nval);
+ ind[0] = 0;
+ *ierr = 0;
+ if (*n < *nblock * 6) {
+ *ierr = 1;
+ }
+ if (*nfig <= 0) {
+ *ierr += 2;
+ }
+ if (*nmvec < *n) {
+ *ierr += 4;
+ }
+ if (*nperm < 0) {
+ *ierr += 8;
+ }
+ if (*maxj < *nblock * 6) {
+ *ierr += 16;
+ }
+ if (nv < max(1,*nperm)) {
+ *ierr += 32;
+ }
+ if (nv > *nmval) {
+ *ierr += 64;
+ }
+ if (nv > *maxop) {
+ *ierr += 128;
+ }
+ if (nv >= *maxj / 2) {
+ *ierr += 256;
+ }
+ if (*nblock < 1) {
+ *ierr += 512;
+ }
+ if (*ierr != 0) {
+ return;
+ }
+
+ small = *nval < 0;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION SORTS AND ORTHONORMALIZES THE USER SUPPLIED VECTORS. */
+/* IF A USER SUPPLIED VECTOR IS ZERO OR IF SIGNIFICANT CANCELLATION */
+/* OCCURS IN THE ORTHOGONALIZATION PROCESS THEN IERR IS SET TO -1 */
+/* AND DNLASO TERMINATES. */
+
+ if (*nperm == 0) {
+ goto L110;
+ }
+
+/* THIS NEGATES THE USER SUPPLIED EIGENVALUES WHEN THE LARGEST */
+/* EIGENVALUES ARE DESIRED, SINCE DNWLA WILL IMPLICITLY USE THE */
+/* NEGATIVE OF THE MATRIX. */
+
+ if (!small)
+ for (i = 0; i < *nperm; ++i) {
+ val[i] = -val[i];
+ }
+
+/* THIS SORTS THE USER SUPPLIED VALUES AND VECTORS. */
+
+ dvsort_(nperm, val, &val[*nmval], &c__0, &tarr, nmvec, n, vec);
+
+/* THIS STORES THE NORMS OF THE VECTORS FOR LATER COMPARISON. */
+/* IT ALSO INSURES THAT THE RESIDUAL NORMS ARE POSITIVE. */
+
+ for (i = 0; i < *nperm; ++i) {
+ val[i + *nmval] = abs(val[i + *nmval]);
+ val[i + *nmval * 2] = dnrm2_(n, &vec[i * *nmvec], &c__1);
+ }
+
+/* THIS PERFORMS THE ORTHONORMALIZATION. */
+
+ m = *n * *nblock;
+ dortqr_(nmvec, n, nperm, vec, &work[m]);
+ for (i = 0; i < *nperm; ++i, m += *nperm + 1) {
+ if (abs(work[m]) <= val[i + *nmval * 2] * .9) {
+ *ierr = -1;
+ return;
+ }
+ }
+
+/* THIS COPIES THE RESIDUAL NORMS INTO THE CORRECT LOCATIONS IN */
+/* THE ARRAY WORK FOR LATER REFERENCE IN DNWLA. */
+
+ m = (*n << 1) * *nblock;
+ dcopy_(nperm, &val[*nmval], &c__1, &work[m], &c__1);
+
+/* THIS SETS EPS TO AN APPROXIMATION OF THE RELATIVE MACHINE */
+/* PRECISION */
+
+/* ***THIS SHOULD BE REPLACED BY AN ASSIGNMENT STATEMENT */
+/* ***IN A PRODUCTION CODE */
+
+L110:
+ eps = 1.;
+ for (i = 0; i < 1000; ++i) {
+ eps *= .5;
+ temp = eps + 1.;
+ if (temp == 1.) {
+ break;
+ }
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CALLS DNWLA WHICH IMPLEMENTS THE LANCZOS ALGORITHM */
+/* WITH SELECTIVE ORTHOGONALIZATION. */
+
+ nband = *nblock + 1;
+ i1 = *n * *nblock;
+ i2 = i1 + *n * *nblock;
+ i3 = i2 + nv;
+ i4 = i3 + nv;
+ i5 = i4 + nv;
+ i6 = i5 + *maxj * nband;
+ i7 = i6 + *nblock * *nblock;
+ i8 = i7 + *nblock * *nblock;
+ i9 = i8 + *maxj * (nv + 1);
+ i10 = i9 + *nblock;
+ i11 = i10 + (nv << 1) + 6;
+ i12 = i11 + *maxj * ((*nblock << 1) + 1);
+ i13 = i12 + *maxj;
+ dnwla_(op, iovect, n, &nband, &nv, nfig, nperm, val, nmvec, vec, nblock,
+ maxop, maxj, &nop, work, &work[i1], &work[i2], &work[i3], &work[i4],
+ &work[i5], &work[i6], &work[i7], &work[i8], &work[i9], &work[i10],
+ &work[i11], &work[i12], &work[i13], ind, &small, &raritz, &delta, &eps, ierr);
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CALLS DNPPLA (THE POST PROCESSOR). */
+
+ if (*nperm == 0) {
+ ind[0] = nop;
+ return;
+ }
+ i1 = *n * *nblock;
+ i2 = i1 + *nperm * *nperm;
+ i3 = i2 + *nperm * *nperm;
+ i4 = i3 + max(*n * *nblock, 2 * *nperm * *nperm);
+ i5 = i4 + *n * *nblock;
+ i6 = i5 + (*nperm << 1) + 4;
+ dnppla_(op, iovect, n, nperm, &nop, nmval, val, nmvec, vec, nblock,
+ &work[i1], &work[i2], &work[i3], &work[i4], &work[i5], &work[i6],
+ &delta, &small, &raritz, &eps);
+
+ ind[0] = nop;
+ return;
+} /* dnlaso_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void dnwla_(op, iovect, n, nband, nval, nfig, nperm, val,
+ nmvec, vec, nblock, maxop, maxj, nop, p1, p0, res, tau, otau, t, alp,
+ bet, s, p2, bound, atemp, vtemp, d, ind, small, raritz, delta, eps, ierr)
+/* Subroutine */
+void (*op) (const integer*,const integer*,const doublereal*,doublereal*);
+/* Subroutine */
+void (*iovect) (const integer*,const integer*,doublereal*,const integer*,const integer*);
+const integer *n, *nband, *nval, *nfig;
+integer *nperm;
+doublereal *val;
+const integer *nmvec;
+doublereal *vec;
+const integer *nblock, *maxop, *maxj;
+integer *nop;
+doublereal *p1, *p0, *res, *tau, *otau, *t, *alp, *bet, *s, *p2, *bound, *atemp, *vtemp, *d;
+integer *ind;
+logical *small, *raritz;
+doublereal *delta, *eps;
+integer *ierr;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal tola, temp, tolg, tmin, tmax, tarr;
+ static logical test;
+ static doublereal zero=0., utol;
+ static integer i, j, k, l, m;
+ static integer ngood, nleft;
+ static doublereal anorm;
+ static integer mtemp;
+ static integer i1;
+ static doublereal pnorm, epsrt, rnorm;
+ static integer ng;
+ static doublereal betmin, alpmin, betmax, alpmax;
+ static integer ntheta;
+ static logical enough;
+ static integer number, nstart;
+
+/* DNWLA IMPLEMENTS THE LANCZOS ALGORITHM WITH SELECTIVE */
+/* ORTHOGONALIZATION. */
+/* */
+/* NBAND NBLOCK + 1 THE BAND WIDTH OF T. */
+/* */
+/* NVAL THE NUMBER OF DESIRED EIGENVALUES. */
+/* */
+/* NPERM THE NUMBER OF PERMANENT VECTORS (THOSE EIGENVECTORS */
+/* INPUT BY THE USER OR THOSE EIGENVECTORS SAVED WHEN THE */
+/* ALGORITHM IS ITERATED). PERMANENT VECTORS ARE ORTHOGONAL */
+/* TO THE CURRENT KRYLOV SUBSPACE. */
+/* */
+/* NOP THE NUMBER OF CALLS TO OP. */
+/* */
+/* P0, P1, AND P2 THE CURRENT BLOCKS OF LANCZOS VECTORS. */
+/* */
+/* RES THE (APPROXIMATE) RESIDUAL NORMS OF THE PERMANENT VECTORS. */
+/* */
+/* TAU AND OTAU USED TO MONITOR THE NEED FOR ORTHOGONALIZATION. */
+/* */
+/* T THE BAND MATRIX. */
+/* */
+/* ALP THE CURRENT DIAGONAL BLOCK. */
+/* */
+/* BET THE CURRENT OFF DIAGONAL BLOCK. */
+/* */
+/* BOUND, ATEMP, VTEMP, D */
+/* TEMPORARY STORAGE USED BY THE BAND EIGENVALUE SOLVER DLAEIG. */
+/* */
+/* S EIGENVECTORS OF T. */
+/* */
+/* SMALL .TRUE. IF THE SMALL EIGENVALUES ARE DESIRED. */
+/* */
+/* RARITZ RETURNED AS .TRUE. IF A FINAL RAYLEIGH-RITZ PROCEDURE */
+/* IS TO BE DONE. */
+/* */
+/* DELTA RETURNED AS THE VALUE OF THE (NVAL+1)TH EIGENVALUE */
+/* OF THE MATRIX. USED IN ESTIMATING THE ACCURACY OF THE */
+/* COMPUTED EIGENVALUES. */
+/* */
+/* INTERNAL VARIABLES USED */
+/* */
+/* J THE CURRENT DIMENSION OF T. (THE DIMENSION OF THE CURRENT */
+/* KRYLOV SUBSPACE. */
+/* */
+/* NGOOD THE NUMBER OF GOOD RITZ VECTORS (GOOD VECTORS */
+/* LIE IN THE CURRENT KRYLOV SUBSPACE). */
+/* */
+/* NLEFT THE NUMBER OF VALUES WHICH REMAIN TO BE DETERMINED, */
+/* I.E. NLEFT = NVAL - NPERM. */
+/* */
+/* NUMBER = NPERM + NGOOD. */
+/* */
+/* ANORM AN ESTIMATE OF THE NORM OF THE MATRIX. */
+/* */
+/* EPS THE RELATIVE MACHINE PRECISION. */
+/* */
+/* UTOL THE USER TOLERANCE. */
+/* */
+/* TARR AN ARRAY OF LENGTH ONE USED TO INSURE TYPE CONSISTENCY IN */
+/* CALLS TO DLAEIG */
+/* */
+/* DZERO AN ARRAY OF LENGTH ONE CONTAINING DZERO, USED TO INSURE TYPE */
+/* CONSISTENCY IN CALLS TO DCOPY */
+
+ rnorm = 0.;
+ if (*nperm != 0) {
+ rnorm = max(-val[0],val[*nperm-1]);
+ }
+ pnorm = rnorm;
+ *delta = 1e31;
+ epsrt = sqrt(*eps);
+ nleft = *nval - *nperm;
+ *nop = 0;
+ number = *nperm;
+ *raritz = FALSE_;
+ utol = max((*n) * *eps, pow_di(&c__10, nfig));
+ j = *maxj;
+
+/* ------------------------------------------------------------------ */
+
+/* ANY ITERATION OF THE ALGORITHM BEGINS HERE. */
+
+L30:
+ for (i = 0; i < *nblock; ++i) {
+ temp = dnrm2_(n, &p1[i * *n], &c__1);
+ if (temp == 0.) {
+ dlaran_(n, &p1[i * *n]);
+ }
+ }
+ for (i = 0; i < *nperm; ++i) {
+ tau[i] = 1.;
+ otau[i] = 0.;
+ }
+ i__1 = *n * *nblock;
+ dcopy_(&i__1, &zero, &c__0, p0, &c__1);
+ i__1 = *nblock * *nblock;
+ dcopy_(&i__1, &zero, &c__0, bet, &c__1);
+ i__1 = j * *nband;
+ dcopy_(&i__1, &zero, &c__0, t, &c__1);
+ mtemp = *nval + 1;
+ for (i = 0; i < mtemp; ++i) {
+ dcopy_(&j, &zero, &c__0, &s[i * *maxj], &c__1);
+ }
+ ngood = 0;
+ tmin = 1e30;
+ tmax = -1e30;
+ test = TRUE_;
+ enough = FALSE_;
+ betmax = 0.;
+ j = 0;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION TAKES A SINGLE BLOCK LANCZOS STEP. */
+
+L80:
+ j += *nblock;
+
+/* THIS IS THE SELECTIVE ORTHOGONALIZATION. */
+
+ for (i = 0; i < number; ++i) {
+ if (tau[i] < epsrt) {
+ continue;
+ }
+ test = TRUE_;
+ tau[i] = 0.;
+ if (otau[i] != 0.) {
+ otau[i] = 1.;
+ }
+ for (k = 0; k < *nblock; ++k) {
+ temp = -ddot_(n, &vec[i * *nmvec], &c__1, &p1[k * *n], &c__1);
+ daxpy_(n, &temp, &vec[i * *nmvec], &c__1, &p1[k * *n], &c__1);
+
+/* THIS CHECKS FOR TOO GREAT A LOSS OF ORTHOGONALITY BETWEEN A */
+/* NEW LANCZOS VECTOR AND A GOOD RITZ VECTOR. THE ALGORITHM IS */
+/* TERMINATED IF TOO MUCH ORTHOGONALITY IS LOST. */
+
+ if (abs(temp * bet[k + k * *nblock]) > (*n) * epsrt * anorm && i >= *nperm) {
+ goto L380;
+ }
+ }
+ }
+
+/* IF NECESSARY, THIS REORTHONORMALIZES P1 AND UPDATES BET. */
+
+ if (test)
+ dortqr_(n, n, nblock, p1, alp);
+ if (test && j != *nblock)
+ for (i = 0; i < *nblock; ++i) {
+ if (alp[i + i * *nblock] > 0.) {
+ continue;
+ }
+ m = j - (*nblock << 1) + i;
+ l = *nblock;
+ for (k = i; k < *nblock; ++k, --l, ++m) {
+ bet[i + k * *nblock] = -bet[i + k * *nblock];
+ t[l + m * *nband] = -t[l + m * *nband];
+ }
+ }
+ test = FALSE_;
+
+/* THIS IS THE LANCZOS STEP. */
+
+ (*op)(n, nblock, p1, p2);
+ ++(*nop);
+ (*iovect)(n, nblock, p1, &j, &c__0);
+
+/* THIS COMPUTES P2=P2-P0*BET(TRANSPOSE) */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = i; k < *nblock; ++k) {
+ d__1 = -bet[i + k * *nblock];
+ daxpy_(n, &d__1, &p0[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ }
+
+/* THIS COMPUTES ALP AND P2=P2-P1*ALP. */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ i1 = i - k;
+ alp[i1 + k * *nblock] = ddot_(n, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ d__1 = -alp[i1 + k * *nblock];
+ daxpy_(n, &d__1, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ if (k != i) {
+ d__1 = -alp[i1 + k * *nblock];
+ daxpy_(n, &d__1, &p1[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ }
+ }
+
+/* REORTHOGONALIZATION OF THE SECOND BLOCK */
+
+ if (j == *nblock)
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ temp = -ddot_(n, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ daxpy_(n, &temp, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ if (k != i) {
+ daxpy_(n, &temp, &p1[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ i1 = i - k;
+ alp[i1 + k * *nblock] += temp;
+ }
+ }
+
+/* THIS ORTHONORMALIZES THE NEXT BLOCK */
+
+ dortqr_(n, n, nblock, p2, bet);
+
+/* THIS STORES ALP AND BET IN T. */
+
+ for (i = 0; i < *nblock; ++i) {
+ m = j - *nblock + i;
+ for (k = i; k < *nblock; ++k) {
+ l = k - i;
+ t[l + m * *nband] = alp[l + i * *nblock];
+ }
+ for (k = 0; k <= i; ++k) {
+ l = *nblock - i + k;
+ t[l + m * *nband] = bet[k + i * *nblock];
+ }
+ }
+
+/* THIS NEGATES T IF SMALL IS FALSE. */
+
+ if (! *small)
+ for (i = j - *nblock; i < j; ++i) {
+ for (k = 0; k <= l; ++k) { /* FIXME *** This must be an error! (already in the fortran code) -- l is undefined *** */
+ t[k + i * *nband] = -t[k + i * *nband];
+ }
+ }
+
+/* THIS SHIFTS THE LANCZOS VECTORS */
+
+ i__1 = *nblock * *n;
+ dcopy_(&i__1, p1, &c__1, p0, &c__1);
+ dcopy_(&i__1, p2, &c__1, p1, &c__1);
+ i__1 = j - *nblock + 1;
+ dlager_(&j, nband, &i__1, t, &tmin, &tmax);
+ anorm = max(max(rnorm,tmax),-tmin);
+
+/* THIS COMPUTES THE EXTREME EIGENVALUES OF ALP. */
+
+ if (number != 0) {
+ dcopy_(nblock, &zero, &c__0, p2, &c__1);
+ dlaeig_(nblock, nblock, &c__1, &c__1, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ alpmin = tarr;
+ dcopy_(nblock, &zero, &c__0, p2, &c__1);
+ dlaeig_(nblock, nblock, nblock, nblock, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ alpmax = tarr;
+ }
+
+/* THIS COMPUTES ALP = BET(TRANSPOSE)*BET. */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ l = i - k;
+ i__1 = *nblock - i;
+ alp[l + k * *nblock] = ddot_(&i__1, &bet[i + i * *nblock], nblock, &bet[k + i * *nblock], nblock);
+ }
+ }
+ if (number == 0) {
+ goto L330;
+ }
+
+/* THIS COMPUTES THE SMALLEST SINGULAR VALUE OF BET. */
+
+ dcopy_(nblock, &zero, &c__0, p2, &c__1);
+ d__1 = anorm * anorm;
+ dlaeig_(nblock, nblock, &c__1, &c__1, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &c__00, &d__1);
+ betmin = sqrt(tarr);
+
+/* THIS UPDATES TAU AND OTAU. */
+
+ for (i = 0; i < number; ++i) {
+ temp = (tau[i] * max(alpmax-val[i],val[i]-alpmin) + otau[i] * betmax + *eps * anorm) / betmin;
+ if (i < *nperm) {
+ temp += res[i] / betmin;
+ }
+ otau[i] = tau[i];
+ tau[i] = temp;
+ }
+
+/* THIS COMPUTES THE LARGEST SINGULAR VALUE OF BET. */
+
+L330:
+ dcopy_(nblock, &zero, &c__0, p2, &c__1);
+ d__1 = anorm * anorm;
+ dlaeig_(nblock, nblock, nblock, nblock, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &c__00, &d__1);
+ betmax = sqrt(tarr);
+ if (j <= *nblock << 1) {
+ goto L80;
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES AND EXAMINES THE SMALLEST NONGOOD AND */
+/* LARGEST DESIRED EIGENVALUES OF T TO SEE IF A CLOSER LOOK */
+/* IS JUSTIFIED. */
+
+ tolg = epsrt * anorm;
+ tola = utol * rnorm;
+ if (*maxj - j < *nblock || ( *nop >= *maxop && nleft != 0 ) ) {
+ goto L390;
+ }
+ else
+ goto L400;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES SOME EIGENVALUES AND EIGENVECTORS OF T TO */
+/* SEE IF FURTHER ACTION IS INDICATED, ENTRY IS AT 380 OR 390 IF AN */
+/* ITERATION (OR TERMINATION) IS KNOWN TO BE NEEDED, OTHERWISE ENTRY */
+/* IS AT 400. */
+
+L380:
+ j -= *nblock;
+ *ierr = -8;
+L390:
+ if (nleft == 0) {
+ return;
+ }
+ test = TRUE_;
+L400:
+ ntheta = min(j/2, nleft+1);
+ dlaeig_(&j, nband, &c__1, &ntheta, t, &val[number], maxj, s, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ dmvpc_(nblock, bet, maxj, &j, s, &ntheta, atemp, vtemp, d);
+
+/* THIS CHECKS FOR TERMINATION OF A CHECK RUN */
+
+ if (nleft == 0 && j >= *nblock * 6) {
+ if (val[number] - atemp[0] > val[*nperm-1] - tola) {
+ goto L790;
+ }
+ }
+
+/* THIS UPDATES NLEFT BY EXAMINING THE COMPUTED EIGENVALUES OF T */
+/* TO DETERMINE IF SOME PERMANENT VALUES ARE NO LONGER DESIRED. */
+
+ if (ntheta <= nleft) {
+ goto L470;
+ }
+ if (*nperm != 0 && val[number+nleft] < val[*nperm-1]) {
+ --(*nperm);
+ ngood = 0;
+ number = *nperm;
+ ++nleft;
+ goto L400;
+ }
+
+/* THIS UPDATES DELTA. */
+
+ *delta = min(*delta,val[number+nleft]);
+ enough = TRUE_;
+ if (nleft == 0) {
+ goto L80;
+ }
+ ntheta = nleft;
+ vtemp[ntheta] = 1.;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION EXAMINES THE COMPUTED EIGENPAIRS IN DETAIL. */
+
+/* THIS CHECKS FOR ENOUGH ACCEPTABLE VALUES. */
+
+ if (! (test || enough)) {
+ goto L470;
+ }
+ *delta = min(*delta,anorm);
+ pnorm = max(rnorm,max(-val[number],*delta));
+ tola = utol * pnorm;
+ nstart = 0;
+ for (i = 0; i < ntheta; ++i) {
+ if (min(atemp[i]*atemp[i]/(*delta-val[number+i]), atemp[i]) <= tola) {
+ ind[i] = -1;
+ continue;
+ }
+ enough = FALSE_;
+ if (! test) {
+ goto L470;
+ }
+ ind[i] = 1;
+ ++nstart;
+ }
+
+/* COPY VALUES OF IND INTO VTEMP */
+
+ for (i = 0; i < ntheta; ++i) {
+ vtemp[i] = (doublereal) ind[i];
+ }
+ goto L500;
+
+/* THIS CHECKS FOR NEW GOOD VECTORS. */
+
+L470:
+ ng = 0;
+ for (i = 0; i < ntheta; ++i) {
+ if (vtemp[i] > tolg) {
+ vtemp[i] = 1.;
+ }
+ else {
+ ++ng;
+ vtemp[i] = -1.;
+ }
+ }
+
+ if (ng <= ngood) {
+ goto L80;
+ }
+ nstart = ntheta - ng;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES AND NORMALIZES THE INDICATED RITZ VECTORS. */
+/* IF NEEDED (TEST = .TRUE.), NEW STARTING VECTORS ARE COMPUTED. */
+
+L500:
+ test = test && ! enough;
+ ngood = ntheta - nstart;
+ ++nstart;
+ ++ntheta;
+
+/* THIS ALIGNS THE DESIRED (ACCEPTABLE OR GOOD) EIGENVALUES AND */
+/* EIGENVECTORS OF T. THE OTHER EIGENVECTORS ARE SAVED FOR */
+/* FORMING STARTING VECTORS, IF NECESSARY. IT ALSO SHIFTS THE */
+/* EIGENVALUES TO OVERWRITE THE GOOD VALUES FROM THE PREVIOUS */
+/* PAUSE. */
+
+ dcopy_(&ntheta, &val[number], &c__1, &val[*nperm], &c__1);
+ if (nstart == 0) {
+ goto L580;
+ }
+ if (nstart != ntheta) {
+ dvsort_(&ntheta, vtemp, atemp, &c__1, &val[*nperm], maxj, &j, s);
+ }
+
+/* THES ACCUMULATES THE J-VECTORS USED TO FORM THE STARTING */
+/* VECTORS. */
+
+ if (! test) {
+ nstart = 0;
+ }
+ if (! test) {
+ goto L580;
+ }
+
+/* FIND MINIMUM ATEMP VALUE TO AVOID POSSIBLE OVERFLOW */
+
+ temp = atemp[0];
+ for (i = 0; i < nstart; ++i) {
+ temp = min(temp,atemp[i]);
+ }
+ l = ngood + min(nstart,*nblock);
+ for (i = ngood; i < l; ++i) {
+ d__1 = temp / atemp[i];
+ dscal_(&j, &d__1, &s[i * *maxj], &c__1);
+ }
+ m = (nstart - 1) / *nblock;
+ l = ngood + *nblock;
+ for (i = 0; i < m; ++i) {
+ for (k = 0; k < *nblock; ++k, ++l) {
+ if (l >= ntheta) {
+ goto L570;
+ }
+ i1 = ngood + k;
+ d__1 = temp / atemp[l];
+ daxpy_(&j, &d__1, &s[l * *maxj], &c__1, &s[i1 * *maxj], &c__1);
+ }
+ }
+L570:
+ nstart = min(nstart,*nblock);
+
+/* THIS STORES THE RESIDUAL NORMS OF THE NEW PERMANENT VECTORS. */
+
+L580:
+ if (test || enough)
+ for (i = 0; i < ngood; ++i) {
+ res[*nperm+i] = atemp[i];
+ }
+
+/* THIS COMPUTES THE RITZ VECTORS BY SEQUENTIALLY RECALLING THE */
+/* LANCZOS VECTORS. */
+
+ number = *nperm + ngood;
+ if (test || enough) {
+ i__1 = *n * *nblock;
+ dcopy_(&i__1, &zero, &c__0, p1, &c__1);
+ }
+ if (ngood != 0)
+ for (i = *nperm; i < number; ++i) {
+ dcopy_(n, &zero, &c__0, &vec[i * *nmvec], &c__1);
+ }
+ for (i = *nblock; *nblock < 0 ? i >= j : i <= j; i += *nblock) {
+ (*iovect)(n, nblock, p2, &i, &c__1);
+ for (k = 0; k < *nblock; ++k) {
+ m = i - *nblock + k;
+ for (l = 0; l < nstart; ++l) {
+ i1 = ngood + l;
+ daxpy_(n, &s[m + i1 * *maxj], &p2[k * *n], &c__1, &p1[l * *n], &c__1);
+ }
+ for (l = 0; l < ngood; ++l) {
+ i1 = l + *nperm;
+ daxpy_(n, &s[m + l * *maxj], &p2[k * *n], &c__1, &vec[i1 * *nmvec], &c__1);
+ }
+ }
+ }
+ if (test || enough) {
+ goto L690;
+ }
+
+/* THIS NORMALIZES THE RITZ VECTORS AND INITIALIZES THE */
+/* TAU RECURRENCE. */
+
+ for (i = *nperm; i < number; ++i) {
+ temp = 1. / dnrm2_(n, &vec[i * *nmvec], &c__1);
+ dscal_(n, &temp, &vec[i * *nmvec], &c__1);
+ tau[i] = 1.;
+ otau[i] = 1.;
+ }
+
+/* SHIFT S VECTORS TO ALIGN FOR LATER CALL TO DLAEIG */
+
+ dcopy_(&ntheta, &val[*nperm], &c__1, vtemp, &c__1);
+ dvsort_(&ntheta, vtemp, atemp, &c__0, &tarr, maxj, &j, s);
+ goto L80;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION PREPARES TO ITERATE THE ALGORITHM BY SORTING THE */
+/* PERMANENT VALUES, RESETTING SOME PARAMETERS, AND ORTHONORMALIZING */
+/* THE PERMANENT VECTORS. */
+
+L690:
+ if (ngood == 0 && *nop >= *maxop) {
+ *ierr = -2; /* THIS REPORTS THAT MAXOP WAS EXCEEDED. */
+ goto L790;
+ }
+ if (ngood == 0) {
+ goto L30;
+ }
+
+/* THIS ORTHONORMALIZES THE VECTORS */
+
+ i__1 = *nperm + ngood;
+ dortqr_(nmvec, n, &i__1, vec, s);
+
+/* THIS SORTS THE VALUES AND VECTORS. */
+
+ if (*nperm != 0) {
+ i__1 = *nperm + ngood;
+ dvsort_(&i__1, val, res, &c__0, &temp, nmvec, n, vec);
+ }
+ *nperm += ngood;
+ nleft -= ngood;
+ rnorm = max(-val[0],val[*nperm-1]);
+
+/* THIS DECIDES WHERE TO GO NEXT. */
+
+ if (*nop >= *maxop && nleft != 0) {
+ *ierr = -2; /* THIS REPORTS THAT MAXOP WAS EXCEEDED. */
+ goto L790;
+ }
+ if (nleft != 0) {
+ goto L30;
+ }
+ if (val[*nval-1] - val[0] < tola) {
+ goto L790;
+ }
+
+/* THIS DOES A CLUSTER TEST TO SEE IF A CHECK RUN IS NEEDED */
+/* TO LOOK FOR UNDISCLOSED MULTIPLICITIES. */
+
+ m = *nperm - *nblock;
+ for (i = 0; i <= m; ++i) {
+ if (val[i + *nblock - 1] - val[i] < tola) {
+ goto L30;
+ }
+ }
+
+/* THIS DOES A CLUSTER TEST TO SEE IF A FINAL RAYLEIGH-RITZ */
+/* PROCEDURE IS NEEDED. */
+
+L790:
+ m = *nperm - *nblock;
+ for (i = 0; i < m; ++i) {
+ if (val[i + *nblock] - val[i] < tola) {
+ *raritz = TRUE_;
+ break;
+ }
+ }
+} /* dnwla_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void dlabax_(n, nband, a, x, y)
+const integer *n, *nband;
+doublereal *a, *x, *y;
+{
+ /* Local variables */
+ static doublereal zero = 0.;
+ static integer i, k, m;
+
+/* THIS SUBROUTINE SETS Y = A*X */
+/* WHERE X AND Y ARE VECTORS OF LENGTH N */
+/* AND A IS AN N X NBAND SYMMETRIC BAND MATRIX */
+
+ dcopy_(n, &zero, &c__0, y, &c__1);
+ for (k = 0; k < *n; ++k) {
+ y[k] += a[k * *nband] * x[k];
+ m = min(*n-k,*nband);
+ for (i = 1; i < m; ++i) {
+ y[k+i] += a[i + k * *nband] * x[k];
+ y[k] += a[i + k * *nband] * x[k+i];
+ }
+ }
+} /* dlabax_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void dlabcm_(n, nband, nl, nr, a, eigval, lde, eigvec, atol, artol, bound, atemp, d, vtemp)
+const integer *n, *nband, *nl, *nr;
+doublereal *a, *eigval;
+const integer *lde;
+doublereal *eigvec, *atol, *artol, *bound, *atemp, *d, *vtemp;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static logical flag_;
+ static doublereal errb;
+ static integer nval, numl;
+ static integer i, j;
+ static doublereal sigma, resid;
+ static doublereal vnorm;
+ static doublereal rq;
+ static integer numvec;
+ static doublereal gap;
+
+/* THIS SUBROUTINE ORGANIZES THE CALCULATION OF THE EIGENVALUES */
+/* FOR THE BNDEIG PACKAGE. EIGENVALUES ARE COMPUTED BY */
+/* A MODIFIED RAYLEIGH QUOTIENT ITERATION. THE EIGENVALUE COUNT */
+/* OBTAINED BY EACH FACTORIZATION IS USED TO OCCASIONALLY OVERRIDE */
+/* THE COMPUTED RAYLEIGH QUOTIENT WITH A DIFFERENT SHIFT TO */
+/* INSURE CONVERGENCE TO THE DESIRED EIGENVALUES. */
+
+/* REPLACE ZERO VECTORS BY RANDOM */
+
+ nval = *nr - *nl + 1;
+ flag_ = FALSE_;
+ for (i = 0; i < nval; ++i) {
+ if (ddot_(n, &eigvec[i * *lde], &c__1, &eigvec[i * *lde], &c__1) == 0.) {
+ dlaran_(n, &eigvec[i * *lde]);
+ }
+ }
+
+/* LOOP OVER EIGENVALUES */
+
+ sigma = bound[(nval << 1) + 1];
+ for (j = 0; j < nval; ++j) {
+ numl = j+1;
+
+/* PREPARE TO COMPUTE FIRST RAYLEIGH QUOTIENT */
+
+L10:
+ dlabax_(n, nband, a, &eigvec[j * *lde], vtemp);
+ vnorm = dnrm2_(n, vtemp, &c__1);
+ if (vnorm != 0.) {
+ d__1 = 1. / vnorm;
+ dscal_(n, &d__1, vtemp, &c__1);
+ dscal_(n, &d__1, &eigvec[j * *lde], &c__1);
+ d__1 = -sigma;
+ daxpy_(n, &d__1, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ }
+
+/* LOOP OVER SHIFTS */
+
+/* COMPUTE RAYLEIGH QUOTIENT, RESIDUAL NORM, AND CURRENT TOLERANCE */
+
+L20:
+ vnorm = dnrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm == 0.) {
+ dlaran_(n, &eigvec[j * *lde]);
+ goto L10;
+ }
+
+ rq = sigma + ddot_(n, &eigvec[j * *lde], &c__1, vtemp, &c__1) / vnorm / vnorm;
+ d__1 = sigma - rq;
+ daxpy_(n, &d__1, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ resid = max(*atol,dnrm2_(n, vtemp, &c__1) / vnorm);
+ d__1 = 1. / vnorm;
+ dscal_(n, &d__1, &eigvec[j * *lde], &c__1);
+
+/* ACCEPT EIGENVALUE IF THE INTERVAL IS SMALL ENOUGH */
+
+ if (bound[(j << 1) + 3] - bound[(j << 1) + 2] < *atol * 3.) {
+ goto L300;
+ }
+
+/* COMPUTE MINIMAL ERROR BOUND */
+
+ errb = resid;
+ gap = min(bound[(j << 1) + 4] - rq,rq - bound[(j << 1) + 1]);
+ if (gap > resid) {
+ errb = max(*atol,resid * resid / gap);
+ }
+
+/* TENTATIVE NEW SHIFT */
+
+ sigma = (bound[(j << 1) + 2] + bound[(j << 1) + 3]) * .5;
+
+/* CHECK FOR TERMINALTION */
+
+ if (resid > *atol * 2.) {
+ goto L40;
+ }
+ if (rq - errb > bound[(j << 1) + 1] && rq + errb < bound[(j << 1) + 4]) {
+ goto L310;
+ }
+
+/* RQ IS TO THE LEFT OF THE INTERVAL */
+
+L40:
+ if (rq >= bound[(j << 1) + 2]) {
+ goto L50;
+ }
+ if (rq - errb > bound[(j << 1) + 1]) {
+ goto L100;
+ }
+ if (rq + errb < bound[(j << 1) + 2]) {
+ dlaran_(n, &eigvec[j * *lde]);
+ }
+ goto L200;
+
+/* RQ IS TO THE RIGHT OF THE INTERVAL */
+
+L50:
+ if (rq <= bound[(j << 1) + 3]) {
+ goto L100;
+ }
+ if (rq + errb < bound[(j << 1) + 4]) {
+ goto L100;
+ }
+
+/* SAVE THE REJECTED VECTOR IF INDICATED */
+
+ if (rq - errb <= bound[(j << 1) + 3]) {
+ goto L200;
+ }
+ for (i = j; i < nval; ++i) {
+ if (bound[(i << 1) + 3] > rq) {
+ dcopy_(n, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ break;
+ }
+ }
+ dlaran_(n, &eigvec[j * *lde]);
+ goto L200;
+
+/* PERTURB RQ TOWARD THE MIDDLE */
+
+L100:
+ if (sigma < rq-errb) {
+ sigma = rq-errb;
+ }
+ if (sigma > rq+errb) {
+ sigma = rq+errb;
+ }
+
+/* FACTOR AND SOLVE */
+
+L200:
+ for (i = j; i < nval; ++i) {
+ if (sigma < bound[(i << 1) + 2]) {
+ break;
+ }
+ }
+ numvec = i - j;
+ numvec = min(numvec,*nband+2);
+ if (resid < *artol) {
+ numvec = min(1,numvec);
+ }
+ dcopy_(n, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ i__1 = (*nband << 1) - 1;
+ dlabfc_(n, nband, a, &sigma, &numvec, lde, &eigvec[j * *lde], &numl, &i__1, atemp, d, atol);
+
+/* PARTIALLY SCALE EXTRA VECTORS TO PREVENT UNDERFLOW OR OVERFLOW */
+
+ for (i = j+1; i < numvec+j; ++i) {
+ d__1 = 1. / vnorm;
+ dscal_(n, &d__1, &eigvec[i * *lde], &c__1);
+ }
+
+/* UPDATE INTERVALS */
+
+ numl -= *nl - 1;
+ if (numl >= 0) {
+ bound[1] = min(bound[1],sigma);
+ }
+ for (i = j; i < nval; ++i) {
+ if (sigma < bound[(i << 1) + 2]) {
+ goto L20;
+ }
+ if (numl <= i)
+ bound[(i << 1) + 2] = sigma;
+ else
+ bound[(i << 1) + 3] = sigma;
+ }
+ if (numl < nval + 1) {
+ if (sigma > bound[(nval << 1) + 2])
+ bound[(nval << 1) + 2] = sigma;
+ }
+ goto L20;
+
+/* ACCEPT AN EIGENPAIR */
+
+L300:
+ dlaran_(n, &eigvec[j * *lde]);
+ flag_ = TRUE_;
+ goto L310;
+
+L305:
+ flag_ = FALSE_;
+ rq = (bound[(j << 1) + 2] + bound[(j << 1) + 3]) * .5;
+ i__1 = (*nband << 1) - 1;
+ dlabfc_(n, nband, a, &rq, &numvec, lde, &eigvec[j * *lde], &numl, &i__1, atemp, d, atol);
+ vnorm = dnrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm != 0.) {
+ d__1 = 1. / vnorm;
+ dscal_(n, &d__1, &eigvec[j * *lde], &c__1);
+ }
+
+/* ORTHOGONALIZE THE NEW EIGENVECTOR AGAINST THE OLD ONES */
+
+L310:
+ eigval[j] = rq;
+ for (i = 0; i < j; ++i) {
+ d__1 = -ddot_(n, &eigvec[i * *lde], &c__1, &eigvec[j * *lde], &c__1);
+ daxpy_(n, &d__1, &eigvec[i * *lde], &c__1, &eigvec[j * *lde], &c__1);
+ }
+ vnorm = dnrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm == 0.) {
+ goto L305;
+ }
+ d__1 = 1. / vnorm;
+ dscal_(n, &d__1, &eigvec[j * *lde], &c__1);
+
+/* ORTHOGONALIZE LATER VECTORS AGAINST THE CONVERGED ONE */
+
+ if (flag_) {
+ goto L305;
+ }
+ for (i = j+1; i < nval; ++i) {
+ d__1 = -ddot_(n, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ daxpy_(n, &d__1, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ }
+ }
+} /* dlabcm_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void dlabfc_(n, nband, a, sigma, number, lde, eigvec, numl, ldad, atemp, d, atol)
+const integer *n, *nband;
+doublereal *a, *sigma;
+const integer *number, *lde;
+doublereal *eigvec;
+integer *numl, *ldad;
+doublereal *atemp, *d, *atol;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal zero=0.;
+ static integer i, j, k, l, m;
+ static integer la, ld, nb1, lpm;
+
+/* THIS SUBROUTINE FACTORS (A-SIGMA*I) WHERE A IS A GIVEN BAND */
+/* MATRIX AND SIGMA IS AN INPUT PARAMETER. IT ALSO SOLVES ZERO */
+/* OR MORE SYSTEMS OF LINEAR EQUATIONS. IT RETURNS THE NUMBER */
+/* OF EIGENVALUES OF A LESS THAN SIGMA BY COUNTING THE STURM */
+/* SEQUENCE DURING THE FACTORIZATION. TO OBTAIN THE STURM */
+/* SEQUENCE COUNT WHILE ALLOWING NON-SYMMETRIC PIVOTING FOR */
+/* STABILITY, THE CODE USES A GUPTA'S MULTIPLE PIVOTING */
+/* ALGORITHM. */
+
+/* INITIALIZE */
+
+ nb1 = *nband - 1;
+ *numl = 0;
+ i__1 = *ldad * *nband;
+ dcopy_(&i__1, &zero, &c__0, d, &c__1);
+
+/* LOOP OVER COLUMNS OF A */
+
+ for (k = 0; k < *n; ++k) {
+
+/* ADD A COLUMN OF A TO D */
+
+ d[nb1 + nb1 * *ldad] = a[k * *nband] - *sigma;
+ m = min(k,nb1);
+ for (i = 0; i < m; ++i) {
+ la = k - i - 1;
+ ld = nb1 - i - 1;
+ d[ld + nb1 * *ldad] = a[i + 1 + la * *nband];
+ }
+
+ m = min(*n-k-1,nb1);
+ for (i = 0; i < m; ++i) {
+ ld = *nband + i;
+ d[ld + nb1 * *ldad] = a[i + 1 + k * *nband];
+ }
+
+/* TERMINATE */
+
+ lpm = 1;
+ for (i = 0; i < nb1; ++i) {
+ l = k - nb1 + i;
+ if (d[i + nb1 * *ldad] == 0.) {
+ continue;
+ }
+ if (abs(d[i + i * *ldad]) >= abs(d[i + nb1 * *ldad])) {
+ goto L50;
+ }
+ if ( (d[i + nb1 * *ldad] < 0. && d[i + i * *ldad] < 0. ) ||
+ (d[i + nb1 * *ldad] > 0. && d[i + i * *ldad] >= 0.) ) {
+ lpm = -lpm;
+ }
+ i__1 = *ldad - i;
+ dswap_(&i__1, &d[i + i * *ldad], &c__1, &d[i + nb1 * *ldad], &c__1);
+ dswap_(number, &eigvec[l], lde, &eigvec[k], lde);
+L50:
+ i__1 = *ldad - i - 1;
+ d__1 = -d[i + nb1 * *ldad] / d[i + i * *ldad];
+ daxpy_(&i__1, &d__1, &d[i + 1 + i * *ldad], &c__1, &d[i + 1 + nb1 * *ldad], &c__1);
+ d__1 = -d[i + nb1 * *ldad] / d[i + i * *ldad];
+ daxpy_(number, &d__1, &eigvec[l], lde, &eigvec[k], lde);
+ }
+
+/* UPDATE STURM SEQUENCE COUNT */
+
+ if (d[nb1 + nb1 * *ldad] < 0.) {
+ lpm = -lpm;
+ }
+ if (lpm < 0) {
+ ++(*numl);
+ }
+ if (k == *n-1) {
+ goto L110;
+ }
+
+/* COPY FIRST COLUMN OF D INTO ATEMP */
+ if (k >= nb1) {
+ l = k - nb1;
+ dcopy_(ldad, d, &c__1, &atemp[l * *ldad], &c__1);
+ }
+
+/* SHIFT THE COLUMNS OF D OVER AND UP */
+
+ for (i = 0; i < nb1; ++i) {
+ i__1 = *ldad - i - 1;
+ dcopy_(&i__1, &d[i + 1 + (i + 1) * *ldad], &c__1, &d[i + i * *ldad], &c__1);
+ d[*ldad - 1 + i * *ldad] = 0.;
+ }
+ }
+
+/* TRANSFER D TO ATEMP */
+
+L110:
+ for (i = 0; i < *nband; ++i) {
+ i__1 = *nband - i;
+ l = *n - i__1;
+ dcopy_(&i__1, &d[i + i * *ldad], &c__1, &atemp[l * *ldad], &c__1);
+ }
+
+/* BACK SUBSTITUTION */
+
+ if (*number == 0) {
+ return;
+ }
+ for (k = *n-1; k >= 0; --k) {
+ if (abs(atemp[k * *ldad]) <= *atol) {
+ atemp[k * *ldad] = d_sign(atol, &atemp[k * *ldad]);
+ }
+
+ for (i = 0; i < *number; ++i) {
+ eigvec[k + i * *lde] /= atemp[k * *ldad];
+ m = min(*ldad-1,k);
+ for (j = 0; j < m; ++j) {
+ l = k - j - 1;
+ eigvec[l + i * *lde] -= atemp[j + 1 + l * *ldad] * eigvec[k + i * *lde];
+ }
+ }
+ }
+} /* dlabfc_ */
+
+
+/* Subroutine */
+static void dlaeig_(n, nband, nl, nr, a, eigval, lde, eigvec, bound, atemp, d, vtemp, eps, tmin, tmax)
+const integer *n, *nband, *nl, *nr;
+doublereal *a, *eigval;
+const integer *lde;
+doublereal *eigvec, *bound, *atemp, *d, *vtemp, *eps, *tmin, *tmax;
+{
+ /* Local variables */
+ static doublereal atol;
+ static integer nval, i;
+ static doublereal artol;
+
+/* THIS IS A SPECIALIZED VERSION OF THE SUBROUTINE BNDEIG TAILORED */
+/* SPECIFICALLY FOR USE BY THE LASO PACKAGE. */
+
+/* SET PARAMETERS */
+
+ atol = *n * *eps * max(*tmax,-(*tmin));
+ artol = atol / sqrt(*eps);
+ nval = *nr - *nl + 1;
+
+/* CHECK FOR SPECIAL CASE OF N = 1 */
+
+ if (*n == 1) {
+ eigval[0] = a[0];
+ eigvec[0] = 1.;
+ return;
+ }
+
+/* SET UP INITIAL EIGENVALUE BOUNDS */
+
+ for (i = 1; i <= nval; ++i) {
+ bound[(i << 1)] = *tmin;
+ bound[(i << 1) + 1] = *tmax;
+ }
+ bound[1] = *tmax;
+ bound[(nval << 1) + 2] = *tmin;
+ if (*nl == 1) {
+ bound[1] = *tmin;
+ }
+ if (*nr == *n) {
+ bound[(nval << 1) + 2] = *tmax;
+ }
+
+ dlabcm_(n, nband, nl, nr, a, eigval, lde, eigvec, &atol, &artol, bound, atemp, d, vtemp);
+} /* dlaeig_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void dlager_(n, nband, nstart, a, tmin, tmax)
+const integer *n, *nband, *nstart;
+doublereal *a, *tmin, *tmax;
+{
+ /* Local variables */
+ static doublereal temp;
+ static integer i, k, l;
+
+/* THIS SUBROUTINE COMPUTES BOUNDS ON THE SPECTRUM OF A BY */
+/* EXAMINING THE GERSCHGORIN CIRCLES. ONLY THE NEWLY CREATED */
+/* CIRCLES ARE EXAMINED */
+
+ for (k = *nstart - 1; k < *n; ++k) {
+ temp = 0.;
+ for (i = 1; i < *nband; ++i) {
+ temp += abs(a[i + k * *nband]);
+ }
+ l = min(k,*nband-1);
+ for (i = 1; i <= l; ++i) {
+ temp += abs(a[i + (k-i) * *nband]);
+ }
+ *tmin = min(*tmin,a[k * *nband] - temp);
+ *tmax = max(*tmax,a[k * *nband] + temp);
+ }
+} /* dlager_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void dlaran_(n, x)
+const integer *n;
+doublereal *x;
+{
+ /* Initialized data */
+ static integer iurand = 0;
+
+ /* Local variables */
+ static integer i;
+
+/* THIS SUBROUTINE SETS THE VECTOR X TO RANDOM NUMBERS */
+
+/* INITIALIZE SEED */
+
+ for (i = 0; i < *n; ++i) {
+ x[i] = urand_(&iurand) - .5;
+ }
+} /* dlaran_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void dmvpc_(nblock, bet, maxj, j, s, number, resnrm, orthcf, rv)
+const integer *nblock;
+const doublereal *bet;
+const integer *maxj, *j;
+const doublereal *s;
+const integer *number;
+doublereal *resnrm, *orthcf, *rv;
+{
+ /* Local variables */
+ static integer i, k, m;
+
+/* THIS SUBROUTINE COMPUTES THE NORM AND THE SMALLEST ELEMENT */
+/* (IN ABSOLUTE VALUE) OF THE VECTOR BET*SJI, WHERE SJI */
+/* IS AN NBLOCK VECTOR OF THE LAST NBLOCK ELEMENTS OF THE ITH */
+/* EIGENVECTOR OF T. THESE QUANTITIES ARE THE RESIDUAL NORM */
+/* AND THE ORTHOGONALITY COEFFICIENT RESPECTIVELY FOR THE */
+/* CORRESPONDING RITZ PAIR. THE ORTHOGONALITY COEFFICIENT IS */
+/* NORMALIZED TO ACCOUNT FOR THE LOCAL REORTHOGONALIZATION. */
+
+ m = *j - *nblock;
+ for (i = 0; i < *number; ++i) {
+ rv[0] = ddot_(nblock, &s[m + i * *maxj], &c__1, &bet[0], nblock);
+ orthcf[i] = abs(rv[0]);
+ for (k = 1; k < *nblock; ++k) {
+ rv[k] = ddot_(nblock, &s[m + i * *maxj], &c__1, &bet[k], nblock);
+ orthcf[i] = min(orthcf[i], abs(rv[k]));
+ }
+ resnrm[i] = dnrm2_(nblock, rv, &c__1);
+ }
+} /* dmvpc_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void dnppla_(op, iovect, n, nperm, nop, nmval, val, nmvec,
+ vec, nblock, h, hv, p, q, bound, d, delta, small, raritz, eps)
+/* Subroutine */
+void (*op) (const integer*,const integer*,const doublereal*,doublereal*);
+/* Subroutine */
+void (*iovect) (const integer*,const integer*,doublereal*,const integer*,const integer*);
+const integer *n, *nperm, *nmval;
+integer *nop;
+doublereal *val;
+const integer *nmvec;
+doublereal *vec;
+const integer *nblock;
+doublereal *h, *hv, *p, *q, *bound, *d, *delta;
+logical *small, *raritz;
+doublereal *eps;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal hmin, hmax, temp;
+ static doublereal zero=0.;
+ static integer i, j, k, l, m;
+ static integer jj, kk;
+
+/* THIS SUBROUTINE POST PROCESSES THE EIGENVECTORS. BLOCK MATRIX */
+/* VECTOR PRODUCTS ARE USED TO MINIMIZED THE NUMBER OF CALLS TO OP. */
+
+/* IF RARITZ IS .TRUE. A FINAL RAYLEIGH-RITZ PROCEDURE IS APPLIED */
+/* TO THE EIGENVECTORS. */
+
+ if (! (*raritz)) {
+ goto L190;
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS CONSTRUCTS H=Q*AQ, WHERE THE COLUMNS OF Q ARE THE */
+/* APPROXIMATE EIGENVECTORS. TEMP = -1 IS USED WHEN SMALL IS */
+/* FALSE TO AVOID HAVING TO RESORT THE EIGENVALUES AND EIGENVECTORS */
+/* COMPUTED BY DLAEIG. */
+
+ i__1 = *nperm * *nperm;
+ dcopy_(&i__1, &zero, &c__0, h, &c__1);
+ temp = -1.;
+ if (*small) {
+ temp = 1.;
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L40;
+ }
+ for (i = 0; i < m; ++i) {
+ dcopy_(n, &vec[i * *nmvec], &c__1, &p[i * *n], &c__1);
+ }
+ (*iovect)(n, &m, p, &m, &c__0);
+ (*op)(n, &m, p, q);
+ ++(*nop);
+ for (i = 0; i < m; ++i) {
+ for (j = i; j < *nperm; ++j) {
+ jj = j - i;
+ h[jj + i * *nperm] = temp * ddot_(n, &vec[j * *nmvec], &c__1, &q[i * *n], &c__1);
+ }
+ }
+ if (*nperm < *nblock) {
+ goto L90;
+ }
+L40:
+ m += *nblock;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ dcopy_(n, &vec[l * *nmvec], &c__1, &p[j * *n], &c__1);
+ }
+ (*iovect)(n, nblock, p, &i, &c__0);
+ (*op)(n, nblock, p, q);
+ ++(*nop);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ for (k = l; k < *nperm; ++k) {
+ kk = k - l;
+ h[kk + l * *nperm] = temp * ddot_(n, &vec[k * *nmvec], &c__1, &q[j * *n], &c__1);
+ }
+ }
+ }
+
+/* THIS COMPUTES THE SPECTRAL DECOMPOSITION OF H. */
+
+L90:
+ hmin = h[0];
+ hmax = h[0];
+ dlager_(nperm, nperm, &c__1, h, &hmin, &hmax);
+ dlaeig_(nperm, nperm, &c__1, nperm, h, val, nperm, hv, bound, p, d, q, eps, &hmin, &hmax);
+
+/* THIS COMPUTES THE RITZ VECTORS--THE COLUMNS OF */
+/* Y = QS WHERE S IS THE MATRIX OF EIGENVECTORS OF H. */
+
+ for (i = 0; i < *nperm; ++i) {
+ dcopy_(n, &zero, &c__0, &vec[i * *nmvec], &c__1);
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L150;
+ }
+ (*iovect)(n, &m, p, &m, &c__1);
+ for (i = 0; i < m; ++i) {
+ for (j = 0; j < *nperm; ++j) {
+ daxpy_(n, &hv[i + j * *nperm], &p[i * *n], &c__1, &vec[j * *nmvec], &c__1);
+ }
+ }
+ if (*nperm < *nblock) {
+ goto L190;
+ }
+L150:
+ m += *nblock;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ (*iovect)(n, nblock, p, &i, &c__1);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ for (k = 0; k < *nperm; ++k) {
+ daxpy_(n, &hv[l + k * *nperm], &p[j * *n], &c__1, &vec[k * *nmvec], &c__1);
+ }
+ }
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES THE RAYLEIGH QUOTIENTS (IN VAL(*,1)) */
+/* AND RESIDUAL NORMS (IN VAL(*,2)) OF THE EIGENVECTORS. */
+
+L190:
+ if (! (*small)) {
+ *delta = -(*delta);
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L220;
+ }
+ for (i = 0; i < m; ++i) {
+ dcopy_(n, &vec[i * *nmvec], &c__1, &p[i * *n], &c__1);
+ }
+ (*op)(n, &m, p, q);
+ ++(*nop);
+ for (i = 0; i < m; ++i) {
+ val[i] = ddot_(n, &p[i * *n], &c__1, &q[i * *n], &c__1);
+ d__1 = -val[i];
+ daxpy_(n, &d__1, &p[i * *n], &c__1, &q[i * *n], &c__1);
+ val[i + *nmval] = dnrm2_(n, &q[i * *n], &c__1);
+ }
+ if (*nperm < *nblock) {
+ goto L260;
+ }
+L220:
+ ++m;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ for (j = 0; j < *nblock; ++j) {
+ l = i - 1 + j;
+ dcopy_(n, &vec[l * *nmvec], &c__1, &p[j * *n], &c__1);
+ }
+ (*op)(n, nblock, p, q);
+ ++(*nop);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - 1 + j;
+ val[l] = ddot_(n, &p[j * *n], &c__1, &q[j * *n], &c__1);
+ d__1 = -val[l];
+ daxpy_(n, &d__1, &p[j * *n], &c__1, &q[j * *n], &c__1);
+ val[l + *nmval] = dnrm2_(n, &q[j * *n], &c__1);
+ }
+ }
+
+/* THIS COMPUTES THE ACCURACY ESTIMATES. FOR CONSISTENCY WITH DILASO */
+
+L260:
+ for (i = 0; i < *nperm; ++i) {
+ temp = *delta - val[i];
+ if (! (*small)) {
+ temp = -temp;
+ }
+ val[i + *nmval * 3] = 0.;
+ if (temp > 0.) {
+ val[i + *nmval * 3] = val[i + *nmval] / temp;
+ }
+ val[i + *nmval * 2] = val[i + *nmval * 3] * val[i + *nmval];
+ }
+
+} /* dnppla_ */
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void dortqr_(nz, n, nblock, z, b)
+const integer *nz, *n, *nblock;
+doublereal *z, *b;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal temp;
+ static integer i, k;
+ static doublereal sigma;
+ static integer length;
+ static doublereal tau;
+
+/* THIS SUBROUTINE COMPUTES THE QR FACTORIZATION OF THE N X NBLOCK */
+/* MATRIX Z. Q IS FORMED IN PLACE AND RETURNED IN Z. R IS */
+/* RETURNED IN B. */
+
+/* THIS SECTION REDUCES Z TO TRIANGULAR FORM. */
+
+ for (i = 0; i < *nblock; ++i) {
+
+/* THIS FORMS THE ITH REFLECTION. */
+
+ length = *n - i;
+ d__1 = dnrm2_(&length, &z[i + i * *nz], &c__1);
+ sigma = d_sign(&d__1, &z[i + i * *nz]);
+ b[i + i * *nblock] = -sigma;
+ z[i + i * *nz] += sigma;
+ tau = sigma * z[i + i * *nz];
+
+/* THIS APPLIES THE ROTATION TO THE REST OF THE COLUMNS. */
+
+ for (k = i+1; k < *nblock; ++k) {
+ if (tau != 0.) {
+ temp = -ddot_(&length, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1) / tau;
+ daxpy_(&length, &temp, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1);
+ }
+ b[i + k * *nblock] = z[i + k * *nz];
+ z[i + k * *nz] = 0.;
+ }
+ }
+
+/* THIS ACCUMULATES THE REFLECTIONS IN REVERSE ORDER. */
+
+ for (i = *nblock-1; i >= 0; --i) {
+
+/* THIS RECREATES THE ITH = NBLOCK-M+1)TH REFLECTION. */
+
+ sigma = -b[i + i * *nblock];
+ tau = z[i + i * *nz] * sigma;
+ if (tau == 0.) {
+ goto L60;
+ }
+ length = *n - i;
+
+/* THIS APPLIES IT TO THE LATER COLUMNS. */
+
+ for (k = i+1; k < *nblock; ++k) {
+ temp = -ddot_(&length, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1) / tau;
+ daxpy_(&length, &temp, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1);
+ }
+ d__1 = -1. / sigma;
+ dscal_(&length, &d__1, &z[i + i * *nz], &c__1);
+L60:
+ z[i + i * *nz] += 1.;
+ }
+} /* dortqr_ */
+
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */
+static void dvsort_(num, val, res, iflag, v, nmvec, n, vec)
+const integer *num;
+doublereal *val, *res;
+const integer *iflag;
+doublereal *v;
+const integer *nmvec, *n;
+doublereal *vec;
+{
+ /* Local variables */
+ static doublereal temp;
+ static integer kk, k, m;
+
+/* THIS SUBROUTINE SORTS THE EIGENVALUES (VAL) IN ASCENDING ORDER */
+/* WHILE CONCURRENTLY SWAPPING THE RESIDUALS AND VECTORS. */
+
+ for (m = *num - 1; m > 0; --m) {
+ for (k = 0; k < m; ++k) {
+ kk = k+1;
+ if (val[k] <= val[kk])
+ continue;
+ temp = val[k]; val[k] = val[kk]; val[kk] = temp;
+ temp = res[k]; res[k] = res[kk]; res[kk] = temp;
+ dswap_(n, &vec[k * *nmvec], &c__1, &vec[kk * *nmvec], &c__1);
+ if (*iflag != 0) {
+ temp = v[k]; v[k] = v[kk]; v[kk] = temp;
+ }
+ }
+ }
+} /* dvsort_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.f
new file mode 100644
index 0000000000000000000000000000000000000000..ff1c07c7dc45317a45a32fd188f3284d3061e6cf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnlaso.f
@@ -0,0 +1,2089 @@
+
+C VERSION 2 DOES NOT USE EISPACK
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE DNLASO(OP, IOVECT, N, NVAL, NFIG, NPERM,
+ * NMVAL, VAL, NMVEC, VEC, NBLOCK, MAXOP, MAXJ, WORK,
+ * IND, IERR)
+C
+ INTEGER N, NVAL, NFIG, NPERM, NMVAL, NMVEC, NBLOCK,
+ * MAXOP, MAXJ, IND(1), IERR
+ DOUBLE PRECISION VEC(NMVEC,1), VAL(NMVAL,1), WORK(1)
+ EXTERNAL OP, IOVECT
+C
+C AUTHOR/IMPLEMENTER D.S.SCOTT-B.N.PARLETT/D.S.SCOTT
+C
+C COMPUTER SCIENCES DEPARTMENT
+C UNIVERSITY OF TEXAS AT AUSTIN
+C AUSTIN, TX 78712
+C
+C VERSION 2 ORIGINATED APRIL 1982
+C
+C CURRENT VERSION JUNE 1983
+C
+C DNLASO FINDS A FEW EIGENVALUES AND EIGENVECTORS AT EITHER END OF
+C THE SPECTRUM OF A LARGE SPARSE SYMMETRIC MATRIX. THE SUBROUTINE
+C DNLASO IS PRIMARILY A DRIVER FOR SUBROUTINE DNWLA WHICH IMPLEMENTS
+C THE LANCZOS ALGORITHM WITH SELECTIVE ORTHOGONALIZATION AND
+C SUBROUTINE DNPPLA WHICH POST PROCESSES THE OUTPUT OF DNWLA.
+C HOWEVER DNLASO DOES CHECK FOR INCONSISTENCIES IN THE CALLING
+C PARAMETERS AND DOES PREPROCESS ANY USER SUPPLIED EIGENPAIRS.
+C DNLASO ALWAYS LOOKS FOR THE SMALLEST (LEFTMOST) EIGENVALUES. IF
+C THE LARGEST EIGENVALUES ARE DESIRED DNLASO IMPLICITLY USES THE
+C NEGATIVE OF THE MATRIX.
+C
+C
+C ON INPUT
+C
+C
+C OP A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE
+C OP(N,M,P,Q). P AND Q ARE N X M MATRICES AND Q IS
+C RETURNED AS THE MATRIX TIMES P.
+C
+C IOVECT A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE
+C IOVECT(N,M,Q,J,K). Q IS AN N X M MATRIX. IF K = 0
+C THE COLUMNS OF Q ARE STORED AS THE (J-M+1)TH THROUGH
+C THE JTH LANCZOS VECTORS. IF K = 1 THEN Q IS RETURNED
+C AS THE (J-M+1)TH THROUGH THE JTH LANCZOS VECTORS. SEE
+C DOCUMENTATION FOR FURTHER DETAILS AND EXAMPLES.
+C
+C N THE ORDER OF THE MATRIX.
+C
+C NVAL NVAL SPECIFIES THE EIGENVALUES TO BE FOUND.
+C DABS(NVAL) IS THE NUMBER OF EIGENVALUES DESIRED.
+C IF NVAL < 0 THE ALGEBRAICALLY SMALLEST (LEFTMOST)
+C EIGENVALUES ARE FOUND. IF NVAL > 0 THE ALGEBRAICALLY
+C LARGEST (RIGHTMOST) EIGENVALUES ARE FOUND. NVAL MUST NOT
+C BE ZERO. DABS(NVAL) MUST BE LESS THAN MAXJ/2.
+C
+C NFIG THE NUMBER OF DECIMAL DIGITS OF ACCURACY DESIRED IN THE
+C EIGENVALUES. NFIG MUST BE GREATER THAN OR EQUAL TO 1.
+C
+C NPERM AN INTEGER VARIABLE WHICH SPECIFIES THE NUMBER OF USER
+C SUPPLIED EIGENPAIRS. IN MOST CASES NPERM WILL BE ZERO. SEE
+C DOCUMENTAION FOR FURTHER DETAILS OF USING NPERM GREATER
+C THAN ZERO. NPERM MUST NOT BE LESS THAN ZERO.
+C
+C NMVAL THE ROW DIMENSION OF THE ARRAY VAL. NMVAL MUST BE GREATER
+C THAN OR EQUAL TO DABS(NVAL).
+C
+C VAL A TWO DIMENSIONAL DOUBLE PRECISION ARRAY OF ROW
+C DIMENSION NMVAL AND COLUMN DIMENSION AT LEAST 4. IF NPERM
+C IS GREATER THAN ZERO THEN CERTAIN INFORMATION MUST BE STORED
+C IN VAL. SEE DOCUMENTATION FOR DETAILS.
+C
+C NMVEC THE ROW DIMENSION OF THE ARRAY VEC. NMVEC MUST BE GREATER
+C THAN OR EQUAL TO N.
+C
+C VEC A TWO DIMENSIONAL DOUBLE PRECISION ARRAY OF ROW
+C DIMENSION NMVEC AND COLUMN DIMENSION AT LEAST DABS(NVAL). IF
+C NPERM > 0 THEN THE FIRST NPERM COLUMNS OF VEC MUST
+C CONTAIN THE USER SUPPLIED EIGENVECTORS.
+C
+C NBLOCK THE BLOCK SIZE. SEE DOCUMENTATION FOR CHOOSING
+C AN APPROPRIATE VALUE FOR NBLOCK. NBLOCK MUST BE GREATER
+C THAN ZERO AND LESS THAN MAXJ/6.
+C
+C MAXOP AN UPPER BOUND ON THE NUMBER OF CALLS TO THE SUBROUTINE
+C OP. DNLASO TERMINATES WHEN MAXOP IS EXCEEDED. SEE
+C DOCUMENTATION FOR GUIDELINES IN CHOOSING A VALUE FOR MAXOP.
+C
+C MAXJ AN INDICATION OF THE AVAILABLE STORAGE (SEE WORK AND
+C DOCUMENTATION ON IOVECT). FOR THE FASTEST CONVERGENCE MAXJ
+C SHOULD BE AS LARGE AS POSSIBLE, ALTHOUGH IT IS USELESS TO HAVE
+C MAXJ LARGER THAN MAXOP*NBLOCK.
+C
+C WORK A DOUBLE PRECISION ARRAY OF DIMENSION AT LEAST AS
+C LARGE AS
+C
+C 2*N*NBLOCK + MAXJ*(NBLOCK+NV+2) + 2*NBLOCK*NBLOCK + 3*NV
+C
+C + THE MAXIMUM OF
+C N*NBLOCK
+C AND
+C MAXJ*(2*NBLOCK+3) + 2*NV + 6 + (2*NBLOCK+2)*(NBLOCK+1)
+C
+C WHERE NV = DABS(NVAL)
+C
+C THE FIRST N*NBLOCK ELEMENTS OF WORK MUST CONTAIN THE DESIRED
+C STARTING VECTORS. SEE DOCUMENTATION FOR GUIDELINES IN
+C CHOOSING STARTING VECTORS.
+C
+C IND AN INTEGER ARRAY OF DIMENSION AT LEAST DABS(NVAL).
+C
+C IERR AN INTEGER VARIABLE.
+C
+C
+C ON OUTPUT
+C
+C
+C NPERM THE NUMBER OF EIGENPAIRS NOW KNOWN.
+C
+C VEC THE FIRST NPERM COLUMNS OF VEC CONTAIN THE EIGENVECTORS.
+C
+C VAL THE FIRST COLUMN OF VAL CONTAINS THE CORRESPONDING
+C EIGENVALUES. THE SECOND COLUMN CONTAINS THE RESIDUAL NORMS OF
+C THE EIGENPAIRS WHICH ARE BOUNDS ON THE ACCURACY OF THE EIGEN-
+C VALUES. THE THIRD COLUMN CONTAINS MORE REALISTIC ESTIMATES
+C OF THE ACCURACY OF THE EIGENVALUES. THE FOURTH COLUMN CONTAINS
+C ESTIMATES OF THE ACCURACY OF THE EIGENVECTORS. SEE
+C DOCUMENTATION FOR FURTHER INFORMATION ON THESE QUANTITIES.
+C
+C WORK IF WORK IS TERMINATED BEFORE COMPLETION (IERR = -2)
+C THE FIRST N*NBLOCK ELEMENTS OF WORK CONTAIN THE BEST VECTORS
+C FOR RESTARTING THE ALGORITHM AND DNLASO CAN BE IMMEDIATELY
+C RECALLED TO CONTINUE WORKING ON THE PROBLEM.
+C
+C IND IND(1) CONTAINS THE ACTUAL NUMBER OF CALLS TO OP. ON SOME
+C OCCASIONS THE NUMBER OF CALLS TO OP MAY BE SLIGHTLY LARGER
+C THAN MAXOP.
+C
+C IERR AN ERROR COMPLETION CODE. THE NORMAL COMPLETION CODE IS
+C ZERO. SEE THE DOCUMENTATION FOR INTERPRETATIONS OF NON-ZERO
+C COMPLETION CODES.
+C
+C
+C INTERNAL VARIABLES.
+C
+C
+ INTEGER I, I1, I2, I3, I4, I5, I6, I7, I8, I9, I10, I11,
+ * I12, I13, M, NBAND, NOP, NV, IABS, MAX0
+ LOGICAL RARITZ, SMALL
+ DOUBLE PRECISION DELTA, EPS, TEMP, DDOT, DNRM2, DABS, TARR(1)
+ EXTERNAL DNPPLA, DNWLA, DMVPC, DORTQR, DAXPY,
+ * DCOPY, DDOT, DNRM2, DSCAL, DSWAP, DLAEIG, DLABCM,
+ * DLABFC, DLAGER, DLARAN, DVSORT
+C
+C NOP RETURNED FROM DNWLA AS THE NUMBER OF CALLS TO THE
+C SUBROUTINE OP.
+C
+C NV SET EQUAL TO DABS(NVAL), THE NUMBER OF EIGENVALUES DESIRED,
+C AND PASSED TO DNWLA.
+C
+C SMALL SET TO .TRUE. IF THE SMALLEST EIGENVALUES ARE DESIRED.
+C
+C RARITZ RETURNED FROM DNWLA AND PASSED TO DNPPLA. RARITZ IS .TRUE.
+C IF A FINAL RAYLEIGH-RITZ PROCEDURE IS NEEDED.
+C
+C DELTA RETURNED FROM DNWLA AS THE EIGENVALUE OF THE MATRIX
+C WHICH IS CLOSEST TO THE DESIRED EIGENVALUES.
+C
+C DNPPLA A SUBROUTINE FOR POST-PROCESSING THE EIGENVECTORS COMPUTED
+C BY DNWLA.
+C
+C DNWLA A SUBROUTINE FOR IMPLEMENTING THE LANCZOS ALGORITHM
+C WITH SELECTIVE ORTHOGONALIZATION.
+C
+C DMVPC A SUBROUTINE FOR COMPUTING THE RESIDUAL NORM AND
+C ORTHOGONALITY COEFFICIENT OF GIVEN RITZ VECTORS.
+C
+C DORTQR A SUBROUTINE FOR ORTHONORMALIZING A BLOCK OF VECTORS
+C USING HOUSEHOLDER REFLECTIONS.
+C
+C DAXPY,DCOPY,DDOT,DNRM2,DSCAL,DSWAP A SUBSET OF THE BASIC LINEAR
+C ALGEBRA SUBPROGRAMS USED FOR VECTOR MANIPULATION.
+C
+C DLARAN A SUBROUTINE TO GENERATE RANDOM VECTORS
+C
+C DLAEIG, DLAGER, DLABCM, DLABFC SUBROUTINES FOR BAND EIGENVALUE
+C CALCULATIONS.
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CHECKS FOR INCONSISTENCY IN THE INPUT PARAMETERS.
+C
+ NV = IABS(NVAL)
+ IND(1) = 0
+ IERR = 0
+ IF (N.LT.6*NBLOCK) IERR = 1
+ IF (NFIG.LE.0) IERR = IERR + 2
+ IF (NMVEC.LT.N) IERR = IERR + 4
+ IF (NPERM.LT.0) IERR = IERR + 8
+ IF (MAXJ.LT.6*NBLOCK) IERR = IERR + 16
+ IF (NV.LT.MAX0(1,NPERM)) IERR = IERR + 32
+ IF (NV.GT.NMVAL) IERR = IERR + 64
+ IF (NV.GT.MAXOP) IERR = IERR + 128
+ IF (NV.GE.MAXJ/2) IERR = IERR + 256
+ IF (NBLOCK.LT.1) IERR = IERR + 512
+ IF (IERR.NE.0) RETURN
+C
+ SMALL = NVAL.LT.0
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION SORTS AND ORTHONORMALIZES THE USER SUPPLIED VECTORS.
+C IF A USER SUPPLIED VECTOR IS ZERO OR IF DSIGNIFICANT CANCELLATION
+C OCCURS IN THE ORTHOGONALIZATION PROCESS THEN IERR IS SET TO -1
+C AND DNLASO TERMINATES.
+C
+ IF (NPERM.EQ.0) GO TO 110
+C
+C THIS NEGATES THE USER SUPPLIED EIGENVALUES WHEN THE LARGEST
+C EIGENVALUES ARE DESIRED, SINCE DNWLA WILL IMPLICITLY USE THE
+C NEGATIVE OF THE MATRIX.
+C
+ IF (SMALL) GO TO 20
+ DO 10 I=1,NPERM
+ VAL(I,1) = -VAL(I,1)
+ 10 CONTINUE
+C
+C THIS SORTS THE USER SUPPLIED VALUES AND VECTORS.
+C
+ 20 CALL DVSORT(NPERM, VAL, VAL(1,2), 0, TARR, NMVEC, N, VEC)
+C
+C THIS STORES THE NORMS OF THE VECTORS FOR LATER COMPARISON.
+C IT ALSO INSURES THAT THE RESIDUAL NORMS ARE POSITIVE.
+C
+ DO 60 I=1,NPERM
+ VAL(I,2) = DABS(VAL(I,2))
+ VAL(I,3) = DNRM2(N,VEC(1,I),1)
+ 60 CONTINUE
+C
+C THIS PERFORMS THE ORTHONORMALIZATION.
+C
+ M = N*NBLOCK + 1
+ CALL DORTQR(NMVEC, N, NPERM, VEC, WORK(M))
+ M = N*NBLOCK - NPERM
+ DO 70 I = 1, NPERM
+ M = M + NPERM + 1
+ IF(DABS(WORK(M)) .GT. 0.9*VAL(I,3)) GO TO 70
+ IERR = -1
+ RETURN
+C
+ 70 CONTINUE
+C
+C THIS COPIES THE RESIDUAL NORMS INTO THE CORRECT LOCATIONS IN
+C THE ARRAY WORK FOR LATER REFERENCE IN DNWLA.
+C
+ M = 2*N*NBLOCK + 1
+ CALL DCOPY(NPERM, VAL(1,2), 1, WORK(M), 1)
+C
+C THIS SETS EPS TO AN APPROXIMATION OF THE RELATIVE MACHINE
+C PRECISION
+C
+C ***THIS SHOULD BE REPLACED BY AN ASDSIGNMENT STATEMENT
+C ***IN A PRODUCTION CODE
+C
+ 110 EPS = 1.0D0
+ DO 120 I = 1,1000
+ EPS = 0.5D0*EPS
+ TEMP = 1.0D0 + EPS
+ IF(TEMP.EQ.1.0D0) GO TO 130
+ 120 CONTINUE
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CALLS DNWLA WHICH IMPLEMENTS THE LANCZOS ALGORITHM
+C WITH SELECTIVE ORTHOGONALIZATION.
+C
+ 130 NBAND = NBLOCK + 1
+ I1 = 1 + N*NBLOCK
+ I2 = I1 + N*NBLOCK
+ I3 = I2 + NV
+ I4 = I3 + NV
+ I5 = I4 + NV
+ I6 = I5 + MAXJ*NBAND
+ I7 = I6 + NBLOCK*NBLOCK
+ I8 = I7 + NBLOCK*NBLOCK
+ I9 = I8 + MAXJ*(NV+1)
+ I10 = I9 + NBLOCK
+ I11 = I10 + 2*NV + 6
+ I12 = I11 + MAXJ*(2*NBLOCK+1)
+ I13 = I12 + MAXJ
+ CALL DNWLA(OP, IOVECT, N, NBAND, NV, NFIG, NPERM, VAL, NMVEC,
+ * VEC, NBLOCK, MAXOP, MAXJ, NOP, WORK(1), WORK(I1),
+ * WORK(I2), WORK(I3), WORK(I4), WORK(I5), WORK(I6),
+ * WORK(I7), WORK(I8), WORK(I9), WORK(I10), WORK(I11),
+ * WORK(I12), WORK(I13), IND, SMALL, RARITZ, DELTA, EPS, IERR)
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CALLS DNPPLA (THE POST PROCESSOR).
+C
+ IF (NPERM.EQ.0) GO TO 140
+ I1 = N*NBLOCK + 1
+ I2 = I1 + NPERM*NPERM
+ I3 = I2 + NPERM*NPERM
+ I4 = I3 + MAX0(N*NBLOCK,2*NPERM*NPERM)
+ I5 = I4 + N*NBLOCK
+ I6 = I5 + 2*NPERM + 4
+ CALL DNPPLA(OP, IOVECT, N, NPERM, NOP, NMVAL, VAL, NMVEC,
+ * VEC, NBLOCK, WORK(I1), WORK(I2), WORK(I3), WORK(I4),
+ * WORK(I5), WORK(I6), DELTA, SMALL, RARITZ, EPS)
+C
+ 140 IND(1) = NOP
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE DNWLA(OP, IOVECT, N, NBAND, NVAL, NFIG, NPERM, VAL,
+ * NMVEC, VEC, NBLOCK, MAXOP, MAXJ, NOP, P1, P0,
+ * RES, TAU, OTAU, T, ALP, BET, S, P2, BOUND, ATEMP, VTEMP, D,
+ * IND, SMALL, RARITZ, DELTA, EPS, IERR)
+C
+ INTEGER N, NBAND, NVAL, NFIG, NPERM, NMVEC, NBLOCK, MAXOP, MAXJ,
+ * NOP, IND(1), IERR
+ LOGICAL RARITZ, SMALL
+ DOUBLE PRECISION VAL(1), VEC(NMVEC,1), P0(N,1), P1(N,1),
+ * P2(N,1), RES(1), TAU(1), OTAU(1), T(NBAND,1),
+ * ALP(NBLOCK,1), BET(NBLOCK,1), BOUND(1), ATEMP(1),
+ * VTEMP(1), D(1), S(MAXJ,1), DELTA, EPS
+ EXTERNAL OP, IOVECT
+C
+C DNWLA IMPLEMENTS THE LANCZOS ALGORITHM WITH SELECTIVE
+C ORTHOGONALIZATION.
+C
+C NBAND NBLOCK + 1 THE BAND WIDTH OF T.
+C
+C NVAL THE NUMBER OF DESIRED EIGENVALUES.
+C
+C NPERM THE NUMBER OF PERMANENT VECTORS (THOSE EIGENVECTORS
+C INPUT BY THE USER OR THOSE EIGENVECTORS SAVED WHEN THE
+C ALGORITHM IS ITERATED). PERMANENT VECTORS ARE ORTHOGONAL
+C TO THE CURRENT KRYLOV SUBSPACE.
+C
+C NOP THE NUMBER OF CALLS TO OP.
+C
+C P0, P1, AND P2 THE CURRENT BLOCKS OF LANCZOS VECTORS.
+C
+C RES THE (APPROXIMATE) RESIDUAL NORMS OF THE PERMANENT VECTORS.
+C
+C TAU AND OTAU USED TO MONITOR THE NEED FOR ORTHOGONALIZATION.
+C
+C T THE BAND MATRIX.
+C
+C ALP THE CURRENT DIAGONAL BLOCK.
+C
+C BET THE CURRENT OFF DIAGONAL BLOCK.
+C
+C BOUND, ATEMP, VTEMP, D TEMPORARY STORAGE USED BY THE BAND
+C EIGENVALUE SOLVER DLAEIG.
+C
+C S EIGENVECTORS OF T.
+C
+C SMALL .TRUE. IF THE SMALL EIGENVALUES ARE DESIRED.
+C
+C RARITZ RETURNED AS .TRUE. IF A FINAL RAYLEIGH-RITZ PROCEDURE
+C IS TO BE DONE.
+C
+C DELTA RETURNED AS THE VALUE OF THE (NVAL+1)TH EIGENVALUE
+C OF THE MATRIX. USED IN ESTIMATING THE ACCURACY OF THE
+C COMPUTED EIGENVALUES.
+C
+C
+C INTERNAL VARIABLES USED
+C
+ INTEGER I, I1, II, J, K, L, M, NG, NGOOD,
+ * NLEFT, NSTART, NTHETA, NUMBER, MIN0, MTEMP
+ LOGICAL ENOUGH, TEST
+ DOUBLE PRECISION ALPMAX, ALPMIN, ANORM, BETMAX, BETMIN,
+ * EPSRT, PNORM, RNORM, TEMP,
+ * TMAX, TMIN, TOLA, TOLG, UTOL, DABS,
+ * DMAX1, DMIN1, DSQRT, DDOT, DNRM2, TARR(1), DZERO(1)
+ EXTERNAL DMVPC, DORTQR, DAXPY, DCOPY, DDOT,
+ * DNRM2, DSCAL, DSWAP, DLAEIG, DLAGER, DLARAN, DVSORT
+C
+C J THE CURRENT DIMENSION OF T. (THE DIMENSION OF THE CURRENT
+C KRYLOV SUBSPACE.
+C
+C NGOOD THE NUMBER OF GOOD RITZ VECTORS (GOOD VECTORS
+C LIE IN THE CURRENT KRYLOV SUBSPACE).
+C
+C NLEFT THE NUMBER OF VALUES WHICH REMAIN TO BE DETERMINED,
+C I.E. NLEFT = NVAL - NPERM.
+C
+C NUMBER = NPERM + NGOOD.
+C
+C ANORM AN ESTIMATE OF THE NORM OF THE MATRIX.
+C
+C EPS THE RELATIVE MACHINE PRECISION.
+C
+C UTOL THE USER TOLERANCE.
+C
+C TARR AN ARRAY OF LENGTH ONE USED TO INSURE TYPE CONSISTENCY IN CALLS TO
+C DLAEIG
+C
+C DZERO AN ARRAY OF LENGTH ONE CONTAINING DZERO, USED TO INSURE TYPE
+C CONSISTENCY IN CALLS TO DCOPY
+C
+ DZERO(1) = 0.0D0
+ RNORM = 0.0D0
+ IF (NPERM.NE.0) RNORM = DMAX1(-VAL(1),VAL(NPERM))
+ PNORM = RNORM
+ DELTA = 10.D30
+ EPSRT = DSQRT(EPS)
+ NLEFT = NVAL - NPERM
+ NOP = 0
+ NUMBER = NPERM
+ RARITZ = .FALSE.
+ UTOL = DMAX1(DBLE(FLOAT(N))*EPS,10.0D0**DBLE((-FLOAT(NFIG))))
+ J = MAXJ
+C
+C ------------------------------------------------------------------
+C
+C ANY ITERATION OF THE ALGORITHM BEGINS HERE.
+C
+ 30 DO 50 I=1,NBLOCK
+ TEMP = DNRM2(N,P1(1,I),1)
+ IF (TEMP.EQ.0D0) CALL DLARAN(N, P1(1,I))
+ 50 CONTINUE
+ IF (NPERM.EQ.0) GO TO 70
+ DO 60 I=1,NPERM
+ TAU(I) = 1.0D0
+ OTAU(I) = 0.0D0
+ 60 CONTINUE
+ 70 CALL DCOPY(N*NBLOCK, DZERO, 0, P0, 1)
+ CALL DCOPY(NBLOCK*NBLOCK, DZERO, 0, BET, 1)
+ CALL DCOPY(J*NBAND, DZERO, 0, T, 1)
+ MTEMP = NVAL + 1
+ DO 75 I = 1, MTEMP
+ CALL DCOPY(J, DZERO, 0, S(1,I), 1)
+ 75 CONTINUE
+ NGOOD = 0
+ TMIN = 1.0D30
+ TMAX = -1.0D30
+ TEST = .TRUE.
+ ENOUGH = .FALSE.
+ BETMAX = 0.0D0
+ J = 0
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION TAKES A SINGLE BLOCK LANCZOS STEP.
+C
+ 80 J = J + NBLOCK
+C
+C THIS IS THE SELECTIVE ORTHOGONALIZATION.
+C
+ IF (NUMBER.EQ.0) GO TO 110
+ DO 100 I=1,NUMBER
+ IF (TAU(I).LT.EPSRT) GO TO 100
+ TEST = .TRUE.
+ TAU(I) = 0.0D0
+ IF (OTAU(I).NE.0.0D0) OTAU(I) = 1.0D0
+ DO 90 K=1,NBLOCK
+ TEMP = -DDOT(N,VEC(1,I),1,P1(1,K),1)
+ CALL DAXPY(N, TEMP, VEC(1,I), 1, P1(1,K), 1)
+C
+C THIS CHECKS FOR TOO GREAT A LOSS OF ORTHOGONALITY BETWEEN A
+C NEW LANCZOS VECTOR AND A GOOD RITZ VECTOR. THE ALGORITHM IS
+C TERMINATED IF TOO MUCH ORTHOGONALITY IS LOST.
+C
+ IF (DABS(TEMP*BET(K,K)).GT.DBLE(FLOAT(N))*EPSRT*
+ * ANORM .AND. I.GT.NPERM) GO TO 380
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C IF NECESSARY, THIS REORTHONORMALIZES P1 AND UPDATES BET.
+C
+ 110 IF(.NOT. TEST) GO TO 160
+ CALL DORTQR(N, N, NBLOCK, P1, ALP)
+ TEST = .FALSE.
+ IF(J .EQ. NBLOCK) GO TO 160
+ DO 130 I = 1,NBLOCK
+ IF(ALP(I,I) .GT. 0.0D0) GO TO 130
+ M = J - 2*NBLOCK + I
+ L = NBLOCK + 1
+ DO 120 K = I,NBLOCK
+ BET(I,K) = -BET(I,K)
+ T(L,M) = -T(L,M)
+ L = L - 1
+ M = M + 1
+ 120 CONTINUE
+ 130 CONTINUE
+C
+C THIS IS THE LANCZOS STEP.
+C
+ 160 CALL OP(N, NBLOCK, P1, P2)
+ NOP = NOP + 1
+ CALL IOVECT(N, NBLOCK, P1, J, 0)
+C
+C THIS COMPUTES P2=P2-P0*BET(TRANSPOSE)
+C
+ DO 180 I=1,NBLOCK
+ DO 170 K=I,NBLOCK
+ CALL DAXPY(N, -BET(I,K), P0(1,K), 1, P2(1,I), 1)
+ 170 CONTINUE
+ 180 CONTINUE
+C
+C THIS COMPUTES ALP AND P2=P2-P1*ALP.
+C
+ DO 200 I=1,NBLOCK
+ DO 190 K=1,I
+ II = I - K + 1
+ ALP(II,K) = DDOT(N,P1(1,I),1,P2(1,K),1)
+ CALL DAXPY(N, -ALP(II,K), P1(1,I), 1, P2(1,K), 1)
+ IF (K.NE.I) CALL DAXPY(N, -ALP(II,K), P1(1,K),
+ * 1, P2(1,I), 1)
+ 190 CONTINUE
+ 200 CONTINUE
+C
+C REORTHOGONALIZATION OF THE SECOND BLOCK
+C
+ IF(J .NE. NBLOCK) GO TO 220
+ DO 215 I=1,NBLOCK
+ DO 210 K=1,I
+ TEMP = DDOT(N,P1(1,I),1,P2(1,K),1)
+ CALL DAXPY(N, -TEMP, P1(1,I), 1, P2(1,K), 1)
+ IF (K.NE.I) CALL DAXPY(N, -TEMP, P1(1,K),
+ * 1, P2(1,I), 1)
+ II = I - K + 1
+ ALP(II,K) = ALP(II,K) + TEMP
+ 210 CONTINUE
+ 215 CONTINUE
+C
+C THIS ORTHONORMALIZES THE NEXT BLOCK
+C
+ 220 CALL DORTQR(N, N, NBLOCK, P2, BET)
+C
+C THIS STORES ALP AND BET IN T.
+C
+ DO 250 I=1,NBLOCK
+ M = J - NBLOCK + I
+ DO 230 K=I,NBLOCK
+ L = K - I + 1
+ T(L,M) = ALP(L,I)
+ 230 CONTINUE
+ DO 240 K=1,I
+ L = NBLOCK - I + K + 1
+ T(L,M) = BET(K,I)
+ 240 CONTINUE
+ 250 CONTINUE
+C
+C THIS NEGATES T IF SMALL IS FALSE.
+C
+ IF (SMALL) GO TO 280
+ M = J - NBLOCK + 1
+ DO 270 I=M,J
+ DO 260 K=1,L
+ T(K,I) = -T(K,I)
+ 260 CONTINUE
+ 270 CONTINUE
+C
+C THIS SHIFTS THE LANCZOS VECTORS
+C
+ 280 CALL DCOPY(NBLOCK*N, P1, 1, P0, 1)
+ CALL DCOPY(NBLOCK*N, P2, 1, P1, 1)
+ CALL DLAGER(J, NBAND, J-NBLOCK+1, T, TMIN, TMAX)
+ ANORM = DMAX1(RNORM, TMAX, -TMIN)
+ IF (NUMBER.EQ.0) GO TO 305
+C
+C THIS COMPUTES THE EXTREME EIGENVALUES OF ALP.
+C
+ CALL DCOPY(NBLOCK, DZERO, 0, P2, 1)
+ CALL DLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
+ 1 P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ ALPMIN = TARR(1)
+ CALL DCOPY(NBLOCK, DZERO, 0, P2, 1)
+ CALL DLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
+ 1 NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ ALPMAX = TARR(1)
+C
+C THIS COMPUTES ALP = BET(TRANSPOSE)*BET.
+C
+ 305 DO 310 I = 1, NBLOCK
+ DO 300 K = 1, I
+ L = I - K + 1
+ ALP(L,K) = DDOT(NBLOCK-I+1, BET(I,I), NBLOCK, BET(K,I),
+ 1 NBLOCK)
+ 300 CONTINUE
+ 310 CONTINUE
+ IF(NUMBER .EQ. 0) GO TO 330
+C
+C THIS COMPUTES THE SMALLEST SINGULAR VALUE OF BET.
+C
+ CALL DCOPY(NBLOCK, DZERO, 0, P2, 1)
+ CALL DLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
+ 1 P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0D0, ANORM*ANORM)
+ BETMIN = DSQRT(TARR(1))
+C
+C THIS UPDATES TAU AND OTAU.
+C
+ DO 320 I=1,NUMBER
+ TEMP = (TAU(I)*DMAX1(ALPMAX-VAL(I),VAL(I)-ALPMIN)
+ * +OTAU(I)*BETMAX+EPS*ANORM)/BETMIN
+ IF (I.LE.NPERM) TEMP = TEMP + RES(I)/BETMIN
+ OTAU(I) = TAU(I)
+ TAU(I) = TEMP
+ 320 CONTINUE
+C
+C THIS COMPUTES THE LARGEST SINGULAR VALUE OF BET.
+C
+ 330 CALL DCOPY(NBLOCK, DZERO, 0, P2, 1)
+ CALL DLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
+ 1 NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0D0,
+ 2 ANORM*ANORM)
+ BETMAX = DSQRT(TARR(1))
+ IF (J.LE.2*NBLOCK) GO TO 80
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES AND EXAMINES THE SMALLEST NONGOOD AND
+C LARGEST DESIRED EIGENVALUES OF T TO SEE IF A CLOSER LOOK
+C IS JUSTIFIED.
+C
+ TOLG = EPSRT*ANORM
+ TOLA = UTOL*RNORM
+ IF(MAXJ-J .LT. NBLOCK .OR. (NOP .GE. MAXOP .AND.
+ 1 NLEFT .NE. 0)) GO TO 390
+ GO TO 400
+
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES SOME EIGENVALUES AND EIGENVECTORS OF T TO
+C SEE IF FURTHER ACTION IS INDICATED, ENTRY IS AT 380 OR 390 IF AN
+C ITERATION (OR TERMINATION) IS KNOWN TO BE NEEDED, OTHERWISE ENTRY
+C IS AT 400.
+C
+ 380 J = J - NBLOCK
+ IERR = -8
+ 390 IF (NLEFT.EQ.0) RETURN
+ TEST = .TRUE.
+ 400 NTHETA = MIN0(J/2,NLEFT+1)
+ CALL DLAEIG(J, NBAND, 1, NTHETA, T, VAL(NUMBER+1),
+ 1 MAXJ, S, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ CALL DMVPC(NBLOCK, BET, MAXJ, J, S, NTHETA, ATEMP, VTEMP, D)
+C
+C THIS CHECKS FOR TERMINATION OF A CHECK RUN
+C
+ IF(NLEFT .NE. 0 .OR. J .LT. 6*NBLOCK) GO TO 410
+ IF(VAL(NUMBER+1)-ATEMP(1) .GT. VAL(NPERM) - TOLA) GO TO 790
+C
+C THIS UPDATES NLEFT BY EXAMINING THE COMPUTED EIGENVALUES OF T
+C TO DETERMINE IF SOME PERMANENT VALUES ARE NO LONGER DESIRED.
+C
+ 410 IF (NTHETA.LE.NLEFT) GO TO 470
+ IF (NPERM.EQ.0) GO TO 430
+ M = NUMBER + NLEFT + 1
+ IF (VAL(M).GE.VAL(NPERM)) GO TO 430
+ NPERM = NPERM - 1
+ NGOOD = 0
+ NUMBER = NPERM
+ NLEFT = NLEFT + 1
+ GO TO 400
+C
+C THIS UPDATES DELTA.
+C
+ 430 M = NUMBER + NLEFT + 1
+ DELTA = DMIN1(DELTA,VAL(M))
+ ENOUGH = .TRUE.
+ IF(NLEFT .EQ. 0) GO TO 80
+ NTHETA = NLEFT
+ VTEMP(NTHETA+1) = 1
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION EXAMINES THE COMPUTED EIGENPAIRS IN DETAIL.
+C
+C THIS CHECKS FOR ENOUGH ACCEPTABLE VALUES.
+C
+ IF (.NOT.(TEST .OR. ENOUGH)) GO TO 470
+ DELTA = DMIN1(DELTA,ANORM)
+ PNORM = DMAX1(RNORM,DMAX1(-VAL(NUMBER+1),DELTA))
+ TOLA = UTOL*PNORM
+ NSTART = 0
+ DO 460 I=1,NTHETA
+ M = NUMBER + I
+ IF (DMIN1(ATEMP(I)*ATEMP(I)/(DELTA-VAL(M)),ATEMP(I))
+ * .GT.TOLA) GO TO 450
+ IND(I) = -1
+ GO TO 460
+C
+ 450 ENOUGH = .FALSE.
+ IF (.NOT.TEST) GO TO 470
+ IND(I) = 1
+ NSTART = NSTART + 1
+ 460 CONTINUE
+C
+C COPY VALUES OF IND INTO VTEMP
+C
+ DO 465 I = 1,NTHETA
+ VTEMP(I) = DBLE(FLOAT(IND(I)))
+ 465 CONTINUE
+ GO TO 500
+C
+C THIS CHECKS FOR NEW GOOD VECTORS.
+C
+ 470 NG = 0
+ DO 490 I=1,NTHETA
+ IF (VTEMP(I).GT.TOLG) GO TO 480
+ NG = NG + 1
+ VTEMP(I) = -1
+ GO TO 490
+C
+ 480 VTEMP(I) = 1
+ 490 CONTINUE
+C
+ IF (NG.LE.NGOOD) GO TO 80
+ NSTART = NTHETA - NG
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES AND NORMALIZES THE INDICATED RITZ VECTORS.
+C IF NEEDED (TEST = .TRUE.), NEW STARTING VECTORS ARE COMPUTED.
+C
+ 500 TEST = TEST .AND. .NOT.ENOUGH
+ NGOOD = NTHETA - NSTART
+ NSTART = NSTART + 1
+ NTHETA = NTHETA + 1
+C
+C THIS ALIGNS THE DESIRED (ACCEPTABLE OR GOOD) EIGENVALUES AND
+C EIGENVECTORS OF T. THE OTHER EIGENVECTORS ARE SAVED FOR
+C FORMING STARTING VECTORS, IF NECESSARY. IT ALSO SHIFTS THE
+C EIGENVALUES TO OVERWRITE THE GOOD VALUES FROM THE PREVIOUS
+C PAUSE.
+C
+ CALL DCOPY(NTHETA, VAL(NUMBER+1), 1, VAL(NPERM+1), 1)
+ IF (NSTART.EQ.0) GO TO 580
+ IF (NSTART.EQ.NTHETA) GO TO 530
+ CALL DVSORT(NTHETA, VTEMP, ATEMP, 1, VAL(NPERM+1), MAXJ,
+ * J, S)
+C
+C THES ACCUMULATES THE J-VECTORS USED TO FORM THE STARTING
+C VECTORS.
+C
+ 530 IF (.NOT.TEST) NSTART = 0
+ IF (.NOT.TEST) GO TO 580
+C
+C FIND MINIMUM ATEMP VALUE TO AVOID POSSIBLE OVERFLOW
+C
+ TEMP = ATEMP(1)
+ DO 535 I = 1, NSTART
+ TEMP = DMIN1(TEMP, ATEMP(I))
+ 535 CONTINUE
+ M = NGOOD + 1
+ L = NGOOD + MIN0(NSTART,NBLOCK)
+ DO 540 I=M,L
+ CALL DSCAL(J, TEMP/ATEMP(I), S(1,I), 1)
+ 540 CONTINUE
+ M = (NSTART-1)/NBLOCK
+ IF (M.EQ.0) GO TO 570
+ L = NGOOD + NBLOCK
+ DO 560 I=1,M
+ DO 550 K=1,NBLOCK
+ L = L + 1
+ IF (L.GT.NTHETA) GO TO 570
+ I1 = NGOOD + K
+ CALL DAXPY(J, TEMP/ATEMP(L), S(1,L), 1, S(1,I1), 1)
+ 550 CONTINUE
+ 560 CONTINUE
+ 570 NSTART = MIN0(NSTART,NBLOCK)
+C
+C THIS STORES THE RESIDUAL NORMS OF THE NEW PERMANENT VECTORS.
+C
+ 580 IF (NGOOD.EQ.0 .OR. .NOT.(TEST .OR. ENOUGH)) GO TO 600
+ DO 590 I=1,NGOOD
+ M = NPERM + I
+ RES(M) = ATEMP(I)
+ 590 CONTINUE
+C
+C THIS COMPUTES THE RITZ VECTORS BY SEQUENTIALLY RECALLING THE
+C LANCZOS VECTORS.
+C
+ 600 NUMBER = NPERM + NGOOD
+ IF (TEST .OR. ENOUGH) CALL DCOPY(N*NBLOCK, DZERO, 0, P1, 1)
+ IF (NGOOD.EQ.0) GO TO 620
+ M = NPERM + 1
+ DO 610 I=M,NUMBER
+ CALL DCOPY(N, DZERO, 0, VEC(1,I), 1)
+ 610 CONTINUE
+ 620 DO 670 I=NBLOCK,J,NBLOCK
+ CALL IOVECT(N, NBLOCK, P2, I, 1)
+ DO 660 K=1,NBLOCK
+ M = I - NBLOCK + K
+ IF (NSTART.EQ.0) GO TO 640
+ DO 630 L=1,NSTART
+ I1 = NGOOD + L
+ CALL DAXPY(N, S(M,I1), P2(1,K), 1, P1(1,L), 1)
+ 630 CONTINUE
+ 640 IF (NGOOD.EQ.0) GO TO 660
+ DO 650 L=1,NGOOD
+ I1 = L + NPERM
+ CALL DAXPY(N, S(M,L), P2(1,K), 1, VEC(1,I1), 1)
+ 650 CONTINUE
+ 660 CONTINUE
+ 670 CONTINUE
+ IF (TEST .OR. ENOUGH) GO TO 690
+C
+C THIS NORMALIZES THE RITZ VECTORS AND INITIALIZES THE
+C TAU RECURRENCE.
+C
+ M = NPERM + 1
+ DO 680 I=M,NUMBER
+ TEMP = 1.0D0/DNRM2(N,VEC(1,I),1)
+ CALL DSCAL(N, TEMP, VEC(1,I), 1)
+ TAU(I) = 1.0D0
+ OTAU(I) = 1.0D0
+ 680 CONTINUE
+C
+C SHIFT S VECTORS TO ALIGN FOR LATER CALL TO DLAEIG
+C
+ CALL DCOPY(NTHETA, VAL(NPERM+1), 1, VTEMP, 1)
+ CALL DVSORT(NTHETA, VTEMP, ATEMP, 0, TARR, MAXJ, J, S)
+ GO TO 80
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION PREPARES TO ITERATE THE ALGORITHM BY SORTING THE
+C PERMANENT VALUES, RESETTING SOME PARAMETERS, AND ORTHONORMALIZING
+C THE PERMANENT VECTORS.
+C
+ 690 IF (NGOOD.EQ.0 .AND. NOP.GE.MAXOP) GO TO 810
+ IF (NGOOD.EQ.0) GO TO 30
+C
+C THIS ORTHONORMALIZES THE VECTORS
+C
+ CALL DORTQR(NMVEC, N, NPERM+NGOOD, VEC, S)
+C
+C THIS SORTS THE VALUES AND VECTORS.
+C
+ IF(NPERM .NE. 0) CALL DVSORT(NPERM+NGOOD, VAL, RES, 0, TEMP,
+ * NMVEC, N, VEC)
+ NPERM = NPERM + NGOOD
+ NLEFT = NLEFT - NGOOD
+ RNORM = DMAX1(-VAL(1),VAL(NPERM))
+C
+C THIS DECIDES WHERE TO GO NEXT.
+C
+ IF (NOP.GE.MAXOP .AND. NLEFT.NE.0) GO TO 810
+ IF (NLEFT.NE.0) GO TO 30
+ IF (VAL(NVAL)-VAL(1).LT.TOLA) GO TO 790
+C
+C THIS DOES A CLUSTER TEST TO SEE IF A CHECK RUN IS NEEDED
+C TO LOOK FOR UNDISCLOSED MULTIPLICITIES.
+C
+ M = NPERM - NBLOCK + 1
+ IF (M.LE.0) RETURN
+ DO 780 I=1,M
+ L = I + NBLOCK - 1
+ IF (VAL(L)-VAL(I).LT.TOLA) GO TO 30
+ 780 CONTINUE
+C
+C THIS DOES A CLUSTER TEST TO SEE IF A FINAL RAYLEIGH-RITZ
+C PROCEDURE IS NEEDED.
+C
+ 790 M = NPERM - NBLOCK
+ IF (M.LE.0) RETURN
+ DO 800 I=1,M
+ L = I + NBLOCK
+ IF (VAL(L)-VAL(I).GE.TOLA) GO TO 800
+ RARITZ = .TRUE.
+ RETURN
+ 800 CONTINUE
+C
+ RETURN
+C
+C ------------------------------------------------------------------
+C
+C THIS REPORTS THAT MAXOP WAS EXCEEDED.
+C
+ 810 IERR = -2
+ GO TO 790
+C
+ END
+ SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
+C
+C CONSTANT TIMES A VECTOR PLUS A VECTOR.
+C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
+C JACK DONGARRA, LINPACK, 3/11/78.
+C
+ DOUBLE PRECISION DX(1),DY(1),DA
+ INTEGER I,INCX,INCY,IX,IY,M,MP1,N
+C
+ IF(N.LE.0)RETURN
+ IF (DA .EQ. 0.0D0) RETURN
+ IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
+C
+C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
+C NOT EQUAL TO 1
+C
+ IX = 1
+ IY = 1
+ IF(INCX.LT.0)IX = (-N+1)*INCX + 1
+ IF(INCY.LT.0)IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DY(IY) = DY(IY) + DA*DX(IX)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C
+C CLEAN-UP LOOP
+C
+ 20 M = MOD(N,4)
+ IF( M .EQ. 0 ) GO TO 40
+ DO 30 I = 1,M
+ DY(I) = DY(I) + DA*DX(I)
+ 30 CONTINUE
+ IF( N .LT. 4 ) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,4
+ DY(I) = DY(I) + DA*DX(I)
+ DY(I + 1) = DY(I + 1) + DA*DX(I + 1)
+ DY(I + 2) = DY(I + 2) + DA*DX(I + 2)
+ DY(I + 3) = DY(I + 3) + DA*DX(I + 3)
+ 50 CONTINUE
+ RETURN
+ END
+ SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
+C
+C COPIES A VECTOR, X, TO A VECTOR, Y.
+C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
+C JACK DONGARRA, LINPACK, 3/11/78.
+C
+ DOUBLE PRECISION DX(1),DY(1)
+ INTEGER I,INCX,INCY,IX,IY,M,MP1,N
+C
+ IF(N.LE.0)RETURN
+ IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
+C
+C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
+C NOT EQUAL TO 1
+C
+ IX = 1
+ IY = 1
+ IF(INCX.LT.0)IX = (-N+1)*INCX + 1
+ IF(INCY.LT.0)IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DY(IY) = DX(IX)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C
+C CLEAN-UP LOOP
+C
+ 20 M = MOD(N,7)
+ IF( M .EQ. 0 ) GO TO 40
+ DO 30 I = 1,M
+ DY(I) = DX(I)
+ 30 CONTINUE
+ IF( N .LT. 7 ) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,7
+ DY(I) = DX(I)
+ DY(I + 1) = DX(I + 1)
+ DY(I + 2) = DX(I + 2)
+ DY(I + 3) = DX(I + 3)
+ DY(I + 4) = DX(I + 4)
+ DY(I + 5) = DX(I + 5)
+ DY(I + 6) = DX(I + 6)
+ 50 CONTINUE
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
+C
+C FORMS THE DOT PRODUCT OF TWO VECTORS.
+C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
+C JACK DONGARRA, LINPACK, 3/11/78.
+C
+ DOUBLE PRECISION DX(1),DY(1),DTEMP
+ INTEGER I,INCX,INCY,IX,IY,M,MP1,N
+C
+ DDOT = 0.0D0
+ DTEMP = 0.0D0
+ IF(N.LE.0)RETURN
+ IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
+C
+C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
+C NOT EQUAL TO 1
+C
+ IX = 1
+ IY = 1
+ IF(INCX.LT.0)IX = (-N+1)*INCX + 1
+ IF(INCY.LT.0)IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DTEMP = DTEMP + DX(IX)*DY(IY)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ DDOT = DTEMP
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C
+C CLEAN-UP LOOP
+C
+ 20 M = MOD(N,5)
+ IF( M .EQ. 0 ) GO TO 40
+ DO 30 I = 1,M
+ DTEMP = DTEMP + DX(I)*DY(I)
+ 30 CONTINUE
+ IF( N .LT. 5 ) GO TO 60
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) +
+ * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4)
+ 50 CONTINUE
+ 60 DDOT = DTEMP
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE DLABAX(N, NBAND, A, X, Y)
+C
+C THIS SUBROUTINE SETS Y = A*X
+C WHERE X AND Y ARE VECTORS OF LENGTH N
+C AND A IS AN N X NBAND SYMMETRIC BAND MATRIX
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND
+ DOUBLE PRECISION A(NBAND,1), X(1), Y(1)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ DOUBLE PRECISION ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+C
+C SUBROUTINES CALLED
+C
+C DCOPY
+C
+ ZERO(1) = 0.0D0
+ CALL DCOPY(N, ZERO, 0, Y, 1)
+ DO 20 K = 1, N
+ Y(K) = Y(K) + A(1,K)*X(K)
+ M = MIN0(N-K+1, NBAND)
+ IF(M .LT. 2) GO TO 20
+ DO 10 I = 2, M
+ L = K + I - 1
+ Y(L) = Y(L) + A(I,K)*X(K)
+ Y(K) = Y(K) + A(I,K)*X(L)
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE DLABCM(N, NBAND, NL, NR, A, EIGVAL,
+ 1 LDE, EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+C
+C THIS SUBROUTINE ORGANIZES THE CALCULATION OF THE EIGENVALUES
+C FOR THE BNDEIG PACKAGE. EIGENVALUES ARE COMPUTED BY
+C A MODIFIED RAYLEIGH QUOTIENT ITERATION. THE EIGENVALUE COUNT
+C OBTAINED BY EACH FACTORIZATION IS USED TO OCCASIONALLY OVERRIDE
+C THE COMPUTED RAYLEIGH QUOTIENT WITH A DIFFERENT SHIFT TO
+C INSURE CONVERGENCE TO THE DESIRED EIGENVALUES.
+C
+C FORMAL PARAMETERS.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ DOUBLE PRECISION A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), ATOL, ARTOL, BOUND(2,1), ATEMP(1),
+ 2 D(1), VTEMP(1)
+C
+C
+C LOCAL VARIABLES
+C
+ LOGICAL FLAG
+ INTEGER I, J, L, M, NUML, NUMVEC, NVAL
+ DOUBLE PRECISION ERRB, GAP, RESID, RQ, SIGMA, VNORM
+C
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ DOUBLE PRECISION DMAX1, DMIN1, DDOT, DNRM2
+C
+C SUBROUTINES CALLED
+C
+C DLABAX, DLABFC, DLARAN, DAXPY, DCOPY, DSCAL
+C
+C REPLACE ZERO VECTORS BY RANDOM
+C
+ NVAL = NR - NL + 1
+ FLAG = .FALSE.
+ DO 5 I = 1, NVAL
+ IF(DDOT(N, EIGVEC(1,I), 1, EIGVEC(1,I), 1) .EQ. 0.0D0)
+ 1 CALL DLARAN(N,EIGVEC(1,I))
+ 5 CONTINUE
+C
+C LOOP OVER EIGENVALUES
+C
+ SIGMA = BOUND(2,NVAL+1)
+ DO 400 J = 1, NVAL
+ NUML = J
+C
+C PREPARE TO COMPUTE FIRST RAYLEIGH QUOTIENT
+C
+ 10 CALL DLABAX(N, NBAND, A, EIGVEC(1,J), VTEMP)
+ VNORM = DNRM2(N, VTEMP, 1)
+ IF(VNORM .EQ. 0.0D0) GO TO 20
+ CALL DSCAL(N, 1.0D0/VNORM, VTEMP, 1)
+ CALL DSCAL(N, 1.0D0/VNORM, EIGVEC(1,J), 1)
+ CALL DAXPY(N, -SIGMA, EIGVEC(1,J), 1, VTEMP, 1)
+C
+C LOOP OVER SHIFTS
+C
+C COMPUTE RAYLEIGH QUOTIENT, RESIDUAL NORM, AND CURRENT TOLERANCE
+C
+ 20 VNORM = DNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0D0) GO TO 30
+ CALL DLARAN(N, EIGVEC(1,J))
+ GO TO 10
+C
+ 30 RQ = SIGMA + DDOT(N, EIGVEC(1,J), 1, VTEMP, 1)
+ 1 /VNORM/VNORM
+ CALL DAXPY(N, SIGMA-RQ, EIGVEC(1,J), 1, VTEMP, 1)
+ RESID = DMAX1(ATOL, DNRM2(N, VTEMP, 1)/VNORM)
+ CALL DSCAL(N, 1.0/VNORM, EIGVEC(1,J), 1)
+C
+C ACCEPT EIGENVALUE IF THE INTERVAL IS SMALL ENOUGH
+C
+ IF(BOUND(2,J+1) - BOUND(1,J+1) .LT. 3.0D0*ATOL) GO TO 300
+C
+C COMPUTE MINIMAL ERROR BOUND
+C
+ ERRB = RESID
+ GAP = DMIN1(BOUND(1,J+2) - RQ, RQ - BOUND(2,J))
+ IF(GAP .GT. RESID) ERRB = DMAX1(ATOL, RESID*RESID/GAP)
+C
+C TENTATIVE NEW SHIFT
+C
+ SIGMA = 0.5D0*(BOUND(1,J+1) + BOUND(2,J+1))
+C
+C CHECK FOR TERMINALTION
+C
+ IF(RESID .GT. 2.0D0*ATOL) GO TO 40
+ IF(RQ - ERRB .GT. BOUND(2,J) .AND.
+ 1 RQ + ERRB .LT. BOUND(1,J+2)) GO TO 310
+C
+C RQ IS TO THE LEFT OF THE INTERVAL
+C
+ 40 IF(RQ .GE. BOUND(1,J+1)) GO TO 50
+ IF(RQ - ERRB .GT. BOUND(2,J)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+1)) CALL DLARAN(N,EIGVEC(1,J))
+ GO TO 200
+C
+C RQ IS TO THE RIGHT OF THE INTERVAL
+C
+ 50 IF(RQ .LE. BOUND(2,J+1)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+2)) GO TO 100
+C
+C SAVE THE REJECTED VECTOR IF INDICATED
+C
+ IF(RQ - ERRB .LE. BOUND(2,J+1)) GO TO 200
+ DO 60 I = J, NVAL
+ IF(BOUND(2,I+1) .GT. RQ) GO TO 70
+ 60 CONTINUE
+ GO TO 80
+C
+ 70 CALL DCOPY(N, EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+C
+ 80 CALL DLARAN(N, EIGVEC(1,J))
+ GO TO 200
+C
+C PERTURB RQ TOWARD THE MIDDLE
+C
+ 100 IF(SIGMA .LT. RQ) SIGMA = DMAX1(SIGMA, RQ-ERRB)
+ IF(SIGMA .GT. RQ) SIGMA = DMIN1(SIGMA, RQ+ERRB)
+C
+C FACTOR AND SOLVE
+C
+ 200 DO 210 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 220
+ 210 CONTINUE
+ I = NVAL + 1
+ 220 NUMVEC = I - J
+ NUMVEC = MIN0(NUMVEC, NBAND + 2)
+ IF(RESID .LT. ARTOL) NUMVEC = MIN0(1,NUMVEC)
+ CALL DCOPY(N, EIGVEC(1,J), 1, VTEMP, 1)
+ CALL DLABFC(N, NBAND, A, SIGMA, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+C
+C PARTIALLY SCALE EXTRA VECTORS TO PREVENT UNDERFLOW OR OVERFLOW
+C
+ IF(NUMVEC .EQ. 1) GO TO 227
+ L = NUMVEC - 1
+ DO 225 I = 1,L
+ M = J + I
+ CALL DSCAL(N, 1.0D0/VNORM, EIGVEC(1,M), 1)
+ 225 CONTINUE
+C
+C UPDATE INTERVALS
+C
+ 227 NUML = NUML - NL + 1
+ IF(NUML .GE. 0) BOUND(2,1) = DMIN1(BOUND(2,1), SIGMA)
+ DO 230 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 20
+ IF(NUML .LT. I) BOUND(1,I+1) = SIGMA
+ IF(NUML .GE. I) BOUND(2,I+1) = SIGMA
+ 230 CONTINUE
+ IF(NUML .LT. NVAL + 1) BOUND(1,NVAL+2) = DMAX1(SIGMA,
+ 1 BOUND(1,NVAL+2))
+ GO TO 20
+C
+C ACCEPT AN EIGENPAIR
+C
+ 300 CALL DLARAN(N, EIGVEC(1,J))
+ FLAG = .TRUE.
+ GO TO 310
+C
+ 305 FLAG = .FALSE.
+ RQ = 0.5D0*(BOUND(1,J+1) + BOUND(2,J+1))
+ CALL DLABFC(N, NBAND, A, RQ, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+ VNORM = DNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0) CALL DSCAL(N, 1.0D0/VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE THE NEW EIGENVECTOR AGAINST THE OLD ONES
+C
+ 310 EIGVAL(J) = RQ
+ IF(J .EQ. 1) GO TO 330
+ M = J - 1
+ DO 320 I = 1, M
+ CALL DAXPY(N, -DDOT(N,EIGVEC(1,I),1,EIGVEC(1,J),1),
+ 1 EIGVEC(1,I), 1, EIGVEC(1,J), 1)
+ 320 CONTINUE
+ 330 VNORM = DNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .EQ. 0.0D0) GO TO 305
+ CALL DSCAL(N, 1.0D0/VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE LATER VECTORS AGAINST THE CONVERGED ONE
+C
+ IF(FLAG) GO TO 305
+ IF(J .EQ. NVAL) RETURN
+ M = J + 1
+ DO 340 I = M, NVAL
+ CALL DAXPY(N, -DDOT(N,EIGVEC(1,J),1,EIGVEC(1,I),1),
+ 1 EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+ 340 CONTINUE
+ 400 CONTINUE
+ RETURN
+C
+ 500 CONTINUE
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE DLABFC(N, NBAND, A, SIGMA, NUMBER, LDE,
+ 1 EIGVEC, NUML, LDAD, ATEMP, D, ATOL)
+C
+C THIS SUBROUTINE FACTORS (A-SIGMA*I) WHERE A IS A GIVEN BAND
+C MATRIX AND SIGMA IS AN INPUT PARAMETER. IT ALSO SOLVES ZERO
+C OR MORE SYSTEMS OF LINEAR EQUATIONS. IT RETURNS THE NUMBER
+C OF EIGENVALUES OF A LESS THAN SIGMA BY COUNTING THE STURM
+C SEQUENCE DURING THE FACTORIZATION. TO OBTAIN THE STURM
+C SEQUENCE COUNT WHILE ALLOWING NON-SYMMETRIC PIVOTING FOR
+C STABILITY, THE CODE USES A GUPTA'S MULTIPLE PIVOTING
+C ALGORITHM.
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NUMBER, LDE, NUML, LDAD
+ DOUBLE PRECISION A(NBAND,1), SIGMA, EIGVEC(LDE,1),
+ 1 ATEMP(LDAD,1), D(LDAD,1), ATOL
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, J, K, KK, L, LA, LD, LPM, M, NB1
+ DOUBLE PRECISION ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ DOUBLE PRECISION DABS
+C
+C SUBROUTINES CALLED
+C
+C DAXPY, DCOPY, DSWAP
+C
+C
+C INITIALIZE
+C
+ ZERO(1) = 0.0D0
+ NB1 = NBAND - 1
+ NUML = 0
+ CALL DCOPY(LDAD*NBAND, ZERO, 0, D, 1)
+C
+C LOOP OVER COLUMNS OF A
+C
+ DO 100 K = 1, N
+C
+C ADD A COLUMN OF A TO D
+C
+ D(NBAND, NBAND) = A(1,K) - SIGMA
+ M = MIN0(K, NBAND) - 1
+ IF(M .EQ. 0) GO TO 20
+ DO 10 I = 1, M
+ LA = K - I
+ LD = NBAND - I
+ D(LD,NBAND) = A(I+1, LA)
+ 10 CONTINUE
+C
+ 20 M = MIN0(N-K, NB1)
+ IF(M .EQ. 0) GO TO 40
+ DO 30 I = 1, M
+ LD = NBAND + I
+ D(LD, NBAND) = A(I+1, K)
+ 30 CONTINUE
+C
+C TERMINATE
+C
+ 40 LPM = 1
+ IF(NB1 .EQ. 0) GO TO 70
+ DO 60 I = 1, NB1
+ L = K - NBAND + I
+ IF(D(I,NBAND) .EQ. 0.0D0) GO TO 60
+ IF(DABS(D(I,I)) .GE. DABS(D(I,NBAND))) GO TO 50
+ IF((D(I,NBAND) .LT. 0.0D0 .AND. D(I,I) .LT. 0.0D0)
+ 1 .OR. (D(I,NBAND) .GT. 0.0D0 .AND. D(I,I) .GE. 0.0D0))
+ 2 LPM = -LPM
+ CALL DSWAP(LDAD-I+1, D(I,I), 1, D(I,NBAND), 1)
+ CALL DSWAP(NUMBER, EIGVEC(L,1), LDE, EIGVEC(K,1), LDE)
+ 50 CALL DAXPY(LDAD-I, -D(I,NBAND)/D(I,I), D(I+1,I), 1,
+ 1 D(I+1,NBAND), 1)
+ CALL DAXPY(NUMBER, -D(I,NBAND)/D(I,I), EIGVEC(L,1),
+ 1 LDE, EIGVEC(K,1), LDE)
+ 60 CONTINUE
+C
+C UPDATE STURM SEQUENCE COUNT
+C
+ 70 IF(D(NBAND,NBAND) .LT. 0.0D0) LPM = -LPM
+ IF(LPM .LT. 0) NUML = NUML + 1
+ IF(K .EQ. N) GO TO 110
+C
+C COPY FIRST COLUMN OF D INTO ATEMP
+ IF(K .LT. NBAND) GO TO 80
+ L = K - NB1
+ CALL DCOPY(LDAD, D, 1, ATEMP(1,L), 1)
+C
+C SHIFT THE COLUMNS OF D OVER AND UP
+C
+ IF(NB1 .EQ. 0) GO TO 100
+ 80 DO 90 I = 1, NB1
+ CALL DCOPY(LDAD-I, D(I+1,I+1), 1, D(I,I), 1)
+ D(LDAD,I) = 0.0D0
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C TRANSFER D TO ATEMP
+C
+ 110 DO 120 I = 1, NBAND
+ L = N - NBAND + I
+ CALL DCOPY(NBAND-I+1, D(I,I), 1, ATEMP(1,L), 1)
+ 120 CONTINUE
+C
+C BACK SUBSTITUTION
+C
+ IF(NUMBER .EQ. 0) RETURN
+ DO 160 KK = 1, N
+ K = N - KK + 1
+ IF(DABS(ATEMP(1,K)) .LE. ATOL)
+ 1 ATEMP(1,K) = DSIGN(ATOL,ATEMP(1,K))
+C
+ 130 DO 150 I = 1, NUMBER
+ EIGVEC(K,I) = EIGVEC(K,I)/ATEMP(1,K)
+ M = MIN0(LDAD, K) - 1
+ IF(M .EQ. 0) GO TO 150
+ DO 140 J = 1, M
+ L = K - J
+ EIGVEC(L,I) = EIGVEC(L,I) - ATEMP(J+1,L)*EIGVEC(K,I)
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ RETURN
+ END
+C
+C
+ SUBROUTINE DLAEIG(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+C
+C THIS IS A SPECIALIZED VERSION OF THE SUBROUTINE BNDEIG TAILORED
+C SPECIFICALLY FOR USE BY THE LASO PACKAGE.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ DOUBLE PRECISION A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), BOUND(2,1), ATEMP(1), D(1), VTEMP(1),
+ 2 EPS, TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, M, NVAL
+ DOUBLE PRECISION ARTOL, ATOL
+C
+C FUNCTIONS CALLED
+C
+ DOUBLE PRECISION DMAX1
+C
+C SUBROUTINES CALLED
+C
+C DLABCM, DLABFC, DLAGER, DCOPY
+C
+C SET PARAMETERS
+C
+ ATOL = DBLE(FLOAT(N))*EPS*DMAX1(TMAX,-TMIN)
+ ARTOL = ATOL/DSQRT(EPS)
+ NVAL = NR - NL + 1
+C
+C CHECK FOR SPECIAL CASE OF N = 1
+C
+ IF(N .NE. 1) GO TO 30
+ EIGVAL(1) = A(1,1)
+ EIGVEC(1,1) = 1.0D0
+ RETURN
+C
+C SET UP INITIAL EIGENVALUE BOUNDS
+C
+ 30 M = NVAL + 1
+ DO 50 I = 2, M
+ BOUND(1,I) = TMIN
+ BOUND(2,I) = TMAX
+ 50 CONTINUE
+ BOUND(2,1) = TMAX
+ BOUND(1,NVAL + 2) = TMIN
+ IF(NL .EQ. 1) BOUND(2,1) = TMIN
+ IF(NR .EQ. N) BOUND(1,NVAL + 2) = TMAX
+C
+ 60 CALL DLABCM(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE DLAGER(N, NBAND, NSTART, A, TMIN, TMAX)
+C
+C THIS SUBROUTINE COMPUTES BOUNDS ON THE SPECTRUM OF A BY
+C EXAMINING THE GERSCHGORIN CIRCLES. ONLY THE NEWLY CREATED
+C CIRCLES ARE EXAMINED
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NSTART
+ DOUBLE PRECISION A(NBAND,1), TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ DOUBLE PRECISION TEMP
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ DOUBLE PRECISION DMIN1, DMAX1
+C
+ DO 50 K = NSTART, N
+ TEMP = 0.0D0
+ DO 10 I = 2, NBAND
+ TEMP = TEMP + DABS(A(I,K))
+ 10 CONTINUE
+ 20 L = MIN0(K,NBAND)
+ IF(L .EQ. 1) GO TO 40
+ DO 30 I = 2, L
+ M = K - I + 1
+ TEMP = TEMP + DABS(A(I,M))
+ 30 CONTINUE
+ 40 TMIN = DMIN1(TMIN, A(1,K)-TEMP)
+ TMAX = DMAX1(TMAX, A(1,K)+TEMP)
+ 50 CONTINUE
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE DLARAN(N, X)
+C
+C THIS SUBROUTINE SETS THE VECTOR X TO RANDOM NUMBERS
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N
+ DOUBLE PRECISION X(N)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, IURAND
+C
+C FUNCTIONS CALLED
+C
+ REAL URAND
+ DOUBLE PRECISION DBLE
+C
+C SUBROUTINES CALLED
+C
+C NONE
+C
+C INITIALIZE SEED
+C
+ DATA IURAND /0/
+C
+ DO 10 I = 1, N
+ X(I) = DBLE(URAND(IURAND)) - 0.5D0
+ 10 CONTINUE
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE DMVPC(NBLOCK, BET, MAXJ, J, S, NUMBER, RESNRM,
+ * ORTHCF, RV)
+C
+ INTEGER NBLOCK, MAXJ, J, NUMBER
+ DOUBLE PRECISION BET(NBLOCK,1), S(MAXJ,1), RESNRM(1),
+ * ORTHCF(1), RV(1)
+C
+C THIS SUBROUTINE COMPUTES THE NORM AND THE SMALLEST ELEMENT
+C (IN ABSOLUTE VALUE) OF THE VECTOR BET*SJI, WHERE SJI
+C IS AN NBLOCK VECTOR OF THE LAST NBLOCK ELEMENTS OF THE ITH
+C EIGENVECTOR OF T. THESE QUANTITIES ARE THE RESIDUAL NORM
+C AND THE ORTHOGONALITY COEFFICIENT RESPECTIVELY FOR THE
+C CORRESPONDING RITZ PAIR. THE ORTHOGONALITY COEFFICIENT IS
+C NORMALIZED TO ACCOUNT FOR THE LOCAL REORTHOGONALIZATION.
+C
+ INTEGER I, K, M
+ DOUBLE PRECISION DDOT, DNRM2, DABS, DMIN1
+C
+ M = J - NBLOCK + 1
+ DO 20 I=1,NUMBER
+ DO 10 K=1,NBLOCK
+ RV(K) = DDOT(NBLOCK,S(M,I),1,BET(K,1),NBLOCK)
+ IF (K.EQ.1) ORTHCF(I) = DABS(RV(K))
+ ORTHCF(I) = DMIN1(ORTHCF(I),DABS(RV(K)))
+ 10 CONTINUE
+ RESNRM(I) = DNRM2(NBLOCK,RV,1)
+ 20 CONTINUE
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE DNPPLA(OP, IOVECT, N, NPERM, NOP, NMVAL, VAL,
+ * NMVEC, VEC, NBLOCK, H, HV, P, Q, BOUND, D, DELTA, SMALL,
+ * RARITZ, EPS)
+C
+ INTEGER N, NPERM, NOP, NMVAL, NMVEC, NBLOCK
+ LOGICAL SMALL, RARITZ
+ DOUBLE PRECISION VAL(NMVAL,1), VEC(NMVEC,1), H(NPERM,1),
+ * HV(NPERM,1), P(N,1), Q(N,1), BOUND(1), D(1), DELTA, EPS
+ EXTERNAL OP, IOVECT
+C
+C THIS SUBROUTINE POST PROCESSES THE EIGENVECTORS. BLOCK MATRIX
+C VECTOR PRODUCTS ARE USED TO MINIMIZED THE NUMBER OF CALLS TO OP.
+C
+ INTEGER I, J, JJ, K, KK, L, M, MOD
+ DOUBLE PRECISION HMIN, HMAX, TEMP, DDOT, DNRM2, DZERO(1)
+ EXTERNAL DAXPY, DCOPY, DDOT, DLAGER, DLAEIG
+C
+C IF RARITZ IS .TRUE. A FINAL RAYLEIGH-RITZ PROCEDURE IS APPLIED
+C TO THE EIGENVECTORS.
+C
+ DZERO(1) = 0.0D0
+ IF (.NOT.RARITZ) GO TO 190
+C
+C ------------------------------------------------------------------
+C
+C THIS CONSTRUCTS H=Q*AQ, WHERE THE COLUMNS OF Q ARE THE
+C APPROXIMATE EIGENVECTORS. TEMP = -1 IS USED WHEN SMALL IS
+C FALSE TO AVOID HAVING TO RESORT THE EIGENVALUES AND EIGENVECTORS
+C COMPUTED BY DLAEIG.
+C
+ CALL DCOPY(NPERM*NPERM, DZERO, 0, H, 1)
+ TEMP = -1.0D0
+ IF (SMALL) TEMP = 1.0D0
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 40
+ DO 10 I=1,M
+ CALL DCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 10 CONTINUE
+ CALL IOVECT(N, M, P, M, 0)
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 30 I=1,M
+ DO 20 J=I,NPERM
+ JJ = J - I + 1
+ H(JJ,I) = TEMP*DDOT(N,VEC(1,J),1,Q(1,I),1)
+ 20 CONTINUE
+ 30 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 90
+ 40 M = M + NBLOCK
+ DO 80 I=M,NPERM,NBLOCK
+ DO 50 J=1,NBLOCK
+ L = I - NBLOCK + J
+ CALL DCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 50 CONTINUE
+ CALL IOVECT(N, NBLOCK, P, I, 0)
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 70 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 60 K=L,NPERM
+ KK = K - L + 1
+ H(KK,L) = TEMP*DDOT(N,VEC(1,K),1,Q(1,J),1)
+ 60 CONTINUE
+ 70 CONTINUE
+ 80 CONTINUE
+C
+C THIS COMPUTES THE SPECTRAL DECOMPOSITION OF H.
+C
+ 90 HMIN = H(1,1)
+ HMAX = H(1,1)
+ CALL DLAGER(NPERM, NPERM, 1, H, HMIN, HMAX)
+ CALL DLAEIG(NPERM, NPERM, 1, NPERM, H, VAL, NPERM,
+ 1 HV, BOUND, P, D, Q, EPS, HMIN, HMAX)
+C
+C THIS COMPUTES THE RITZ VECTORS--THE COLUMNS OF
+C Y = QS WHERE S IS THE MATRIX OF EIGENVECTORS OF H.
+C
+ DO 120 I=1,NPERM
+ CALL DCOPY(N, DZERO, 0, VEC(1,I), 1)
+ 120 CONTINUE
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 150
+ CALL IOVECT(N, M, P, M, 1)
+ DO 140 I=1,M
+ DO 130 J=1,NPERM
+ CALL DAXPY(N, HV(I,J), P(1,I), 1, VEC(1,J), 1)
+ 130 CONTINUE
+ 140 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 190
+ 150 M = M + NBLOCK
+ DO 180 I=M,NPERM,NBLOCK
+ CALL IOVECT(N, NBLOCK, P, I, 1)
+ DO 170 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 160 K=1,NPERM
+ CALL DAXPY(N, HV(L,K), P(1,J), 1, VEC(1,K), 1)
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES THE RAYLEIGH QUOTIENTS (IN VAL(*,1))
+C AND RESIDUAL NORMS (IN VAL(*,2)) OF THE EIGENVECTORS.
+C
+ 190 IF (.NOT.SMALL) DELTA = -DELTA
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 220
+ DO 200 I=1,M
+ CALL DCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 200 CONTINUE
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 210 I=1,M
+ VAL(I,1) = DDOT(N,P(1,I),1,Q(1,I),1)
+ CALL DAXPY(N, -VAL(I,1), P(1,I), 1, Q(1,I), 1)
+ VAL(I,2) = DNRM2(N,Q(1,I),1)
+ 210 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 260
+ 220 M = M + 1
+ DO 250 I=M,NPERM,NBLOCK
+ DO 230 J=1,NBLOCK
+ L = I - 1 + J
+ CALL DCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 230 CONTINUE
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 240 J=1,NBLOCK
+ L = I - 1 + J
+ VAL(L,1) = DDOT(N,P(1,J),1,Q(1,J),1)
+ CALL DAXPY(N, -VAL(L,1), P(1,J), 1, Q(1,J), 1)
+ VAL(L,2) = DNRM2(N,Q(1,J),1)
+ 240 CONTINUE
+ 250 CONTINUE
+C
+C THIS COMPUTES THE ACCURACY ESTIMATES. FOR CONSISTENCY WITH DILASO
+C A DO LOOP IS NOT USED.
+C
+ 260 I = 0
+ 270 I = I + 1
+ IF (I.GT.NPERM) RETURN
+ TEMP = DELTA - VAL(I,1)
+ IF (.NOT.SMALL) TEMP = -TEMP
+ VAL(I,4) = 0.0D0
+ IF (TEMP.GT.0.0D0) VAL(I,4) = VAL(I,2)/TEMP
+ VAL(I,3) = VAL(I,4)*VAL(I,2)
+ GO TO 270
+C
+ END
+ DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX)
+ INTEGER I, INCX, J, N, NEXT, NN
+ DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE
+ DATA ZERO, ONE /0.0D0, 1.0D0/
+C
+C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE
+C INCREMENT INCX .
+C IF N .LE. 0 RETURN WITH RESULT = 0.
+C IF N .GE. 1 THEN INCX MUST BE .GE. 1
+C
+C C.L.LAWSON, 1978 JAN 08
+C
+C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE
+C HOPEFULLY APPLICABLE TO ALL MACHINES.
+C CUTLO = MAXIMUM OF DSQRT(U/EPS) OVER ALL KNOWN MACHINES.
+C CUTHI = MINIMUM OF DSQRT(V) OVER ALL KNOWN MACHINES.
+C WHERE
+C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1.
+C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT)
+C V = LARGEST NO. (OVERFLOW LIMIT)
+C
+C BRIEF OUTLINE OF ALGORITHM..
+C
+C PHASE 1 SCANS ZERO COMPONENTS.
+C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO
+C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO
+C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M
+C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX.
+C
+C VALUES FOR CUTLO AND CUTHI..
+C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER
+C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS..
+C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE
+C UNIVAC AND DEC AT 2**(-103)
+C THUS CUTLO = 2**(-51) = 4.44089E-16
+C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC.
+C THUS CUTHI = 2**(63.5) = 1.30438E19
+C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC.
+C THUS CUTLO = 2**(-33.5) = 8.23181D-11
+C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D19
+C DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 /
+C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 /
+ DATA CUTLO, CUTHI / 8.232D-11, 1.304D19 /
+C
+ IF(N .GT. 0) GO TO 10
+ DNRM2 = ZERO
+ GO TO 300
+C
+ 10 ASSIGN 30 TO NEXT
+ SUM = ZERO
+ NN = N * INCX
+C BEGIN MAIN LOOP
+ I = 1
+ 20 GO TO NEXT,(30, 50, 70, 110)
+ 30 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
+ ASSIGN 50 TO NEXT
+ XMAX = ZERO
+C
+C PHASE 1. SUM IS ZERO
+C
+ 50 IF( DX(I) .EQ. ZERO) GO TO 200
+ IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
+C
+C PREPARE FOR PHASE 2.
+ ASSIGN 70 TO NEXT
+ GO TO 105
+C
+C PREPARE FOR PHASE 4.
+C
+ 100 I = J
+ ASSIGN 110 TO NEXT
+ SUM = (SUM / DX(I)) / DX(I)
+ 105 XMAX = DABS(DX(I))
+ GO TO 115
+C
+C PHASE 2. SUM IS SMALL.
+C SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
+C
+ 70 IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75
+C
+C COMMON CODE FOR PHASES 2 AND 4.
+C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW.
+C
+ 110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115
+ SUM = ONE + SUM * (XMAX / DX(I))**2
+ XMAX = DABS(DX(I))
+ GO TO 200
+C
+ 115 SUM = SUM + (DX(I)/XMAX)**2
+ GO TO 200
+C
+C
+C PREPARE FOR PHASE 3.
+C
+ 75 SUM = (SUM * XMAX) * XMAX
+C
+C
+C FOR REAL OR D.P. SET HITEST = CUTHI/N
+C FOR COMPLEX SET HITEST = CUTHI/(2*N)
+C
+ 85 HITEST = CUTHI/FLOAT( N )
+C
+C PHASE 3. SUM IS MID-RANGE. NO SCALING.
+C
+ DO 95 J =I,NN,INCX
+ IF(DABS(DX(J)) .GE. HITEST) GO TO 100
+ 95 SUM = SUM + DX(J)**2
+ DNRM2 = DSQRT( SUM )
+ GO TO 300
+C
+ 200 CONTINUE
+ I = I + INCX
+ IF ( I .LE. NN ) GO TO 20
+C
+C END OF MAIN LOOP.
+C
+C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
+C
+ DNRM2 = XMAX * DSQRT(SUM)
+ 300 CONTINUE
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE DORTQR(NZ, N, NBLOCK, Z, B)
+C
+ INTEGER NZ, N, NBLOCK
+ DOUBLE PRECISION Z(NZ,1), B(NBLOCK,1)
+C
+C THIS SUBROUTINE COMPUTES THE QR FACTORIZATION OF THE N X NBLOCK
+C MATRIX Z. Q IS FORMED IN PLACE AND RETURNED IN Z. R IS
+C RETURNED IN B.
+C
+ INTEGER I, J, K, LENGTH, M
+ DOUBLE PRECISION SIGMA, TAU, TEMP, DDOT, DNRM2, DSIGN
+ EXTERNAL DAXPY, DDOT, DNRM2, DSCAL
+C
+C THIS SECTION REDUCES Z TO TRIANGULAR FORM.
+C
+ DO 30 I=1,NBLOCK
+C
+C THIS FORMS THE ITH REFLECTION.
+C
+ LENGTH = N - I + 1
+ SIGMA = DSIGN(DNRM2(LENGTH,Z(I,I),1),Z(I,I))
+ B(I,I) = -SIGMA
+ Z(I,I) = Z(I,I) + SIGMA
+ TAU = SIGMA*Z(I,I)
+ IF (I.EQ.NBLOCK) GO TO 30
+ J = I + 1
+C
+C THIS APPLIES THE ROTATION TO THE REST OF THE COLUMNS.
+C
+ DO 20 K=J,NBLOCK
+ IF (TAU.EQ.0.0D0) GO TO 10
+ TEMP = -DDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL DAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 10 B(I,K) = Z(I,K)
+ Z(I,K) = 0.0D0
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C THIS ACCUMULATES THE REFLECTIONS IN REVERSE ORDER.
+C
+ DO 70 M=1,NBLOCK
+C
+C THIS RECREATES THE ITH = NBLOCK-M+1)TH REFLECTION.
+C
+ I = NBLOCK + 1 - M
+ SIGMA = -B(I,I)
+ TAU = Z(I,I)*SIGMA
+ IF (TAU.EQ.0.0D0) GO TO 60
+ LENGTH = N - NBLOCK + M
+ IF (I.EQ.NBLOCK) GO TO 50
+ J = I + 1
+C
+C THIS APPLIES IT TO THE LATER COLUMNS.
+C
+ DO 40 K=J,NBLOCK
+ TEMP = -DDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL DAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 40 CONTINUE
+ 50 CALL DSCAL(LENGTH, -1.0D0/SIGMA, Z(I,I), 1)
+ 60 Z(I,I) = 1.0D0 + Z(I,I)
+ 70 CONTINUE
+ RETURN
+ END
+ SUBROUTINE DSCAL(N,DA,DX,INCX)
+C
+C SCALES A VECTOR BY A CONSTANT.
+C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE.
+C JACK DONGARRA, LINPACK, 3/11/78.
+C
+ DOUBLE PRECISION DA,DX(1)
+ INTEGER I,INCX,M,MP1,N,NINCX
+C
+ IF(N.LE.0)RETURN
+ IF(INCX.EQ.1)GO TO 20
+C
+C CODE FOR INCREMENT NOT EQUAL TO 1
+C
+ NINCX = N*INCX
+ DO 10 I = 1,NINCX,INCX
+ DX(I) = DA*DX(I)
+ 10 CONTINUE
+ RETURN
+C
+C CODE FOR INCREMENT EQUAL TO 1
+C
+C
+C CLEAN-UP LOOP
+C
+ 20 M = MOD(N,5)
+ IF( M .EQ. 0 ) GO TO 40
+ DO 30 I = 1,M
+ DX(I) = DA*DX(I)
+ 30 CONTINUE
+ IF( N .LT. 5 ) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ DX(I) = DA*DX(I)
+ DX(I + 1) = DA*DX(I + 1)
+ DX(I + 2) = DA*DX(I + 2)
+ DX(I + 3) = DA*DX(I + 3)
+ DX(I + 4) = DA*DX(I + 4)
+ 50 CONTINUE
+ RETURN
+ END
+ SUBROUTINE DSWAP (N,DX,INCX,DY,INCY)
+C
+C INTERCHANGES TWO VECTORS.
+C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE.
+C JACK DONGARRA, LINPACK, 3/11/78.
+C
+ DOUBLE PRECISION DX(1),DY(1),DTEMP
+ INTEGER I,INCX,INCY,IX,IY,M,MP1,N
+C
+ IF(N.LE.0)RETURN
+ IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
+C
+C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
+C TO 1
+C
+ IX = 1
+ IY = 1
+ IF(INCX.LT.0)IX = (-N+1)*INCX + 1
+ IF(INCY.LT.0)IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DTEMP = DX(IX)
+ DX(IX) = DY(IY)
+ DY(IY) = DTEMP
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C
+C CLEAN-UP LOOP
+C
+ 20 M = MOD(N,3)
+ IF( M .EQ. 0 ) GO TO 40
+ DO 30 I = 1,M
+ DTEMP = DX(I)
+ DX(I) = DY(I)
+ DY(I) = DTEMP
+ 30 CONTINUE
+ IF( N .LT. 3 ) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,3
+ DTEMP = DX(I)
+ DX(I) = DY(I)
+ DY(I) = DTEMP
+ DTEMP = DX(I + 1)
+ DX(I + 1) = DY(I + 1)
+ DY(I + 1) = DTEMP
+ DTEMP = DX(I + 2)
+ DX(I + 2) = DY(I + 2)
+ DY(I + 2) = DTEMP
+ 50 CONTINUE
+ RETURN
+ END
+C
+C-------------------------------------------------------------------
+C
+ SUBROUTINE DVSORT(NUM, VAL, RES, IFLAG, V, NMVEC, N, VEC)
+ INTEGER NUM, IFLAG, NMVEC, N
+ DOUBLE PRECISION VAL(1), RES(1), V(1), VEC(NMVEC,1)
+C
+C THIS SUBROUTINE SORTS THE EIGENVALUES (VAL) IN ASCENDING ORDER
+C WHILE CONCURRENTLY SWAPPING THE RESIDUALS AND VECTORS.
+ INTEGER I, K, M
+ DOUBLE PRECISION TEMP
+ IF(NUM .LE. 1) RETURN
+ DO 20 I = 2, NUM
+ M = NUM - I + 1
+ DO 10 K = 1, M
+ IF(VAL(K) .LE. VAL(K+1)) GO TO 10
+ TEMP = VAL(K)
+ VAL(K) = VAL(K+1)
+ VAL(K+1) = TEMP
+ TEMP = RES(K)
+ RES(K) = RES(K+1)
+ RES(K+1) = TEMP
+ CALL DSWAP(N, VEC(1,K), 1, VEC(1,K+1), 1)
+ IF(IFLAG .EQ. 0) GO TO 10
+ TEMP = V(K)
+ V(K) = V(K+1)
+ V(K+1) = TEMP
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
+ REAL FUNCTION URAND(IY)
+ INTEGER IY
+C
+C URAND IS A UNIFORM RANDOM NUMBER GENERATOR BASED ON THEORY AND
+C SUGGESTIONS GIVEN IN D.E. KNUTH (1969), VOL 2. THE INTEGER IY
+C SHOULD BE INITIALIZED TO AN ARBITRARY INTEGER PRIOR TO THE FIRST CALL
+C TO URAND. THE CALLING PROGRAM SHOULD NOT ALTER THE VALUE OF IY
+C BETWEEN SUBSEQUENT CALLS TO URAND. VALUES OF URAND WILL BE RETURNED
+C IN THE INTERVAL (0,1).
+C
+ INTEGER IA,IC,ITWO,M2,M,MIC
+ DOUBLE PRECISION HALFM
+ REAL S
+ DOUBLE PRECISION DATAN,DSQRT
+ DATA M2/0/,ITWO/2/
+ IF (M2 .NE. 0) GO TO 20
+C
+C IF FIRST ENTRY, COMPUTE MACHINE INTEGER WORD LENGTH
+C
+ M = 1
+ 10 M2 = M
+ M = ITWO*M2
+ IF (M .GT. M2) GO TO 10
+ HALFM = M2
+C
+C COMPUTE MULTIPLIER AND INCREMENT FOR LINEAR CONGRUENTIAL METHOD
+C
+ IA = 8*IDINT(HALFM*DATAN(1.D0)/8.D0) + 5
+ IC = 2*IDINT(HALFM*(0.5D0-DSQRT(3.D0)/6.D0)) + 1
+ MIC = (M2 - IC) + M2
+C
+C S IS THE SCALE FACTOR FOR CONVERTING TO FLOATING POINT
+C
+ S = 0.5/HALFM
+C
+C COMPUTE NEXT RANDOM NUMBER
+C
+ 20 IY = IY*IA
+C
+C THE FOLLOWING STATEMENT IS FOR COMPUTERS WHICH DO NOT ALLOW
+C INTEGER OVERFLOW ON ADDITION
+C
+ IF (IY .GT. MIC) IY = (IY - M2) - M2
+C
+ IY = IY + IC
+C
+C THE FOLLOWING STATEMENT IS FOR COMPUTERS WHERE THE
+C WORD LENGTH FOR ADDITION IS GREATER THAN FOR MULTIPLICATION
+C
+ IF (IY/2 .GT. M2) IY = (IY - M2) - M2
+C
+C THE FOLLOWING STATEMENT IS FOR COMPUTERS WHERE INTEGER
+C OVERFLOW AFFECTS THE SIGN BIT
+C
+ IF (IY .LT. 0) IY = (IY + M2) + M2
+ URAND = FLOAT(IY)*S
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dnrm2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnrm2.c
new file mode 100644
index 0000000000000000000000000000000000000000..8c34e459c9fa4463bfdd9af58ecf7280e57b2c89
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dnrm2.c
@@ -0,0 +1,60 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+#ifdef KR_headers
+doublereal dnrm2_(n, x, incx)
+const integer *n;
+const doublereal *x;
+const integer *incx;
+#else
+doublereal dnrm2_(const integer* n, const doublereal* x, const integer* incx)
+#endif
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal norm, scale, absxi;
+ static integer ix;
+ static doublereal ssq;
+
+/* DNRM2 returns the euclidean norm of a vector via the function */
+/* name, so that */
+/* */
+/* DNRM2 := sqrt( x'*x ) */
+/* */
+/* -- This version written on 25-October-1982. */
+/* Modified on 14-October-1993 to inline the call to DLASSQ. */
+/* Sven Hammarling, Nag Ltd. */
+
+ if (*n < 1 || *incx < 1) {
+ norm = 0.;
+ } else if (*n == 1) {
+ norm = abs(x[0]);
+ } else {
+ scale = 0.;
+ ssq = 1.;
+/* The following loop is equivalent to this call to the LAPACK */
+/* auxiliary routine: */
+/* CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+ for (ix = 0; ix < *n * *incx; ix += *incx) {
+ if (x[ix] != 0.) {
+ absxi = abs(x[ix]);
+ if (scale < absxi) {
+ d__1 = scale / absxi;
+ ssq = ssq * d__1 * d__1 + 1.;
+ scale = absxi;
+ } else {
+ d__1 = absxi / scale;
+ ssq += d__1 * d__1;
+ }
+ }
+ }
+ norm = scale * sqrt(ssq);
+ }
+
+ return norm;
+
+} /* dnrm2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.c
new file mode 100644
index 0000000000000000000000000000000000000000..2a9fe47151303a21c20a4337297cfdf0f424966f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.c
@@ -0,0 +1,124 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dorg2r_(integer *m, integer *n, integer *k, doublereal *a,
+ integer *lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j, l;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DORG2R generates an m by n real matrix Q with orthonormal columns, */
+/* which is defined as the first n columns of a product of k elementary */
+/* reflectors of order m */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by DGEQRF. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. M >= N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. N >= K >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the i-th column must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by DGEQRF in the first k columns of its array */
+/* argument A. */
+/* On exit, the m-by-n matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORG2R", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return;
+ }
+
+/* Initialise columns k+1:n to columns of the unit matrix */
+
+ for (j = *k; j < *n; ++j) {
+ for (l = 0; l < *m; ++l) {
+ a[l + j * *lda] = 0.;
+ }
+ a[j + j * *lda] = 1.;
+ }
+
+ for (i = *k - 1; i >= 0; --i) {
+
+/* Apply H(i) to A(i:m,i:n) from the left */
+
+ if (i < *n - 1) {
+ a[i + i * *lda] = 1.;
+ i__1 = *m - i;
+ i__2 = *n - i - 1;
+ dlarf_("Left", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i], &a[i + (i + 1) * *lda], lda, work);
+ }
+ if (i < *m - 1) {
+ i__1 = *m - i - 1;
+ d__1 = -tau[i];
+ dscal_(&i__1, &d__1, &a[i + 1 + i * *lda], &c__1);
+ }
+ a[i + i * *lda] = 1. - tau[i];
+
+/* Set A(1:i-1,i) to zero */
+
+ for (l = 0; l < i-1; ++l) {
+ a[l + i * *lda] = 0.;
+ }
+ }
+} /* dorg2r_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..8ecd83de6959ef8f412e4845ba8b0bee340aabf9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorg2r.f
@@ -0,0 +1,130 @@
+ SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORG2R generates an m by n real matrix Q with orthonormal columns,
+* which is defined as the first n columns of a product of k elementary
+* reflectors of order m
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGEQRF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. M >= N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. N >= K >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the i-th column must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by DGEQRF in the first k columns of its array
+* argument A.
+* On exit, the m-by-n matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGEQRF.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, DSCAL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORG2R', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Initialise columns k+1:n to columns of the unit matrix
+*
+ DO 20 J = K + 1, N
+ DO 10 L = 1, M
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ A( J, J ) = ONE
+ 20 CONTINUE
+*
+ DO 40 I = K, 1, -1
+*
+* Apply H(i) to A(i:m,i:n) from the left
+*
+ IF( I.LT.N ) THEN
+ A( I, I ) = ONE
+ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK )
+ END IF
+ IF( I.LT.M )
+ $ CALL DSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
+ A( I, I ) = ONE - TAU( I )
+*
+* Set A(1:i-1,i) to zero
+*
+ DO 30 L = 1, I - 1
+ A( L, I ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of DORG2R
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..4843052e4b33441a1f098868bb63dc24dfebde3d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.c
@@ -0,0 +1,225 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+
+/* Subroutine */ void dorgqr_(m, n, k, a, lda, tau, work, lwork, info)
+integer *m, *n, *k;
+doublereal *a;
+integer *lda;
+doublereal *tau, *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i, j, l, nbmin, iinfo;
+ static integer ib, nb, ki, kk;
+ static integer nx;
+ static integer ldwork, lwkopt;
+ static logical lquery;
+ static integer iws;
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+
+/* DORGQR generates an M-by-N real matrix Q with orthonormal columns, */
+/* which is defined as the first N columns of a product of K elementary */
+/* reflectors of order M */
+
+/* Q = H(1) H(2) . . . H(k) */
+
+/* as returned by DGEQRF. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. M >= N >= 0. */
+
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. N >= K >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the i-th column must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by DGEQRF in the first k columns of its array */
+/* argument A. */
+/* On exit, the M-by-N matrix Q. */
+
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* For optimum performance LWORK >= N*NB, where NB is the */
+/* optimal blocksize. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+/* Test the input arguments */
+
+ *info = 0;
+ nb = ilaenv_(&c__1, "DORGQR", " ", m, n, k, &c_n1);
+ lwkopt = max(1,*n) * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*lwork < max(1,*n) && ! lquery) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGQR", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ work[1] = 1.;
+ return;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if (nb > 1 && nb < *k) {
+
+/* Determine when to cross over from blocked to unblocked code. */
+
+ nx = ilaenv_(&c__3, "DORGQR", " ", m, n, k, &c_n1);
+ nx = max(0,nx);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/* Not enough workspace to use optimal NB: reduce NB and */
+/* determine the minimum value of NB. */
+
+ nb = *lwork / ldwork;
+ nbmin = ilaenv_(&c__2, "DORGQR", " ", m, n, k, &c_n1);
+ nbmin = max(2,nbmin);
+ }
+ }
+ }
+
+ if (nb >= nbmin && nb < *k && nx < *k) {
+
+/* Use blocked code after the last block. */
+/* The first kk columns are handled by the block method. */
+
+ ki = (*k - nx - 1) / nb * nb;
+ kk = min(*k, ki + nb);
+
+/* Set A(1:kk,kk+1:n) to zero. */
+
+ for (j = kk + 1; j <= *n; ++j) {
+ for (i = 1; i <= kk; ++i) {
+ a[i + j * a_dim1] = 0.;
+ }
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *n) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ dorg2r_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &tau[kk + 1], &work[1], &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ for (i = ki + 1; nb > 0 ? i >= 1 : i <= 1; i -= nb) {
+ ib = min(nb, *k - i + 1);
+ if (i + ib <= *n) {
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__2 = *m - i + 1;
+ dlarft_("Forward", "Columnwise", &i__2, &ib, &a[i + i * a_dim1], lda, &tau[i], &work[1], &ldwork);
+
+/* Apply H to A(i:m,i+ib:n) from the left */
+
+ i__2 = *m - i + 1;
+ i__3 = *n - i - ib + 1;
+ dlarfb_("Left", "No transpose", "Forward", "Columnwise", &i__2, &i__3,
+ &ib, &a[i + i * a_dim1], lda, &work[1], &ldwork,
+ &a[i + (i + ib) * a_dim1], lda, &work[ib + 1], &ldwork);
+ }
+
+/* Apply H to rows i:m of current block */
+
+ i__2 = *m - i + 1;
+ dorg2r_(&i__2, &ib, &ib, &a[i + i * a_dim1], lda, &tau[i], &work[1], &iinfo);
+
+/* Set rows 1:i-1 of current block to zero */
+
+ for (j = i; j < i + ib; ++j) {
+ for (l = 1; l < i; ++l) {
+ a[l + j * a_dim1] = 0.;
+ }
+ }
+ }
+ }
+
+ work[1] = (doublereal) iws;
+
+} /* dorgqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..171dfb527301294e8bfe894f1c46674f0ec9e72d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgqr.f
@@ -0,0 +1,217 @@
+ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, LWORK, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORGQR generates an M-by-N real matrix Q with orthonormal columns,
+* which is defined as the first N columns of a product of K elementary
+* reflectors of order M
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGEQRF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. M >= N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. N >= K >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the i-th column must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by DGEQRF in the first k columns of its array
+* argument A.
+* On exit, the M-by-N matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGEQRF.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= max(1,N).
+* For optimum performance LWORK >= N*NB, where NB is the
+* optimal blocksize.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY
+ INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
+ $ LWKOPT, NB, NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARFB, DLARFT, DORG2R, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
+ LWKOPT = MAX( 1, N )*NB
+ WORK( 1 ) = LWKOPT
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+ INFO = -8
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORGQR', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ NBMIN = 2
+ NX = 0
+ IWS = N
+ IF( NB.GT.1 .AND. NB.LT.K ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+*
+ NX = MAX( 0, ILAENV( 3, 'DORGQR', ' ', M, N, K, -1 ) )
+ IF( NX.LT.K ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ LDWORK = N
+ IWS = LDWORK*NB
+ IF( LWORK.LT.IWS ) THEN
+*
+* Not enough workspace to use optimal NB: reduce NB and
+* determine the minimum value of NB.
+*
+ NB = LWORK / LDWORK
+ NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, -1 ) )
+ END IF
+ END IF
+ END IF
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
+*
+* Use blocked code after the last block.
+* The first kk columns are handled by the block method.
+*
+ KI = ( ( K-NX-1 ) / NB )*NB
+ KK = MIN( K, KI+NB )
+*
+* Set A(1:kk,kk+1:n) to zero.
+*
+ DO 20 J = KK + 1, N
+ DO 10 I = 1, KK
+ A( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ KK = 0
+ END IF
+*
+* Use unblocked code for the last or only block.
+*
+ IF( KK.LT.N )
+ $ CALL DORG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
+ $ TAU( KK+1 ), WORK, IINFO )
+*
+ IF( KK.GT.0 ) THEN
+*
+* Use blocked code
+*
+ DO 50 I = KI + 1, 1, -NB
+ IB = MIN( NB, K-I+1 )
+ IF( I+IB.LE.N ) THEN
+*
+* Form the triangular factor of the block reflector
+* H = H(i) H(i+1) . . . H(i+ib-1)
+*
+ CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+ $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
+*
+* Apply H to A(i:m,i+ib:n) from the left
+*
+ CALL DLARFB( 'Left', 'No transpose', 'Forward',
+ $ 'Columnwise', M-I+1, N-I-IB+1, IB,
+ $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
+ $ LDA, WORK( IB+1 ), LDWORK )
+ END IF
+*
+* Apply H to rows i:m of current block
+*
+ CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
+ $ IINFO )
+*
+* Set rows 1:i-1 of current block to zero
+*
+ DO 40 J = I, I + IB - 1
+ DO 30 L = 1, I - 1
+ A( L, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ 50 CONTINUE
+ END IF
+*
+ WORK( 1 ) = IWS
+ RETURN
+*
+* End of DORGQR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.c
new file mode 100644
index 0000000000000000000000000000000000000000..10e5133e0f06313342467d94770f232fbed64ae6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.c
@@ -0,0 +1,127 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dorgr2_(m, n, k, a, lda, tau, work, info)
+integer *m, *n, *k;
+doublereal *a;
+integer *lda;
+doublereal *tau, *work;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j, l;
+ static integer ii, ij;
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DORGR2 generates an m by n real matrix Q with orthonormal rows, */
+/* which is defined as the last m rows of a product of k elementary */
+/* reflectors of order n */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by DGERQF. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. N >= M. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. M >= K >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the (m-k+i)-th row must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by DGERQF in the last k rows of its array argument */
+/* A. */
+/* On exit, the m by n matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGERQF. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (M) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *m) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGR2", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m <= 0) {
+ return;
+ }
+
+ if (*k < *m) {
+
+/* Initialise rows 1:m-k to rows of the unit matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (l = 0; l < *m - *k; ++l) {
+ a[l + j * *lda] = 0.;
+ }
+ if (j >= *n - *m && j < *n - *k) {
+ a[*m - *n + j + j * *lda] = 1.;
+ }
+ }
+ }
+
+ for (i = 0; i < *k; ++i) {
+ ii = *m - *k + i;
+ ij = *n - *k + i;
+
+/* Apply H(i) to A(1:m-k+i,1:n-k+i) from the right */
+
+ a[ii + ij * *lda] = 1.;
+ i__1 = ij + 1;
+ dlarf_("Right", &ii, &i__1, &a[ii], lda, &tau[i], a, lda, work);
+ d__1 = -tau[i];
+ dscal_(&ij, &d__1, &a[ii], lda);
+ a[ii + ij * *lda] = 1. - tau[i];
+
+/* Set A(m-k+i,n-k+i+1:n) to zero */
+
+ for (l = ij + 1; l < *n; ++l) {
+ a[ii + l * *lda] = 0.;
+ }
+ }
+} /* dorgr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.f
new file mode 100644
index 0000000000000000000000000000000000000000..ea88d346bf2ccc8e9f36a4407b3adf1071b7f0be
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorgr2.f
@@ -0,0 +1,132 @@
+ SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORGR2 generates an m by n real matrix Q with orthonormal rows,
+* which is defined as the last m rows of a product of k elementary
+* reflectors of order n
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGERQF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. N >= M.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. M >= K >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the (m-k+i)-th row must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by DGERQF in the last k rows of its array argument
+* A.
+* On exit, the m by n matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGERQF.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (M)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, II, J, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, DSCAL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORGR2', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.LE.0 )
+ $ RETURN
+*
+ IF( K.LT.M ) THEN
+*
+* Initialise rows 1:m-k to rows of the unit matrix
+*
+ DO 20 J = 1, N
+ DO 10 L = 1, M - K
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ IF( J.GT.N-M .AND. J.LE.N-K )
+ $ A( M-N+J, J ) = ONE
+ 20 CONTINUE
+ END IF
+*
+ DO 40 I = 1, K
+ II = M - K + I
+*
+* Apply H(i) to A(1:m-k+i,1:n-k+i) from the right
+*
+ A( II, N-M+II ) = ONE
+ CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ),
+ $ A, LDA, WORK )
+ CALL DSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA )
+ A( II, N-M+II ) = ONE - TAU( I )
+*
+* Set A(m-k+i,n-k+i+1:n) to zero
+*
+ DO 30 L = N - M + II + 1, N
+ A( II, L ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of DORGR2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.c
new file mode 100644
index 0000000000000000000000000000000000000000..62ae30b4962b3585855b90b0ae96706285ca3bb1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.c
@@ -0,0 +1,182 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dorm2r_(const char *side, const char *trans, const integer *m, const integer *n,
+ const integer *k, doublereal *a, const integer *lda, const doublereal *tau, doublereal *c,
+ const integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical left;
+ static integer i;
+ static integer i1, i2, i3, ic, jc, mi, ni, nq;
+ static logical notran;
+ static doublereal aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DORM2R overwrites the general real m by n matrix C with */
+/* */
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+/* */
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+/* */
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+/* */
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+/* */
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,K) */
+/* The i-th column must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGEQRF in the first k columns of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* If SIDE = 'L', LDA >= max(1,M); */
+/* if SIDE = 'R', LDA >= max(1,N). */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+/* */
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORM2R", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return;
+ }
+
+ if ( (left && ! notran) || ( ! left && notran) ) {
+ i1 = 0;
+ i2 = *k - 1;
+ i3 = 1;
+ } else {
+ i1 = *k - 1;
+ i2 = 0;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 0;
+ } else {
+ mi = *m;
+ ic = 0;
+ }
+
+ for (i = i1; i3 < 0 ? i >= i2 : i <= i2; i += i3) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i;
+ ic = i;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i;
+ jc = i;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.;
+ dlarf_(side, &mi, &ni, &a[i + i * *lda], &c__1, &tau[i], &c[ic + jc * *ldc], ldc, work);
+ a[i + i * *lda] = aii;
+ }
+} /* dorm2r_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..74dd845ef720d92e4bf7e11e0420304e5597225d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dorm2r.f
@@ -0,0 +1,198 @@
+ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+ $ WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, K, LDA, LDC, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORM2R overwrites the general real m by n matrix C with
+*
+* Q * C if SIDE = 'L' and TRANS = 'N', or
+*
+* Q'* C if SIDE = 'L' and TRANS = 'T', or
+*
+* C * Q if SIDE = 'R' and TRANS = 'N', or
+*
+* C * Q' if SIDE = 'R' and TRANS = 'T',
+*
+* where Q is a real orthogonal matrix defined as the product of k
+* elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
+* if SIDE = 'R'.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply Q or Q' from the Left
+* = 'R': apply Q or Q' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply Q (No transpose)
+* = 'T': apply Q' (Transpose)
+*
+* M (input) INTEGER
+* The number of rows of the matrix C. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C. N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines
+* the matrix Q.
+* If SIDE = 'L', M >= K >= 0;
+* if SIDE = 'R', N >= K >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,K)
+* The i-th column must contain the vector which defines the
+* elementary reflector H(i), for i = 1,2,...,k, as returned by
+* DGEQRF in the first k columns of its array argument A.
+* A is modified by the routine but restored on exit.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A.
+* If SIDE = 'L', LDA >= max(1,M);
+* if SIDE = 'R', LDA >= max(1,N).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGEQRF.
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension
+* (N) if SIDE = 'L',
+* (M) if SIDE = 'R'
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFT, NOTRAN
+ INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
+ DOUBLE PRECISION AII
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LEFT = LSAME( SIDE, 'L' )
+ NOTRAN = LSAME( TRANS, 'N' )
+*
+* NQ is the order of Q
+*
+ IF( LEFT ) THEN
+ NQ = M
+ ELSE
+ NQ = N
+ END IF
+ IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -2
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
+ INFO = -7
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORM2R', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+ $ RETURN
+*
+ IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
+ $ THEN
+ I1 = 1
+ I2 = K
+ I3 = 1
+ ELSE
+ I1 = K
+ I2 = 1
+ I3 = -1
+ END IF
+*
+ IF( LEFT ) THEN
+ NI = N
+ JC = 1
+ ELSE
+ MI = M
+ IC = 1
+ END IF
+*
+ DO 10 I = I1, I2, I3
+ IF( LEFT ) THEN
+*
+* H(i) is applied to C(i:m,1:n)
+*
+ MI = M - I + 1
+ IC = I
+ ELSE
+*
+* H(i) is applied to C(1:m,i:n)
+*
+ NI = N - I + 1
+ JC = I
+ END IF
+*
+* Apply H(i)
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
+ $ LDC, WORK )
+ A( I, I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of DORM2R
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..8c6b6d7852ffddefaba970049714f50c17d5de18
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.c
@@ -0,0 +1,276 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static ftnlen cc__2 = 2;
+static integer c__65 = 65;
+
+/* Subroutine */ void dormqr_(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
+const char *side, *trans;
+const integer *m, *n, *k;
+doublereal *a;
+const integer *lda;
+doublereal *tau, *c;
+const integer *ldc;
+doublereal *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1;
+ ftnlen i__2[2];
+ char ch__1[2];
+
+ /* Local variables */
+ static logical left;
+ static integer i;
+ static doublereal t[4160] /* was [65][64] */;
+ static integer nbmin, iinfo, i1, i2, i3;
+ static integer ib, ic, jc, nb, mi, ni;
+ static integer nq, nw;
+ static logical notran;
+ static integer ldwork, lwkopt;
+ static logical lquery;
+ static integer iws;
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DORMQR overwrites the general real M-by-N matrix C with */
+/* */
+/* SIDE = 'L' SIDE = 'R' */
+/* TRANS = 'N': Q * C C * Q */
+/* TRANS = 'T': Q**T * C C * Q**T */
+/* */
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N */
+/* if SIDE = 'R'. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q**T from the Left; */
+/* = 'R': apply Q or Q**T from the Right. */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': No transpose, apply Q; */
+/* = 'T': Transpose, apply Q**T. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension (LDA,K) */
+/* The i-th column must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGEQRF in the first k columns of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* If SIDE = 'L', LDA >= max(1,M); */
+/* if SIDE = 'R', LDA >= max(1,N). */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+/* */
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the M-by-N matrix C. */
+/* On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. */
+/* If SIDE = 'L', LWORK >= max(1,N); */
+/* if SIDE = 'R', LWORK >= max(1,M). */
+/* For optimum performance LWORK >= N*NB if SIDE = 'L', and */
+/* LWORK >= M*NB if SIDE = 'R', where NB is the optimal */
+/* blocksize. */
+/* */
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c -= c_offset;
+ --work;
+
+/* Test the input arguments */
+
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if (*lwork < max(1,nw) && ! lquery) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/* Determine the block size. NB may be at most NBMAX, where NBMAX */
+/* is used to define the local array T. */
+
+/* Writing concatenation */
+ i__2[0] = 1, a__1[0] = side;
+ i__2[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__2, &cc__2, (ftnlen)2);
+ nb = ilaenv_(&c__1, "DORMQR", ch__1, m, n, k, &c_n1);
+ nb = min(64,nb);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMQR", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if (nb > 1 && nb < *k) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/* Writing concatenation */
+ i__2[0] = 1, a__1[0] = side;
+ i__2[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__2, &cc__2, (ftnlen)2);
+ nbmin = ilaenv_(&c__2, "DORMQR", ch__1, m, n, k, &c_n1);
+ nbmin = max(2,nbmin);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorm2r_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c[c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ( (left && ! notran) || (! left && notran) ) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ for (i = i1; i3 < 0 ? i >= i2 : i <= i2; i += i3) {
+ ib = min(nb, *k - i + 1);
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__1 = nq - i + 1;
+ dlarft_("Forward", "Columnwise", &i__1, &ib, &a[i + i * a_dim1], lda, &tau[i], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i + 1;
+ ic = i;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i + 1;
+ jc = i;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib,
+ &a[i + i * a_dim1], lda, t, &c__65, &c[ic + jc * c_dim1], ldc, &work[1], &ldwork);
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+
+} /* dormqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..57315ae6083ebe6b4157e2f13bdd1b4764e849cc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormqr.f
@@ -0,0 +1,261 @@
+ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+ $ WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, K, LDA, LDC, LWORK, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORMQR overwrites the general real M-by-N matrix C with
+*
+* SIDE = 'L' SIDE = 'R'
+* TRANS = 'N': Q * C C * Q
+* TRANS = 'T': Q**T * C C * Q**T
+*
+* where Q is a real orthogonal matrix defined as the product of k
+* elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
+* if SIDE = 'R'.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply Q or Q**T from the Left;
+* = 'R': apply Q or Q**T from the Right.
+*
+* TRANS (input) CHARACTER*1
+* = 'N': No transpose, apply Q;
+* = 'T': Transpose, apply Q**T.
+*
+* M (input) INTEGER
+* The number of rows of the matrix C. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C. N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines
+* the matrix Q.
+* If SIDE = 'L', M >= K >= 0;
+* if SIDE = 'R', N >= K >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA,K)
+* The i-th column must contain the vector which defines the
+* elementary reflector H(i), for i = 1,2,...,k, as returned by
+* DGEQRF in the first k columns of its array argument A.
+* A is modified by the routine but restored on exit.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A.
+* If SIDE = 'L', LDA >= max(1,M);
+* if SIDE = 'R', LDA >= max(1,N).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGEQRF.
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+* On entry, the M-by-N matrix C.
+* On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK.
+* If SIDE = 'L', LWORK >= max(1,N);
+* if SIDE = 'R', LWORK >= max(1,M).
+* For optimum performance LWORK >= N*NB if SIDE = 'L', and
+* LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+* blocksize.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER NBMAX, LDT
+ PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFT, LQUERY, NOTRAN
+ INTEGER I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
+ $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
+* ..
+* .. Local Arrays ..
+ DOUBLE PRECISION T( LDT, NBMAX )
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LEFT = LSAME( SIDE, 'L' )
+ NOTRAN = LSAME( TRANS, 'N' )
+ LQUERY = ( LWORK.EQ.-1 )
+*
+* NQ is the order of Q and NW is the minimum dimension of WORK
+*
+ IF( LEFT ) THEN
+ NQ = M
+ NW = N
+ ELSE
+ NQ = N
+ NW = M
+ END IF
+ IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -2
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
+ INFO = -7
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
+ INFO = -12
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+*
+* Determine the block size. NB may be at most NBMAX, where NBMAX
+* is used to define the local array T.
+*
+ NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
+ $ -1 ) )
+ LWKOPT = MAX( 1, NW )*NB
+ WORK( 1 ) = LWKOPT
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORMQR', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+ NBMIN = 2
+ LDWORK = NW
+ IF( NB.GT.1 .AND. NB.LT.K ) THEN
+ IWS = NW*NB
+ IF( LWORK.LT.IWS ) THEN
+ NB = LWORK / LDWORK
+ NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
+ $ -1 ) )
+ END IF
+ ELSE
+ IWS = NW
+ END IF
+*
+ IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
+* Use unblocked code
+*
+ CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
+ $ IINFO )
+ ELSE
+*
+* Use blocked code
+*
+ IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
+ $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
+ I1 = 1
+ I2 = K
+ I3 = NB
+ ELSE
+ I1 = ( ( K-1 ) / NB )*NB + 1
+ I2 = 1
+ I3 = -NB
+ END IF
+*
+ IF( LEFT ) THEN
+ NI = N
+ JC = 1
+ ELSE
+ MI = M
+ IC = 1
+ END IF
+*
+ DO 10 I = I1, I2, I3
+ IB = MIN( NB, K-I+1 )
+*
+* Form the triangular factor of the block reflector
+* H = H(i) H(i+1) . . . H(i+ib-1)
+*
+ CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
+ $ LDA, TAU( I ), T, LDT )
+ IF( LEFT ) THEN
+*
+* H or H' is applied to C(i:m,1:n)
+*
+ MI = M - I + 1
+ IC = I
+ ELSE
+*
+* H or H' is applied to C(1:m,i:n)
+*
+ NI = N - I + 1
+ JC = I
+ END IF
+*
+* Apply H or H'
+*
+ CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
+ $ IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
+ $ WORK, LDWORK )
+ 10 CONTINUE
+ END IF
+ WORK( 1 ) = LWKOPT
+ RETURN
+*
+* End of DORMQR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.c
new file mode 100644
index 0000000000000000000000000000000000000000..aea4c91e3ab0cddb65415c558ed600151d4d483d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.c
@@ -0,0 +1,174 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *c, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical left;
+ static integer i;
+ static integer i1, i2, i3, mi, ni, nq;
+ static logical notran;
+ static doublereal aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DORMR2 overwrites the general real m by n matrix C with */
+/* */
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+/* */
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+/* */
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+/* */
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+/* */
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+/* */
+/* A (input) DOUBLE PRECISION array, dimension */
+/* (LDA,M) if SIDE = 'L', */
+/* (LDA,N) if SIDE = 'R' */
+/* The i-th row must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGERQF in the last k rows of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,K). */
+/* */
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGERQF. */
+/* */
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMR2", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return;
+ }
+
+ if ( (left && !notran) || (!left && notran) ) {
+ i1 = 0;
+ i2 = *k - 1;
+ i3 = 1;
+ } else {
+ i1 = *k - 1;
+ i2 = 0;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ for (i = i1; i3 < 0 ? i >= i2 : i <= i2; i += i3) {
+ if (left) {
+
+/* H(i) is applied to C(1:m-k+i,1:n) */
+
+ mi = *m - *k + i + 1;
+ } else {
+
+/* H(i) is applied to C(1:m,1:n-k+i) */
+
+ ni = *n - *k + i + 1;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i + (nq - *k + i) * *lda];
+ a[i + (nq - *k + i) * *lda] = 1.;
+ dlarf_(side, &mi, &ni, &a[i], lda, &tau[i], c, ldc, work);
+ a[i + (nq - *k + i) * *lda] = aii;
+ }
+} /* dormr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.f
new file mode 100644
index 0000000000000000000000000000000000000000..fc2870474fc9969c75c6b6af9bbb0a38247d370c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dormr2.f
@@ -0,0 +1,194 @@
+ SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+ $ WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, K, LDA, LDC, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DORMR2 overwrites the general real m by n matrix C with
+*
+* Q * C if SIDE = 'L' and TRANS = 'N', or
+*
+* Q'* C if SIDE = 'L' and TRANS = 'T', or
+*
+* C * Q if SIDE = 'R' and TRANS = 'N', or
+*
+* C * Q' if SIDE = 'R' and TRANS = 'T',
+*
+* where Q is a real orthogonal matrix defined as the product of k
+* elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
+* if SIDE = 'R'.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply Q or Q' from the Left
+* = 'R': apply Q or Q' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply Q (No transpose)
+* = 'T': apply Q' (Transpose)
+*
+* M (input) INTEGER
+* The number of rows of the matrix C. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C. N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines
+* the matrix Q.
+* If SIDE = 'L', M >= K >= 0;
+* if SIDE = 'R', N >= K >= 0.
+*
+* A (input) DOUBLE PRECISION array, dimension
+* (LDA,M) if SIDE = 'L',
+* (LDA,N) if SIDE = 'R'
+* The i-th row must contain the vector which defines the
+* elementary reflector H(i), for i = 1,2,...,k, as returned by
+* DGERQF in the last k rows of its array argument A.
+* A is modified by the routine but restored on exit.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,K).
+*
+* TAU (input) DOUBLE PRECISION array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by DGERQF.
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension
+* (N) if SIDE = 'L',
+* (M) if SIDE = 'R'
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFT, NOTRAN
+ INTEGER I, I1, I2, I3, MI, NI, NQ
+ DOUBLE PRECISION AII
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LEFT = LSAME( SIDE, 'L' )
+ NOTRAN = LSAME( TRANS, 'N' )
+*
+* NQ is the order of Q
+*
+ IF( LEFT ) THEN
+ NQ = M
+ ELSE
+ NQ = N
+ END IF
+ IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -2
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+ INFO = -7
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DORMR2', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+ $ RETURN
+*
+ IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
+ $ THEN
+ I1 = 1
+ I2 = K
+ I3 = 1
+ ELSE
+ I1 = K
+ I2 = 1
+ I3 = -1
+ END IF
+*
+ IF( LEFT ) THEN
+ NI = N
+ ELSE
+ MI = M
+ END IF
+*
+ DO 10 I = I1, I2, I3
+ IF( LEFT ) THEN
+*
+* H(i) is applied to C(1:m-k+i,1:n)
+*
+ MI = M - K + I
+ ELSE
+*
+* H(i) is applied to C(1:m,1:n-k+i)
+*
+ NI = N - K + I
+ END IF
+*
+* Apply H(i)
+*
+ AII = A( I, NQ-K+I )
+ A( I, NQ-K+I ) = ONE
+ CALL DLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
+ $ WORK )
+ A( I, NQ-K+I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of DORMR2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.c
new file mode 100644
index 0000000000000000000000000000000000000000..b24d16cf49e6036c7ad0ac2a7e6a5ddfc168365d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.c
@@ -0,0 +1,242 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dpoco_(a, lda, n, rcond, z, info)
+doublereal *a;
+integer *lda, *n;
+doublereal *rcond, *z;
+integer *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j, k;
+ static doublereal s, t;
+ static doublereal anorm;
+ static doublereal ynorm;
+ static integer kb;
+ static doublereal ek, sm, wk;
+ static integer jm1, kp1;
+ static doublereal wkm;
+
+/* dpoco factors a double precision symmetric positive definite */
+/* matrix and estimates the condition of the matrix. */
+/* */
+/* if rcond is not needed, dpofa is slightly faster. */
+/* to solve a*x = b , follow dpoco by dposl. */
+/* to compute inverse(a)*c , follow dpoco by dposl. */
+/* to compute determinant(a) , follow dpoco by dpodi. */
+/* to compute inverse(a) , follow dpoco by dpodi. */
+/* */
+/* on entry */
+/* */
+/* a double precision(lda, n) */
+/* the symmetric matrix to be factored. only the */
+/* diagonal and upper triangle are used. */
+/* */
+/* lda integer */
+/* the leading dimension of the array a . */
+/* */
+/* n integer */
+/* the order of the matrix a . */
+/* */
+/* on return */
+/* */
+/* a an upper triangular matrix r so that a = trans(r)*r */
+/* where trans(r) is the transpose. */
+/* the strict lower triangle is unaltered. */
+/* if info .ne. 0 , the factorization is not complete. */
+/* */
+/* rcond double precision */
+/* an estimate of the reciprocal condition of a . */
+/* for the system a*x = b , relative perturbations */
+/* in a and b of size epsilon may cause */
+/* relative perturbations in x of size epsilon/rcond .*/
+/* if rcond is so small that the logical expression */
+/* 1.0 + rcond .eq. 1.0 */
+/* is true, then a may be singular to working */
+/* precision. in particular, rcond is zero if */
+/* exact singularity is detected or the estimate */
+/* underflows. if info .ne. 0 , rcond is unchanged. */
+/* */
+/* z double precision(n) */
+/* a work vector whose contents are usually unimportant. */
+/* if a is close to a singular matrix, then z is */
+/* an approximate null vector in the sense that */
+/* norm(a*z) = rcond*norm(a)*norm(z) . */
+/* if info .ne. 0 , z is unchanged. */
+/* */
+/* info integer */
+/* = 0 for normal return. */
+/* = k signals an error condition. the leading minor */
+/* of order k is not positive definite. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* cleve moler, university of new mexico, argonne national lab. */
+
+/* subroutines and functions */
+/* */
+/* linpack dpofa */
+/* blas daxpy,ddot,dscal,dasum */
+/* fortran dabs,dmax1,dreal,dsign */
+
+
+ /* Parameter adjustments */
+ --z;
+ a_dim1 = *lda;
+ a_offset = a_dim1 + 1;
+ a -= a_offset;
+
+/* find norm of a using only upper half */
+
+ for (j = 1; j <= *n; ++j) {
+ z[j] = dasum_(&j, &a[j * a_dim1 + 1], &c__1);
+ jm1 = j - 1;
+ if (jm1 < 1) {
+ goto L20;
+ }
+ for (i = 1; i <= jm1; ++i) {
+ z[i] += abs(a[i + j * a_dim1]);
+ }
+L20:
+ ;
+ }
+ anorm = 0.;
+ for (j = 1; j <= *n; ++j) {
+ anorm = max(anorm,z[j]);
+ }
+
+/* factor */
+
+ dpofa_(&a[a_offset], lda, n, info);
+ if (*info != 0) {
+ goto L180;
+ }
+
+/* rcond = 1/(norm(a)*(estimate of norm(inverse(a)))) . */
+/* estimate = norm(z)/norm(y) where a*z = y and a*y = e . */
+/* the components of e are chosen to cause maximum local */
+/* growth in the elements of w where trans(r)*w = e . */
+/* the vectors are frequently rescaled to avoid overflow. */
+
+/* solve trans(r)*w = e */
+
+ ek = 1.;
+ for (j = 1; j <= *n; ++j) {
+ z[j] = 0.;
+ }
+ for (k = 1; k <= *n; ++k) {
+ if (z[k] != 0.) {
+ d__1 = -z[k];
+ ek = d_sign(&ek, &d__1);
+ }
+ if (abs(ek - z[k]) <= a[k + k * a_dim1]) {
+ goto L60;
+ }
+ s = a[k + k * a_dim1] / abs(ek - z[k]);
+ dscal_(n, &s, &z[1], &c__1);
+ ek *= s;
+L60:
+ wk = ek - z[k];
+ wkm = -ek - z[k];
+ s = abs(wk);
+ sm = abs(wkm);
+ wk /= a[k + k * a_dim1];
+ wkm /= a[k + k * a_dim1];
+ kp1 = k + 1;
+ if (kp1 > *n) {
+ goto L100;
+ }
+ for (j = kp1; j <= *n; ++j) {
+ sm += abs(z[j] + wkm * a[k + j * a_dim1]);
+ z[j] += wk * a[k + j * a_dim1];
+ s += abs(z[j]);
+ }
+ if (s >= sm) {
+ goto L90;
+ }
+ t = wkm - wk;
+ wk = wkm;
+ for (j = kp1; j <= *n; ++j) {
+ z[j] += t * a[k + j * a_dim1];
+ }
+L90:
+L100:
+ z[k] = wk;
+ }
+ s = 1. / dasum_(n, &z[1], &c__1);
+ dscal_(n, &s, &z[1], &c__1);
+
+/* solve r*y = w */
+
+ for (kb = 1; kb <= *n; ++kb) {
+ k = *n + 1 - kb;
+ if (abs(z[k]) <= a[k + k * a_dim1]) {
+ goto L120;
+ }
+ s = a[k + k * a_dim1] / abs(z[k]);
+ dscal_(n, &s, &z[1], &c__1);
+L120:
+ z[k] /= a[k + k * a_dim1];
+ t = -z[k];
+ i__1 = k - 1;
+ daxpy_(&i__1, &t, &a[k * a_dim1 + 1], &c__1, &z[1], &c__1);
+ }
+ s = 1. / dasum_(n, &z[1], &c__1);
+ dscal_(n, &s, &z[1], &c__1);
+
+ ynorm = 1.;
+
+/* solve trans(r)*v = y */
+
+ for (k = 1; k <= *n; ++k) {
+ i__1 = k - 1;
+ z[k] -= ddot_(&i__1, &a[k * a_dim1 + 1], &c__1, &z[1], &c__1);
+ if (abs(z[k]) <= a[k + k * a_dim1]) {
+ goto L140;
+ }
+ s = a[k + k * a_dim1] / abs(z[k]);
+ dscal_(n, &s, &z[1], &c__1);
+ ynorm *= s;
+L140:
+ z[k] /= a[k + k * a_dim1];
+ }
+ s = 1. / dasum_(n, &z[1], &c__1);
+ dscal_(n, &s, &z[1], &c__1);
+ ynorm *= s;
+
+/* solve r*z = v */
+
+ for (kb = 1; kb <= *n; ++kb) {
+ k = *n + 1 - kb;
+ if (abs(z[k]) <= a[k + k * a_dim1]) {
+ goto L160;
+ }
+ s = a[k + k * a_dim1] / abs(z[k]);
+ dscal_(n, &s, &z[1], &c__1);
+ ynorm *= s;
+L160:
+ z[k] /= a[k + k * a_dim1];
+ t = -z[k];
+ i__1 = k - 1;
+ daxpy_(&i__1, &t, &a[k * a_dim1 + 1], &c__1, &z[1], &c__1);
+ }
+/* make znorm = 1.0 */
+ s = 1. / dasum_(n, &z[1], &c__1);
+ dscal_(n, &s, &z[1], &c__1);
+ ynorm *= s;
+
+ if (anorm != 0.) {
+ *rcond = ynorm / anorm;
+ }
+ if (anorm == 0.) {
+ *rcond = 0.;
+ }
+L180:
+ return;
+} /* dpoco_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.f
new file mode 100644
index 0000000000000000000000000000000000000000..f6574e40d64358a3a4a9eded0d4f825a5c807ca9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpoco.f
@@ -0,0 +1,194 @@
+ subroutine dpoco(a,lda,n,rcond,z,info)
+ integer lda,n,info
+ double precision a(lda,1),z(1)
+ double precision rcond
+c
+c dpoco factors a double precision symmetric positive definite
+c matrix and estimates the condition of the matrix.
+c
+c if rcond is not needed, dpofa is slightly faster.
+c to solve a*x = b , follow dpoco by dposl.
+c to compute inverse(a)*c , follow dpoco by dposl.
+c to compute determinant(a) , follow dpoco by dpodi.
+c to compute inverse(a) , follow dpoco by dpodi.
+c
+c on entry
+c
+c a double precision(lda, n)
+c the symmetric matrix to be factored. only the
+c diagonal and upper triangle are used.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c on return
+c
+c a an upper triangular matrix r so that a = trans(r)*r
+c where trans(r) is the transpose.
+c the strict lower triangle is unaltered.
+c if info .ne. 0 , the factorization is not complete.
+c
+c rcond double precision
+c an estimate of the reciprocal condition of a .
+c for the system a*x = b , relative perturbations
+c in a and b of size epsilon may cause
+c relative perturbations in x of size epsilon/rcond .
+c if rcond is so small that the logical expression
+c 1.0 + rcond .eq. 1.0
+c is true, then a may be singular to working
+c precision. in particular, rcond is zero if
+c exact singularity is detected or the estimate
+c underflows. if info .ne. 0 , rcond is unchanged.
+c
+c z double precision(n)
+c a work vector whose contents are usually unimportant.
+c if a is close to a singular matrix, then z is
+c an approximate null vector in the sense that
+c norm(a*z) = rcond*norm(a)*norm(z) .
+c if info .ne. 0 , z is unchanged.
+c
+c info integer
+c = 0 for normal return.
+c = k signals an error condition. the leading minor
+c of order k is not positive definite.
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c linpack dpofa
+c blas daxpy,ddot,dscal,dasum
+c fortran dabs,dmax1,dreal,dsign
+c
+c internal variables
+c
+ double precision ddot,ek,t,wk,wkm
+ double precision anorm,s,dasum,sm,ynorm
+ integer i,j,jm1,k,kb,kp1
+c
+c
+c find norm of a using only upper half
+c
+ do 30 j = 1, n
+ z(j) = dasum(j,a(1,j),1)
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 20
+ do 10 i = 1, jm1
+ z(i) = z(i) + dabs(a(i,j))
+ 10 continue
+ 20 continue
+ 30 continue
+ anorm = 0.0d0
+ do 40 j = 1, n
+ anorm = dmax1(anorm,z(j))
+ 40 continue
+c
+c factor
+c
+ call dpofa(a,lda,n,info)
+ if (info .ne. 0) go to 180
+c
+c rcond = 1/(norm(a)*(estimate of norm(inverse(a)))) .
+c estimate = norm(z)/norm(y) where a*z = y and a*y = e .
+c the components of e are chosen to cause maximum local
+c growth in the elements of w where trans(r)*w = e .
+c the vectors are frequently rescaled to avoid overflow.
+c
+c solve trans(r)*w = e
+c
+ ek = 1.0d0
+ do 50 j = 1, n
+ z(j) = 0.0d0
+ 50 continue
+ do 110 k = 1, n
+ if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k))
+ if (dabs(ek-z(k)) .le. a(k,k)) go to 60
+ s = a(k,k)/dabs(ek-z(k))
+ call dscal(n,s,z,1)
+ ek = s*ek
+ 60 continue
+ wk = ek - z(k)
+ wkm = -ek - z(k)
+ s = dabs(wk)
+ sm = dabs(wkm)
+ wk = wk/a(k,k)
+ wkm = wkm/a(k,k)
+ kp1 = k + 1
+ if (kp1 .gt. n) go to 100
+ do 70 j = kp1, n
+ sm = sm + dabs(z(j)+wkm*a(k,j))
+ z(j) = z(j) + wk*a(k,j)
+ s = s + dabs(z(j))
+ 70 continue
+ if (s .ge. sm) go to 90
+ t = wkm - wk
+ wk = wkm
+ do 80 j = kp1, n
+ z(j) = z(j) + t*a(k,j)
+ 80 continue
+ 90 continue
+ 100 continue
+ z(k) = wk
+ 110 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+c
+c solve r*y = w
+c
+ do 130 kb = 1, n
+ k = n + 1 - kb
+ if (dabs(z(k)) .le. a(k,k)) go to 120
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ 120 continue
+ z(k) = z(k)/a(k,k)
+ t = -z(k)
+ call daxpy(k-1,t,a(1,k),1,z(1),1)
+ 130 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+c
+ ynorm = 1.0d0
+c
+c solve trans(r)*v = y
+c
+ do 150 k = 1, n
+ z(k) = z(k) - ddot(k-1,a(1,k),1,z(1),1)
+ if (dabs(z(k)) .le. a(k,k)) go to 140
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+ 140 continue
+ z(k) = z(k)/a(k,k)
+ 150 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+c
+c solve r*z = v
+c
+ do 170 kb = 1, n
+ k = n + 1 - kb
+ if (dabs(z(k)) .le. a(k,k)) go to 160
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+ 160 continue
+ z(k) = z(k)/a(k,k)
+ t = -z(k)
+ call daxpy(k-1,t,a(1,k),1,z(1),1)
+ 170 continue
+c make znorm = 1.0
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+c
+ if (anorm .ne. 0.0d0) rcond = ynorm/anorm
+ if (anorm .eq. 0.0d0) rcond = 0.0d0
+ 180 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.c
new file mode 100644
index 0000000000000000000000000000000000000000..ef337baf45f05c2448ec7a5ba4b37c6ecf69560d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.c
@@ -0,0 +1,129 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dpodi_(a, lda, n, det, job)
+doublereal *a;
+const integer *lda, *n;
+doublereal *det;
+const integer *job;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j, k;
+ static doublereal s, t;
+
+/* dpodi computes the determinant and inverse of a certain */
+/* double precision symmetric positive definite matrix (see below) */
+/* using the factors computed by dpoco, dpofa or dqrdc. */
+
+/* on entry */
+
+/* a double precision(lda, n) */
+/* the output a from dpoco or dpofa */
+/* or the output x from dqrdc. */
+
+/* lda integer */
+/* the leading dimension of the array a . */
+
+/* n integer */
+/* the order of the matrix a . */
+
+/* job integer */
+/* = 11 both determinant and inverse. */
+/* = 01 inverse only. */
+/* = 10 determinant only. */
+
+/* on return */
+
+/* a if dpoco or dpofa was used to factor a then */
+/* dpodi produces the upper half of inverse(a) . */
+/* if dqrdc was used to decompose x then */
+/* dpodi produces the upper half of inverse(trans(x)*x) */
+/* where trans(x) is the transpose. */
+/* elements of a below the diagonal are unchanged. */
+/* if the units digit of job is zero, a is unchanged. */
+
+/* det double precision(2) */
+/* determinant of a or of trans(x)*x if requested. */
+/* otherwise not referenced. */
+/* determinant = det(1) * 10.0**det(2) */
+/* with 1.0 .le. det(1) .lt. 10.0 */
+/* or det(1) .eq. 0.0 . */
+
+/* error condition */
+
+/* a division by zero will occur if the input factor contains */
+/* a zero on the diagonal and the inverse is requested. */
+/* it will not occur if the subroutines are called correctly */
+/* and if dpoco or dpofa has set info .eq. 0 . */
+
+/* linpack. this version dated 08/14/78 . */
+/* cleve moler, university of new mexico, argonne national lab. */
+
+/* subroutines and functions */
+
+/* blas daxpy,dscal */
+/* fortran mod */
+
+/* compute determinant */
+
+ if (*job / 10 == 0) {
+ goto L70;
+ }
+
+ det[0] = 1.;
+ det[1] = 0.;
+ s = 10.;
+ for (i = 0; i < *n; ++i) {
+ d__1 = a[i + i * *lda];
+ det[0] *= d__1 * d__1;
+ if (det[0] == 0.) {
+ break;
+ }
+ while (det[0] < 1.) {
+ det[0] *= s;
+ det[1] += -1.;
+ }
+ while (det[0] >= s) {
+ det[0] /= s;
+ det[1] += 1.;
+ }
+ }
+
+/* compute inverse(r) */
+
+L70:
+ if (*job % 10 == 0) {
+ return;
+ }
+ for (k = 0; k < *n; ++k) {
+ a[k + k * *lda] = 1. / a[k + k * *lda];
+ t = -a[k + k * *lda];
+ dscal_(&k, &t, &a[k * *lda], &c__1);
+ for (j = k+1; j < *n; ++j) {
+ t = a[k + j * *lda];
+ a[k + j * *lda] = 0.;
+ i__1 = k+1;
+ daxpy_(&i__1, &t, &a[k * *lda], &c__1, &a[j * *lda], &c__1);
+ }
+ }
+
+/* form inverse(r) * trans(inverse(r)) */
+
+ for (j = 0; j < *n; ++j) {
+ for (k = 0; k < j; ++k) {
+ t = a[k + j * *lda];
+ i__1 = k+1;
+ daxpy_(&i__1, &t, &a[j * *lda], &c__1, &a[k * *lda], &c__1);
+ }
+ t = a[j + j * *lda];
+ i__1 = j+1;
+ dscal_(&i__1, &t, &a[j * *lda], &c__1);
+ }
+} /* dpodi_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.f
new file mode 100644
index 0000000000000000000000000000000000000000..b4b2c3e3728e5cd5bf7616bf121bb1d7ee07ed35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpodi.f
@@ -0,0 +1,121 @@
+ subroutine dpodi(a,lda,n,det,job)
+ integer lda,n,job
+ double precision a(lda,1)
+ double precision det(2)
+c
+c dpodi computes the determinant and inverse of a certain
+c double precision symmetric positive definite matrix (see below)
+c using the factors computed by dpoco, dpofa or dqrdc.
+c
+c on entry
+c
+c a double precision(lda, n)
+c the output a from dpoco or dpofa
+c or the output x from dqrdc.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c job integer
+c = 11 both determinant and inverse.
+c = 01 inverse only.
+c = 10 determinant only.
+c
+c on return
+c
+c a if dpoco or dpofa was used to factor a then
+c dpodi produces the upper half of inverse(a) .
+c if dqrdc was used to decompose x then
+c dpodi produces the upper half of inverse(trans(x)*x)
+c where trans(x) is the transpose.
+c elements of a below the diagonal are unchanged.
+c if the units digit of job is zero, a is unchanged.
+c
+c det double precision(2)
+c determinant of a or of trans(x)*x if requested.
+c otherwise not referenced.
+c determinant = det(1) * 10.0**det(2)
+c with 1.0 .le. det(1) .lt. 10.0
+c or det(1) .eq. 0.0 .
+c
+c error condition
+c
+c a division by zero will occur if the input factor contains
+c a zero on the diagonal and the inverse is requested.
+c it will not occur if the subroutines are called correctly
+c and if dpoco or dpofa has set info .eq. 0 .
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c blas daxpy,dscal
+c fortran mod
+c
+c internal variables
+c
+ double precision t
+ double precision s
+ integer i,j,jm1,k,kp1
+c
+c compute determinant
+c
+ if (job/10 .eq. 0) go to 70
+ det(1) = 1.0d0
+ det(2) = 0.0d0
+ s = 10.0d0
+ do 50 i = 1, n
+ det(1) = a(i,i)**2*det(1)
+c ...exit
+ if (det(1) .eq. 0.0d0) go to 60
+ 10 if (det(1) .ge. 1.0d0) go to 20
+ det(1) = s*det(1)
+ det(2) = det(2) - 1.0d0
+ go to 10
+ 20 continue
+ 30 if (det(1) .lt. s) go to 40
+ det(1) = det(1)/s
+ det(2) = det(2) + 1.0d0
+ go to 30
+ 40 continue
+ 50 continue
+ 60 continue
+ 70 continue
+c
+c compute inverse(r)
+c
+ if (mod(job,10) .eq. 0) go to 140
+ do 100 k = 1, n
+ a(k,k) = 1.0d0/a(k,k)
+ t = -a(k,k)
+ call dscal(k-1,t,a(1,k),1)
+ kp1 = k + 1
+ if (n .lt. kp1) go to 90
+ do 80 j = kp1, n
+ t = a(k,j)
+ a(k,j) = 0.0d0
+ call daxpy(k,t,a(1,k),1,a(1,j),1)
+ 80 continue
+ 90 continue
+ 100 continue
+c
+c form inverse(r) * trans(inverse(r))
+c
+ do 130 j = 1, n
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 120
+ do 110 k = 1, jm1
+ t = a(k,j)
+ call daxpy(k,t,a(1,j),1,a(1,k),1)
+ 110 continue
+ 120 continue
+ t = a(j,j)
+ call dscal(j,t,a(1,j),1)
+ 130 continue
+ 140 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.c
new file mode 100644
index 0000000000000000000000000000000000000000..3a15fa5a5e3790c55ca88334badf0f1419a3da74
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.c
@@ -0,0 +1,66 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dpofa_(a, lda, n, info)
+doublereal *a;
+integer *lda, *n, *info;
+{
+ /* Local variables */
+ static integer j, k;
+ static doublereal s, t;
+
+/* dpofa factors a double precision symmetric positive definite */
+/* matrix. */
+/* */
+/* dpofa is usually called by dpoco, but it can be called */
+/* directly with a saving in time if rcond is not needed. */
+/* (time for dpoco) = (1 + 18/n)*(time for dpofa) . */
+/* */
+/* on entry */
+/* */
+/* a double precision(lda, n) */
+/* the symmetric matrix to be factored. only the */
+/* diagonal and upper triangle are used. */
+/* */
+/* lda integer */
+/* the leading dimension of the array a . */
+/* */
+/* n integer */
+/* the order of the matrix a . */
+/* */
+/* on return */
+/* */
+/* a an upper triangular matrix r so that a = trans(r)*r */
+/* where trans(r) is the transpose. */
+/* the strict lower triangle is unaltered. */
+/* if info .ne. 0 , the factorization is not complete. */
+/* */
+/* info integer */
+/* = 0 for normal return. */
+/* = k signals an error condition. the leading minor */
+/* of order k is not positive definite. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* cleve moler, university of new mexico, argonne national lab. */
+
+ for (j = 0; j < *n; ++j) {
+ *info = j+1;
+ s = 0.;
+ for (k = 0; k < j; ++k) {
+ t = a[k + j * *lda] - ddot_(&k, &a[k * *lda], &c__1, &a[j * *lda], &c__1);
+ t /= a[k + k * *lda];
+ a[k + j * *lda] = t;
+ s += t * t;
+ }
+ s = a[j + j * *lda] - s;
+ if (s <= 0.) {
+ return;
+ }
+ a[j + j * *lda] = sqrt(s);
+ }
+ *info = 0;
+} /* dpofa_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.f
new file mode 100644
index 0000000000000000000000000000000000000000..f0b92e164da281c9f6965f76729e530958028ddf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dpofa.f
@@ -0,0 +1,72 @@
+ subroutine dpofa(a,lda,n,info)
+ integer lda,n,info
+ double precision a(lda,1)
+c
+c dpofa factors a double precision symmetric positive definite
+c matrix.
+c
+c dpofa is usually called by dpoco, but it can be called
+c directly with a saving in time if rcond is not needed.
+c (time for dpoco) = (1 + 18/n)*(time for dpofa) .
+c
+c on entry
+c
+c a double precision(lda, n)
+c the symmetric matrix to be factored. only the
+c diagonal and upper triangle are used.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c on return
+c
+c a an upper triangular matrix r so that a = trans(r)*r
+c where trans(r) is the transpose.
+c the strict lower triangle is unaltered.
+c if info .ne. 0 , the factorization is not complete.
+c
+c info integer
+c = 0 for normal return.
+c = k signals an error condition. the leading minor
+c of order k is not positive definite.
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c blas ddot
+c fortran dsqrt
+c
+c internal variables
+c
+ double precision ddot,t
+ double precision s
+ integer j,jm1,k
+c begin block with ...exits to 40
+c
+c
+ do 30 j = 1, n
+ info = j
+ s = 0.0d0
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 20
+ do 10 k = 1, jm1
+ t = a(k,j) - ddot(k-1,a(1,k),1,a(1,j),1)
+ t = t/a(k,k)
+ a(k,j) = t
+ s = s + t*t
+ 10 continue
+ 20 continue
+ s = a(j,j) - s
+c ......exit
+ if (s .le. 0.0d0) go to 40
+ a(j,j) = dsqrt(s)
+ 30 continue
+ info = 0
+ 40 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.c
new file mode 100644
index 0000000000000000000000000000000000000000..202da826c8e156b07ee1729229572480c69ce2f6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.c
@@ -0,0 +1,74 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dposl_(a, lda, n, b)
+const doublereal *a;
+const integer *lda, *n;
+doublereal *b;
+{
+ /* Local variables */
+ static integer k;
+ static doublereal t;
+
+/* dposl solves the double precision symmetric positive definite */
+/* system a * x = b */
+/* using the factors computed by dpoco or dpofa. */
+/* */
+/* on entry */
+/* */
+/* a double precision(lda, n) */
+/* the output from dpoco or dpofa. */
+/* */
+/* lda integer */
+/* the leading dimension of the array a . */
+/* */
+/* n integer */
+/* the order of the matrix a . */
+/* */
+/* b double precision(n) */
+/* the right hand side vector. */
+/* */
+/* on return */
+/* */
+/* b the solution vector x . */
+/* */
+/* error condition */
+/* */
+/* a division by zero will occur if the input factor contains */
+/* a zero on the diagonal. technically this indicates */
+/* singularity but it is usually caused by improper subroutine */
+/* arguments. it will not occur if the subroutines are called */
+/* correctly and info .eq. 0 . */
+/* */
+/* to compute inverse(a) * c where c is a matrix */
+/* with p columns */
+/* call dpoco(a,lda,n,rcond,z,info) */
+/* if (rcond is too small .or. info .ne. 0) go to ... */
+/* do 10 j = 1, p */
+/* call dposl(a,lda,n,c(1,j)) */
+/* 10 continue */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* cleve moler, university of new mexico, argonne national lab. */
+
+/* subroutines and functions */
+/* blas daxpy,ddot */
+
+/* solve trans(r)*y = b */
+
+ for (k = 0; k < *n; ++k) {
+ t = ddot_(&k, &a[k * *lda], &c__1, b, &c__1);
+ b[k] = (b[k] - t) / a[k + k * *lda];
+ }
+
+/* solve r*x = y */
+
+ for (k = *n - 1; k >= 0; --k) {
+ b[k] /= a[k + k * *lda];
+ t = -b[k];
+ daxpy_(&k, &t, &a[k * *lda], &c__1, b, &c__1);
+ }
+} /* dposl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.f
new file mode 100644
index 0000000000000000000000000000000000000000..5bf6f3bdcf018025968f07257730d465bd2d7cac
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dposl.f
@@ -0,0 +1,71 @@
+ subroutine dposl(a,lda,n,b)
+ integer lda,n
+ double precision a(lda,1),b(1)
+c
+c dposl solves the double precision symmetric positive definite
+c system a * x = b
+c using the factors computed by dpoco or dpofa.
+c
+c on entry
+c
+c a double precision(lda, n)
+c the output from dpoco or dpofa.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c b double precision(n)
+c the right hand side vector.
+c
+c on return
+c
+c b the solution vector x .
+c
+c error condition
+c
+c a division by zero will occur if the input factor contains
+c a zero on the diagonal. technically this indicates
+c singularity but it is usually caused by improper subroutine
+c arguments. it will not occur if the subroutines are called
+c correctly and info .eq. 0 .
+c
+c to compute inverse(a) * c where c is a matrix
+c with p columns
+c call dpoco(a,lda,n,rcond,z,info)
+c if (rcond is too small .or. info .ne. 0) go to ...
+c do 10 j = 1, p
+c call dposl(a,lda,n,c(1,j))
+c 10 continue
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c blas daxpy,ddot
+c
+c internal variables
+c
+ double precision ddot,t
+ integer k,kb
+c
+c solve trans(r)*y = b
+c
+ do 10 k = 1, n
+ t = ddot(k-1,a(1,k),1,b(1),1)
+ b(k) = (b(k) - t)/a(k,k)
+ 10 continue
+c
+c solve r*x = y
+c
+ do 20 kb = 1, n
+ k = n + 1 - kb
+ b(k) = b(k)/a(k,k)
+ t = -b(k)
+ call daxpy(k-1,t,a(1,k),1,b(1),1)
+ 20 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..ed5b69357c9dd5d5b8c3695d5fab42e81fa8ddc1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.c
@@ -0,0 +1,240 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dqrdc_(x, ldx, n, p, qraux, jpvt, work, job)
+doublereal *x;
+const integer *ldx, *n, *p;
+doublereal *qraux;
+integer *jpvt;
+doublereal *work;
+const integer *job;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static logical negj;
+ static integer maxj;
+ static integer j, l;
+ static doublereal t;
+ static logical swapj;
+ static doublereal nrmxl;
+ static integer jp, pl, pu;
+ static doublereal tt, maxnrm;
+
+/* dqrdc uses householder transformations to compute the qr */
+/* factorization of an n by p matrix x. column pivoting */
+/* based on the 2-norms of the reduced columns may be */
+/* performed at the users option. */
+/* */
+/* on entry */
+/* */
+/* x double precision(ldx,p), where ldx .ge. n. */
+/* x contains the matrix whose decomposition is to be */
+/* computed. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* jpvt integer(p). */
+/* jpvt contains integers that control the selection */
+/* of the pivot columns. the k-th column x(k) of x */
+/* is placed in one of three classes according to the */
+/* value of jpvt(k). */
+/* */
+/* if jpvt(k) .gt. 0, then x(k) is an initial */
+/* column. */
+/* */
+/* if jpvt(k) .eq. 0, then x(k) is a free column. */
+/* */
+/* if jpvt(k) .lt. 0, then x(k) is a final column. */
+/* */
+/* before the decomposition is computed, initial columns */
+/* are moved to the beginning of the array x and final */
+/* columns to the end. both initial and final columns */
+/* are frozen in place during the computation and only */
+/* free columns are moved. at the k-th stage of the */
+/* reduction, if x(k) is occupied by a free column */
+/* it is interchanged with the free column of largest */
+/* reduced norm. jpvt is not referenced if */
+/* job .eq. 0. */
+/* */
+/* work double precision(p). */
+/* work is a work array. work is not referenced if */
+/* job .eq. 0. */
+/* */
+/* job integer. */
+/* job is an integer that initiates column pivoting. */
+/* if job .eq. 0, no pivoting is done. */
+/* if job .ne. 0, pivoting is done. */
+/* */
+/* on return */
+/* */
+/* x x contains in its upper triangle the upper */
+/* triangular matrix r of the qr factorization. */
+/* below its diagonal x contains information from */
+/* which the orthogonal part of the decomposition */
+/* can be recovered. note that if pivoting has */
+/* been requested, the decomposition is not that */
+/* of the original matrix x but that of x */
+/* with its columns permuted as described by jpvt. */
+/* */
+/* qraux double precision(p). */
+/* qraux contains further information required to recover */
+/* the orthogonal part of the decomposition. */
+/* */
+/* jpvt jpvt(k) contains the index of the column of the */
+/* original matrix that has been interchanged into */
+/* the k-th column, if pivoting was requested. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* dqrdc uses the following functions and subprograms. */
+/* */
+/* blas daxpy,ddot,dscal,dswap,dnrm2 */
+/* fortran dabs,dmax1,min0,dsqrt */
+
+/* internal variables */
+
+ pl = 0;
+ pu = -1;
+ if (*job == 0) {
+ goto L60;
+ }
+
+/* pivoting has been requested. rearrange the columns */
+/* according to jpvt. */
+
+ for (j = 0; j < *p; ++j) {
+ swapj = jpvt[j] > 0;
+ negj = jpvt[j] < 0;
+ jpvt[j] = j+1;
+ if (negj) {
+ jpvt[j] = -j-1;
+ }
+ if (! swapj) {
+ continue;
+ }
+ if (j != pl) {
+ dswap_(n, &x[pl * *ldx], &c__1, &x[j * *ldx], &c__1);
+ }
+ jpvt[j] = jpvt[pl];
+ jpvt[pl] = j+1;
+ ++pl;
+ }
+ pu = *p - 1;
+ for (j = pu; j >= 0; --j) {
+ if (jpvt[j] >= 0) {
+ continue;
+ }
+ jpvt[j] = -jpvt[j];
+ if (j != pu) {
+ dswap_(n, &x[pu * *ldx], &c__1, &x[j * *ldx], &c__1);
+ jp = jpvt[pu];
+ jpvt[pu] = jpvt[j];
+ jpvt[j] = jp;
+ }
+ --pu;
+ }
+L60:
+
+/* compute the norms of the free columns. */
+
+ for (j = pl; j <= pu; ++j) {
+ qraux[j] = dnrm2_(n, &x[j * *ldx], &c__1);
+ work[j] = qraux[j];
+ }
+
+/* perform the householder reduction of x. */
+
+ for (l = 0; l < *n && l < *p; ++l) {
+ if (l < pl || l >= pu) {
+ goto L120;
+ }
+
+/* locate the column of largest norm and bring it */
+/* into the pivot position. */
+
+ maxnrm = 0.;
+ maxj = l;
+ for (j = l; j <= pu; ++j) {
+ if (qraux[j] <= maxnrm) {
+ continue;
+ }
+ maxnrm = qraux[j];
+ maxj = j;
+ }
+ if (maxj != l) {
+ dswap_(n, &x[l * *ldx], &c__1, &x[maxj * *ldx], &c__1);
+ qraux[maxj] = qraux[l];
+ work[maxj] = work[l];
+ jp = jpvt[maxj]; jpvt[maxj] = jpvt[l]; jpvt[l] = jp;
+ }
+L120:
+ qraux[l] = 0.;
+ if (l+1 == *n) {
+ continue;
+ }
+
+/* compute the householder transformation for column l. */
+
+ i__1 = *n - l;
+ nrmxl = dnrm2_(&i__1, &x[l + l * *ldx], &c__1);
+ if (nrmxl == 0.) {
+ continue;
+ }
+ if (x[l + l * *ldx] != 0.) {
+ nrmxl = d_sign(&nrmxl, &x[l + l * *ldx]);
+ }
+ i__1 = *n - l;
+ d__1 = 1. / nrmxl;
+ dscal_(&i__1, &d__1, &x[l + l * *ldx], &c__1);
+ x[l + l * *ldx] += 1.;
+
+/* apply the transformation to the remaining columns, */
+/* updating the norms. */
+
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l;
+ t = -ddot_(&i__1, &x[l + l * *ldx], &c__1,
+ &x[l + j * *ldx], &c__1) / x[l + l * *ldx];
+ daxpy_(&i__1, &t, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1);
+ if (j < pl || j > pu) {
+ continue;
+ }
+ if (qraux[j] == 0.) {
+ continue;
+ }
+ tt = abs(x[l + j * *ldx]) / qraux[j];
+ tt = 1. - tt * tt;
+ tt = max(tt,0.);
+ t = tt;
+ d__1 = qraux[j] / work[j];
+ tt = tt * .05 * d__1 * d__1 + 1.;
+ if (tt != 1.) {
+ qraux[j] *= sqrt(t);
+ continue;
+ }
+ i__1 = *n - l - 1;
+ qraux[j] = dnrm2_(&i__1, &x[l + 1 + j * *ldx], &c__1);
+ work[j] = qraux[j];
+ }
+
+/* save the transformation. */
+
+ qraux[l] = x[l + l * *ldx];
+ x[l + l * *ldx] = -nrmxl;
+ }
+} /* dqrdc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..b9c000e50922c0e2245a5924c479336fd3d88afe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrdc.f
@@ -0,0 +1,207 @@
+ subroutine dqrdc(x,ldx,n,p,qraux,jpvt,work,job)
+ integer ldx,n,p,job
+ integer jpvt(1)
+ double precision x(ldx,1),qraux(1),work(1)
+c
+c dqrdc uses householder transformations to compute the qr
+c factorization of an n by p matrix x. column pivoting
+c based on the 2-norms of the reduced columns may be
+c performed at the users option.
+c
+c on entry
+c
+c x double precision(ldx,p), where ldx .ge. n.
+c x contains the matrix whose decomposition is to be
+c computed.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c jpvt integer(p).
+c jpvt contains integers that control the selection
+c of the pivot columns. the k-th column x(k) of x
+c is placed in one of three classes according to the
+c value of jpvt(k).
+c
+c if jpvt(k) .gt. 0, then x(k) is an initial
+c column.
+c
+c if jpvt(k) .eq. 0, then x(k) is a free column.
+c
+c if jpvt(k) .lt. 0, then x(k) is a final column.
+c
+c before the decomposition is computed, initial columns
+c are moved to the beginning of the array x and final
+c columns to the end. both initial and final columns
+c are frozen in place during the computation and only
+c free columns are moved. at the k-th stage of the
+c reduction, if x(k) is occupied by a free column
+c it is interchanged with the free column of largest
+c reduced norm. jpvt is not referenced if
+c job .eq. 0.
+c
+c work double precision(p).
+c work is a work array. work is not referenced if
+c job .eq. 0.
+c
+c job integer.
+c job is an integer that initiates column pivoting.
+c if job .eq. 0, no pivoting is done.
+c if job .ne. 0, pivoting is done.
+c
+c on return
+c
+c x x contains in its upper triangle the upper
+c triangular matrix r of the qr factorization.
+c below its diagonal x contains information from
+c which the orthogonal part of the decomposition
+c can be recovered. note that if pivoting has
+c been requested, the decomposition is not that
+c of the original matrix x but that of x
+c with its columns permuted as described by jpvt.
+c
+c qraux double precision(p).
+c qraux contains further information required to recover
+c the orthogonal part of the decomposition.
+c
+c jpvt jpvt(k) contains the index of the column of the
+c original matrix that has been interchanged into
+c the k-th column, if pivoting was requested.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c dqrdc uses the following functions and subprograms.
+c
+c blas daxpy,ddot,dscal,dswap,dnrm2
+c fortran dabs,dmax1,min0,dsqrt
+c
+c internal variables
+c
+ integer j,jp,l,lp1,lup,maxj,pl,pu
+ double precision maxnrm,dnrm2,tt
+ double precision ddot,nrmxl,t
+ logical negj,swapj
+c
+c
+ pl = 1
+ pu = 0
+ if (job .eq. 0) go to 60
+c
+c pivoting has been requested. rearrange the columns
+c according to jpvt.
+c
+ do 20 j = 1, p
+ swapj = jpvt(j) .gt. 0
+ negj = jpvt(j) .lt. 0
+ jpvt(j) = j
+ if (negj) jpvt(j) = -j
+ if (.not.swapj) go to 10
+ if (j .ne. pl) call dswap(n,x(1,pl),1,x(1,j),1)
+ jpvt(j) = jpvt(pl)
+ jpvt(pl) = j
+ pl = pl + 1
+ 10 continue
+ 20 continue
+ pu = p
+ do 50 jj = 1, p
+ j = p - jj + 1
+ if (jpvt(j) .ge. 0) go to 40
+ jpvt(j) = -jpvt(j)
+ if (j .eq. pu) go to 30
+ call dswap(n,x(1,pu),1,x(1,j),1)
+ jp = jpvt(pu)
+ jpvt(pu) = jpvt(j)
+ jpvt(j) = jp
+ 30 continue
+ pu = pu - 1
+ 40 continue
+ 50 continue
+ 60 continue
+c
+c compute the norms of the free columns.
+c
+ if (pu .lt. pl) go to 80
+ do 70 j = pl, pu
+ qraux(j) = dnrm2(n,x(1,j),1)
+ work(j) = qraux(j)
+ 70 continue
+ 80 continue
+c
+c perform the householder reduction of x.
+c
+ lup = min0(n,p)
+ do 200 l = 1, lup
+ if (l .lt. pl .or. l .ge. pu) go to 120
+c
+c locate the column of largest norm and bring it
+c into the pivot position.
+c
+ maxnrm = 0.0d0
+ maxj = l
+ do 100 j = l, pu
+ if (qraux(j) .le. maxnrm) go to 90
+ maxnrm = qraux(j)
+ maxj = j
+ 90 continue
+ 100 continue
+ if (maxj .eq. l) go to 110
+ call dswap(n,x(1,l),1,x(1,maxj),1)
+ qraux(maxj) = qraux(l)
+ work(maxj) = work(l)
+ jp = jpvt(maxj)
+ jpvt(maxj) = jpvt(l)
+ jpvt(l) = jp
+ 110 continue
+ 120 continue
+ qraux(l) = 0.0d0
+ if (l .eq. n) go to 190
+c
+c compute the householder transformation for column l.
+c
+ nrmxl = dnrm2(n-l+1,x(l,l),1)
+ if (nrmxl .eq. 0.0d0) go to 180
+ if (x(l,l) .ne. 0.0d0) nrmxl = dsign(nrmxl,x(l,l))
+ call dscal(n-l+1,1.0d0/nrmxl,x(l,l),1)
+ x(l,l) = 1.0d0 + x(l,l)
+c
+c apply the transformation to the remaining columns,
+c updating the norms.
+c
+ lp1 = l + 1
+ if (p .lt. lp1) go to 170
+ do 160 j = lp1, p
+ t = -ddot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call daxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ if (j .lt. pl .or. j .gt. pu) go to 150
+ if (qraux(j) .eq. 0.0d0) go to 150
+ tt = 1.0d0 - (dabs(x(l,j))/qraux(j))**2
+ tt = dmax1(tt,0.0d0)
+ t = tt
+ tt = 1.0d0 + 0.05d0*tt*(qraux(j)/work(j))**2
+ if (tt .eq. 1.0d0) go to 130
+ qraux(j) = qraux(j)*dsqrt(t)
+ go to 140
+ 130 continue
+ qraux(j) = dnrm2(n-l,x(l+1,j),1)
+ work(j) = qraux(j)
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c save the transformation.
+c
+ qraux(l) = x(l,l)
+ x(l,l) = -nrmxl
+ 180 continue
+ 190 continue
+ 200 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.c
new file mode 100644
index 0000000000000000000000000000000000000000..5efeda9d3f064c692a1dcc5226e95c4fa172ebf0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.c
@@ -0,0 +1,286 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void dqrsl_(x, ldx, n, k, qraux, y, qy, qty, b, rsd, xb, job, info)
+const doublereal *x;
+const integer *ldx, *n, *k;
+const doublereal *qraux, *y;
+doublereal *qy, *qty, *b, *rsd, *xb;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal temp;
+ static logical cqty;
+ static integer i, j;
+ static doublereal t;
+ static logical cb;
+ static logical cr;
+ static integer ju;
+ static logical cxb, cqy;
+
+/* dqrsl applies the output of dqrdc to compute coordinate */
+/* transformations, projections, and least squares solutions. */
+/* for k .le. min(n,p), let xk be the matrix */
+
+/* xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) */
+
+/* formed from columns jpvt(1), ... ,jpvt(k) of the original */
+/* n x p matrix x that was input to dqrdc (if no pivoting was */
+/* done, xk consists of the first k columns of x in their */
+/* original order). dqrdc produces a factored orthogonal matrix q */
+/* and an upper triangular matrix r such that */
+/* */
+/* xk = q * (r) */
+/* (0) */
+/* */
+/* this information is contained in coded form in the arrays */
+/* x and qraux. */
+/* */
+/* on entry */
+/* */
+/* x double precision(ldx,p). */
+/* x contains the output of dqrdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix xk. it must */
+/* have the same value as n in dqrdc. */
+/* */
+/* k integer. */
+/* k is the number of columns of the matrix xk. k */
+/* must nnot be greater than min(n,p), where p is the */
+/* same as in the calling sequence to dqrdc. */
+/* */
+/* qraux double precision(p). */
+/* qraux contains the auxiliary output from dqrdc. */
+/* */
+/* y double precision(n) */
+/* y contains an n-vector that is to be manipulated */
+/* by dqrsl. */
+/* */
+/* job integer. */
+/* job specifies what is to be computed. job has */
+/* the decimal expansion abcde, with the following */
+/* meaning. */
+/* */
+/* if a.ne.0, compute qy. */
+/* if b,c,d, or e .ne. 0, compute qty. */
+/* if c.ne.0, compute b. */
+/* if d.ne.0, compute rsd. */
+/* if e.ne.0, compute xb. */
+/* */
+/* note that a request to compute b, rsd, or xb */
+/* automatically triggers the computation of qty, for */
+/* which an array must be provided in the calling */
+/* sequence. */
+/* */
+/* on return */
+/* */
+/* qy double precision(n). */
+/* qy contains q*y, if its computation has been */
+/* requested. */
+/* */
+/* qty double precision(n). */
+/* qty contains trans(q)*y, if its computation has */
+/* been requested. here trans(q) is the */
+/* transpose of the matrix q. */
+/* */
+/* b double precision(k) */
+/* b contains the solution of the least squares problem */
+/* */
+/* minimize norm2(y - xk*b), */
+/* */
+/* if its computation has been requested. (note that */
+/* if pivoting was requested in dqrdc, the j-th */
+/* component of b will be associated with column jpvt(j) */
+/* of the original matrix x that was input into dqrdc.) */
+/* */
+/* rsd double precision(n). */
+/* rsd contains the least squares residual y - xk*b, */
+/* if its computation has been requested. rsd is */
+/* also the orthogonal projection of y onto the */
+/* orthogonal complement of the column space of xk. */
+/* */
+/* xb double precision(n). */
+/* xb contains the least squares approximation xk*b, */
+/* if its computation has been requested. xb is also */
+/* the orthogonal projection of y onto the column space */
+/* of x. */
+/* */
+/* info integer. */
+/* info is zero unless the computation of b has */
+/* been requested and r is exactly singular. in */
+/* this case, info is the index of the first zero */
+/* diagonal element of r and b is left unaltered. */
+/* */
+/* the parameters qy, qty, b, rsd, and xb are not referenced */
+/* if their computation is not requested and in this case */
+/* can be replaced by dummy variables in the calling program. */
+/* to save storage, the user may in some cases use the same */
+/* array for different parameters in the calling sequence. a */
+/* frequently occurring example is when one wishes to compute */
+/* any of b, rsd, or xb and does not need y or qty. in this */
+/* case one may identify y, qty, and one of b, rsd, or xb, while */
+/* providing separate arrays for anything else that is to be */
+/* computed. thus the calling sequence */
+/* */
+/* call dqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info) */
+/* */
+/* will result in the computation of b and rsd, with rsd */
+/* overwriting y. more generally, each item in the following */
+/* list contains groups of permissible identifications for */
+/* a single callinng sequence. */
+/* */
+/* 1. (y,qty,b) (rsd) (xb) (qy) */
+/* */
+/* 2. (y,qty,rsd) (b) (xb) (qy) */
+/* */
+/* 3. (y,qty,xb) (b) (rsd) (qy) */
+/* */
+/* 4. (y,qy) (qty,b) (rsd) (xb) */
+/* */
+/* 5. (y,qy) (qty,rsd) (b) (xb) */
+/* */
+/* 6. (y,qy) (qty,xb) (b) (rsd) */
+/* */
+/* in any group the value returned in the array allocated to */
+/* the group corresponds to the last member of the group. */
+
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* dqrsl uses the following functions and subprograms. */
+
+/* blas daxpy,dcopy,ddot */
+/* fortran dabs,min0,mod */
+
+/* set info flag. */
+ *info = 0;
+
+/* determine what is to be computed. */
+
+ cqy = *job / 10000 != 0;
+ cqty = *job % 10000 != 0;
+ cb = *job % 1000 / 100 != 0;
+ cr = *job % 100 / 10 != 0;
+ cxb = *job % 10 != 0;
+ ju = min(*k,*n - 1);
+
+/* special action when n=1. */
+
+ if (ju == 0) {
+ if (cqy) qy[0] = y[0];
+ if (cqty) qty[0] = y[0];
+ if (cxb) xb[0] = y[0];
+ if (cb) {
+ if (x[0] == 0.) *info = 1;
+ else b[0] = y[0] / x[0];
+ }
+ if (cr) rsd[0] = 0.;
+ return;
+ }
+
+/* set up to compute qy or qty. */
+
+ if (cqy) {
+ dcopy_(n, y, &c__1, qy, &c__1);
+ }
+ if (cqty) {
+ dcopy_(n, y, &c__1, qty, &c__1);
+ }
+
+/* compute qy. */
+
+ if (cqy)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j] == 0.)
+ continue;
+ temp = x[j + j * *ldx];
+ ((doublereal*)x)[j + j * *ldx] = qraux[j]; /* breaks const-ness, but will be restored */
+ i__1 = *n - j;
+ t = -ddot_(&i__1, &x[j + j * *ldx], &c__1, &qy[j], &c__1) / x[j + j * *ldx];
+ daxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &qy[j], &c__1);
+ ((doublereal*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+
+/* compute trans(q)*y. */
+
+ if (cqty)
+ for (j = 0; j < ju; ++j) {
+ if (qraux[j] == 0.)
+ continue;
+ temp = x[j + j * *ldx];
+ ((doublereal*)x)[j + j * *ldx] = qraux[j]; /* breaks const-ness, but will be restored */
+ i__1 = *n - j;
+ t = -ddot_(&i__1, &x[j + j * *ldx], &c__1, &qty[j], &c__1) / x[j + j * *ldx];
+ daxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &qty[j], &c__1);
+ ((doublereal*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+
+/* set up to compute b, rsd, or xb. */
+
+ if (cb) {
+ dcopy_(k, qty, &c__1, b, &c__1);
+ }
+ if (cxb) {
+ dcopy_(k, qty, &c__1, xb, &c__1);
+ }
+ if (cr && *k < *n) {
+ i__1 = *n - *k;
+ dcopy_(&i__1, &qty[*k], &c__1, &rsd[*k], &c__1);
+ }
+ if (cxb)
+ for (i = *k; i < *n; ++i) {
+ xb[i] = 0.;
+ }
+ if (cr)
+ for (i = 0; i < *k; ++i) {
+ rsd[i] = 0.;
+ }
+
+/* compute b. */
+
+ if (cb)
+ for (j = *k-1; j >= 0; --j) {
+ if (x[j + j * *ldx] == 0.) {
+ *info = j+1;
+ break;
+ }
+ b[j] /= x[j + j * *ldx];
+ if (j != 0) {
+ t = -b[j];
+ daxpy_(&j, &t, &x[j * *ldx], &c__1, b, &c__1);
+ }
+ }
+ if (! cr && ! cxb)
+ return;
+
+/* compute rsd or xb as required. */
+
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j] == 0.) {
+ continue;
+ }
+ temp = x[j + j * *ldx];
+ ((doublereal*)x)[j + j * *ldx] = qraux[j]; /* breaks const-ness, but will be restored */
+ i__1 = *n - j;
+ if (cr) {
+ t = -ddot_(&i__1, &x[j + j * *ldx], &c__1, &rsd[j], &c__1) / x[j + j * *ldx];
+ daxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &rsd[j], &c__1);
+ }
+ if (cxb) {
+ t = -ddot_(&i__1, &x[j + j * *ldx], &c__1, &xb[j], &c__1) / x[j + j * *ldx];
+ daxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &xb[j], &c__1);
+ }
+ ((doublereal*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+} /* dqrsl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.f
new file mode 100644
index 0000000000000000000000000000000000000000..152eac6e9cd3b197db01728cba0665aa0477c83d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dqrsl.f
@@ -0,0 +1,274 @@
+ subroutine dqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info)
+ integer ldx,n,k,job,info
+ double precision x(ldx,1),qraux(1),y(1),qy(1),qty(1),b(1),rsd(1),
+ * xb(1)
+c
+c dqrsl applies the output of dqrdc to compute coordinate
+c transformations, projections, and least squares solutions.
+c for k .le. min(n,p), let xk be the matrix
+c
+c xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k)))
+c
+c formed from columns jpvt(1), ... ,jpvt(k) of the original
+c n x p matrix x that was input to dqrdc (if no pivoting was
+c done, xk consists of the first k columns of x in their
+c original order). dqrdc produces a factored orthogonal matrix q
+c and an upper triangular matrix r such that
+c
+c xk = q * (r)
+c (0)
+c
+c this information is contained in coded form in the arrays
+c x and qraux.
+c
+c on entry
+c
+c x double precision(ldx,p).
+c x contains the output of dqrdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix xk. it must
+c have the same value as n in dqrdc.
+c
+c k integer.
+c k is the number of columns of the matrix xk. k
+c must nnot be greater than min(n,p), where p is the
+c same as in the calling sequence to dqrdc.
+c
+c qraux double precision(p).
+c qraux contains the auxiliary output from dqrdc.
+c
+c y double precision(n)
+c y contains an n-vector that is to be manipulated
+c by dqrsl.
+c
+c job integer.
+c job specifies what is to be computed. job has
+c the decimal expansion abcde, with the following
+c meaning.
+c
+c if a.ne.0, compute qy.
+c if b,c,d, or e .ne. 0, compute qty.
+c if c.ne.0, compute b.
+c if d.ne.0, compute rsd.
+c if e.ne.0, compute xb.
+c
+c note that a request to compute b, rsd, or xb
+c automatically triggers the computation of qty, for
+c which an array must be provided in the calling
+c sequence.
+c
+c on return
+c
+c qy double precision(n).
+c qy contains q*y, if its computation has been
+c requested.
+c
+c qty double precision(n).
+c qty contains trans(q)*y, if its computation has
+c been requested. here trans(q) is the
+c transpose of the matrix q.
+c
+c b double precision(k)
+c b contains the solution of the least squares problem
+c
+c minimize norm2(y - xk*b),
+c
+c if its computation has been requested. (note that
+c if pivoting was requested in dqrdc, the j-th
+c component of b will be associated with column jpvt(j)
+c of the original matrix x that was input into dqrdc.)
+c
+c rsd double precision(n).
+c rsd contains the least squares residual y - xk*b,
+c if its computation has been requested. rsd is
+c also the orthogonal projection of y onto the
+c orthogonal complement of the column space of xk.
+c
+c xb double precision(n).
+c xb contains the least squares approximation xk*b,
+c if its computation has been requested. xb is also
+c the orthogonal projection of y onto the column space
+c of x.
+c
+c info integer.
+c info is zero unless the computation of b has
+c been requested and r is exactly singular. in
+c this case, info is the index of the first zero
+c diagonal element of r and b is left unaltered.
+c
+c the parameters qy, qty, b, rsd, and xb are not referenced
+c if their computation is not requested and in this case
+c can be replaced by dummy variables in the calling program.
+c to save storage, the user may in some cases use the same
+c array for different parameters in the calling sequence. a
+c frequently occurring example is when one wishes to compute
+c any of b, rsd, or xb and does not need y or qty. in this
+c case one may identify y, qty, and one of b, rsd, or xb, while
+c providing separate arrays for anything else that is to be
+c computed. thus the calling sequence
+c
+c call dqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info)
+c
+c will result in the computation of b and rsd, with rsd
+c overwriting y. more generally, each item in the following
+c list contains groups of permissible identifications for
+c a single callinng sequence.
+c
+c 1. (y,qty,b) (rsd) (xb) (qy)
+c
+c 2. (y,qty,rsd) (b) (xb) (qy)
+c
+c 3. (y,qty,xb) (b) (rsd) (qy)
+c
+c 4. (y,qy) (qty,b) (rsd) (xb)
+c
+c 5. (y,qy) (qty,rsd) (b) (xb)
+c
+c 6. (y,qy) (qty,xb) (b) (rsd)
+c
+c in any group the value returned in the array allocated to
+c the group corresponds to the last member of the group.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c dqrsl uses the following functions and subprograms.
+c
+c blas daxpy,dcopy,ddot
+c fortran dabs,min0,mod
+c
+c internal variables
+c
+ integer i,j,jj,ju,kp1
+ double precision ddot,t,temp
+ logical cb,cqy,cqty,cr,cxb
+c
+c
+c set info flag.
+c
+ info = 0
+c
+c determine what is to be computed.
+c
+ cqy = job/10000 .ne. 0
+ cqty = mod(job,10000) .ne. 0
+ cb = mod(job,1000)/100 .ne. 0
+ cr = mod(job,100)/10 .ne. 0
+ cxb = mod(job,10) .ne. 0
+ ju = min0(k,n-1)
+c
+c special action when n=1.
+c
+ if (ju .ne. 0) go to 40
+ if (cqy) qy(1) = y(1)
+ if (cqty) qty(1) = y(1)
+ if (cxb) xb(1) = y(1)
+ if (.not.cb) go to 30
+ if (x(1,1) .ne. 0.0d0) go to 10
+ info = 1
+ go to 20
+ 10 continue
+ b(1) = y(1)/x(1,1)
+ 20 continue
+ 30 continue
+ if (cr) rsd(1) = 0.0d0
+ go to 250
+ 40 continue
+c
+c set up to compute qy or qty.
+c
+ if (cqy) call dcopy(n,y,1,qy,1)
+ if (cqty) call dcopy(n,y,1,qty,1)
+ if (.not.cqy) go to 70
+c
+c compute qy.
+c
+ do 60 jj = 1, ju
+ j = ju - jj + 1
+ if (qraux(j) .eq. 0.0d0) go to 50
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -ddot(n-j+1,x(j,j),1,qy(j),1)/x(j,j)
+ call daxpy(n-j+1,t,x(j,j),1,qy(j),1)
+ x(j,j) = temp
+ 50 continue
+ 60 continue
+ 70 continue
+ if (.not.cqty) go to 100
+c
+c compute trans(q)*y.
+c
+ do 90 j = 1, ju
+ if (qraux(j) .eq. 0.0d0) go to 80
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -ddot(n-j+1,x(j,j),1,qty(j),1)/x(j,j)
+ call daxpy(n-j+1,t,x(j,j),1,qty(j),1)
+ x(j,j) = temp
+ 80 continue
+ 90 continue
+ 100 continue
+c
+c set up to compute b, rsd, or xb.
+c
+ if (cb) call dcopy(k,qty,1,b,1)
+ kp1 = k + 1
+ if (cxb) call dcopy(k,qty,1,xb,1)
+ if (cr .and. k .lt. n) call dcopy(n-k,qty(kp1),1,rsd(kp1),1)
+ if (.not.cxb .or. kp1 .gt. n) go to 120
+ do 110 i = kp1, n
+ xb(i) = 0.0d0
+ 110 continue
+ 120 continue
+ if (.not.cr) go to 140
+ do 130 i = 1, k
+ rsd(i) = 0.0d0
+ 130 continue
+ 140 continue
+ if (.not.cb) go to 190
+c
+c compute b.
+c
+ do 170 jj = 1, k
+ j = k - jj + 1
+ if (x(j,j) .ne. 0.0d0) go to 150
+ info = j
+c ......exit
+ go to 180
+ 150 continue
+ b(j) = b(j)/x(j,j)
+ if (j .eq. 1) go to 160
+ t = -b(j)
+ call daxpy(j-1,t,x(1,j),1,b,1)
+ 160 continue
+ 170 continue
+ 180 continue
+ 190 continue
+ if (.not.cr .and. .not.cxb) go to 240
+c
+c compute rsd or xb as required.
+c
+ do 230 jj = 1, ju
+ j = ju - jj + 1
+ if (qraux(j) .eq. 0.0d0) go to 220
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ if (.not.cr) go to 200
+ t = -ddot(n-j+1,x(j,j),1,rsd(j),1)/x(j,j)
+ call daxpy(n-j+1,t,x(j,j),1,rsd(j),1)
+ 200 continue
+ if (.not.cxb) go to 210
+ t = -ddot(n-j+1,x(j,j),1,xb(j),1)/x(j,j)
+ call daxpy(n-j+1,t,x(j,j),1,xb(j),1)
+ 210 continue
+ x(j,j) = temp
+ 220 continue
+ 230 continue
+ 240 continue
+ 250 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/drot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/drot.c
new file mode 100644
index 0000000000000000000000000000000000000000..748e339037b2b44922c4b64cf7f918a289e9b4bf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/drot.c
@@ -0,0 +1,50 @@
+#include "f2c.h"
+#include "netlib.h"
+#ifdef KR_headers
+/* Subroutine */ void drot_(n, dx, incx, dy, incy, c, s)
+const integer *n;
+doublereal *dx;
+const integer *incx;
+doublereal *dy;
+const integer *incy;
+const doublereal *c, *s;
+#else
+void drot_(const integer *n, doublereal *dx, const integer *incx, doublereal *dy, const integer *incy,
+ const doublereal *c, const doublereal*s)
+#endif
+{
+ /* Local variables */
+ static integer i;
+ static doublereal dtemp;
+ static integer ix, iy;
+
+/* applies a plane rotation. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ dtemp = *c * dx[i] + *s * dy[i];
+ dy[i] = *c * dy[i] - *s * dx[i];
+ dx[i] = dtemp;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ dtemp = *c * dx[ix] + *s * dy[iy];
+ dy[iy] = *c * dy[iy] - *s * dx[ix];
+ dx[ix] = dtemp;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* drot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/drotg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/drotg.c
new file mode 100644
index 0000000000000000000000000000000000000000..f64abe5c215e09f850928e209ac6dd0691368167
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/drotg.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static doublereal c_b4 = 1.;
+
+/* Subroutine */ void drotg_(da, db, c, s)
+doublereal *da, *db, *c, *s;
+{
+ /* Local variables */
+ static doublereal r, scale, z, roe;
+
+/* construct givens plane rotation. */
+/* jack dongarra, linpack, 3/11/78. */
+
+ scale = abs(*da) + abs(*db);
+ if (scale == 0.) {
+ *c = 1.; *s = 0.;
+ *da = *db = 0.;
+ }
+ else {
+ roe = *db;
+ if (abs(*da) > abs(*db)) {
+ roe = *da;
+ }
+ r = *da / scale;
+ z = *db / scale;
+ r = scale * sqrt(r * r + z * z);
+ r *= d_sign(&c_b4, &roe);
+ *c = *da / r;
+ *s = *db / r;
+ z = 1.;
+ if (abs(*da) > abs(*db)) {
+ z = *s;
+ }
+ if (abs(*db) >= abs(*da) && *c != 0.) {
+ z = 1. / *c;
+ }
+ *da = r;
+ *db = z;
+ }
+} /* drotg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.c
new file mode 100644
index 0000000000000000000000000000000000000000..774dcc5ce66f3626a6eb7bba60b036d2083ada97
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.c
@@ -0,0 +1,95 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void drscl_(n, sa, sx, incx)
+integer *n;
+doublereal *sa, *sx;
+integer *incx;
+{
+ static doublereal cden;
+ static logical done;
+ static doublereal cnum, cden1, cnum1;
+ static doublereal bignum, smlnum, mul;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DRSCL multiplies an n-element real vector x by the real scalar 1/a. */
+/* This is done without overflow or underflow as long as */
+/* the final result x/a does not overflow or underflow. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of components of the vector x. */
+/* */
+/* SA (input) DOUBLE PRECISION */
+/* The scalar a which is used to divide each component of x. */
+/* SA must be >= 0, or the subroutine will divide by zero. */
+/* */
+/* SX (input/output) DOUBLE PRECISION array, dimension */
+/* (1+(N-1)*abs(INCX)) */
+/* The n-element vector x. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector SX. */
+/* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return;
+ }
+
+/* Get machine parameters */
+
+ smlnum = dlamch_("S");
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Initialize the denominator to SA and the numerator to 1. */
+
+ cden = *sa;
+ cnum = 1.;
+
+L10:
+ cden1 = cden * smlnum;
+ cnum1 = cnum / bignum;
+ if (abs(cden1) > abs(cnum) && cnum != 0.) {
+
+/* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. */
+
+ mul = smlnum;
+ done = FALSE_;
+ cden = cden1;
+ } else if (abs(cnum1) > abs(cden)) {
+
+/* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. */
+
+ mul = bignum;
+ done = FALSE_;
+ cnum = cnum1;
+ } else {
+
+/* Multiply X by CNUM / CDEN and return. */
+
+ mul = cnum / cden;
+ done = TRUE_;
+ }
+
+/* Scale the vector X by MUL */
+
+ dscal_(n, &mul, sx, incx);
+
+ if (! done) {
+ goto L10;
+ }
+} /* drscl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.f
new file mode 100644
index 0000000000000000000000000000000000000000..d268c231f435c8a25afc4a55b476b92def7785d7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/drscl.f
@@ -0,0 +1,115 @@
+ SUBROUTINE DRSCL( N, SA, SX, INCX )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION SA
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION SX( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DRSCL multiplies an n-element real vector x by the real scalar 1/a.
+* This is done without overflow or underflow as long as
+* the final result x/a does not overflow or underflow.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of components of the vector x.
+*
+* SA (input) DOUBLE PRECISION
+* The scalar a which is used to divide each component of x.
+* SA must be >= 0, or the subroutine will divide by zero.
+*
+* SX (input/output) DOUBLE PRECISION array, dimension
+* (1+(N-1)*abs(INCX))
+* The n-element vector x.
+*
+* INCX (input) INTEGER
+* The increment between successive values of the vector SX.
+* > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL DONE
+ DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL DSCAL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Get machine parameters
+*
+ SMLNUM = DLAMCH( 'S' )
+ BIGNUM = ONE / SMLNUM
+ CALL DLABAD( SMLNUM, BIGNUM )
+*
+* Initialize the denominator to SA and the numerator to 1.
+*
+ CDEN = SA
+ CNUM = ONE
+*
+ 10 CONTINUE
+ CDEN1 = CDEN*SMLNUM
+ CNUM1 = CNUM / BIGNUM
+ IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
+*
+* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
+*
+ MUL = SMLNUM
+ DONE = .FALSE.
+ CDEN = CDEN1
+ ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
+*
+* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
+*
+ MUL = BIGNUM
+ DONE = .FALSE.
+ CNUM = CNUM1
+ ELSE
+*
+* Multiply X by CNUM / CDEN and return.
+*
+ MUL = CNUM / CDEN
+ DONE = .TRUE.
+ END IF
+*
+* Scale the vector X by MUL
+*
+ CALL DSCAL( N, MUL, SX, INCX )
+*
+ IF( .NOT.DONE )
+ $ GO TO 10
+*
+ RETURN
+*
+* End of DRSCL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dscal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dscal.c
new file mode 100644
index 0000000000000000000000000000000000000000..b351744623ef742ae1f4e22c072d3af0e6737dd0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dscal.c
@@ -0,0 +1,39 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dscal_(n, da, dx, incx)
+const integer *n;
+const doublereal *da;
+doublereal *dx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i, m, nincx;
+
+/* scales a vector by a constant. */
+/* uses unrolled loops for increment equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0 || *incx <= 0) {
+ return;
+ }
+/* code for increment equal to 1 */
+ if (*incx == 1) {
+ m = *n % 5;
+ for (i = 0; i < m; ++i) {
+ dx[i] *= *da;
+ }
+ for (i = m; i < *n; i += 5) {
+ dx[i] *= *da; dx[i+1] *= *da; dx[i+2] *= *da; dx[i+3] *= *da; dx[i+4] *= *da;
+ }
+ }
+/* code for increment not equal to 1 */
+ else {
+ nincx = *n * *incx;
+ for (i = 0; i < nincx; i += *incx) {
+ dx[i] *= *da;
+ }
+ }
+} /* dscal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dsetgpfa.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsetgpfa.c
new file mode 100644
index 0000000000000000000000000000000000000000..deae6a143b7186a30c29128026bcae1728e2cc70
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsetgpfa.c
@@ -0,0 +1,96 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double asin(double), cos(double), sin(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c__3 = 3;
+static integer c__5 = 5;
+
+/* SUBROUTINE 'SETGPFA' */
+/* SETUP ROUTINE FOR SELF-SORTING IN-PLACE */
+/* GENERALIZED PRIME FACTOR (COMPLEX) FFT [GPFA] */
+/* */
+/* CALL SETGPFA(TRIGS,N) */
+/* */
+/* INPUT : */
+/* ----- */
+/* N IS THE LENGTH OF THE TRANSFORMS. N MUST BE OF THE FORM: */
+/* ----------------------------------- */
+/* N = (2**IP) * (3**IQ) * (5**IR) */
+/* ----------------------------------- */
+/* */
+/* OUTPUT: */
+/* ------ */
+/* TRIGS IS A TABLE OF TWIDDLE FACTORS, */
+/* OF LENGTH 2*IPQR (REAL) WORDS, WHERE: */
+/* -------------------------------------- */
+/* IPQR = (2**IP) + (3**IQ) + (5**IR) */
+/* -------------------------------------- */
+/* */
+/* WRITTEN BY CLIVE TEMPERTON 1990 */
+/* */
+/* ---------------------------------------------------------------------- */
+
+/* Subroutine */
+void dsetgpfa_(doublereal *trigs, const integer *n, integer *ires, integer *info)
+{
+ /* Local variables */
+ static integer ifac, kink, irot, i, k;
+ static doublereal angle, twopi;
+ static integer kk, ni, nj[3], ll, nn;
+ static doublereal del;
+
+/* DECOMPOSE N INTO FACTORS 2,3,5 */
+/* ------------------------------ */
+ nn = *n;
+ ifac = 2;
+
+ for (ll = 0; ll < 3; ++ll) {
+ kk = 0;
+ while (nn % ifac == 0) {
+ ++kk;
+ nn /= ifac;
+ }
+ ires[ll] = kk;
+ ifac += ll+1; /* which makes ifac 3 and 5 in the next 2 runs */
+ }
+
+ if (nn != 1) {
+ *info = -1;
+ return;
+ }
+
+/* COMPUTE LIST OF ROTATED TWIDDLE FACTORS */
+/* --------------------------------------- */
+ nj[0] = pow_ii(&c__2, ires);
+ nj[1] = pow_ii(&c__3, ires+1);
+ nj[2] = pow_ii(&c__5, ires+2);
+
+ twopi = asin(1.) * 4.;
+ i = 0;
+
+ for (ll = 0; ll < 3; ++ll) {
+ ni = nj[ll];
+ if (ni == 1) {
+ continue; /* next ll */
+ }
+ del = twopi / (doublereal) ni;
+ irot = *n / ni;
+ kink = irot % ni;
+ kk = 0;
+
+ for (k = 1; k <= ni; ++k) {
+ angle = (doublereal) kk * del;
+ trigs[i] = cos(angle);
+ trigs[i+1] = sin(angle);
+
+ i += 2;
+ kk += kink;
+ if (kk > ni) {
+ kk -= ni;
+ }
+ }
+ }
+ *info = 0;
+} /* setgpfa_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.c
new file mode 100644
index 0000000000000000000000000000000000000000..e9cac08fc6a098035555dcf305a4039ab31645df
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.c
@@ -0,0 +1,7825 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, Oct 2003: manual optimisation and clean-up */
+
+extern double log(double), sqrt(double); /* #include <math.h> */
+extern long time(long *timer); /* #include <time.h> */
+
+extern doublereal cheby_(doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *);
+extern doublereal determ_(integer *, doublereal *, doublereal *);
+extern doublereal eigvns_(integer *, doublereal *, doublereal *, doublereal *, integer *);
+extern doublereal eigvss_(integer *, doublereal *, doublereal *, doublereal *, integer *, integer *);
+extern doublereal itpackddot_(integer *, doublereal *, integer *, doublereal *, integer *);
+extern doublereal pbeta_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *);
+extern doublereal pvtbv_(integer *, integer *, integer *, doublereal *, doublereal *);
+extern doublereal tau_(integer *);
+extern doublereal timer_(real *);
+extern integer bisrch_(integer *, integer *, integer *);
+extern integer ipstr_(doublereal *);
+extern logical chgsme_(doublereal *, integer *);
+extern logical omgchg_(integer *);
+extern logical omgstr_(integer *);
+extern logical tstchg_(integer *);
+
+/***** BEGIN VXL ADDITIONS ****/
+
+/* Turn off warnings in f2c generated code */
+#if defined(_MSC_VER)
+# if defined(__ICL)
+# pragma warning(disable: 239 264 1011 )
+# else
+# pragma warning(disable: 4101 4244 4554 4756 4723)
+# endif
+#endif
+
+/***** END VXL ADDITIONS ****/
+
+/* Common Block Declarations */
+
+static struct {
+ integer in;
+ integer is;
+ integer isym;
+ integer itmax;
+ integer level;
+ integer nout;
+} itcom1_;
+
+#define itcom1_1 itcom1_
+
+static struct {
+ logical adapt;
+ logical betadt;
+ logical caseii;
+ logical halt;
+ logical partad;
+} itcom2_;
+
+#define itcom2_1 itcom2_
+
+static struct {
+ doublereal bdelnm;
+ doublereal betab;
+ doublereal cme;
+ doublereal delnnm;
+ doublereal delsnm;
+ doublereal ff;
+ doublereal gamma;
+ doublereal omega;
+ doublereal qa;
+ doublereal qt;
+ doublereal rho;
+ doublereal rrr;
+ doublereal sige;
+ doublereal sme;
+ doublereal specr;
+ doublereal spr;
+ doublereal drelpr;
+ doublereal stptst;
+ doublereal udnm;
+ doublereal zeta;
+} itcom3_;
+
+#define itcom3_1 itcom3_
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c__0 = 0;
+static doublereal c_b21 = 0.;
+static integer c__2 = 2;
+static integer c__3 = 3;
+static integer c__4 = 4;
+static doublereal c_b286 = 1.;
+static integer c__5 = 5;
+static integer c__6 = 6;
+static integer c__7 = 7;
+
+/* Subroutine */
+int jcg_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer *ierr)
+{
+ /* Local variables */
+ static integer n3, nb, ib1, ib2, ib3, ib4, ib5, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE JCG (JACOBI CONJUGATE GRADIENT) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, JCG, DRIVES THE JACOBI CONJUGATE */
+/* GRADIENT ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. JACOBI CONJUGATE */
+/* GRADIENT NEEDS THIS TO BE IN LENGTH AT LEAST */
+/* 4*N + 2*ITMAX, IF ISYM = 0 (SYMMETRIC STORAGE) */
+/* 4*N + 4*ITMAX, IF ISYM = 1 (NONSYMMETRIC STORAGE) */
+/* HERE ITMAX = IPARM(1) AND ISYM = IPARM(5) */
+/* (ITMAX IS THE MAXIMUM ALLOWABLE NUMBER OF ITERATIONS) */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... JCG SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL, */
+/* ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER, */
+/* ITJCG, IVFILL, PARCON, PERMAT, */
+/* PERROR, PERVEC, PJAC, PMULT, PRBNDX, */
+/* PSTOP, QSORT, DAXPY, SBELM, SCAL, DCOPY, */
+/* DDOT, SUM3, UNSCAL, VEVMW, VFILL, VOUT, */
+/* WEVMW, ZBRENT */
+/* SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, MOD, DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__1);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 11;
+ goto L370;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L370;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ ib3 = ib2 + *n;
+ ib4 = ib3 + *n;
+ ib5 = ib4 + *n;
+ iparm[7] = (*n << 2) + (itcom1_1.itmax << 1);
+ if (itcom1_1.isym != 0)
+ iparm[7] += itcom1_1.itmax << 1;
+
+ if (*nw < iparm[7]) {
+ ier = 12;
+ goto L370;
+ }
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED */
+
+ nb = iparm[8];
+ if (nb < 0)
+ goto L170;
+
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L370;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ permat_(n, ia, ja, a, iwksp, &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L370;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE DIAGONAL ELEMENTS. */
+
+L170:
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L370;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... COMPUTE INITIAL PSEUDO-RESIDUAL */
+
+ itpackdcopy_(n, rhs, &c__1, &wksp[ib2], &c__1);
+ pjac_(n, ia, ja, a, u, &wksp[ib2]);
+ vevmw_(n, &wksp[ib2], u);
+
+ /* ... ITERATION SEQUENCE */
+
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L240;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) WKSP(IB2) = DEL(IN) */
+ /* WKSP(IB1) = U(IN-1) WKSP(IB3) = DEL(IN-1) */
+
+ itjcg_(n, ia, ja, a, u, &wksp[ib1], &wksp[ib2], &wksp[ib3], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L280;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) WKSP(IB2) = DEL(IN-1) */
+ /* WKSP(IB1) = U(IN) WKSP(IB3) = DEL(IN) */
+
+L240:
+ itjcg_(n, ia, ja, a, &wksp[ib1], u, &wksp[ib3], &wksp[ib2], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L280;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 13;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L310;
+
+ /* ... METHOD HAS CONVERGED */
+
+L280:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L310:
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] < 0)
+ goto L340;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L370;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L340:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ if (itcom1_1.isym != 0)
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L370:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* jcg_ */
+
+/* Subroutine */
+int jsi_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer *ierr)
+{
+ /* Local variables */
+ static integer n3, nb, ib1, ib2, ib3, ier;
+ static doublereal tol;
+ static integer icnt;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE JSI (JACOBI SEMI-ITERATIVE) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, JSI, DRIVES THE JACOBI SEMI- */
+/* ITERATION ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. JACOBI SI */
+/* NEEDS THIS TO BE IN LENGTH AT LEAST */
+/* 2*N */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... JSI SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHEBY, CHGSI, CHGSME, DFAULT, ECHALL, */
+/* ECHOUT, ITERM, TIMER, ITJSI, IVFILL, PAR */
+/* PERMAT, PERROR, PERVEC, PJAC, PMULT, PRBNDX, */
+/* PSTOP, PVTBV, QSORT, DAXPY, SBELM, SCAL, */
+/* DCOPY, DDOT, SUM3, TSTCHG, UNSCAL, VEVMW, */
+/* VFILL, VOUT, WEVMW */
+/* SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT), */
+/* MOD,DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__2);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 21;
+ goto L360;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ ib3 = ib2 + *n;
+ iparm[7] = *n << 1;
+ if (*nw < iparm[7]) {
+ ier = 22;
+ goto L360;
+ }
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED */
+
+ nb = iparm[8];
+ if (nb < 0)
+ goto L170;
+
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ permat_(n, ia, ja, a, iwksp, &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE DIAGONAL ELEMENTS. */
+
+L170:
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... ITERATION SEQUENCE */
+
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L230;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) */
+ /* WKSP(IB1) = U(IN-1) */
+
+ itjsi_(n, ia, ja, a, rhs, u, &wksp[ib1], &wksp[ib2], &icnt);
+
+ if (itcom2_1.halt)
+ goto L270;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) */
+ /* WKSP(IB1) = U(IN) */
+
+L230:
+ itjsi_(n, ia, ja, a, rhs, &wksp[ib1], u, &wksp[ib2], &icnt);
+
+ if (itcom2_1.halt)
+ goto L270;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 23;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L300;
+
+ /* ... METHOD HAS CONVERGED */
+
+L270:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L300:
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] < 0)
+ goto L330;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L360;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L330:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L360:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* jsi_ */
+
+/* Subroutine */
+int sor_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer* ierr)
+{
+ /* Local variables */
+ static integer n3, nb, ib1, ib2, ib3, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE SOR (SUCCESSIVE OVERRELATION) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, SOR, DRIVES THE SUCCESSIVE */
+/* OVERRELAXATION ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. SOR NEEDS THIS */
+/* TO BE IN LENGTH AT LEAST N */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... SOR SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, DFAULT, ECHALL, ECHOUT, IPSTR, ITERM, */
+/* TIMER, ITSOR, IVFILL, PERMAT, PERROR, */
+/* PERVEC, PFSOR1, PMULT, PRBNDX, PSTOP, QSORT, */
+/* SBELM, SCAL, DCOPY, DDOT, TAU, UNSCAL, VFILL, */
+/* VOUT, WEVMW */
+/* SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT), */
+/* DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__3);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 31;
+ goto L360;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ ib3 = ib2 + *n;
+ iparm[7] = *n;
+ if (*nw < iparm[7]) {
+ ier = 32;
+ goto L360;
+ }
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED */
+
+ nb = iparm[8];
+ if (nb < 0)
+ goto L170;
+
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ permat_(n, ia, ja, a, iwksp, &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE */
+ /* ... DIAGONAL ELEMENTS. */
+
+L170:
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L360;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... ITERATION SEQUENCE */
+
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+
+ /* ... CODE FOR ONE ITERATION. */
+
+ /* U = U(IN) */
+
+ itsor_(n, ia, ja, a, rhs, u, &wksp[ib1]);
+
+ if (itcom2_1.halt)
+ goto L270;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 33;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L300;
+
+ /* ... METHOD HAS CONVERGED */
+
+L270:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+L300:
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] < 0)
+ goto L330;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L360;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L330:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[4] = itcom3_1.omega;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L360:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* sor_ */
+
+/* Subroutine */
+int ssorcg_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer* ierr)
+{
+ /* Local variables */
+ static integer n3, nb, ib1, ib2, ib3, ib4, ib5, ib6, ib7, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static doublereal betnew;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE SSORCG (SYMMETRIC SUCCESSIVE OVER- */
+/* RELAXATION CONJUGATE GRADIENT) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, SSORCG, DRIVES THE SYMMETRIC SOR-CG */
+/* ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. SSOR-CG */
+/* NEEDS TO BE IN LENGTH AT LEAST */
+/* 6*N + 2*ITMAX, IF IPARM(5)=0 (SYMMETRIC STORAGE) */
+/* 6*N + 4*ITMAX, IF IPARM(5)=1 (NONSYMMETRIC STORAGE) */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... SSORCG SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL, */
+/* ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER, */
+/* ITSRCG, IVFILL, OMEG, OMGCHG, OMGSTR, */
+/* PARCON, PBETA, PBSOR, PERMAT, PERROR, */
+/* PERVEC, PFSOR, PJAC, PMULT, PRBNDX, PSTOP, PVT */
+/* QSORT, SBELM, SCAL, DCOPY, DDOT, SUM3, */
+/* UNSCAL, VEVMW, VEVPW, VFILL, VOUT, WEVMW, */
+/* ZBRENT */
+/* SYSTEM DABS, DLOG, DLOG10, DBLE(AMAX0), DMAX1, AMIN1, */
+/* MOD, DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ if (iparm[8] >= 0)
+ iparm[5] = 2;
+
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__4);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 41;
+ goto L390;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L390;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ ib3 = ib2 + *n;
+ ib4 = ib3 + *n;
+ ib5 = ib4 + *n;
+ ib6 = ib5 + *n;
+ ib7 = ib6 + *n;
+ iparm[7] = *n * 6 + (itcom1_1.itmax << 1);
+ if (itcom1_1.isym != 0)
+ iparm[7] += itcom1_1.itmax << 1;
+
+ if (*nw < iparm[7]) {
+ ier = 42;
+ goto L390;
+ }
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED */
+
+ nb = iparm[8];
+ if (nb < 0)
+ goto L170;
+
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L390;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ permat_(n, ia, ja, a, iwksp, &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L390;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE */
+ /* ... DIAGONAL ELEMENTS. */
+
+L170:
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L390;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... SPECIAL PROCEDURE FOR FULLY ADAPTIVE CASE. */
+
+ if (! itcom2_1.adapt)
+ goto L250;
+
+ if (itcom2_1.betadt) {
+ vfill_(n, &wksp[ib1], &c_b286);
+ betnew = pbeta_(n, ia, ja, a, &wksp[ib1], &wksp[ib2], &wksp[ib3]) / (doublereal)(*n);
+ itcom3_1.betab = max(max(itcom3_1.betab,.25),betnew);
+ }
+
+ omeg_(&c_b21, &c__1);
+ itcom1_1.is = 0;
+
+ /* ... INITIALIZE FORWARD PSEUDO-RESIDUAL */
+
+L250:
+ itpackdcopy_(n, rhs, &c__1, &wksp[ib1], &c__1);
+ itpackdcopy_(n, u, &c__1, &wksp[ib2], &c__1);
+ pfsor_(n, ia, ja, a, &wksp[ib2], &wksp[ib1]);
+ vevmw_(n, &wksp[ib2], u);
+
+ /* ... ITERATION SEQUENCE */
+
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L260;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) WKSP(IB2) = C(IN) */
+ /* WKSP(IB1) = U(IN-1) WKSP(IB3) = C(IN-1) */
+
+ itsrcg_(n, ia, ja, a, rhs, u, &wksp[ib1], &wksp[ib2], &wksp[ib3], &wksp[ib4], &wksp[ib5], &wksp[ib6], &wksp[ib7]);
+
+ if (itcom2_1.halt)
+ goto L300;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) WKSP(IB2) = C(IN-1) */
+ /* WKSP(IB1) = U(IN) WKSP(IB3) =C(IN) */
+
+L260:
+ itsrcg_(n, ia, ja, a, rhs, &wksp[ib1], u, &wksp[ib3], &wksp[ib2], &wksp[ib4], &wksp[ib5], &wksp[ib6], &wksp[ib7]);
+
+ if (itcom2_1.halt)
+ goto L300;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 43;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L330;
+
+ /* ... METHOD HAS CONVERGED */
+
+L300:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L330:
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] < 0)
+ goto L360;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L390;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L360:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+ if (itcom1_1.isym != 0)
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[4] = itcom3_1.omega;
+ rparm[5] = itcom3_1.specr;
+ rparm[6] = itcom3_1.betab;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L390:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* ssorcg_ */
+
+/* Subroutine */
+int ssorsi_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer* ierr)
+{
+ /* Local variables */
+ static integer n3, nb, ib1, ib2, ib3, ib4, ib5, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static doublereal betnew;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE SSORSI (SYMMETRIC SUCCESSIVE RELAX- */
+/* ATION SEMI-ITERATION) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, SSORSI, DRIVES THE SYMMETRIC SOR-SI */
+/* ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. SSORSI */
+/* NEEDS THIS TO BE IN LENGTH AT LEAST 5*N */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... SSORSI SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHEBY, CHGSI, DFAULT, ECHALL, ECHOUT, */
+/* ITERM, TIMER, ITSRSI, IVFILL, OMEG, */
+/* OMGSTR, PARSI, PBETA, PERMAT, PERROR, */
+/* PERVEC, PFSOR, PMULT, PRBNDX, PSSOR1, */
+/* PSTOP, PVTBV, QSORT, SBELM, SCAL, DCOPY, */
+/* DDOT, SUM3, TSTCHG, UNSCAL, VEVPW, VFILL, */
+/* VOUT, WEVMW */
+/* SYSTEM DABS, DLOG, DLOG10, DBLE(AMAX0), DMAX1, */
+/* DBLE(FMOD), DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ if (iparm[8] >= 0)
+ iparm[5] = 2;
+
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__5);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 51;
+ goto L380;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L380;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ ib3 = ib2 + *n;
+ ib4 = ib3 + *n;
+ ib5 = ib4 + *n;
+ iparm[7] = *n * 5;
+ if (*nw < iparm[7])
+ ier = 52;
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED */
+
+ nb = iparm[8];
+ if (nb < 0)
+ goto L170;
+
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L380;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ permat_(n, ia, ja, a, iwksp, &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L380;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE */
+ /* ... DIAGONAL ELEMENTS. */
+
+L170:
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L380;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... SPECIAL PROCEDURE FOR FULLY ADAPTIVE CASE. */
+
+ if (! itcom2_1.adapt)
+ goto L240;
+
+ if (itcom2_1.betadt) {
+ vfill_(n, &wksp[ib1], &c_b286);
+ betnew = pbeta_(n, ia, ja, a, &wksp[ib1], &wksp[ib2], &wksp[ib3]) / (doublereal)(*n);
+ itcom3_1.betab = max(max(itcom3_1.betab,.25),betnew);
+ }
+
+ omeg_(&c_b21, &c__1);
+ itcom1_1.is = 0;
+
+ /* ... ITERATION SEQUENCE */
+
+L240:
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L250;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) */
+ /* WKSP(IB1) = U(IN-1) */
+
+ itsrsi_(n, ia, ja, a, rhs, u, &wksp[ib1], &wksp[ib2], &wksp[ib3], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L290;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) */
+ /* WKSP(IB1) = U(IN) */
+
+L250:
+ itsrsi_(n, ia, ja, a, rhs, &wksp[ib1], u, &wksp[ib2], &wksp[ib3], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L290;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 53;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L320;
+
+ /* ... METHOD HAS CONVERGED */
+
+L290:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L320:
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] < 0)
+ goto L350;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[ib3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L380;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L350:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[4] = itcom3_1.omega;
+ rparm[5] = itcom3_1.specr;
+ rparm[6] = itcom3_1.betab;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L380:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* ssorsi_ */
+
+/* Subroutine */
+int rscg_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer* ierr)
+{
+ /* Local variables */
+ static integer n3, nb, nr, ib1, ib2, ib3, ib4, ib5, jb3, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE RSCG (REDUCED SYSTEM CONJUGATE */
+/* GRADIENT) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, RSCG, DRIVES THE REDUCED SYSTEM CG */
+/* ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IN THE RED-BLACK MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. RSCG NEEDS */
+/* THIS TO BE IN LENGTH AT LEAST */
+/* N+3*NB+2*ITMAX, IF IPARM(5)=0 (SYMMETRIC STORAGE) */
+/* N+3*NB+4*ITMAX, IF IPARM(5)=1 (NONSYMMETRIC STORAGE) */
+/* HERE NB IS THE ORDER OF THE BLACK SUBSYSTEM */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... RSCG SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL, */
+/* ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER */
+/* ITRSCG, IVFILL, PARCON, PERMAT, */
+/* PERROR, PERVEC, PMULT, PRBNDX, PRSBLK, */
+/* PRSRED, PSTOP, QSORT, SBELM, SCAL, DCOPY, */
+/* DDOT, SUM3, UNSCAL, VFILL, VOUT, WEVMW, */
+/* ZBRENT */
+/* SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, MOD, DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__6);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 61;
+ goto L430;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L430;
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ jb3 = ib2 + *n;
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF POSSIBLE */
+
+ nb = iparm[8];
+ if (nb < 0) {
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L430;
+ }
+
+ if (nb < 0 || nb > *n) {
+ ier = 64;
+ goto L430;
+ }
+ if (nb == 0 || nb == *n)
+ nb = *n / 2;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ if (iparm[8] < 0) {
+ permat_(n, ia, ja, a, iwksp, &iwksp[jb3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L430;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+ }
+
+ /* ... FINISH WKSP BASE ADDRESSES */
+
+ ib3 = ib2 + nb;
+ ib4 = ib3 + nb;
+ ib5 = ib4 + nb;
+ nr = *n - nb;
+ iparm[7] = *n + nb * 3 + (itcom1_1.itmax << 1);
+ if (itcom1_1.isym != 0)
+ iparm[7] += itcom1_1.itmax << 1;
+
+ if (*nw < iparm[7]) {
+ ier = 62;
+ goto L430;
+ }
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE */
+ /* ... DIAGONAL ELEMENTS. */
+
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L430;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... INITIALIZE FORWARD PSEUDO-RESIDUAL */
+
+ if (*n <= 1) {
+ u[0] = rhs[0];
+ goto L330;
+ }
+ itpackdcopy_(&nr, rhs, &c__1, &wksp[ib1], &c__1);
+ prsred_(&nb, &nr, ia, ja, a, &u[nr], &wksp[ib1]);
+ itpackdcopy_(&nb, &rhs[nr], &c__1, &wksp[ib2], &c__1);
+ prsblk_(&nb, &nr, ia, ja, a, &wksp[ib1], &wksp[ib2]);
+ vevmw_(&nb, &wksp[ib2], &u[nr]);
+
+ /* ... ITERATION SEQUENCE */
+
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L290;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) WKSP(IB2) = D(IN) */
+ /* WKSP(IB1) = U(IN-1) WKSP(IB3) = D(IN-1) */
+
+ itrscg_(n, &nb, ia, ja, a, u, &wksp[ib1], &wksp[ib2], &wksp[ib3], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L330;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) WKSP(IB2) = D(IN-1) */
+ /* WKSP(IB1) = U(IN) WKSP(IB3) = D(IN) */
+
+L290:
+ itrscg_(n, &nb, ia, ja, a, &wksp[ib1], u, &wksp[ib3], &wksp[ib2], &wksp[ib4], &wksp[ib5]);
+
+ if (itcom2_1.halt)
+ goto L330;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 63;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L360;
+
+ /* ... METHOD HAS CONVERGED */
+
+L330:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L360:
+ if (*n != 1) {
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ itpackdcopy_(&nr, rhs, &c__1, u, &c__1);
+ prsred_(&nb, &nr, ia, ja, a, &u[nr], u);
+ }
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] >= 0)
+ goto L400;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[jb3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L430;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L400:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+ if (itcom1_1.isym != 0)
+ iparm[7] -= (itcom1_1.itmax - itcom1_1.in) << 1;
+
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L430:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* rscg_ */
+
+/* Subroutine */
+int rssi_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ integer *iwksp, integer *nw, doublereal *wksp, integer *iparm, doublereal *rparm, integer* ierr)
+{
+ /* Local variables */
+ static integer n3, nb, nr, ib1, ib2, jb3, ier;
+ static doublereal tol;
+ static doublereal temp;
+ static integer loop;
+ static doublereal time1, time2;
+ static real timi1, timj1, timi2, timj2;
+ static integer idgts;
+ static doublereal digit1, digit2;
+ static integer itmax1;
+ static integer ierper;
+
+/* ITPACK 2C MAIN SUBROUTINE RSSI (REDUCED SYSTEM SEMI-ITERATIVE) */
+/* EACH OF THE MAIN SUBROUTINES: */
+/* JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI */
+/* CAN BE USED INDEPENDENTLY OF THE OTHERS */
+
+/* THIS SUBROUTINE, RSSI, DRIVES THE REDUCED SYSTEM SI */
+/* ALGORITHM. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS */
+/* THE LATEST ESTIMATE TO THE SOLUTION. */
+/* IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N */
+/* NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT, */
+/* IPARM(8) IS AMOUNT USED. */
+/* WKSP D.P. VECTOR USED FOR WORKING SPACE. RSSI */
+/* NEEDS THIS TO BE IN LENGTH AT LEAST N + NB */
+/* HERE NB IS THE ORDER OF THE BLACK SUBSYSTEM */
+/* IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY */
+/* SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF */
+/* RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME */
+/* D.P. PARAMETERS WHICH AFFECT THE METHOD. */
+/* IER OUTPUT INTEGER. ERROR FLAG. (= IERR) */
+/* */
+/* ... RSSI SUBPROGRAM REFERENCES: */
+/* */
+/* FROM ITPACK BISRCH, CHEBY, CHGSI, DFAULT, ECHALL, */
+/* ECHOUT, ITERM, TIMER, ITRSSI, IVFILL, */
+/* PARSI, PERMAT, PERROR, PERVEC, PMULT, */
+/* PRBNDX, PRSBLK, PRSRED, PSTOP, QSORT, */
+/* DAXPY, SBELM, SCAL, DCOPY, DDOT, SUM3, */
+/* TSTCHG, UNSCAL, VEVMW, VFILL, VOUT, */
+/* WEVMW */
+/* SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT), */
+/* DSQRT */
+/* */
+/* VERSION: ITPACK 2C (MARCH 1982) */
+/* */
+/* CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS */
+/* CENTER FOR NUMERICAL ANALYSIS */
+/* UNIVERSITY OF TEXAS */
+/* AUSTIN, TX 78712 */
+/* (512) 471-1242 */
+/* */
+/* FOR ADDITIONAL DETAILS ON THE */
+/* (A) SUBROUTINE SEE TOMS ARTICLE 1982 */
+/* (B) ALGORITHM SEE CNA REPORT 150 */
+/* */
+/* BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN */
+/* */
+/* REFERENCE THE BOOK: APPLIED ITERATIVE METHODS */
+/* L. HAGEMAN, D. YOUNG */
+/* ACADEMIC PRESS, 1981 */
+/* */
+/* ************************************************** */
+/* * IMPORTANT NOTE * */
+/* * * */
+/* * WHEN INSTALLING ITPACK ROUTINES ON A * */
+/* * DIFFERENT COMPUTER, RESET SOME OF THE VALUES * */
+/* * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE * */
+/* * * */
+/* * DRELPR MACHINE RELATIVE PRECISION * */
+/* * RPARM(1) STOPPING CRITERION * */
+/* * * */
+/* * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE * */
+/* * SECOND USED IN TIMER * */
+/* * * */
+/* ************************************************** */
+/* */
+/* SPECIFICATIONS FOR ARGUMENTS */
+/* */
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM1 */
+/* */
+/* IN - ITERATION NUMBER */
+/* IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED */
+/* ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH */
+/* ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED */
+/* LEVEL - LEVEL OF OUTPUT CONTROL SWITCH */
+/* NOUT - OUTPUT UNIT NUMBER */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM2 */
+/* */
+/* ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH */
+/* BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA */
+/* CASEII - ADAPTIVE PROCEDURE CASE SWITCH */
+/* HALT - STOPPING TEST SWITCH */
+/* PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH */
+/* */
+/* ... VARIABLES IN COMMON BLOCK - ITCOM3 */
+/* */
+/* BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N */
+/* BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX */
+/* CME - ESTIMATE OF LARGEST EIGENVALUE */
+/* DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N */
+/* DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S */
+/* FF - ADAPTIVE PROCEDURE DAMPING FACTOR */
+/* GAMMA - ACCELERATION PARAMETER */
+/* OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR */
+/* QA - PSEUDO-RESIDUAL RATIO */
+/* QT - VIRTUAL SPECTRAL RADIUS */
+/* RHO - ACCELERATION PARAMETER */
+/* RRR - ADAPTIVE PARAMETER */
+/* SIGE - PARAMETER SIGMA-SUB-E */
+/* SME - ESTIMATE OF SMALLEST EIGENVALUE */
+/* SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR */
+/* DRELPR - MACHINE RELATIVE PRECISION */
+/* STPTST - STOPPING PARAMETER */
+/* UDNM - TWO NORM OF U */
+/* ZETA - STOPPING CRITERION */
+
+ itcom1_1.level = iparm[1];
+ itcom1_1.nout = iparm[3];
+ ier = 0;
+ if (iparm[0] <= 0)
+ return 0;
+
+ if (iparm[10] == 0)
+ timj1 = timer_((real*)0);
+
+ if (itcom1_1.level < 3)
+ echout_(iparm, rparm, &c__7);
+ else
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__1);
+ temp = itcom3_1.drelpr * 500.;
+ if (itcom3_1.zeta < temp)
+ itcom3_1.zeta = temp;
+
+ time1 = rparm[8];
+ time2 = rparm[9];
+ digit1 = rparm[10];
+ digit2 = rparm[11];
+
+ /* ... VERIFY N */
+
+ if (*n <= 0) {
+ ier = 71;
+ goto L420;
+ }
+
+ /* ... REMOVE ROWS AND COLUMNS IF REQUESTED */
+
+ if (iparm[9] != 0) {
+ tol = rparm[7];
+ ivfill_(n, iwksp, &c__0);
+ vfill_(n, wksp, &c_b21);
+ sbelm_(n, ia, ja, a, rhs, iwksp, wksp, &tol, &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES. */
+
+ ib1 = 0;
+ ib2 = ib1 + *n;
+ jb3 = ib2 + *n;
+
+ /* ... PERMUTE TO RED-BLACK SYSTEM IF POSSIBLE */
+
+ nb = iparm[8];
+ if (nb < 0) {
+ n3 = *n * 3;
+ ivfill_(&n3, iwksp, &c__0);
+ prbndx_(n, &nb, ia, ja, iwksp, &iwksp[ib2], &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L420;
+ }
+
+ if (nb < 0 || nb > *n) {
+ ier = 74;
+ goto L420;
+ }
+ if (nb == 0 || nb == *n)
+ nb = *n / 2;
+
+ /* ... PERMUTE MATRIX AND RHS */
+
+ if (iparm[8] < 0) {
+ permat_(n, ia, ja, a, iwksp, &iwksp[jb3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L420;
+
+ pervec_(n, rhs, iwksp);
+ pervec_(n, u, iwksp);
+ }
+
+ /* ... INITIALIZE WKSP BASE ADDRESSES */
+
+ nr = *n - nb;
+
+ iparm[7] = *n + nb;
+ if (*nw < iparm[7]) {
+ ier = 72;
+ goto L420;
+ }
+
+ /* ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE */
+ /* ... DIAGONAL ELEMENTS. */
+
+ vfill_(&iparm[7], wksp, &c_b21);
+ scal_(n, ia, ja, a, rhs, u, wksp, &itcom1_1.level, &itcom1_1.nout, &ier);
+ if (ier != 0)
+ goto L420;
+
+ if (iparm[10] == 0)
+ timi1 = timer_((real*)0);
+
+ /* ... ITERATION SEQUENCE */
+
+ if (*n <= 1) {
+ u[0] = rhs[0];
+ goto L320;
+ }
+ itmax1 = itcom1_1.itmax + 1;
+ for (loop = 1; loop <= itmax1; ++loop) {
+ itcom1_1.in = loop - 1;
+ if (itcom1_1.in % 2 == 1)
+ goto L280;
+
+ /* ... CODE FOR THE EVEN ITERATIONS. */
+
+ /* U = U(IN) */
+ /* WKSP(IB1) = U(IN-1) */
+
+ itrssi_(n, &nb, ia, ja, a, rhs, u, &wksp[ib1], &wksp[ib2]);
+
+ if (itcom2_1.halt)
+ goto L320;
+
+ continue;
+
+ /* ... CODE FOR THE ODD ITERATIONS. */
+
+ /* U = U(IN-1) */
+ /* WKSP(IB1) = U(IN) */
+
+L280:
+ itrssi_(n, &nb, ia, ja, a, rhs, &wksp[ib1], u, &wksp[ib2]);
+
+ if (itcom2_1.halt)
+ goto L320;
+ }
+
+ /* ... ITMAX HAS BEEN REACHED */
+
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+ ier = 73;
+ if (iparm[2] == 0)
+ rparm[0] = itcom3_1.stptst;
+
+ goto L350;
+
+ /* ... METHOD HAS CONVERGED */
+
+L320:
+ if (iparm[10] == 0) {
+ timi2 = timer_((real*)0);
+ time1 = (doublereal) (timi2 - timi1);
+ }
+
+ /* ... PUT SOLUTION INTO U IF NOT ALREADY THERE. */
+
+L350:
+ if (*n != 1) {
+ if (itcom1_1.in % 2 == 1)
+ itpackdcopy_(n, &wksp[ib1], &c__1, u, &c__1);
+
+ itpackdcopy_(&nr, rhs, &c__1, u, &c__1);
+ prsred_(&nb, &nr, ia, ja, a, &u[nr], u);
+ }
+
+ /* ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS. */
+
+ unscal_(n, ia, ja, a, rhs, u, wksp);
+
+ /* ... UN-PERMUTE MATRIX,RHS, AND SOLUTION */
+
+ if (iparm[8] >= 0)
+ goto L390;
+
+ permat_(n, ia, ja, a, &iwksp[ib2], &iwksp[jb3], &itcom1_1.isym, &itcom1_1.level, &itcom1_1.nout, &ierper);
+ if (ierper != 0) {
+ if (ier == 0)
+ ier = ierper;
+
+ goto L420;
+ }
+
+ pervec_(n, rhs, &iwksp[ib2]);
+ pervec_(n, u, &iwksp[ib2]);
+
+ /* ... OPTIONAL ERROR ANALYSIS */
+
+L390:
+ idgts = iparm[11];
+ if (idgts >= 0) {
+ if (iparm[1] <= 0)
+ idgts = 0;
+
+ perror_(n, ia, ja, a, rhs, u, wksp, &digit1, &digit2, &idgts);
+ }
+
+ /* ... SET RETURN PARAMETERS IN IPARM AND RPARM */
+
+ if (iparm[10] == 0) {
+ timj2 = timer_((real*)0);
+ time2 = (doublereal) (timj2 - timj1);
+ }
+ if (iparm[2] == 0) {
+ iparm[0] = itcom1_1.in;
+ iparm[8] = nb;
+ rparm[1] = itcom3_1.cme;
+ rparm[2] = itcom3_1.sme;
+ rparm[8] = time1;
+ rparm[9] = time2;
+ rparm[10] = digit1;
+ rparm[11] = digit2;
+ }
+
+L420:
+ *ierr = ier;
+ if (itcom1_1.level >= 3)
+ echall_(n, ia, ja, a, rhs, iparm, rparm, &c__2);
+
+ return 0;
+} /* rssi_ */
+
+/* Subroutine */
+int itjcg_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *u1,
+ doublereal *d, doublereal *d1, doublereal *dtwd, doublereal *tri)
+{
+ static doublereal c1, c2, c3, c4;
+ static logical q1;
+ static doublereal con;
+ static doublereal dnrm;
+ static doublereal dtnrm;
+ static doublereal gamold;
+ static doublereal rhoold;
+
+/* THIS SUBROUTINE, ITJCG, PERFORMS ONE ITERATION OF THE */
+/* JACOBI CONJUGATE GRADIENT ALGORITHM. IT IS CALLED BY JCG. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. CONTAINS INFORMATION DEFINING */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. CONTAINS THE NONZERO VALUES OF THE */
+/* LINEAR SYSTEM. */
+/* U INPUT D.P. VECTOR. CONTAINS THE VALUE OF THE */
+/* SOLUTION VECTOR AT THE END OF IN ITERATIONS. */
+/* U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, IT CONTAINS */
+/* THE VALUE OF THE SOLUTION AT THE END OF THE IN-1 */
+/* ITERATION. ON OUTPUT, IT WILL CONTAIN THE NEWEST */
+/* ESTIMATE FOR THE SOLUTION VECTOR. */
+/* D INPUT D.P. VECTOR. CONTAINS THE PSEUDO-RESIDUAL */
+/* VECTOR AFTER IN ITERATIONS. */
+/* D1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, D1 CONTAINS */
+/* THE PSEUDO-RESIDUAL VECTOR AFTER IN-1 ITERATIONS. ON */
+/* OUTPUT, IT WILL CONTAIN THE NEWEST PSEUDO-RESIDUAL */
+/* VECTOR. */
+/* DTWD D.P. ARRAY. USED IN THE COMPUTATIONS OF THE */
+/* ACCELERATION PARAMETER GAMMA AND THE NEW PSEUDO- */
+/* RESIDUAL. */
+/* TRI D.P. ARRAY. STORES THE TRIDIAGONAL MATRIX ASSOCIATED */
+/* WITH THE EIGENVALUES OF THE CONJUGATE GRADIENT */
+/* POLYNOMIAL. */
+
+ /* ... COMPUTE NEW ESTIMATE FOR CME IF ADAPT = .TRUE. */
+
+ if (itcom2_1.adapt)
+ chgcon_(tri, &gamold, &rhoold, &c__1);
+
+ /* ... TEST FOR STOPPING */
+
+ itcom3_1.delnnm = itpackddot_(n, d, &c__1, d, &c__1);
+ dnrm = itcom3_1.delnnm;
+ con = itcom3_1.cme;
+ pstop_(n, u, &dnrm, &con, &c__1, &q1);
+ if (itcom2_1.halt)
+ goto L30;
+
+ /* ... COMPUTE RHO AND GAMMA - ACCELERATION PARAMETERS */
+
+ vfill_(n, dtwd, &c_b21);
+ pjac_(n, ia, ja, a, d, dtwd);
+ dtnrm = itpackddot_(n, d, &c__1, dtwd, &c__1);
+ if (itcom1_1.isym != 0)
+ rhoold = itpackddot_(n, dtwd, &c__1, d1, &c__1);
+
+ parcon_(&dtnrm, &c1, &c2, &c3, &c4, &gamold, &rhoold, &c__1);
+
+ /* ... COMPUTE U(IN+1) AND D(IN+1) */
+
+ sum3_(n, &c1, d, &c2, u, &c3, u1);
+ sum3_(n, &c1, dtwd, &c4, d, &c3, d1);
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L30:
+ iterm_(n, a, u, dtwd, &c__1);
+
+ return 0;
+} /* itjcg_ */
+
+/* Subroutine */
+int itjsi_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs,
+ doublereal *u, doublereal *u1, doublereal *d, integer *icnt)
+{
+ static doublereal c1, c2, c3;
+ static logical q1;
+ static doublereal con;
+ static doublereal dnrm;
+ static doublereal dtnrm;
+ static doublereal oldnrm;
+
+/* THIS SUBROUTINE, ITJSI, PERFORMS ONE ITERATION OF THE */
+/* JACOBI SEMI-ITERATIVE ALGORITHM. IT IS CALLED BY JSI. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE */
+/* SOLUTION VECTOR AFTER IN ITERATIONS. */
+/* U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE */
+/* SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT, */
+/* IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION */
+/* VECTOR. */
+/* D D.P. ARRAY. D IS USED FOR THE COMPUTATION OF THE */
+/* PSEUDO-RESIDUAL ARRAY FOR THE CURRENT ITERATION. */
+/* ICNT NUMBER OF ITERATIONS SINCE LAST CHANGE OF SME */
+
+ if (itcom1_1.in == 0)
+ *icnt = 0;
+
+ /* ... COMPUTE PSEUDO-RESIDUALS */
+
+ itpackdcopy_(n, rhs, &c__1, d, &c__1);
+ pjac_(n, ia, ja, a, u, d);
+ vevmw_(n, d, u);
+
+ /* ... STOPPING AND ADAPTIVE CHANGE TESTS */
+
+ oldnrm = itcom3_1.delnnm;
+ itcom3_1.delnnm = itpackddot_(n, d, &c__1, d, &c__1);
+ dnrm = itcom3_1.delnnm;
+ con = itcom3_1.cme;
+ pstop_(n, u, &dnrm, &con, &c__1, &q1);
+ if (itcom2_1.halt)
+ goto L40;
+
+ if (! itcom2_1.adapt)
+ goto L30;
+
+ if (! tstchg_(&c__1))
+ goto L10;
+
+ /* ... CHANGE ITERATIVE PARAMETERS (CME) */
+
+ dtnrm = pvtbv_(n, ia, ja, a, d);
+ chgsi_(&dtnrm, &c__1);
+ if (! itcom2_1.adapt)
+ goto L30;
+
+ goto L20;
+
+ /* ... TEST IF SME NEEDS TO BE CHANGED AND CHANGE IF NECESSARY. */
+
+L10:
+ if (itcom2_1.caseii)
+ goto L30;
+
+ if (! chgsme_(&oldnrm, icnt))
+ goto L30;
+
+ *icnt = 0;
+
+ /* ... COMPUTE U(IN+1) AFTER CHANGE OF PARAMETERS */
+
+L20:
+ itpackdcopy_(n, u, &c__1, u1, &c__1);
+ itpackdaxpy_(n, &itcom3_1.gamma, d, &c__1, u1, &c__1);
+ goto L40;
+
+ /* ... COMPUTE U(IN+1) WITHOUT CHANGE OF PARAMETERS */
+
+L30:
+ parsi_(&c1, &c2, &c3, &c__1);
+ sum3_(n, &c1, d, &c2, u, &c3, u1);
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L40:
+ iterm_(n, a, u, d, &c__2);
+
+ return 0;
+} /* itjsi_ */
+
+/* Subroutine */
+int itsor_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u, doublereal *wk)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal h;
+ static logical q1;
+ static integer ip;
+ static integer iss;
+ static doublereal dnrm;
+ static integer iphat;
+ static doublereal spcrm1;
+ static logical change;
+ static doublereal omegap;
+ static integer ipstar;
+
+/* THIS SUBROUTINE, ITSOR, PERFORMS ONE ITERATION OF THE */
+/* SUCCESSIVE OVERRELAXATION ALGORITHM. IT IS CALLED BY SOR. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE */
+/* SOLUTION VECTOR AFTER IN ITERATIONS. ON OUTPUT, */
+/* IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION */
+/* VECTOR. */
+/* WK D.P. ARRAY. WORK VECTOR OF LENGTH N. */
+
+ /* ... SET INITIAL PARAMETERS NOT ALREADY SET */
+
+ if (itcom1_1.in != 0)
+ goto L20;
+
+ pstop_(n, u, &c_b21, &c_b21, &c__0, &q1);
+ if (! itcom2_1.adapt) {
+ change = FALSE_;
+ ip = 0;
+ iphat = 2;
+ iss = 0;
+ goto L30;
+ }
+
+ change = TRUE_;
+ ip = 0;
+ omegap = itcom3_1.omega;
+ itcom3_1.omega = 1.;
+ iss = 0;
+ iphat = 2;
+ ipstar = 4;
+ if (omegap <= 1.)
+ change = FALSE_;
+
+ /* ... RESET OMEGA, IPHAT, AND IPSTAR (CIRCLE A IN FLOWCHART) */
+
+L20:
+ if (change) {
+ change = FALSE_;
+ ++itcom1_1.is;
+ ip = 0;
+ iss = 0;
+ itcom3_1.omega = min(omegap,tau_(&itcom1_1.is));
+ iphat = max(3, (integer)((itcom3_1.omega-1.)/(2.-itcom3_1.omega)));
+ ipstar = ipstr_(&itcom3_1.omega);
+ }
+
+ /* ... COMPUTE U (IN + 1) AND NORM OF DEL(S,P) - CIRCLE B IN FLOW CHART */
+
+L30:
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ spcrm1 = itcom3_1.specr;
+ itpackdcopy_(n, rhs, &c__1, wk, &c__1);
+ pfsor1_(n, ia, ja, a, u, wk);
+ if (itcom3_1.delnnm == 0.)
+ goto L40;
+
+ if (itcom1_1.in != 0)
+ itcom3_1.specr = itcom3_1.delnnm / itcom3_1.delsnm;
+
+ if (ip < iphat)
+ goto L70;
+
+ /* ... STOPPING TEST, SET H */
+
+ if (itcom3_1.specr >= 1.)
+ goto L70;
+
+ if (itcom3_1.specr > itcom3_1.omega - 1.) {
+ h = itcom3_1.specr;
+ goto L50;
+ }
+L40:
+ ++iss;
+ h = itcom3_1.omega - 1.;
+
+ /* ... PERFORM STOPPING TEST. */
+
+L50:
+ dnrm = itcom3_1.delnnm * itcom3_1.delnnm;
+ pstop_(n, u, &dnrm, &h, &c__1, &q1);
+ if (itcom2_1.halt)
+ goto L70;
+
+ /* ... METHOD HAS NOT CONVERGED YET, TEST FOR CHANGING OMEGA */
+
+ if (! itcom2_1.adapt)
+ goto L70;
+
+ if (ip < ipstar)
+ goto L70;
+
+ if (itcom3_1.omega <= 1.) {
+ itcom3_1.cme = sqrt((abs(itcom3_1.specr)));
+ omegap = 2. / (sqrt(abs(1. - itcom3_1.specr)) + 1.);
+ change = TRUE_;
+ goto L70;
+ }
+
+ if (iss != 0)
+ goto L70;
+
+ d__1 = itcom3_1.omega - 1.;
+ if (itcom3_1.specr <= pow_dd(&d__1, &itcom3_1.ff))
+ goto L70;
+
+ /* ... CHANGE PARAMETERS */
+
+ if (itcom3_1.specr + 5e-5 > spcrm1) {
+ itcom3_1.cme = (itcom3_1.specr + itcom3_1.omega - 1.) /
+ (sqrt((abs(itcom3_1.specr))) * itcom3_1.omega);
+ omegap = 2. / (sqrt(abs(1. - itcom3_1.cme * itcom3_1.cme)) + 1.);
+ change = TRUE_;
+ }
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L70:
+ iterm_(n, a, u, wk, &c__3);
+ ++ip;
+
+ return 0;
+} /* itsor_ */
+
+/* Subroutine */
+int itsrcg_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs,
+ doublereal *u, doublereal *u1, doublereal *c, doublereal *c1,
+ doublereal *d, doublereal *dl, doublereal *wk, doublereal *tri)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static logical q1;
+ static doublereal t1, t2, t3, t4, con;
+ static doublereal dnrm;
+ static doublereal gamold;
+ static doublereal betnew, rhoold;
+
+/* THIS SUBROUTINE, ITSRCG, PERFORMS ONE ITERATION OF THE */
+/* SYMMETRIC SOR CONJUGATE GRADIENT ALGORITHM. IT IS CALLED BY */
+/* SSORCG. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE OF THE */
+/* SOLUTION VECTOR AFTER IN ITERATIONS. */
+/* U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE */
+/* THE ESTIMATE FOR THE SOLUTION AFTER IN-1 ITERATIONS. */
+/* ON OUTPUT, U1 CONTAINS THE UPDATED ESTIMATE. */
+/* C INPUT D.P. VECTOR. CONTAINS THE FORWARD RESIDUAL */
+/* AFTER IN ITERATIONS. */
+/* C1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, C1 CONTAINS */
+/* THE FORWARD RESIDUAL AFTER IN-1 ITERATIONS. ON */
+/* OUTPUT, C1 CONTAINS THE UPDATED FORWARD RESIDUAL. */
+/* D D.P. VECTOR. IS USED TO COMPUTE THE BACKWARD PSEUDO- */
+/* RESIDUAL VECTOR FOR THE CURRENT ITERATION. */
+/* DL D.P. VECTOR. IS USED IN THE COMPUTATIONS OF THE */
+/* ACCELERATION PARAMETERS. */
+/* WK D.P. VECTOR. WORKING SPACE OF LENGTH N. */
+/* TRI D.P. VECTOR. STORES THE TRIDIAGONAL MATRIX ASSOCIATED */
+/* WITH THE CONJUGATE GRADIENT ACCELERATION. */
+
+ /* ... CALCULATE S-PRIME FOR ADAPTIVE PROCEDURE. */
+
+ if (itcom2_1.adapt || itcom2_1.partad)
+ chgcon_(tri, &gamold, &rhoold, &c__3);
+
+ /* ... COMPUTE BACKWARD RESIDUAL */
+
+ itpackdcopy_(n, rhs, &c__1, wk, &c__1);
+ itpackdcopy_(n, c, &c__1, d, &c__1);
+ vevpw_(n, d, u);
+ pbsor_(n, ia, ja, a, d, wk);
+ vevmw_(n, d, u);
+
+ /* ... COMPUTE ACCELERATION PARAMETERS AND THEN U(IN+1) (IN U1) */
+
+ itpackdcopy_(n, d, &c__1, dl, &c__1);
+ vfill_(n, wk, &c_b21);
+ pfsor_(n, ia, ja, a, dl, wk);
+ wevmw_(n, d, dl);
+ itcom3_1.delnnm = itpackddot_(n, c, &c__1, c, &c__1);
+ if (itcom3_1.delnnm != 0.) {
+ dnrm = itpackddot_(n, c, &c__1, dl, &c__1);
+ if (dnrm != 0.) {
+ if (itcom1_1.isym != 0)
+ rhoold = itpackddot_(n, c, &c__1, c1, &c__1) - itpackddot_(n, dl, &c__1, c1, &c__1);
+
+ parcon_(&dnrm, &t1, &t2, &t3, &t4, &gamold, &rhoold, &c__3);
+ sum3_(n, &t1, d, &t2, u, &t3, u1);
+ }
+ }
+
+ /* ... TEST FOR STOPPING */
+
+ itcom3_1.bdelnm = itpackddot_(n, d, &c__1, d, &c__1);
+ dnrm = itcom3_1.bdelnm;
+ con = itcom3_1.specr;
+ pstop_(n, u, &dnrm, &con, &c__1, &q1);
+ if (itcom2_1.halt)
+ goto L100;
+
+ /* ... IF NON- OR PARTIALLY-ADAPTIVE, COMPUTE C(IN+1) AND EXIT. */
+
+ if (! itcom2_1.adapt) {
+ d__1 = -t1;
+ sum3_(n, &d__1, dl, &t2, c, &t3, c1);
+ goto L100;
+ }
+
+ /* ... FULLY ADAPTIVE PROCEDURE */
+
+ if (omgstr_(&c__1))
+ goto L90;
+
+ /* ... PARAMETERS HAVE BEEN UNCHANGED. COMPUTE C(IN+1) AND EXIT. */
+
+ if (! omgchg_(&c__1)) {
+ d__1 = -t1;
+ sum3_(n, &d__1, dl, &t2, c, &t3, c1);
+ goto L100;
+ }
+
+ /* ... IT HAS BEEN DECIDED TO CHANGE PARAMETERS */
+ /* (1) COMPUTE NEW BETAB IF BETADT = .TRUE. */
+
+ if (itcom2_1.betadt) {
+ betnew = pbeta_(n, ia, ja, a, d, wk, c1) / itcom3_1.bdelnm;
+ itcom3_1.betab = max(max(itcom3_1.betab,.25),betnew);
+ }
+
+ /* ... (2) COMPUTE NEW CME, OMEGA, AND SPECR */
+
+ if (! itcom2_1.caseii) {
+ dnrm = pvtbv_(n, ia, ja, a, d);
+ goto L80;
+ }
+ vfill_(n, wk, &c_b21);
+ pjac_(n, ia, ja, a, d, wk);
+ dnrm = itpackddot_(n, wk, &c__1, wk, &c__1);
+L80:
+ omeg_(&dnrm, &c__3);
+
+ /* ... (3) COMPUTE NEW FORWARD RESIDUAL SINCE OMEGA HAS BEEN CHANGED. */
+
+L90:
+ itpackdcopy_(n, rhs, &c__1, wk, &c__1);
+ itpackdcopy_(n, u1, &c__1, c1, &c__1);
+ pfsor_(n, ia, ja, a, c1, wk);
+ vevmw_(n, c1, u1);
+
+ /* ... OUTPUT INTERMEDIATE RESULTS. */
+
+L100:
+ iterm_(n, a, u, wk, &c__4);
+
+ return 0;
+} /* itsrcg_ */
+
+/* Subroutine */
+int itsrsi_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u,
+ doublereal *u1, doublereal *c, doublereal *d, doublereal *ctwd, doublereal *wk)
+{
+ /* Local variables */
+ static doublereal c1, c2, c3;
+ static logical q1;
+ static doublereal con;
+ static doublereal dnrm;
+ static doublereal betnew;
+
+/* THIS SUBROUTINE, ITSRSI, PERFORMS ONE ITERATION OF THE */
+/* SYMMETRIC SOR SEMI-ITERATION ALGORITHM. IT IS CALLED BY */
+/* SSORSI. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE OF THE */
+/* SOLUTION VECTOR AFTER IN ITERATIONS. */
+/* U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE */
+/* THE ESTIMATE FOR THE SOLUTION AFTER IN-1 ITERATIONS. */
+/* ON OUTPUT, U1 CONTAINS THE UPDATED ESTIMATE. */
+/* C D.P. VECTOR. IS USED TO COMPUTE THE FORWARD PSEUDO- */
+/* RESIDUAL VECTOR FOR THE CURRENT ITERATION. */
+/* D D.P. VECTOR. IS USED TO COMPUTE THE BACKWARD PSEUDO- */
+/* RESIDUAL VECTOR FOR THE CURRENT ITERATION. */
+/* CTWD D.P. VECTOR. IS USED IN THE COMPUTATIONS OF THE */
+/* ACCELERATION PARAMETERS. */
+/* WK D.P. VECTOR. WORKING SPACE OF LENGTH N. */
+
+ /* ... COMPUTE PSEUDO-RESIDUALS (FORWARD AND BACKWARD) */
+
+ itpackdcopy_(n, rhs, &c__1, wk, &c__1);
+ itpackdcopy_(n, u, &c__1, ctwd, &c__1);
+ pssor1_(n, ia, ja, a, ctwd, wk, c, d);
+
+ /* ... COMPUTE U(IN+1) -- CONTAINED IN THE VECTOR U1. */
+
+ parsi_(&c1, &c2, &c3, &c__3);
+ sum3_(n, &c1, d, &c2, u, &c3, u1);
+
+ /* ... TEST FOR STOPPING */
+
+ itcom3_1.bdelnm = itpackddot_(n, d, &c__1, d, &c__1);
+ dnrm = itcom3_1.bdelnm;
+ con = itcom3_1.specr;
+ pstop_(n, u, &dnrm, &con, &c__1, &q1);
+ if (itcom2_1.halt || ! (itcom2_1.adapt || itcom2_1.partad))
+ goto L40;
+
+ /* ... ADAPTIVE PROCEDURE */
+
+ if (omgstr_(&c__1))
+ goto L40;
+
+ itcom3_1.delnnm = itpackddot_(n, c, &c__1, c, &c__1);
+ if (itcom1_1.in == itcom1_1.is)
+ itcom3_1.delsnm = itcom3_1.delnnm;
+
+ if (itcom1_1.in == 0 || ! tstchg_(&c__1))
+ goto L40;
+
+ /* ... IT HAS BEEN DECIDED TO CHANGE PARAMETERS. */
+ /* ... (1) COMPUTE CTWD */
+
+ itpackdcopy_(n, d, &c__1, ctwd, &c__1);
+ vfill_(n, wk, &c_b21);
+ pfsor_(n, ia, ja, a, ctwd, wk);
+ vevpw_(n, ctwd, c);
+ vevmw_(n, ctwd, d);
+
+ /* ... (2) COMPUTE NEW SPECTRAL RADIUS FOR CURRENT OMEGA. */
+
+ dnrm = itpackddot_(n, c, &c__1, ctwd, &c__1);
+ chgsi_(&dnrm, &c__3);
+ if (! itcom2_1.adapt)
+ goto L40;
+
+ /* ... (3) COMPUTE NEW BETAB IF BETADT = .TRUE. */
+
+ if (itcom2_1.betadt) {
+ betnew = pbeta_(n, ia, ja, a, d, wk, ctwd) / itcom3_1.bdelnm;
+ itcom3_1.betab = max(max(itcom3_1.betab,.25),betnew);
+ }
+
+ /* ... (4) COMPUTE NEW CME, OMEGA, AND SPECR. */
+
+ if (! itcom2_1.caseii) {
+ dnrm = pvtbv_(n, ia, ja, a, d);
+ goto L30;
+ }
+ vfill_(n, wk, &c_b21);
+ pjac_(n, ia, ja, a, d, wk);
+ dnrm = itpackddot_(n, wk, &c__1, wk, &c__1);
+L30:
+ omeg_(&dnrm, &c__3);
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L40:
+ iterm_(n, a, u, wk, &c__5);
+
+ return 0;
+} /* itsrsi_ */
+
+/* Subroutine */
+int itrscg_(integer *n, integer *nb, integer *ia, integer *ja, doublereal *a, doublereal *ub,
+ doublereal *ub1, doublereal *db, doublereal *db1, doublereal *wb, doublereal *tri)
+{
+ static doublereal c1, c2, c3, c4;
+ static logical q1;
+ static integer nr;
+ static doublereal con;
+ static doublereal dnrm;
+ static doublereal gamold;
+ static doublereal rhoold;
+
+/* THIS SUBROUTINE, ITRSCG, PERFORMS ONE ITERATION OF THE */
+/* REDUCED SYSTEM CONJUGATE GRADIENT ALGORITHM. IT IS */
+/* CALLED BY RSCG. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* NB INPUT INTEGER. CONTAINS THE NUMBER OF BLACK POINTS */
+/* IN THE RED-BLACK MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* UB INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE */
+/* SOLUTION ON THE BLACK POINTS AFTER IN ITERATIONS. */
+/* UB1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, UB1 CONTAINS THE */
+/* SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT, */
+/* IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION */
+/* VECTOR. THIS IS ONLY FOR THE BLACK POINTS. */
+/* DB INPUT D.P. ARRAY. DB CONTAINS THE VALUE OF THE */
+/* CURRENT PSEUDO-RESIDUAL ON THE BLACK POINTS. */
+/* DB1 INPUT/OUTPUT D.P. ARRAY. DB1 CONTAINS THE PSEUDO- */
+/* RESIDUAL ON THE BLACK POINTS FOR THE IN-1 ITERATION */
+/* ON INPUT. ON OUTPUT, IT IS FOR THE IN+1 ITERATION. */
+/* WB D.P. ARRAY. WB IS USED FOR COMPUTATIONS INVOLVING */
+/* BLACK VECTORS. */
+/* TRI D.P. ARRAY. STORES THE TRIDIAGONAL MATRIX ASSOCIATED */
+/* WITH CONJUGATE GRADIENT ACCELERATION. */
+
+ /* ... COMPUTE NEW ESTIMATE FOR CME IF ADAPT = .TRUE. */
+
+ nr = *n - *nb;
+ if (itcom2_1.adapt)
+ chgcon_(tri, &gamold, &rhoold, &c__2);
+
+ /* ... TEST FOR STOPPING */
+
+ itcom3_1.delnnm = itpackddot_(nb, db, &c__1, db, &c__1);
+ dnrm = itcom3_1.delnnm;
+ con = itcom3_1.cme;
+ pstop_(nb, &ub[nr], &dnrm, &con, &c__2, &q1);
+ if (itcom2_1.halt)
+ goto L30;
+
+ /* ... COMPUTE ACCELERATION PARAMETERS */
+
+ vfill_(&nr, ub1, &c_b21);
+ prsred_(nb, &nr, ia, ja, a, db, ub1);
+ vfill_(nb, wb, &c_b21);
+ prsblk_(nb, &nr, ia, ja, a, ub1, wb);
+ dnrm = itpackddot_(nb, db, &c__1, wb, &c__1);
+ if (itcom1_1.isym != 0)
+ rhoold = itpackddot_(nb, wb, &c__1, db1, &c__1);
+
+ parcon_(&dnrm, &c1, &c2, &c3, &c4, &gamold, &rhoold, &c__2);
+
+ /* ... COMPUTE UB(IN+1) AND DB(IN+1) */
+
+ sum3_(nb, &c1, db, &c2, &ub[nr], &c3, &ub1[nr]);
+ sum3_(nb, &c1, wb, &c4, db, &c3, db1);
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L30:
+ iterm_(nb, &a[nr], &ub[nr], wb, &c__6);
+
+ return 0;
+} /* itrscg_ */
+
+/* Subroutine */
+int itrssi_(integer *n, integer *nb, integer *ia, integer *ja, doublereal *a,
+ doublereal *rhs, doublereal *ub, doublereal *ub1, doublereal *db)
+{
+ static doublereal c1, c2, c3;
+ static logical q1;
+ static integer nr;
+ static doublereal dnrm;
+ static doublereal cnst;
+
+/* THIS SUBROUTINE, ITRSSI, PERFORMS ONE ITERATION OF THE */
+/* REDUCED SYSTEM SEMI-ITERATION ALGORITHM. IT IS */
+/* CALLED BY RSSI. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* N INPUT INTEGER. DIMENSION OF THE MATRIX. */
+/* NB INPUT INTEGER. CONTAINS THE NUMBER OF BLACK POINTS */
+/* IN THE RED-BLACK MATRIX. */
+/* IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF */
+/* THE SPARSE MATRIX REPRESENTATION. */
+/* A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE */
+/* MATRIX REPRESENTATION. */
+/* RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE */
+/* OF THE MATRIX PROBLEM. */
+/* UB INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE */
+/* SOLUTION ON THE BLACK POINTS AFTER IN ITERATIONS. */
+/* UB1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, UB1 CONTAINS THE */
+/* SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT, */
+/* IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION */
+/* VECTOR. THIS IS ONLY FOR THE BLACK POINTS. */
+/* DB INPUT D.P. ARRAY. DB CONTAINS THE VALUE OF THE */
+/* CURRENT PSEUDO-RESIDUAL ON THE BLACK POINTS. */
+
+ /* ... COMPUTE UR(IN) INTO UB */
+
+ nr = *n - *nb;
+ itpackdcopy_(&nr, rhs, &c__1, ub, &c__1);
+ prsred_(nb, &nr, ia, ja, a, &ub[nr], ub);
+
+ /* ... COMPUTE PSEUDO-RESIDUAL, DB(IN) */
+
+ itpackdcopy_(nb, &rhs[nr], &c__1, db, &c__1);
+ prsblk_(nb, &nr, ia, ja, a, ub, db);
+ vevmw_(nb, db, &ub[nr]);
+
+ /* ... TEST FOR STOPPING */
+
+ itcom3_1.delnnm = itpackddot_(nb, db, &c__1, db, &c__1);
+ dnrm = itcom3_1.delnnm;
+ cnst = itcom3_1.cme;
+ pstop_(nb, &ub[nr], &dnrm, &cnst, &c__2, &q1);
+ if (itcom2_1.halt)
+ goto L20;
+
+ if (! itcom2_1.adapt)
+ goto L10;
+
+ /* ... TEST TO CHANGE PARAMETERS */
+
+ if (! tstchg_(&c__2))
+ goto L10;
+
+ /* ... CHANGE PARAMETERS */
+
+ vfill_(&nr, ub1, &c_b21);
+ prsred_(nb, &nr, ia, ja, a, db, ub1);
+ dnrm = itpackddot_(&nr, ub1, &c__1, ub1, &c__1);
+ chgsi_(&dnrm, &c__2);
+ if (itcom2_1.adapt) { /* ... COMPUTE UB(N+1) AFTER CHANGING PARAMETERS */
+ itpackdcopy_(nb, &ub[nr], &c__1, &ub1[nr], &c__1);
+ itpackdaxpy_(nb, &itcom3_1.gamma, db, &c__1, &ub1[nr], &c__1);
+ goto L20;
+ }
+ /* ... COMPUTE UB(N+1) WITHOUT CHANGE OF PARAMETERS */
+L10:
+ parsi_(&c1, &c2, &c3, &c__2);
+ sum3_(nb, &c1, db, &c2, &ub[nr], &c3, &ub1[nr]);
+
+ /* ... OUTPUT INTERMEDIATE INFORMATION */
+
+L20:
+ iterm_(nb, &a[nr], &ub[nr], db, &c__7);
+
+ return 0;
+} /* itrssi_ */
+
+integer bisrch_(integer *n, integer *k, integer *l)
+{
+ /* Local variables */
+ static integer jmid, jleft, jright;
+
+/* ... BISRCH IS AN INTEGER FUNCTION WHICH USES A BISECTION SEARCH */
+/* TO FIND THE ENTRY J IN THE ARRAY K SUCH THAT THE VALUE L IS */
+/* GREATER THAN OR EQUAL TO K(J) AND STRICTLY LESS THAN K(J+1). */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTOR K */
+/* K INTEGER VECTOR */
+/* L INTEGER CONSTANT SUCH THAT K(J) .GE. L .LT. K(J+1) */
+/* WITH J RETURNED AS VALUE OF INTEGER FUNCTION BISRCH */
+
+ if (*n == 2)
+ return 1;
+
+ jleft = 1;
+ jright = *n;
+ jmid = (*n + 1) / 2;
+
+L10:
+ if (*l >= k[jmid-1]) /* ...... L .GE. K(LEFT) AND L .LT. K(JMID) */
+ jleft = jmid;
+ else /* ...... L .GE. K(JMID) AND L .LT. K(JRIGHT) */
+ jright = jmid;
+
+ /* ...... TEST FOR CONVERGENCE */
+
+ if (jright - jleft == 1) /* ...... BISECTION SEARCH FINISHED */
+ return jleft;
+
+ jmid = jleft + (jright - jleft + 1) / 2;
+ goto L10;
+} /* bisrch_ */
+
+doublereal cheby_(doublereal *qa, doublereal *qt, doublereal *rrr, integer *
+ ip, doublereal *cme, doublereal *sme)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal x, y, z;
+
+/* COMPUTES THE SOLUTION TO THE CHEBYSHEV EQUATION */
+
+/* ... PARAMETER LIST: */
+
+/* QA RATIO OF PSEUDO-RESIDUALS */
+/* QT VIRTUAL SPECTRAL RADIUS */
+/* RRR ADAPTIVE PARAMETER */
+/* IP NUMBER OF ITERATIONS SINCE LAST CHANGE OF */
+/* PARAMETERS */
+/* CME, ESTIMATES FOR THE LARGEST AND SMALLEST EIGEN- */
+/* SME VALUES OF THE ITERATION MATRIX */
+
+ z = (*qa + sqrt(abs(*qa * *qa - *qt * *qt))) * .5 * (pow_di(rrr, ip) + 1.);
+ d__1 = 1. / (doublereal) ((real) (*ip));
+ x = pow_dd(&z, &d__1);
+ y = (x + *rrr / x) / (*rrr + 1.);
+
+ return (*cme + *sme + y * (2. - *cme - *sme)) * .5;
+} /* cheby_ */
+
+/* Subroutine */
+int chgcon_(doublereal *tri, doublereal *gamold, doublereal *rhoold, integer *ibmth)
+{
+ /* Local variables */
+ static integer ip, ib3;
+ static doublereal end;
+ static integer ier;
+ static doublereal cmold, start;
+
+/* COMPUTES THE NEW ESTIMATE FOR THE LARGEST EIGENVALUE FOR */
+/* CONJUGATE GRADIENT ACCELERATION. */
+
+/* ... PARAMETER LIST: */
+
+/* TRI TRIDIAGONAL MATRIX ASSOCIATED WITH THE EIGENVALUES */
+/* OF THE CONJUGATE GRADIENT POLYNOMIAL */
+/* GAMOLD */
+/* AND */
+/* RHOOLD PREVIOUS VALUES OF ACCELERATION PARAMETERS */
+/* IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY CG */
+/* IBMTH = 1, JACOBI */
+/* = 2, REDUCED SYSTEM */
+/* = 3, SSOR */
+
+ switch (*ibmth) {
+ case 1: goto L10;
+ case 2: goto L20;
+ case 3: goto L30;
+ }
+
+ /* ... JACOBI CONJUGATE GRADIENT */
+
+L10:
+ start = itcom3_1.cme;
+ ip = itcom1_1.in;
+ goto L40;
+
+ /* ... REDUCED SYSTEM CG */
+
+L20:
+ start = itcom3_1.cme * itcom3_1.cme;
+ ip = itcom1_1.in;
+ goto L40;
+
+ /* ... SSOR CG */
+
+L30:
+ if (itcom2_1.adapt)
+ start = itcom3_1.spr;
+
+ if (! itcom2_1.adapt)
+ start = itcom3_1.specr;
+
+ ip = itcom1_1.in - itcom1_1.is;
+
+ /* ... DEFINE THE MATRIX */
+
+L40:
+ if (ip >= 2)
+ goto L60;
+
+ if (ip != 1) { /* ... IP = 0 */
+ end = 0.;
+ cmold = 0.;
+ }
+ else { /* ... IP = 1 */
+ end = 1. - 1. / itcom3_1.gamma;
+ tri[0] = end;
+ tri[1] = 0.;
+ }
+ goto L110;
+
+ /* ... IP > 1 */
+
+L60:
+ if (ip > 2 && abs(start - cmold) <= itcom3_1.zeta * start)
+ goto L120;
+ cmold = start;
+
+ /* ... COMPUTE THE LARGEST EIGENVALUE */
+
+ tri[(ip << 1) - 2] = 1. - 1. / itcom3_1.gamma;
+ tri[(ip << 1) - 1] = (itcom3_1.rho - 1.) / (itcom3_1.rho * *rhoold * itcom3_1.gamma * *gamold);
+ if (itcom1_1.isym == 0)
+ end = eigvss_(&ip, tri, &start, &itcom3_1.zeta, &itcom1_1.itmax, &ier);
+
+ else {
+ ib3 = ip + ip / 2 + 1;
+ end = eigvns_(&ip, tri, &tri[ip << 1], &tri[ib3 << 1], &ier);
+ }
+
+ if (ier != 0)
+ goto L130;
+
+ /* ... SET SPECTRAL RADIUS FOR THE VARIOUS METHODS */
+
+L110:
+ if (*ibmth == 1)
+ itcom3_1.cme = end;
+
+ if (*ibmth == 2)
+ itcom3_1.cme = sqrt((abs(end)));
+
+ if (*ibmth == 3 && itcom2_1.adapt)
+ itcom3_1.spr = end;
+
+ if (*ibmth == 3 && ! itcom2_1.adapt)
+ itcom3_1.specr = end;
+
+ return 0;
+
+ /* ... RELATIVE CHANGE IN CME IS LESS THAN ZETA. THEREFORE STOP */
+ /* CHANGING. */
+
+L120:
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+ return 0;
+
+ /* ... ESTIMATE FOR CME > 1.D0. THEREFORE NEED TO STOP ADAPTIVE */
+ /* PROCEDURE AND KEEP OLD VALUE OF CME. */
+
+L130:
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+
+ return 0;
+} /* chgcon_ */
+
+/* Subroutine */
+int chgsi_(doublereal *dtnrm, integer *ibmth)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal zm1, zm2;
+ static doublereal cmold;
+
+/* ... COMPUTES NEW CHEBYSHEV ACCELERATION PARAMETERS ADAPTIVELY. */
+
+/* ... PARAMETER LIST: */
+
+/* DTNRM NUMERATOR OF RAYLEIGH QUOTIENT */
+/* IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI */
+/* IBMTH = 1, JACOBI */
+/* = 2, REDUCED SYSTEM */
+/* = 3, SYMMETRIC SOR */
+
+ switch (*ibmth) {
+ case 1: goto L10;
+ case 2: goto L30;
+ case 3: goto L50;
+ }
+
+ /* --------------------- */
+ /* ... JACOBI SEMI-ITERATIVE */
+ /* --------------------- */
+
+ /* ... CHEBYSHEV EQUATION */
+
+L10:
+ if (itcom1_1.in == 0)
+ zm1 = itcom3_1.cme;
+
+ if (itcom1_1.in != 0) {
+ i__1 = itcom1_1.in - itcom1_1.is;
+ zm1 = cheby_(&itcom3_1.qa, &itcom3_1.qt, &itcom3_1.rrr, &i__1, &itcom3_1.cme, &itcom3_1.sme);
+ }
+
+ /* ... RAYLEIGH QUOTIENT */
+
+ zm2 = *dtnrm / itcom3_1.delnnm;
+
+ /* ... COMPUTATION OF ITERATIVE PARAMETERS */
+
+ cmold = itcom3_1.cme;
+ itcom3_1.cme = max(max(zm1,zm2),cmold);
+ if (itcom3_1.cme >= 1.)
+ goto L20;
+
+ if (itcom2_1.caseii)
+ itcom3_1.sme = -itcom3_1.cme;
+
+ itcom3_1.sige = (itcom3_1.cme - itcom3_1.sme) / (2. - itcom3_1.cme - itcom3_1.sme);
+ itcom3_1.gamma = 2. / (2. - itcom3_1.cme - itcom3_1.sme);
+ itcom3_1.rrr = (1. - sqrt(abs(1. - itcom3_1.sige * itcom3_1.sige))) /
+ (sqrt(abs(1. - itcom3_1.sige * itcom3_1.sige)) + 1.);
+ itcom1_1.is = itcom1_1.in;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ itcom3_1.rho = 1.;
+ return 0;
+
+ /* ... ADAPTIVE PROCEDURE FAILED FOR JACOBI SI */
+
+L20:
+ itcom3_1.cme = cmold;
+ itcom2_1.adapt = FALSE_;
+ return 0;
+
+ /* ----------------------------- */
+ /* ... REDUCED SYSTEM SEMI-ITERATIVE */
+ /* ----------------------------- */
+
+ /* ... CHEBYSHEV EQUATION */
+
+L30:
+ if (itcom1_1.in == 0)
+ zm1 = itcom3_1.cme;
+
+ if (itcom1_1.in != 0) {
+ i__1 = (itcom1_1.in - itcom1_1.is) << 1;
+ zm1 = cheby_(&itcom3_1.qa, &itcom3_1.qt, &itcom3_1.rrr, &i__1, &c_b21, &c_b21);
+ }
+
+ /* ... RAYLEIGH QUOTIENT */
+
+ zm2 = sqrt(abs(*dtnrm / itcom3_1.delnnm));
+
+ /* ... COMPUTATION OF NEW ITERATIVE PARAMETERS */
+
+ cmold = itcom3_1.cme;
+ itcom3_1.cme = max(max(zm1,zm2),cmold);
+ if (itcom3_1.cme >= 1.) {
+ /* ... ADAPTIVE PROCEDURE FAILED FOR REDUCED SYSTEM SI */
+ itcom3_1.cme = cmold;
+ itcom2_1.adapt = FALSE_;
+ return 0;
+ }
+ itcom3_1.sige = itcom3_1.cme * itcom3_1.cme / (2. - itcom3_1.cme * itcom3_1.cme);
+ itcom3_1.gamma = 2. / (2. - itcom3_1.cme * itcom3_1.cme);
+ itcom3_1.rrr = (1. - sqrt(abs(1. - itcom3_1.cme * itcom3_1.cme))) /
+ (sqrt(abs(1. - itcom3_1.cme * itcom3_1.cme)) + 1.);
+ itcom1_1.is = itcom1_1.in;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ itcom3_1.rho = 1.;
+ return 0;
+
+ /* ----------------------------- */
+ /* ... SYMMETRIC SOR SEMI-ITERATIVE */
+ /* ---------------------------- */
+
+L50:
+ if (itcom3_1.specr == 0.)
+ itcom3_1.specr = .171572875;
+
+ if (itcom1_1.in != 0) {
+ i__1 = itcom1_1.in - itcom1_1.is;
+ zm1 = cheby_(&itcom3_1.qa, &itcom3_1.qt, &itcom3_1.rrr, &i__1, &itcom3_1.specr, &c_b21);
+ }
+ else {
+ zm1 = itcom3_1.specr;
+ itcom3_1.spr = itcom3_1.specr;
+ }
+
+ /* ... RAYLEIGH QUOTIENT */
+
+ zm2 = *dtnrm / itcom3_1.delnnm;
+
+ /* ... COMPUTATION OF NEW ESTIMATE FOR SPECTRAL RADIUS */
+
+ /* ... PARTIALLY ADAPTIVE SSOR SI */
+
+ if (! itcom2_1.adapt) {
+ itcom3_1.specr = max(max(zm1,zm2),itcom3_1.specr);
+ itcom1_1.is = itcom1_1.in + 1;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ return 0;
+ }
+
+ /* ... FULLY ADAPTIVE SSOR SI */
+
+ itcom3_1.spr = max(max(zm1,zm2),itcom3_1.spr);
+ return 0;
+} /* chgsi_ */
+
+logical chgsme_(doublereal *oldnrm, integer *icnt)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal q, z;
+ static integer ip;
+ static doublereal rn, wp, sm1, sm2;
+
+/* ... THIS FUNCTION TESTS FOR JACOBI SI WHETHER SME SHOULD BE CHANGED */
+/* ... WHEN CASEII = .FALSE.. IF THE TEST IS POSITIVE THE NEW VALUE */
+/* ... OF SME IS COMPUTED. */
+
+/* ... PARAMETER LIST: */
+
+/* OLDNRM SQUARE OF THE NORM OF THE PSEUDO-RESIDUAL */
+/* AT THE LAST ITERATION */
+/* ICNT NUMBER OF ITERATIONS SINCE LAST CHANGE OF */
+/* PARAMETERS */
+
+ rn = sqrt(itcom3_1.delnnm / *oldnrm);
+ if (! (itcom3_1.qa > 1. && rn > 1.))
+ return FALSE_;
+
+ if (itcom1_1.in <= itcom1_1.is + 2)
+ return FALSE_;
+
+ ++(*icnt);
+ if (*icnt < 3)
+ return FALSE_;
+
+ /* ... CHANGE SME IN J-SI ADAPTIVE PROCEDURE */
+
+ sm1 = 0.;
+ sm2 = 0.;
+ if (itcom3_1.sme >= itcom3_1.cme)
+ goto L10;
+
+ /* ... COMPUTE SM1 */
+
+ ip = itcom1_1.in - itcom1_1.is;
+ q = itcom3_1.qa * (pow_di(&itcom3_1.rrr, &ip) + 1.) / (sqrt(pow_di(&itcom3_1.rrr, &ip)) * 2.);
+ d__1 = q + sqrt(q * q - 1.);
+ d__2 = 1. / (doublereal) ((real) ip);
+ z = pow_dd(&d__1, &d__2);
+ wp = (z * z + 1.) / (z * 2.);
+ sm1 = (itcom3_1.cme + itcom3_1.sme - wp * (itcom3_1.cme - itcom3_1.sme)) * .5;
+
+ /* ... COMPUTE SM2 */
+
+ i__1 = ip - 1;
+ q = rn * (pow_di(&itcom3_1.rrr, &ip) + 1.) / ((pow_di(&itcom3_1.rrr, &i__1) + 1.) * sqrt(itcom3_1.rrr));
+ wp = (q * q + 1.) / (q * 2.);
+ sm2 = (itcom3_1.cme + itcom3_1.sme - wp * (itcom3_1.cme - itcom3_1.sme)) *
+ .5;
+
+L10:
+ itcom3_1.sme = min(min(min(sm1 * 1.25,sm2 * 1.25),itcom3_1.sme),-1.);
+ itcom3_1.sige = (itcom3_1.cme - itcom3_1.sme) / (2. - itcom3_1.cme - itcom3_1.sme);
+ itcom3_1.gamma = 2. / (2. - itcom3_1.cme - itcom3_1.sme);
+ itcom3_1.rrr = (1. - sqrt(1. - itcom3_1.sige * itcom3_1.sige)) /
+ (sqrt(1. - itcom3_1.sige * itcom3_1.sige) + 1.);
+ itcom1_1.is = itcom1_1.in;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ itcom3_1.rho = 1.;
+
+ return TRUE_;
+} /* chgsme_ */
+
+/* Subroutine */
+int itpackdaxpy_(integer *n, doublereal *da, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
+{
+ /* Local variables */
+ static integer i, m, ix, iy, ns;
+
+ /* OVERWRITE DOUBLE PRECISION DY WITH DOUBLE PRECISION DA*DX + DY. */
+
+ if (*n <= 0 || *da == 0.)
+ return 0;
+
+ if (*incx == *incy) {
+ if (*incx < 1)
+ goto L10;
+ else if (*incx == 1)
+ goto L30;
+ else
+ goto L70;
+ }
+L10:
+
+ /* CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS. */
+
+ ix = 0;
+ iy = 0;
+ if (*incx < 0)
+ ix = (-(*n) + 1) * *incx;
+
+ if (*incy < 0)
+ iy = (-(*n) + 1) * *incy;
+
+ for (i = 0; i < *n; ++i) {
+ dy[iy] += *da * dx[ix];
+ ix += *incx;
+ iy += *incy;
+ }
+ return 0;
+
+ /* CODE FOR BOTH INCREMENTS EQUAL TO 1 */
+
+ /* CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4. */
+
+L30:
+ m = *n - (*n / 4 << 2);
+ for (i = 0; i < m; ++i)
+ dy[i] += *da * dx[i];
+
+ for (i = m; i < *n; i += 4) {
+ dy[i] += *da * dx[i];
+ dy[i + 1] += *da * dx[i + 1];
+ dy[i + 2] += *da * dx[i + 2];
+ dy[i + 3] += *da * dx[i + 3];
+ }
+ return 0;
+
+ /* CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. */
+
+L70:
+ ns = *n * *incx;
+ for (i = 0; *incx < 0 ? i >= ns-1 : i < ns; i += *incx)
+ dy[i] = *da * dx[i] + dy[i];
+
+ return 0;
+} /* itpackdaxpy_ */
+
+/* Subroutine */
+int itpackdcopy_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
+{
+ /* Local variables */
+ static integer i, m, ix, iy, ns;
+
+ /* COPY DOUBLE PRECISION DX TO DOUBLE PRECISION DY. */
+
+ if (*n <= 0)
+ return 0;
+
+ if (*incx == *incy) {
+ if (*incx < 1)
+ goto L10;
+ else if (*incx == 1)
+ goto L30;
+ else
+ goto L70;
+ }
+L10:
+
+ /* CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. */
+
+ ix = 0;
+ iy = 0;
+ if (*incx < 0)
+ ix = (-(*n) + 1) * *incx;
+
+ if (*incy < 0)
+ iy = (-(*n) + 1) * *incy;
+
+ for (i = 0; i < *n; ++i) {
+ dy[iy] = dx[ix];
+ ix += *incx;
+ iy += *incy;
+ }
+ return 0;
+
+ /* CODE FOR BOTH INCREMENTS EQUAL TO 1 */
+
+ /* CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7. */
+
+L30:
+ m = *n - *n / 7 * 7;
+ for (i = 0; i < m; ++i)
+ dy[i] = dx[i];
+
+ for (i = m; i < *n; i += 7) {
+ dy[i] = dx[i];
+ dy[i + 1] = dx[i + 1];
+ dy[i + 2] = dx[i + 2];
+ dy[i + 3] = dx[i + 3];
+ dy[i + 4] = dx[i + 4];
+ dy[i + 5] = dx[i + 5];
+ dy[i + 6] = dx[i + 6];
+ }
+ return 0;
+
+ /* CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS. */
+
+L70:
+ ns = *n * *incx;
+ for (i = 0; *incx < 0 ? i >= ns-1 : i < ns; i += *incx)
+ dy[i] = dx[i];
+
+ return 0;
+} /* itpackdcopy_ */
+
+doublereal itpackddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ doublereal ret_val;
+
+ /* Local variables */
+ static integer i, m, ix, iy, ns;
+
+ /* RETURNS THE DOT PRODUCT OF DOUBLE PRECISION DX AND DY. */
+
+ ret_val = 0.;
+ if (*n <= 0)
+ return 0.;
+
+ if (*incx == *incy) {
+ if (*incx < 1)
+ goto L10;
+ else if (*incx == 1)
+ goto L30;
+ else
+ goto L70;
+ }
+L10:
+
+ /* CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS. */
+
+ ix = 0;
+ iy = 0;
+ if (*incx < 0)
+ ix = (-(*n) + 1) * *incx;
+
+ if (*incy < 0)
+ iy = (-(*n) + 1) * *incy;
+
+ for (i = 0; i < *n; ++i) {
+ ret_val += dx[ix] * dy[iy];
+ ix += *incx;
+ iy += *incy;
+ }
+ return ret_val;
+
+ /* CODE FOR BOTH INCREMENTS EQUAL TO 1. */
+
+ /* CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5. */
+
+L30:
+ m = *n - *n / 5 * 5;
+ for (i = 0; i < m; ++i)
+ ret_val += dx[i] * dy[i];
+
+ for (i = m; i < *n; i += 5)
+ ret_val += dx[i]*dy[i] + dx[i+1]*dy[i+1] + dx[i+2]*dy[i+2] + dx[i+3]*dy[i+3] + dx[i+4]*dy[i+4];
+ return ret_val;
+
+ /* CODE FOR POSITIVE EQUAL INCREMENTS .NE.1. */
+
+L70:
+ ns = *n * *incx;
+ for (i = 0; *incx < 0 ? i >= ns-1 : i < ns; i += *incx)
+ ret_val += dx[i] * dy[i];
+
+ return ret_val;
+} /* itpackddot_ */
+
+doublereal determ_(integer *n, doublereal *tri, doublereal *xlmda)
+{
+ /* Local variables */
+ static integer l;
+ static doublereal d1, d2, d3;
+ static integer icnt;
+
+/* THIS SUBROUTINE COMPUTES THE DETERMINANT OF A SYMMETRIC */
+/* TRIDIAGONAL MATRIX GIVEN BY TRI. DET(TRI - XLMDA*I) = 0 */
+
+/* ... PARAMETER LIST */
+
+/* N ORDER OF TRIDIAGONAL SYSTEM */
+/* TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N */
+/* XLMDA ARGUMENT FOR CHARACTERISTIC EQUATION */
+
+ d2 = tri[(*n << 1) - 2] - *xlmda;
+ d1 = d2 * (tri[(*n << 1) - 4] - *xlmda) - tri[(*n << 1) - 1];
+ if (*n == 2)
+ return d1;
+
+ for (icnt = 2; icnt < *n; ++icnt) {
+ l = *n - icnt + 1;
+ d3 = d2;
+ d2 = d1;
+ d1 = (tri[((l - 1) << 1) - 2] - *xlmda) * d2 - d3 * tri[(l << 1) - 1];
+ }
+
+ return d1;
+} /* determ_ */
+
+/* Subroutine */
+int dfault_(integer *iparm, doublereal *rparm)
+{
+/* ... THIS SUBROUTINE SETS THE DEFAULT VALUES OF IPARM AND RPARM. */
+
+/* ... PARAMETER LIST: */
+
+/* IPARM */
+/* AND */
+/* RPARM ARRAYS SPECIFYING OPTIONS AND TOLERANCES */
+
+/* DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE */
+
+/* DRELPR - COMPUTER PRECISION (APPROX.) */
+/* IF INSTALLER OF PACKAGE DOES NOT KNOW DRELPR VALUE, */
+/* AN APPROXIMATE VALUE CAN BE DETERMINED FROM A SIMPLE */
+/* FORTRAN PROGRAM SUCH AS */
+
+/* DOUBLE PRECISION DRELPR, TEMP */
+/* DRELPR = 1.0D0 */
+/* 2 DRELPR = 0.5D0*DRELPR */
+/* TEMP = DRELPR + 1.0D0 */
+/* IF(TEMP .GT. 1.0D0) GO TO 2 */
+/* WRITE(6,3) DRELPR */
+/* 3 FORMAT(5X,D15.8) */
+/* STOP */
+/* END */
+
+/* SOME VALUES ARE: */
+
+/* DRELPR = 1.26D-29 FOR CDC CYBER 170/750 (APPROX.) 2**-96 */
+/* = 2.22D-16 FOR DEC 10 (APPROX.) 2**-52 */
+/* = 7.11D-15 FOR VAX 11/780 (APPROX.) 2**-47 */
+/* = 1.14D-13 FOR IBM 370/158 (APPROX.) 2**-43 */
+
+/* *** SHOULD BE CHANGED FOR OTHER MACHINES *** */
+
+/* TO FACILITATE CONVERGENCE, RPARM(1) SHOULD BE SET TO */
+/* 500.*DRELPR OR LARGER */
+
+ itcom3_1.drelpr = 7.11e-15;
+
+ iparm[0] = 100;
+ iparm[1] = 0;
+ iparm[2] = 0;
+ iparm[3] = 6;
+ iparm[4] = 0;
+ iparm[5] = 1;
+ iparm[6] = 1;
+ iparm[7] = 0;
+ iparm[8] = -1;
+ iparm[9] = 0;
+ iparm[10] = 0;
+ iparm[11] = 0;
+
+ rparm[0] = 5e-6;
+ rparm[1] = 0.;
+ rparm[2] = 0.;
+ rparm[3] = .75;
+ rparm[4] = 1.;
+ rparm[5] = 0.;
+ rparm[6] = .25;
+ rparm[7] = itcom3_1.drelpr * 100.;
+ rparm[8] = 0.;
+ rparm[9] = 0.;
+ rparm[10] = 0.;
+ rparm[11] = 0.;
+
+ return 0;
+} /* dfault_ */
+
+/* Subroutine */
+int echall_(integer *nn, integer *ia, integer *ja, doublereal *a, doublereal *rhs,
+ integer *iparm, doublereal *rparm, integer *icall)
+{
+ (void)nn; (void)ia; (void)ja; (void)a; (void)rhs;
+/* ... THIS ROUTINE INITIALIZES THE ITPACK COMMON BLOCKS FROM THE */
+/* ... INFORMATION CONTAINED IN IPARM AND RPARM. ECHALL ALSO PRINTS THE */
+/* ... VALUES OF ALL THE PARAMETERS IN IPARM AND RPARM. */
+
+/* ... PARAMETER LIST: */
+
+/* IPARM */
+/* AND */
+/* RPARM ARRAYS OF PARAMETERS SPECIFYING OPTIONS AND */
+/* TOLERANCES */
+/* ICALL INDICATOR OF WHICH PARAMETERS ARE BEING PRINTED */
+/* ICALL = 1, INITIAL PARAMETERS */
+/* ICALL = 2, FINAL PARAMETERS */
+
+ if (*icall != 1)
+ return 0;
+
+ /* ... INITIALIZE ITPACK COMMON */
+
+ itcom3_1.zeta = rparm[0];
+ itcom3_1.cme = rparm[1];
+ itcom3_1.sme = rparm[2];
+ itcom3_1.ff = rparm[3];
+ itcom3_1.omega = rparm[4];
+ itcom3_1.specr = rparm[5];
+ itcom3_1.betab = rparm[6];
+ itcom1_1.itmax = iparm[0];
+ itcom1_1.level = iparm[1];
+ itcom1_1.isym = iparm[4];
+
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+ itcom2_1.betadt = FALSE_;
+ if (iparm[5] == 1 || iparm[5] == 3)
+ itcom2_1.adapt = TRUE_;
+
+ if (iparm[5] == 1)
+ itcom2_1.betadt = TRUE_;
+
+ if (iparm[5] == 2)
+ itcom2_1.partad = TRUE_;
+
+ itcom2_1.caseii = FALSE_;
+ if (iparm[6] == 2)
+ itcom2_1.caseii = TRUE_;
+
+ if (itcom2_1.caseii)
+ itcom3_1.sme = -itcom3_1.cme;
+
+ if (! itcom2_1.caseii && itcom3_1.sme == 0.)
+ itcom3_1.sme = -1.;
+
+ itcom3_1.spr = itcom3_1.sme;
+
+ /* ... SET REST OF COMMON VARIABLES TO ZERO */
+
+ itcom1_1.in = 0;
+ itcom1_1.is = 0;
+ itcom2_1.halt = FALSE_;
+ itcom3_1.bdelnm = 0.;
+ itcom3_1.delnnm = 0.;
+ itcom3_1.delsnm = 0.;
+ itcom3_1.gamma = 0.;
+ itcom3_1.qa = 0.;
+ itcom3_1.qt = 0.;
+ itcom3_1.rho = 0.;
+ itcom3_1.rrr = 0.;
+ itcom3_1.sige = 0.;
+ itcom3_1.stptst = 0.;
+ itcom3_1.udnm = 0.;
+
+ if (itcom1_1.level <= 4)
+ return 0;
+
+ /* THIS SECTION OF ECHALL CAUSES PRINTING OF THE LINEAR SYSTEM AND */
+ /* THE ITERATIVE PARAMETERS */
+
+ return 0;
+} /* echall_ */
+
+/* Subroutine */
+int echout_(integer *iparm, doublereal *rparm, integer *imthd)
+{
+/* THIS ROUTINE INITIALIZES THE ITPACK COMMON BLOCKS FROM THE */
+/* INFORMATION CONTAINED IN IPARM AND RPARM. */
+
+/* ... PARAMETER LIST: */
+
+/* IPARM */
+/* AND */
+/* RPARM ARRAYS OF PARAMETERS SPECIFYING OPTIONS AND */
+/* TOLERANCES */
+/* IMTHD INDICATOR OF METHOD */
+/* IMTHD = 1, JCG */
+/* IMTHD = 2, JSI */
+/* IMTHD = 3, SOR */
+/* IMTHD = 4, SSORCG */
+/* IMTHD = 5, SSORSI */
+/* IMTHD = 6, RSCG */
+/* IMTHD = 7, RSSI */
+
+ itcom3_1.zeta = rparm[0];
+ itcom3_1.cme = rparm[1];
+ itcom3_1.sme = rparm[2];
+ itcom3_1.ff = rparm[3];
+ itcom3_1.omega = rparm[4];
+ itcom3_1.specr = rparm[5];
+ itcom3_1.betab = rparm[6];
+ itcom1_1.itmax = iparm[0];
+ itcom1_1.level = iparm[1];
+ itcom1_1.isym = iparm[4];
+
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+ itcom2_1.betadt = FALSE_;
+ if (iparm[5] == 1 || iparm[5] == 3)
+ itcom2_1.adapt = TRUE_;
+
+ if (iparm[5] == 1)
+ itcom2_1.betadt = TRUE_;
+
+ if (iparm[5] == 2)
+ itcom2_1.partad = TRUE_;
+
+ itcom2_1.caseii = FALSE_;
+ if (iparm[6] == 2)
+ itcom2_1.caseii = TRUE_;
+
+ if (itcom2_1.caseii)
+ itcom3_1.sme = -itcom3_1.cme;
+
+ if (! itcom2_1.caseii && itcom3_1.sme == 0.)
+ itcom3_1.sme = -1.;
+
+ itcom3_1.spr = itcom3_1.sme;
+
+ /* ... SET REST OF COMMON VARIABLES TO ZERO */
+
+ itcom1_1.in = 0;
+ itcom1_1.is = 0;
+ itcom2_1.halt = FALSE_;
+ itcom3_1.bdelnm = 0.;
+ itcom3_1.delnnm = 0.;
+ itcom3_1.delsnm = 0.;
+ itcom3_1.gamma = 0.;
+ itcom3_1.qa = 0.;
+ itcom3_1.qt = 0.;
+ itcom3_1.rho = 0.;
+ itcom3_1.rrr = 0.;
+ itcom3_1.sige = 0.;
+ itcom3_1.stptst = 0.;
+ itcom3_1.udnm = 0.;
+ if (itcom1_1.level <= 2)
+ return 0;
+
+ /* ... THIS SECTION OF ECHOUT ECHOES THE INPUT VALUES FOR THE INITIAL */
+ /* ITERATIVE PARAMETERS */
+
+ switch (*imthd) {
+ case 1: goto L80;
+ case 2: goto L20;
+ case 3: goto L100;
+ case 4: goto L60;
+ case 5: goto L40;
+ case 6: goto L80;
+ case 7: goto L20;
+ }
+
+ /* ... JSI, RSSI */
+
+L20:
+ return 0;
+
+ /* ... SSORSI */
+
+L40:
+ return 0;
+
+ /* ... SSORCG */
+
+L60:
+ return 0;
+
+ /* ... JCG, RSCG */
+
+L80:
+ if (itcom2_1.adapt)
+ return 0;
+
+L100:
+ return 0;
+} /* echout_ */
+
+doublereal eigvns_(integer *n, doublereal *tri, doublereal *d, doublereal *e2, integer *ier)
+{
+ /* Local variables */
+ static integer i;
+
+/* COMPUTES THE LARGEST EIGENVALUE OF A SYMMETRIC TRIDIAGONAL MATRIX */
+/* FOR CONJUGATE GRADIENT ACCELERATION. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF TRIDIAGONAL SYSTEM */
+/* TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N */
+/* D ARRAY FOR EQRT1S(NEGATIVE DIAGONAL ELEMENTS) */
+/* E2 ARRAY FOR EQRT1S (SUPER DIAGONAL ELEMENTS) */
+/* IER ERROR FLAG: ON RETURN, IER=0 INDICATES THAT */
+/* THE LARGEST EIGENVALUE OF TRI WAS FOUND. */
+
+ d[0] = -tri[0];
+ for (i = 1; i < *n; ++i) {
+ d[i] = -tri[i << 1];
+ e2[i] = abs(tri[(i << 1) + 1]);
+ }
+
+ eqrt1s_(d, e2, n, &c__1, &c__0, ier);
+ return -d[0];
+} /* eigvns_ */
+
+doublereal eigvss_(integer *n, doublereal *tri, doublereal *start, doublereal *zeta, integer *itmax, integer *ier)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal a, b, eps;
+ static integer nsig, itmp, maxfn;
+
+/* COMPUTES THE LARGEST EIGENVALUE OF A SYMMETRIC TRIDIAGONAL MATRIX */
+/* FOR CONJUGATE GRADIENT ACCELERATION. */
+/* MODIFIED IMSL ROUTINE ZBRENT USED. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF TRIDIAGONAL SYSTEM */
+/* TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N */
+/* START INITIAL LOWER BOUND OF INTERVAL CONTAINING ROOT */
+/* ZETA STOPPING CRITERIA */
+/* IER ERROR FLAG: ON RETURN, IER=0 INDICATES THAT */
+/* THE LARGEST EIGENVALUE OF TRI WAS FOUND. */
+
+ d__1 = abs(*zeta);
+ itmp = (integer) ((real) (-d_lg10(&d__1)));
+ nsig = max(itmp,4);
+ maxfn = max(*itmax,50);
+
+ /* EPS = DMIN1(ZETA,0.5D-4) */
+
+ eps = 0.;
+ a = *start;
+ b = 1.;
+ zbrent_(n, tri, &eps, &nsig, &a, &b, &maxfn, ier);
+ return b;
+} /* eigvss_ */
+
+/* Subroutine */
+int eqrt1s_(doublereal *d, doublereal *e2, integer *n, integer *m, integer *isw, integer *ierr)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal f;
+ static integer i, j, k;
+ static doublereal p, q, r, s;
+ static integer ii, jj;
+ static doublereal ep, qp;
+ static integer ier;
+ static doublereal err, tot, dlam, delta;
+
+/* MODIFIED IMSL ROUTINE NAME - EQRT1S */
+
+/* ----------------------------------------------------------------------- */
+
+/* COMPUTER - CDC/SINGLE */
+
+/* LATEST REVISION - JUNE 1, 1980 */
+
+/* PURPOSE - SMALLEST OR LARGEST M EIGENVALUES OF A */
+/* SYMMETRIC TRIDIAGONAL MATRIX */
+
+/* USAGE - CALL EQRT1S (D,E2,N,M,ISW,IER) */
+
+/* ARGUMENTS D - INPUT VECTOR OF LENGTH N CONTAINING */
+/* THE DIAGONAL ELEMENTS OF THE MATRIX. THE */
+/* COMPUTED EIGENVALUES REPLACE THE FIRST M */
+/* COMPONENTS OF THE VECTOR D IN NON- */
+/* DECREASING SEQUENCE, WHILE THE REMAINING */
+/* COMPONENTS ARE LOST. */
+/* E2 - INPUT VECTOR OF LENGTH N CONTAINING */
+/* THE SQUARES OF THE OFF-DIAGONAL ELEMENTS */
+/* OF THE MATRIX. INPUT E2 IS DESTROYED. */
+/* N - INPUT SCALAR CONTAINING THE ORDER OF THE */
+/* MATRIX. */
+/* M - INPUT SCALAR CONTAINING THE NUMBER OF */
+/* SMALLEST EIGENVALUES DESIRED (M IS */
+/* LESS THAN OR EQUAL TO N). */
+/* ISW - INPUT SCALAR MEANING AS FOLLOWS - */
+/* ISW=1 MEANS THAT THE MATRIX IS KNOWN TO BE */
+/* POSITIVE DEFINITE. */
+/* ISW=0 MEANS THAT THE MATRIX IS NOT KNOWN */
+/* TO BE POSITIVE DEFINITE. */
+/* IER - ERROR PARAMETER. (OUTPUT) (= IERR) */
+/* WARNING ERROR */
+/* IER = 601 INDICATES THAT SUCCESSIVE */
+/* ITERATES TO THE K-TH EIGENVALUE WERE NOT */
+/* MONOTONE INCREASING. THE VALUE K IS */
+/* STORED IN E2(1). */
+/* TERMINAL ERROR */
+/* IER = 602 INDICATES THAT ISW=1 BUT MATRIX */
+/* IS NOT POSITIVE DEFINITE */
+
+/* PRECISION/HARDWARE - SINGLE AND DOUBLE/H32 */
+/* - SINGLE/H36,H48,H60 */
+
+/* NOTATION - INFORMATION ON SPECIAL NOTATION AND */
+/* CONVENTIONS IS AVAILABLE IN THE MANUAL */
+/* INTRODUCTION OR THROUGH IMSL ROUTINE UHELP */
+
+/* REMARKS AS WRITTEN, THE ROUTINE COMPUTES THE M SMALLEST */
+/* EIGENVALUES. TO COMPUTE THE M LARGEST EIGENVALUES, */
+/* REVERSE THE SIGN OF EACH ELEMENT OF D BEFORE AND */
+/* AFTER CALLING THE ROUTINE. IN THIS CASE, ISW MUST */
+/* EQUAL ZERO. */
+
+/* COPYRIGHT - 1980 BY IMSL, INC. ALL RIGHTS RESERVED. */
+
+/* WARRANTY - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN */
+/* APPLIED TO THIS CODE. NO OTHER WARRANTY, */
+/* EXPRESSED OR IMPLIED, IS APPLICABLE. */
+
+/* ----------------------------------------------------------------------- */
+
+/* SPECIFICATIONS FOR LOCAL VARIABLES */
+
+/* DRELPR = MACHINE PRECISION */
+
+ ier = 0;
+ dlam = 0.;
+ err = 0.;
+ s = 0.;
+
+ /* LOOK FOR SMALL SUB-DIAGONAL ENTRIES */
+ /* DEFINE INITIAL SHIFT FROM LOWER */
+ /* GERSCHGORIN BOUND. */
+
+ tot = d[0];
+ q = 0.;
+ j = 0;
+ for (i = 0; i < *n; ++i) {
+ p = q;
+ if (i == 0 || p <= itcom3_1.drelpr * (abs(d[i]) + abs(d[i-1])))
+ e2[i] = 0.;
+
+ /* COUNT IF E2(I) HAS UNDERFLOWED */
+
+ if (e2[i] == 0.)
+ ++j;
+
+ q = 0.;
+ if (i != *n-1)
+ q = sqrt(abs(e2[i + 1]));
+
+ tot = min(d[i] - p - q,tot);
+ }
+ if (*isw != 1 || tot > 0.) {
+ for (i = 0; i < *n; ++i)
+ d[i] -= tot;
+ }
+ else
+ tot = 0.;
+
+ for (k = 0; k < *m; ++k)
+ {
+ /* NEXT QR TRANSFORMATION */
+
+L70:
+ tot += s;
+ delta = d[*n] - s;
+ i = *n - 1;
+ f = abs(itcom3_1.drelpr * tot);
+ if (dlam < f)
+ dlam = f;
+
+ if (delta > dlam)
+ goto L90;
+
+ if (delta >= -dlam)
+ goto L170;
+
+ ier = 602;
+ goto L210;
+
+ /* REPLACE SMALL SUB-DIAGONAL SQUARES */
+ /* BY ZERO TO REDUCE THE INCIDENCE OF */
+ /* UNDERFLOWS */
+
+L90:
+ if (k != *n-1) {
+ for (j = k+1; j < *n; ++j) {
+ d__1 = itcom3_1.drelpr * (d[j] + d[j - 1]);
+ if (e2[j] <= d__1 * d__1)
+ e2[j] = 0.;
+ }
+ }
+ f = e2[*n-1] / delta;
+ qp = delta + f;
+ p = 1.;
+ for (ii = 0; ii < *n-k-1; ++ii) {
+ i = *n - ii - 2;
+ q = d[i] - s - f;
+ r = q / qp;
+ p = p * r + 1.;
+ ep = f * r;
+ d[i + 1] = qp + ep;
+ delta = q - ep;
+ if (delta <= dlam) {
+ if (delta >= -dlam)
+ goto L170;
+
+ ier = 602;
+ goto L210;
+ }
+
+ f = e2[i] / q;
+ qp = delta + f;
+ e2[i + 1] = qp * ep;
+ }
+
+ d[k] = qp;
+ s = qp / p;
+ if (tot + s > tot)
+ goto L70;
+
+ ier = 601;
+ ++k;
+ e2[0] = (doublereal) k;
+ --k;
+
+ /* SET ERROR -- IRREGULAR END */
+ /* DEFLATE MINIMUM DIAGONAL ELEMENT */
+
+ s = 0.;
+ delta = qp;
+ for (j = k; j < *n; ++j) {
+ if (d[j] <= delta) {
+ i = j;
+ delta = d[j];
+ }
+ }
+
+ /* CONVERGENCE */
+
+L170:
+ if (i < *n-1)
+ e2[i + 1] = e2[i] * f / qp;
+
+ for (jj = 0; jj < i-k; ++jj) {
+ j = i - jj - 1;
+ d[j + 1] = d[j] - s;
+ e2[j + 1] = e2[j];
+ }
+
+ d[k] = tot;
+ err += abs(delta);
+ e2[k] = err;
+ }
+L210:
+ *ierr = ier;
+ return 0;
+} /* eqrt1s_ */
+
+integer ipstr_(doublereal *omega)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer ip;
+ static doublereal wm1;
+
+/* FINDS THE SMALLEST INTEGER, IPSTR, GREATER THAN 5 SUCH THAT */
+/* IPSTR * (OMEGA-1)**(IPSTR-1) .LE. 0.50. IPSTR WILL BE SET */
+/* IN LOOP. */
+
+/* ... PARAMETER LIST: */
+
+/* OMEGA RELAXATION FACTOR FOR SOR METHOD */
+
+ wm1 = *omega - 1.;
+
+ for (ip = 6; ip <= 940; ++ip) {
+ i__1 = ip - 1;
+ if ((doublereal) ((real) ip) * pow_di(&wm1, &i__1) <= .5)
+ return ip;
+ }
+ return 940;
+} /* ipstr_ */
+
+/* Subroutine */
+int iterm_(integer *nn, doublereal *a, doublereal *u, doublereal *wk, integer *imthdd)
+{
+ /* Local variables */
+ static integer i;
+
+ (void)imthdd;
+/* THIS ROUTINE PRODUCES THE ITERATION SUMMARY LINE AT THE END */
+/* OF EACH ITERATION. IF LEVEL = 5, THE LATEST APPROXIMATION */
+/* TO THE SOLUTION WILL BE PRINTED. */
+
+/* ... PARAMETER LIST: */
+
+/* NN ORDER OF SYSTEM OR, FOR REDUCED SYSTEM */
+/* ROUTINES, ORDER OF BLACK SUBSYSTEM */
+/* A ITERATION MATRIX */
+/* U SOLUTION ESTIMATE */
+/* WK WORK ARRAY OF LENGTH NN */
+/* IMTHD INDICATOR OF METHOD (=IMTHDD) */
+/* IMTHD = 1, JCG */
+/* IMTHD = 2, JSI */
+/* IMTHD = 3, SOR */
+/* IMTHD = 4, SSORCG */
+/* IMTHD = 5, SSORSI */
+/* IMTHD = 6, RSCG */
+/* IMTHD = 7, RSSI */
+
+ /* ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION */
+
+ if (itcom1_1.level < 2)
+ return 0;
+
+ /* ... PRINT HEADER FOR JCG AND RSCG */
+
+ /* ... PRINT SUMMARY LINE */
+
+ /* ... PRINT HEADER FOR SSOR-SI */
+
+ /* ... PRINT SUMMARY LINE */
+
+ /* ... PRINT HEADER FOR J-SI AND RS-SI */
+
+ /* ... PRINT SUMMARY LINE */
+
+ /* ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION FOR SOR. */
+
+ /* ... PRINT HEADER FOR SOR */
+
+ /* ... PRINT SUMMARY LINE FOR SOR */
+
+ /* ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION FOR SSOR-CG. */
+
+ /* ... PRINT HEADER FOR SSOR-CG */
+
+ /* ... PRINT SUMMARY LINE FOR SSOR-CG */
+
+ if (itcom1_1.level < 4)
+ return 0;
+
+ for (i = 0; i < *nn; ++i)
+ wk[i] = u[i] / a[i];
+
+ return 0;
+} /* iterm_ */
+
+/* Subroutine */
+int ivfill_(integer *n, integer *iv, integer *ival)
+{
+ /* Local variables */
+ static integer i, m;
+
+/* FILLS AN INTEGER VECTOR, IV, WITH AN INTEGER VALUE, IVAL. */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTOR IV */
+/* IV INTEGER VECTOR */
+/* IVAL INTEGER CONSTANT THAT FILLS FIRST N LOCATIONS OF IV */
+
+ if (*n <= 0)
+ return 0;
+
+ /* CLEAN UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 10 */
+
+ m = *n % 10;
+ for (i = 0; i < m; ++i)
+ iv[i] = *ival;
+
+ for (i = m; i < *n; i += 10) {
+ iv[i] = *ival;
+ iv[i + 1] = *ival;
+ iv[i + 2] = *ival;
+ iv[i + 3] = *ival;
+ iv[i + 4] = *ival;
+ iv[i + 5] = *ival;
+ iv[i + 6] = *ival;
+ iv[i + 7] = *ival;
+ iv[i + 8] = *ival;
+ iv[i + 9] = *ival;
+ }
+
+ return 0;
+} /* ivfill_ */
+
+/* Subroutine */
+int omeg_(doublereal *dnrm, integer *iflag)
+{
+ /* Local variables */
+ static doublereal zm1, zm2, temp;
+
+/* COMPUTES NEW VALUES FOR CME, OMEGA, AND SPECR FOR */
+/* FULLY ADAPTIVE SSOR METHODS. */
+
+/* ... PARAMETER LIST: */
+
+/* DNRM NUMERATOR OF RAYLEIGH QUOTIENT */
+/* IFLAG INDICATOR OF APPROPRIATE ENTRY POINT */
+
+ zm1 = 0.;
+ zm2 = 0.;
+ if (*iflag == 1)
+ goto L10;
+
+ /* ... IFLAG .NE. 1, COMPUTE NEW ESTIMATE FOR CME */
+
+ zm1 = ((1.-itcom3_1.spr) * (itcom3_1.betab * (itcom3_1.omega * itcom3_1.omega) + 1.) - itcom3_1.omega * (2.-itcom3_1.omega)) /
+ (itcom3_1.omega * (itcom3_1.omega - 1. - itcom3_1.spr));
+
+ if (! itcom2_1.caseii)
+ zm2 = *dnrm / itcom3_1.bdelnm;
+
+ if (itcom2_1.caseii)
+ zm2 = sqrt(abs(*dnrm / itcom3_1.bdelnm));
+
+ itcom3_1.cme = max(max(itcom3_1.cme,zm1),zm2);
+
+ /* ... IFLAG = 1, OR CONTINUATION OF IFLAG .NE. 1 */
+
+ /* COMPUTE NEW VALUES OF OMEGA AND SPECR BASED ON CME AND BETAB */
+
+L10:
+ itcom1_1.is = itcom1_1.in + 1;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ if (itcom3_1.cme >= itcom3_1.betab * 4.)
+ goto L30;
+
+ /* ... CME .LT. 4.D0*BETAB */
+
+ temp = sqrt(abs(1. - itcom3_1.cme * 2. + itcom3_1.betab * 4.));
+ itcom3_1.omega = max(2. / (temp + 1.),1.);
+ temp = (1. - itcom3_1.cme) / temp;
+ itcom3_1.specr = (1. - temp) / (temp + 1.);
+ if (abs(itcom3_1.omega - 1.) < itcom3_1.drelpr)
+ itcom3_1.specr = 0.;
+
+ return 0;
+
+ /* ... CME .GE. 4.D0*BETAB */
+
+ /* ... OMEGA-STAR WILL BE CHOSEN */
+
+L30:
+ itcom3_1.cme = sqrt((abs(itcom3_1.betab))) * 2.;
+ itcom3_1.omega = 2. / (sqrt(abs(1. - itcom3_1.betab * 4.)) + 1.);
+ itcom3_1.specr = itcom3_1.omega - 1.;
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+
+ return 0;
+} /* omeg_ */
+
+logical omgchg_(integer *ndummy)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal del1, del2;
+ (void)ndummy;
+
+/* ... THIS FUNCTION TESTS TO SEE WHETHER OMEGA SHOULD BE CHANGED */
+/* ... FOR SSOR CG METHOD. */
+
+/* ... PARAMETER LIST: */
+
+/* NDUMMY ARBITRARY INTEGER PARAMETER */
+
+ /* ... STATEMENT FUNCTION PHI(X) */
+
+ if (itcom1_1.in - itcom1_1.is < 3)
+ return FALSE_;
+
+ if (itcom3_1.specr == 0.)
+ goto L10;
+
+ if (itcom3_1.specr >= itcom3_1.spr)
+ return FALSE_;
+
+ d__1 = 1. - itcom3_1.specr / itcom3_1.spr;
+ del1 = -log(abs((1. - sqrt(abs(1.-itcom3_1.specr))) /
+ (1. + sqrt(abs(1.-itcom3_1.specr))) /
+ ((1. - sqrt(abs(d__1))) /
+ (1. + sqrt(abs(d__1))))));
+ del2 = -log(abs((1. - sqrt(abs(1. - itcom3_1.spr))) / (1. + sqrt(abs(1. - itcom3_1.spr)))));
+ if (del1 / del2 >= itcom3_1.ff)
+ return FALSE_;
+
+L10:
+ return TRUE_;
+} /* omgchg_ */
+
+logical omgstr_(integer *ndummy)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal temp, temp1, omstar;
+
+ (void)ndummy;
+
+/* TESTS FOR FULLY ADAPTIVE SSOR METHODS WHETHER OMEGA-STAR */
+/* SHOULD BE USED FOR OMEGA AND THE ADAPTIVE PROCESS TURNED */
+/* OFF. */
+
+/* ... PARAMETER LIST: */
+
+/* NDUMMY ARBITRARY INTEGER PARAMETER */
+
+ /* ... STATEMENT FUNCTION PHI(X) */
+
+ if (itcom3_1.betab >= .25 || ! itcom2_1.adapt)
+ return FALSE_;
+
+ omstar = 2. / (sqrt(abs(1. - itcom3_1.betab * 4.)) + 1.);
+
+ /* ... TEST TO CHOSE OMEGA-STAR */
+
+ if (omstar > 1. && itcom3_1.specr > 0.) {
+ temp = log(abs((1. - sqrt(abs(2. - omstar))) / (1. + sqrt(abs(2. - omstar)))));
+ temp1 = log(abs((1. - sqrt(abs(1. - itcom3_1.specr))) / (1. + sqrt(abs(1. - itcom3_1.specr)))));
+ if (temp / temp1 < itcom3_1.ff)
+ return FALSE_;
+ }
+
+ /* ... OMEGA-STAR WAS CHOSEN */
+
+ itcom3_1.omega = omstar;
+ itcom3_1.specr = itcom3_1.omega - 1.;
+ itcom2_1.adapt = FALSE_;
+ itcom2_1.partad = FALSE_;
+ itcom3_1.cme = sqrt((abs(itcom3_1.betab))) * 2.;
+ d__1 = (1. - sqrt(abs(itcom3_1.specr))) / (1. + sqrt(abs(itcom3_1.specr)));
+ itcom3_1.rrr = d__1 * d__1;
+ itcom3_1.gamma = 2. / (2. - itcom3_1.specr);
+ itcom3_1.sige = itcom3_1.specr / (2. - itcom3_1.specr);
+ itcom3_1.rho = 1.;
+ itcom1_1.is = itcom1_1.in + 1;
+ itcom3_1.delsnm = itcom3_1.delnnm;
+
+ return TRUE_;
+} /* omgstr_ */
+
+/* Subroutine */
+int parcon_(doublereal *dtnrm, doublereal *c1, doublereal *c2, doublereal *c3, doublereal *c4,
+ doublereal *gamold, doublereal * rhotmp, integer *ibmth)
+{
+ static integer ip;
+ static doublereal rhoold;
+
+/* COMPUTES ACCELERATION PARAMETERS FOR CONJUGATE GRADIENT */
+/* ACCELERATED METHODS. */
+
+/* ... PARAMETER LIST: */
+
+/* DTNRM INNER PRODUCT OF RESIDUALS */
+/* C1 OUTPUT: RHO*GAMMA */
+/* C2 OUTPUT: RHO */
+/* C3 OUTPUT: 1-RHO */
+/* C4 OUTPUT: RHO*(1-GAMMA) */
+/* GAMOLD OUTPUT: VALUE OF GAMMA AT PRECEDING ITERATION */
+/* RHOTMP LAST ESTIMATE FOR VALUE OF RHO */
+/* IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY CG */
+/* IBMTH = 1, JACOBI */
+/* = 2, REDUCED SYSTEM */
+/* = 3, SSOR */
+
+ ip = itcom1_1.in - itcom1_1.is;
+
+ /* ... SET RHOOLD AND GAMOLD */
+
+ rhoold = itcom3_1.rho;
+ *gamold = itcom3_1.gamma;
+
+ /* ... COMPUTE GAMMA (IN+1) */
+
+ /* ... FOR JACOBI OR REDUCED SYSTEM CG */
+
+ if (*ibmth <= 2)
+ itcom3_1.gamma = 1. / (1. - *dtnrm / itcom3_1.delnnm);
+
+ /* ... FOR SSOR CG */
+
+ if (*ibmth == 3)
+ itcom3_1.gamma = itcom3_1.delnnm / *dtnrm;
+
+ /* ... COMPUTE RHO (IN+1) */
+
+ itcom3_1.rho = 1.;
+ if (ip != 0) {
+ if (itcom1_1.isym != 0)
+ itcom3_1.rho = 1. / (1. - itcom3_1.gamma * *rhotmp / itcom3_1.delsnm);
+ else
+ itcom3_1.rho = 1. / (1. - itcom3_1.gamma * itcom3_1.delnnm / (*gamold * itcom3_1.delsnm * rhoold));
+ }
+
+ /* ... COMPUTE CONSTANTS C1, C2, C3, AND C4 */
+
+ itcom3_1.delsnm = itcom3_1.delnnm;
+ *rhotmp = rhoold;
+ *c1 = itcom3_1.rho * itcom3_1.gamma;
+ *c2 = itcom3_1.rho;
+ *c3 = 1. - itcom3_1.rho;
+ *c4 = itcom3_1.rho * (1. - itcom3_1.gamma);
+
+ return 0;
+} /* parcon_ */
+
+/* Subroutine */
+int parsi_(doublereal *c1, doublereal *c2, doublereal *c3, integer *ibmth)
+{
+ /* Local variables */
+ static integer ip;
+
+/* COMPUTES ACCELERATION PARAMETERS FOR SEMI-ITERATIVE */
+/* ACCELERATED METHODS. */
+
+/* ... PARAMETER LIST: */
+
+/* C1,C2 */
+/* AND */
+/* C3 OUTPUT ACCELERATION PARAMETERS */
+/* IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI */
+/* IBMTH = 1, JACOBI */
+/* = 2, REDUCED SYSTEM */
+/* = 3, SSOR */
+
+ ip = itcom1_1.in - itcom1_1.is;
+ if (ip == 0)
+ goto L30;
+
+ if (ip != 1) {
+ itcom3_1.rho = 1. / (1. - itcom3_1.sige * itcom3_1.sige * itcom3_1.rho * .25);
+ goto L20;
+ }
+ itcom3_1.rho = 1. / (1. - itcom3_1.sige * itcom3_1.sige * .5);
+
+L20:
+ *c1 = itcom3_1.rho * itcom3_1.gamma;
+ *c2 = itcom3_1.rho;
+ *c3 = 1. - itcom3_1.rho;
+
+ return 0;
+
+ /* ... NONADAPTIVE INITIALIZATION FOR SEMI-ITERATIVE METHODS */
+
+L30:
+ switch (*ibmth) {
+ case 1: goto L40;
+ case 2: goto L50;
+ case 3: goto L60;
+ }
+
+ /* ... JSI */
+
+L40:
+ if (itcom2_1.caseii)
+ itcom3_1.sme = -itcom3_1.cme;
+
+ itcom3_1.gamma = 2. / (2. - itcom3_1.cme - itcom3_1.sme);
+ itcom3_1.sige = (itcom3_1.cme - itcom3_1.sme) / (2. - itcom3_1.cme - itcom3_1.sme);
+ goto L70;
+
+ /* ... REDUCED SYSTEM SI */
+
+L50:
+ itcom3_1.gamma = 2. / (2. - itcom3_1.cme * itcom3_1.cme);
+ itcom3_1.sige = itcom3_1.cme * itcom3_1.cme / (2. - itcom3_1.cme * itcom3_1.cme);
+ itcom3_1.rrr = (1. - sqrt(abs(1. - itcom3_1.cme * itcom3_1.cme))) / (sqrt(abs(1. - itcom3_1.cme * itcom3_1.cme)) + 1.);
+ goto L70;
+
+ /* ... SSORSI */
+
+L60:
+ itcom3_1.gamma = 2. / (2. - itcom3_1.specr);
+ itcom3_1.sige = itcom3_1.specr / (2. - itcom3_1.specr);
+ itcom3_1.rrr = (1. - sqrt(abs(1. - itcom3_1.sige * itcom3_1.sige))) / (sqrt(abs(1. - itcom3_1.sige * itcom3_1.sige)) + 1.);
+
+L70:
+ itcom3_1.rho = 1.;
+ *c1 = itcom3_1.gamma;
+ *c2 = 1.;
+ *c3 = 0.;
+
+ return 0;
+} /* parsi_ */
+
+doublereal pbeta_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *v, doublereal *w1, doublereal *w2)
+{
+ /* System generated locals */
+ doublereal ret_val;
+
+ /* Local variables */
+ static integer i, k, ii, jj, jai;
+ static doublereal sum;
+ static integer jajj, ibgn, iend, itmp;
+ static doublereal temp1, temp2;
+
+/* ... COMPUTES THE NUMERATOR FOR THE COMPUTATION OF BETAB IN */
+/* ... SSOR METHODS. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* W1,W2 WORKSPACE VECTORS OF LENGTH N */
+
+ ret_val = 0.;
+ if (itcom1_1.isym == 0)
+ goto L110;
+
+ /* ************** NON - SYMMETRIC SECTION ******************** */
+
+ for (i = 0; i < *n; ++i)
+ w1[i] = v[i];
+
+ temp1 = 0.;
+ temp2 = 0.;
+ itmp = 2;
+ ibgn = ia[0] - 1;
+ iend = ia[itmp-1] - 1;
+ for (i = ibgn; i < iend; ++i) {
+ jai = ja[i] - 1;
+ temp1 -= a[i] * w1[jai];
+ }
+ w1[0] = temp1;
+ w2[0] = 0.;
+ for (k = 1; k < *n-1; ++k) {
+ temp1 = 0.;
+ temp2 = 0.;
+ ibgn = ia[k] - 1;
+ iend = ia[k + 1] - 1;
+ for (i = ibgn; i < iend; ++i) {
+ jai = ja[i] - 1;
+ if (jai > k)
+ temp1 -= a[i] * w1[jai];
+ else
+ temp2 -= a[i] * w1[jai];
+ }
+ w1[k] = temp1;
+ w2[k] = temp2;
+ }
+ temp2 = 0.;
+ ibgn = ia[*n-1] - 1;
+ iend = ia[*n] - 1;
+ for (i = ibgn; i < iend; ++i) {
+ jai = ja[i] - 1;
+ temp2 -= a[i] * w1[jai];
+ }
+ w2[*n-1] = temp2;
+ for (i = 0; i < *n; ++i)
+ ret_val += v[i] * w2[i];
+
+ return ret_val;
+
+ /* **************** SYMMETRIC SECTION ************************* */
+
+L110:
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (ibgn >= iend)
+ continue;
+ sum = 0.;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum += a[jj] * v[jajj];
+ }
+ ret_val += sum * sum;
+ }
+ return ret_val;
+} /* pbeta_ */
+
+/* Subroutine */
+int pbsor_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *rhs)
+{
+ /* Local variables */
+ static integer i, ii, jj;
+ static doublereal ui, sum, omm1;
+ static integer jajj, ibgn, iend;
+
+/* ... THIS SUBROUTINE COMPUTES A BACKWARD SOR SWEEP. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* OMEGA RELAXATION FACTOR */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+
+ omm1 = itcom3_1.omega - 1.;
+ if (itcom1_1.isym == 0)
+ goto L40;
+
+ /* *************** NON - SYMMETRIC SECTION ********************** */
+
+ for (i = 0; i < *n; ++i) {
+ ii = *n - i - 1;
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ u[ii] = itcom3_1.omega * sum - omm1 * u[ii];
+ }
+ return 0;
+
+ /* ***************** SYMMETRIC SECTION ************************** */
+
+L40:
+ for (ii = 0; ii < *n; ++ii) {
+ ui = u[ii];
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhs[jajj] -= a[jj] * ui;
+ }
+ }
+
+ for (i = 0; i < *n; ++i) {
+ ii = *n - i - 1;
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ u[ii] = itcom3_1.omega * sum - omm1 * u[ii];
+ }
+ return 0;
+} /* pbsor_ */
+
+/* Subroutine */
+int qsort_(integer *n, integer *key, doublereal *data, integer *error)
+{
+ /* Initialized data */
+
+ static integer tiny = 9;
+ static integer stklen = 30;
+
+ /* Local variables */
+ static doublereal d;
+ static integer i, j, k, v, jm1, ip1, top;
+ static logical done;
+ static integer left, llen, rlen, lfrh2, stack[30], right;
+
+/* ================================================================== */
+
+/* Q U I C K S O R T */
+
+/* IN THE STYLE OF THE CACM PAPER BY BOB SEDGEWICK, OCTOBER 1978 */
+
+/* INPUT: */
+/* N -- NUMBER OF ELEMENTS TO BE SORTED */
+/* KEY -- AN ARRAY OF LENGTH N CONTAINING THE VALUES */
+/* WHICH ARE TO BE SORTED */
+/* DATA -- A SECOND ARRAY OF LENGTH N CONTAINING DATA */
+/* ASSOCIATED WITH THE INDIVIDUAL KEYS. */
+
+/* OUTPUT: */
+/* KEY -- WILL BE ARRANGED SO THAT VALUES ARE IN INCREASING */
+/* ORDER */
+/* DATA -- REARRANGED TO CORRESPOND TO REARRANGED KEYS */
+/* ERROR -- WILL BE ZERO UNLESS YOUR INPUT FILE WAS OF TRULY */
+/* ENORMOUS LENGTH, IN WHICH CASE IT WILL BE EQUAL TO 1. */
+
+/* ================================================================== */
+
+/* ... PROGRAM IS A DIRECT TRANSLATION INTO FORTRAN OF SEDGEWICK^S */
+/* PROGRAM 2, WHICH IS NON-RECURSIVE, IGNORES FILES OF LENGTH */
+/* LESS THAN 'TINY' DURING PARTITIONING, AND USES MEDIAN OF THREE */
+/* PARTITIONING. */
+
+ if (*n == 1)
+ return 0;
+
+ if (*n <= 0)
+ goto L240;
+
+ *error = 0;
+ top = 1;
+ left = 0;
+ right = *n - 1;
+ done = *n <= tiny;
+
+ if (done)
+ goto L150;
+
+ ivfill_(&stklen, stack, &c__0);
+
+ /* =========================================================== */
+ /* QUICKSORT -- PARTITION THE FILE UNTIL NO SUBFILE REMAINS OF */
+ /* LENGTH GREATER THAN 'TINY' */
+ /* =========================================================== */
+
+ /* ... WHILE NOT DONE DO ... */
+
+L10:
+ if (done)
+ goto L150;
+
+ /* ... FIND MEDIAN OF LEFT, RIGHT AND MIDDLE ELEMENTS OF CURRENT */
+ /* SUBFILE, WHICH IS KEY(LEFT), ..., KEY(RIGHT) */
+
+ lfrh2 = (left + right) / 2;
+ k = key[lfrh2];
+ d = data[lfrh2];
+ key[lfrh2] = key[left];
+ data[lfrh2] = data[left];
+ key[left] = k;
+ data[left] = d;
+
+ if (key[left + 1] > key[right]) {
+ k = key[left + 1];
+ d = data[left + 1];
+ key[left + 1] = key[right];
+ data[left + 1] = data[right];
+ key[right] = k;
+ data[right] = d;
+ }
+
+ if (key[left] > key[right]) {
+ k = key[left];
+ d = data[left];
+ key[left] = key[right];
+ data[left] = data[right];
+ key[right] = k;
+ data[right] = d;
+ }
+
+ if (key[left + 1] > key[left]) {
+ k = key[left + 1];
+ d = data[left + 1];
+ key[left + 1] = key[left];
+ data[left + 1] = data[left];
+ key[left] = k;
+ data[left] = d;
+ }
+
+ v = key[left];
+
+ /* ... V IS NOW THE MEDIAN VALUE OF THE THREE KEYS. NOW MOVE */
+ /* FROM THE LEFT AND RIGHT ENDS SIMULTANEOUSLY, EXCHANGING */
+ /* KEYS AND DATA UNTIL ALL KEYS LESS THAN V ARE PACKED TO */
+ /* THE LEFT, ALL KEYS LARGER THAN V ARE PACKED TO THE */
+ /* RIGHT. */
+
+ i = left + 1;
+ j = right;
+
+ /* LOOP */
+ /* REPEAT I = I+1 UNTIL KEY(I) >= V; */
+ /* REPEAT J = J-1 UNTIL KEY(J) <= V; */
+ /* EXIT IF J < I; */
+ /* << EXCHANGE KEYS I AND J >> */
+ /* END */
+
+L50:
+ while (key[++i] < v) ;
+
+ while (key[--j] > v) ;
+
+ if (j >= i) {
+ k = key[i];
+ d = data[i];
+ key[i] = key[j];
+ data[i] = data[j];
+ key[j] = k;
+ data[j] = d;
+ goto L50;
+ }
+
+ k = key[left];
+ d = data[left];
+ key[left] = key[j];
+ data[left] = data[j];
+ key[j] = k;
+ data[j] = d;
+
+ /* ... WE HAVE NOW PARTITIONED THE FILE INTO TWO SUBFILES, */
+ /* ONE IS (LEFT ... J-1) AND THE OTHER IS (I...RIGHT). */
+ /* PROCESS THE SMALLER NEXT. STACK THE LARGER ONE. */
+
+ llen = j - left;
+ rlen = right - i + 1;
+ if (max(llen,rlen) > tiny)
+ goto L100;
+
+ /* ... BOTH SUBFILES ARE TINY, SO UNSTACK NEXT LARGER FILE */
+
+ if (top != 1) {
+ top += -2;
+ left = stack[top - 1] - 1;
+ right = stack[top] - 1;
+ }
+ else
+ done = TRUE_;
+
+ goto L10;
+
+ /* ... ELSE ONE OR BOTH SUBFILES ARE LARGE */
+
+L100:
+ if (min(llen,rlen) > tiny)
+ goto L120;
+
+ /* ... ONE SUBFILE IS SMALL, ONE LARGE. IGNORE THE SMALL ONE */
+
+ if (llen <= rlen)
+ left = i;
+ else
+ right = j - 1;
+
+ goto L10;
+
+ /* ... ELSE BOTH ARE LARGER THAN TINY. ONE MUST BE STACKED. */
+
+L120:
+ if (top >= stklen)
+ goto L240;
+
+ if (llen <= rlen) {
+ stack[top - 1] = i + 1;
+ stack[top] = right + 1;
+ right = j - 1;
+ }
+ else {
+ stack[top - 1] = left + 1;
+ stack[top] = j;
+ left = i;
+ }
+
+ top += 2;
+
+ goto L10;
+
+ /* ------------------------------------------------------------ */
+ /* INSERTION SORT THE ENTIRE FILE, WHICH CONSISTS OF A LIST */
+ /* OF 'TINY' SUBFILES, LOCALLY OUT OF ORDER, GLOBALLY IN ORDER. */
+ /* ------------------------------------------------------------ */
+
+ /* ... FIRST, FIND LARGEST ELEMENT IN 'KEY' */
+
+L150:
+ i = *n - 2;
+ left = max(0, *n-tiny) - 1;
+ j = *n - 1;
+ k = key[j];
+
+L160:
+ if (i <= left)
+ goto L180;
+
+ if (key[i] > k) {
+ k = key[i];
+ j = i;
+ }
+
+ --i;
+ goto L160;
+
+L180:
+ if (j != *n - 1) {
+ /* ... LARGEST ELEMENT WILL BE IN KEY(N) */
+ key[j] = key[*n-1];
+ key[*n-1] = k;
+ d = data[*n-1];
+ data[*n-1] = data[j];
+ data[j] = d;
+ }
+
+ /* ... INSERTION SORT ... FOR I := N-1 STEP -1 TO 1 DO ... */
+
+ i = *n - 2;
+ ip1 = *n - 1;
+
+L200:
+ if (key[i] <= key[ip1])
+ goto L220;
+
+ /* ... OUT OF ORDER ... MOVE UP TO CORRECT PLACE */
+
+ k = key[i];
+ d = data[i];
+ j = ip1;
+ jm1 = i;
+
+ /* ... REPEAT ... UNTIL 'CORRECT PLACE FOR K FOUND' */
+
+L210:
+ key[jm1] = key[j];
+ data[jm1] = data[j];
+ jm1 = j;
+ ++j;
+ if (key[j] < k)
+ goto L210;
+
+ key[jm1] = k;
+ data[jm1] = d;
+
+L220:
+ ip1 = i;
+ --i;
+ if (i >= 0)
+ goto L200;
+
+L230:
+ return 0;
+
+L240:
+ *error = 1;
+ goto L230;
+} /* qsort_ */
+
+/* Subroutine */
+int permat_(integer *n, integer *ia, integer *ja, doublereal *a, integer *p,
+ integer *newia, integer *isym, integer * level, integer *nout, integer* ierr)
+{
+ /* Local variables */
+ static integer i, j, k, ip, jp, jaj, ier, ipp, ibgn, iend;
+ static doublereal save;
+ static integer nels;
+ static doublereal temp;
+ static integer next;
+
+ (void)level; (void)nout;
+/* ********************************************************************* */
+
+/* ... SUBROUTINE PERMAT TAKES THE SPARSE MATRIX REPRESENTATION */
+/* OF THE MATRIX STORED IN THE ARRAYS IA, JA, AND A AND */
+/* PERMUTES BOTH ROWS AND COLUMNS OVERWRITING THE PREVIOUS */
+/* STRUCTURE. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* IA,JA INTEGER ARRAYS OF THE SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF THE SPARSE MATRIX REPRESENTATION */
+/* P PERMUTATION VECTOR */
+/* NEWIA INTEGER WORK VECTOR OF LENGTH N */
+/* ISYM SYMMETRIC/NONSYMMETRIC STORAGE SWITCH */
+/* LEVEL SWITCH CONTROLLING LEVEL OF OUTPUT */
+/* NOUT OUTPUT UNIT NUMBER */
+/* IER OUTPUT ERROR FLAG (= IERR) */
+
+/* IER = 0 NORMAL RETURN */
+/* IER = 301 NO ENTRY IN ITH ROW OF ORIGINAL */
+/* MATRIX. IF LEVEL IS GREATER THAN */
+/* 0, I WILL BE PRINTED */
+/* IER = 302 THERE IS NO ENTRY IN THE ITH ROW */
+/* OF THE PERMUTED MATRIX */
+/* IER = 303 ERROR RETURN FROM QSORT IN */
+/* SORTING THE ITH ROW OF THE */
+/* PERMUTED MATRIX */
+/* ... IT IS ASSUMED THAT THE I-TH ENTRY OF THE PERMUTATION VECTOR */
+/* P INDICATES THE ROW THE I-TH ROW GETS MAPPED INTO. (I.E. */
+/* IF ( P(I) = J ) ROW I GETS MAPPED INTO ROW J.) */
+
+/* ... THE ARRAY NEWIA IS AN INTEGER WORK VECTOR OF LENGTH N WHICH */
+/* KEEPS TRACK OF WHERE THE ROWS BEGIN IN THE PERMUTED STRUCTURE. */
+
+/* ... PERMAT IS CAPABLE OF PERMUTING BOTH THE SYMMETRIC AND NON- */
+/* SYMMETRIC FORM OF IA, JA, AND A. IF ( ISYM .EQ. 0 ) SYMMETRIC */
+/* FORM IS ASSUMED. */
+
+/* ... TWO EXTERNAL MODULES ARE USED BY PERMAT. THE FIRST IS INTEGER */
+/* FUNCTION BISRCH WHICH USES A BISECTION SEARCH ( ORDER LOG-BASE-2 */
+/* OF N+1 ) THROUGH THE ARRAY IA TO FIND THE ROW INDEX OF AN ARBI- */
+/* TRARY ENTRY EXTRACTED FROM THE ARRAY JA. THE SECOND IS SUBROUTINE */
+/* QSORT WHICH PERFORMS A QUICK SORT TO PLACE THE ENTRIES IN */
+/* THE PERMUTED ROWS IN COLUMN ORDER. */
+
+/* ********************************************************************* */
+
+ /* ... PREPROCESSING PHASE */
+
+ /* ...... DETERMINE THE NUMBER OF NONZEROES IN THE ROWS OF THE PERMUTED */
+ /* MATRIX AND STORE THAT IN NEWIA. THEN SWEEP THRU NEWIA TO MAKE */
+ /* NEWIA(I) POINT TO THE BEGINNING OF EACH ROW IN THE PERMUTED */
+ /* DATA STRUCTURE. ALSO NEGATE ALL THE ENTRIES IN JA TO INDICATE */
+ /* THAT THOSE ENTRIES HAVE NOT BEEN MOVED YET. */
+
+ ier = 0;
+ nels = ia[*n] - 1;
+ for (i = 0; i < *n; ++i)
+ newia[i] = 0;
+
+ for (i = 0; i < *n; ++i) {
+ ip = p[i] - 1;
+ ibgn = ia[i] - 1;
+ iend = ia[i + 1] - 1;
+ if (ibgn >= iend)
+ goto L90;
+
+ for (j = ibgn; j < iend; ++j) {
+ ipp = ip;
+ jaj = ja[j];
+ jp = p[jaj-1] - 1;
+ if (*isym == 0 && ip > jp)
+ ipp = jp;
+
+ ++newia[ipp];
+ ja[j] = -jaj;
+ }
+ }
+ ibgn = 0;
+ for (i = 0; i < *n; ++i) {
+ k = ibgn + newia[i];
+ newia[i] = ibgn+1;
+ ibgn = k;
+ }
+
+ /* ...... PREPROCESSING NOW FINISHED. */
+
+ /* ...... NOW PERMUTE JA AND A. THIS PERMUTATION WILL PERFORM THE */
+ /* FOLLOWING STEPS */
+
+ /* 1. FIND THE FIRST ENTRY IN JA NOT PERMUTED WHICH IS */
+ /* INDICATED BY AN NEGATIVE VALUE IN JA */
+ /* 2. COMPUTE WHICH ROW THE CURRENT ENTRY IS IN. THIS */
+ /* IS COMPUTED BY A BISECTION SEARCH THRU THE ARRAY */
+ /* IA. */
+ /* 3. USING THE PERMUTATION ARRAY P AND THE ARRAY NEWIA */
+ /* COMPUTE WHERE THE CURRENT ENTRY IS TO BE PLACED. */
+ /* 4. THEN PICK UP THE ENTRY WHERE THE CURRENT ENTRY WILL */
+ /* GO. PUT THE CURRENT ENTRY IN PLACE. THEN MAKE THE */
+ /* DISPLACED ENTRY THE CURRENT ENTRY AND LOOP TO STEP 2. */
+ /* 5. THIS PROCESS WILL END WHEN THE NEXT ENTRY HAS ALREADY */
+ /* BEEN MOVED. THEN LOOP TO STEP 1. */
+
+ for (j = 0; j < nels; ++j) {
+ if (ja[j] > 0)
+ continue;
+ jaj = -ja[j];
+ save = a[j];
+ next = j + 1;
+ ja[j] = jaj;
+L50:
+ jp = p[jaj-1] - 1;
+ k = *n + 1;
+ i = bisrch_(&k, ia, &next) - 1;
+ ip = p[i] - 1;
+ ipp = ip;
+ if (*isym == 0 && ip > jp) {
+ ipp = jp;
+ jp = ip;
+ }
+ next = newia[ipp] - 1;
+
+ temp = save; save = a[next]; a[next] = temp;
+
+ jaj = -ja[next];
+ ja[next] = jp + 1;
+ ++newia[ipp];
+ if (jaj > 0) {
+ ++next;
+ goto L50;
+ }
+ }
+
+ /* ...... THE MATRIX IS NOW PERMUTED BUT THE ROWS MAY NOT BE IN */
+ /* ORDER. THE REMAINDER OF THIS SUBROUTINE PERFORMS */
+ /* A QUICK SORT ON EACH ROW TO SORT THE ENTRIES IN */
+ /* COLUMN ORDER. THE IA ARRAY IS ALSO CORRECTED FROM */
+ /* INFORMATION STORED IN THE NEWIA ARRAY. NEWIA(I) NOW */
+ /* POINTS TO THE FIRST ENTRY OF ROW I+1. */
+
+ ia[0] = 1;
+ for (i = 0; i < *n; ++i) {
+ ia[i + 1] = newia[i];
+ k = ia[i + 1] - ia[i];
+ if (k == 1)
+ continue;
+ if (k < 1)
+ goto L110;
+
+ ibgn = ia[i] - 1;
+ qsort_(&k, &ja[ibgn], &a[ibgn], &ier);
+ if (ier != 0)
+ goto L130;
+ }
+
+ /* ...... END OF MATRIX PERMUTATION */
+
+ goto L150;
+
+ /* ... ERROR TRAPS */
+
+ /* ...... NO ENTRY IN ROW I IN THE ORIGINAL SYSTEM */
+
+L90:
+ ier = 301;
+ goto L150;
+
+ /* ...... NO ENTRY IN ROW I IN THE PERMUTED SYSTEM */
+
+L110:
+ ier = 302;
+ goto L150;
+
+ /* ...... ERROR RETURN FROM SUBROUTINE QSORT */
+
+L130:
+ ier = 303;
+
+L150:
+ *ierr = ier;
+ return 0;
+} /* permat_ */
+
+/* Subroutine */
+int perror_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs,
+ doublereal *u, doublereal *w, doublereal *digtt1, doublereal *digtt2, integer *idgtts)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal bnrm, temp, rnrm;
+ static integer idgts;
+ static doublereal digit1, digit2;
+
+/* PERROR COMPUTES THE RESIDUAL, R = RHS - A*U. THE USER */
+/* ALSO HAS THE OPTION OF PRINTING THE RESIDUAL AND/OR THE */
+/* UNKNOWN VECTOR DEPENDING ON IDGTS. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* W WORKSPACE VECTOR */
+/* DIGIT1 OUTPUT: MEASURE OF ACCURACY OF STOPPING TEST (= DIGTT1 */
+/* DIGIT2 OUTPUT: MEASURE OF ACCURACY OF SOLUTION (= DIGTT2) */
+/* IDGTS PARAMETER CONTROLING LEVEL OF OUTPUT (= IDGTTS) */
+/* IF IDGTS < 1 OR IDGTS > 4, THEN NO OUTPUT. */
+/* = 1, THEN NUMBER OF DIGITS IS PRINTED, PRO- */
+/* VIDED LEVEL .GE. 1 */
+/* = 2, THEN SOLUTION VECTOR IS PRINTED, PRO- */
+/* VIDED LEVEL .GE. 1 */
+/* = 3, THEN RESIDUAL VECTOR IS PRINTED, PRO- */
+/* VIDED LEVEL .GE. 1 */
+/* = 4, THEN BOTH VECTORS ARE PRINTED, PRO- */
+/* VIDED LEVEL .GE. 1 */
+
+ idgts = *idgtts;
+ digit1 = 0.;
+ digit2 = 0.;
+ if (*n <= 0)
+ goto L40;
+
+ d__1 = abs(itcom3_1.drelpr);
+ digit1 = -d_lg10(&d__1);
+ if (itcom3_1.stptst > 0.) {
+ d__1 = abs(itcom3_1.stptst);
+ digit1 = -d_lg10(&d__1);
+ }
+ bnrm = itpackddot_(n, rhs, &c__1, rhs, &c__1);
+ if (bnrm == 0.)
+ goto L10;
+
+ pmult_(n, ia, ja, a, u, w);
+ wevmw_(n, rhs, w);
+ rnrm = itpackddot_(n, w, &c__1, w, &c__1);
+ temp = rnrm / bnrm;
+ if (temp != 0.) {
+ d__1 = abs(temp);
+ digit2 = -d_lg10(&d__1) / 2.;
+ goto L20;
+ }
+L10:
+ d__1 = abs(itcom3_1.drelpr);
+ digit2 = -d_lg10(&d__1);
+
+L20:
+ if (itcom1_1.level > 0) {
+ if (idgts == 2 || idgts == 4)
+ vout_(n, u, &c__2, &itcom1_1.nout);
+ if (idgts == 3 || idgts == 4)
+ vout_(n, w, &c__1, &itcom1_1.nout);
+ }
+
+L40:
+ *digtt1 = digit1;
+ *digtt2 = digit2;
+ return 0;
+} /* perror_ */
+
+/* Subroutine */
+int pervec_(integer *n, doublereal *v, integer *p)
+{
+ /* Local variables */
+ static integer ii, now;
+ static doublereal save, temp;
+ static integer next;
+
+/* THIS SUBROUTINE PERMUTES A D.P. VECTOR AS DICTATED BY THE */
+/* PERMUTATION VECTOR, P. IF P(I) = J, THEN V(J) GETS V(I). */
+
+/* ... PARAMETER LIST: */
+
+/* V D.P. VECTOR OF LENGTH N */
+/* P INTEGER PERMUTATION VECTOR */
+
+ if (*n <= 0)
+ return 0;
+
+ for (ii = 0; ii < *n; ++ii) {
+ if (p[ii] < 0)
+ continue;
+
+ next = p[ii];
+ save = v[ii];
+ while (p[next-1] >= 0) {
+ temp = save;
+ save = v[next-1];
+ v[next-1] = temp;
+
+ now = next;
+ next = p[now-1];
+ p[now-1] = -next;
+ }
+ }
+
+ for (ii = 0; ii < *n; ++ii)
+ p[ii] = -p[ii];
+
+ return 0;
+} /* pervec_ */
+
+/* Subroutine */
+int pfsor_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *rhs)
+{
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal ui, sum, omm1;
+ static integer jajj, ibgn, iend;
+
+/* THIS SUBROUTINE COMPUTES A FORWARD SOR SWEEP. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* OMEGA RELAXATION FACTOR */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+
+ omm1 = itcom3_1.omega - 1.;
+ if (itcom1_1.isym == 0)
+ goto L40;
+
+ /* *********** NON - SYMMETRIC SECTION ********************* */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ ui = itcom3_1.omega * sum - omm1 * u[ii];
+ u[ii] = ui;
+ }
+ return 0;
+
+ /* ************* SYMMETRIC SECTION ************************* */
+
+L40:
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ ui = itcom3_1.omega * sum - omm1 * u[ii];
+ u[ii] = ui;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhs[jajj] -= a[jj] * ui;
+ }
+ }
+ return 0;
+} /* pfsor_ */
+
+/* Subroutine */
+int pfsor1_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *rhs)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal ui, sum, omm1;
+ static integer jajj, ibgn, iend;
+ static doublereal sumd;
+
+/* THIS SUBROUTINE COMPUTES A FORWARD SOR SWEEP ON U AND */
+/* COMPUTES THE NORM OF THE PSEUDO-RESIDUAL VECTOR. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* OMEGA RELAXATION FACTOR */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+
+ omm1 = itcom3_1.omega - 1.;
+ sumd = 0.;
+ if (itcom1_1.isym == 0)
+ goto L40;
+
+ /* **************** NON - SYMMETRIC SECTION ****************** */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ ui = itcom3_1.omega * sum - omm1 * u[ii];
+ d__1 = ui - u[ii];
+ sumd += d__1 * d__1;
+ u[ii] = ui;
+ }
+ goto L90;
+
+ /* *************** SYMMETRIC SECTION ************************ */
+
+L40:
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ ui = itcom3_1.omega * sum - omm1 * u[ii];
+ d__1 = ui - u[ii];
+ sumd += d__1 * d__1;
+ u[ii] = ui;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhs[jajj] -= a[jj] * ui;
+ }
+ }
+
+L90:
+ itcom3_1.delnnm = sqrt(sumd);
+ return 0;
+} /* pfsor1_ */
+
+/* Subroutine */
+int pjac_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *rhs)
+{
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal uii;
+ static integer jajj, ibgn, iend;
+ static doublereal rhsii;
+
+/* ... THIS SUBROUTINE PERFORMS ONE JACOBI ITERATION. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U ESTIMATE OF SOLUTION OF A MATRIX PROBLEM */
+/* RHS ON INPUT: CONTAINS THE RIGHT HAND SIDE OF */
+/* A MATRIX PROBLEM */
+/* ON OUTPUT: CONTAINS A*U + RHS */
+
+ if (itcom1_1.isym == 0)
+ goto L30;
+
+ /* *************** NON - SYMMETRIC SECTION **************** */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ rhsii = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhsii -= a[jj] * u[jajj];
+ }
+ rhs[ii] = rhsii;
+ }
+ return 0;
+
+ /* ************** SYMMETRIC SECTION ********************** */
+
+L30:
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (ibgn >= iend)
+ continue;
+
+ rhsii = rhs[ii];
+ uii = u[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhsii -= a[jj] * u[jajj];
+ rhs[jajj] -= a[jj] * uii;
+ }
+ rhs[ii] = rhsii;
+ }
+ return 0;
+} /* pjac_ */
+
+/* Subroutine */
+int pmult_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u, doublereal *w)
+{
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal uii, wii, sum;
+ static integer jajj, ibgn, iend;
+
+/* ... THIS SUBROUTINE PERFORMS ONE MATRIX-VECTOR MULTIPLICATION. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* W ON RETURN W CONTAINS A*U */
+
+ if (*n <= 0)
+ return 0;
+
+ if (itcom1_1.isym == 0)
+ goto L40;
+
+ /* *************** NON - SYMMETRIC SECTION ********************** */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = 0.;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum += a[jj] * u[jajj];
+ }
+ w[ii] = sum;
+ }
+ return 0;
+
+ /* ***************** SYMMETRIC SECTION ************************** */
+
+L40:
+ vfill_(n, w, &c_b21);
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ uii = u[ii];
+ wii = w[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ wii += a[jj] * u[jajj];
+ w[jajj] += a[jj] * uii;
+ }
+ w[ii] = wii;
+ }
+ return 0;
+} /* pmult_ */
+
+/* Subroutine */
+int prbndx_(integer *n, integer *nblack, integer *ia, integer *ja, integer *p,
+ integer *ip, integer *level, integer *nout, integer *ier)
+{
+ /* Local variables */
+ static integer i, j, k, old, ibgn, iend, nred, last, next, typ, first, young, curtyp, nxttyp;
+
+ (void)level; (void)nout;
+/* ************************************************************** */
+
+/* THIS SUBROUTINE COMPUTES THE RED-BLACK PERMUTATION */
+/* VECTORS P ( AND ITS INVERSE IP ) IF POSSIBLE. */
+
+/* THE ALGORITHM IS TO MARK THE FIRST NODE AS RED (ARBITRARY). */
+/* ALL OF ITS ADJACENT NODES ARE MARKED BLACK AND PLACED IN */
+/* A STACK. THE REMAINDER OF THE CODE PULLS THE FIRST NODE */
+/* OFF THE TOP OF THE STACK AND TRIES TO TYPE ITS ADJACENT NODES. */
+/* THE TYPING OF THE ADJACENT POINT IS A FIVE WAY CASE STATEMENT */
+/* WHICH IS WELL COMMENTED BELOW (SEE DO LOOP 100). */
+
+/* THE ARRAY P IS USED BOTH TO KEEP TRACK OF THE COLOR OF A NODE */
+/* (RED NODE IS POSITIVE, BLACK IS NEGATIVE) BUT ALSO THE FATHER */
+/* NODE THAT CAUSED THE COLOR MARKING OF THAT POINT. SINCE */
+/* COMPLETE INFORMATION ON THE ADJACENCY STRUCTURE IS HARD TO COME */
+/* BY THIS FORMS A LINK TO ENABLE THE COLOR CHANGE OF A PARTIAL */
+/* TREE WHEN A RECOVERABLE COLOR CONFLICT OCCURS. */
+
+/* THE ARRAY IP IS USED AS A STACK TO POINT TO THE SET OF NODES */
+/* LEFT TO BE TYPED THAT ARE KNOWN TO BE ADJACENT TO THE CURRENT */
+/* FATHER NODE. */
+
+/* ********************************************************************* */
+
+/* INPUT PARAMETERS */
+
+/* N NUMBER OF NODES. (INTEGER, SCALAR) */
+
+/* IA,JA ADJACENCY STRUCTURE ARRAYS. CAN BE EITHER THE */
+/* SYMMETRIC OR NONSYMMETRIC FORM. IT IS ASSUMED */
+/* THAT FOR EVERY ROW WHERE ONLY ONE ELEMENT IS */
+/* STORED THAT ELEMENT CORRESPONDS TO THE DIAGONAL */
+/* ENTRY. THE DIAGONAL DOES NOT HAVE TO BE THE FIRST */
+/* ENTRY STORED. (INTEGER, ARRAYS) */
+/* LEVEL SWITCH FOR PRINTING */
+/* NOUT OUTPUT TAPE NUMBER */
+
+/* OUTPUT PARAMETERS */
+
+/* NBLACK NUMBER OF BLACK NODES. NUMBER OF RED NODES IS */
+/* N - NBLACK. (INTEGER, SCALAR) */
+
+/* P, IP PERMUTATION AND INVERSE PERMUTATION VECTORS. */
+/* (INTEGER, ARRAYS EACH OF LENGTH N) */
+
+/* IER ERROR FLAG. (INTEGER, SCALAR) */
+
+/* IER = 0, NORMAL RETURN. INDEXING PERFORMED */
+/* SUCCESSFULLY */
+/* IER =201, RED-BLACK INDEXING NOT POSSIBLE. */
+
+/* ******************************************************************** */
+
+ *ier = 0;
+
+ /* IF ( N .LE. 0 ) GO TO 8000 */
+
+ for (i = 0; i < *n; ++i) {
+ p[i] = 0;
+ ip[i] = 0;
+ }
+
+ /* ... HANDLE THE FIRST SET OF POINTS UNTIL SOME ADJACENT POINTS ARE FOUND */
+
+ first = 0;
+
+L20:
+ p[first] = first + 1;
+ if (ia[first + 1] - ia[first] > 1)
+ goto L40;
+
+ /* ... SEARCH FOR NEXT ENTRY THAT HAS NOT BEEN MARKED */
+
+ if (first == *n-1)
+ goto L130;
+
+ ibgn = first + 1;
+ for (i = ibgn; i < *n; ++i) {
+ if (p[i] == 0) {
+ first = i;
+ goto L20;
+ }
+ }
+ goto L130;
+
+ /* ... FIRST SET OF ADJACENT POINTS FOUND */
+
+L40:
+ next = 0;
+ last = 0;
+ ip[0] = first + 1;
+
+ /* ... LOOP OVER LABELED POINTS INDICATED IN THE STACK STORED IN */
+ /* ... THE ARRAY IP */
+
+L50:
+ k = ip[next] - 1;
+ curtyp = p[k];
+ nxttyp = -curtyp;
+ ibgn = ia[k] - 1;
+ iend = ia[k + 1] - 1;
+ for (i = ibgn; i < iend; ++i) {
+ j = ja[i] - 1;
+ typ = p[j];
+ if (j == k)
+ continue;
+
+ /* ================================================================== */
+
+ /* THE FOLLOWING IS A FIVE WAY CASE STATEMENT DEALING WITH THE */
+ /* LABELING OF THE ADJACENT NODE. */
+
+ /* ... CASE I. IF THE ADJACENT NODE HAS ALREADY BEEN LABELED WITH */
+ /* LABEL EQUAL TO NXTTYP, THEN SKIP TO THE NEXT ADJACENT NODE. */
+
+ else if (typ == nxttyp)
+ continue;
+
+ /* ... CASE II. IF THE ADJACENT NODE HAS NOT BEEN LABELED YET LABEL */
+ /* IT WITH NXTTYP AND ENTER IT IN THE STACK */
+
+ else if (typ == 0) {
+ ++last;
+ ip[last] = j + 1;
+ p[j] = nxttyp;
+ continue;
+ }
+
+ /* ... CASE III. IF THE ADJACENT NODE HAS ALREADY BEEN LABELED WITH */
+ /* OPPOSITE COLOR AND THE SAME FATHER SEED, THEN THERE */
+ /* IS AN IRRECOVERABLE COLOR CONFLICT. */
+
+ else if (typ == curtyp) { /* ...... TYPE CONFLICT */
+ *ier = 201;
+ return 0;
+ }
+
+ /* ... CASE IV. IF THE ADJACENT NODE HAS THE RIGHT COLOR AND A DIFFERENT */
+ /* FATHER NODE, THEN CHANGE ALL NODES OF THE YOUNGEST FATHE */
+ /* NODE TO POINT TO THE OLDEST FATHER SEED AND RETAIN THE */
+ /* SAME COLORS. */
+
+ else if (typ * nxttyp >= 1) {
+ old = min(abs(typ),abs(nxttyp));
+ young = max(abs(typ),abs(nxttyp));
+ for (j = young-1; j < *n; ++j) {
+ if (abs(p[j]) == young)
+ p[j] = old*p[j] >= 0 ? old : -old;
+ }
+ curtyp = p[k];
+ nxttyp = -curtyp;
+ continue;
+ }
+
+ /* ... CASE V. IF THE ADJACENT NODE HAS THE WRONG COLOR AND A DIFFERENT */
+ /* FATHER NODE, THEN CHANGE ALL NODES OF THE YOUNGEST FATHER */
+ /* NODE TO POINT TO THE OLDEST FATHER NODE ALONG WITH */
+ /* CHANGING THEIR COLORS. SINCE UNTIL THIS TIME THE */
+ /* YOUNGEST FATHER NODE TREE HAS BEEN INDEPENDENT NO OTHER */
+ /* COLOR CONFLICTS WILL ARISE FROM THIS CHANGE. */
+
+ else {
+ old = min(abs(typ),abs(nxttyp));
+ young = max(abs(typ),abs(nxttyp));
+ for (j = young-1; j < *n; ++j) {
+ if (abs(p[j]) == young)
+ p[j] = old*p[j] <= 0 ? old : -old;
+ }
+ curtyp = p[k];
+ nxttyp = -curtyp;
+ continue;
+ }
+
+ /* ... END OF CASE STATEMENT */
+
+ /* ================================================================== */
+ }
+
+ /* ... ADVANCE TO NEXT NODE IN THE STACK */
+
+ ++next;
+ if (next <= last)
+ goto L50;
+
+ /* ... ALL NODES IN THE STACK HAVE BEEN REMOVED */
+
+ /* ... CHECK FOR NODES NOT LABELED. IF ANY ARE FOUND */
+ /* ... START THE LABELING PROCESS AGAIN AT THE FIRST */
+ /* ... NODE FOUND THAT IS NOT LABELED. */
+
+ ibgn = first + 1;
+ for (i = ibgn; i < *n; ++i) {
+ if (p[i] == 0) {
+ first = i;
+ goto L20;
+ }
+ }
+
+ /* =================================================================== */
+
+ /* ... ALL NODES ARE NOW TYPED EITHER RED OR BLACK */
+
+ /* ... GENERATE PERMUTATION VECTORS */
+
+L130:
+ nred = 0;
+ *nblack = 0;
+ for (i = 0; i < *n; ++i) {
+ if (p[i] < 0) /* BLACK POINT */
+ {
+ ++(*nblack);
+ j = *n - *nblack;
+ ip[j] = i + 1;
+ p[i] = j + 1;
+ }
+ else /* RED POINT */
+ {
+ ++nred;
+ ip[nred-1] = i + 1;
+ p[i] = nred;
+ }
+ }
+
+ /* ... SUCCESSFUL RED-BLACK ORDERING COMPLETED */
+
+ return 0;
+
+ /* ........ ERROR TRAPS */
+
+ /* ...... N .LE. 0 */
+
+ /* 8000 IER = 200 */
+ /* GO TO 9000 */
+} /* prbndx_ */
+
+/* Subroutine */
+int prsblk_(integer *nb, integer *nr, integer *ia, integer *ja, doublereal *a, doublereal *ur, doublereal *vb)
+{
+ /* Local variables */
+ static integer i, j, jaj, inr;
+ static doublereal uri, sum;
+ static integer ibgn, iend;
+
+/* ... COMPUTE A BLACK-RS SWEEP ON A RED VECTOR INTO A BLACK VECTOR */
+
+/* ... PARAMETER LIST: */
+
+/* NB NUMBER OF BLACK POINTS */
+/* NR NUMBER OF RED POINTS */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* UR ESTIMATE OF RED SOLUTION VECTOR */
+/* VB OUTPUT: PRESENT ESTIMATE OF BLACK SOLUTION */
+/* VECTOR */
+
+ if (itcom1_1.isym == 0)
+ goto L30;
+
+ /* *************** NON - SYMMETRIC SECTION ********************** */
+
+ for (i = 0; i < *nb; ++i) {
+ inr = i + *nr;
+ ibgn = ia[inr] - 1;
+ iend = ia[inr + 1] - 1;
+ sum = vb[i];
+ if (ibgn >= iend)
+ continue;
+
+ for (j = ibgn; j < iend; ++j) {
+ jaj = ja[j] - 1;
+ sum -= a[j] * ur[jaj];
+ }
+ vb[i] = sum;
+ }
+ return 0;
+
+ /* ***************** SYMMETRIC SECTION ************************** */
+
+L30:
+ for (i = 0; i < *nr; ++i) {
+ ibgn = ia[i] - 1;
+ iend = ia[i + 1] - 1;
+ uri = ur[i];
+ for (j = ibgn; j < iend; ++j) {
+ jaj = ja[j] - *nr - 1;
+ vb[jaj] -= a[j] * uri;
+ }
+ }
+
+ return 0;
+} /* prsblk_ */
+
+/* Subroutine */
+int prsred_(integer *nb, integer *nr, integer *ia, integer *ja, doublereal *a, doublereal *ub, doublereal *vr)
+{
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal sum;
+ static integer jajj, ibgn, iend;
+
+/* ... COMPUTES A RED-RS SWEEP ON A BLACK VECTOR INTO A RED VECTOR. */
+/* */
+/* ... PARAMETER LIST: */
+/* */
+/* NB NUMBER OF BLACK POINTS (unused!?) */
+/* NR NUMBER OF RED POINTS */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* UB PRESENT ESTIMATE OF BLACK SOLUTION VECTOR */
+/* VR OUTPUT: PRESENT ESTIMATE OF RED SOLUTION VECTOR */
+
+ for (ii = 0; ii < *nr; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (ibgn >= iend)
+ continue;
+
+ sum = vr[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - *nr - 1;
+ sum -= a[jj] * ub[jajj];
+ }
+ vr[ii] = sum;
+ }
+
+ return 0;
+} /* prsred_ */
+
+/* Subroutine */
+int pssor1_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *u,
+ doublereal *rhs, doublereal *fr, doublereal *br)
+{
+ /* Local variables */
+ static integer i, ii, jj;
+ static doublereal uii, sum, omm1;
+ static integer jajj, ibgn, iend;
+
+/* ... COMPUTES COMPLETE SSOR SWEEP ON U. U IS OVERWRITTEN */
+/* ... WITH THE NEW ITERANT, FR AND BR WILL CONTAIN */
+/* ... THE FORWARD AND BACKWARD RESIDUALS ON OUTPUT. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* OMEGA RELAXATION FACTOR */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* U ESTIMATE OF SOLUTION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+/* FR,BR OUTPUT: FORWARD AND BACKWARD RESIDUALS RESPECTIVELY */
+
+ omm1 = itcom3_1.omega - 1.;
+ if (itcom1_1.isym == 0)
+ goto L40;
+
+ /* *************** NON - SYMMETRIC SECTION ********************** */
+
+ /* ... FORWARD SWEEP */
+
+ for (ii = 0; ii < *n; ++ii) {
+ br[ii] = u[ii];
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ uii = itcom3_1.omega * sum - omm1 * u[ii];
+ fr[ii] = uii - u[ii];
+ u[ii] = uii;
+ }
+ goto L90;
+
+ /* ***************** SYMMETRIC SECTION ************************** */
+
+ /* ... FORWARD SWEEP */
+
+L40:
+ for (ii = 0; ii < *n; ++ii) {
+ br[ii] = u[ii];
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ sum = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sum -= a[jj] * u[jajj];
+ }
+ uii = itcom3_1.omega * sum - omm1 * u[ii];
+ fr[ii] = uii - u[ii];
+ u[ii] = uii;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ rhs[jajj] -= a[jj] * uii;
+ }
+ }
+
+ /* ... BACKWARD SWEEP */
+
+L90:
+ for (i = 0; i < *n; ++i) {
+ ii = *n - i - 1;
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ uii = rhs[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ uii -= a[jj] * u[jajj];
+ }
+ u[ii] = itcom3_1.omega * uii - omm1 * u[ii];
+ br[ii] = u[ii] - br[ii];
+ }
+
+ return 0;
+} /* pssor1_ */
+
+/* Subroutine */
+int pstop_(integer *n, doublereal *u, doublereal *dnrm, doublereal *ccon, integer *iflag, logical *q1)
+{
+ /* Local variables */
+ static doublereal tl, tr, con;
+ static doublereal uold;
+
+/* THIS SUBROUTINE PERFORMS A TEST TO SEE IF THE ITERATIVE */
+/* METHOD HAS CONVERGED TO A SOLUTION INSIDE THE ERROR */
+/* TOLERANCE, ZETA. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF SYSTEM */
+/* U PRESENT SOLUTION ESTIMATE */
+/* DNRM INNER PRODUCT OF PSEUDO-RESIDUALS AT PRECEDING */
+/* ITERATION */
+/* CON STOPPING TEST PARAMETER (= CCON) */
+/* IFLAG STOPPING TEST INTEGER FLAG */
+/* IFLAG = 0, SOR ITERATION ZERO */
+/* IFLAG = 1, NON-RS METHOD */
+/* IFLAG = 2, RS METHOD */
+/* Q1 STOPPING TEST LOGICAL FLAG */
+
+ con = *ccon;
+ itcom2_1.halt = FALSE_;
+
+ /* SPECIAL PROCEDURE FOR ZEROTH ITERATION */
+
+ if (itcom1_1.in < 1) {
+ *q1 = FALSE_;
+ itcom3_1.udnm = 1.;
+ itcom3_1.stptst = 1e3;
+ if (*iflag <= 0)
+ return 0;
+ }
+
+ /* ... TEST IF UDNM NEEDS TO BE RECOMPUTED */
+
+ if (!*q1 && (itcom1_1.in <= 5 || itcom1_1.in % 5 == 0)) {
+ uold = itcom3_1.udnm;
+ itcom3_1.udnm = itpackddot_(n, u, &c__1, u, &c__1);
+ if (itcom3_1.udnm == 0.)
+ itcom3_1.udnm = 1.;
+
+ if (itcom1_1.in > 5 && abs(itcom3_1.udnm - uold) <= itcom3_1.udnm * itcom3_1.zeta)
+ *q1 = TRUE_;
+ }
+
+ /* ... COMPUTE STOPPING TEST */
+
+ tr = sqrt(itcom3_1.udnm);
+ tl = 1.;
+ if (con == 1.)
+ goto L40;
+
+ if (*iflag != 2) {
+ tl = sqrt(*dnrm);
+ tr *= 1. - con;
+ }
+ else {
+ tl = sqrt(*dnrm * 2.);
+ tr *= 1. - con * con;
+ }
+L40:
+ itcom3_1.stptst = tl / tr;
+ if (tl >= tr * itcom3_1.zeta)
+ return 0;
+
+ itcom2_1.halt = TRUE_;
+
+ return 0;
+} /* pstop_ */
+
+doublereal pvtbv_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *v)
+{
+ /* Local variables */
+ static integer ii, jj;
+ static doublereal sum;
+ static integer jajj, ibgn, iend;
+ static doublereal sumr;
+
+/* THIS FUNCTION COMPUTES (V**T)*A*V. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* V D.P. VECTOR OF LENGTH N */
+
+ sum = 0.;
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (ibgn >= iend)
+ continue;
+
+ sumr = 0.;
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ sumr -= a[jj] * v[jajj];
+ }
+ sum += v[ii] * sumr;
+ }
+
+ if (itcom1_1.isym == 0)
+ sum *= 2.;
+
+ return sum;
+} /* pvtbv_ */
+
+/* Subroutine */
+int sbagn_(integer *n, integer *nz, integer *ia, integer *ja, doublereal *a,
+ integer *iwork, integer *level, integer *nout, integer* ierr)
+{
+ /* Local variables */
+ static integer i, j, ier, ntn, nto, now, nadd;
+
+ (void)level; (void)nout;
+/* ... THE ROUTINES SBINI, SBSIJ, AND SBEND CREATE A SPARSE */
+/* MATRIX STRUCTURE BY MEANS OF A LINKED LIST WHICH IS */
+/* DESTROYED BY SBEND. SBAGN CREATES A NEW LINKED LIST */
+/* SO THAT ELEMENTS MAY BE ADDED TO THE MATRIX AFTER SBEND */
+/* HAS BEEN CALLED. SBAGN SHOULD BE CALLED WITH THE APPRO- */
+/* PRIATE PARAMETERS, AND THEN SBSIJ AND SBEND CAN BE CALLED */
+/* TO ADD THE ELEMENTS AND COMPLETE THE SPARSE MATRIX STRUC- */
+/* TURE. */
+
+/* ... PARAMETER LIST: */
+
+/* N ORDER OF THE SYSTEM */
+/* NZ MAXIMUM NUMBER OF NON-ZERO ELEMENTS */
+/* IN THE SYSTEM */
+/* IA, JA INTEGER ARRAYS OF THE SPARSE */
+/* MATRIX STRUCTURE */
+/* A D.P. ARRAY OF THE SPARSE MATRIX */
+/* STRUCTURE */
+/* IWORK WORK ARRAY OF DIMENSION NZ */
+/* LEVEL OUTPUT LEVEL CONTROL (= LEVELL) */
+/* NOUT OUTPUT FILE NUMBER */
+/* IER ERROR FLAG (= IERR). POSSIBLE RETURNS ARE */
+/* IER = 0, SUCCESSFUL COMPLETION */
+/* = 703, NZ TOO SMALL - NO MORE */
+/* ELEMENTS CAN BE ADDED */
+
+ now = ia[*n] - 1;
+ nadd = *nz - now;
+ ier = 0;
+ if (nadd <= 0)
+ ier = 703;
+
+ if (ier != 0)
+ goto L90;
+
+ /* ... SHIFT ELEMENTS OF A AND JA DOWN AND ADD ZERO FILL */
+
+ nto = now;
+ ntn = *nz;
+ for (i = 0; i < now; ++i) {
+ --nto; --ntn;
+ ja[ntn] = ja[nto];
+ a[ntn] = a[nto];
+ }
+ for (i = 0; i < nadd; ++i) {
+ ja[i] = 0;
+ a[i] = 0.;
+ }
+
+ /* ... UPDATE IA TO REFLECT DOWNWARD SHIFT IN A AND JA */
+
+ for (i = 0; i <= *n; ++i)
+ ia[i] += nadd;
+
+ /* ... CREATE LINKED LIST */
+
+ for (i = nadd; i < *nz; ++i)
+ iwork[i] = i + 2;
+
+ for (i = 0; i < nadd; ++i)
+ iwork[i] = 0;
+
+ for (i = 0; i < *n; ++i) {
+ j = ia[i + 1] - 2;
+ iwork[j] = -i - 1;
+ }
+
+ /* ... INDICATE IN LAST POSITION OF IA HOW MANY SPACES */
+ /* ARE LEFT IN A AND JA FOR ADDITION OF ELEMENTS */
+
+ ia[*n] = nadd;
+ return 0;
+
+ /* ... ERROR RETURN */
+
+L90:
+ *ierr = ier;
+ return 0;
+} /* sbagn_ */
+
+/* Subroutine */
+int sbelm_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, integer *iw,
+ doublereal *rw, doublereal *tol, integer *isym, integer *level, integer *nout, integer *ier)
+{
+ /* Local variables */
+ static doublereal di;
+ static integer ii, jj, kk, ibgn, iend, jjdi, icnt;
+
+ (void)level; (void)nout;
+/* ... SBELM IS DESIGNED TO REMOVE ROWS AND COLUMNS OF THE MATRIX */
+/* ... WHERE DABS(A(I,J))/A(I,I) .LE. TOL FOR J = 1 TO N AND A(I,I) */
+/* ... .GT. 0. THIS IS TO TAKE CARE OF MATRICES ARISING */
+/* ... FROM FINITE ELEMENT DISCRETIZATIONS OF PDE^S WITH DIRICHLET */
+/* ... BOUNDARY CONDITIONS. ANY SUCH ROWS AND CORRESPONDING COLUMNS */
+/* ... ARE THEN SET TO THE IDENTITY AFTER CORRECTING RHS. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+/* IW,RW WORK ARRAYS OF LENGTH N */
+/* TOL TOLERANCE FACTOR */
+/* ISYM FLAG FOR TYPE OF STORAGE FOR SYSTEM */
+/* (0: SYMMETRIC, 1:NONSYMMETRIC) */
+/* LEVEL PRINTING SWITCH FOR ERROR CONDITION */
+/* NOUT OUTPUT TAPE NUMBER */
+/* IER ERROR FLAG: NONZERO VALUE ON RETURN MEANS */
+/* 101 : DIAGONAL ENTRY NOT POSITIVE */
+/* 102 : THERE IS NO DIAGONAL ENTRY IN ROW */
+
+/* ********************************************************************** */
+
+/* UPDATE. SBELM HAS BEEN REWRITTEN TO SPEED UP THE LOCATION OF */
+/* OF ROWS WHICH ARE TO BE ELIMINATED. THIS IS DONE BY */
+/* FIRST STORING THE LARGEST ELEMENT OF EACH ROW IN */
+/* THE ARRAY RW. THE DIAGONAL ENTRY IS THEN COMPARED */
+/* WITH THE CORRESPONDING ELEMENT IN RW. IF IT IS */
+/* DECIDED TO ELIMINATE THE ROW THEN IT IS MARKED FOR */
+/* ELIMINATION. */
+
+/* WHEN A ROW IS TO BE ELIMINATED ITS DIAGONAL ENTRY */
+/* IS STORED IN RW AND IW IS MARKED BY A NONZERO */
+/* (WHICH IS THIS ROW NUMBER) */
+
+/* ROWS WHICH HAVE ONLY DIAGONAL ENTRIES ARE NOT */
+/* ALTERED. */
+
+/* ********************************************************************* */
+
+ /* IF (N .GE. 1) GO TO 10 */
+ /* IER = 100 */
+ /* RETURN */
+ /* 10 CONTINUE */
+
+ /* ... STORE THE LARGEST (DABSOLUTE VALUE) OFF DIAGONAL ENTRY FOR */
+ /* ... ROW II IN RW(II). */
+
+ *ier = 0;
+ icnt = 0;
+ for (ii = 0; ii < *n; ++ii) {
+ rw[ii] = 0.;
+ iw[ii] = 0;
+ }
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (ibgn >= iend)
+ goto L140;
+
+ for (jj = ibgn; jj < iend; ++jj) {
+ kk = ja[jj] - 1;
+ if (kk == ii)
+ continue;
+
+ rw[ii] = max(rw[ii],abs(a[jj]));
+ if (*isym != 0)
+ continue;
+
+ rw[kk] = max(rw[kk],abs(a[jj]));
+ }
+ }
+
+ /* ... FOR II = 1 TO N FIND THE DIAGONAL ENTRY IN ROW II */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ for (jj = ibgn; jj < iend; ++jj) {
+ if (ja[jj] != ii + 1)
+ continue;
+
+ di = a[jj];
+ jjdi = jj + 1;
+ if (di > 0.)
+ goto L50;
+
+ *ier = 101;
+ return 0;
+ }
+ goto L140;
+L50:
+
+ /* ... CHECK THE SIZE OF THE LARGEST OFF DIAGONAL ELEMENT */
+ /* ... ( STORED IN RW(II) ) AGAINST THE DIAGONAL ELEMENT DII. */
+
+ if (rw[ii] == 0.) {
+ if (1. / di > *tol)
+ continue;
+ }
+ else if (rw[ii] / di > *tol)
+ continue;
+
+ /* ... THE OFF DIAGONAL ELEMENTS ARE SMALL COMPARED TO THE DIAGONAL */
+ /* ... THEREFORE MARK IT FOR ELIMINATION AND PERFORM INITIAL PROCESSING */
+
+ ++icnt;
+ iw[ii] = ii + 1;
+ rw[ii] = di;
+ a[jjdi - 1] = 1.;
+ rhs[ii] /= di;
+ }
+
+ /* ... ELIMINATE THE ROWS AND COLUMNS INDICATED BY THE NONZERO */
+ /* ... ENTRIES IN IW. THERE ARE ICNT OF THEM */
+
+ if (icnt == 0)
+ return 0;
+
+ /* ... THE ELIMINATION IS AS FOLLOWS: */
+
+ /* FOR II = 1 TO N DO */
+ /* IF ( IW(II) .NE. 0 ) THEN */
+ /* SET DIAGONAL VALUE TO 1.0 ( ALREADY DONE ) */
+ /* SET RHS(II) = RHS(II) / RW(II) ( ALREADY DONE ) */
+ /* FIND NONZERO OFFDIAGONAL ENTRIES KK */
+ /* IF ( IW(KK) .EQ. 0 ) FIX UP RHS(KK) WHEN USING SYMMETRIC ST */
+ /* SET A(II,KK) = 0.0 */
+ /* ELSE ( I.E. IW(II) .EQ. 0 ) */
+ /* FIND NONZERO OFFDIAGONAL ENTRIES KK */
+ /* IF ( IW(KK) .NE. 0 ) FIX UP RHS(II) */
+ /* AND SET A(II,KK) = 0.0 */
+ /* END IF */
+ /* END DO */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ if (iw[ii] == 0)
+ goto L100;
+
+ /* ... THE II-TH ROW IS TO BE ELIMINATED */
+
+ for (jj = ibgn; jj < iend; ++jj) {
+ kk = ja[jj] - 1;
+ if (kk == ii)
+ continue;
+
+ if (iw[kk] == 0 && *isym == 0)
+ rhs[kk] -= a[jj] * rhs[ii];
+
+ a[jj] = 0.;
+ }
+ continue;
+
+ /* ... THE II-TH ROW IS KEPT. CHECK THE OFF-DIAGONAL ENTRIES */
+
+L100:
+ for (jj = ibgn; jj < iend; ++jj) {
+ kk = ja[jj] - 1;
+ if (kk != ii && iw[kk] != 0) {
+ rhs[ii] -= a[jj] * rhs[kk];
+ a[jj] = 0.;
+ }
+ }
+ }
+
+ return 0;
+
+ /* ... ERROR TRAPS -- NO DIAGONAL ENTRY IN ROW II (ROW MAY BE EMPTY). */
+
+L140:
+ *ier = 102;
+
+ return 0;
+} /* sbelm_ */
+
+/* Subroutine */
+int sbend_(integer *n, integer *nz, integer *ia, integer *ja, doublereal *a, integer *iwork)
+{
+ /* Local variables */
+ static integer i, l, jaj;
+ static doublereal val;
+ static integer top, ideg, link, next, hlink, mhlink, ohlink, nulink, maxtop;
+
+/* *********************************************************************** */
+
+/* SBEND IS THE THIRD OF A SUITE OF SUBROUTINES TO AID THE */
+/* USER TO CONSTRUCT THE IA, JA, A DATA STRUCTURE USED IN */
+/* ITPACK. */
+
+/* SBEND RESTRUCTURES THE LINKED LIST DATA STRUCTURE BUILT BY */
+/* SBINI AND SBSIJ INTO THE FINAL DATA STRUCTURE REQUIRE BY */
+/* ITPACK. THE RESTRUCTURING CAN TAKE PLACE IN THE MINIMUM */
+/* AMOUNT OF MEMORY REQUIRED TO HOLD THE NONZERO STRUCTURE OF */
+/* THE SPARSE MATRIX BUT WILL RUN QUICKER IF MORE STORAGE */
+/* IS ALLOWED. */
+
+/* SBEND IS BASED ON SUBROUTINE BUILD OF THE SPARSE MATRIX */
+/* PACKAGE SPARSPAK DEVELOPED BY ALAN GEORGE AND JOSEPH LUI */
+/* OF THE UNIVERSITY OF WATERLOO, WATERLOO, ONTARIO. */
+
+/* ... PARAMETERS */
+
+/* ...... INPUT */
+
+/* N THE ORDER OF THE LINEAR SYSTEM */
+
+/* NZ THE LENGTH OF THE ARRAYS JA, IWORK, AND A. */
+
+/* ...... INPUT/OUTPUT */
+
+/* IA INTEGER ARRAY OF LENGTH N+1. THE FIRST N ENTRIES */
+/* POINT TO THE BEGINNING OF THE LINKED LIST FOR EACH */
+/* ROW. IA(N+1)-1 IS THE TOP OF THE LINKED LISTS */
+/* CONTAINED IN JA, IWORK, AND A. ON OUTPUT IA WILL */
+/* POINT TO THE FIRST ENTRY OF EACH ROW IN THE FINAL */
+/* DATA STRUCTURE. */
+
+/* JA INTEGER ARRAY OF LENGTH NZ. ON INPUT JA STORES THE */
+/* COLUMN NUMBERS OF THE NONZERO ENTRIES AS INDICATED */
+/* BY THE LINKED LISTS. ON OUTPUT JA STORES THE */
+/* COLUMN NUMBERS IN ROW ORDERED FORM. */
+
+/* A D.P. ARRAY OF LENGTH NZ. ON INPUT A STORES THE */
+/* VALUE OF THE NOZERO ENTRIES AS INDICATED BY THE */
+/* LINKED LISTS. ON OUTPUT A STORES THE VALUES IN */
+/* ROW ORDERED FORM. */
+
+/* IWORK INTEGER ARRAY OF LENGTH NZ. ON INPUT IWORK STORES THE */
+/* THE LINKS OF THE LINKED LISTS. ON OUTPUT IT IS */
+/* DESTROYED. */
+
+/* *********************************************************************** */
+
+ /* ... INITIALIZATION */
+
+ /* ...... THE VARIABLES NEXT AND TOP RESPECTIVELY POINT TO THE */
+ /* NEXT AVAILABLE ENTRY FOR THE FINAL DATA STRUCTURE AND */
+ /* THE TOP OF THE REMAINDER OF THE LINKED LISTS. */
+
+ next = 0;
+ top = ia[*n];
+ maxtop = *nz - ia[*n];
+
+ /* *********************************************************************** */
+
+ /* ... CONVERT EACH ROW INTO FINAL FORM */
+
+ for (i = 0; i < *n; ++i) {
+ ideg = 0;
+ nulink = ia[i] - 1;
+
+ /* ... LOOP OVER EACH NODE IN THE LINKED LIST OF ROW I */
+
+L10:
+ link = nulink;
+ if (link < 0)
+ goto L80;
+
+ nulink = iwork[link] - 1;
+ jaj = ja[link];
+ val = a[link];
+
+ /* ... CHECK TO SEE IF A COLLISION BETWEEN THE LINKED LISTS */
+ /* AND THE FINAL FORM HAS OCCURRED. */
+
+ if (next >= top && link != top)
+ goto L20;
+
+ /* ... COLLISION HAS NOT OCCURRED. FREE THE SPACE FOR THE TRIPLE */
+ /* (JA(LINK), A(LINK), IWORK(LINK)) */
+
+ ja[link] = 0;
+ a[link] = 0.;
+ iwork[link] = 0;
+
+ /* ... SPECIAL CASE TO MOVE TOP DOWN IF LINK .EQ. TOP */
+
+ if (link == top)
+ goto L60;
+
+ goto L70;
+
+ /* *********************************************************************** */
+
+ /* ... COLLISION HAS OCCURRED. CLEAR OFF SOME SPACE FOR THE CURRENT */
+ /* ENTRY BY MOVING THE TRIPLE ( JA(TOP),A(TOP),IWORK(TOP) ) */
+ /* DOWNWARDS TO THE FREED TRIPLE ( JA(LINK),A(LINK),IWORK(LINK) ). */
+ /* THEN ADJUST THE LINK FIELDS. */
+
+ /* ...... PATCH UP THE LINKED LIST FOR THE CURRENT ROW I. THEN */
+ /* TRAVERSE THE LINKED LIST CONTAINING TOP UNTIL THE POINTER */
+ /* POINTER BACK TO IA IS FOUND. */
+
+L20:
+ ia[i] = link + 1;
+ hlink = top;
+
+L30:
+ hlink = iwork[hlink] - 1;
+ if (hlink >= 0)
+ goto L30;
+
+ /* ...... NOW FOLLOW THE LINKED LIST BACK TO TOP KEEPING TRACK */
+ /* OF THE OLD LINK. */
+
+ /* ......... SPECIAL CASE IF IA(-HLINK) = TOP */
+
+ mhlink = -hlink - 2;
+ if (ia[mhlink] != top + 1)
+ goto L40;
+
+ iwork[link] = iwork[top];
+ ja[link] = ja[top];
+ a[link] = a[top];
+ ia[mhlink] = link + 1;
+ if (nulink == top)
+ nulink = link;
+
+ goto L60;
+
+ /* ......... USUAL CASE. */
+
+L40:
+ hlink = ia[mhlink] - 1;
+L50:
+ ohlink = hlink;
+ hlink = iwork[ohlink] - 1;
+ if (hlink != top)
+ goto L50;
+
+ iwork[link] = iwork[top];
+ ja[link] = ja[top];
+ a[link] = a[top];
+ if (ohlink != link)
+ iwork[ohlink] = link + 1;
+
+ if (nulink == top)
+ nulink = link;
+
+ /* ... COLLAPSE TOP OF LINK LIST BY AS MUCH AS POSSIBLE */
+
+L60:
+ while (++top < maxtop && iwork[top] == 0) ;
+
+ /* *********************************************************************** */
+
+ /* ... PUT THE CURRENT TRIPLE INTO THE FINAL DATA STRUCTURE */
+
+L70:
+ ja[next] = jaj;
+ a[next] = val;
+ ++next;
+ ++ideg;
+ goto L10;
+
+ /* ... FINAL STRUCTURE FOR ROW I IS COMPLETE. LINKED LIST IS */
+ /* DESTROYED AND WILL BE RECAPTURED AS NECESSARY BY THE */
+ /* LOOP ON LABEL 60 */
+
+L80:
+ ia[i] = ideg;
+ }
+
+ /* *********************************************************************** */
+
+ /* ... FINALIZE THE DATA STRUCTURE BY BUILDING THE FINAL VERSION OF */
+ /* IA. */
+
+ l = ia[0] + 1;
+ ia[0] = 1;
+ for (i = 0; i < *n; ++i) {
+ ideg = ia[i + 1];
+ ia[i + 1] = l;
+ l += ideg;
+ }
+
+ /* ... FINAL IA, JA, A DATA STRUCTURE BUILT. */
+
+ return 0;
+} /* sbend_ */
+
+/* Subroutine */
+int sbini_(integer *n, integer *nz, integer *ia, integer *ja, doublereal *a, integer *iwork)
+{
+ /* Local variables */
+ static integer i;
+
+/* *********************************************************************** */
+
+/* SBINI IS THE FIRST OF A SUITE OF THREE SUBROUTINES TO AID */
+/* THE USER TO CONSTRUCT THE IA, JA, A DATA STRUCTURE USED */
+/* IN ITPACK. */
+
+/* SBINI INITIALIZES THE ARRAYS IA, JA, IWORK, AND A. THE OTHER */
+/* SUBROUTINES IN THE SUITE ARE SBSIJ ( WHICH BUILDS A LINKED */
+/* LIST REPRESENTATION OF THE MATRIX STRUCTURE ) AND SBEND ( WHICH */
+/* RESTRUCTURE THE LINKED LIST FORM INTO THE FINAL FORM ). */
+
+/* ... PARAMETERS */
+
+/* ...... INPUT */
+
+/* N THE ORDER OF THE LINEAR SYSTEM */
+
+/* NZ THE MAXIMUM NUMBER OF NONZEROES ALLOWED IN THE */
+/* LINEAR SYSTEM. */
+
+/* ...... OUTPUT */
+
+/* IA INTEGER ARRAY OF LENGTH N+1. SBINI SETS THIS ARRAY */
+/* TO -I FOR I = 1 THRU N. IA(N+1) IS SET TO NZ. */
+
+/* JA INTEGER ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE. */
+
+/* A D.P. ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE. */
+
+/* IWORK INTEGER ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE. */
+
+/* *********************************************************************** */
+
+ for (i = 0; i < *n; ++i)
+ ia[i] = -i - 1;
+
+ ia[*n] = *nz;
+
+ ivfill_(nz, ja, &c__0);
+ ivfill_(nz, iwork, &c__0);
+ vfill_(nz, a, &c_b21);
+
+ return 0;
+} /* sbini_ */
+
+/* Subroutine */
+int sbsij_(integer *n, integer *nz, integer *ia, integer *ja, doublereal *a,
+ integer *iwork, integer *ii, integer *jj, doublereal * vall,
+ integer *mode, integer *level, integer *nout, integer* ierr)
+{
+ /* Local variables */
+ static integer i, j, ier;
+ static doublereal val;
+ static integer link;
+ static doublereal temp;
+ static integer next;
+
+ (void)nz; (void)level; (void)nout;
+
+/* *********************************************************************** */
+
+/* SBSIJ IS THE SECOND OF A SUITE OF THREE SUBROUTINES TO AID IN */
+/* THE CONSTRUCTION OF THE IA, JA, A DATA STRUCTURE USED IN */
+/* ITPACK. */
+
+/* SBSIJ TAKES THE INDIVIDUAL ENTRIES OF THE SPARSE MATRIX AS */
+/* GIVEN TO IT AT EACH CALL VIA (I,J,VAL) AND INSERTS IT INTO */
+/* A LINKED LIST REPRESENTATION OF THE SPARSE MATRIX. */
+
+/* EACH ROW OF THE SPARSE MATRIX IS ASSOCIATED WITH A CIRCULAR */
+/* LINKED LIST BEGINNING AT IA(I). THE LAST ENTERED ELEMENT IN */
+/* EACH LIST POINTS BACK TO IA(I) WITH THE VALUE -I. THE LINKS */
+/* ARE STORED IN THE ARRAY IWORK, WHILE JA AND A STORE THE COLUMN */
+/* NUMBER AND VALUE IN PARALLEL TO IWORK. THE LINKED LISTED ARE */
+/* STORED BEGINNING AT ENTRY NZ AND WORKING BACKWARDS TOWARDS 1. */
+
+/* ... PARAMETERS */
+
+/* ...... INPUT */
+
+/* N THE ORDER OF THE LINEAR SYSTEM */
+
+/* NZ THE LENGTH OF THE ARRAYS JA, A, AND IWORK */
+
+/* I, J THE ROW AND COLUMN NUMBERS OF THE ENTRY OF THE SPARSE */
+/* LINEAR SYSTEM TO BE ENTERED IN THE DATA STRUCTURE(=II,JJ) */
+
+/* VAL THE NONZERO VALUE ASSOCIATED WITH (I,J) (= VALL) */
+
+/* MODE IF THE (I,J) ENTRY HAS ALREADY BEEN SET, MODE SPECIFIES */
+/* THE WAY IN WHICH THE ENTRY IS TO BE TREATED. */
+/* IF MODE .LT. 0 LET THE VALUE REMAIN AS IS */
+/* .EQ. 0 RESET IT TO THE NEW VALUE */
+/* .GT. 0 ADD THE NEW VALUE TO THE OLD VALUE */
+
+/* NOUT OUTPUT FILE NUMBER */
+
+/* LEVEL OUTPUT FILE SWITCH */
+
+/* ... INPUT/OUTPUT */
+
+/* IA INTEGER ARRAY OF LENGTH N+1. THE FIRST N ENTRIES */
+/* POINT TO THE BEGINNING OF THE LINKED LIST FOR EACH */
+/* ROW. IA(N+1) POINTS TO THE NEXT ENTRY AVAILABLE FOR */
+/* STORING THE CURRENT ENTRY INTO THE LINKED LIST. */
+
+/* JA INTEGER ARRAY OF LENGTH NZ. JA STORES THE COLUMN */
+/* NUMBERS OF THE NONZERO ENTRIES. */
+
+/* A D.P. ARRAY OF LENGTH NZ. A STORES THE VALUE OF THE */
+/* NONZERO ENTRIES. */
+
+/* IWORK INTEGER ARRAY OF LENGTH NZ. IWORK STORES THE LINKS. */
+
+/* IER ERROR FLAG.(= IERR) POSSIBLE RETURNS ARE */
+/* IER = 0 SUCCESSFUL COMPLETION */
+/* = 700 ENTRY WAS ALREADY SET, VALUE HANDLED */
+/* AS SPECIFIED BY MODE. */
+/* = 701 IMPROPER VALUE OF EITHER I OR J INDEX */
+/* = 702 NO ROOM REMAINING, NZ TOO SMALL. */
+
+/* *********************************************************************** */
+
+ /* ... CHECK THE VALIDITY OF THE (I,J) ENTRY */
+
+ i = *ii - 1;
+ j = *jj - 1;
+ val = *vall;
+ ier = 0;
+ if (i < 0 || i >= *n)
+ ier = 701;
+
+ if (j < 0 || j >= *n)
+ ier = 701;
+
+ if (ier != 0)
+ goto L130;
+
+ /* ... TRAVERSE THE LINK LIST POINTED TO BY IA(I) UNTIL EITHER */
+ /* ... THE J ENTRY OR THE END OF THE LIST HAS BEEN FOUND. */
+
+ link = ia[i] - 1;
+
+ /* ...... SPECIAL CASE FOR THE FIRST ENTRY IN THE ROW */
+
+ if (link >= 0)
+ goto L30;
+
+ next = ia[*n] - 1;
+ if (next < 0)
+ goto L110;
+
+ ia[i] = next + 1;
+ ja[next] = j + 1;
+ a[next] = val;
+ iwork[next] = -i - 1;
+ ia[*n] = next;
+ goto L130;
+
+ /* ... FOLLOW THE LINK LIST UNTIL J OR THE END OF THE LIST IS FOUND */
+
+L30:
+ if (ja[link] == j + 1)
+ goto L40;
+
+ if (iwork[link] <= 0)
+ goto L100;
+
+ link = iwork[link] - 1;
+ goto L30;
+
+ /* : */
+ /* ... ENTRY (I,J) ALREADY HAS BEEN SET. RESET VALUE DEPENDING ON MODE */
+
+L40:
+ ier = 700;
+ if (*mode < 0)
+ goto L130;
+
+ if (*mode < 1) {
+ a[link] = val;
+ goto L130;
+ }
+ temp = a[link] + val;
+ a[link] = temp;
+ goto L130;
+
+ /* ... ENTRY (I,J) HAS NOT BEEN SET. ENTER IT INTO THE LINKED LIST */
+
+L100:
+ next = ia[*n] - 1;
+ if (next >= 0) {
+ iwork[link] = next + 1;
+ ja[next] = j + 1;
+ a[next] = val;
+ iwork[next] = -i - 1;
+ ia[*n] = next;
+ goto L130;
+ }
+
+ /* *********************************************************************** */
+
+ /* ... ERROR TRAP FOR NO ROOM REMAINING */
+
+L110:
+ ier = 702;
+
+L130:
+ *ierr = ier;
+ return 0;
+} /* sbsij_ */
+
+/* Subroutine */
+int scal_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs,
+ doublereal *u, doublereal *d, integer *level, integer *nout, integer *ier)
+{
+ /* Local variables */
+ static integer i, j;
+ static doublereal di;
+ static integer ii, jj, im1, jadd, jajj, ibgn, iend, jjpi;
+
+ (void)level; (void)nout;
+/* ... ORIGINAL MATRIX IS SCALED TO A UNIT DIAGONAL MATRIX. RHS */
+/* ... AND U ARE SCALED ACCORDINGLY. THE MATRIX IS THEN SPLIT AND */
+/* ... IA, JA, AND A RESHUFFLED. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* D OUTPUT VECTOR CONTAINING THE SQUARE ROOTS */
+/* OF THE DIAGONAL ENTRIES */
+/* LEVEL PRINTING SWITCH FOR ERROR CONDITION */
+/* NOUT OUTPUT TAPE NUMBER */
+/* IER ERROR FLAG: ON RETURN NONZERO VALUES MEAN */
+/* 401 : THE ITH DIAGONAL ELEMENT IS .LE. 0. */
+/* 402 : NO DIAGONAL ELEMENT IN ROW I */
+
+ /* ... EXTRACT SQUARE ROOT OF THE DIAGONAL OUT OF A AND SCALE U AND RHS */
+
+ *ier = 0;
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ for (jj = ibgn; jj < iend; ++jj) {
+ if (ja[jj] != ii + 1)
+ continue;
+
+ di = a[jj];
+ if (di > 0.)
+ goto L70;
+
+ if (di != 0.) {
+ *ier = 401;
+ return 0;
+ }
+ *ier = 401;
+ return 0;
+ }
+ *ier = 402;
+ return 0;
+
+L70:
+ di = sqrt((abs(di)));
+ rhs[ii] /= di;
+ u[ii] *= di;
+ d[ii] = di;
+ }
+
+ /* ... SHIFT MATRIX TO ELIMINATE DIAGONAL ENTRIES */
+
+ if (*n > 1)
+ for (i = 0; i < *n; ++i) {
+ im1 = i;
+ ii = *n - i - 1;
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ jadd = ibgn + iend + 1;
+ for (j = ibgn; j < iend; ++j) {
+ jj = jadd - j - 2;
+ jjpi = jj + im1;
+ if (ja[jj] == ii + 1)
+ im1 = i + 1;
+
+ a[jjpi] = a[jj];
+ ja[jjpi] = ja[jj];
+ }
+ ia[ii + 1] = ia[ii + 1] + i;
+ }
+
+ ia[0] += *n;
+
+ /* ... SCALE SHIFTED MATRIX AND STORE D ARRAY IN FIRST N ENTRIES OF A */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ di = d[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj] - 1;
+ a[jj] /= di * d[jajj];
+ }
+ a[ii] = di;
+ }
+
+ return 0;
+} /* scal_ */
+
+/* Subroutine */
+int sum3_(integer *n, doublereal *c1, doublereal *x1, doublereal *c2, doublereal *x2, doublereal *c3, doublereal *x3)
+{
+ /* Local variables */
+ static integer i;
+
+/* ... COMPUTES X3 = C1*X1 + C2*X2 + C3*X3 */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTORS X1, X2, X3 */
+/* C1,C2,C3 D.P. CONSTANTS */
+/* X1,X2,X3 D.P. VECTORS SUCH THAT */
+/* X3(I) = C1*X1(I) + C2*X2(I) + C3*X3(I) */
+/* X3(I) = C1*X1(I) + C2*X2(I) IF C3 = 0. */
+
+ if (*n <= 0)
+ return 0;
+
+ if (*c3 != 0.) {
+ for (i = 0; i < *n; ++i)
+ x3[i] = *c1 * x1[i] + *c2 * x2[i] + *c3 * x3[i];
+ return 0;
+ }
+
+ for (i = 0; i < *n; ++i)
+ x3[i] = *c1 * x1[i] + *c2 * x2[i];
+
+ return 0;
+} /* sum3_ */
+
+doublereal tau_(integer *ii)
+{
+ /* Initialized data */
+ static doublereal t[8] = { 1.5,1.8,1.85,1.9,1.94,1.96,1.975,1.985 };
+
+/* ... THIS SUBROUTINE SETS TAU(II) FOR THE SOR METHOD. */
+
+ /* II NUMBER OF TIMES PARAMETERS HAVE BEEN CHANGED */
+
+ if (*ii <= 8)
+ return t[*ii - 1];
+ else
+ return 1.992;
+} /* tau_ */
+
+doublereal timer_(real* dummy)
+{
+/* ... TIMER IS A ROUTINE TO RETURN THE EXECUTION TIME IN SECONDS. */
+
+/* ********************************************* */
+/* ** ** */
+/* ** THIS ROUTINE IS NOT PORTABLE. ** */
+/* ** ** */
+/* ********************************************* */
+
+ (void)dummy;
+ return (doublereal)time(0L);
+} /* timer_ */
+
+logical tstchg_(integer *ibmth)
+{
+ /* Local variables */
+ static integer ip;
+
+/* THIS FUNCTION PERFORMS A TEST TO DETERMINE IF PARAMETERS */
+/* SHOULD BE CHANGED FOR SEMI-ITERATION ACCELERATED METHODS. */
+
+/* ... PARAMETER LIST: */
+
+/* IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI */
+/* IBMTH = 1, JACOBI */
+/* = 2, REDUCED SYSTEM */
+/* = 3, SSOR */
+
+ ip = itcom1_1.in - itcom1_1.is;
+ if (*ibmth == 2)
+ ip <<= 1;
+
+ if (itcom1_1.in == 0)
+ goto L10;
+
+ if (ip < 3)
+ goto L20;
+
+ itcom3_1.qa = sqrt(abs(itcom3_1.delnnm / itcom3_1.delsnm));
+ itcom3_1.qt = sqrt(abs(pow_di(&itcom3_1.rrr, &ip))) * 2. / (pow_di(&itcom3_1.rrr, &ip) + 1.);
+ if (itcom3_1.qa >= 1. || itcom3_1.qa < pow_dd(&itcom3_1.qt, &itcom3_1.ff))
+
+ goto L20;
+
+ /* ... TEST PASSES -- CHANGE PARAMETERS */
+
+L10:
+ return TRUE_;
+
+ /* ... TEST FAILS -- DO NOT CHANGE PARAMETERS */
+
+L20:
+ return FALSE_;
+} /* tstchg_ */
+
+/* Subroutine */
+int unscal_(integer *n, integer *ia, integer *ja, doublereal *a, doublereal *rhs, doublereal *u, doublereal *d)
+{
+ /* Local variables */
+ static doublereal di;
+ static integer ii, jj, is, jajj, ibgn, iend, jjpi, inew;
+
+/* ... THIS SUBROUTINE REVERSES THE PROCESS OF SCAL. */
+
+/* ... PARAMETER LIST: */
+
+/* N DIMENSION OF MATRIX */
+/* IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION */
+/* A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION */
+/* RHS RIGHT HAND SIDE OF MATRIX PROBLEM */
+/* U LATEST ESTIMATE OF SOLUTION */
+/* D VECTOR CONTAINING THE SQUARE ROOTS */
+/* OF THE DIAGONAL ENTRIES */
+
+ /* ... EXTRACT DIAGONAL FROM SCALED A AND UNSCALE U AND RHS */
+
+ for (ii = 0; ii < *n; ++ii) {
+ di = a[ii];
+ u[ii] /= di;
+ rhs[ii] *= di;
+ d[ii] = di;
+ }
+
+ /* ... UNSCALE A */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ di = d[ii];
+ for (jj = ibgn; jj < iend; ++jj) {
+ jajj = ja[jj];
+ a[jj] *= di * d[jajj-1];
+ }
+ }
+
+ /* ... INSERT DIAGONAL BACK INTO A */
+
+ for (ii = 0; ii < *n; ++ii) {
+ ibgn = ia[ii] - 1;
+ iend = ia[ii + 1] - 1;
+ is = *n - ii - 1;
+ inew = ibgn - is - 1;
+ a[inew] = d[ii] * d[ii];
+ ja[inew] = ii + 1;
+ if (is != 0)
+ for (jj = ibgn; jj < iend; ++jj) {
+ jjpi = jj - is;
+ a[jjpi] = a[jj];
+ ja[jjpi] = ja[jj];
+ }
+ ia[ii] = inew + 1;
+ }
+
+ return 0;
+} /* unscal_ */
+
+/* Subroutine */
+int vevmw_(integer *n, doublereal *v, doublereal *w)
+{
+ /* Local variables */
+ static integer i, m;
+
+/* ... VEVMW COMPUTES V = V - W */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTORS V AND W */
+/* V D.P. VECTOR */
+/* W D.P. VECTOR SUCH THAT V(I) = V(I) - W(I) */
+
+ if (*n <= 0)
+ return 0;
+
+ m = *n % 4;
+
+ for (i = 0; i < m; ++i)
+ v[i] -= w[i];
+
+ for (i = m; i < *n; i += 4) {
+ v[i] -= w[i];
+ v[i + 1] -= w[i + 1];
+ v[i + 2] -= w[i + 2];
+ v[i + 3] -= w[i + 3];
+ }
+ return 0;
+} /* vevmw_ */
+
+/* Subroutine */
+int vevpw_(integer *n, doublereal *v, doublereal *w)
+{
+ /* Local variables */
+ static integer i, m;
+
+/* ... VPW COMPUTES V = V + W */
+
+/* ... PARAMETER LIST: */
+
+/* N LENGTH OF VECTORS V AND W */
+/* V D.P. VECTOR */
+/* W D.P. VECTOR SUCH THAT V(I) = V(I) + W(I) */
+
+ if (*n <= 0)
+ return 0;
+
+ m = *n % 4;
+ for (i = 0; i < m; ++i)
+ v[i] += w[i];
+
+ for (i = m; i < *n; i += 4) {
+ v[i] += w[i];
+ v[i + 1] += w[i + 1];
+ v[i + 2] += w[i + 2];
+ v[i + 3] += w[i + 3];
+ }
+
+ return 0;
+} /* vevpw_ */
+
+/* Subroutine */
+int vfill_(integer *n, doublereal *v, doublereal *val)
+{
+ /* Local variables */
+ static integer i, m;
+
+/* FILLS A VECTOR, V, WITH A CONSTANT VALUE, VAL. */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTOR V */
+/* V D.P. VECTOR */
+/* VAL D.P. CONSTANT THAT FILLS FIRST N LOCATIONS OF V */
+
+ if (*n <= 0)
+ return 0;
+
+ /* CLEAN UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 10 */
+
+ m = *n % 10;
+ for (i = 0; i < m; ++i)
+ v[i] = *val;
+
+ for (i = m; i < *n; i += 10) {
+ v[i] = *val;
+ v[i + 1] = *val;
+ v[i + 2] = *val;
+ v[i + 3] = *val;
+ v[i + 4] = *val;
+ v[i + 5] = *val;
+ v[i + 6] = *val;
+ v[i + 7] = *val;
+ v[i + 8] = *val;
+ v[i + 9] = *val;
+ }
+
+ return 0;
+} /* vfill_ */
+
+/* Subroutine */
+int vout_(integer *n, doublereal *v, integer *iswt, integer *nout)
+{
+/* THIS SUBROUTINE EFFECTS PRINTING OF RESIDUAL AND SOLUTION */
+/* VECTORS - CALLED FROM PERROR */
+
+/* ... PARAMETER LIST: */
+
+/* V VECTOR OF LENGTH N */
+/* ISWT LABELLING INFORMATION */
+/* NOUT OUTPUT DEVICE NUMBER */
+
+ /* IF (N .LE. 0) RETURN */
+ (void)n; (void)v; (void)iswt; (void)nout;
+
+ return 0;
+} /* vout_ */
+
+/* Subroutine */
+int wevmw_(integer *n, doublereal *v, doublereal *w)
+{
+ /* Local variables */
+ static integer i, m;
+
+/* ... WEVMW COMPUTES W = V - W */
+
+/* ... PARAMETER LIST: */
+
+/* N INTEGER LENGTH OF VECTORS V AND W */
+/* V D.P. VECTOR */
+/* W D.P. VECTOR SUCH THAT W(I) = V(I) - W(I) */
+
+ if (*n <= 0)
+ return 0;
+
+ m = *n % 4;
+ for (i = 0; i < m; ++i)
+ w[i] = v[i] - w[i];
+
+ for (i = m; i < *n; i += 4) {
+ w[i] = v[i] - w[i];
+ w[i + 1] = v[i + 1] - w[i + 1];
+ w[i + 2] = v[i + 2] - w[i + 2];
+ w[i + 3] = v[i + 3] - w[i + 3];
+ }
+
+ return 0;
+} /* wevmw_ */
+
+/* Subroutine */
+int zbrent_(integer *n, doublereal *tri, doublereal *eps, integer *nsig,
+ doublereal *aa, doublereal *bb, integer *maxfnn, integer *ier)
+{
+ /* Initialized data */
+
+ static doublereal zero = 0.;
+ static doublereal half = .5;
+ static doublereal one = 1.;
+ static doublereal three = 3.;
+ static doublereal ten = 10.;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal a, b, c, d, e, p, q, r, s, t, fa, fb, fc;
+ static integer ic;
+ static doublereal rm, tol, rone, temp;
+ static integer maxfn;
+
+/* MODIFIED IMSL ROUTINE NAME - ZBRENT */
+
+/* ----------------------------------------------------------------------- */
+
+/* COMPUTER - CDC/SINGLE */
+
+/* LATEST REVISION - JANUARY 1, 1978 */
+
+/* PURPOSE - ZERO OF A FUNCTION WHICH CHANGES SIGN IN A */
+/* GIVEN INTERVAL (BRENT ALGORITHM) */
+
+/* USAGE - CALL ZBRENT (F,EPS,NSIG,A,B,MAXFN,IER) */
+
+/* ARGUMENTS TRI - A TRIDIAGONAL MATRIX OF ORDER N */
+/* EPS - FIRST CONVERGENCE CRITERION (INPUT). A ROOT, */
+/* B, IS ACCEPTED IF DABS(F(B)) IS LESS THAN OR */
+/* EQUAL TO EPS. EPS MAY BE SET TO ZERO. */
+/* NSIG - SECOND CONVERGENCE CRITERION (INPUT). A ROOT, */
+/* B, IS ACCEPTED IF THE CURRENT APPROXIMATION */
+/* AGREES WITH THE TRUE SOLUTION TO NSIG */
+/* SIGNIFICANT DIGITS. */
+/* A,B - ON INPUT, THE USER MUST SUPPLY TWO POINTS, A */
+/* AND B, SUCH THAT F(A) AND F(B) ARE OPPOSITE */
+/* IN SIGN. (= AA, BB) */
+/* ON OUTPUT, BOTH A AND B ARE ALTERED. B */
+/* WILL CONTAIN THE BEST APPROXIMATION TO THE */
+/* ROOT OF F. SEE REMARK 1. */
+/* MAXFN - ON INPUT, MAXFN SHOULD CONTAIN AN UPPER BOUND */
+/* ON THE NUMBER OF FUNCTION EVALUATIONS */
+/* REQUIRED FOR CONVERGENCE. ON OUTPUT, MAXFN */
+/* WILL CONTAIN THE ACTUAL NUMBER OF FUNCTION */
+/* EVALUATIONS USED. (= MAXFNN) */
+/* IER - ERROR PARAMETER. (OUTPUT) */
+/* TERMINAL ERROR */
+/* IER = 501 INDICATES THE ALGORITHM FAILED TO */
+/* CONVERGE IN MAXFN EVALUATIONS. */
+/* IER = 502 INDICATES F(A) AND F(B) HAVE THE */
+/* SAME SIGN. */
+
+/* PRECISION/HARDWARE - SINGLE AND DOUBLE/H32 */
+/* - SINGLE/H36,H48,H60 */
+
+/* NOTATION - INFORMATION ON SPECIAL NOTATION AND */
+/* CONVENTIONS IS AVAILABLE IN THE MANUAL */
+/* INTRODUCTION OR THROUGH IMSL ROUTINE UHELP */
+
+/* REMARKS 1. LET F(X) BE THE CHARACTERISTIC FUNCTION OF THE MATRIX */
+/* TRI EVALUATED AT X. FUNCTION DETERM EVALUATES F(X). */
+/* ON EXIT FROM ZBRENT, WHEN IER=0, A AND B SATISFY THE */
+/* FOLLOWING, */
+/* F(A)*F(B) .LE.0, */
+/* DABS(F(B)) .LE. DABS(F(A)), AND */
+/* EITHER DABS(F(B)) .LE. EPS OR */
+/* DABS(A-B) .LE. MAX(DABS(B),0.1)*10.0**(-NSIG). */
+/* THE PRESENCE OF 0.1 IN THIS ERROR CRITERION CAUSES */
+/* LEADING ZEROES TO THE RIGHT OF THE DECIMAL POINT TO BE */
+/* COUNTED AS SIGNIFICANT DIGITS. SCALING MAY BE REQUIRED */
+/* IN ORDER TO ACCURATELY DETERMINE A ZERO OF SMALL */
+/* MAGNITUDE. */
+/* 2. ZBRENT IS GUARANTEED TO REACH CONVERGENCE WITHIN */
+/* K = (DLOG((B-A)/D)+1.0)**2 FUNCTION EVALUATIONS WHERE */
+/* D=MIN(OVER X IN (A,B) OF */
+/* MAX(DABS(X),0.1)*10.0**(-NSIG)). */
+/* THIS IS AN UPPER BOUND ON THE NUMBER OF EVALUATIONS. */
+/* RARELY DOES THE ACTUAL NUMBER OF EVALUATIONS USED BY */
+/* ZBRENT EXCEED DSQRT(K). D CAN BE COMPUTED AS FOLLOWS, */
+/* P = DBLE(AMIN1(DABS(A),DABS(B))) */
+/* P = DMAX1(0.1,P) */
+/* IF ((A-0.1)*(B-0.1).LT.0.0) P = 0.1 */
+/* D = P*10.0**(-NSIG) */
+
+/* COPYRIGHT - 1977 BY IMSL, INC. ALL RIGHTS RESERVED. */
+
+/* WARRANTY - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN */
+/* APPLIED TO THIS CODE. NO OTHER WARRANTY, */
+/* EXPRESSED OR IMPLIED, IS APPLICABLE. */
+
+/* ----------------------------------------------------------------------- */
+
+ a = *aa;
+ b = *bb;
+ maxfn = *maxfnn;
+ *ier = 0;
+ i__1 = -(*nsig);
+ t = pow_di(&ten, &i__1);
+ ic = 2;
+ fa = determ_(n, tri, &a);
+ fb = determ_(n, tri, &b);
+ s = b;
+
+ /* TEST FOR SAME SIGN */
+
+ if (fa * fb > zero)
+ goto L110;
+
+L10:
+ c = a;
+ fc = fa;
+ d = b - c;
+ e = d;
+L20:
+ if (abs(fc) < abs(fb)) {
+ a = b;
+ b = c;
+ c = a;
+ fa = fb;
+ fb = fc;
+ fc = fa;
+ }
+
+ tol = t * max(abs(b),.1);
+ rm = (c - b) * half;
+
+ /* TEST FOR FIRST CONVERGENCE CRITERIA */
+
+ if (abs(fb) <= *eps)
+ goto L80;
+
+ /* TEST FOR SECOND CONVERGENCE CRITERIA */
+
+ if (abs(c - b) <= tol)
+ goto L80;
+
+ /* CHECK EVALUATION COUNTER */
+
+ if (ic >= maxfn)
+ goto L90;
+
+ /* IS BISECTION FORCED */
+
+ if (abs(e) < tol)
+ goto L60;
+
+ if (abs(fa) <= abs(fb))
+ goto L60;
+
+ s = fb / fa;
+
+ /* LINEAR INTERPOLATION */
+
+ if (a == c) {
+ p = (c - b) * s;
+ q = one - s;
+ }
+
+ /* INVERSE QUADRATIC INTERPOLATION */
+
+ else {
+ q = fa / fc;
+ r = fb / fc;
+ rone = r - one;
+ p = s * ((c - b) * q * (q - r) - (b - a) * rone);
+ q = (q - one) * rone * (s - one);
+ }
+
+ if (p > zero)
+ q = -q;
+
+ if (p < zero)
+ p = -p;
+
+ s = e;
+ e = d;
+
+ /* IF DABS(P/Q).GE.75*DABS(C-B) THEN */
+ /* FORCE BISECTION */
+
+ if (p + p >= three * rm * q)
+ goto L60;
+
+ /* IF DABS(P/Q).GE..5*DABS(S) THEN FORCE */
+ /* BISECTION. S = THE VALUE OF P/Q */
+ /* ON THE STEP BEFORE THE LAST ONE */
+
+ if (p + p < abs(s * q)) {
+ d = p / q;
+ goto L70;
+ }
+
+ /* BISECTION */
+
+L60:
+ e = rm;
+ d = e;
+
+ /* INCREMENT B */
+
+L70:
+ a = b;
+ fa = fb;
+ temp = d;
+ if (abs(temp) <= half * tol) {
+ d__1 = half * tol;
+ temp = d_sign(&d__1, &rm);
+ }
+ b += temp;
+ s = b;
+ fb = determ_(n, tri, &s);
+ ++ic;
+ if (fb * fc <= zero)
+ goto L20;
+ else
+ goto L10;
+
+ /* CONVERGENCE OF B */
+
+L80:
+ a = c;
+ maxfn = ic;
+ goto L130;
+
+ /* MAXFN EVALUATIONS */
+
+L90:
+ *ier = 501;
+ a = c;
+ maxfn = ic;
+ goto L130;
+
+ /* TERMINAL ERROR - F(A) AND F(B) HAVE */
+ /* THE SAME SIGN */
+
+L110:
+ *ier = 502;
+ maxfn = ic;
+L130:
+ *aa = a;
+ *bb = b;
+ *maxfnn = maxfn;
+ return 0;
+} /* zbrent_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.f
new file mode 100644
index 0000000000000000000000000000000000000000..6c8b71bd31daf3803a4d146ea16f59781ac313f5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsrc2c.f
@@ -0,0 +1,8755 @@
+ SUBROUTINE JCG (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE JCG (JACOBI CONJUGATE GRADIENT)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, JCG, DRIVES THE JACOBI CONJUGATE
+C GRADIENT ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. JACOBI CONJUGATE
+C GRADIENT NEEDS THIS TO BE IN LENGTH AT LEAST
+C 4*N + 2*ITMAX, IF ISYM = 0 (SYMMETRIC STORAGE)
+C 4*N + 4*ITMAX, IF ISYM = 1 (NONSYMMETRIC STORAGE)
+C HERE ITMAX = IPARM(1) AND ISYM = IPARM(5)
+C (ITMAX IS THE MAXIMUM ALLOWABLE NUMBER OF ITERATIONS)
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD.
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... JCG SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL,
+C ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER,
+C ITJCG, IVFILL, PARCON, PERMAT,
+C PERROR, PERVEC, PJAC, PMULT, PRBNDX,
+C PSTOP, QSORT, DAXPY, SBELM, SCAL, DCOPY,
+C DDOT, SUM3, UNSCAL, VEVMW, VFILL, VOUT,
+C WEVMW, ZBRENT
+C SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, MOD, DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,IB4,IB5,IDGTS,IER,IERPER,ITMAX1,LOOP,N,NB,N3
+ DOUBLE PRECISION DIGIT1,DIGIT2,TEMP,TIME1,TIME2,TOL
+C
+C **** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C **** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE JCG')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,1)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE JCG'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 11
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 370
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 370
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ IB3 = IB2+N
+ IB4 = IB3+N
+ IB5 = IB4+N
+ IPARM(8) = 4*N+2*ITMAX
+ IF (ISYM.NE.0) IPARM(8) = IPARM(8)+2*ITMAX
+ IF (NW.GE.IPARM(8)) GO TO 110
+ IER = 12
+ IF (LEVEL.GE.0) WRITE (NOUT,100) NW,IPARM(8)
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 370
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED
+C
+ 110 NB = IPARM(9)
+ IF (NB.LT.0) GO TO 170
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 130
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER,NB
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 370
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 130 IF (LEVEL.GE.2) WRITE (NOUT,140) NB
+ 140 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(IB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 160
+ IF (LEVEL.GE.0) WRITE (NOUT,150) IER
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 370
+ 160 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 170 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 190
+ IF (LEVEL.GE.0) WRITE (NOUT,180) IER
+ 180 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 370
+ 190 IF (LEVEL.LE.2) GO TO 220
+ WRITE (NOUT,200)
+ 200 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ IF (ADAPT) WRITE (NOUT,210)
+ 210 FORMAT (1X,'CME IS THE ESTIMATE OF THE LARGEST EIGENVALUE OF',
+ * ' THE JACOBI MATRIX')
+ 220 IF (IPARM(11).NE.0) GO TO 230
+ TIMI1 = TIMER(DUMMY)
+C
+C ... COMPUTE INITIAL PSEUDO-RESIDUAL
+C
+ 230 CONTINUE
+ CALL DCOPY (N,RHS,1,WKSP(IB2),1)
+ CALL PJAC (N,IA,JA,A,U,WKSP(IB2))
+ CALL VEVMW (N,WKSP(IB2),U)
+C
+C ... ITERATION SEQUENCE
+C
+ ITMAX1 = ITMAX+1
+ DO 250 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 240
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN) WKSP(IB2) = DEL(IN)
+C WKSP(IB1) = U(IN-1) WKSP(IB3) = DEL(IN-1)
+C
+ CALL ITJCG (N,IA,JA,A,U,WKSP(IB1),WKSP(IB2),WKSP(IB3),WKSP(IB4)
+ * ,WKSP(IB5))
+C
+ IF (HALT) GO TO 280
+ GO TO 250
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1) WKSP(IB2) = DEL(IN-1)
+C WKSP(IB1) = U(IN) WKSP(IB3) = DEL(IN)
+C
+ 240 CALL ITJCG (N,IA,JA,A,WKSP(IB1),U,WKSP(IB3),WKSP(IB2),WKSP(IB4)
+ * ,WKSP(IB5))
+C
+ IF (HALT) GO TO 280
+ 250 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 260
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 260 IER = 13
+ IF (LEVEL.GE.1) WRITE (NOUT,270) ITMAX
+ 270 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE JCG'/' ',' FAILURE TO CONVERGE IN',I5
+ * ,' ITERATIONS')
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 310
+C
+C ... METHOD HAS CONVERGED
+C
+ 280 IF (IPARM(11).NE.0) GO TO 290
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 290 IF (LEVEL.GE.1) WRITE (NOUT,300) IN
+ 300 FORMAT (/1X,'JCG HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 310 CONTINUE
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).LT.0) GO TO 340
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(IB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 330
+ IF (LEVEL.GE.0) WRITE (NOUT,320) IERPER
+ 320 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 370
+ 330 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 340 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 350
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 350 IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (IPARM(11).NE.0) GO TO 360
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 360 IF (ISYM.NE.0) IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (IPARM(3).NE.0) GO TO 370
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 370 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE JSI (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE JSI (JACOBI SEMI-ITERATIVE)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, JSI, DRIVES THE JACOBI SEMI-
+C ITERATION ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. JACOBI SI
+C NEEDS THIS TO BE IN LENGTH AT LEAST
+C 2*N
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD.
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... JSI SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHEBY, CHGSI, CHGSME, DFAULT, ECHALL,
+C ECHOUT, ITERM, TIMER, ITJSI, IVFILL, PAR
+C PERMAT, PERROR, PERVEC, PJAC, PMULT, PRBNDX,
+C PSTOP, PVTBV, QSORT, DAXPY, SBELM, SCAL,
+C DCOPY, DDOT, SUM3, TSTCHG, UNSCAL, VEVMW,
+C VFILL, VOUT, WEVMW
+C SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT),
+C MOD,DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,ICNT,IDGTS,IER,IERPER,ITMAX1,LOOP,N,NB,N3
+ DOUBLE PRECISION DIGIT1,DIGIT2,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE JSI')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,2)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE JSI'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 21
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 360
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 360
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ IB3 = IB2+N
+ IPARM(8) = 2*N
+ IF (NW.GE.IPARM(8)) GO TO 110
+ IER = 22
+ IF (LEVEL.GE.0) WRITE (NOUT,100) NW,IPARM(8)
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 360
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED
+C
+ 110 NB = IPARM(9)
+ IF (NB.LT.0) GO TO 170
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 130
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER,NB
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 360
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 130 IF (LEVEL.GE.2) WRITE (NOUT,140) NB
+ 140 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(IB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 160
+ IF (LEVEL.GE.0) WRITE (NOUT,150) IER
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 360
+ 160 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 170 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 190
+ IF (LEVEL.GE.0) WRITE (NOUT,180) IER
+ 180 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 360
+ 190 IF (LEVEL.LE.2) GO TO 210
+ WRITE (NOUT,200)
+ 200 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ 210 IF (IPARM(11).NE.0) GO TO 220
+ TIMI1 = TIMER(DUMMY)
+C
+C ... ITERATION SEQUENCE
+C
+ 220 ITMAX1 = ITMAX+1
+ DO 240 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 230
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN)
+C WKSP(IB1) = U(IN-1)
+C
+ CALL ITJSI (N,IA,JA,A,RHS,U,WKSP(IB1),WKSP(IB2),ICNT)
+C
+ IF (HALT) GO TO 270
+ GO TO 240
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1)
+C WKSP(IB1) = U(IN)
+C
+ 230 CALL ITJSI (N,IA,JA,A,RHS,WKSP(IB1),U,WKSP(IB2),ICNT)
+C
+ IF (HALT) GO TO 270
+ 240 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 250
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 250 IER = 23
+ IF (LEVEL.GE.1) WRITE (NOUT,260) ITMAX
+ 260 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE JSI'/' ',' FAILURE TO CONVERGE IN',I5
+ * ,' ITERATIONS')
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 300
+C
+C ... METHOD HAS CONVERGED
+C
+ 270 IF (IPARM(11).NE.0) GO TO 280
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 280 IF (LEVEL.GE.1) WRITE (NOUT,290) IN
+ 290 FORMAT (/1X,'JSI HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 300 CONTINUE
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).LT.0) GO TO 330
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(IB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 320
+ IF (LEVEL.GE.0) WRITE (NOUT,310) IERPER
+ 310 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE JSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 360
+ 320 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 330 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 340
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 340 IF (IPARM(11).NE.0) GO TO 350
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 350 IF (IPARM(3).NE.0) GO TO 360
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 360 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE SOR (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE SOR (SUCCESSIVE OVERRELATION)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, SOR, DRIVES THE SUCCESSIVE
+C OVERRELAXATION ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. SOR NEEDS THIS
+C TO BE IN LENGTH AT LEAST N
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD.
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... SOR SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, DFAULT, ECHALL, ECHOUT, IPSTR, ITERM,
+C TIMER, ITSOR, IVFILL, PERMAT, PERROR,
+C PERVEC, PFSOR1, PMULT, PRBNDX, PSTOP, QSORT,
+C SBELM, SCAL, DCOPY, DDOT, TAU, UNSCAL, VFILL,
+C VOUT, WEVMW
+C SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT),
+C DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,IDGTS,IER,IERPER,ITMAX1,LOOP,N,NB,N3
+ DOUBLE PRECISION DIGIT1,DIGIT2,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE SOR')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,3)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SOR'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 31
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 360
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 360
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ IB3 = IB2+N
+ IPARM(8) = N
+ IF (NW.GE.IPARM(8)) GO TO 110
+ IER = 32
+ IF (LEVEL.GE.0) WRITE (NOUT,100) NW,IPARM(8)
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 360
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED
+C
+ 110 NB = IPARM(9)
+ IF (NB.LT.0) GO TO 170
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 130
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER,NB
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 360
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 130 IF (LEVEL.GE.2) WRITE (NOUT,140) NB
+ 140 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(IB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 160
+ IF (LEVEL.GE.0) WRITE (NOUT,150) IER
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 360
+ 160 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 170 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 190
+ IF (LEVEL.GE.0) WRITE (NOUT,180) IER
+ 180 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 360
+ 190 IF (LEVEL.LE.2) GO TO 220
+ IF (ADAPT) WRITE (NOUT,200)
+ 200 FORMAT (///1X,'CME IS THE ESTIMATE OF THE LARGEST EIGENVALUE OF',
+ * ' THE JACOBI MATRIX')
+ WRITE (NOUT,210)
+ 210 FORMAT (1X,'OMEGA IS THE RELAXATION FACTOR')
+ 220 IF (IPARM(11).NE.0) GO TO 230
+ TIMI1 = TIMER(DUMMY)
+C
+C ... ITERATION SEQUENCE
+C
+ 230 ITMAX1 = ITMAX+1
+ DO 240 LOOP = 1,ITMAX1
+ IN = LOOP-1
+C
+C ... CODE FOR ONE ITERATION.
+C
+C U = U(IN)
+C
+ CALL ITSOR (N,IA,JA,A,RHS,U,WKSP(IB1))
+C
+ IF (HALT) GO TO 270
+ 240 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 250
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 250 IF (LEVEL.GE.1) WRITE (NOUT,260) ITMAX
+ 260 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SOR'/' ',' FAILURE TO CONVERGE IN',I5
+ * ,' ITERATIONS')
+ IER = 33
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 300
+C
+C ... METHOD HAS CONVERGED
+C
+ 270 IF (IPARM(11).NE.0) GO TO 280
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 280 IF (LEVEL.GE.1) WRITE (NOUT,290) IN
+ 290 FORMAT (/1X,'SOR HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ 300 CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).LT.0) GO TO 330
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(IB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 320
+ IF (LEVEL.GE.0) WRITE (NOUT,310) IERPER
+ 310 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SOR '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 360
+ 320 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 330 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 340
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 340 IF (IPARM(11).NE.0) GO TO 350
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 350 IF (IPARM(3).NE.0) GO TO 360
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(5) = OMEGA
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 360 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE SSORCG (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,
+ * IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE SSORCG (SYMMETRIC SUCCESSIVE OVER-
+C RELAXATION CONJUGATE GRADIENT)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, SSORCG, DRIVES THE SYMMETRIC SOR-CG
+C ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. SSOR-CG
+C NEEDS TO BE IN LENGTH AT LEAST
+C 6*N + 2*ITMAX, IF IPARM(5)=0 (SYMMETRIC STORAGE)
+C 6*N + 4*ITMAX, IF IPARM(5)=1 (NONSYMMETRIC STORAGE)
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... SSORCG SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL,
+C ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER,
+C ITSRCG, IVFILL, OMEG, OMGCHG, OMGSTR,
+C PARCON, PBETA, PBSOR, PERMAT, PERROR,
+C PERVEC, PFSOR, PJAC, PMULT, PRBNDX, PSTOP, PVT
+C QSORT, SBELM, SCAL, DCOPY, DDOT, SUM3,
+C UNSCAL, VEVMW, VEVPW, VFILL, VOUT, WEVMW,
+C ZBRENT
+C SYSTEM DABS, DLOG, DLOG10, DBLE(AMAX0), DMAX1, AMIN1,
+C MOD, DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,IB4,IB5,IB6,IB7,IDGTS,IER,IERPER,ITMAX1,LOOP,N
+ * ,NB,N3
+ DOUBLE PRECISION BETNEW,DIGIT1,DIGIT2,PBETA,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (IPARM(9).GE.0) IPARM(6) = 2
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE SSORCG')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,4)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SSORCG'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 41
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 390
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 390
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ IB3 = IB2+N
+ IB4 = IB3+N
+ IB5 = IB4+N
+ IB6 = IB5+N
+ IB7 = IB6+N
+ IPARM(8) = 6*N+2*ITMAX
+ IF (ISYM.NE.0) IPARM(8) = IPARM(8)+2*ITMAX
+ IF (NW.GE.IPARM(8)) GO TO 110
+ IER = 42
+ IF (LEVEL.GE.0) WRITE (NOUT,100) NW,IPARM(8)
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 390
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED
+C
+ 110 NB = IPARM(9)
+ IF (NB.LT.0) GO TO 170
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 130
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER,NB
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 390
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 130 IF (LEVEL.GE.2) WRITE (NOUT,140) NB
+ 140 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(IB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 160
+ IF (LEVEL.GE.0) WRITE (NOUT,150) IER
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 390
+ 160 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 170 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 190
+ IF (LEVEL.GE.0) WRITE (NOUT,180) IER
+ 180 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 390
+ 190 IF (LEVEL.LE.2) GO TO 220
+ WRITE (NOUT,200)
+ 200 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ WRITE (NOUT,210)
+ 210 FORMAT (1X,'S-PRIME IS AN INITIAL ESTIMATE FOR NEW CME')
+ 220 IF (IPARM(11).NE.0) GO TO 230
+ TIMI1 = TIMER(DUMMY)
+C
+C ... SPECIAL PROCEDURE FOR FULLY ADAPTIVE CASE.
+C
+ 230 CONTINUE
+ IF (.NOT.ADAPT) GO TO 250
+ IF (.NOT.BETADT) GO TO 240
+ CALL VFILL (N,WKSP(IB1),1.D0)
+ BETNEW = PBETA(N,IA,JA,A,WKSP(IB1),WKSP(IB2),WKSP(IB3))/
+ * DBLE(FLOAT(N))
+ BETAB = DMAX1(BETAB,.25D0,BETNEW)
+ 240 CALL OMEG (0.D0,1)
+ IS = 0
+C
+C ... INITIALIZE FORWARD PSEUDO-RESIDUAL
+C
+ 250 CALL DCOPY (N,RHS,1,WKSP(IB1),1)
+ CALL DCOPY (N,U,1,WKSP(IB2),1)
+ CALL PFSOR (N,IA,JA,A,WKSP(IB2),WKSP(IB1))
+ CALL VEVMW (N,WKSP(IB2),U)
+C
+C ... ITERATION SEQUENCE
+C
+ ITMAX1 = ITMAX+1
+ DO 270 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 260
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN) WKSP(IB2) = C(IN)
+C WKSP(IB1) = U(IN-1) WKSP(IB3) = C(IN-1)
+C
+ CALL ITSRCG (N,IA,JA,A,RHS,U,WKSP(IB1),WKSP(IB2),WKSP(IB3),
+ * WKSP(IB4),WKSP(IB5),WKSP(IB6),WKSP(IB7))
+C
+ IF (HALT) GO TO 300
+ GO TO 270
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1) WKSP(IB2) = C(IN-1)
+C WKSP(IB1) = U(IN) WKSP(IB3) =C(IN)
+C
+ 260 CALL ITSRCG (N,IA,JA,A,RHS,WKSP(IB1),U,WKSP(IB3),WKSP(IB2),
+ * WKSP(IB4),WKSP(IB5),WKSP(IB6),WKSP(IB7))
+C
+ IF (HALT) GO TO 300
+ 270 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 280
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 280 IF (LEVEL.GE.1) WRITE (NOUT,290) ITMAX
+ 290 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SSORCG'/' ',' FAILURE TO CONVERGE IN'
+ * ,I5,' ITERATIONS')
+ IER = 43
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 330
+C
+C ... METHOD HAS CONVERGED
+C
+ 300 IF (IPARM(11).NE.0) GO TO 310
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 310 IF (LEVEL.GE.1) WRITE (NOUT,320) IN
+ 320 FORMAT (/1X,'SSORCG HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 330 CONTINUE
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).LT.0) GO TO 360
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(IB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 350
+ IF (LEVEL.GE.0) WRITE (NOUT,340) IERPER
+ 340 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 390
+ 350 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 360 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 370
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 370 IF (IPARM(11).NE.0) GO TO 380
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 380 IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (ISYM.NE.0) IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (IPARM(3).NE.0) GO TO 390
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(5) = OMEGA
+ RPARM(6) = SPECR
+ RPARM(7) = BETAB
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 390 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE SSORSI (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,
+ * IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE SSORSI (SYMMETRIC SUCCESSIVE RELAX-
+C ATION SEMI-ITERATION)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, SSORSI, DRIVES THE SYMMETRIC SOR-SI
+C ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. SSORSI
+C NEEDS THIS TO BE IN LENGTH AT LEAST 5*N
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... SSORSI SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHEBY, CHGSI, DFAULT, ECHALL, ECHOUT,
+C ITERM, TIMER, ITSRSI, IVFILL, OMEG,
+C OMGSTR, PARSI, PBETA, PERMAT, PERROR,
+C PERVEC, PFSOR, PMULT, PRBNDX, PSSOR1,
+C PSTOP, PVTBV, QSORT, SBELM, SCAL, DCOPY,
+C DDOT, SUM3, TSTCHG, UNSCAL, VEVPW, VFILL,
+C VOUT, WEVMW
+C SYSTEM DABS, DLOG, DLOG10, DBLE(AMAX0), DMAX1, DBLE(F
+C MOD, DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,IB4,IB5,IDGTS,IER,IERPER,ITMAX1,LOOP,N,NB,N3
+ DOUBLE PRECISION BETNEW,DIGIT1,DIGIT2,PBETA,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (IPARM(9).GE.0) IPARM(6) = 2
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE SSORSI')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,5)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SSORSI'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 51
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 380
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 380
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ IB3 = IB2+N
+ IB4 = IB3+N
+ IB5 = IB4+N
+ IPARM(8) = 5*N
+ IF (NW.GE.IPARM(8)) GO TO 110
+ IER = 52
+ IF (LEVEL.GE.0) WRITE (NOUT,100) NW,IPARM(8)
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF REQUESTED
+C
+ 110 NB = IPARM(9)
+ IF (NB.LT.0) GO TO 170
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 130
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER,NB
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 380
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 130 IF (LEVEL.GE.2) WRITE (NOUT,140) NB
+ 140 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(IB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 160
+ IF (LEVEL.GE.0) WRITE (NOUT,150) IER
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 380
+ 160 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 170 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 190
+ IF (LEVEL.GE.0) WRITE (NOUT,180) IER
+ 180 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 380
+ 190 IF (LEVEL.LE.2) GO TO 210
+ WRITE (NOUT,200)
+ 200 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ 210 IF (IPARM(11).NE.0) GO TO 220
+ TIMI1 = TIMER(DUMMY)
+C
+C ... SPECIAL PROCEDURE FOR FULLY ADAPTIVE CASE.
+C
+ 220 CONTINUE
+ IF (.NOT.ADAPT) GO TO 240
+ IF (.NOT.BETADT) GO TO 230
+ CALL VFILL (N,WKSP(IB1),1.D0)
+ BETNEW = PBETA(N,IA,JA,A,WKSP(IB1),WKSP(IB2),WKSP(IB3))/
+ * DBLE(FLOAT(N))
+ BETAB = DMAX1(BETAB,.25D0,BETNEW)
+ 230 CALL OMEG (0.D0,1)
+ IS = 0
+C
+C ... ITERATION SEQUENCE
+C
+ 240 ITMAX1 = ITMAX+1
+ DO 260 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 250
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN)
+C WKSP(IB1) = U(IN-1)
+C
+ CALL ITSRSI (N,IA,JA,A,RHS,U,WKSP(IB1),WKSP(IB2),WKSP(IB3),
+ * WKSP(IB4),WKSP(IB5))
+C
+ IF (HALT) GO TO 290
+ GO TO 260
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1)
+C WKSP(IB1) = U(IN)
+C
+ 250 CALL ITSRSI (N,IA,JA,A,RHS,WKSP(IB1),U,WKSP(IB2),WKSP(IB3),
+ * WKSP(IB4),WKSP(IB5))
+C
+ IF (HALT) GO TO 290
+ 260 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 270
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 270 IF (LEVEL.GE.1) WRITE (NOUT,280) ITMAX
+ 280 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SSORSI'/' ',' FAILURE TO CONVERGE IN'
+ * ,I5,' ITERATIONS')
+ IER = 53
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 320
+C
+C ... METHOD HAS CONVERGED
+C
+ 290 IF (IPARM(11).NE.0) GO TO 300
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 300 IF (LEVEL.GE.1) WRITE (NOUT,310) IN
+ 310 FORMAT (/1X,'SSORSI HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 320 CONTINUE
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).LT.0) GO TO 350
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(IB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 340
+ IF (LEVEL.GE.0) WRITE (NOUT,330) IERPER
+ 330 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE SSORSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 380
+ 340 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 350 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 360
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 360 IF (IPARM(11).NE.0) GO TO 370
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 370 IF (IPARM(3).NE.0) GO TO 380
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(5) = OMEGA
+ RPARM(6) = SPECR
+ RPARM(7) = BETAB
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 380 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE RSCG (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE RSCG (REDUCED SYSTEM CONJUGATE
+C GRADIENT)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, RSCG, DRIVES THE REDUCED SYSTEM CG
+C ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IN THE RED-BLACK MATRIX.
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. RSCG NEEDS
+C THIS TO BE IN LENGTH AT LEAST
+C N+3*NB+2*ITMAX, IF IPARM(5)=0 (SYMMETRIC STORAGE)
+C N+3*NB+4*ITMAX, IF IPARM(5)=1 (NONSYMMETRIC STORAGE)
+C HERE NB IS THE ORDER OF THE BLACK SUBSYSTEM
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... RSCG SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHGCON, DETERM, DFAULT, ECHALL,
+C ECHOUT, EIGVNS, EIGVSS, EQRT1S, ITERM, TIMER
+C ITRSCG, IVFILL, PARCON, PERMAT,
+C PERROR, PERVEC, PMULT, PRBNDX, PRSBLK,
+C PRSRED, PSTOP, QSORT, SBELM, SCAL, DCOPY,
+C DDOT, SUM3, UNSCAL, VFILL, VOUT, WEVMW,
+C ZBRENT
+C SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, MOD, DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IB3,IB4,IB5,IDGTS,IER,IERPER,ITMAX1,JB3,LOOP,N,NB,
+ * NR,NRP1,N3
+ DOUBLE PRECISION DIGIT1,DIGIT2,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE RSCG')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,6)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE RSCG'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 61
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 430
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+ GO TO 430
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ JB3 = IB2+N
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF POSSIBLE
+C
+ NB = IPARM(9)
+ IF (NB.GE.0) GO TO 110
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 110
+ IF (LEVEL.GE.0) WRITE (NOUT,100) IER,NB
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 430
+ 110 IF (NB.GE.0.AND.NB.LE.N) GO TO 130
+ IER = 64
+ IF (LEVEL.GE.1) WRITE (NOUT,120) IER,NB
+ 120 FORMAT (/10X,'ERROR DETECTED IN RED-BLACK SUBSYSTEM INDEX'/10X,
+ * 'IER =',I5,' IPARM(9) =',I5,' (NB)')
+ GO TO 430
+ 130 IF (NB.NE.0.AND.NB.NE.N) GO TO 150
+ NB = N/2
+ IF (LEVEL.GE.2.AND.IPARM(9).GE.0) WRITE (NOUT,140) IPARM(9),NB
+ 140 FORMAT (/10X,' IPARM(9) = ',I5,' IMPLIES MATRIX IS DIAGONAL'/10X,
+ * ' NB RESET TO ',I5)
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 150 IF (IPARM(9).GE.0) GO TO 190
+ IF (LEVEL.GE.2) WRITE (NOUT,160) NB
+ 160 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(JB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 180
+ IF (LEVEL.GE.0) WRITE (NOUT,170) IER
+ 170 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 430
+ 180 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... FINISH WKSP BASE ADDRESSES
+C
+ 190 IB3 = IB2+NB
+ IB4 = IB3+NB
+ IB5 = IB4+NB
+ NR = N-NB
+ NRP1 = NR+1
+ IPARM(8) = N+3*NB+2*ITMAX
+ IF (ISYM.NE.0) IPARM(8) = IPARM(8)+2*ITMAX
+ IF (NW.GE.IPARM(8)) GO TO 210
+ IER = 62
+ IF (LEVEL.GE.0) WRITE (NOUT,200) NW,IPARM(8)
+ 200 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 430
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 210 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 230
+ IF (LEVEL.GE.0) WRITE (NOUT,220) IER
+ 220 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 430
+ 230 IF (LEVEL.LE.2) GO TO 260
+ WRITE (NOUT,240)
+ 240 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ IF (ADAPT) WRITE (NOUT,250)
+ 250 FORMAT (1X,'CME IS THE ESTIMATE OF THE LARGEST EIGENVALUE OF',
+ * ' THE JACOBI MATRIX')
+ 260 IF (IPARM(11).NE.0) GO TO 270
+ TIMI1 = TIMER(DUMMY)
+C
+C ... INITIALIZE FORWARD PSEUDO-RESIDUAL
+C
+ 270 CONTINUE
+ IF (N.GT.1) GO TO 280
+ U(1) = RHS(1)
+ GO TO 330
+ 280 CALL DCOPY (NR,RHS,1,WKSP(IB1),1)
+ CALL PRSRED (NB,NR,IA,JA,A,U(NRP1),WKSP(IB1))
+ CALL DCOPY (NB,RHS(NRP1),1,WKSP(IB2),1)
+ CALL PRSBLK (NB,NR,IA,JA,A,WKSP(IB1),WKSP(IB2))
+ CALL VEVMW (NB,WKSP(IB2),U(NRP1))
+C
+C ... ITERATION SEQUENCE
+C
+ ITMAX1 = ITMAX+1
+ DO 300 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 290
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN) WKSP(IB2) = D(IN)
+C WKSP(IB1) = U(IN-1) WKSP(IB3) = D(IN-1)
+C
+ CALL ITRSCG (N,NB,IA,JA,A,U,WKSP(IB1),WKSP(IB2),WKSP(IB3),
+ * WKSP(IB4),WKSP(IB5))
+C
+ IF (HALT) GO TO 330
+ GO TO 300
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1) WKSP(IB2) = D(IN-1)
+C WKSP(IB1) = U(IN) WKSP(IB3) = D(IN)
+C
+ 290 CALL ITRSCG (N,NB,IA,JA,A,WKSP(IB1),U,WKSP(IB3),WKSP(IB2),
+ * WKSP(IB4),WKSP(IB5))
+C
+ IF (HALT) GO TO 330
+ 300 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 310
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 310 IF (LEVEL.GE.1) WRITE (NOUT,320) ITMAX
+ 320 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE RSCG'/' ',' FAILURE TO CONVERGE IN',
+ * I5,' ITERATIONS')
+ IER = 63
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 360
+C
+C ... METHOD HAS CONVERGED
+C
+ 330 IF (IPARM(11).NE.0) GO TO 340
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 340 IF (LEVEL.GE.1) WRITE (NOUT,350) IN
+ 350 FORMAT (/1X,'RSCG HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 360 CONTINUE
+ IF (N.EQ.1) GO TO 370
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+ CALL DCOPY (NR,RHS,1,U,1)
+ CALL PRSRED (NB,NR,IA,JA,A,U(NRP1),U)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ 370 CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).GE.0) GO TO 400
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(JB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 390
+ IF (LEVEL.GE.0) WRITE (NOUT,380) IERPER
+ 380 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSCG '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 430
+ 390 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 400 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 410
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 410 IF (IPARM(11).NE.0) GO TO 420
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 420 IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (ISYM.NE.0) IPARM(8) = IPARM(8)-2*(ITMAX-IN)
+ IF (IPARM(3).NE.0) GO TO 430
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 430 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE RSSI (NN,IA,JA,A,RHS,U,IWKSP,NW,WKSP,IPARM,RPARM,IERR)
+C
+C ITPACK 2C MAIN SUBROUTINE RSSI (REDUCED SYSTEM SEMI-ITERATIVE)
+C EACH OF THE MAIN SUBROUTINES:
+C JCG, JSI, SOR, SSORCG, SSORSI, RSCG, RSSI
+C CAN BE USED INDEPENDENTLY OF THE OTHERS
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, RSSI, DRIVES THE REDUCED SYSTEM SI
+C ALGORITHM.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C INITIAL GUESS TO THE SOLUTION. ON OUTPUT, IT CONTAINS
+C THE LATEST ESTIMATE TO THE SOLUTION.
+C IWKSP INTEGER VECTOR WORKSPACE OF LENGTH 3*N
+C NW INPUT INTEGER. LENGTH OF AVAILABLE WKSP. ON OUTPUT,
+C IPARM(8) IS AMOUNT USED.
+C WKSP D.P. VECTOR USED FOR WORKING SPACE. RSSI
+C NEEDS THIS TO BE IN LENGTH AT LEAST N + NB
+C HERE NB IS THE ORDER OF THE BLACK SUBSYSTEM
+C IPARM INTEGER VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY
+C SOME INTEGER PARAMETERS WHICH AFFECT THE METHOD. IF
+C RPARM D.P. VECTOR OF LENGTH 12. ALLOWS USER TO SPECIFY SOME
+C D.P. PARAMETERS WHICH AFFECT THE METHOD.
+C IER OUTPUT INTEGER. ERROR FLAG. (= IERR)
+C
+C ... RSSI SUBPROGRAM REFERENCES:
+C
+C FROM ITPACK BISRCH, CHEBY, CHGSI, DFAULT, ECHALL,
+C ECHOUT, ITERM, TIMER, ITRSSI, IVFILL,
+C PARSI, PERMAT, PERROR, PERVEC, PMULT,
+C PRBNDX, PRSBLK, PRSRED, PSTOP, QSORT,
+C DAXPY, SBELM, SCAL, DCOPY, DDOT, SUM3,
+C TSTCHG, UNSCAL, VEVMW, VFILL, VOUT,
+C WEVMW
+C SYSTEM DABS, DLOG10, DBLE(AMAX0), DMAX1, DBLE(FLOAT),
+C DSQRT
+C
+C VERSION: ITPACK 2C (MARCH 1982)
+C
+C CODE WRITTEN BY: DAVID KINCAID, ROGER GRIMES, JOHN RESPESS
+C CENTER FOR NUMERICAL ANALYSIS
+C UNIVERSITY OF TEXAS
+C AUSTIN, TX 78712
+C (512) 471-1242
+C
+C FOR ADDITIONAL DETAILS ON THE
+C (A) SUBROUTINE SEE TOMS ARTICLE 1982
+C (B) ALGORITHM SEE CNA REPORT 150
+C
+C BASED ON THEORY BY: DAVID YOUNG, DAVID KINCAID, LOU HAGEMAN
+C
+C REFERENCE THE BOOK: APPLIED ITERATIVE METHODS
+C L. HAGEMAN, D. YOUNG
+C ACADEMIC PRESS, 1981
+C
+C **************************************************
+C * IMPORTANT NOTE *
+C * *
+C * WHEN INSTALLING ITPACK ROUTINES ON A *
+C * DIFFERENT COMPUTER, RESET SOME OF THE VALUES *
+C * IN SUBROUTNE DFAULT. MOST IMPORTANT ARE *
+C * *
+C * DRELPR MACHINE RELATIVE PRECISION *
+C * RPARM(1) STOPPING CRITERION *
+C * *
+C * ALSO CHANGE SYSTEM-DEPENDENT ROUTINE *
+C * SECOND USED IN TIMER *
+C * *
+C **************************************************
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IWKSP(1),IPARM(12),NN,NW,IERR
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WKSP(NW),RPARM(12)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB1,IB2,IDGTS,IER,IERPER,ITMAX1,JB3,LOOP,N,NB,NR,NRP1,N3
+ DOUBLE PRECISION DIGIT1,DIGIT2,TEMP,TIME1,TIME2,TOL
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM1
+C
+C IN - ITERATION NUMBER
+C IS - ITERATION NUMBER WHEN PARAMETERS LAST CHANGED
+C ISYM - SYMMETRIC/NONSYMMETRIC STORAGE FORMAT SWITCH
+C ITMAX - MAXIMUM NUMBER OF ITERATIONS ALLOWED
+C LEVEL - LEVEL OF OUTPUT CONTROL SWITCH
+C NOUT - OUTPUT UNIT NUMBER
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM2
+C
+C ADAPT - FULLY ADAPTIVE PROCEDURE SWITCH
+C BETADT - SWITCH FOR ADAPTIVE DETERMINATION OF BETA
+C CASEII - ADAPTIVE PROCEDURE CASE SWITCH
+C HALT - STOPPING TEST SWITCH
+C PARTAD - PARTIALLY ADAPTIVE PROCEDURE SWITCH
+C
+C ... VARIABLES IN COMMON BLOCK - ITCOM3
+C
+C BDELNM - TWO NORM OF B TIMES DELTA-SUPER-N
+C BETAB - ESTIMATE FOR THE SPECTRAL RADIUS OF LU MATRIX
+C CME - ESTIMATE OF LARGEST EIGENVALUE
+C DELNNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION N
+C DELSNM - INNER PRODUCT OF PSEUDO-RESIDUAL AT ITERATION S
+C FF - ADAPTIVE PROCEDURE DAMPING FACTOR
+C GAMMA - ACCELERATION PARAMETER
+C OMEGA - OVERRELAXATION PARAMETER FOR SOR AND SSOR
+C QA - PSEUDO-RESIDUAL RATIO
+C QT - VIRTUAL SPECTRAL RADIUS
+C RHO - ACCELERATION PARAMETER
+C RRR - ADAPTIVE PARAMETER
+C SIGE - PARAMETER SIGMA-SUB-E
+C SME - ESTIMATE OF SMALLEST EIGENVALUE
+C SPECR - SPECTRAL RADIUS ESTIMATE FOR SSOR
+C DRELPR - MACHINE RELATIVE PRECISION
+C STPTST - STOPPING PARAMETER
+C UDNM - TWO NORM OF U
+C ZETA - STOPPING CRITERION
+C
+C ... INITIALIZE COMMON BLOCKS
+C
+ LEVEL = IPARM(2)
+ NOUT = IPARM(4)
+ IF (LEVEL.GE.1) WRITE (NOUT,10)
+ 10 FORMAT ('0'///1X,'BEGINNING OF ITPACK SOLUTION MODULE RSSI')
+ IER = 0
+ IF (IPARM(1).LE.0) RETURN
+ N = NN
+ IF (IPARM(11).EQ.0) TIMJ1 = TIMER(DUMMY)
+ IF (LEVEL.GE.3) GO TO 20
+ CALL ECHOUT (IPARM,RPARM,7)
+ GO TO 30
+ 20 CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,1)
+ 30 TEMP = 5.0D2*DRELPR
+ IF (ZETA.GE.TEMP) GO TO 50
+ IF (LEVEL.GE.1) WRITE (NOUT,40) ZETA,DRELPR,TEMP
+ 40 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE RSSI'/' ',' RPARM(1) =',D10.3,
+ * ' (ZETA)'/' ',' A VALUE THIS SMALL MAY HINDER CONVERGENCE '/
+ * ' ',' SINCE MACHINE PRECISION DRELPR =',D10.3/' ',
+ * ' ZETA RESET TO ',D10.3)
+ ZETA = TEMP
+ 50 CONTINUE
+ TIME1 = RPARM(9)
+ TIME2 = RPARM(10)
+ DIGIT1 = RPARM(11)
+ DIGIT2 = RPARM(12)
+C
+C ... VERIFY N
+C
+ IF (N.GT.0) GO TO 70
+ IER = 71
+ IF (LEVEL.GE.0) WRITE (NOUT,60) N
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' INVALID MATRIX DIMENSION, N =',I8)
+ GO TO 420
+ 70 CONTINUE
+C
+C ... REMOVE ROWS AND COLUMNS IF REQUESTED
+C
+ IF (IPARM(10).EQ.0) GO TO 90
+ TOL = RPARM(8)
+ CALL IVFILL (N,IWKSP,0)
+ CALL VFILL (N,WKSP,0.0D0)
+ CALL SBELM (N,IA,JA,A,RHS,IWKSP,WKSP,TOL,ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 90
+ IF (LEVEL.GE.0) WRITE (NOUT,80) IER,TOL
+ 80 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SBELM '/' ',
+ * ' WHICH REMOVES ROWS AND COLUMNS OF SYSTEM '/' ',
+ * ' WHEN DIAGONAL ENTRY TOO LARGE '/' ',' IER = ',I5,5X,
+ * ' RPARM(8) = ',D10.3,' (TOL)')
+C
+C ... INITIALIZE WKSP BASE ADDRESSES.
+C
+ 90 IB1 = 1
+ IB2 = IB1+N
+ JB3 = IB2+N
+C
+C ... PERMUTE TO RED-BLACK SYSTEM IF POSSIBLE
+C
+ NB = IPARM(9)
+ IF (NB.GE.0) GO TO 110
+ N3 = 3*N
+ CALL IVFILL (N3,IWKSP,0)
+ CALL PRBNDX (N,NB,IA,JA,IWKSP,IWKSP(IB2),LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 110
+ IF (LEVEL.GE.0) WRITE (NOUT,100) IER,NB
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PRBNDX'/' ',
+ * ' WHICH COMPUTES THE RED-BLACK INDEXING'/' ',' IER = ',I5
+ * ,' IPARM(9) = ',I5,' (NB)')
+ GO TO 420
+ 110 IF (NB.GE.0.AND.NB.LE.N) GO TO 130
+ IER = 74
+ IF (LEVEL.GE.1) WRITE (NOUT,120) IER,NB
+ 120 FORMAT (/10X,'ERROR DETECTED IN RED-BLACK SUBSYSTEM INDEX'/10X,
+ * 'IER =',I5,' IPARM(9) =',I5,' (NB)')
+ GO TO 420
+ 130 IF (NB.NE.0.AND.NB.NE.N) GO TO 150
+ NB = N/2
+ IF (LEVEL.GE.2.AND.IPARM(9).GE.0) WRITE (NOUT,140) IPARM(9),NB
+ 140 FORMAT (/10X,' IPARM(9) = ',I5,' IMPLIES MATRIX IS DIAGONAL'/10X,
+ * ' NB RESET TO ',I5)
+C
+C ... PERMUTE MATRIX AND RHS
+C
+ 150 IF (IPARM(9).GE.0) GO TO 190
+ IF (LEVEL.GE.2) WRITE (NOUT,160) NB
+ 160 FORMAT (/10X,'ORDER OF BLACK SUBSYSTEM = ',I5,' (NB)')
+ CALL PERMAT (N,IA,JA,A,IWKSP,IWKSP(JB3),ISYM,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 180
+ IF (LEVEL.GE.0) WRITE (NOUT,170) IER
+ 170 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH DOES THE RED-BLACK PERMUTATION'/' ',' IER = ',I5)
+ GO TO 420
+ 180 CALL PERVEC (N,RHS,IWKSP)
+ CALL PERVEC (N,U,IWKSP)
+C
+C ... INITIALIZE WKSP BASE ADDRESSES
+C
+ 190 NR = N-NB
+C
+ NRP1 = NR+1
+ IPARM(8) = N+NB
+ IF (NW.GE.IPARM(8)) GO TO 210
+ IER = 72
+ IF (LEVEL.GE.0) WRITE (NOUT,200) NW,IPARM(8)
+ 200 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' NOT ENOUGH WORKSPACE AT ',I10/' ',' SET IPARM(8) =',I10
+ * ,' (NW)')
+ GO TO 420
+C
+C ... SCALE LINEAR SYSTEM, U, AND RHS BY THE SQUARE ROOT OF THE
+C ... DIAGONAL ELEMENTS.
+C
+ 210 CONTINUE
+ CALL VFILL (IPARM(8),WKSP,0.0D0)
+ CALL SCAL (N,IA,JA,A,RHS,U,WKSP,LEVEL,NOUT,IER)
+ IF (IER.EQ.0) GO TO 230
+ IF (LEVEL.GE.0) WRITE (NOUT,220) IER
+ 220 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE SCAL '/' ',
+ * ' WHICH SCALES THE SYSTEM '/' ',' IER = ',I5)
+ GO TO 420
+ 230 IF (LEVEL.LE.2) GO TO 250
+ WRITE (NOUT,240)
+ 240 FORMAT (///1X,'IN THE FOLLOWING, RHO AND GAMMA ARE',
+ * ' ACCELERATION PARAMETERS')
+ 250 IF (IPARM(11).NE.0) GO TO 260
+ TIMI1 = TIMER(DUMMY)
+C
+C ... ITERATION SEQUENCE
+C
+ 260 IF (N.GT.1) GO TO 270
+ U(1) = RHS(1)
+ GO TO 320
+ 270 ITMAX1 = ITMAX+1
+ DO 290 LOOP = 1,ITMAX1
+ IN = LOOP-1
+ IF (MOD(IN,2).EQ.1) GO TO 280
+C
+C ... CODE FOR THE EVEN ITERATIONS.
+C
+C U = U(IN)
+C WKSP(IB1) = U(IN-1)
+C
+ CALL ITRSSI (N,NB,IA,JA,A,RHS,U,WKSP(IB1),WKSP(IB2))
+C
+ IF (HALT) GO TO 320
+ GO TO 290
+C
+C ... CODE FOR THE ODD ITERATIONS.
+C
+C U = U(IN-1)
+C WKSP(IB1) = U(IN)
+C
+ 280 CALL ITRSSI (N,NB,IA,JA,A,RHS,WKSP(IB1),U,WKSP(IB2))
+C
+ IF (HALT) GO TO 320
+ 290 CONTINUE
+C
+C ... ITMAX HAS BEEN REACHED
+C
+ IF (IPARM(11).NE.0) GO TO 300
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 300 IF (LEVEL.GE.1) WRITE (NOUT,310) ITMAX
+ 310 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE RSSI'/' ',' FAILURE TO CONVERGE IN',
+ * I5,' ITERATIONS')
+ IER = 73
+ IF (IPARM(3).EQ.0) RPARM(1) = STPTST
+ GO TO 350
+C
+C ... METHOD HAS CONVERGED
+C
+ 320 IF (IPARM(11).NE.0) GO TO 330
+ TIMI2 = TIMER(DUMMY)
+ TIME1 = DBLE(TIMI2-TIMI1)
+ 330 IF (LEVEL.GE.1) WRITE (NOUT,340) IN
+ 340 FORMAT (/1X,'RSSI HAS CONVERGED IN ',I5,' ITERATIONS')
+C
+C ... PUT SOLUTION INTO U IF NOT ALREADY THERE.
+C
+ 350 CONTINUE
+ IF (N.EQ.1) GO TO 360
+ IF (MOD(IN,2).EQ.1) CALL DCOPY (N,WKSP(IB1),1,U,1)
+ CALL DCOPY (NR,RHS,1,U,1)
+ CALL PRSRED (NB,NR,IA,JA,A,U(NRP1),U)
+C
+C ... UNSCALE THE MATRIX, SOLUTION, AND RHS VECTORS.
+C
+ 360 CALL UNSCAL (N,IA,JA,A,RHS,U,WKSP)
+C
+C ... UN-PERMUTE MATRIX,RHS, AND SOLUTION
+C
+ IF (IPARM(9).GE.0) GO TO 390
+ CALL PERMAT (N,IA,JA,A,IWKSP(IB2),IWKSP(JB3),ISYM,LEVEL,NOUT,
+ * IERPER)
+ IF (IERPER.EQ.0) GO TO 380
+ IF (LEVEL.GE.0) WRITE (NOUT,370) IERPER
+ 370 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' CALLED FROM ITPACK ROUTINE RSSI '/' ',
+ * ' ERROR DETECTED IN SUBROUTINE PERMAT'/' ',
+ * ' WHICH UNDOES THE RED-BLACK PERMUTATION '/' ',
+ * ' IER = ',I5)
+ IF (IER.EQ.0) IER = IERPER
+ GO TO 420
+ 380 CALL PERVEC (N,RHS,IWKSP(IB2))
+ CALL PERVEC (N,U,IWKSP(IB2))
+C
+C ... OPTIONAL ERROR ANALYSIS
+C
+ 390 IDGTS = IPARM(12)
+ IF (IDGTS.LT.0) GO TO 400
+ IF (IPARM(2).LE.0) IDGTS = 0
+ CALL PERROR (N,IA,JA,A,RHS,U,WKSP,DIGIT1,DIGIT2,IDGTS)
+C
+C ... SET RETURN PARAMETERS IN IPARM AND RPARM
+C
+ 400 IF (IPARM(11).NE.0) GO TO 410
+ TIMJ2 = TIMER(DUMMY)
+ TIME2 = DBLE(TIMJ2-TIMJ1)
+ 410 IF (IPARM(3).NE.0) GO TO 420
+ IPARM(1) = IN
+ IPARM(9) = NB
+ RPARM(2) = CME
+ RPARM(3) = SME
+ RPARM(9) = TIME1
+ RPARM(10) = TIME2
+ RPARM(11) = DIGIT1
+ RPARM(12) = DIGIT2
+C
+ 420 CONTINUE
+ IERR = IER
+ IF (LEVEL.GE.3) CALL ECHALL (N,IA,JA,A,RHS,IPARM,RPARM,2)
+C
+ RETURN
+ END
+ SUBROUTINE ITJCG (NN,IA,JA,A,U,U1,D,D1,DTWD,TRI)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITJCG, PERFORMS ONE ITERATION OF THE
+C JACOBI CONJUGATE GRADIENT ALGORITHM. IT IS CALLED BY JCG.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. CONTAINS INFORMATION DEFINING
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. CONTAINS THE NONZERO VALUES OF THE
+C LINEAR SYSTEM.
+C U INPUT D.P. VECTOR. CONTAINS THE VALUE OF THE
+C SOLUTION VECTOR AT THE END OF IN ITERATIONS.
+C U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, IT CONTAINS
+C THE VALUE OF THE SOLUTION AT THE END OF THE IN-1
+C ITERATION. ON OUTPUT, IT WILL CONTAIN THE NEWEST
+C ESTIMATE FOR THE SOLUTION VECTOR.
+C D INPUT D.P. VECTOR. CONTAINS THE PSEUDO-RESIDUAL
+C VECTOR AFTER IN ITERATIONS.
+C D1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, D1 CONTAINS
+C THE PSEUDO-RESIDUAL VECTOR AFTER IN-1 ITERATIONS. ON
+C OUTPUT, IT WILL CONTAIN THE NEWEST PSEUDO-RESIDUAL
+C VECTOR.
+C DTWD D.P. ARRAY. USED IN THE COMPUTATIONS OF THE
+C ACCELERATION PARAMETER GAMMA AND THE NEW PSEUDO-
+C RESIDUAL.
+C TRI D.P. ARRAY. STORES THE TRIDIAGONAL MATRIX ASSOCIATED
+C WITH THE EIGENVALUES OF THE CONJUGATE GRADIENT
+C POLYNOMIAL.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),U1(NN),D(NN),D1(NN),DTWD(NN),TRI(2,1)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER N
+ DOUBLE PRECISION CON,C1,C2,C3,C4,DNRM,DTNRM,GAMOLD,RHOOLD,RHOTMP
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE JCG
+C
+C ... COMPUTE NEW ESTIMATE FOR CME IF ADAPT = .TRUE.
+C
+ IF (ADAPT) CALL CHGCON (TRI,GAMOLD,RHOOLD,1)
+C
+C ... TEST FOR STOPPING
+C
+ N = NN
+ DELNNM = DDOT(N,D,1,D,1)
+ DNRM = DELNNM
+ CON = CME
+ CALL PSTOP (N,U,DNRM,CON,1,Q1)
+ IF (HALT) GO TO 30
+C
+C ... COMPUTE RHO AND GAMMA - ACCELERATION PARAMETERS
+C
+ CALL VFILL (N,DTWD,0.D0)
+ CALL PJAC (N,IA,JA,A,D,DTWD)
+ DTNRM = DDOT(N,D,1,DTWD,1)
+ IF (ISYM.EQ.0) GO TO 10
+ RHOTMP = DDOT(N,DTWD,1,D1,1)
+ CALL PARCON (DTNRM,C1,C2,C3,C4,GAMOLD,RHOTMP,1)
+ RHOOLD = RHOTMP
+ GO TO 20
+ 10 CALL PARCON (DTNRM,C1,C2,C3,C4,GAMOLD,RHOOLD,1)
+C
+C ... COMPUTE U(IN+1) AND D(IN+1)
+C
+ 20 CALL SUM3 (N,C1,D,C2,U,C3,U1)
+ CALL SUM3 (N,C1,DTWD,C4,D,C3,D1)
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 30 CALL ITERM (N,A,U,DTWD,1)
+C
+ RETURN
+ END
+ SUBROUTINE ITJSI (NN,IA,JA,A,RHS,U,U1,D,ICNT)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITJSI, PERFORMS ONE ITERATION OF THE
+C JACOBI SEMI-ITERATIVE ALGORITHM. IT IS CALLED BY JSI.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE
+C SOLUTION VECTOR AFTER IN ITERATIONS.
+C U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE
+C SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT,
+C IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION
+C VECTOR.
+C D D.P. ARRAY. D IS USED FOR THE COMPUTATION OF THE
+C PSEUDO-RESIDUAL ARRAY FOR THE CURRENT ITERATION.
+C ICNT NUMBER OF ITERATIONS SINCE LAST CHANGE OF SME
+C
+C ... SPECIFICATIONS OF ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN,ICNT
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),U1(NN),D(NN)
+C
+C ... SPECIFICATIONS OF LOCAL VARIABLES
+C
+ INTEGER N
+ DOUBLE PRECISION CON,C1,C2,C3,DNRM,DTNRM,OLDNRM
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS OF FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT,PVTBV
+ LOGICAL TSTCHG,CHGSME
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE JSI
+C
+ N = NN
+ IF (IN.EQ.0) ICNT = 0
+C
+C ... COMPUTE PSEUDO-RESIDUALS
+C
+ CALL DCOPY (N,RHS,1,D,1)
+ CALL PJAC (N,IA,JA,A,U,D)
+ CALL VEVMW (N,D,U)
+C
+C ... STOPPING AND ADAPTIVE CHANGE TESTS
+C
+ OLDNRM = DELNNM
+ DELNNM = DDOT(N,D,1,D,1)
+ DNRM = DELNNM
+ CON = CME
+ CALL PSTOP (N,U,DNRM,CON,1,Q1)
+ IF (HALT) GO TO 40
+ IF (.NOT.ADAPT) GO TO 30
+ IF (.NOT.TSTCHG(1)) GO TO 10
+C
+C ... CHANGE ITERATIVE PARAMETERS (CME)
+C
+ DTNRM = PVTBV(N,IA,JA,A,D)
+ CALL CHGSI (DTNRM,1)
+ IF (.NOT.ADAPT) GO TO 30
+ GO TO 20
+C
+C ... TEST IF SME NEEDS TO BE CHANGED AND CHANGE IF NECESSARY.
+C
+ 10 CONTINUE
+ IF (CASEII) GO TO 30
+ IF (.NOT.CHGSME(OLDNRM,ICNT)) GO TO 30
+ ICNT = 0
+C
+C ... COMPUTE U(IN+1) AFTER CHANGE OF PARAMETERS
+C
+ 20 CALL DCOPY (N,U,1,U1,1)
+ CALL DAXPY (N,GAMMA,D,1,U1,1)
+ GO TO 40
+C
+C ... COMPUTE U(IN+1) WITHOUT CHANGE OF PARAMETERS
+C
+ 30 CALL PARSI (C1,C2,C3,1)
+ CALL SUM3 (N,C1,D,C2,U,C3,U1)
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 40 CALL ITERM (N,A,U,D,2)
+C
+ RETURN
+ END
+ SUBROUTINE ITSOR (NN,IA,JA,A,RHS,U,WK)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITSOR, PERFORMS ONE ITERATION OF THE
+C SUCCESSIVE OVERRELAXATION ALGORITHM. IT IS CALLED BY SOR.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT/OUTPUT D.P. VECTOR. ON INPUT, U CONTAINS THE
+C SOLUTION VECTOR AFTER IN ITERATIONS. ON OUTPUT,
+C IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION
+C VECTOR.
+C WK D.P. ARRAY. WORK VECTOR OF LENGTH N.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),WK(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP,IPHAT,IPSTAR,ISS,N
+ DOUBLE PRECISION DNRM,H,OMEGAP,SPCRM1
+ LOGICAL CHANGE,Q1
+C
+ DOUBLE PRECISION TAU
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE SOR
+C
+C ... SET INITIAL PARAMETERS NOT ALREADY SET
+C
+ N = NN
+ IF (IN.NE.0) GO TO 20
+ CALL PSTOP (N,U,0.D0,0.D0,0,Q1)
+ IF (ADAPT) GO TO 10
+ CHANGE = .FALSE.
+ IP = 0
+ IPHAT = 2
+ ISS = 0
+ GO TO 30
+C
+ 10 CHANGE = .TRUE.
+ IP = 0
+ OMEGAP = OMEGA
+ OMEGA = 1.D0
+ ISS = 0
+ IPHAT = 2
+ IPSTAR = 4
+ IF (OMEGAP.LE.1.D0) CHANGE = .FALSE.
+C
+C ... RESET OMEGA, IPHAT, AND IPSTAR (CIRCLE A IN FLOWCHART)
+C
+ 20 IF (.NOT.CHANGE) GO TO 30
+ CHANGE = .FALSE.
+ IS = IS+1
+ IP = 0
+ ISS = 0
+ OMEGA = DMIN1(OMEGAP,TAU(IS))
+ IPHAT = MAX0(3,IFIX(SNGL((OMEGA-1.D0)/(2.D0-OMEGA))))
+ IPSTAR = IPSTR(OMEGA)
+C
+C ... COMPUTE U (IN + 1) AND NORM OF DEL(S,P) - CIRCLE B IN FLOW CHART
+C
+ 30 CONTINUE
+ DELSNM = DELNNM
+ SPCRM1 = SPECR
+ CALL DCOPY (N,RHS,1,WK,1)
+ CALL PFSOR1 (N,IA,JA,A,U,WK)
+ IF (DELNNM.EQ.0.D0) GO TO 40
+ IF (IN.NE.0) SPECR = DELNNM/DELSNM
+ IF (IP.LT.IPHAT) GO TO 70
+C
+C ... STOPPING TEST, SET H
+C
+ IF (SPECR.GE.1.D0) GO TO 70
+ IF (.NOT.(SPECR.GT.(OMEGA-1.D0))) GO TO 40
+ H = SPECR
+ GO TO 50
+ 40 ISS = ISS+1
+ H = OMEGA-1.D0
+C
+C ... PERFORM STOPPING TEST.
+C
+ 50 CONTINUE
+ DNRM = DELNNM**2
+ CALL PSTOP (N,U,DNRM,H,1,Q1)
+ IF (HALT) GO TO 70
+C
+C ... METHOD HAS NOT CONVERGED YET, TEST FOR CHANGING OMEGA
+C
+ IF (.NOT.ADAPT) GO TO 70
+ IF (IP.LT.IPSTAR) GO TO 70
+ IF (OMEGA.GT.1.D0) GO TO 60
+ CME = DSQRT(DABS(SPECR))
+ OMEGAP = 2.D0/(1.D0+DSQRT(DABS(1.D0-SPECR)))
+ CHANGE = .TRUE.
+ GO TO 70
+ 60 IF (ISS.NE.0) GO TO 70
+ IF (SPECR.LE.(OMEGA-1.D0)**FF) GO TO 70
+ IF ((SPECR+5.D-5).LE.SPCRM1) GO TO 70
+C
+C ... CHANGE PARAMETERS
+C
+ CME = (SPECR+OMEGA-1.D0)/(DSQRT(DABS(SPECR))*OMEGA)
+ OMEGAP = 2.D0/(1.D0+DSQRT(DABS(1.D0-CME*CME)))
+ CHANGE = .TRUE.
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 70 CALL ITERM (N,A,U,WK,3)
+ IP = IP+1
+C
+ RETURN
+ END
+ SUBROUTINE ITSRCG (NN,IA,JA,A,RHS,U,U1,C,C1,D,DL,WK,TRI)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITSRCG, PERFORMS ONE ITERATION OF THE
+C SYMMETRIC SOR CONJUGATE GRADIENT ALGORITHM. IT IS CALLED BY
+C SSORCG.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE OF THE
+C SOLUTION VECTOR AFTER IN ITERATIONS.
+C U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE
+C THE ESTIMATE FOR THE SOLUTION AFTER IN-1 ITERATIONS.
+C ON OUTPUT, U1 CONTAINS THE UPDATED ESTIMATE.
+C C INPUT D.P. VECTOR. CONTAINS THE FORWARD RESIDUAL
+C AFTER IN ITERATIONS.
+C C1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, C1 CONTAINS
+C THE FORWARD RESIDUAL AFTER IN-1 ITERATIONS. ON
+C OUTPUT, C1 CONTAINS THE UPDATED FORWARD RESIDUAL.
+C D D.P. VECTOR. IS USED TO COMPUTE THE BACKWARD PSEUDO-
+C RESIDUAL VECTOR FOR THE CURRENT ITERATION.
+C DL D.P. VECTOR. IS USED IN THE COMPUTATIONS OF THE
+C ACCELERATION PARAMETERS.
+C WK D.P. VECTOR. WORKING SPACE OF LENGTH N.
+C TRI D.P. VECTOR. STORES THE TRIDIAGONAL MATRIX ASSOCIATED
+C WITH THE CONJUGATE GRADIENT ACCELERATION.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),U1(NN),C(NN),C1(NN),D(NN),
+ * DL(NN),WK(NN),TRI(2,1)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER N
+ DOUBLE PRECISION BETNEW,CON,DNRM,GAMOLD,RHOOLD,RHOTMP,T1,T2,T3,T4
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT,PBETA,PVTBV
+ LOGICAL OMGCHG,OMGSTR
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE SSORCG
+C
+C ... CALCULATE S-PRIME FOR ADAPTIVE PROCEDURE.
+C
+ N = NN
+ IF (ADAPT.OR.PARTAD) CALL CHGCON (TRI,GAMOLD,RHOOLD,3)
+C
+C ... COMPUTE BACKWARD RESIDUAL
+C
+ CALL DCOPY (N,RHS,1,WK,1)
+ CALL DCOPY (N,C,1,D,1)
+ CALL VEVPW (N,D,U)
+ CALL PBSOR (N,IA,JA,A,D,WK)
+ CALL VEVMW (N,D,U)
+C
+C ... COMPUTE ACCELERATION PARAMETERS AND THEN U(IN+1) (IN U1)
+C
+ CALL DCOPY (N,D,1,DL,1)
+ CALL VFILL (N,WK,0.D0)
+ CALL PFSOR (N,IA,JA,A,DL,WK)
+ CALL WEVMW (N,D,DL)
+ DELNNM = DDOT(N,C,1,C,1)
+ IF (DELNNM.EQ.0.D0) GO TO 30
+ DNRM = DDOT(N,C,1,DL,1)
+ IF (DNRM.EQ.0.D0) GO TO 30
+ IF (ISYM.EQ.0) GO TO 10
+ RHOTMP = DDOT(N,C,1,C1,1)-DDOT(N,DL,1,C1,1)
+ CALL PARCON (DNRM,T1,T2,T3,T4,GAMOLD,RHOTMP,3)
+ RHOOLD = RHOTMP
+ GO TO 20
+ 10 CALL PARCON (DNRM,T1,T2,T3,T4,GAMOLD,RHOOLD,3)
+ 20 CALL SUM3 (N,T1,D,T2,U,T3,U1)
+C
+C ... TEST FOR STOPPING
+C
+ 30 BDELNM = DDOT(N,D,1,D,1)
+ DNRM = BDELNM
+ CON = SPECR
+ CALL PSTOP (N,U,DNRM,CON,1,Q1)
+ IF (HALT) GO TO 100
+C
+C ... IF NON- OR PARTIALLY-ADAPTIVE, COMPUTE C(IN+1) AND EXIT.
+C
+ IF (ADAPT) GO TO 40
+ CALL SUM3 (N,-T1,DL,T2,C,T3,C1)
+ GO TO 100
+C
+C ... FULLY ADAPTIVE PROCEDURE
+C
+ 40 CONTINUE
+ IF (OMGSTR(1)) GO TO 90
+ IF (OMGCHG(1)) GO TO 50
+C
+C ... PARAMETERS HAVE BEEN UNCHANGED. COMPUTE C(IN+1) AND EXIT.
+C
+ CALL SUM3 (N,-T1,DL,T2,C,T3,C1)
+ GO TO 100
+C
+C ... IT HAS BEEN DECIDED TO CHANGE PARAMETERS
+C (1) COMPUTE NEW BETAB IF BETADT = .TRUE.
+C
+ 50 CONTINUE
+ IF (.NOT.BETADT) GO TO 60
+ BETNEW = PBETA(N,IA,JA,A,D,WK,C1)/BDELNM
+ BETAB = DMAX1(BETAB,.25D0,BETNEW)
+C
+C ... (2) COMPUTE NEW CME, OMEGA, AND SPECR
+C
+ 60 CONTINUE
+ IF (CASEII) GO TO 70
+ DNRM = PVTBV(N,IA,JA,A,D)
+ GO TO 80
+ 70 CALL VFILL (N,WK,0.D0)
+ CALL PJAC (N,IA,JA,A,D,WK)
+ DNRM = DDOT(N,WK,1,WK,1)
+ 80 CALL OMEG (DNRM,3)
+C
+C ... (3) COMPUTE NEW FORWARD RESIDUAL SINCE OMEGA HAS BEEN CHANGED.
+C
+ 90 CONTINUE
+ CALL DCOPY (N,RHS,1,WK,1)
+ CALL DCOPY (N,U1,1,C1,1)
+ CALL PFSOR (N,IA,JA,A,C1,WK)
+ CALL VEVMW (N,C1,U1)
+C
+C ... OUTPUT INTERMEDIATE RESULTS.
+C
+ 100 CALL ITERM (N,A,U,WK,4)
+C
+ RETURN
+ END
+ SUBROUTINE ITSRSI (NN,IA,JA,A,RHS,U,U1,C,D,CTWD,WK)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITSRSI, PERFORMS ONE ITERATION OF THE
+C SYMMETRIC SOR SEMI-ITERATION ALGORITHM. IT IS CALLED BY
+C SSORSI.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX. (= NN)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C U INPUT D.P. VECTOR. CONTAINS THE ESTIMATE OF THE
+C SOLUTION VECTOR AFTER IN ITERATIONS.
+C U1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, U1 CONTAINS THE
+C THE ESTIMATE FOR THE SOLUTION AFTER IN-1 ITERATIONS.
+C ON OUTPUT, U1 CONTAINS THE UPDATED ESTIMATE.
+C C D.P. VECTOR. IS USED TO COMPUTE THE FORWARD PSEUDO-
+C RESIDUAL VECTOR FOR THE CURRENT ITERATION.
+C D D.P. VECTOR. IS USED TO COMPUTE THE BACKWARD PSEUDO-
+C RESIDUAL VECTOR FOR THE CURRENT ITERATION.
+C CTWD D.P. VECTOR. IS USED IN THE COMPUTATIONS OF THE
+C ACCELERATION PARAMETERS.
+C WK D.P. VECTOR. WORKING SPACE OF LENGTH N.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),U1(NN),C(NN),D(NN),WK(NN),
+ * CTWD(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER N
+ DOUBLE PRECISION BETNEW,CON,C1,C2,C3,DNRM
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT,PBETA,PVTBV
+ LOGICAL OMGSTR,TSTCHG
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE SSORSI
+C
+C ... COMPUTE PSEUDO-RESIDUALS (FORWARD AND BACKWARD)
+C
+ N = NN
+ CALL DCOPY (N,RHS,1,WK,1)
+ CALL DCOPY (N,U,1,CTWD,1)
+ CALL PSSOR1 (N,IA,JA,A,CTWD,WK,C,D)
+C
+C ... COMPUTE U(IN+1) -- CONTAINED IN THE VECTOR U1.
+C
+ CALL PARSI (C1,C2,C3,3)
+ CALL SUM3 (N,C1,D,C2,U,C3,U1)
+C
+C ... TEST FOR STOPPING
+C
+ BDELNM = DDOT(N,D,1,D,1)
+ DNRM = BDELNM
+ CON = SPECR
+ CALL PSTOP (N,U,DNRM,CON,1,Q1)
+ IF (HALT.OR..NOT.(ADAPT.OR.PARTAD)) GO TO 40
+C
+C ... ADAPTIVE PROCEDURE
+C
+ IF (OMGSTR(1)) GO TO 40
+ DELNNM = DDOT(N,C,1,C,1)
+ IF (IN.EQ.IS) DELSNM = DELNNM
+ IF (IN.EQ.0.OR..NOT.TSTCHG(1)) GO TO 40
+C
+C ... IT HAS BEEN DECIDED TO CHANGE PARAMETERS.
+C ... (1) COMPUTE CTWD
+C
+ CALL DCOPY (N,D,1,CTWD,1)
+ CALL VFILL (N,WK,0.D0)
+ CALL PFSOR (N,IA,JA,A,CTWD,WK)
+ CALL VEVPW (N,CTWD,C)
+ CALL VEVMW (N,CTWD,D)
+C
+C ... (2) COMPUTE NEW SPECTRAL RADIUS FOR CURRENT OMEGA.
+C
+ DNRM = DDOT(N,C,1,CTWD,1)
+ CALL CHGSI (DNRM,3)
+ IF (.NOT.ADAPT) GO TO 40
+C
+C ... (3) COMPUTE NEW BETAB IF BETADT = .TRUE.
+C
+ IF (.NOT.BETADT) GO TO 10
+ BETNEW = PBETA(N,IA,JA,A,D,WK,CTWD)/BDELNM
+ BETAB = DMAX1(BETAB,.25D0,BETNEW)
+C
+C ... (4) COMPUTE NEW CME, OMEGA, AND SPECR.
+C
+ 10 CONTINUE
+ IF (CASEII) GO TO 20
+ DNRM = PVTBV(N,IA,JA,A,D)
+ GO TO 30
+ 20 CALL VFILL (N,WK,0.D0)
+ CALL PJAC (N,IA,JA,A,D,WK)
+ DNRM = DDOT(N,WK,1,WK,1)
+ 30 CALL OMEG (DNRM,3)
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 40 CALL ITERM (N,A,U,WK,5)
+C
+ RETURN
+ END
+ SUBROUTINE ITRSCG (N,NNB,IA,JA,A,UB,UB1,DB,DB1,WB,TRI)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITRSCG, PERFORMS ONE ITERATION OF THE
+C REDUCED SYSTEM CONJUGATE GRADIENT ALGORITHM. IT IS
+C CALLED BY RSCG.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX.
+C NB INPUT INTEGER. CONTAINS THE NUMBER OF BLACK POINTS
+C IN THE RED-BLACK MATRIX. (= NNB)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C UB INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE
+C SOLUTION ON THE BLACK POINTS AFTER IN ITERATIONS.
+C UB1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, UB1 CONTAINS THE
+C SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT,
+C IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION
+C VECTOR. THIS IS ONLY FOR THE BLACK POINTS.
+C DB INPUT D.P. ARRAY. DB CONTAINS THE VALUE OF THE
+C CURRENT PSEUDO-RESIDUAL ON THE BLACK POINTS.
+C DB1 INPUT/OUTPUT D.P. ARRAY. DB1 CONTAINS THE PSEUDO-
+C RESIDUAL ON THE BLACK POINTS FOR THE IN-1 ITERATION
+C ON INPUT. ON OUTPUT, IT IS FOR THE IN+1 ITERATION.
+C WB D.P. ARRAY. WB IS USED FOR COMPUTATIONS INVOLVING
+C BLACK VECTORS.
+C TRI D.P. ARRAY. STORES THE TRIDIAGONAL MATRIX ASSOCIATED
+C WITH CONJUGATE GRADIENT ACCELERATION.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),N,NNB
+ DOUBLE PRECISION A(1),UB(N),UB1(N),DB(NNB),DB1(N),WB(NNB),TRI(2,1)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER NB,NR,NRP1
+ DOUBLE PRECISION CON,C1,C2,C3,C4,DNRM,GAMOLD,RHOOLD,RHOTMP
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE RSCG
+C
+C ... COMPUTE NEW ESTIMATE FOR CME IF ADAPT = .TRUE.
+C
+ NB = NNB
+ NR = N-NB
+ NRP1 = NR+1
+ IF (ADAPT) CALL CHGCON (TRI,GAMOLD,RHOOLD,2)
+C
+C ... TEST FOR STOPPING
+C
+ DELNNM = DDOT(NB,DB,1,DB,1)
+ DNRM = DELNNM
+ CON = CME
+ CALL PSTOP (NB,UB(NRP1),DNRM,CON,2,Q1)
+ IF (HALT) GO TO 30
+C
+C ... COMPUTE ACCELERATION PARAMETERS
+C
+ CALL VFILL (NR,UB1,0.D0)
+ CALL PRSRED (NB,NR,IA,JA,A,DB,UB1)
+ CALL VFILL (NB,WB,0.D0)
+ CALL PRSBLK (NB,NR,IA,JA,A,UB1,WB)
+ DNRM = DDOT(NB,DB,1,WB,1)
+ IF (ISYM.EQ.0) GO TO 10
+ RHOTMP = DDOT(NB,WB,1,DB1,1)
+ CALL PARCON (DNRM,C1,C2,C3,C4,GAMOLD,RHOTMP,2)
+ RHOOLD = RHOTMP
+ GO TO 20
+ 10 CALL PARCON (DNRM,C1,C2,C3,C4,GAMOLD,RHOOLD,2)
+C
+C ... COMPUTE UB(IN+1) AND DB(IN+1)
+C
+ 20 CALL SUM3 (NB,C1,DB,C2,UB(NRP1),C3,UB1(NRP1))
+ CALL SUM3 (NB,C1,WB,C4,DB,C3,DB1)
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 30 CALL ITERM (NB,A(NRP1),UB(NRP1),WB,6)
+C
+ RETURN
+ END
+ SUBROUTINE ITRSSI (N,NNB,IA,JA,A,RHS,UB,UB1,DB)
+C
+C ... FUNCTION:
+C
+C THIS SUBROUTINE, ITRSSI, PERFORMS ONE ITERATION OF THE
+C REDUCED SYSTEM SEMI-ITERATION ALGORITHM. IT IS
+C CALLED BY RSSI.
+C
+C ... PARAMETER LIST:
+C
+C N INPUT INTEGER. DIMENSION OF THE MATRIX.
+C NB INPUT INTEGER. CONTAINS THE NUMBER OF BLACK POINTS
+C IN THE RED-BLACK MATRIX. (= NNB)
+C IA,JA INPUT INTEGER VECTORS. THE TWO INTEGER ARRAYS OF
+C THE SPARSE MATRIX REPRESENTATION.
+C A INPUT D.P. VECTOR. THE D.P. ARRAY OF THE SPARSE
+C MATRIX REPRESENTATION.
+C RHS INPUT D.P. VECTOR. CONTAINS THE RIGHT HAND SIDE
+C OF THE MATRIX PROBLEM.
+C UB INPUT D.P. VECTOR. CONTAINS THE ESTIMATE FOR THE
+C SOLUTION ON THE BLACK POINTS AFTER IN ITERATIONS.
+C UB1 INPUT/OUTPUT D.P. VECTOR. ON INPUT, UB1 CONTAINS THE
+C SOLUTION VECTOR AFTER IN-1 ITERATIONS. ON OUTPUT,
+C IT WILL CONTAIN THE NEWEST ESTIMATE FOR THE SOLUTION
+C VECTOR. THIS IS ONLY FOR THE BLACK POINTS.
+C DB INPUT D.P. ARRAY. DB CONTAINS THE VALUE OF THE
+C CURRENT PSEUDO-RESIDUAL ON THE BLACK POINTS.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),N,NNB
+ DOUBLE PRECISION A(1),RHS(N),UB(N),UB1(N),DB(NNB)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER NB,NR,NRP1
+ DOUBLE PRECISION CONST,C1,C2,C3,DNRM
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT
+ LOGICAL TSTCHG
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN SUBROUTINE RSSI
+C
+C ... COMPUTE UR(IN) INTO UB
+C
+ NB = NNB
+ NR = N-NB
+ NRP1 = NR+1
+ CALL DCOPY (NR,RHS,1,UB,1)
+ CALL PRSRED (NB,NR,IA,JA,A,UB(NRP1),UB)
+C
+C ... COMPUTE PSEUDO-RESIDUAL, DB(IN)
+C
+ CALL DCOPY (NB,RHS(NRP1),1,DB,1)
+ CALL PRSBLK (NB,NR,IA,JA,A,UB,DB)
+ CALL VEVMW (NB,DB,UB(NRP1))
+C
+C ... TEST FOR STOPPING
+C
+ DELNNM = DDOT(NB,DB,1,DB,1)
+ DNRM = DELNNM
+ CONST = CME
+ CALL PSTOP (NB,UB(NRP1),DNRM,CONST,2,Q1)
+ IF (HALT) GO TO 20
+ IF (.NOT.ADAPT) GO TO 10
+C
+C ... TEST TO CHANGE PARAMETERS
+C
+ IF (.NOT.TSTCHG(2)) GO TO 10
+C
+C ... CHANGE PARAMETERS
+C
+ CALL VFILL (NR,UB1,0.D0)
+ CALL PRSRED (NB,NR,IA,JA,A,DB,UB1)
+ DNRM = DDOT(NR,UB1,1,UB1,1)
+ CALL CHGSI (DNRM,2)
+ IF (.NOT.ADAPT) GO TO 10
+C
+C ... COMPUTE UB(N+1) AFTER CHANGING PARAMETERS
+C
+ CALL DCOPY (NB,UB(NRP1),1,UB1(NRP1),1)
+ CALL DAXPY (NB,GAMMA,DB,1,UB1(NRP1),1)
+ GO TO 20
+C
+C ... COMPUTE UB(N+1) WITHOUT CHANGE OF PARAMETERS
+C
+ 10 CALL PARSI (C1,C2,C3,2)
+ CALL SUM3 (NB,C1,DB,C2,UB(NRP1),C3,UB1(NRP1))
+C
+C ... OUTPUT INTERMEDIATE INFORMATION
+C
+ 20 CALL ITERM (NB,A(NRP1),UB(NRP1),DB,7)
+C
+ RETURN
+ END
+ INTEGER FUNCTION BISRCH (N,K,L)
+C
+C ... BISRCH IS AN INTEGER FUNCTION WHICH USES A BISECTION SEARCH
+C TO FIND THE ENTRY J IN THE ARRAY K SUCH THAT THE VALUE L IS
+C GREATER THAN OR EQUAL TO K(J) AND STRICTLY LESS THAN K(J+1).
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTOR K
+C K INTEGER VECTOR
+C L INTEGER CONSTANT SUCH THAT K(J) .GE. L .LT. K(J+1)
+C WITH J RETURNED AS VALUE OF INTEGER FUNCTION BISRCH
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,L,K(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER JLEFT,JMID,JRIGHT
+C
+ JLEFT = 1
+ JRIGHT = N
+ IF (N.EQ.2) GO TO 40
+ JMID = (N+1)/2
+C
+ 10 IF (L.GE.K(JMID)) GO TO 20
+C
+C ...... L .GE. K(LEFT) AND L .LT. K(JMID)
+C
+ JRIGHT = JMID
+ GO TO 30
+C
+C ...... L .GE. K(JMID) AND L .LT. K(JRIGHT)
+C
+ 20 JLEFT = JMID
+C
+C ...... TEST FOR CONVERGENCE
+C
+ 30 IF (JRIGHT-JLEFT.EQ.1) GO TO 40
+ JMID = JLEFT+(JRIGHT-JLEFT+1)/2
+ GO TO 10
+C
+C ...... BISECTION SEARCH FINISHED
+C
+ 40 BISRCH = JLEFT
+C
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION CHEBY (QA,QT,RRR,IP,CME,SME)
+C
+C COMPUTES THE SOLUTION TO THE CHEBYSHEV EQUATION
+C
+C ... PARAMETER LIST:
+C
+C QA RATIO OF PSEUDO-RESIDUALS
+C QT VIRTUAL SPECTRAL RADIUS
+C RRR ADAPTIVE PARAMETER
+C IP NUMBER OF ITERATIONS SINCE LAST CHANGE OF
+C PARAMETERS
+C CME, ESTIMATES FOR THE LARGEST AND SMALLEST EIGEN-
+C SME VALUES OF THE ITERATION MATRIX
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IP
+ DOUBLE PRECISION CME,QA,QT,RRR,SME
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION X,Y,Z
+C
+ Z = .5D0*(QA+DSQRT(DABS(QA**2-QT**2)))*(1.D0+RRR**IP)
+ X = Z**(1.D0/DBLE(FLOAT(IP)))
+ Y = (X+RRR/X)/(1.D0+RRR)
+C
+ CHEBY = .5D0*(CME+SME+Y*(2.D0-CME-SME))
+C
+ RETURN
+ END
+ SUBROUTINE CHGCON (TRI,GAMOLD,RHOOLD,IBMTH)
+C
+C COMPUTES THE NEW ESTIMATE FOR THE LARGEST EIGENVALUE FOR
+C CONJUGATE GRADIENT ACCELERATION.
+C
+C ... PARAMETER LIST:
+C
+C TRI TRIDIAGONAL MATRIX ASSOCIATED WITH THE EIGENVALUES
+C OF THE CONJUGATE GRADIENT POLYNOMIAL
+C GAMOLD
+C AND
+C RHOOLD PREVIOUS VALUES OF ACCELERATION PARAMETERS
+C IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY CG
+C IBMTH = 1, JACOBI
+C = 2, REDUCED SYSTEM
+C = 3, SSOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IBMTH
+ DOUBLE PRECISION TRI(2,1),GAMOLD,RHOOLD
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IB2,IB3,IER,IP
+ DOUBLE PRECISION CMOLD,END,START,EIGVSS,EIGVNS
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ GO TO (10,20,30), IBMTH
+C
+C ... JACOBI CONJUGATE GRADIENT
+C
+ 10 START = CME
+ IP = IN
+ GO TO 40
+C
+C ... REDUCED SYSTEM CG
+C
+ 20 START = CME**2
+ IP = IN
+ GO TO 40
+C
+C ... SSOR CG
+C
+ 30 IF (ADAPT) START = SPR
+ IF (.NOT.ADAPT) START = SPECR
+ IP = IN-IS
+C
+C ... DEFINE THE MATRIX
+C
+ 40 IF (IP.GE.2) GO TO 60
+ IF (IP.EQ.1) GO TO 50
+C
+C ... IP = 0
+C
+ END = 0.D0
+ CMOLD = 0.D0
+ GO TO 110
+C
+C ... IP = 1
+C
+ 50 END = 1.D0-1.D0/GAMMA
+ TRI(1,1) = END
+ TRI(2,1) = 0.D0
+ GO TO 110
+C
+C ... IP > 1
+C
+ 60 IF ((IP.GT.2).AND.(DABS(START-CMOLD).LE.ZETA*START)) GO TO 120
+ CMOLD = START
+C
+C ... COMPUTE THE LARGEST EIGENVALUE
+C
+ TRI(1,IP) = 1.D0-1.D0/GAMMA
+ TRI(2,IP) = (RHO-1.D0)/(RHO*RHOOLD*GAMMA*GAMOLD)
+ IF (ISYM.NE.0) GO TO 80
+ END = EIGVSS(IP,TRI,START,ZETA,ITMAX,IER)
+ IF (IER.EQ.0) GO TO 100
+ IF (LEVEL.GE.2) WRITE (NOUT,70) IER
+ 70 FORMAT (/10X,'DIFFICULTY IN COMPUTATION OF MAXIMUM EIGENVALUE'/15X
+ * ,'OF ITERATION MATRIX'/10X,'SUBROUTINE ZBRENT RETURNED IER =',
+ * I5)
+ GO TO 100
+ 80 IB2 = 1+IP
+ IB3 = IB2+IP/2+1
+ END = EIGVNS(IP,TRI,TRI(1,IB2),TRI(1,IB3),IER)
+ IF (IER.EQ.0) GO TO 100
+ IF (LEVEL.GE.2) WRITE (NOUT,90) IER
+ 90 FORMAT (/10X,'DIFFICULTY IN COMPUTATION OF MAXIMUM EIGENVALUE'/15X
+ * ,'OF ITERATION MATRIX'/10X,'SUBROUTINE EQRT1S RETURNED IER =',
+ * I5)
+ 100 CONTINUE
+ IF (IER.NE.0) GO TO 130
+C
+C ... SET SPECTRAL RADIUS FOR THE VARIOUS METHODS
+C
+ 110 IF (IBMTH.EQ.1) CME = END
+ IF (IBMTH.EQ.2) CME = DSQRT(DABS(END))
+ IF (IBMTH.EQ.3.AND.ADAPT) SPR = END
+ IF (IBMTH.EQ.3.AND..NOT.ADAPT) SPECR = END
+ RETURN
+C
+C ... RELATIVE CHANGE IN CME IS LESS THAN ZETA. THEREFORE STOP
+C CHANGING.
+C
+ 120 ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ RETURN
+C
+C ... ESTIMATE FOR CME > 1.D0. THEREFORE NEED TO STOP ADAPTIVE
+C PROCEDURE AND KEEP OLD VALUE OF CME.
+C
+ 130 ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ IF (LEVEL.GE.2) WRITE (NOUT,140) IN,START
+ 140 FORMAT (/10X,'ESTIMATE OF MAXIMUM EIGENVALUE OF JACOBI '/15X,
+ * 'MATRIX (CME) NOT ACCURATE'/10X,
+ * 'ADAPTIVE PROCEDURE TURNED OFF AT ITERATION ',I5/10X,
+ * 'FINAL ESTIMATE OF MAXIMUM EIGENVALUE =',D15.7/)
+C
+ RETURN
+ END
+ SUBROUTINE CHGSI (DTNRM,IBMTH)
+C
+C ... COMPUTES NEW CHEBYSHEV ACCELERATION PARAMETERS ADAPTIVELY.
+C
+C ... PARAMETER LIST:
+C
+C DTNRM NUMERATOR OF RAYLEIGH QUOTIENT
+C IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI
+C IBMTH = 1, JACOBI
+C = 2, REDUCED SYSTEM
+C = 3, SYMMETRIC SOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IBMTH
+ DOUBLE PRECISION DTNRM
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION CMOLD,ZM1,ZM2
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION CHEBY
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ GO TO (10,30,50), IBMTH
+C
+C ---------------------
+C ... JACOBI SEMI-ITERATIVE
+C ---------------------
+C
+C ... CHEBYSHEV EQUATION
+C
+ 10 CONTINUE
+ IF (IN.EQ.0) ZM1 = CME
+ IF (IN.NE.0) ZM1 = CHEBY(QA,QT,RRR,IN-IS,CME,SME)
+C
+C ... RAYLEIGH QUOTIENT
+C
+ ZM2 = DTNRM/DELNNM
+C
+C ... COMPUTATION OF ITERATIVE PARAMETERS
+C
+ CMOLD = CME
+ CME = DMAX1(ZM1,ZM2,CMOLD)
+ IF (CME.GE.1.D0) GO TO 20
+ IF (CASEII) SME = -CME
+ SIGE = (CME-SME)/(2.D0-CME-SME)
+ GAMMA = 2.D0/(2.D0-CME-SME)
+ RRR = (1.D0-DSQRT(DABS(1.D0-SIGE*SIGE)))/(1.D0+DSQRT(DABS(1.D0-
+ * SIGE*SIGE)))
+ IS = IN
+ DELSNM = DELNNM
+ RHO = 1.D0
+ IF (LEVEL.GE.2) WRITE (NOUT,90) IN,ZM1,ZM2,CME,GAMMA,CME
+ RETURN
+C
+C ... ADAPTIVE PROCEDURE FAILED FOR JACOBI SI
+C
+ 20 CME = CMOLD
+ ADAPT = .FALSE.
+ IF (LEVEL.GE.2) WRITE (NOUT,110) IN,CME
+ RETURN
+C
+C -----------------------------
+C ... REDUCED SYSTEM SEMI-ITERATIVE
+C -----------------------------
+C
+C ... CHEBYSHEV EQUATION
+C
+ 30 CONTINUE
+ IF (IN.EQ.0) ZM1 = CME
+ IF (IN.NE.0) ZM1 = CHEBY(QA,QT,RRR,2*(IN-IS),0.D0,0.D0)
+C
+C ... RAYLEIGH QUOTIENT
+C
+ ZM2 = DSQRT(DABS(DTNRM/DELNNM))
+C
+C ... COMPUTATION OF NEW ITERATIVE PARAMETERS
+C
+ CMOLD = CME
+ CME = DMAX1(ZM1,ZM2,CMOLD)
+ IF (CME.GE.1.D0) GO TO 40
+ SIGE = CME*CME/(2.D0-CME*CME)
+ GAMMA = 2.D0/(2.D0-CME*CME)
+ RRR = (1.D0-DSQRT(DABS(1.D0-CME*CME)))/(1.D0+DSQRT(DABS(1.D0-CME*
+ * CME)))
+ IS = IN
+ DELSNM = DELNNM
+ RHO = 1.D0
+ IF (LEVEL.GE.2) WRITE (NOUT,90) IN,ZM1,ZM2,CME,GAMMA,CME
+ RETURN
+C
+C ... ADAPTIVE PROCEDURE FAILED FOR REDUCED SYSTEM SI
+C
+ 40 CME = CMOLD
+ ADAPT = .FALSE.
+ IF (LEVEL.GE.2) WRITE (NOUT,110) IN,CME
+ RETURN
+C
+C -----------------------------
+C ... SYMMETRIC SOR SEMI-ITERATIVE
+C ----------------------------
+C
+ 50 CONTINUE
+ IF (SPECR.EQ.0.D0) SPECR = .171572875D0
+ IF (IN.EQ.0) GO TO 60
+ ZM1 = CHEBY(QA,QT,RRR,IN-IS,SPECR,0.D0)
+ GO TO 70
+ 60 ZM1 = SPECR
+ SPR = SPECR
+C
+C ... RAYLEIGH QUOTIENT
+C
+ 70 ZM2 = DTNRM/DELNNM
+C
+C ... COMPUTATION OF NEW ESTIMATE FOR SPECTRAL RADIUS
+C
+ IF (ADAPT) GO TO 80
+C
+C ... PARTIALLY ADAPTIVE SSOR SI
+C
+ SPECR = DMAX1(ZM1,ZM2,SPECR)
+ IS = IN+1
+ DELSNM = DELNNM
+ IF (LEVEL.GE.2) WRITE (NOUT,100) IN,ZM1,ZM2,CME,SPECR
+ RETURN
+C
+C ... FULLY ADAPTIVE SSOR SI
+C
+ 80 SPR = DMAX1(ZM1,ZM2,SPR)
+ RETURN
+C
+C ... FORMAT STATEMENTS
+C
+ 90 FORMAT (/30X,'PARAMETERS WERE CHANGED AT ITERATION NO.',I5/35X,
+ * 'SOLUTION TO CHEBYSHEV EQN. =',D15.7/35X,
+ * 'SOLUTION TO RAYLEIGH QUOTIENT =',D15.7/35X,
+ * 'NEW ESTIMATE FOR CME =',D15.7/35X,
+ * 'NEW ESTIMATE FOR GAMMA =',D15.7/35X,
+ * 'NEW ESTIMATE FOR SPECTRAL RADIUS =',D15.7/)
+C
+ 100 FORMAT (/30X,'PARAMETERS WERE CHANGED AT ITERATION NO.',I5/35X,
+ * 'SOLUTION TO CHEBYSHEV EQN. =',D15.7/35X,
+ * 'SOLUTION TO RAYLEIGH QUOTIENT =',D15.7/35X,
+ * 'NEW ESTIMATE FOR CME =',D15.7/35X,
+ * 'NEW ESTIMATE FOR SPECTRAL RADIUS =',D15.7/)
+C
+ 110 FORMAT (/10X,'ESTIMATE OF MAXIMUM EIGENVALUE OF JACOBI '/15X,
+ * 'MATRIX (CME) TOO LARGE'/10X,
+ * 'ADAPTIVE PROCEDURE TURNED OFF AT ITERATION ',I5/10X,
+ * 'FINAL ESTIMATE OF MAXIMUM EIGENVALUE =',D15.7/)
+C
+ END
+ LOGICAL FUNCTION CHGSME (OLDNRM,ICNT)
+C
+C ... THIS FUNCTION TESTS FOR JACOBI SI WHETHER SME SHOULD BE CHANGED
+C ... WHEN CASEII = .FALSE.. IF THE TEST IS POSITIVE THE NEW VALUE
+C ... OF SME IS COMPUTED.
+C
+C ... PARAMETER LIST:
+C
+C OLDNRM SQUARE OF THE NORM OF THE PSEUDO-RESIDUAL
+C AT THE LAST ITERATION
+C ICNT NUMBER OF ITERATIONS SINCE LAST CHANGE OF
+C PARAMETERS
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER ICNT
+ DOUBLE PRECISION OLDNRM
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP
+ DOUBLE PRECISION Q,RN,SM1,SM2,WP,Z
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ CHGSME = .FALSE.
+ RN = DSQRT(DELNNM/OLDNRM)
+ IF (.NOT.(QA.GT.1.D0.AND.RN.GT.1.D0)) RETURN
+ IF (IN.LE.IS+2) RETURN
+C
+ ICNT = ICNT+1
+ IF (ICNT.LT.3) RETURN
+C
+C ... CHANGE SME IN J-SI ADAPTIVE PROCEDURE
+C
+ CHGSME = .TRUE.
+ SM1 = 0.D0
+ SM2 = 0.D0
+ IF (SME.GE.CME) GO TO 10
+C
+C ... COMPUTE SM1
+C
+ IP = IN-IS
+ Q = QA*(1.D0+RRR**IP)/(2.D0*DSQRT(RRR**IP))
+ Z = (Q+DSQRT(Q**2-1.D0))**(1.D0/DBLE(FLOAT(IP)))
+ WP = (Z**2+1.D0)/(2.D0*Z)
+ SM1 = .5D0*(CME+SME-WP*(CME-SME))
+C
+C ... COMPUTE SM2
+C
+ Q = RN*(1.D0+RRR**IP)/((1.D0+RRR**(IP-1))*DSQRT(RRR))
+ WP = (Q**2+1.D0)/(2.D0*Q)
+ SM2 = .5D0*(CME+SME-WP*(CME-SME))
+C
+ 10 SME = DMIN1(1.25D0*SM1,1.25D0*SM2,SME,-1.D0)
+ SIGE = (CME-SME)/(2.D0-CME-SME)
+ GAMMA = 2.D0/(2.D0-CME-SME)
+ RRR = (1.D0-DSQRT(1.D0-SIGE**2))/(1.D0+DSQRT(1.D0-SIGE**2))
+ IS = IN
+ DELSNM = DELNNM
+ RHO = 1.D0
+C
+ IF (LEVEL.GE.2) WRITE (NOUT,20) IN,SM1,SM2,SME
+C
+ 20 FORMAT (/30X,'ESTIMATE OF SMALLEST EIGENVALUE OF JACOBI'/37X,
+ * 'MATRIX (SME) CHANGED AT ITERATION ',I5/35X,
+ * 'FIRST ESTIMATE OF SME =',D15.7/35X,
+ * 'SECOND ESTIMATE OF SME =',D15.7/35X,
+ * 'NEW ESTIMATE OF SME =',D15.7/)
+C
+ RETURN
+ END
+ SUBROUTINE DAXPY (N,DA,DX,INCX,DY,INCY)
+C
+C OVERWRITE DOUBLE PRECISION DY WITH DOUBLE PRECISION DA*DX + DY.
+C
+ DOUBLE PRECISION DX(1),DY(1),DA
+ IF (N.LE.0.OR.DA.EQ.0.D0) RETURN
+ IF (INCX.EQ.INCY) IF (INCX-1) 10 , 30 , 70
+ 10 CONTINUE
+C
+C CODE FOR NONEQUAL OR NONPOSITIVE INCREMENTS.
+C
+ IX = 1
+ IY = 1
+ IF (INCX.LT.0) IX = (-N+1)*INCX+1
+ IF (INCY.LT.0) IY = (-N+1)*INCY+1
+ DO 20 I = 1,N
+ DY(IY) = DY(IY)+DA*DX(IX)
+ IX = IX+INCX
+ IY = IY+INCY
+ 20 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 4.
+C
+ 30 M = N-(N/4)*4
+ IF (M.EQ.0) GO TO 50
+ DO 40 I = 1,M
+ DY(I) = DY(I)+DA*DX(I)
+ 40 CONTINUE
+ IF (N.LT.4) RETURN
+ 50 MP1 = M+1
+ DO 60 I = MP1,N,4
+ DY(I) = DY(I)+DA*DX(I)
+ DY(I+1) = DY(I+1)+DA*DX(I+1)
+ DY(I+2) = DY(I+2)+DA*DX(I+2)
+ DY(I+3) = DY(I+3)+DA*DX(I+3)
+ 60 CONTINUE
+ RETURN
+C
+C CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
+C
+ 70 CONTINUE
+ NS = N*INCX
+ DO 80 I = 1,NS,INCX
+ DY(I) = DA*DX(I)+DY(I)
+ 80 CONTINUE
+ RETURN
+ END
+ SUBROUTINE DCOPY (N,DX,INCX,DY,INCY)
+C
+C COPY DOUBLE PRECISION DX TO DOUBLE PRECISION DY.
+C
+ DOUBLE PRECISION DX(1),DY(1)
+ IF (N.LE.0) RETURN
+ IF (INCX.EQ.INCY) IF (INCX-1) 10 , 30 , 70
+ 10 CONTINUE
+C
+C CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
+C
+ IX = 1
+ IY = 1
+ IF (INCX.LT.0) IX = (-N+1)*INCX+1
+ IF (INCY.LT.0) IY = (-N+1)*INCY+1
+ DO 20 I = 1,N
+ DY(IY) = DX(IX)
+ IX = IX+INCX
+ IY = IY+INCY
+ 20 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1
+C
+C CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 7.
+C
+ 30 M = N-(N/7)*7
+ IF (M.EQ.0) GO TO 50
+ DO 40 I = 1,M
+ DY(I) = DX(I)
+ 40 CONTINUE
+ IF (N.LT.7) RETURN
+ 50 MP1 = M+1
+ DO 60 I = MP1,N,7
+ DY(I) = DX(I)
+ DY(I+1) = DX(I+1)
+ DY(I+2) = DX(I+2)
+ DY(I+3) = DX(I+3)
+ DY(I+4) = DX(I+4)
+ DY(I+5) = DX(I+5)
+ DY(I+6) = DX(I+6)
+ 60 CONTINUE
+ RETURN
+C
+C CODE FOR EQUAL, POSITIVE, NONUNIT INCREMENTS.
+C
+ 70 CONTINUE
+ NS = N*INCX
+ DO 80 I = 1,NS,INCX
+ DY(I) = DX(I)
+ 80 CONTINUE
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION DDOT (N,DX,INCX,DY,INCY)
+C
+C RETURNS THE DOT PRODUCT OF DOUBLE PRECISION DX AND DY.
+C
+ DOUBLE PRECISION DX(1),DY(1)
+ DDOT = 0.D0
+ IF (N.LE.0) RETURN
+ IF (INCX.EQ.INCY) IF (INCX-1) 10 , 30 , 70
+ 10 CONTINUE
+C
+C CODE FOR UNEQUAL OR NONPOSITIVE INCREMENTS.
+C
+ IX = 1
+ IY = 1
+ IF (INCX.LT.0) IX = (-N+1)*INCX+1
+ IF (INCY.LT.0) IY = (-N+1)*INCY+1
+ DO 20 I = 1,N
+ DDOT = DDOT+DX(IX)*DY(IY)
+ IX = IX+INCX
+ IY = IY+INCY
+ 20 CONTINUE
+ RETURN
+C
+C CODE FOR BOTH INCREMENTS EQUAL TO 1.
+C
+C CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 5.
+C
+ 30 M = N-(N/5)*5
+ IF (M.EQ.0) GO TO 50
+ DO 40 I = 1,M
+ DDOT = DDOT+DX(I)*DY(I)
+ 40 CONTINUE
+ IF (N.LT.5) RETURN
+ 50 MP1 = M+1
+ DO 60 I = MP1,N,5
+ DDOT = DDOT+DX(I)*DY(I)+DX(I+1)*DY(I+1)+DX(I+2)*DY(I+2)+DX(I+3)
+ * *DY(I+3)+DX(I+4)*DY(I+4)
+ 60 CONTINUE
+ RETURN
+C
+C CODE FOR POSITIVE EQUAL INCREMENTS .NE.1.
+C
+ 70 CONTINUE
+ NS = N*INCX
+ DO 80 I = 1,NS,INCX
+ DDOT = DDOT+DX(I)*DY(I)
+ 80 CONTINUE
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION DETERM (N,TRI,XLMDA)
+C
+C THIS SUBROUTINE COMPUTES THE DETERMINANT OF A SYMMETRIC
+C TRIDIAGONAL MATRIX GIVEN BY TRI. DET(TRI - XLMDA*I) = 0
+C
+C ... PARAMETER LIST
+C
+C N ORDER OF TRIDIAGONAL SYSTEM
+C TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N
+C XLMDA ARGUMENT FOR CHARACTERISTIC EQUATION
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N
+ DOUBLE PRECISION TRI(2,1),XLMDA
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER ICNT,L,NM1
+ DOUBLE PRECISION D1,D2,D3
+C
+ NM1 = N-1
+ D2 = TRI(1,N)-XLMDA
+ D1 = D2*(TRI(1,NM1)-XLMDA)-TRI(2,N)
+ IF (N.EQ.2) GO TO 20
+C
+C ... BEGINNING OF LOOP
+C
+ DO 10 ICNT = 2,NM1
+ L = NM1-ICNT+2
+ D3 = D2
+ D2 = D1
+ D1 = (TRI(1,L-1)-XLMDA)*D2-D3*TRI(2,L)
+ 10 CONTINUE
+C
+C ... DETERMINANT COMPUTED
+C
+ 20 DETERM = D1
+C
+ RETURN
+ END
+ SUBROUTINE DFAULT (IPARM,RPARM)
+C
+C ... THIS SUBROUTINE SETS THE DEFAULT VALUES OF IPARM AND RPARM.
+C
+C ... PARAMETER LIST:
+C
+C IPARM
+C AND
+C RPARM ARRAYS SPECIFYING OPTIONS AND TOLERANCES
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IPARM(12)
+ DOUBLE PRECISION RPARM(12)
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+C DRELPR - COMPUTER PRECISION (APPROX.)
+C IF INSTALLER OF PACKAGE DOES NOT KNOW DRELPR VALUE,
+C AN APPROXIMATE VALUE CAN BE DETERMINED FROM A SIMPLE
+C FORTRAN PROGRAM SUCH AS
+C
+C DOUBLE PRECISION DRELPR, TEMP
+C DRELPR = 1.0D0
+C 2 DRELPR = 0.5D0*DRELPR
+C TEMP = DRELPR + 1.0D0
+C IF(TEMP .GT. 1.0D0) GO TO 2
+C WRITE(6,3) DRELPR
+C 3 FORMAT(5X,D15.8)
+C STOP
+C END
+C
+C SOME VALUES ARE:
+C
+C DRELPR = 1.26D-29 FOR CDC CYBER 170/750 (APPROX.) 2**-96
+C = 2.22D-16 FOR DEC 10 (APPROX.) 2**-52
+C = 7.11D-15 FOR VAX 11/780 (APPROX.) 2**-47
+C = 1.14D-13 FOR IBM 370/158 (APPROX.) 2**-43
+C
+C *** SHOULD BE CHANGED FOR OTHER MACHINES ***
+C
+C TO FACILITATE CONVERGENCE, RPARM(1) SHOULD BE SET TO
+C 500.*DRELPR OR LARGER
+C
+ DRELPR = 7.11D-15
+C
+ IPARM(1) = 100
+ IPARM(2) = 0
+ IPARM(3) = 0
+ IPARM(4) = 6
+ IPARM(5) = 0
+ IPARM(6) = 1
+ IPARM(7) = 1
+ IPARM(8) = 0
+ IPARM(9) = -1
+ IPARM(10) = 0
+ IPARM(11) = 0
+ IPARM(12) = 0
+C
+ RPARM(1) = 0.5D-5
+ RPARM(2) = 0.D0
+ RPARM(3) = 0.D0
+ RPARM(4) = .75D0
+ RPARM(5) = 1.D0
+ RPARM(6) = 0.D0
+ RPARM(7) = .25D0
+ RPARM(8) = 1.D2*DRELPR
+ RPARM(9) = 0.D0
+ RPARM(10) = 0.D0
+ RPARM(11) = 0.D0
+ RPARM(12) = 0.D0
+C
+ RETURN
+ END
+ SUBROUTINE ECHALL (NN,IA,JA,A,RHS,IPARM,RPARM,ICALL)
+C
+C ... THIS ROUTINE INITIALIZES THE ITPACK COMMON BLOCKS FROM THE
+C ... INFORMATION CONTAINED IN IPARM AND RPARM. ECHALL ALSO PRINTS THE
+C ... VALUES OF ALL THE PARAMETERS IN IPARM AND RPARM.
+C
+C ... PARAMETER LIST:
+C
+C IPARM
+C AND
+C RPARM ARRAYS OF PARAMETERS SPECIFYING OPTIONS AND
+C TOLERANCES
+C ICALL INDICATOR OF WHICH PARAMETERS ARE BEING PRINTED
+C ICALL = 1, INITIAL PARAMETERS
+C ICALL = 2, FINAL PARAMETERS
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),IPARM(12),NN,ICALL
+ DOUBLE PRECISION A(1),RHS(NN),RPARM(12)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,N,NP1,NZRO
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ IF (ICALL.NE.1) GO TO 100
+ N = NN
+ NP1 = N+1
+ NZRO = IA(NP1)-1
+C
+C ... INITIALIZE ITPACK COMMON
+C
+ ZETA = RPARM(1)
+ CME = RPARM(2)
+ SME = RPARM(3)
+ FF = RPARM(4)
+ OMEGA = RPARM(5)
+ SPECR = RPARM(6)
+ BETAB = RPARM(7)
+ ITMAX = IPARM(1)
+ LEVEL = IPARM(2)
+ ISYM = IPARM(5)
+C
+ ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ BETADT = .FALSE.
+ IF (IPARM(6).EQ.1.OR.IPARM(6).EQ.3) ADAPT = .TRUE.
+ IF (IPARM(6).EQ.1) BETADT = .TRUE.
+ IF (IPARM(6).EQ.2) PARTAD = .TRUE.
+C
+ CASEII = .FALSE.
+ IF (IPARM(7).EQ.2) CASEII = .TRUE.
+ IF (CASEII) SME = -CME
+ IF (.NOT.CASEII.AND.SME.EQ.0.D0) SME = -1.D0
+ SPR = SME
+C
+C ... SET REST OF COMMON VARIABLES TO ZERO
+C
+ IN = 0
+ IS = 0
+ HALT = .FALSE.
+ BDELNM = 0.D0
+ DELNNM = 0.D0
+ DELSNM = 0.D0
+ GAMMA = 0.D0
+ QA = 0.D0
+ QT = 0.D0
+ RHO = 0.D0
+ RRR = 0.D0
+ SIGE = 0.D0
+ STPTST = 0.D0
+ UDNM = 0.D0
+C
+ IF (LEVEL.LE.4) GO TO 80
+C
+C THIS SECTION OF ECHALL CAUSES PRINTING OF THE LINEAR SYSTEM AND
+C THE ITERATIVE PARAMETERS
+C
+ WRITE (NOUT,10)
+ 10 FORMAT (///30X,'THE LINEAR SYSTEM IS AS FOLLOWS')
+ WRITE (NOUT,20)
+ 20 FORMAT (/2X,'IA ARRAY')
+ WRITE (NOUT,30) (IA(I),I=1,NP1)
+ 30 FORMAT (2X,10(2X,I8))
+ WRITE (NOUT,40)
+ 40 FORMAT (/2X,'JA ARRAY')
+ WRITE (NOUT,30) (JA(I),I=1,NZRO)
+ WRITE (NOUT,50)
+ 50 FORMAT (/2X,' A ARRAY')
+ WRITE (NOUT,60) (A(I),I=1,NZRO)
+ 60 FORMAT (2X,5(2X,D20.13))
+ WRITE (NOUT,70)
+ 70 FORMAT (/2X,'RHS ARRAY')
+ WRITE (NOUT,60) (RHS(I),I=1,N)
+ 80 WRITE (NOUT,90)
+ 90 FORMAT (///30X,'INITIAL ITERATIVE PARAMETERS')
+ GO TO 120
+ 100 WRITE (NOUT,110)
+ 110 FORMAT (///30X,'FINAL ITERATIVE PARAMETERS')
+ 120 WRITE (NOUT,130) IPARM(1),LEVEL,IPARM(3),NOUT,ISYM,IPARM(6)
+ 130 FORMAT (35X,'IPARM(1) =',I15,4X,'(ITMAX)'/35X,'IPARM(2) =',I15,
+ * 4X,'(LEVEL) '/35X,'IPARM(3) =',I15,4X,'(IRESET)'/35X,
+ * 'IPARM(4) =',I15,4X,'(NOUT) '/35X,'IPARM(5) =',I15,4X,
+ * '(ISYM) '/35X,'IPARM(6) =',I15,4X,'(IADAPT)')
+ WRITE (NOUT,140) IPARM(7),IPARM(8),IPARM(9),IPARM(10),IPARM(11),
+ * IPARM(12)
+ 140 FORMAT (35X,'IPARM(7) =',I15,4X,'(ICASE)'/35X,'IPARM(8) =',I15,
+ * 4X,'(NWKSP)'/35X,'IPARM(9) =',I15,4X,'(NB) '/35X,
+ * 'IPARM(10) =',I15,4X,'(IREMOVE)'/35X,'IPARM(11) =',I15,4X,
+ * '(ITIME)'/35X,'IPARM(12) =',I15,4X,'(IDGTS)')
+ WRITE (NOUT,150) ZETA,CME,SME,FF,OMEGA,SPECR
+ 150 FORMAT (35X,'RPARM(1) =',D15.8,4X,'(ZETA) '/35X,'RPARM(2) =',
+ * D15.8,4X,'(CME) '/35X,'RPARM(3) =',D15.8,4X,'(SME) '/35X,
+ * 'RPARM(4) =',D15.8,4X,'(FF) '/35X,'RPARM(5) =',D15.8,4X,
+ * '(OMEGA) '/35X,'RPARM(6) =',D15.8,4X,'(SPECR) ')
+ WRITE (NOUT,160) BETAB,RPARM(8),RPARM(9),RPARM(10),RPARM(11),
+ * RPARM(12)
+ 160 FORMAT (35X,'RPARM(7) =',D15.8,4X,'(BETAB) '/35X,'RPARM(8) =',
+ * D15.8,4X,'(TOL)'/35X,'RPARM(9) =',D15.8,4X,'(TIME1)'/35X,
+ * 'RPARM(10) =',D15.8,4X,'(TIME2)'/35X,'RPARM(11) =',D15.8,4X,
+ * '(DIGIT1)'/35X,'RPARM(12) =',D15.8,4X,'(DIGIT2)')
+C
+ RETURN
+ END
+ SUBROUTINE ECHOUT (IPARM,RPARM,IMTHD)
+C
+C THIS ROUTINE INITIALIZES THE ITPACK COMMON BLOCKS FROM THE
+C INFORMATION CONTAINED IN IPARM AND RPARM.
+C
+C ... PARAMETER LIST:
+C
+C IPARM
+C AND
+C RPARM ARRAYS OF PARAMETERS SPECIFYING OPTIONS AND
+C TOLERANCES
+C IMTHD INDICATOR OF METHOD
+C IMTHD = 1, JCG
+C IMTHD = 2, JSI
+C IMTHD = 3, SOR
+C IMTHD = 4, SSORCG
+C IMTHD = 5, SSORSI
+C IMTHD = 6, RSCG
+C IMTHD = 7, RSSI
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IPARM(12),IMTHD
+ DOUBLE PRECISION RPARM(12)
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+C ... INITIALIZE ITPACK COMMON
+C
+ ZETA = RPARM(1)
+ CME = RPARM(2)
+ SME = RPARM(3)
+ FF = RPARM(4)
+ OMEGA = RPARM(5)
+ SPECR = RPARM(6)
+ BETAB = RPARM(7)
+ ITMAX = IPARM(1)
+ LEVEL = IPARM(2)
+ ISYM = IPARM(5)
+C
+ ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ BETADT = .FALSE.
+ IF (IPARM(6).EQ.1.OR.IPARM(6).EQ.3) ADAPT = .TRUE.
+ IF (IPARM(6).EQ.1) BETADT = .TRUE.
+ IF (IPARM(6).EQ.2) PARTAD = .TRUE.
+C
+ CASEII = .FALSE.
+ IF (IPARM(7).EQ.2) CASEII = .TRUE.
+ IF (CASEII) SME = -CME
+ IF (.NOT.CASEII.AND.SME.EQ.0.D0) SME = -1.D0
+ SPR = SME
+C
+C ... SET REST OF COMMON VARIABLES TO ZERO
+C
+ IN = 0
+ IS = 0
+ HALT = .FALSE.
+ BDELNM = 0.D0
+ DELNNM = 0.D0
+ DELSNM = 0.D0
+ GAMMA = 0.D0
+ QA = 0.D0
+ QT = 0.D0
+ RHO = 0.D0
+ RRR = 0.D0
+ SIGE = 0.D0
+ STPTST = 0.D0
+ UDNM = 0.D0
+ IF (LEVEL.LE.2) RETURN
+C
+C ... THIS SECTION OF ECHOUT ECHOES THE INPUT VALUES FOR THE INITIAL
+C ITERATIVE PARAMETERS
+C
+ WRITE (NOUT,10) ISYM,ITMAX,ZETA,ADAPT,CASEII
+ 10 FORMAT (///30X,'INITIAL ITERATIVE PARAMETERS',3X,
+ * 'RELEVANT SWITCHES'/35X,'ISYM =',I15,8X,'IPARM(5)'/35X,
+ * 'ITMAX =',I15,8X,'IPARM(1)'/35X,'ZETA =',D15.8,8X,'RPARM(1)'
+ * /35X,'ADAPT =',L15,8X,'IPARM(6)'/35X,'CASEII =',L15,8X,
+ * 'IPARM(7)')
+ GO TO (80,20,100,60,40,80,20), IMTHD
+C
+C ... JSI, RSSI
+C
+ 20 WRITE (NOUT,30) FF,CME,SME
+ 30 FORMAT (35X,'FF =',D15.8,8X,'RPARM(4)'/35X,'CME =',D15.8,8X
+ * ,'RPARM(2)'/35X,'SME =',D15.8,8X,'RPARM(3)'///)
+ RETURN
+C
+C ... SSORSI
+C
+ 40 WRITE (NOUT,50) PARTAD,FF,CME,OMEGA,SPECR,BETAB,BETADT
+ 50 FORMAT (35X,'PARTAD =',L15,8X,'IPARM(6)'/35X,'FF =',D15.8,8X,
+ * 'RPARM(4)'/35X,'CME =',D15.8,8X,'RPARM(2)'/35X,'OMEGA =',
+ * D15.8,8X,'RPARM(5)'/35X,'SPECR =',D15.8,8X,'RPARM(6)'/35X,
+ * 'BETAB =',D15.8,8X,'RPARM(7)'/35X,'BETADT =',L15,8X,'IPARM(6)'
+ * ///)
+ RETURN
+C
+C ... SSORCG
+C
+ 60 WRITE (NOUT,70) PARTAD,CME,OMEGA,SPECR,BETAB,BETADT
+ 70 FORMAT (35X,'PARTAD =',L15,8X,'IPARM(6)'/35X,'CME =',D15.8,8X,
+ * 'RPARM(2)'/35X,'OMEGA =',D15.8,8X,'RPARM(5)'/35X,'SPECR =',
+ * D15.8,8X,'RPARM(6)'/35X,'BETAB =',D15.8,8X,'RPARM(7)'/35X,
+ * 'BETADT =',L15,8X,'IPARM(6)'///)
+ RETURN
+C
+C ... JCG, RSCG
+C
+ 80 IF (ADAPT) RETURN
+ WRITE (NOUT,90) CME
+ 90 FORMAT (35X,'CME =',D15.8,8X,'RPARM(2)'///)
+C
+ 100 CONTINUE
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION EIGVNS (N,TRI,D,E2,IER)
+C
+C COMPUTES THE LARGEST EIGENVALUE OF A SYMMETRIC TRIDIAGONAL MATRIX
+C FOR CONJUGATE GRADIENT ACCELERATION.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF TRIDIAGONAL SYSTEM
+C TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N
+C D ARRAY FOR EQRT1S (NEGATIVE DIAGONAL ELEMENTS)
+C E2 ARRAY FOR EQRT1S (SUPER DIAGONAL ELEMENTS)
+C IER ERROR FLAG: ON RETURN, IER=0 INDICATES THAT
+C THE LARGEST EIGENVALUE OF TRI WAS FOUND.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,IER
+ DOUBLE PRECISION TRI(2,1),D(N),E2(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I
+C
+ EIGVNS = 0.D0
+C
+ D(1) = -TRI(1,1)
+ DO 10 I = 2,N
+ D(I) = -TRI(1,I)
+ E2(I) = DABS(TRI(2,I))
+ 10 CONTINUE
+C
+ CALL EQRT1S (D,E2,N,1,0,IER)
+ EIGVNS = -D(1)
+C
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION EIGVSS (N,TRI,START,ZETA,ITMAX,IER)
+C
+C COMPUTES THE LARGEST EIGENVALUE OF A SYMMETRIC TRIDIAGONAL MATRIX
+C FOR CONJUGATE GRADIENT ACCELERATION.
+C MODIFIED IMSL ROUTINE ZBRENT USED.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF TRIDIAGONAL SYSTEM
+C TRI SYMMETRIC TRIDIAGONAL MATRIX OF ORDER N
+C START INITIAL LOWER BOUND OF INTERVAL CONTAINING ROOT
+C ZETA STOPPING CRITERIA
+C IER ERROR FLAG: ON RETURN, IER=0 INDICATES THAT
+C THE LARGEST EIGENVALUE OF TRI WAS FOUND.
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,ITMAX,IER
+ DOUBLE PRECISION TRI(2,1),START,ZETA,A,B,EPS
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER MAXFN,NSIG,ITMP
+C
+ EIGVSS = 0.D0
+ ITMP = IFIX(SNGL(-DLOG10(DABS(ZETA))))
+ NSIG = MAX0(ITMP,4)
+ MAXFN = MAX0(ITMAX,50)
+C
+C EPS = DMIN1(ZETA,0.5D-4)
+C
+ EPS = 0.0D0
+ A = START
+ B = 1.0D0
+ CALL ZBRENT (N,TRI,EPS,NSIG,A,B,MAXFN,IER)
+ EIGVSS = B
+C
+ RETURN
+ END
+ SUBROUTINE EQRT1S (D,E2,NN,M,ISW,IERR)
+C
+C MODIFIED IMSL ROUTINE NAME - EQRT1S
+C
+C-----------------------------------------------------------------------
+C
+C COMPUTER - CDC/SINGLE
+C
+C LATEST REVISION - JUNE 1, 1980
+C
+C PURPOSE - SMALLEST OR LARGEST M EIGENVALUES OF A
+C SYMMETRIC TRIDIAGONAL MATRIX
+C
+C USAGE - CALL EQRT1S (D,E2,N,M,ISW,IER)
+C
+C ARGUMENTS D - INPUT VECTOR OF LENGTH N CONTAINING
+C THE DIAGONAL ELEMENTS OF THE MATRIX. THE
+C COMPUTED EIGENVALUES REPLACE THE FIRST M
+C COMPONENTS OF THE VECTOR D IN NON-
+C DECREASING SEQUENCE, WHILE THE REMAINING
+C COMPONENTS ARE LOST.
+C E2 - INPUT VECTOR OF LENGTH N CONTAINING
+C THE SQUARES OF THE OFF-DIAGONAL ELEMENTS
+C OF THE MATRIX. INPUT E2 IS DESTROYED.
+C N - INPUT SCALAR CONTAINING THE ORDER OF THE
+C MATRIX. (= NN)
+C M - INPUT SCALAR CONTAINING THE NUMBER OF
+C SMALLEST EIGENVALUES DESIRED (M IS
+C LESS THAN OR EQUAL TO N).
+C ISW - INPUT SCALAR MEANING AS FOLLOWS -
+C ISW=1 MEANS THAT THE MATRIX IS KNOWN TO BE
+C POSITIVE DEFINITE.
+C ISW=0 MEANS THAT THE MATRIX IS NOT KNOWN
+C TO BE POSITIVE DEFINITE.
+C IER - ERROR PARAMETER. (OUTPUT) (= IERR)
+C WARNING ERROR
+C IER = 601 INDICATES THAT SUCCESSIVE
+C ITERATES TO THE K-TH EIGENVALUE WERE NOT
+C MONOTONE INCREASING. THE VALUE K IS
+C STORED IN E2(1).
+C TERMINAL ERROR
+C IER = 602 INDICATES THAT ISW=1 BUT MATRIX
+C IS NOT POSITIVE DEFINITE
+C
+C PRECISION/HARDWARE - SINGLE AND DOUBLE/H32
+C - SINGLE/H36,H48,H60
+C
+C NOTATION - INFORMATION ON SPECIAL NOTATION AND
+C CONVENTIONS IS AVAILABLE IN THE MANUAL
+C INTRODUCTION OR THROUGH IMSL ROUTINE UHELP
+C
+C REMARKS AS WRITTEN, THE ROUTINE COMPUTES THE M SMALLEST
+C EIGENVALUES. TO COMPUTE THE M LARGEST EIGENVALUES,
+C REVERSE THE SIGN OF EACH ELEMENT OF D BEFORE AND
+C AFTER CALLING THE ROUTINE. IN THIS CASE, ISW MUST
+C EQUAL ZERO.
+C
+C COPYRIGHT - 1980 BY IMSL, INC. ALL RIGHTS RESERVED.
+C
+C WARRANTY - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN
+C APPLIED TO THIS CODE. NO OTHER WARRANTY,
+C EXPRESSED OR IMPLIED, IS APPLICABLE.
+C
+C-----------------------------------------------------------------------
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER NN,M,ISW,IERR
+ DOUBLE PRECISION D(NN),E2(NN)
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER II,I,JJ,J,K1,K,N,IER
+ DOUBLE PRECISION DELTA,DLAM,EP,ERR,F,P,QP,Q,R,S,TOT
+C
+C DRELPR = MACHINE PRECISION
+C FIRST EXECUTABLE STATEMENT
+C
+ N = NN
+ IER = 0
+ DLAM = 0.0D0
+ ERR = 0.0D0
+ S = 0.0D0
+C
+C LOOK FOR SMALL SUB-DIAGONAL ENTRIES
+C DEFINE INITIAL SHIFT FROM LOWER
+C GERSCHGORIN BOUND.
+C
+ TOT = D(1)
+ Q = 0.0D0
+ J = 0
+ DO 30 I = 1,N
+ P = Q
+ IF (I.EQ.1) GO TO 10
+ IF (P.GT.DRELPR*(DABS(D(I))+DABS(D(I-1)))) GO TO 20
+ 10 E2(I) = 0.0D0
+C
+C COUNT IF E2(I) HAS UNDERFLOWED
+C
+ 20 IF (E2(I).EQ.0.D0) J = J+1
+ Q = 0.0D0
+ IF (I.NE.N) Q = DSQRT(DABS(E2(I+1)))
+ TOT = DMIN1(D(I)-P-Q,TOT)
+ 30 CONTINUE
+ IF (ISW.EQ.1.AND.TOT.LT.0.0D0) GO TO 50
+ DO 40 I = 1,N
+ D(I) = D(I)-TOT
+ 40 CONTINUE
+ GO TO 60
+ 50 TOT = 0.0D0
+ 60 DO 200 K = 1,M
+C
+C NEXT QR TRANSFORMATION
+C
+ 70 TOT = TOT+S
+ DELTA = D(N)-S
+ I = N
+ F = DABS(DRELPR*TOT)
+ IF (DLAM.LT.F) DLAM = F
+ IF (DELTA.GT.DLAM) GO TO 90
+ IF (DELTA.GE.(-DLAM)) GO TO 170
+ IER = 602
+ IF (LEVEL.GE.1) WRITE (NOUT,80)
+ 80 FORMAT ('0','*** W A R N I N G ************'/' ',
+ * ' IN ITPACK ROUTINE EQRT1S '/' ',
+ * ' PARAMETER ISW = 1 BUT MATRIX '/' ',
+ * ' NOT POSITIVE DEFINITE')
+ GO TO 210
+C
+C REPLACE SMALL SUB-DIAGONAL SQUARES
+C BY ZERO TO REDUCE THE INCIDENCE OF
+C UNDERFLOWS
+C
+ 90 IF (K.EQ.N) GO TO 110
+ K1 = K+1
+ DO 100 J = K1,N
+ IF (E2(J).LE.(DRELPR*(D(J)+D(J-1)))**2) E2(J) = 0.0D0
+ 100 CONTINUE
+ 110 F = E2(N)/DELTA
+ QP = DELTA+F
+ P = 1.0D0
+ IF (K.EQ.N) GO TO 140
+ K1 = N-K
+ DO 130 II = 1,K1
+ I = N-II
+ Q = D(I)-S-F
+ R = Q/QP
+ P = P*R+1.0D0
+ EP = F*R
+ D(I+1) = QP+EP
+ DELTA = Q-EP
+ IF (DELTA.GT.DLAM) GO TO 120
+ IF (DELTA.GE.(-DLAM)) GO TO 170
+ IER = 602
+ IF (LEVEL.GE.0) WRITE (NOUT,80)
+ GO TO 210
+ 120 F = E2(I)/Q
+ QP = DELTA+F
+ E2(I+1) = QP*EP
+ 130 CONTINUE
+ 140 D(K) = QP
+ S = QP/P
+ IF (TOT+S.GT.TOT) GO TO 70
+ IER = 601
+ E2(1) = K
+ IF (LEVEL.GE.1) WRITE (NOUT,150) K
+ 150 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE EQRT1S '/' ',
+ * ' SUCCESSIVE ITERATES TO THE',I10/' ',
+ * ' EIGENVALUE WERE NOT MONOTONE INCREASING ')
+C
+C SET ERROR -- IRREGULAR END
+C DEFLATE MINIMUM DIAGONAL ELEMENT
+C
+ S = 0.0D0
+ DELTA = QP
+ DO 160 J = K,N
+ IF (D(J).GT.DELTA) GO TO 160
+ I = J
+ DELTA = D(J)
+ 160 CONTINUE
+C
+C CONVERGENCE
+C
+ 170 IF (I.LT.N) E2(I+1) = E2(I)*F/QP
+ IF (I.EQ.K) GO TO 190
+ K1 = I-K
+ DO 180 JJ = 1,K1
+ J = I-JJ
+ D(J+1) = D(J)-S
+ E2(J+1) = E2(J)
+ 180 CONTINUE
+ 190 D(K) = TOT
+ ERR = ERR+DABS(DELTA)
+ E2(K) = ERR
+ 200 CONTINUE
+ IF (IER.EQ.0) GO TO 220
+ 210 CONTINUE
+ 220 IERR = IER
+ RETURN
+ END
+ INTEGER FUNCTION IPSTR (OMEGA)
+C
+C FINDS THE SMALLEST INTEGER, IPSTR, GREATER THAN 5 SUCH THAT
+C IPSTR * (OMEGA-1)**(IPSTR-1) .LE. 0.50. IPSTR WILL BE SET
+C IN LOOP.
+C
+C ... PARAMETER LIST:
+C
+C OMEGA RELAXATION FACTOR FOR SOR METHOD
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ DOUBLE PRECISION OMEGA
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP
+ DOUBLE PRECISION WM1
+C
+ WM1 = OMEGA-1.D0
+C
+ DO 10 IP = 6,940
+ IF (DBLE(FLOAT(IP))*(WM1**(IP-1)).GT.0.50D0) GO TO 10
+ IPSTR = IP
+ RETURN
+ 10 CONTINUE
+ IPSTR = 940
+ RETURN
+C
+ END
+ SUBROUTINE ITERM (NN,A,U,WK,IMTHDD)
+C
+C THIS ROUTINE PRODUCES THE ITERATION SUMMARY LINE AT THE END
+C OF EACH ITERATION. IF LEVEL = 5, THE LATEST APPROXIMATION
+C TO THE SOLUTION WILL BE PRINTED.
+C
+C ... PARAMETER LIST:
+C
+C NN ORDER OF SYSTEM OR, FOR REDUCED SYSTEM
+C ROUTINES, ORDER OF BLACK SUBSYSTEM
+C A ITERATION MATRIX
+C U SOLUTION ESTIMATE
+C WK WORK ARRAY OF LENGTH NN
+C IMTHD INDICATOR OF METHOD (=IMTHDD)
+C IMTHD = 1, JCG
+C IMTHD = 2, JSI
+C IMTHD = 3, SOR
+C IMTHD = 4, SSORCG
+C IMTHD = 5, SSORSI
+C IMTHD = 6, RSCG
+C IMTHD = 7, RSSI
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER NN,IMTHD
+ DOUBLE PRECISION A(1),U(NN),WK(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IMTHDD,IP,N
+ DOUBLE PRECISION QTFF
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+ N = NN
+ IMTHD = IMTHDD
+C
+C ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION
+C
+ IF (LEVEL.LT.2) RETURN
+ GO TO (10,110,170,210,50,10,110), IMTHD
+ 10 IF (IN.GT.0) GO TO 30
+C
+C ... PRINT HEADER FOR JCG AND RSCG
+C
+ WRITE (NOUT,20)
+ 20 FORMAT (////15X,'INTERMEDIATE OUTPUT AFTER EACH ITERATION'//
+ * ' NUMBER OF',5X,'CONVERGENCE',7X,'CME ',11X,'RHO',12X,'GAMMA'/
+ * ' ITERATIONS',4X,'TEST '//)
+C
+C ... PRINT SUMMARY LINE
+C
+ 30 WRITE (NOUT,40) IN,STPTST,CME,RHO,GAMMA
+ 40 FORMAT (4X,I5,3X,4D15.7)
+ IF (LEVEL.GE.4) GO TO 250
+C
+ RETURN
+C
+ 50 IF (IN.GT.0) GO TO 70
+C
+C ... PRINT HEADER FOR SSOR-SI
+C
+ WRITE (NOUT,60)
+ 60 FORMAT (////15X,'INTERMEDIATE OUTPUT AFTER EACH ITERATION'//
+ * ' NUMBER OF',4X,'CONVERGENCE',7X,'PARAMETER CHANGE TEST',10X,
+ * 'RHO',12X,'GAMMA'/' ITERATIONS',3X,'TEST ',11X,'LHS(QA)',7X,
+ * 'RHS(QT**FF)'//)
+C
+C ... PRINT SUMMARY LINE
+C
+ 70 IP = IN-IS
+ IF (IMTHD.EQ.7) IP = 2*IP
+ IF (IP.LT.3) GO TO 90
+ QTFF = QT**FF
+ WRITE (NOUT,80) IN,STPTST,QA,QTFF,RHO,GAMMA
+ 80 FORMAT (4X,I5,3X,5D15.7)
+ IF (LEVEL.GE.4) GO TO 250
+ RETURN
+C
+ 90 WRITE (NOUT,100) IN,STPTST,RHO,GAMMA
+ 100 FORMAT (4X,I5,3X,D15.7,30X,2D15.7)
+ IF (LEVEL.GE.4) GO TO 250
+ RETURN
+C
+ 110 IF (IN.GT.0) GO TO 130
+C
+C ... PRINT HEADER FOR J-SI AND RS-SI
+C
+ WRITE (NOUT,120)
+ 120 FORMAT (////15X,'INTERMEDIATE OUTPUT AFTER EACH ITERATION'//
+ * ' NUMBER OF',4X,'CONVERGENCE',7X,'PARAMETER CHANGE TEST',10X,
+ * 'RHO'/' ITERATIONS',3X,'TEST ',11X,'LHS(QA)',7X,'RHS(QT**FF)'//
+ * )
+C
+C ... PRINT SUMMARY LINE
+C
+ 130 IP = IN-IS
+ IF (IMTHD.EQ.7) IP = 2*IP
+ IF (IP.LT.3) GO TO 150
+ QTFF = QT**FF
+ WRITE (NOUT,140) IN,STPTST,QA,QTFF,RHO
+ 140 FORMAT (4X,I5,3X,5D15.7)
+ IF (LEVEL.GE.4) GO TO 250
+ RETURN
+C
+ 150 WRITE (NOUT,160) IN,STPTST,RHO
+ 160 FORMAT (4X,I5,3X,D15.7,30X,D15.7)
+ IF (LEVEL.GE.4) GO TO 250
+ RETURN
+C
+C ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION FOR SOR.
+C
+ 170 IF (IN.GT.0) GO TO 190
+C
+C ... PRINT HEADER FOR SOR
+C
+ WRITE (NOUT,180)
+ 180 FORMAT (////15X,'INTERMEDIATE OUTPUT AFTER EACH ITERATION'//
+ * ' NUMBER OF',4X,'CONVERGENCE',6X,'CME ',9X,'OMEGA',7X,
+ * 'SPECTRAL'/' ITERATIONS',3X,'TEST',38X,'RADIUS'//)
+C
+C ... PRINT SUMMARY LINE FOR SOR
+C
+ 190 CONTINUE
+ WRITE (NOUT,200) IN,STPTST,CME,OMEGA,SPECR
+ 200 FORMAT (4X,I5,3X,4D14.7)
+ IF (LEVEL.GE.4) GO TO 250
+C
+ RETURN
+C
+C ... PRINT VARIOUS PARAMETERS AFTER EACH ITERATION FOR SSOR-CG.
+C
+ 210 IF (IN.GT.0) GO TO 230
+C
+C ... PRINT HEADER FOR SSOR-CG
+C
+ WRITE (NOUT,220)
+ 220 FORMAT (////15X,'INTERMEDIATE OUTPUT AFTER EACH ITERATION'//
+ * ' NUMBER OF',4X,'CONVERGENCE',3X,' SPECTRAL',6X,'S-PRIME',9X,
+ * 'RHO',10X,'GAMMA'/' ITERATIONS',3X,'TEST ',10X,'RADIUS'//)
+C
+C ... PRINT SUMMARY LINE FOR SSOR-CG
+C
+ 230 CONTINUE
+ WRITE (NOUT,240) IN,STPTST,SPECR,SPR,RHO,GAMMA
+ 240 FORMAT (4X,I5,3X,5D14.7)
+ IF (LEVEL.GE.4) GO TO 250
+ RETURN
+C
+ 250 IF (IMTHD.GT.5) GO TO 270
+ WRITE (NOUT,260) IN
+ 260 FORMAT ('0',2X,'ESTIMATE OF SOLUTION AT ITERATION ',I5)
+ GO TO 290
+ 270 WRITE (NOUT,280) IN
+ 280 FORMAT ('0',2X,'ESTIMATE OF SOLUTION AT BLACK POINTS ',
+ * 'AT ITERATION ',I5)
+ 290 DO 300 I = 1,N
+ WK(I) = U(I)/A(I)
+ 300 CONTINUE
+ WRITE (NOUT,310) (WK(I),I=1,N)
+ 310 FORMAT (2X,5(2X,D20.13))
+ WRITE (NOUT,320)
+ 320 FORMAT (//)
+C
+ RETURN
+ END
+ SUBROUTINE IVFILL (N,IV,IVAL)
+C
+C FILLS AN INTEGER VECTOR, IV, WITH AN INTEGER VALUE, IVAL.
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTOR IV
+C IV INTEGER VECTOR
+C IVAL INTEGER CONSTANT THAT FILLS FIRST N LOCATIONS OF IV
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,IVAL,IV(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,M,MP1
+C
+ IF (N.LE.0) RETURN
+C
+C CLEAN UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 10
+C
+ M = MOD(N,10)
+ IF (M.EQ.0) GO TO 20
+ DO 10 I = 1,M
+ IV(I) = IVAL
+ 10 CONTINUE
+ IF (N.LT.10) RETURN
+C
+ 20 MP1 = M+1
+ DO 30 I = MP1,N,10
+ IV(I) = IVAL
+ IV(I+1) = IVAL
+ IV(I+2) = IVAL
+ IV(I+3) = IVAL
+ IV(I+4) = IVAL
+ IV(I+5) = IVAL
+ IV(I+6) = IVAL
+ IV(I+7) = IVAL
+ IV(I+8) = IVAL
+ IV(I+9) = IVAL
+ 30 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE OMEG (DNRM,IFLAG)
+C
+C COMPUTES NEW VALUES FOR CME, OMEGA, AND SPECR FOR
+C FULLY ADAPTIVE SSOR METHODS.
+C
+C ... PARAMETER LIST:
+C
+C DNRM NUMERATOR OF RAYLEIGH QUOTIENT
+C IFLAG INDICATOR OF APPROPRIATE ENTRY POINT
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IFLAG
+ DOUBLE PRECISION DNRM
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION TEMP,ZM1,ZM2
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ ZM1 = 0.D0
+ ZM2 = 0.D0
+ IF (IFLAG.EQ.1) GO TO 10
+C
+C ... IFLAG .NE. 1, COMPUTE NEW ESTIMATE FOR CME
+C
+ ZM1 = ((1.D0-SPR)*(1.D0+BETAB*OMEGA**2)-OMEGA*(2.D0-OMEGA))/(OMEGA
+ * *(OMEGA-1.D0-SPR))
+C
+ IF (.NOT.CASEII) ZM2 = DNRM/BDELNM
+ IF (CASEII) ZM2 = DSQRT(DABS(DNRM/BDELNM))
+ CME = DMAX1(CME,ZM1,ZM2)
+C
+C ... IFLAG = 1, OR CONTINUATION OF IFLAG .NE. 1
+C
+C COMPUTE NEW VALUES OF OMEGA AND SPECR BASED ON CME AND BETAB
+C
+ 10 IS = IN+1
+ DELSNM = DELNNM
+ IF (CME.GE.(4.D0*BETAB)) GO TO 30
+C
+C ... CME .LT. 4.D0*BETAB
+C
+ TEMP = DSQRT(DABS(1.D0-2.D0*CME+4.D0*BETAB))
+ OMEGA = DMAX1((2.D0/(1.D0+TEMP)),1.D0)
+ TEMP = (1.D0-CME)/TEMP
+ SPECR = (1.D0-TEMP)/(1.D0+TEMP)
+ IF (DABS(OMEGA-1.D0).LT.DRELPR) SPECR = 0.D0
+ IF (LEVEL.GE.2) WRITE (NOUT,20) IN,BETAB,ZM1,ZM2,CME,OMEGA,SPECR
+ 20 FORMAT (/30X,'PARAMETERS WERE CHANGED AT ITERATION NO.',I5/35X,
+ * 'NEW ESTIMATE OF BETAB =',D15.7/35X,
+ * 'SOLUTION TO CHEBYSHEV EQN. =',D15.7/35X,
+ * 'SOLUTION TO RAYLEIGH QUOTIENT =',D15.7/35X,
+ * 'NEW ESTIMATE FOR CME =',D15.7/35X,
+ * 'NEW ESTIMATE FOR OMEGA =',D15.7/35X,
+ * 'NEW ESTIMATE FOR SPECTRAL RADIUS =',D15.7/)
+C
+ RETURN
+C
+C ... CME .GE. 4.D0*BETAB
+C
+C ... OMEGA-STAR WILL BE CHOSEN
+C
+ 30 CME = 2.D0*DSQRT(DABS(BETAB))
+ OMEGA = 2.D0/(1.D0+DSQRT(DABS(1.D0-4.D0*BETAB)))
+ SPECR = OMEGA-1.D0
+ ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ IF (LEVEL.GE.2) WRITE (NOUT,20) IN,BETAB,ZM1,ZM2,CME,OMEGA,SPECR
+C
+ RETURN
+ END
+ LOGICAL FUNCTION OMGCHG (NDUMMY)
+C
+C ... THIS FUNCTION TESTS TO SEE WHETHER OMEGA SHOULD BE CHANGED
+C ... FOR SSOR CG METHOD.
+C
+C ... PARAMETER LIST:
+C
+C NDUMMY ARBITRARY INTEGER PARAMETER
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER NDUMMY
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION DEL1,DEL2,X
+C
+ DOUBLE PRECISION PHI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+C ... STATEMENT FUNCTION PHI(X)
+C
+ PHI(X) = (1.D0-DSQRT(DABS(1.D0-X)))/(1.D0+DSQRT(DABS(1.D0-X)))
+C
+ OMGCHG = .FALSE.
+ IF (IN-IS.LT.3) RETURN
+ IF (SPECR.EQ.0.D0) GO TO 10
+ IF (SPECR.GE.SPR) RETURN
+ DEL1 = -DLOG(DABS(PHI(SPECR)/PHI(SPECR/SPR)))
+ DEL2 = -DLOG(DABS(PHI(SPR)))
+ IF ((DEL1/DEL2).GE.FF) RETURN
+C
+ 10 OMGCHG = .TRUE.
+C
+ RETURN
+ END
+ LOGICAL FUNCTION OMGSTR (NDUMMY)
+C
+C TESTS FOR FULLY ADAPTIVE SSOR METHODS WHETHER OMEGA-STAR
+C SHOULD BE USED FOR OMEGA AND THE ADAPTIVE PROCESS TURNED
+C OFF.
+C
+C ... PARAMETER LIST:
+C
+C NDUMMY ARBITRARY INTEGER PARAMETER
+C
+C ... SPECIFICATION FOR ARGUMENT
+C
+ INTEGER NDUMMY
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION OMSTAR,TEMP,TEMP1,X
+C
+ DOUBLE PRECISION PHI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+C ... STATEMENT FUNCTION PHI(X)
+C
+ PHI(X) = (1.D0-DSQRT(DABS(1.D0-X)))/(1.D0+DSQRT(DABS(1.D0-X)))
+C
+ OMGSTR = .FALSE.
+ IF (BETAB.GE..25D0.OR..NOT.ADAPT) RETURN
+ OMSTAR = 2.D0/(1.D0+DSQRT(DABS(1.D0-4.D0*BETAB)))
+C
+C ... TEST TO CHOSE OMEGA-STAR
+C
+ IF ((OMSTAR.LE.1.D0).OR.(SPECR.LE.0.D0)) GO TO 10
+ TEMP = DLOG(DABS(PHI(OMSTAR-1.D0)))
+ TEMP1 = DLOG(DABS(PHI(SPECR)))
+ IF ((TEMP/TEMP1).LT.FF) RETURN
+C
+C ... OMEGA-STAR WAS CHOSEN
+C
+ 10 OMEGA = OMSTAR
+ SPECR = OMEGA-1.D0
+ OMGSTR = .TRUE.
+ ADAPT = .FALSE.
+ PARTAD = .FALSE.
+ CME = 2.D0*DSQRT(DABS(BETAB))
+ RRR = PHI(1.D0-SPECR)**2
+ GAMMA = 2.D0/(2.D0-SPECR)
+ SIGE = SPECR/(2.D0-SPECR)
+ RHO = 1.D0
+ IS = IN+1
+ DELSNM = DELNNM
+ IF (LEVEL.GE.2) WRITE (NOUT,20) IN,CME,OMEGA,SPECR
+ 20 FORMAT (/30X,'OMEGA-STAR, AN ALTERNATE ESTIMATE OF',
+ * ' OMEGA, WAS CHOSEN AT ITERATION',I5/35X,
+ * 'NEW ESTIMATE FOR CME =',D15.7/35X,
+ * 'NEW ESTIMATE FOR OMEGA =',D15.7/35X,
+ * 'NEW ESTIMATE FOR SPECTRAL RADIUS =',D15.7/)
+C
+ RETURN
+ END
+ SUBROUTINE PARCON (DTNRM,C1,C2,C3,C4,GAMOLD,RHOTMP,IBMTH)
+C
+C COMPUTES ACCELERATION PARAMETERS FOR CONJUGATE GRADIENT
+C ACCELERATED METHODS.
+C
+C ... PARAMETER LIST:
+C
+C DTNRM INNER PRODUCT OF RESIDUALS
+C C1 OUTPUT: RHO*GAMMA
+C C2 OUTPUT: RHO
+C C3 OUTPUT: 1-RHO
+C C4 OUTPUT: RHO*(1-GAMMA)
+C GAMOLD OUTPUT: VALUE OF GAMMA AT PRECEDING ITERATION
+C RHOTMP LAST ESTIMATE FOR VALUE OF RHO
+C IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY CG
+C IBMTH = 1, JACOBI
+C = 2, REDUCED SYSTEM
+C = 3, SSOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IBMTH
+ DOUBLE PRECISION DTNRM,C1,C2,C3,C4,GAMOLD,RHOTMP
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP
+ DOUBLE PRECISION RHOOLD
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ IP = IN-IS
+C
+C ... SET RHOOLD AND GAMOLD
+C
+ RHOOLD = RHO
+ GAMOLD = GAMMA
+C
+C ... COMPUTE GAMMA (IN+1)
+C
+C ... FOR JACOBI OR REDUCED SYSTEM CG
+C
+ IF (IBMTH.LE.2) GAMMA = 1.D0/(1.D0-DTNRM/DELNNM)
+C
+C ... FOR SSOR CG
+C
+ IF (IBMTH.EQ.3) GAMMA = DELNNM/DTNRM
+C
+C ... COMPUTE RHO (IN+1)
+C
+ RHO = 1.D0
+ IF (IP.EQ.0) GO TO 20
+ IF (ISYM.EQ.0) GO TO 10
+ RHO = 1.D0/(1.D0-GAMMA*RHOTMP/DELSNM)
+ GO TO 20
+ 10 RHO = 1.D0/(1.D0-GAMMA*DELNNM/(GAMOLD*DELSNM*RHOOLD))
+C
+C ... COMPUTE CONSTANTS C1, C2, C3, AND C4
+C
+ 20 DELSNM = DELNNM
+ RHOTMP = RHOOLD
+ C1 = RHO*GAMMA
+ C2 = RHO
+ C3 = 1.D0-RHO
+ C4 = RHO*(1.D0-GAMMA)
+C
+ RETURN
+ END
+ SUBROUTINE PARSI (C1,C2,C3,IBMTH)
+C
+C COMPUTES ACCELERATION PARAMETERS FOR SEMI-ITERATIVE
+C ACCELERATED METHODS.
+C
+C ... PARAMETER LIST:
+C
+C C1,C2
+C AND
+C C3 OUTPUT ACCELERATION PARAMETERS
+C IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI
+C IBMTH = 1, JACOBI
+C = 2, REDUCED SYSTEM
+C = 3, SSOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IBMTH
+ DOUBLE PRECISION C1,C2,C3
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ IP = IN-IS
+ IF (IP.EQ.0) GO TO 30
+ IF (IP.EQ.1) GO TO 10
+ RHO = 1.D0/(1.D0-SIGE*SIGE*RHO*.25D0)
+ GO TO 20
+ 10 RHO = 1.D0/(1.D0-SIGE*SIGE*.5D0)
+C
+ 20 C1 = RHO*GAMMA
+ C2 = RHO
+ C3 = 1.D0-RHO
+C
+ RETURN
+C
+C ... NONADAPTIVE INITIALIZATION FOR SEMI-ITERATIVE METHODS
+C
+ 30 CONTINUE
+ GO TO (40,50,60), IBMTH
+C
+C ... JSI
+C
+ 40 IF (CASEII) SME = -CME
+ GAMMA = 2.D0/(2.D0-CME-SME)
+ SIGE = (CME-SME)/(2.D0-CME-SME)
+ GO TO 70
+C
+C ... REDUCED SYSTEM SI
+C
+ 50 GAMMA = 2.D0/(2.D0-CME*CME)
+ SIGE = CME*CME/(2.D0-CME*CME)
+ RRR = (1.D0-DSQRT(DABS(1.D0-CME*CME)))/(1.D0+DSQRT(DABS(1.D0-CME*
+ * CME)))
+ GO TO 70
+C
+C ... SSORSI
+C
+ 60 GAMMA = 2.D0/(2.D0-SPECR)
+ SIGE = SPECR/(2.D0-SPECR)
+ RRR = (1.D0-DSQRT(DABS(1.D0-SIGE*SIGE)))/(1.D0+DSQRT(DABS(1.D0-
+ * SIGE*SIGE)))
+C
+ 70 RHO = 1.D0
+ C1 = GAMMA
+ C2 = 1.D0
+ C3 = 0.D0
+C
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION PBETA (NN,IA,JA,A,V,W1,W2)
+C
+C ... COMPUTES THE NUMERATOR FOR THE COMPUTATION OF BETAB IN
+C ... SSOR METHODS.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C W1,W2 WORKSPACE VECTORS OF LENGTH N
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),V(NN),W1(NN),W2(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IBGN,IEND,II,ITMP,JAI,JAJJ,JJ,K,N,NM1
+ DOUBLE PRECISION SUM,TEMP1,TEMP2
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ PBETA = 0.D0
+ IF (ISYM.EQ.0) GO TO 110
+C
+C ************** NON - SYMMETRIC SECTION ********************
+C
+ DO 10 I = 1,N
+ W1(I) = V(I)
+ 10 CONTINUE
+ TEMP1 = 0.D0
+ TEMP2 = 0.D0
+ ITMP = 2
+ IBGN = IA(1)
+ IEND = IA(ITMP)-1
+ IF (IEND.LT.IBGN) GO TO 30
+ DO 20 I = IBGN,IEND
+ JAI = JA(I)
+ TEMP1 = TEMP1-A(I)*W1(JAI)
+ 20 CONTINUE
+ 30 W1(1) = TEMP1
+ W2(1) = 0.D0
+ NM1 = N-1
+ DO 70 K = 2,NM1
+ TEMP1 = 0.D0
+ TEMP2 = 0.D0
+ IBGN = IA(K)
+ IEND = IA(K+1)-1
+ IF (IEND.LT.IBGN) GO TO 60
+ DO 50 I = IBGN,IEND
+ JAI = JA(I)
+ IF (JAI.GT.K) GO TO 40
+ TEMP2 = TEMP2-A(I)*W1(JAI)
+ GO TO 50
+ 40 TEMP1 = TEMP1-A(I)*W1(JAI)
+ 50 CONTINUE
+ 60 W1(K) = TEMP1
+ W2(K) = TEMP2
+ 70 CONTINUE
+ TEMP2 = 0.D0
+ IBGN = IA(N)
+ IEND = IA(N+1)-1
+ IF (IEND.LT.IBGN) GO TO 90
+ DO 80 I = IBGN,IEND
+ JAI = JA(I)
+ TEMP2 = TEMP2-A(I)*W1(JAI)
+ 80 CONTINUE
+ 90 W2(N) = TEMP2
+ DO 100 I = 1,N
+ PBETA = PBETA+V(I)*W2(I)
+ 100 CONTINUE
+ RETURN
+C
+C **************** SYMMETRIC SECTION *************************
+C
+ 110 DO 130 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = 0.D0
+ IF (IBGN.GT.IEND) GO TO 130
+ DO 120 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*V(JAJJ)
+ 120 CONTINUE
+ PBETA = PBETA+SUM*SUM
+ 130 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE PBSOR (NN,IA,JA,A,U,RHS)
+C
+C ... THIS SUBROUTINE COMPUTES A BACKWARD SOR SWEEP.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM (= NN)
+C OMEGA RELAXATION FACTOR
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U LATEST ESTIMATE OF SOLUTION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),RHS(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IBGN,IEND,II,JAJJ,JJ,N,NPL1
+ DOUBLE PRECISION OMM1,SUM,UI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ NPL1 = N+1
+ OMM1 = OMEGA-1.D0
+ IF (ISYM.EQ.0) GO TO 40
+C
+C *************** NON - SYMMETRIC SECTION **********************
+C
+ DO 30 I = 1,N
+ II = NPL1-I
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ 20 U(II) = OMEGA*SUM-OMM1*U(II)
+ 30 CONTINUE
+ RETURN
+C
+C ***************** SYMMETRIC SECTION **************************
+C
+ 40 DO 60 II = 1,N
+ UI = U(II)
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 60
+ DO 50 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHS(JAJJ) = RHS(JAJJ)-A(JJ)*UI
+ 50 CONTINUE
+ 60 CONTINUE
+C
+ DO 90 I = 1,N
+ II = NPL1-I
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 80
+ DO 70 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 70 CONTINUE
+ 80 U(II) = OMEGA*SUM-OMM1*U(II)
+ 90 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE PERMAT (NN,IA,JA,A,P,NEWIA,ISYM,LEVEL,NOUT,IERR)
+C
+C*********************************************************************
+C
+C ... SUBROUTINE PERMAT TAKES THE SPARSE MATRIX REPRESENTATION
+C OF THE MATRIX STORED IN THE ARRAYS IA, JA, AND A AND
+C PERMUTES BOTH ROWS AND COLUMNS OVERWRITING THE PREVIOUS
+C STRUCTURE.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM (= NN)
+C IA,JA INTEGER ARRAYS OF THE SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF THE SPARSE MATRIX REPRESENTATION
+C P PERMUTATION VECTOR
+C NEWIA INTEGER WORK VECTOR OF LENGTH N
+C ISYM SYMMETRIC/NONSYMMETRIC STORAGE SWITCH
+C LEVEL SWITCH CONTROLLING LEVEL OF OUTPUT
+C NOUT OUTPUT UNIT NUMBER
+C IER OUTPUT ERROR FLAG (= IERR)
+C
+C IER = 0 NORMAL RETURN
+C IER = 301 NO ENTRY IN ITH ROW OF ORIGINAL
+C MATRIX. IF LEVEL IS GREATER THAN
+C 0, I WILL BE PRINTED
+C IER = 302 THERE IS NO ENTRY IN THE ITH ROW
+C OF THE PERMUTED MATRIX
+C IER = 303 ERROR RETURN FROM QSORT IN
+C SORTING THE ITH ROW OF THE
+C PERMUTED MATRIX
+C ... IT IS ASSUMED THAT THE I-TH ENTRY OF THE PERMUTATION VECTOR
+C P INDICATES THE ROW THE I-TH ROW GETS MAPPED INTO. (I.E.
+C IF ( P(I) = J ) ROW I GETS MAPPED INTO ROW J.)
+C
+C ... THE ARRAY NEWIA IS AN INTEGER WORK VECTOR OF LENGTH N WHICH
+C KEEPS TRACK OF WHERE THE ROWS BEGIN IN THE PERMUTED STRUCTURE.
+C
+C ... PERMAT IS CAPABLE OF PERMUTING BOTH THE SYMMETRIC AND NON-
+C SYMMETRIC FORM OF IA, JA, AND A. IF ( ISYM .EQ. 0 ) SYMMETRIC
+C FORM IS ASSUMED.
+C
+C ... TWO EXTERNAL MODULES ARE USED BY PERMAT. THE FIRST IS INTEGER
+C FUNCTION BISRCH WHICH USES A BISECTION SEARCH ( ORDER LOG-BASE-2
+C OF N+1 ) THROUGH THE ARRAY IA TO FIND THE ROW INDEX OF AN ARBI-
+C TRARY ENTRY EXTRACTED FROM THE ARRAY JA. THE SECOND IS SUBROUTINE
+C QSORT WHICH PERFORMS A QUICK SORT TO PLACE THE ENTRIES IN
+C THE PERMUTED ROWS IN COLUMN ORDER.
+C
+C*********************************************************************
+C
+ INTEGER NN,IA(1),JA(1),P(NN),NEWIA(NN),ISYM,IERR
+ DOUBLE PRECISION A(1)
+C
+C ... INTERNAL VARIABLES
+C
+ INTEGER BISRCH,I,IBGN,IEND,IP,IPP,J,JAJ,JP,IER,K,N,NELS,NEXT,NPL1
+C
+ DOUBLE PRECISION SAVE,TEMP
+C
+C*********************************************************************
+C
+C ... PREPROCESSING PHASE
+C
+C ...... DETERMINE THE NUMBER OF NONZEROES IN THE ROWS OF THE PERMUTED
+C MATRIX AND STORE THAT IN NEWIA. THEN SWEEP THRU NEWIA TO MAKE
+C NEWIA(I) POINT TO THE BEGINNING OF EACH ROW IN THE PERMUTED
+C DATA STRUCTURE. ALSO NEGATE ALL THE ENTRIES IN JA TO INDICATE
+C THAT THOSE ENTRIES HAVE NOT BEEN MOVED YET.
+C
+ N = NN
+ IER = 0
+ NPL1 = N+1
+ NELS = IA(NPL1)-1
+ DO 10 I = 1,N
+ NEWIA(I) = 0
+ 10 CONTINUE
+ DO 30 I = 1,N
+ IP = P(I)
+ IBGN = IA(I)
+ IEND = IA(I+1)-1
+ IF (IBGN.GT.IEND) GO TO 90
+ DO 20 J = IBGN,IEND
+ IPP = IP
+ JAJ = JA(J)
+ JP = P(JAJ)
+ IF (ISYM.EQ.0.AND.IP.GT.JP) IPP = JP
+ NEWIA(IPP) = NEWIA(IPP)+1
+ JA(J) = -JAJ
+ 20 CONTINUE
+ 30 CONTINUE
+ IBGN = 1
+ DO 40 I = 1,N
+ K = IBGN+NEWIA(I)
+ NEWIA(I) = IBGN
+ IBGN = K
+ 40 CONTINUE
+C
+C ...... PREPROCESSING NOW FINISHED.
+C
+C ...... NOW PERMUTE JA AND A. THIS PERMUTATION WILL PERFORM THE
+C FOLLOWING STEPS
+C
+C 1. FIND THE FIRST ENTRY IN JA NOT PERMUTED WHICH IS
+C INDICATED BY AN NEGATIVE VALUE IN JA
+C 2. COMPUTE WHICH ROW THE CURRENT ENTRY IS IN. THIS
+C IS COMPUTED BY A BISECTION SEARCH THRU THE ARRAY
+C IA.
+C 3. USING THE PERMUTATION ARRAY P AND THE ARRAY NEWIA
+C COMPUTE WHERE THE CURRENT ENTRY IS TO BE PLACED.
+C 4. THEN PICK UP THE ENTRY WHERE THE CURRENT ENTRY WILL
+C GO. PUT THE CURRENT ENTRY IN PLACE. THEN MAKE THE
+C DISPLACED ENTRY THE CURRENT ENTRY AND LOOP TO STEP 2.
+C 5. THIS PROCESS WILL END WHEN THE NEXT ENTRY HAS ALREADY
+C BEEN MOVED. THEN LOOP TO STEP 1.
+C
+ DO 70 J = 1,NELS
+ IF (JA(J).GT.0) GO TO 70
+ JAJ = -JA(J)
+ SAVE = A(J)
+ NEXT = J
+ JA(J) = JAJ
+C
+ 50 JP = P(JAJ)
+ I = BISRCH(NPL1,IA,NEXT)
+ IP = P(I)
+ IPP = IP
+ IF (ISYM.NE.0.OR.IP.LE.JP) GO TO 60
+ IPP = JP
+ JP = IP
+ 60 NEXT = NEWIA(IPP)
+C
+ TEMP = SAVE
+ SAVE = A(NEXT)
+ A(NEXT) = TEMP
+C
+ JAJ = -JA(NEXT)
+ JA(NEXT) = JP
+ NEWIA(IPP) = NEWIA(IPP)+1
+ IF (JAJ.GT.0) GO TO 50
+C
+ 70 CONTINUE
+C
+C ...... THE MATRIX IS NOW PERMUTED BUT THE ROWS MAY NOT BE IN
+C ORDER. THE REMAINDER OF THIS SUBROUTINE PERFORMS
+C A QUICK SORT ON EACH ROW TO SORT THE ENTRIES IN
+C COLUMN ORDER. THE IA ARRAY IS ALSO CORRECTED FROM
+C INFORMATION STORED IN THE NEWIA ARRAY. NEWIA(I) NOW
+C POINTS TO THE FIRST ENTRY OF ROW I+1.
+C
+ IA(1) = 1
+ DO 80 I = 1,N
+ IA(I+1) = NEWIA(I)
+ K = IA(I+1)-IA(I)
+ IF (K.EQ.1) GO TO 80
+ IF (K.LT.1) GO TO 110
+C
+ IBGN = IA(I)
+ CALL QSORT (K,JA(IBGN),A(IBGN),IER)
+ IF (IER.NE.0) GO TO 130
+C
+ 80 CONTINUE
+C
+C ...... END OF MATRIX PERMUTATION
+C
+ GO TO 150
+C
+C ... ERROR TRAPS
+C
+C ...... NO ENTRY IN ROW I IN THE ORIGINAL SYSTEM
+C
+ 90 IER = 301
+ IF (LEVEL.GE.0) WRITE (NOUT,100) I
+ 100 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE PERMAT '/' ',' NO ENTRY IN ROW ',I10
+ * ,' OF ORIGINAL MATRIX ')
+ GO TO 150
+C
+C ...... NO ENTRY IN ROW I IN THE PERMUTED SYSTEM
+C
+ 110 IER = 302
+ IF (LEVEL.GE.0) WRITE (NOUT,120) I
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE PRBNDX '/' ',' NO ENTRY IN ROW ',I10
+ * ,' OF PERMUTED MATRIX ')
+ GO TO 150
+C
+C ...... ERROR RETURN FROM SUBROUTINE QSORT
+C
+ 130 IER = 303
+ IF (LEVEL.GE.0) WRITE (NOUT,140) I
+ 140 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE QSORT '/' ',
+ * ' ERROR IN SORTING PERMUTED ROW ',I12/' ',
+ * ' CALLED FROM ITPACK ROUTINE PRBNDX ')
+C
+ 150 CONTINUE
+ IERR = IER
+ RETURN
+ END
+ SUBROUTINE PERROR (NN,IA,JA,A,RHS,U,W,DIGTT1,DIGTT2,IDGTTS)
+C
+C PERROR COMPUTES THE RESIDUAL, R = RHS - A*U. THE USER
+C ALSO HAS THE OPTION OF PRINTING THE RESIDUAL AND/OR THE
+C UNKNOWN VECTOR DEPENDING ON IDGTS.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C U LATEST ESTIMATE OF SOLUTION
+C W WORKSPACE VECTOR
+C DIGIT1 OUTPUT: MEASURE OF ACCURACY OF STOPPING TEST (= DIGTT1
+C DIGIT2 OUTPUT: MEASURE OF ACCURACY OF SOLUTION (= DIGTT2)
+C IDGTS PARAMETER CONTROLING LEVEL OF OUTPUT (= IDGTTS)
+C IF IDGTS < 1 OR IDGTS > 4, THEN NO OUTPUT.
+C = 1, THEN NUMBER OF DIGITS IS PRINTED, PRO-
+C VIDED LEVEL .GE. 1
+C = 2, THEN SOLUTION VECTOR IS PRINTED, PRO-
+C VIDED LEVEL .GE. 1
+C = 3, THEN RESIDUAL VECTOR IS PRINTED, PRO-
+C VIDED LEVEL .GE. 1
+C = 4, THEN BOTH VECTORS ARE PRINTED, PRO-
+C VIDED LEVEL .GE. 1
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN,IDGTTS
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),W(NN),DIGTT1,DIGTT2
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IDGTS,N
+ DOUBLE PRECISION BNRM,DIGIT1,DIGIT2,RNRM,TEMP
+C
+C ... SPECIFICATIONS FOR FUNCTION SUBPROGRAMS
+C
+ DOUBLE PRECISION DDOT
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ IDGTS = IDGTTS
+ DIGIT1 = 0.D0
+ DIGIT2 = 0.D0
+ IF (N.LE.0) GO TO 40
+C
+ DIGIT1 = -DLOG10(DABS(DRELPR))
+ IF (STPTST.GT.0.D0) DIGIT1 = -DLOG10(DABS(STPTST))
+ BNRM = DDOT(N,RHS,1,RHS,1)
+ IF (BNRM.EQ.0.D0) GO TO 10
+ CALL PMULT (N,IA,JA,A,U,W)
+ CALL WEVMW (N,RHS,W)
+ RNRM = DDOT(N,W,1,W,1)
+ TEMP = RNRM/BNRM
+ IF (TEMP.EQ.0.D0) GO TO 10
+ DIGIT2 = -DLOG10(DABS(TEMP))/2.D0
+ GO TO 20
+C
+ 10 DIGIT2 = -DLOG10(DABS(DRELPR))
+C
+ 20 IF ((IDGTS.LT.1).OR.(LEVEL.LE.0)) GO TO 40
+ WRITE (NOUT,30) DIGIT1,DIGIT2
+ 30 FORMAT (/6X,'APPROX. NO. OF DIGITS (EST. REL. ERROR) =',F5.1,2X,
+ * '(DIGIT1)'/3X,'APPROX. NO. OF DIGITS (EST. REL. RESIDUAL) =',
+ * F5.1,2X,'(DIGIT2)')
+C
+ IF (IDGTS.LE.1.OR.IDGTS.GT.4) GO TO 40
+ IF (IDGTS.NE.3) CALL VOUT (N,U,2,NOUT)
+ IF (IDGTS.GE.3) CALL VOUT (N,W,1,NOUT)
+C
+ 40 CONTINUE
+ DIGTT1 = DIGIT1
+ DIGTT2 = DIGIT2
+ RETURN
+ END
+ SUBROUTINE PERVEC (N,V,P)
+C
+C THIS SUBROUTINE PERMUTES A D.P. VECTOR AS DICTATED BY THE
+C PERMUTATION VECTOR, P. IF P(I) = J, THEN V(J) GETS V(I).
+C
+C ... PARAMETER LIST:
+C
+C V D.P. VECTOR OF LENGTH N
+C P INTEGER PERMUTATION VECTOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,P(N)
+ DOUBLE PRECISION V(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER II,NEXT,NOW
+ DOUBLE PRECISION SAVE,TEMP
+C
+ IF (N.LE.0) RETURN
+C
+ DO 20 II = 1,N
+ IF (P(II).LT.0) GO TO 20
+C
+ NEXT = P(II)
+ SAVE = V(II)
+C
+ 10 CONTINUE
+ IF (P(NEXT).LT.0) GO TO 20
+ TEMP = SAVE
+ SAVE = V(NEXT)
+ V(NEXT) = TEMP
+C
+ NOW = NEXT
+ NEXT = P(NOW)
+ P(NOW) = -NEXT
+ GO TO 10
+C
+ 20 CONTINUE
+C
+ DO 30 II = 1,N
+ P(II) = -P(II)
+ 30 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE PFSOR (NN,IA,JA,A,U,RHS)
+C
+C THIS SUBROUTINE COMPUTES A FORWARD SOR SWEEP.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM (= NN)
+C OMEGA RELAXATION FACTOR
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U LATEST ESTIMATE OF SOLUTION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),RHS(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JAJJ,JJ,N
+ DOUBLE PRECISION OMM1,SUM,UI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ OMM1 = OMEGA-1.D0
+ IF (ISYM.EQ.0) GO TO 40
+C
+C *********** NON - SYMMETRIC SECTION *********************
+C
+ DO 30 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ 20 UI = OMEGA*SUM-OMM1*U(II)
+ U(II) = UI
+ 30 CONTINUE
+ RETURN
+C
+C ************* SYMMETRIC SECTION *************************
+C
+ 40 DO 80 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 60
+ DO 50 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 50 CONTINUE
+ 60 UI = OMEGA*SUM-OMM1*U(II)
+ U(II) = UI
+ IF (IBGN.GT.IEND) GO TO 80
+ DO 70 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHS(JAJJ) = RHS(JAJJ)-A(JJ)*UI
+ 70 CONTINUE
+ 80 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE PFSOR1 (NN,IA,JA,A,U,RHS)
+C
+C THIS SUBROUTINE COMPUTES A FORWARD SOR SWEEP ON U AND
+C COMPUTES THE NORM OF THE PSEUDO-RESIDUAL VECTOR.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM (= NN)
+C OMEGA RELAXATION FACTOR
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U LATEST ESTIMATE OF SOLUTION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),RHS(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JAJJ,JJ,N
+ DOUBLE PRECISION OMM1,SUM,SUMD,UI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ OMM1 = OMEGA-1.D0
+ SUMD = 0.D0
+ IF (ISYM.EQ.0) GO TO 40
+C
+C **************** NON - SYMMETRIC SECTION ******************
+C
+ DO 30 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ 20 CONTINUE
+ UI = OMEGA*SUM-OMM1*U(II)
+ SUMD = SUMD+(UI-U(II))**2
+ U(II) = UI
+ 30 CONTINUE
+ GO TO 90
+C
+C *************** SYMMETRIC SECTION ************************
+C
+ 40 DO 80 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 60
+ DO 50 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 50 CONTINUE
+ 60 CONTINUE
+ UI = OMEGA*SUM-OMM1*U(II)
+ SUMD = SUMD+(UI-U(II))**2
+ U(II) = UI
+ IF (IBGN.GT.IEND) GO TO 80
+ DO 70 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHS(JAJJ) = RHS(JAJJ)-A(JJ)*UI
+ 70 CONTINUE
+ 80 CONTINUE
+C
+ 90 DELNNM = DSQRT(SUMD)
+ RETURN
+C
+ END
+ SUBROUTINE PJAC (NN,IA,JA,A,U,RHS)
+C
+C ... THIS SUBROUTINE PERFORMS ONE JACOBI ITERATION.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U ESTIMATE OF SOLUTION OF A MATRIX PROBLEM
+C RHS ON INPUT: CONTAINS THE RIGHT HAND SIDE OF
+C A MATRIX PROBLEM
+C ON OUTPUT: CONTAINS A*U + RHS
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),RHS(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JAJJ,JJ,N
+ DOUBLE PRECISION RHSII,UII
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ IF (ISYM.EQ.0) GO TO 30
+C
+C *************** NON - SYMMETRIC SECTION ****************
+C
+ DO 20 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 20
+ RHSII = RHS(II)
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHSII = RHSII-A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ RHS(II) = RHSII
+ 20 CONTINUE
+ RETURN
+C
+C ************** SYMMETRIC SECTION **********************
+C
+ 30 DO 50 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 50
+ RHSII = RHS(II)
+ UII = U(II)
+ DO 40 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHSII = RHSII-A(JJ)*U(JAJJ)
+ RHS(JAJJ) = RHS(JAJJ)-A(JJ)*UII
+ 40 CONTINUE
+ RHS(II) = RHSII
+ 50 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE PMULT (NN,IA,JA,A,U,W)
+C
+C ... THIS SUBROUTINE PERFORMS ONE MATRIX-VECTOR MULTIPLICATION.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U LATEST ESTIMATE OF SOLUTION
+C W ON RETURN W CONTAINS A*U
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),W(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JJ,N
+ DOUBLE PRECISION SUM,UII,WII
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ IF (N.LE.0) RETURN
+ IF (ISYM.EQ.0) GO TO 40
+C
+C *************** NON - SYMMETRIC SECTION **********************
+C
+ DO 30 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = 0.0D0
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM+A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ 20 W(II) = SUM
+ 30 CONTINUE
+ RETURN
+C
+C ***************** SYMMETRIC SECTION **************************
+C
+ 40 CALL VFILL (N,W,0.D0)
+ DO 70 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ UII = U(II)
+ WII = W(II)
+ IF (IBGN.GT.IEND) GO TO 60
+ DO 50 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ WII = WII+A(JJ)*U(JAJJ)
+ W(JAJJ) = W(JAJJ)+A(JJ)*UII
+ 50 CONTINUE
+ 60 W(II) = WII
+ 70 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE PRBNDX (NN,NBLACK,IA,JA,P,IP,LEVEL,NOUT,IER)
+C
+C**************************************************************
+C
+C THIS SUBROUTINE COMPUTES THE RED-BLACK PERMUTATION
+C VECTORS P ( AND ITS INVERSE IP ) IF POSSIBLE.
+C
+C THE ALGORITHM IS TO MARK THE FIRST NODE AS RED (ARBITRARY).
+C ALL OF ITS ADJACENT NODES ARE MARKED BLACK AND PLACED IN
+C A STACK. THE REMAINDER OF THE CODE PULLS THE FIRST NODE
+C OFF THE TOP OF THE STACK AND TRIES TO TYPE ITS ADJACENT NODES.
+C THE TYPING OF THE ADJACENT POINT IS A FIVE WAY CASE STATEMENT
+C WHICH IS WELL COMMENTED BELOW (SEE DO LOOP 100).
+C
+C THE ARRAY P IS USED BOTH TO KEEP TRACK OF THE COLOR OF A NODE
+C (RED NODE IS POSITIVE, BLACK IS NEGATIVE) BUT ALSO THE FATHER
+C NODE THAT CAUSED THE COLOR MARKING OF THAT POINT. SINCE
+C COMPLETE INFORMATION ON THE ADJACENCY STRUCTURE IS HARD TO COME
+C BY THIS FORMS A LINK TO ENABLE THE COLOR CHANGE OF A PARTIAL
+C TREE WHEN A RECOVERABLE COLOR CONFLICT OCCURS.
+C
+C THE ARRAY IP IS USED AS A STACK TO POINT TO THE SET OF NODES
+C LEFT TO BE TYPED THAT ARE KNOWN TO BE ADJACENT TO THE CURRENT
+C FATHER NODE.
+C
+C*********************************************************************
+C
+C INPUT PARAMETERS
+C
+C N NUMBER OF NODES. (INTEGER, SCALAR) (= NN)
+C
+C IA,JA ADJACENCY STRUCTURE ARRAYS. CAN BE EITHER THE
+C SYMMETRIC OR NONSYMMETRIC FORM. IT IS ASSUMED
+C THAT FOR EVERY ROW WHERE ONLY ONE ELEMENT IS
+C STORED THAT ELEMENT CORRESPONDS TO THE DIAGONAL
+C ENTRY. THE DIAGONAL DOES NOT HAVE TO BE THE FIRST
+C ENTRY STORED. (INTEGER, ARRAYS)
+C LEVEL SWITCH FOR PRINTING
+C NOUT OUTPUT TAPE NUMBER
+C
+C OUTPUT PARAMETERS
+C
+C NBLACK NUMBER OF BLACK NODES. NUMBER OF RED NODES IS
+C N - NBLACK. (INTEGER, SCALAR)
+C
+C P, IP PERMUTATION AND INVERSE PERMUTATION VECTORS.
+C (INTEGER, ARRAYS EACH OF LENGTH N)
+C
+C IER ERROR FLAG. (INTEGER, SCALAR)
+C
+C IER = 0, NORMAL RETURN. INDEXING PERFORMED
+C SUCCESSFULLY
+C IER =201, RED-BLACK INDEXING NOT POSSIBLE.
+C
+C********************************************************************
+C
+ INTEGER NN,NBLACK,IA(1),JA(1),P(NN),IP(NN),IER
+C
+ INTEGER FIRST,NEXT,LAST,I,OLD,YOUNG,IBGN,IEND,J,K,CURTYP,NXTTYP,
+ * TYPE,NRED,N
+C
+C-----------------------------------------------------------------------
+C
+ N = NN
+ IER = 0
+C
+C IF ( N .LE. 0 ) GO TO 8000
+C
+ DO 10 I = 1,N
+ P(I) = 0
+ IP(I) = 0
+ 10 CONTINUE
+C
+C ... HANDLE THE FIRST SET OF POINTS UNTIL SOME ADJACENT POINTS
+C ... ARE FOUND
+C
+ FIRST = 1
+C
+ 20 P(FIRST) = FIRST
+ IF (IA(FIRST+1)-IA(FIRST).GT.1) GO TO 40
+C
+C ... SEARCH FOR NEXT ENTRY THAT HAS NOT BEEN MARKED
+C
+ IF (FIRST.EQ.N) GO TO 130
+ IBGN = FIRST+1
+ DO 30 I = IBGN,N
+ IF (P(I).NE.0) GO TO 30
+ FIRST = I
+ GO TO 20
+ 30 CONTINUE
+ GO TO 130
+C
+C ... FIRST SET OF ADJACENT POINTS FOUND
+C
+ 40 NEXT = 1
+ LAST = 1
+ IP(1) = FIRST
+C
+C ... LOOP OVER LABELED POINTS INDICATED IN THE STACK STORED IN
+C ... THE ARRAY IP
+C
+ 50 K = IP(NEXT)
+ CURTYP = P(K)
+ NXTTYP = -CURTYP
+ IBGN = IA(K)
+ IEND = IA(K+1)-1
+ IF (IBGN.GT.IEND) GO TO 110
+ DO 100 I = IBGN,IEND
+ J = JA(I)
+ TYPE = P(J)
+ IF (J.EQ.K) GO TO 100
+C
+C==================================================================
+C
+C THE FOLLOWING IS A FIVE WAY CASE STATEMENT DEALING WITH THE
+C LABELING OF THE ADJACENT NODE.
+C
+C ... CASE I. IF THE ADJACENT NODE HAS ALREADY BEEN LABELED WITH
+C LABEL EQUAL TO NXTTYP, THEN SKIP TO THE NEXT ADJACENT
+C NODE.
+C
+ IF (TYPE.EQ.NXTTYP) GO TO 100
+C
+C ... CASE II. IF THE ADJACENT NODE HAS NOT BEEN LABELED YET LABEL
+C IT WITH NXTTYP AND ENTER IT IN THE STACK
+C
+ IF (TYPE.NE.0) GO TO 60
+ LAST = LAST+1
+ IP(LAST) = J
+ P(J) = NXTTYP
+ GO TO 100
+C
+C ... CASE III. IF THE ADJACENT NODE HAS ALREADY BEEN LABELED WITH
+C OPPOSITE COLOR AND THE SAME FATHER SEED, THEN THERE
+C IS AN IRRECOVERABLE COLOR CONFLICT.
+C
+ 60 IF (TYPE.EQ.CURTYP) GO TO 160
+C
+C ... CASE IV. IF THE ADJACENT NODE HAS THE RIGHT COLOR AND A DIFFERENT
+C FATHER NODE, THEN CHANGE ALL NODES OF THE YOUNGEST FATHE
+C NODE TO POINT TO THE OLDEST FATHER SEED AND RETAIN THE
+C SAME COLORS.
+C
+ IF (TYPE*NXTTYP.LT.1) GO TO 80
+ OLD = MIN0(IABS(TYPE),IABS(NXTTYP))
+ YOUNG = MAX0(IABS(TYPE),IABS(NXTTYP))
+ DO 70 J = YOUNG,N
+ IF (IABS(P(J)).EQ.YOUNG) P(J) = ISIGN(OLD,P(J))
+ 70 CONTINUE
+ CURTYP = P(K)
+ NXTTYP = -CURTYP
+ GO TO 100
+C
+C ... CASE V. IF THE ADJACENT NODE HAS THE WRONG COLOR AND A DIFFERENT
+C FATHER NODE, THEN CHANGE ALL NODES OF THE YOUNGEST FATHER
+C NODE TO POINT TO THE OLDEST FATHER NODE ALONG WITH
+C CHANGING THEIR COLORS. SINCE UNTIL THIS TIME THE
+C YOUNGEST FATHER NODE TREE HAS BEEN INDEPENDENT NO OTHER
+C COLOR CONFLICTS WILL ARISE FROM THIS CHANGE.
+C
+ 80 OLD = MIN0(IABS(TYPE),IABS(NXTTYP))
+ YOUNG = MAX0(IABS(TYPE),IABS(NXTTYP))
+ DO 90 J = YOUNG,N
+ IF (IABS(P(J)).EQ.YOUNG) P(J) = ISIGN(OLD,-P(J))
+ 90 CONTINUE
+ CURTYP = P(K)
+ NXTTYP = -CURTYP
+C
+C ... END OF CASE STATEMENT
+C
+C==================================================================
+C
+ 100 CONTINUE
+C
+C ... ADVANCE TO NEXT NODE IN THE STACK
+C
+ 110 NEXT = NEXT+1
+ IF (NEXT.LE.LAST) GO TO 50
+C
+C ... ALL NODES IN THE STACK HAVE BEEN REMOVED
+C
+C ... CHECK FOR NODES NOT LABELED. IF ANY ARE FOUND
+C ... START THE LABELING PROCESS AGAIN AT THE FIRST
+C ... NODE FOUND THAT IS NOT LABELED.
+C
+ IBGN = FIRST+1
+ DO 120 I = IBGN,N
+ IF (P(I).NE.0) GO TO 120
+ FIRST = I
+ GO TO 20
+ 120 CONTINUE
+C
+C===================================================================
+C
+C ... ALL NODES ARE NOW TYPED EITHER RED OR BLACK
+C
+C ... GENERATE PERMUTATION VECTORS
+C
+ 130 NRED = 0
+ NBLACK = 0
+ DO 150 I = 1,N
+ IF (P(I).LT.0) GO TO 140
+C
+C RED POINT
+C
+ NRED = NRED+1
+ IP(NRED) = I
+ P(I) = NRED
+ GO TO 150
+C
+C BLACK POINT
+C
+ 140 NBLACK = NBLACK+1
+ J = N-NBLACK+1
+ IP(J) = I
+ P(I) = J
+C
+ 150 CONTINUE
+C
+C ... SUCCESSFUL RED-BLACK ORDERING COMPLETED
+C
+ GO TO 180
+C
+C ........ ERROR TRAPS
+C
+C ...... N .LE. 0
+C
+C8000 IER = 200
+C GO TO 9000
+C
+C ...... TYPE CONFLICT
+C
+ 160 IER = 201
+ IF (LEVEL.GE.0) WRITE (NOUT,170)
+ 170 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE PRBNDX '/' ',
+ * ' RED-BLACK INDEXING NOT POSSIBLE')
+C
+C ... RETURN
+C
+ 180 CONTINUE
+ RETURN
+ END
+ SUBROUTINE PRSBLK (NNB,NNR,IA,JA,A,UR,VB)
+C
+C ... COMPUTE A BLACK-RS SWEEP ON A RED VECTOR INTO A BLACK VECTOR
+C
+C ... PARAMETER LIST:
+C
+C NB NUMBER OF BLACK POINTS (= NNB)
+C NR NUMBER OF RED POINTS (= NNR)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C UR ESTIMATE OF RED SOLUTION VECTOR
+C VB OUTPUT: PRESENT ESTIMATE OF BLACK SOLUTION
+C VECTOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NNB,NNR
+ DOUBLE PRECISION A(1),UR(NNR),VB(NNB)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IBGN,IEND,INR,J,JAJ,NB,NR
+ DOUBLE PRECISION SUM,URI
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ NB = NNB
+ NR = NNR
+ IF (ISYM.EQ.0) GO TO 30
+C
+C *************** NON - SYMMETRIC SECTION **********************
+C
+ DO 20 I = 1,NB
+ INR = I+NR
+ IBGN = IA(INR)
+ IEND = IA(INR+1)-1
+ SUM = VB(I)
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 J = IBGN,IEND
+ JAJ = JA(J)
+ SUM = SUM-A(J)*UR(JAJ)
+ 10 CONTINUE
+ VB(I) = SUM
+ 20 CONTINUE
+ RETURN
+C
+C ***************** SYMMETRIC SECTION **************************
+C
+ 30 DO 50 I = 1,NR
+ IBGN = IA(I)
+ IEND = IA(I+1)-1
+ IF (IBGN.GT.IEND) GO TO 50
+ URI = UR(I)
+ DO 40 J = IBGN,IEND
+ JAJ = JA(J)-NR
+ VB(JAJ) = VB(JAJ)-A(J)*URI
+ 40 CONTINUE
+ 50 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE PRSRED (NNB,NNR,IA,JA,A,UB,VR)
+C
+C ... COMPUTES A RED-RS SWEEP ON A BLACK VECTOR INTO A RED VECTOR.
+C
+C ... PARAMETER LIST:
+C
+C NB NUMBER OF BLACK POINTS (= NNR)
+C NR NUMBER OF RED POINTS (= NNB)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C UB PRESENT ESTIMATE OF BLACK SOLUTION VECTOR
+C VR OUTPUT: PRESENT ESTIMATE OF RED SOLUTION VECTOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NNB,NNR
+ DOUBLE PRECISION A(1),UB(NNB),VR(NNR)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JAJJ,JJ,NB,NR
+ DOUBLE PRECISION SUM
+C
+ NB = NNB
+ NR = NNR
+ DO 20 II = 1,NR
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 20
+ SUM = VR(II)
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)-NR
+ SUM = SUM-A(JJ)*UB(JAJJ)
+ 10 CONTINUE
+ VR(II) = SUM
+ 20 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE PSSOR1 (NN,IA,JA,A,U,RHS,FR,BR)
+C
+C ... COMPUTES COMPLETE SSOR SWEEP ON U. U IS OVERWRITTEN
+C ... WITH THE NEW ITERANT, FR AND BR WILL CONTAIN
+C ... THE FORWARD AND BACKWARD RESIDUALS ON OUTPUT.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM (= NN)
+C OMEGA RELAXATION FACTOR
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C U ESTIMATE OF SOLUTION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C FR,BR OUTPUT: FORWARD AND BACKWARD RESIDUALS RESPECTIVELY
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN
+ DOUBLE PRECISION A(1),U(NN),RHS(NN),FR(NN),BR(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IBGN,IEND,II,JAJJ,JJ,N,NPL1
+ DOUBLE PRECISION OMM1,SUM,UII
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ N = NN
+ NPL1 = N+1
+ OMM1 = OMEGA-1.D0
+ IF (ISYM.EQ.0) GO TO 40
+C
+C *************** NON - SYMMETRIC SECTION **********************
+C
+C ... FORWARD SWEEP
+C
+ DO 30 II = 1,N
+ BR(II) = U(II)
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 20
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 10 CONTINUE
+ 20 UII = OMEGA*SUM-OMM1*U(II)
+ FR(II) = UII-U(II)
+ U(II) = UII
+ 30 CONTINUE
+ GO TO 90
+C
+C ***************** SYMMETRIC SECTION **************************
+C
+C ... FORWARD SWEEP
+C
+ 40 DO 80 II = 1,N
+ BR(II) = U(II)
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ SUM = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 60
+ DO 50 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUM = SUM-A(JJ)*U(JAJJ)
+ 50 CONTINUE
+ 60 UII = OMEGA*SUM-OMM1*U(II)
+ FR(II) = UII-U(II)
+ U(II) = UII
+ IF (IBGN.GT.IEND) GO TO 80
+ DO 70 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ RHS(JAJJ) = RHS(JAJJ)-A(JJ)*UII
+ 70 CONTINUE
+ 80 CONTINUE
+C
+C ... BACKWARD SWEEP
+C
+ 90 DO 120 I = 1,N
+ II = NPL1-I
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ UII = RHS(II)
+ IF (IBGN.GT.IEND) GO TO 110
+ DO 100 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ UII = UII-A(JJ)*U(JAJJ)
+ 100 CONTINUE
+ 110 U(II) = OMEGA*UII-OMM1*U(II)
+ BR(II) = U(II)-BR(II)
+ 120 CONTINUE
+C
+ RETURN
+C
+ END
+ SUBROUTINE PSTOP (N,U,DNRM,CCON,IFLAG,Q1)
+C
+C THIS SUBROUTINE PERFORMS A TEST TO SEE IF THE ITERATIVE
+C METHOD HAS CONVERGED TO A SOLUTION INSIDE THE ERROR
+C TOLERANCE, ZETA.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF SYSTEM
+C U PRESENT SOLUTION ESTIMATE
+C DNRM INNER PRODUCT OF PSEUDO-RESIDUALS AT PRECEDING
+C ITERATION
+C CON STOPPING TEST PARAMETER (= CCON)
+C IFLAG STOPPING TEST INTEGER FLAG
+C IFLAG = 0, SOR ITERATION ZERO
+C IFLAG = 1, NON-RS METHOD
+C IFLAG = 2, RS METHOD
+C Q1 STOPPING TEST LOGICAL FLAG
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,IFLAG
+ DOUBLE PRECISION U(N),DNRM,CCON
+ LOGICAL Q1
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION CON,TL,TR,UOLD
+C
+C ... SPECIFICATIONS FOR ARGUMENT SUBROUTINES
+C
+ DOUBLE PRECISION DDOT
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ CON = CCON
+ HALT = .FALSE.
+C
+C SPECIAL PROCEDURE FOR ZEROTH ITERATION
+C
+ IF (IN.GE.1) GO TO 10
+ Q1 = .FALSE.
+ UDNM = 1.D0
+ STPTST = 1.D3
+ IF (IFLAG.LE.0) RETURN
+C
+C ... TEST IF UDNM NEEDS TO BE RECOMPUTED
+C
+ 10 CONTINUE
+ IF (Q1) GO TO 20
+ IF ((IN.GT.5).AND.(MOD(IN,5).NE.0)) GO TO 20
+ UOLD = UDNM
+ UDNM = DDOT(N,U,1,U,1)
+ IF (UDNM.EQ.0.D0) UDNM = 1.D0
+ IF ((IN.GT.5).AND.(DABS(UDNM-UOLD).LE.UDNM*ZETA)) Q1 = .TRUE.
+C
+C ... COMPUTE STOPPING TEST
+C
+ 20 TR = DSQRT(UDNM)
+ TL = 1.D0
+ IF (CON.EQ.1.D0) GO TO 40
+ IF (IFLAG.EQ.2) GO TO 30
+ TL = DSQRT(DNRM)
+ TR = TR*(1.D0-CON)
+ GO TO 40
+ 30 TL = DSQRT(2.D0*DNRM)
+ TR = TR*(1.D0-CON*CON)
+ 40 STPTST = TL/TR
+ IF (TL.GE.TR*ZETA) RETURN
+ HALT = .TRUE.
+C
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION PVTBV (N,IA,JA,A,V)
+C
+C THIS FUNCTION COMPUTES (V**T)*A*V.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C V D.P. VECTOR OF LENGTH N
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),N
+ DOUBLE PRECISION A(1),V(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,JAJJ,JJ
+ DOUBLE PRECISION SUM,SUMR
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+ PVTBV = 0.D0
+ SUM = 0.D0
+ DO 20 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 20
+ SUMR = 0.D0
+ DO 10 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ SUMR = SUMR-A(JJ)*V(JAJJ)
+ 10 CONTINUE
+ SUM = SUM+V(II)*SUMR
+ 20 CONTINUE
+C
+ IF (ISYM.EQ.0) SUM = 2.D0*SUM
+ PVTBV = SUM
+C
+ RETURN
+ END
+ SUBROUTINE QSORT (NN,KEY,DATA,ERROR)
+C
+C ==================================================================
+C
+C Q U I C K S O R T
+C
+C IN THE STYLE OF THE CACM PAPER BY BOB SEDGEWICK, OCTOBER 1978
+C
+C INPUT:
+C N -- NUMBER OF ELEMENTS TO BE SORTED (= NN)
+C KEY -- AN ARRAY OF LENGTH N CONTAINING THE VALUES
+C WHICH ARE TO BE SORTED
+C DATA -- A SECOND ARRAY OF LENGTH N CONTAINING DATA
+C ASSOCIATED WITH THE INDIVIDUAL KEYS.
+C
+C OUTPUT:
+C KEY -- WILL BE ARRANGED SO THAT VALUES ARE IN INCREASING
+C ORDER
+C DATA -- REARRANGED TO CORRESPOND TO REARRANGED KEYS
+C ERROR -- WILL BE ZERO UNLESS YOUR INPUT FILE WAS OF TRULY
+C ENORMOUS LENGTH, IN WHICH CASE IT WILL BE EQUAL TO 1.
+C
+C ==================================================================
+C
+ INTEGER NN,ERROR,KEY(NN)
+ DOUBLE PRECISION DATA(NN)
+C
+C ------------------------
+C
+ INTEGER TOP,LEFT,RIGHT,I,J,TINY,V,K,IP1,JM1,LLEN,RLEN,N
+ LOGICAL DONE
+ DOUBLE PRECISION D
+ INTEGER STKLEN,STACK(30)
+C
+ DATA TINY,STKLEN / 9,30 /
+C
+C -----------------------------------
+C
+C ... PROGRAM IS A DIRECT TRANSLATION INTO FORTRAN OF SEDGEWICK^S
+C PROGRAM 2, WHICH IS NON-RECURSIVE, IGNORES FILES OF LENGTH
+C LESS THAN 'TINY' DURING PARTITIONING, AND USES MEDIAN OF THREE
+C PARTITIONING.
+C
+ N = NN
+ IF (N.EQ.1) RETURN
+ IF (N.LE.0) GO TO 240
+C
+ ERROR = 0
+ TOP = 1
+ LEFT = 1
+ RIGHT = N
+ DONE = (N.LE.TINY)
+C
+ IF (DONE) GO TO 150
+ CALL IVFILL (STKLEN,STACK,0)
+C
+C ===========================================================
+C QUICKSORT -- PARTITION THE FILE UNTIL NO SUBFILE REMAINS OF
+C LENGTH GREATER THAN 'TINY'
+C ===========================================================
+C
+C ... WHILE NOT DONE DO ...
+C
+ 10 IF (DONE) GO TO 150
+C
+C ... FIND MEDIAN OF LEFT, RIGHT AND MIDDLE ELEMENTS OF CURRENT
+C SUBFILE, WHICH IS KEY(LEFT), ..., KEY(RIGHT)
+C
+ LFRH2 = (LEFT+RIGHT)/2
+ K = KEY(LFRH2)
+ D = DATA(LFRH2)
+ KEY(LFRH2) = KEY(LEFT)
+ DATA(LFRH2) = DATA(LEFT)
+ KEY(LEFT) = K
+ DATA(LEFT) = D
+C
+ IF (KEY(LEFT+1).LE.KEY(RIGHT)) GO TO 20
+ K = KEY(LEFT+1)
+ D = DATA(LEFT+1)
+ KEY(LEFT+1) = KEY(RIGHT)
+ DATA(LEFT+1) = DATA(RIGHT)
+ KEY(RIGHT) = K
+ DATA(RIGHT) = D
+C
+ 20 IF (KEY(LEFT).LE.KEY(RIGHT)) GO TO 30
+ K = KEY(LEFT)
+ D = DATA(LEFT)
+ KEY(LEFT) = KEY(RIGHT)
+ DATA(LEFT) = DATA(RIGHT)
+ KEY(RIGHT) = K
+ DATA(RIGHT) = D
+C
+ 30 IF (KEY(LEFT+1).LE.KEY(LEFT)) GO TO 40
+ K = KEY(LEFT+1)
+ D = DATA(LEFT+1)
+ KEY(LEFT+1) = KEY(LEFT)
+ DATA(LEFT+1) = DATA(LEFT)
+ KEY(LEFT) = K
+ DATA(LEFT) = D
+C
+ 40 V = KEY(LEFT)
+C
+C ... V IS NOW THE MEDIAN VALUE OF THE THREE KEYS. NOW MOVE
+C FROM THE LEFT AND RIGHT ENDS SIMULTANEOUSLY, EXCHANGING
+C KEYS AND DATA UNTIL ALL KEYS LESS THAN V ARE PACKED TO
+C THE LEFT, ALL KEYS LARGER THAN V ARE PACKED TO THE
+C RIGHT.
+C
+ I = LEFT+1
+ J = RIGHT
+C
+C LOOP
+C REPEAT I = I+1 UNTIL KEY(I) >= V;
+C REPEAT J = J-1 UNTIL KEY(J) <= V;
+C EXIT IF J < I;
+C << EXCHANGE KEYS I AND J >>
+C END
+C
+ 50 CONTINUE
+ 60 I = I+1
+ IF (KEY(I).LT.V) GO TO 60
+C
+ 70 J = J-1
+ IF (KEY(J).GT.V) GO TO 70
+C
+ IF (J.LT.I) GO TO 80
+ K = KEY(I)
+ D = DATA(I)
+ KEY(I) = KEY(J)
+ DATA(I) = DATA(J)
+ KEY(J) = K
+ DATA(J) = D
+ GO TO 50
+C
+ 80 K = KEY(LEFT)
+ D = DATA(LEFT)
+ KEY(LEFT) = KEY(J)
+ DATA(LEFT) = DATA(J)
+ KEY(J) = K
+ DATA(J) = D
+C
+C ... WE HAVE NOW PARTITIONED THE FILE INTO TWO SUBFILES,
+C ONE IS (LEFT ... J-1) AND THE OTHER IS (I...RIGHT).
+C PROCESS THE SMALLER NEXT. STACK THE LARGER ONE.
+C
+ LLEN = J-LEFT
+ RLEN = RIGHT-I+1
+ IF (MAX0(LLEN,RLEN).GT.TINY) GO TO 100
+C
+C ... BOTH SUBFILES ARE TINY, SO UNSTACK NEXT LARGER FILE
+C
+ IF (TOP.EQ.1) GO TO 90
+ TOP = TOP-2
+ LEFT = STACK(TOP)
+ RIGHT = STACK(TOP+1)
+ GO TO 10
+C
+ 90 DONE = .TRUE.
+C
+ GO TO 10
+C
+C ... ELSE ONE OR BOTH SUBFILES ARE LARGE
+C
+ 100 IF (MIN0(LLEN,RLEN).GT.TINY) GO TO 120
+C
+C ... ONE SUBFILE IS SMALL, ONE LARGE. IGNORE THE SMALL ONE
+C
+ IF (LLEN.GT.RLEN) GO TO 110
+ LEFT = I
+ GO TO 10
+C
+ 110 RIGHT = J-1
+C
+ GO TO 10
+C
+C ... ELSE BOTH ARE LARGER THAN TINY. ONE MUST BE STACKED.
+C
+ 120 IF (TOP.GE.STKLEN) GO TO 240
+ IF (LLEN.GT.RLEN) GO TO 130
+ STACK(TOP) = I
+ STACK(TOP+1) = RIGHT
+ RIGHT = J-1
+ GO TO 140
+C
+ 130 STACK(TOP) = LEFT
+ STACK(TOP+1) = J-1
+ LEFT = I
+C
+ 140 TOP = TOP+2
+C
+ GO TO 10
+C
+C ------------------------------------------------------------
+C INSERTION SORT THE ENTIRE FILE, WHICH CONSISTS OF A LIST
+C OF 'TINY' SUBFILES, LOCALLY OUT OF ORDER, GLOBALLY IN ORDER.
+C ------------------------------------------------------------
+C
+C ... FIRST, FIND LARGEST ELEMENT IN 'KEY'
+C
+ 150 I = N-1
+ LEFT = MAX0(0,N-TINY)
+ K = KEY(N)
+ J = N
+C
+ 160 IF (I.LE.LEFT) GO TO 180
+ IF (KEY(I).LE.K) GO TO 170
+ K = KEY(I)
+ J = I
+C
+ 170 I = I-1
+ GO TO 160
+C
+ 180 IF (J.EQ.N) GO TO 190
+C
+C ... LARGEST ELEMENT WILL BE IN KEY(N)
+C
+ KEY(J) = KEY(N)
+ KEY(N) = K
+ D = DATA(N)
+ DATA(N) = DATA(J)
+ DATA(J) = D
+C
+C ... INSERTION SORT ... FOR I := N-1 STEP -1 TO 1 DO ...
+C
+ 190 I = N-1
+ IP1 = N
+C
+ 200 IF (KEY(I).LE.KEY(IP1)) GO TO 220
+C
+C ... OUT OF ORDER ... MOVE UP TO CORRECT PLACE
+C
+ K = KEY(I)
+ D = DATA(I)
+ J = IP1
+ JM1 = I
+C
+C ... REPEAT ... UNTIL 'CORRECT PLACE FOR K FOUND'
+C
+ 210 KEY(JM1) = KEY(J)
+ DATA(JM1) = DATA(J)
+ JM1 = J
+ J = J+1
+ IF (KEY(J).LT.K) GO TO 210
+C
+ KEY(JM1) = K
+ DATA(JM1) = D
+C
+ 220 IP1 = I
+ I = I-1
+ IF (I.GT.0) GO TO 200
+C
+ 230 RETURN
+C
+ 240 ERROR = 1
+ GO TO 230
+C
+ END
+ SUBROUTINE SBAGN (N,NZ,IA,JA,A,IWORK,LEVELL,NOUTT,IERR)
+C
+C ... THE ROUTINES SBINI, SBSIJ, AND SBEND CREATE A SPARSE
+C MATRIX STRUCTURE BY MEANS OF A LINKED LIST WHICH IS
+C DESTROYED BY SBEND. SBAGN CREATES A NEW LINKED LIST
+C SO THAT ELEMENTS MAY BE ADDED TO THE MATRIX AFTER SBEND
+C HAS BEEN CALLED. SBAGN SHOULD BE CALLED WITH THE APPRO-
+C PRIATE PARAMETERS, AND THEN SBSIJ AND SBEND CAN BE CALLED
+C TO ADD THE ELEMENTS AND COMPLETE THE SPARSE MATRIX STRUC-
+C TURE.
+C
+C ... PARAMETER LIST:
+C
+C N ORDER OF THE SYSTEM
+C NZ MAXIMUM NUMBER OF NON-ZERO ELEMENTS
+C IN THE SYSTEM
+C IA, JA INTEGER ARRAYS OF THE SPARSE
+C MATRIX STRUCTURE
+C A D.P. ARRAY OF THE SPARSE MATRIX
+C STRUCTURE
+C IWORK WORK ARRAY OF DIMENSION NZ
+C LEVEL OUTPUT LEVEL CONTROL (= LEVELL)
+C NOUT OUTPUT FILE NUMBER (= NOUTT)
+C IER ERROR FLAG (= IERR). POSSIBLE RETURNS ARE
+C IER = 0, SUCCESSFUL COMPLETION
+C = 703, NZ TOO SMALL - NO MORE
+C ELEMENTS CAN BE ADDED
+C
+C ... SPECIFICTIONS FOR ARGUMENTS
+C
+ INTEGER NZ,IA(1),JA(1),IWORK(NZ),N,LEVELL,NOUTT,IERR
+ DOUBLE PRECISION A(NZ)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IER,J,LEVEL,NOUT,NADD,NADDP1,NOW,NP1,NTO,NTN
+C
+C ... INITIALIZE LOCAL VARIABLES AND MAKE ERROR CHECK
+C
+ NOW = IA(N+1)-1
+ NADD = NZ-NOW
+ IER = 0
+ LEVEL = LEVELL
+ NOUT = NOUTT
+ IF (NADD.LE.0) IER = 703
+ IF (IER.EQ.0) GO TO 20
+ IF (LEVEL.GE.0) WRITE (NOUT,10) IER
+ 10 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SBAGN '/' ',' IER = ',I10/' ',
+ * ' NZ TOO SMALL - NO ROOM FOR NEW ENTRY')
+ GO TO 90
+C
+C ... SHIFT ELEMENTS OF A AND JA DOWN AND ADD ZERO FILL
+C
+ 20 NTO = NOW
+ NTN = NZ
+ DO 30 I = 1,NOW
+ JA(NTN) = JA(NTO)
+ A(NTN) = A(NTO)
+ NTO = NTO-1
+ NTN = NTN-1
+ 30 CONTINUE
+ DO 40 I = 1,NADD
+ JA(I) = 0
+ A(I) = 0.D0
+ 40 CONTINUE
+C
+C ... UPDATE IA TO REFLECT DOWNWARD SHIFT IN A AND JA
+C
+ NP1 = N+1
+ DO 50 I = 1,NP1
+ IA(I) = IA(I)+NADD
+ 50 CONTINUE
+C
+C ... CREATE LINKED LIST
+C
+ NADDP1 = NADD+1
+ DO 60 I = NADDP1,NZ
+ IWORK(I) = I+1
+ 60 CONTINUE
+ DO 70 I = 1,NADD
+ IWORK(I) = 0
+ 70 CONTINUE
+ DO 80 I = 1,N
+ J = IA(I+1)-1
+ IWORK(J) = -I
+ 80 CONTINUE
+C
+C ... INDICATE IN LAST POSITION OF IA HOW MANY SPACES
+C ARE LEFT IN A AND JA FOR ADDITION OF ELEMENTS
+C
+ IA(N+1) = NADD
+ RETURN
+C
+C ... ERROR RETURN
+C
+ 90 IERR = IER
+ RETURN
+ END
+ SUBROUTINE SBELM (NN,IA,JA,A,RHS,IW,RW,TOL,ISYM,LEVEL,NOUT,IER)
+C
+C ... SBELM IS DESIGNED TO REMOVE ROWS AND COLUMNS OF THE MATRIX
+C ... WHERE DABS(A(I,J))/A(I,I) .LE. TOL FOR J = 1 TO N AND A(I,I)
+C ... .GT. 0. THIS IS TO TAKE CARE OF MATRICES ARISING
+C ... FROM FINITE ELEMENT DISCRETIZATIONS OF PDE^S WITH DIRICHLET
+C ... BOUNDARY CONDITIONS. ANY SUCH ROWS AND CORRESPONDING COLUMNS
+C ... ARE THEN SET TO THE IDENTITY AFTER CORRECTING RHS.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C IW,RW WORK ARRAYS OF LENGTH N
+C TOL TOLERANCE FACTOR
+C ISYM FLAG FOR TYPE OF STORAGE FOR SYSTEM
+C (0: SYMMETRIC, 1:NONSYMMETRIC)
+C LEVEL PRINTING SWITCH FOR ERROR CONDITION
+C NOUT OUTPUT TAPE NUMBER
+C IER ERROR FLAG: NONZERO VALUE ON RETURN MEANS
+C 101 : DIAGONAL ENTRY NOT POSITIVE
+C 102 : THERE IS NO DIAGONAL ENTRY IN ROW
+C
+C**********************************************************************
+C
+C UPDATE. SBELM HAS BEEN REWRITTEN TO SPEED UP THE LOCATION OF
+C OF ROWS WHICH ARE TO BE ELIMINATED. THIS IS DONE BY
+C FIRST STORING THE LARGEST ELEMENT OF EACH ROW IN
+C THE ARRAY RW. THE DIAGONAL ENTRY IS THEN COMPARED
+C WITH THE CORRESPONDING ELEMENT IN RW. IF IT IS
+C DECIDED TO ELIMINATE THE ROW THEN IT IS MARKED FOR
+C ELIMINATION.
+C
+C WHEN A ROW IS TO BE ELIMINATED ITS DIAGONAL ENTRY
+C IS STORED IN RW AND IW IS MARKED BY A NONZERO
+C (WHICH IS THIS ROW NUMBER)
+C
+C ROWS WHICH HAVE ONLY DIAGONAL ENTRIES ARE NOT
+C ALTERED.
+C
+C*********************************************************************
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER NN,IA(1),JA(1),IW(NN),ISYM,LEVEL,NOUT,IER
+ DOUBLE PRECISION A(1),RHS(NN),RW(NN),TOL
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,ICNT,IEND,JJ,JJDI,KK,N
+ DOUBLE PRECISION DI
+C
+ N = NN
+C
+C IF (N .GE. 1) GO TO 10
+C IER = 100
+C RETURN
+C 10 CONTINUE
+C
+C ... STORE THE LARGEST (DABSOLUTE VALUE) OFF DIAGONAL ENTRY FOR
+C ... ROW II IN RW(II).
+C
+ IER = 0
+ ICNT = 0
+ DO 10 II = 1,N
+ RW(II) = 0.0D0
+ IW(II) = 0
+ 10 CONTINUE
+ DO 20 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 140
+ DO 20 JJ = IBGN,IEND
+ KK = JA(JJ)
+ IF (KK.EQ.II) GO TO 20
+ RW(II) = DMAX1(RW(II),DABS(A(JJ)))
+ IF (ISYM.NE.0) GO TO 20
+ RW(KK) = DMAX1(RW(KK),DABS(A(JJ)))
+ 20 CONTINUE
+C
+C ... FOR II = 1 TO N FIND THE DIAGONAL ENTRY IN ROW II
+C
+ DO 80 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ DO 40 JJ = IBGN,IEND
+ IF (JA(JJ).NE.II) GO TO 40
+ DI = A(JJ)
+ JJDI = JJ
+ IF (DI.GT.0.D0) GO TO 50
+ IER = 101
+ IF (LEVEL.GE.0) WRITE (NOUT,30) II,DI
+ 30 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SBELM '/' ',
+ * ' DIAGONAL ELEMENT',I10,' NOT POSITIVE '/' ',
+ * ' CURRENT VALUE = ',D15.8)
+ RETURN
+ 40 CONTINUE
+ GO TO 140
+ 50 CONTINUE
+C
+C ... CHECK THE SIZE OF THE LARGEST OFF DIAGONAL ELEMENT
+C ... ( STORED IN RW(II) ) AGAINST THE DIAGONAL ELEMENT DII.
+C
+ IF (RW(II).NE.0.0D0) GO TO 60
+ IF (1.0D0/DI.LE.TOL) GO TO 70
+ GO TO 80
+ 60 IF (RW(II)/DI.GT.TOL) GO TO 80
+C
+C ... THE OFF DIAGONAL ELEMENTS ARE SMALL COMPARED TO THE DIAGONAL
+C ... THEREFORE MARK IT FOR ELIMINATION AND PERFORM INITIAL
+C ... PROCESSING
+C
+ 70 ICNT = ICNT+1
+ IW(II) = II
+ RW(II) = DI
+ A(JJDI) = 1.0D0
+ RHS(II) = RHS(II)/DI
+C
+ 80 CONTINUE
+C
+C ... ELIMINATE THE ROWS AND COLUMNS INDICATED BY THE NONZERO
+C ... ENTRIES IN IW. THERE ARE ICNT OF THEM
+C
+ IF (ICNT.EQ.0) GO TO 130
+C
+C ... THE ELIMINATION IS AS FOLLOWS:
+C
+C FOR II = 1 TO N DO
+C IF ( IW(II) .NE. 0 ) THEN
+C SET DIAGONAL VALUE TO 1.0 ( ALREADY DONE )
+C SET RHS(II) = RHS(II) / RW(II) ( ALREADY DONE )
+C FIND NONZERO OFFDIAGONAL ENTRIES KK
+C IF ( IW(KK) .EQ. 0 ) FIX UP RHS(KK) WHEN USING SYMMETRIC ST
+C SET A(II,KK) = 0.0
+C ELSE ( I.E. IW(II) .EQ. 0 )
+C FIND NONZERO OFFDIAGONAL ENTRIES KK
+C IF ( IW(KK) .NE. 0 ) FIX UP RHS(II)
+C AND SET A(II,KK) = 0.0
+C END IF
+C END DO
+C
+ DO 120 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IW(II).EQ.0) GO TO 100
+C
+C ... THE II-TH ROW IS TO BE ELIMINATED
+C
+ DO 90 JJ = IBGN,IEND
+ KK = JA(JJ)
+ IF (KK.EQ.II) GO TO 90
+ IF ((IW(KK).EQ.0).AND.(ISYM.EQ.0)) RHS(KK) = RHS(KK)-A(JJ)*
+ * RHS(II)
+ A(JJ) = 0.0D0
+ 90 CONTINUE
+ GO TO 120
+C
+C ... THE II-TH ROW IS KEPT. CHECK THE OFF-DIAGONAL ENTRIES
+C
+ 100 DO 110 JJ = IBGN,IEND
+ KK = JA(JJ)
+ IF (KK.EQ.II.OR.IW(KK).EQ.0) GO TO 110
+ RHS(II) = RHS(II)-A(JJ)*RHS(KK)
+ A(JJ) = 0.0D0
+ 110 CONTINUE
+C
+ 120 CONTINUE
+C
+ 130 RETURN
+C
+C ... ERROR TRAPS -- NO DIAGONAL ENTRY IN ROW II (ROW MAY BE EMPTY).
+C
+ 140 CONTINUE
+ IER = 102
+ IF (LEVEL.GE.0) WRITE (NOUT,150) II
+ 150 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SBELM '/' ',
+ * ' NO DIAGONAL ENTRY IN ROW ',I10)
+C
+ RETURN
+ END
+ SUBROUTINE SBEND (N,NZ,IA,JA,A,IWORK)
+C
+C***********************************************************************
+C
+C SBEND IS THE THIRD OF A SUITE OF SUBROUTINES TO AID THE
+C USER TO CONSTRUCT THE IA, JA, A DATA STRUCTURE USED IN
+C ITPACK.
+C
+C SBEND RESTRUCTURES THE LINKED LIST DATA STRUCTURE BUILT BY
+C SBINI AND SBSIJ INTO THE FINAL DATA STRUCTURE REQUIRE BY
+C ITPACK. THE RESTRUCTURING CAN TAKE PLACE IN THE MINIMUM
+C AMOUNT OF MEMORY REQUIRED TO HOLD THE NONZERO STRUCTURE OF
+C THE SPARSE MATRIX BUT WILL RUN QUICKER IF MORE STORAGE
+C IS ALLOWED.
+C
+C SBEND IS BASED ON SUBROUTINE BUILD OF THE SPARSE MATRIX
+C PACKAGE SPARSPAK DEVELOPED BY ALAN GEORGE AND JOSEPH LUI
+C OF THE UNIVERSITY OF WATERLOO, WATERLOO, ONTARIO.
+C
+C ... PARAMETERS
+C
+C ...... INPUT
+C
+C N THE ORDER OF THE LINEAR SYSTEM
+C
+C NZ THE LENGTH OF THE ARRAYS JA, IWORK, AND A.
+C
+C ...... INPUT/OUTPUT
+C
+C IA INTEGER ARRAY OF LENGTH N+1. THE FIRST N ENTRIES
+C POINT TO THE BEGINNING OF THE LINKED LIST FOR EACH
+C ROW. IA(N+1)-1 IS THE TOP OF THE LINKED LISTS
+C CONTAINED IN JA, IWORK, AND A. ON OUTPUT IA WILL
+C POINT TO THE FIRST ENTRY OF EACH ROW IN THE FINAL
+C DATA STRUCTURE.
+C
+C JA INTEGER ARRAY OF LENGTH NZ. ON INPUT JA STORES THE
+C COLUMN NUMBERS OF THE NONZERO ENTRIES AS INDICATED
+C BY THE LINKED LISTS. ON OUTPUT JA STORES THE
+C COLUMN NUMBERS IN ROW ORDERED FORM.
+C
+C A D.P. ARRAY OF LENGTH NZ. ON INPUT A STORES THE
+C VALUE OF THE NOZERO ENTRIES AS INDICATED BY THE
+C LINKED LISTS. ON OUTPUT A STORES THE VALUES IN
+C ROW ORDERED FORM.
+C
+C IWORK INTEGER ARRAY OF LENGTH NZ. ON INPUT IWORK STORES THE
+C THE LINKS OF THE LINKED LISTS. ON OUTPUT IT IS
+C DESTROYED.
+C
+C***********************************************************************
+C
+ INTEGER N,NZ,IA(1),JA(NZ),IWORK(NZ)
+ DOUBLE PRECISION A(NZ)
+C
+ INTEGER MAXTOP,NEXT,TOP,IDEG,NULINK,JAJ,HLINK,OHLINK,L,I,LINK,
+ * MHLINK
+ DOUBLE PRECISION VAL
+C
+C***********************************************************************
+C
+C ... INITIALIZATION
+C
+C ...... THE VARIABLES NEXT AND TOP RESPECTIVELY POINT TO THE
+C NEXT AVAILABLE ENTRY FOR THE FINAL DATA STRUCTURE AND
+C THE TOP OF THE REMAINDER OF THE LINKED LISTS.
+C
+ NEXT = 1
+ TOP = IA(N+1)+1
+ MAXTOP = NZ-IA(N+1)+1
+C
+C***********************************************************************
+C
+C ... CONVERT EACH ROW INTO FINAL FORM
+C
+ DO 90 I = 1,N
+ IDEG = 0
+ NULINK = IA(I)
+C
+C ... LOOP OVER EACH NODE IN THE LINKED LIST OF ROW I
+C
+ 10 LINK = NULINK
+ IF (LINK.LE.0) GO TO 80
+ NULINK = IWORK(LINK)
+ JAJ = JA(LINK)
+ VAL = A(LINK)
+C
+C ... CHECK TO SEE IF A COLLISION BETWEEN THE LINKED LISTS
+C AND THE FINAL FORM HAS OCCURRED.
+C
+ IF (NEXT.GE.TOP.AND.LINK.NE.TOP) GO TO 20
+C
+C ... COLLISION HAS NOT OCCURRED. FREE THE SPACE FOR THE TRIPLE
+C (JA(LINK), A(LINK), IWORK(LINK))
+C
+ JA(LINK) = 0
+ A(LINK) = 0.0D0
+ IWORK(LINK) = 0
+C
+C ... SPECIAL CASE TO MOVE TOP DOWN IF LINK .EQ. TOP
+C
+ IF (LINK.EQ.TOP) GO TO 60
+ GO TO 70
+C
+C***********************************************************************
+C
+C ... COLLISION HAS OCCURRED. CLEAR OFF SOME SPACE FOR THE CURRENT
+C ENTRY BY MOVING THE TRIPLE ( JA(TOP),A(TOP),IWORK(TOP) )
+C DOWNWARDS TO THE FREED TRIPLE ( JA(LINK),A(LINK),IWORK(LINK) ).
+C THEN ADJUST THE LINK FIELDS.
+C
+C ...... PATCH UP THE LINKED LIST FOR THE CURRENT ROW I. THEN
+C TRAVERSE THE LINKED LIST CONTAINING TOP UNTIL THE POINTER
+C POINTER BACK TO IA IS FOUND.
+C
+ 20 IA(I) = LINK
+ HLINK = TOP
+C
+ 30 HLINK = IWORK(HLINK)
+ IF (HLINK.GT.0) GO TO 30
+C
+C ...... NOW FOLLOW THE LINKED LIST BACK TO TOP KEEPING TRACK
+C OF THE OLD LINK.
+C
+C ......... SPECIAL CASE IF IA(-HLINK) = TOP
+C
+ MHLINK = -HLINK
+ IF (IA(MHLINK).NE.TOP) GO TO 40
+C
+ IWORK(LINK) = IWORK(TOP)
+ JA(LINK) = JA(TOP)
+ A(LINK) = A(TOP)
+ IA(MHLINK) = LINK
+ IF (NULINK.EQ.TOP) NULINK = LINK
+ GO TO 60
+C
+C ......... USUAL CASE.
+C
+ 40 HLINK = IA(MHLINK)
+ 50 OHLINK = HLINK
+ HLINK = IWORK(OHLINK)
+ IF (HLINK.NE.TOP) GO TO 50
+C
+ IWORK(LINK) = IWORK(TOP)
+ JA(LINK) = JA(TOP)
+ A(LINK) = A(TOP)
+ IF (OHLINK.NE.LINK) IWORK(OHLINK) = LINK
+ IF (NULINK.EQ.TOP) NULINK = LINK
+C
+C ... COLLAPSE TOP OF LINK LIST BY AS MUCH AS POSSIBLE
+C
+ 60 TOP = TOP+1
+ IF (TOP.GE.MAXTOP) GO TO 70
+ IF (IWORK(TOP).NE.0) GO TO 70
+ GO TO 60
+C
+C***********************************************************************
+C
+C ... PUT THE CURRENT TRIPLE INTO THE FINAL DATA STRUCTURE
+C
+ 70 JA(NEXT) = JAJ
+ A(NEXT) = VAL
+ NEXT = NEXT+1
+ IDEG = IDEG+1
+ GO TO 10
+C
+C ... FINAL STRUCTURE FOR ROW I IS COMPLETE. LINKED LIST IS
+C DESTROYED AND WILL BE RECAPTURED AS NECESSARY BY THE
+C LOOP ON LABEL 60
+C
+ 80 IA(I) = IDEG
+C
+ 90 CONTINUE
+C
+C***********************************************************************
+C
+C ... FINALIZE THE DATA STRUCTURE BY BUILDING THE FINAL VERSION OF
+C IA.
+C
+ L = IA(1)+1
+ IA(1) = 1
+ DO 100 I = 1,N
+ IDEG = IA(I+1)
+ IA(I+1) = L
+ L = L+IDEG
+ 100 CONTINUE
+C
+C ... FINAL IA, JA, A DATA STRUCTURE BUILT.
+C
+ RETURN
+ END
+ SUBROUTINE SBINI (N,NZ,IA,JA,A,IWORK)
+C
+C***********************************************************************
+C
+C SBINI IS THE FIRST OF A SUITE OF THREE SUBROUTINES TO AID
+C THE USER TO CONSTRUCT THE IA, JA, A DATA STRUCTURE USED
+C IN ITPACK.
+C
+C SBINI INITIALIZES THE ARRAYS IA, JA, IWORK, AND A. THE OTHER
+C SUBROUTINES IN THE SUITE ARE SBSIJ ( WHICH BUILDS A LINKED
+C LIST REPRESENTATION OF THE MATRIX STRUCTURE ) AND SBEND ( WHICH
+C RESTRUCTURE THE LINKED LIST FORM INTO THE FINAL FORM ).
+C
+C ... PARAMETERS
+C
+C ...... INPUT
+C
+C N THE ORDER OF THE LINEAR SYSTEM
+C
+C NZ THE MAXIMUM NUMBER OF NONZEROES ALLOWED IN THE
+C LINEAR SYSTEM.
+C
+C ...... OUTPUT
+C
+C IA INTEGER ARRAY OF LENGTH N+1. SBINI SETS THIS ARRAY
+C TO -I FOR I = 1 THRU N. IA(N+1) IS SET TO NZ.
+C
+C JA INTEGER ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE.
+C
+C A D.P. ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE.
+C
+C IWORK INTEGER ARRAY OF LENGTH NZ. INITIALIZED TO ZERO HERE.
+C
+C***********************************************************************
+C
+ INTEGER N,NZ,IA(1),JA(NZ),IWORK(NZ),I
+ DOUBLE PRECISION A(NZ)
+C
+C***********************************************************************
+C
+ DO 10 I = 1,N
+ IA(I) = -I
+ 10 CONTINUE
+ IA(N+1) = NZ
+C
+ CALL IVFILL (NZ,JA,0)
+ CALL IVFILL (NZ,IWORK,0)
+ CALL VFILL (NZ,A,0.D0)
+C
+ RETURN
+ END
+ SUBROUTINE SBSIJ (N,NZ,IA,JA,A,IWORK,II,JJ,VALL,MODE,LEVELL,NOUTT,
+ * IERR)
+C
+C***********************************************************************
+C
+C SBSIJ IS THE SECOND OF A SUITE OF THREE SUBROUTINES TO AID IN
+C THE CONSTRUCTION OF THE IA, JA, A DATA STRUCTURE USED IN
+C ITPACK.
+C
+C SBSIJ TAKES THE INDIVIDUAL ENTRIES OF THE SPARSE MATRIX AS
+C GIVEN TO IT AT EACH CALL VIA (I,J,VAL) AND INSERTS IT INTO
+C A LINKED LIST REPRESENTATION OF THE SPARSE MATRIX.
+C
+C EACH ROW OF THE SPARSE MATRIX IS ASSOCIATED WITH A CIRCULAR
+C LINKED LIST BEGINNING AT IA(I). THE LAST ENTERED ELEMENT IN
+C EACH LIST POINTS BACK TO IA(I) WITH THE VALUE -I. THE LINKS
+C ARE STORED IN THE ARRAY IWORK, WHILE JA AND A STORE THE COLUMN
+C NUMBER AND VALUE IN PARALLEL TO IWORK. THE LINKED LISTED ARE
+C STORED BEGINNING AT ENTRY NZ AND WORKING BACKWARDS TOWARDS 1.
+C
+C ... PARAMETERS
+C
+C ...... INPUT
+C
+C N THE ORDER OF THE LINEAR SYSTEM
+C
+C NZ THE LENGTH OF THE ARRAYS JA, A, AND IWORK
+C
+C I, J THE ROW AND COLUMN NUMBERS OF THE ENTRY OF THE SPARSE
+C LINEAR SYSTEM TO BE ENTERED IN THE DATA STRUCTURE(=II,JJ)
+C
+C VAL THE NONZERO VALUE ASSOCIATED WITH (I,J) (= VALL)
+C
+C MODE IF THE (I,J) ENTRY HAS ALREADY BEEN SET, MODE SPECIFIES
+C THE WAY IN WHICH THE ENTRY IS TO BE TREATED.
+C IF MODE .LT. 0 LET THE VALUE REMAIN AS IS
+C .EQ. 0 RESET IT TO THE NEW VALUE
+C .GT. 0 ADD THE NEW VALUE TO THE OLD VALUE
+C
+C NOUT OUTPUT FILE NUMBER (= NOUTT)
+C
+C LEVEL OUTPUT FILE SWITCH (= LEVELL)
+C ... INPUT/OUTPUT
+C
+C IA INTEGER ARRAY OF LENGTH N+1. THE FIRST N ENTRIES
+C POINT TO THE BEGINNING OF THE LINKED LIST FOR EACH
+C ROW. IA(N+1) POINTS TO THE NEXT ENTRY AVAILABLE FOR
+C STORING THE CURRENT ENTRY INTO THE LINKED LIST.
+C
+C JA INTEGER ARRAY OF LENGTH NZ. JA STORES THE COLUMN
+C NUMBERS OF THE NONZERO ENTRIES.
+C
+C A D.P. ARRAY OF LENGTH NZ. A STORES THE VALUE OF THE
+C NONZERO ENTRIES.
+C
+C IWORK INTEGER ARRAY OF LENGTH NZ. IWORK STORES THE LINKS.
+C
+C IER ERROR FLAG.(= IERR) POSSIBLE RETURNS ARE
+C IER = 0 SUCCESSFUL COMPLETION
+C = 700 ENTRY WAS ALREADY SET, VALUE HANDLED
+C AS SPECIFIED BY MODE.
+C = 701 IMPROPER VALUE OF EITHER I OR J INDEX
+C = 702 NO ROOM REMAINING, NZ TOO SMALL.
+C
+C***********************************************************************
+C
+ INTEGER N,NZ,IA(1),JA(NZ),IWORK(NZ),II,JJ,MODE,LEVELL,NOUTT,IERR
+ DOUBLE PRECISION A(NZ),VALL
+C
+ INTEGER LINK,NEXT,NPL1,I,J,LEVEL,NOUT,IER
+ DOUBLE PRECISION VAL,TEMP
+C
+C***********************************************************************
+C
+C ... CHECK THE VALIDITY OF THE (I,J) ENTRY
+C
+ I = II
+ J = JJ
+ VAL = VALL
+ LEVEL = LEVELL
+ NOUT = NOUTT
+ IER = 0
+ IF (I.LE.0.OR.I.GT.N) IER = 701
+ IF (J.LE.0.OR.J.GT.N) IER = 701
+ IF (IER.EQ.0) GO TO 20
+ IF (LEVEL.GE.0) WRITE (NOUT,10) IER,I,J
+ 10 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SBSIJ '/' ',' IER = ',I10/' ',
+ * ' ( ',I10,' , ',I10,' )'/' ',
+ * ' IMPROPER VALUE FOR I OR J ')
+ GO TO 130
+C
+C ... TRAVERSE THE LINK LIST POINTED TO BY IA(I) UNTIL EITHER
+C ... THE J ENTRY OR THE END OF THE LIST HAS BEEN FOUND.
+C
+ 20 NPL1 = N+1
+ LINK = IA(I)
+C
+C ...... SPECIAL CASE FOR THE FIRST ENTRY IN THE ROW
+C
+ IF (LINK.GT.0) GO TO 30
+ NEXT = IA(NPL1)
+ IF (NEXT.LT.1) GO TO 110
+C
+ IA(I) = NEXT
+ JA(NEXT) = J
+ A(NEXT) = VAL
+ IWORK(NEXT) = -I
+ IA(NPL1) = NEXT-1
+ GO TO 130
+C
+C ... FOLLOW THE LINK LIST UNTIL J OR THE END OF THE LIST IS FOUND
+C
+ 30 IF (JA(LINK).EQ.J) GO TO 40
+ IF (IWORK(LINK).LE.0) GO TO 100
+ LINK = IWORK(LINK)
+ GO TO 30
+C
+C:
+C ... ENTRY (I,J) ALREADY HAS BEEN SET. RESET VALUE DEPENDING ON MODE
+C
+ 40 IER = 700
+ IF (MODE.GE.0) GO TO 60
+ IF (LEVEL.GE.1) WRITE (NOUT,50) IER,I,J,A(LINK)
+ 50 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SBSIJ '/' ',' IER = ',I10/' ',
+ * ' ( ',I10,' , ',I10,' )'/' ',
+ * ' ENTRY ALREADY SET AND IS LEFT AS ',D15.8)
+ GO TO 130
+ 60 IF (MODE.GE.1) GO TO 80
+ IF (LEVEL.GE.1) WRITE (NOUT,70) IER,I,J,A(LINK),VAL
+ 70 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SBSIJ '/' ',' IER = ',I10/' ',
+ * ' ( ',I10,' , ',I10,' )'/' ',
+ * ' ENTRY ALREADY SET - CURRENT VALUE OF',D15.8/' ',
+ * ' RESET TO',D15.8)
+ A(LINK) = VAL
+ GO TO 130
+ 80 TEMP = A(LINK)+VAL
+ IF (LEVEL.GE.1) WRITE (NOUT,90) IER,I,J,A(LINK),TEMP
+ 90 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE SBSIJ '/' ',' IER = ',I10/' ',
+ * ' ( ',I10,' , ',I10,' )'/' ',
+ * ' ENTRY ALREADY SET - CURRENT VALUE OF',D15.8/' ',
+ * ' RESET TO',D15.8)
+ A(LINK) = TEMP
+ GO TO 130
+C
+C ... ENTRY (I,J) HAS NOT BEEN SET. ENTER IT INTO THE LINKED LIST
+C
+ 100 NEXT = IA(NPL1)
+ IF (NEXT.LT.1) GO TO 110
+C
+ IWORK(LINK) = NEXT
+ JA(NEXT) = J
+ A(NEXT) = VAL
+ IWORK(NEXT) = -I
+ IA(NPL1) = NEXT-1
+ GO TO 130
+C
+C***********************************************************************
+C
+C ... ERROR TRAP FOR NO ROOM REMAINING
+C
+ 110 IER = 702
+ IF (LEVEL.GE.0) WRITE (NOUT,120) IER
+ 120 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SBSIJ '/' ',' IER = ',I10/' ',
+ * ' NZ TOO SMALL - NO ROOM FOR NEW ENTRY')
+C
+ 130 CONTINUE
+ IERR = IER
+ RETURN
+ END
+ SUBROUTINE SCAL (NN,IA,JA,A,RHS,U,D,LEVEL,NOUT,IER)
+C
+C ... ORIGINAL MATRIX IS SCALED TO A UNIT DIAGONAL MATRIX. RHS
+C ... AND U ARE SCALED ACCORDINGLY. THE MATRIX IS THEN SPLIT AND
+C ... IA, JA, AND A RESHUFFLED.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX (= NN)
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C U LATEST ESTIMATE OF SOLUTION
+C D OUTPUT VECTOR CONTAINING THE SQUARE ROOTS
+C OF THE DIAGONAL ENTRIES
+C LEVEL PRINTING SWITCH FOR ERROR CONDITION
+C NOUT OUTPUT TAPE NUMBER
+C IER ERROR FLAG: ON RETURN NONZERO VALUES MEAN
+C 401 : THE ITH DIAGONAL ELEMENT IS .LE. 0.
+C 402 : NO DIAGONAL ELEMENT IN ROW I
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),NN,LEVEL,NOUT,IER
+ DOUBLE PRECISION A(1),RHS(NN),U(NN),D(NN)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,IBGN,IEND,II,IM1,J,JADD,JAJJ,JJ,JJPI,N,NP1
+ DOUBLE PRECISION DI
+C
+C ... EXTRACT SQUARE ROOT OF THE DIAGONAL OUT OF A AND SCALE U AND RHS
+C
+ N = NN
+ IER = 0
+ DO 80 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 50
+ DO 40 JJ = IBGN,IEND
+ IF (JA(JJ).NE.II) GO TO 40
+ DI = A(JJ)
+ IF (DI.GT.0.D0) GO TO 70
+ IF (DI.EQ.0.D0) GO TO 20
+ IER = 401
+ IF (LEVEL.GE.0) WRITE (NOUT,10) II
+ 10 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SCAL '/' ',
+ * ' DIAGONAL ENTRY IN ROW ',I10,' NEGATIVE')
+ RETURN
+ 20 IER = 401
+ IF (LEVEL.GE.0) WRITE (NOUT,30)
+ 30 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SCAL '/' ',
+ * ' DIAGONAL ENTRY IN ROW ',I10,' IS ZERO')
+ RETURN
+ 40 CONTINUE
+ 50 IER = 402
+ IF (LEVEL.GE.0) WRITE (NOUT,60) II
+ 60 FORMAT ('0','*** F A T A L E R R O R ************'/'0',
+ * ' IN ITPACK ROUTINE SCAL '/' ',
+ * ' NO DIAGONAL ENTRY IN ROW',I10)
+ RETURN
+C
+ 70 CONTINUE
+ DI = DSQRT(DABS(DI))
+ RHS(II) = RHS(II)/DI
+ U(II) = U(II)*DI
+ D(II) = DI
+ 80 CONTINUE
+C
+C ... SHIFT MATRIX TO ELIMINATE DIAGONAL ENTRIES
+C
+ IF (N.EQ.1) GO TO 110
+ NP1 = N+1
+ DO 100 I = 1,N
+ IM1 = I-1
+ II = NP1-I
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ JADD = IBGN+IEND
+ DO 90 J = IBGN,IEND
+ JJ = JADD-J
+ JJPI = JJ+IM1
+ IF (JA(JJ).EQ.II) IM1 = I
+ A(JJPI) = A(JJ)
+ JA(JJPI) = JA(JJ)
+ 90 CONTINUE
+ IA(II+1) = IA(II+1)+I-1
+ 100 CONTINUE
+ 110 IA(1) = IA(1)+N
+C
+C ... SCALE SHIFTED MATRIX AND STORE D ARRAY IN FIRST N ENTRIES OF A
+C
+ DO 140 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ DI = D(II)
+ IF (IBGN.GT.IEND) GO TO 130
+ DO 120 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ A(JJ) = A(JJ)/(DI*D(JAJJ))
+ 120 CONTINUE
+ 130 CONTINUE
+ A(II) = DI
+ 140 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE SUM3 (N,C1,X1,C2,X2,C3,X3)
+C
+C ... COMPUTES X3 = C1*X1 + C2*X2 + C3*X3
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTORS X1, X2, X3
+C C1,C2,C3 D.P. CONSTANTS
+C X1,X2,X3 D.P. VECTORS SUCH THAT
+C X3(I) = C1*X1(I) + C2*X2(I) + C3*X3(I)
+C X3(I) = C1*X1(I) + C2*X2(I) IF C3 = 0.
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+ DOUBLE PRECISION X1(N),X2(N),X3(N),C1,C2,C3
+C
+ IF (N.LE.0) RETURN
+ IF (DABS(C3).EQ.0.D0) GO TO 20
+C
+ DO 10 I = 1,N
+ X3(I) = C1*X1(I)+C2*X2(I)+C3*X3(I)
+ 10 CONTINUE
+ RETURN
+C
+C ... COMPUTE X3 = C1*X1 + C2*X2
+C
+ 20 DO 30 I = 1,N
+ X3(I) = C1*X1(I)+C2*X2(I)
+ 30 CONTINUE
+C
+ RETURN
+ END
+ DOUBLE PRECISION FUNCTION TAU (II)
+C
+C ... THIS SUBROUTINE SETS TAU(II) FOR THE SOR METHOD.
+C
+C ... PARAMETER LIST:
+C
+C II NUMBER OF TIMES PARAMETERS HAVE BEEN CHANGED
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER II
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ DOUBLE PRECISION T(8)
+C
+ DATA T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8) / 1.5D0,1.8D0,1.85D0,
+ * 1.9D0,1.94D0,1.96D0,1.975D0,1.985D0 /
+C
+ TAU = 1.992D0
+ IF (II.LE.8) TAU = T(II)
+C
+ RETURN
+ END
+ FUNCTION TIMER (TIMDMY)
+C
+C ... TIMER IS A ROUTINE TO RETURN THE EXECUTION TIME IN
+C ... SECONDS.
+C
+C ... PARAMETERS --
+C
+C TIMDMY DUMMY ARGUMENT
+C
+C
+C *********************************************
+C ** **
+C ** THIS ROUTINE IS NOT PORTABLE. **
+C ** **
+C *********************************************
+C
+ REAL TIMDMY
+C
+C ... CRAY Y-MP.
+C
+C TIMER = SECOND ()
+C
+C ... UNIX ETIME FACILITY.
+C
+ EXTERNAL ETIME
+ DIMENSION TARRAY(2)
+ REAL ETIME, TIMER
+ TOTAL = ETIME (TARRAY)
+ TIMER = TOTAL
+C
+C ... IBM RISC SYSTEM/6000.
+C
+C TIMER = FLOAT(MCLOCK())/100.0
+C
+ RETURN
+ END
+ LOGICAL FUNCTION TSTCHG (IBMTH)
+C
+C THIS FUNCTION PERFORMS A TEST TO DETERMINE IF PARAMETERS
+C SHOULD BE CHANGED FOR SEMI-ITERATION ACCELERATED METHODS.
+C
+C ... PARAMETER LIST:
+C
+C IBMTH INDICATOR OF BASIC METHOD BEING ACCELERATED BY SI
+C IBMTH = 1, JACOBI
+C = 2, REDUCED SYSTEM
+C = 3, SSOR
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IBMTH
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IP
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCKS IN MAIN SUBROUTINE
+C
+ IP = IN-IS
+ IF (IBMTH.EQ.2) IP = 2*IP
+C
+ IF (IN.EQ.0) GO TO 10
+ IF (IP.LT.3) GO TO 20
+C
+ QA = DSQRT(DABS(DELNNM/DELSNM))
+ QT = 2.D0*DSQRT(DABS(RRR**IP))/(1.D0+RRR**IP)
+ IF ((QA.GE.1.D0).OR.(QA.LT.QT**FF)) GO TO 20
+C
+C ... TEST PASSES -- CHANGE PARAMETERS
+C
+ 10 TSTCHG = .TRUE.
+ RETURN
+C
+C ... TEST FAILS -- DO NOT CHANGE PARAMETERS
+C
+ 20 TSTCHG = .FALSE.
+ RETURN
+C
+ END
+ SUBROUTINE UNSCAL (N,IA,JA,A,RHS,U,D)
+C
+C ... THIS SUBROUTINE REVERSES THE PROCESS OF SCAL.
+C
+C ... PARAMETER LIST:
+C
+C N DIMENSION OF MATRIX
+C IA,JA INTEGER ARRAYS OF SPARSE MATRIX REPRESENTATION
+C A D.P. ARRAY OF SPARSE MATRIX REPRESENTATION
+C RHS RIGHT HAND SIDE OF MATRIX PROBLEM
+C U LATEST ESTIMATE OF SOLUTION
+C D VECTOR CONTAINING THE SQUARE ROOTS
+C OF THE DIAGONAL ENTRIES
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER IA(1),JA(1),N
+ DOUBLE PRECISION A(1),RHS(N),U(N),D(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IBGN,IEND,II,INEW,IS,JAJJ,JJ,JJPI
+ DOUBLE PRECISION DI
+C
+C ... EXTRACT DIAGONAL FROM SCALED A AND UNSCALE U AND RHS
+C
+ DO 10 II = 1,N
+ DI = A(II)
+ U(II) = U(II)/DI
+ RHS(II) = RHS(II)*DI
+ D(II) = DI
+ 10 CONTINUE
+C
+C ... UNSCALE A
+C
+ DO 30 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IF (IBGN.GT.IEND) GO TO 30
+ DI = D(II)
+ DO 20 JJ = IBGN,IEND
+ JAJJ = JA(JJ)
+ A(JJ) = A(JJ)*DI*D(JAJJ)
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C ... INSERT DIAGONAL BACK INTO A
+C
+ DO 60 II = 1,N
+ IBGN = IA(II)
+ IEND = IA(II+1)-1
+ IS = N-II
+ INEW = IBGN-IS-1
+ A(INEW) = D(II)**2
+ JA(INEW) = II
+ IF (IS.EQ.0.OR.IBGN.GT.IEND) GO TO 50
+ DO 40 JJ = IBGN,IEND
+ JJPI = JJ-IS
+ A(JJPI) = A(JJ)
+ JA(JJPI) = JA(JJ)
+ 40 CONTINUE
+ 50 CONTINUE
+ IA(II) = INEW
+ 60 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE VEVMW (N,V,W)
+C
+C ... VEVMW COMPUTES V = V - W
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTORS V AND W
+C V D.P. VECTOR
+C W D.P. VECTOR SUCH THAT V(I) = V(I) - W(I)
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N
+ DOUBLE PRECISION V(N),W(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,M,MP1
+C
+ IF (N.LE.0) RETURN
+ M = MOD(N,4)
+C
+ IF (M.EQ.0) GO TO 20
+ DO 10 I = 1,M
+ V(I) = V(I)-W(I)
+ 10 CONTINUE
+ IF (N.LT.4) RETURN
+C
+ 20 MP1 = M+1
+ DO 30 I = MP1,N,4
+ V(I) = V(I)-W(I)
+ V(I+1) = V(I+1)-W(I+1)
+ V(I+2) = V(I+2)-W(I+2)
+ V(I+3) = V(I+3)-W(I+3)
+ 30 CONTINUE
+ RETURN
+C
+ END
+ SUBROUTINE VEVPW (N,V,W)
+C
+C ... VPW COMPUTES V = V + W
+C
+C ... PARAMETER LIST:
+C
+C N LENGTH OF VECTORS V AND W
+C V D.P. VECTOR
+C W D.P. VECTOR SUCH THAT V(I) = V(I) + W(I)
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N
+ DOUBLE PRECISION V(N),W(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,M,MP1
+C
+ IF (N.LE.0) RETURN
+C
+ M = MOD(N,4)
+ IF (M.EQ.0) GO TO 20
+ DO 10 I = 1,M
+ V(I) = V(I)+W(I)
+ 10 CONTINUE
+ IF (N.LT.4) RETURN
+C
+ 20 MP1 = M+1
+ DO 30 I = MP1,N,4
+ V(I) = V(I)+W(I)
+ V(I+1) = V(I+1)+W(I+1)
+ V(I+2) = V(I+2)+W(I+2)
+ V(I+3) = V(I+3)+W(I+3)
+ 30 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE VFILL (N,V,VAL)
+C
+C FILLS A VECTOR, V, WITH A CONSTANT VALUE, VAL.
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTOR V
+C V D.P. VECTOR
+C VAL D.P. CONSTANT THAT FILLS FIRST N LOCATIONS OF V
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N
+ DOUBLE PRECISION V(N),VAL
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,M,MP1
+C
+ IF (N.LE.0) RETURN
+C
+C CLEAN UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 10
+C
+ M = MOD(N,10)
+ IF (M.EQ.0) GO TO 20
+ DO 10 I = 1,M
+ V(I) = VAL
+ 10 CONTINUE
+ IF (N.LT.10) RETURN
+C
+ 20 MP1 = M+1
+ DO 30 I = MP1,N,10
+ V(I) = VAL
+ V(I+1) = VAL
+ V(I+2) = VAL
+ V(I+3) = VAL
+ V(I+4) = VAL
+ V(I+5) = VAL
+ V(I+6) = VAL
+ V(I+7) = VAL
+ V(I+8) = VAL
+ V(I+9) = VAL
+ 30 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE VOUT (N,V,ISWT,NOUTT)
+C
+C THIS SUBROUTINE EFFECTS PRINTING OF RESIDUAL AND SOLUTION
+C VECTORS - CALLED FROM PERROR
+C
+C ... PARAMETER LIST:
+C
+C V VECTOR OF LENGTH N
+C ISWT LABELLING INFORMATION
+C NOUT OUTPUT DEVICE NUMBER (= NOUTT)
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N,ISWT,NOUTT
+ DOUBLE PRECISION V(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,J,JM1,K,KUPPER,NOUT
+C
+ NOUT = NOUTT
+C
+C IF (N .LE. 0) RETURN
+C
+ KUPPER = MIN0(N,8)
+ IF (ISWT.EQ.1) WRITE (NOUT,10)
+ 10 FORMAT (//5X,'RESIDUAL VECTOR')
+ IF (ISWT.EQ.2) WRITE (NOUT,20)
+ 20 FORMAT (//5X,'SOLUTION VECTOR')
+ WRITE (NOUT,30) (I,I=1,KUPPER)
+ 30 FORMAT (10X,8I15)
+ WRITE (NOUT,40)
+ 40 FORMAT (10X,120('-')/)
+C
+ DO 60 J = 1,N,8
+ KUPPER = MIN0(J+7,N)
+ JM1 = J-1
+ WRITE (NOUT,50) JM1,(V(K),K=J,KUPPER)
+ 50 FORMAT (4X,I5,'+ ',8D15.5)
+ 60 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE WEVMW (N,V,W)
+C
+C ... WEVMW COMPUTES W = V - W
+C
+C ... PARAMETER LIST:
+C
+C N INTEGER LENGTH OF VECTORS V AND W
+C V D.P. VECTOR
+C W D.P. VECTOR SUCH THAT W(I) = V(I) - W(I)
+C
+C ... SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER N
+ DOUBLE PRECISION V(N),W(N)
+C
+C ... SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER I,M,MP1
+C
+ IF (N.LE.0) RETURN
+ M = MOD(N,4)
+ IF (M.EQ.0) GO TO 20
+ DO 10 I = 1,M
+ W(I) = V(I)-W(I)
+ 10 CONTINUE
+ IF (N.LT.4) RETURN
+C
+ 20 MP1 = M+1
+ DO 30 I = MP1,N,4
+ W(I) = V(I)-W(I)
+ W(I+1) = V(I+1)-W(I+1)
+ W(I+2) = V(I+2)-W(I+2)
+ W(I+3) = V(I+3)-W(I+3)
+ 30 CONTINUE
+C
+ RETURN
+ END
+ SUBROUTINE ZBRENT (N,TRI,EPS,NSIG,AA,BB,MAXFNN,IER)
+C
+C MODIFIED IMSL ROUTINE NAME - ZBRENT
+C
+C-----------------------------------------------------------------------
+C
+C COMPUTER - CDC/SINGLE
+C
+C LATEST REVISION - JANUARY 1, 1978
+C
+C PURPOSE - ZERO OF A FUNCTION WHICH CHANGES SIGN IN A
+C GIVEN INTERVAL (BRENT ALGORITHM)
+C
+C USAGE - CALL ZBRENT (F,EPS,NSIG,A,B,MAXFN,IER)
+C
+C ARGUMENTS TRI - A TRIDIAGONAL MATRIX OF ORDER N
+C EPS - FIRST CONVERGENCE CRITERION (INPUT). A ROOT,
+C B, IS ACCEPTED IF DABS(F(B)) IS LESS THAN OR
+C EQUAL TO EPS. EPS MAY BE SET TO ZERO.
+C NSIG - SECOND CONVERGENCE CRITERION (INPUT). A ROOT,
+C B, IS ACCEPTED IF THE CURRENT APPROXIMATION
+C AGREES WITH THE TRUE SOLUTION TO NSIG
+C SIGNIFICANT DIGITS.
+C A,B - ON INPUT, THE USER MUST SUPPLY TWO POINTS, A
+C AND B, SUCH THAT F(A) AND F(B) ARE OPPOSITE
+C IN SIGN. (= AA, BB)
+C ON OUTPUT, BOTH A AND B ARE ALTERED. B
+C WILL CONTAIN THE BEST APPROXIMATION TO THE
+C ROOT OF F. SEE REMARK 1.
+C MAXFN - ON INPUT, MAXFN SHOULD CONTAIN AN UPPER BOUND
+C ON THE NUMBER OF FUNCTION EVALUATIONS
+C REQUIRED FOR CONVERGENCE. ON OUTPUT, MAXFN
+C WILL CONTAIN THE ACTUAL NUMBER OF FUNCTION
+C EVALUATIONS USED. (= MAXFNN)
+C IER - ERROR PARAMETER. (OUTPUT)
+C TERMINAL ERROR
+C IER = 501 INDICATES THE ALGORITHM FAILED TO
+C CONVERGE IN MAXFN EVALUATIONS.
+C IER = 502 INDICATES F(A) AND F(B) HAVE THE
+C SAME SIGN.
+C
+C PRECISION/HARDWARE - SINGLE AND DOUBLE/H32
+C - SINGLE/H36,H48,H60
+C
+C NOTATION - INFORMATION ON SPECIAL NOTATION AND
+C CONVENTIONS IS AVAILABLE IN THE MANUAL
+C INTRODUCTION OR THROUGH IMSL ROUTINE UHELP
+C
+C REMARKS 1. LET F(X) BE THE CHARACTERISTIC FUNCTION OF THE MATRIX
+C TRI EVALUATED AT X. FUNCTION DETERM EVALUATES F(X).
+C ON EXIT FROM ZBRENT, WHEN IER=0, A AND B SATISFY THE
+C FOLLOWING,
+C F(A)*F(B) .LE.0,
+C DABS(F(B)) .LE. DABS(F(A)), AND
+C EITHER DABS(F(B)) .LE. EPS OR
+C DABS(A-B) .LE. MAX(DABS(B),0.1)*10.0**(-NSIG).
+C THE PRESENCE OF 0.1 IN THIS ERROR CRITERION CAUSES
+C LEADING ZEROES TO THE RIGHT OF THE DECIMAL POINT TO BE
+C COUNTED AS SIGNIFICANT DIGITS. SCALING MAY BE REQUIRED
+C IN ORDER TO ACCURATELY DETERMINE A ZERO OF SMALL
+C MAGNITUDE.
+C 2. ZBRENT IS GUARANTEED TO REACH CONVERGENCE WITHIN
+C K = (DLOG((B-A)/D)+1.0)**2 FUNCTION EVALUATIONS WHERE
+C D=MIN(OVER X IN (A,B) OF
+C MAX(DABS(X),0.1)*10.0**(-NSIG)).
+C THIS IS AN UPPER BOUND ON THE NUMBER OF EVALUATIONS.
+C RARELY DOES THE ACTUAL NUMBER OF EVALUATIONS USED BY
+C ZBRENT EXCEED DSQRT(K). D CAN BE COMPUTED AS FOLLOWS,
+C P = DBLE(AMIN1(DABS(A),DABS(B)))
+C P = DMAX1(0.1,P)
+C IF ((A-0.1)*(B-0.1).LT.0.0) P = 0.1
+C D = P*10.0**(-NSIG)
+C
+C COPYRIGHT - 1977 BY IMSL, INC. ALL RIGHTS RESERVED.
+C
+C WARRANTY - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN
+C APPLIED TO THIS CODE. NO OTHER WARRANTY,
+C EXPRESSED OR IMPLIED, IS APPLICABLE.
+C
+C-----------------------------------------------------------------------
+C
+C *** BEGIN: ITPACK COMMON
+C
+ INTEGER IN,IS,ISYM,ITMAX,LEVEL,NOUT
+ COMMON /ITCOM1/ IN,IS,ISYM,ITMAX,LEVEL,NOUT
+C
+ LOGICAL ADAPT,BETADT,CASEII,HALT,PARTAD
+ COMMON /ITCOM2/ ADAPT,BETADT,CASEII,HALT,PARTAD
+C
+ DOUBLE PRECISION BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+ COMMON /ITCOM3/ BDELNM,BETAB,CME,DELNNM,DELSNM,FF,GAMMA,OMEGA,QA,
+ * QT,RHO,RRR,SIGE,SME,SPECR,SPR,DRELPR,STPTST,UDNM,ZETA
+C
+C *** END : ITPACK COMMON
+C
+C DESCRIPTION OF VARIABLES IN COMMON BLOCK IN MAIN SUBROUTINE
+C
+C SPECIFICATIONS FOR ARGUMENTS
+C
+ INTEGER NSIG,MAXFNN,IER
+ DOUBLE PRECISION TRI(2,1),EPS,AA,BB
+C
+C SPECIFICATIONS FOR LOCAL VARIABLES
+C
+ INTEGER IC,MAXFN
+ DOUBLE PRECISION ZERO,HALF,ONE,THREE,TEN,A,B,T,FA,FB,C,FC,D,E,TOL,
+ * RM,S,P,Q,R,RONE,TEMP,DETERM
+ DATA ZERO / 0.D0 / ,HALF / 5.D-1 / ,ONE / 1.D0 / ,THREE / 3.D0 / ,
+ * TEN / 10.D0 /
+C
+C FIRST EXECUTABLE STATEMENT
+C
+ A = AA
+ B = BB
+ MAXFN = MAXFNN
+ IER = 0
+ T = TEN**(-NSIG)
+ IC = 2
+ FA = DETERM(N,TRI,A)
+ FB = DETERM(N,TRI,B)
+ S = B
+C
+C TEST FOR SAME SIGN
+C
+ IF (FA*FB.GT.ZERO) GO TO 110
+ 10 C = A
+ FC = FA
+ D = B-C
+ E = D
+ 20 IF (DABS(FC).GE.DABS(FB)) GO TO 30
+ A = B
+ B = C
+ C = A
+ FA = FB
+ FB = FC
+ FC = FA
+ 30 CONTINUE
+ TOL = T*DMAX1(DABS(B),0.1D0)
+ RM = (C-B)*HALF
+C
+C TEST FOR FIRST CONVERGENCE CRITERIA
+C
+ IF (DABS(FB).LE.EPS) GO TO 80
+C
+C TEST FOR SECOND CONVERGENCE CRITERIA
+C
+ IF (DABS(C-B).LE.TOL) GO TO 80
+C
+C CHECK EVALUATION COUNTER
+C
+ IF (IC.GE.MAXFN) GO TO 90
+C
+C IS BISECTION FORCED
+C
+ IF (DABS(E).LT.TOL) GO TO 60
+ IF (DABS(FA).LE.DABS(FB)) GO TO 60
+ S = FB/FA
+ IF (A.NE.C) GO TO 40
+C
+C LINEAR INTERPOLATION
+C
+ P = (C-B)*S
+ Q = ONE-S
+ GO TO 50
+C
+C INVERSE QUADRATIC INTERPOLATION
+C
+ 40 Q = FA/FC
+ R = FB/FC
+ RONE = R-ONE
+ P = S*((C-B)*Q*(Q-R)-(B-A)*RONE)
+ Q = (Q-ONE)*RONE*(S-ONE)
+ 50 IF (P.GT.ZERO) Q = -Q
+ IF (P.LT.ZERO) P = -P
+ S = E
+ E = D
+C
+C IF DABS(P/Q).GE.75*DABS(C-B) THEN
+C FORCE BISECTION
+C
+ IF (P+P.GE.THREE*RM*Q) GO TO 60
+C
+C IF DABS(P/Q).GE..5*DABS(S) THEN FORCE
+C BISECTION. S = THE VALUE OF P/Q
+C ON THE STEP BEFORE THE LAST ONE
+C
+ IF (P+P.GE.DABS(S*Q)) GO TO 60
+ D = P/Q
+ GO TO 70
+C
+C BISECTION
+C
+ 60 E = RM
+ D = E
+C
+C INCREMENT B
+C
+ 70 A = B
+ FA = FB
+ TEMP = D
+ IF (DABS(TEMP).LE.HALF*TOL) TEMP = DSIGN(HALF*TOL,RM)
+ B = B+TEMP
+ S = B
+ FB = DETERM(N,TRI,S)
+ IC = IC+1
+ IF (FB*FC.LE.ZERO) GO TO 20
+ GO TO 10
+C
+C CONVERGENCE OF B
+C
+ 80 A = C
+ MAXFN = IC
+ GO TO 130
+C
+C MAXFN EVALUATIONS
+C
+ 90 IER = 501
+ A = C
+ MAXFN = IC
+ IF (LEVEL.GE.1) WRITE (NOUT,100) MAXFN
+ 100 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE ZBRENT '/' ',
+ * ' ALGORITHM FAILED TO CONVERGE '/' ',' IN',I6,
+ * ' ITERATIONS ')
+ GO TO 130
+C
+C TERMINAL ERROR - F(A) AND F(B) HAVE
+C THE SAME SIGN
+C
+ 110 IER = 502
+ MAXFN = IC
+ IF (LEVEL.GE.1) WRITE (NOUT,120)
+ 120 FORMAT ('0','*** W A R N I N G ************'/'0',
+ * ' IN ITPACK ROUTINE ZBRENT '/' ',
+ * ' F(A) AND F(B) HAVE SAME SIGN ')
+ 130 CONTINUE
+ AA = A
+ BB = B
+ MAXFNN = MAXFN
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dsvdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsvdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..c79276fbe11d32028d1d5297da59ba1dfb805a3a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dsvdc.c
@@ -0,0 +1,546 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/*
+ * Calling this ensures that the operands are spilled to
+ * memory and thus avoids excessive precision when compiling
+ * for x86 with heavy optimization (gcc). It is better to do
+ * this than to turn on -ffloat-store.
+ */
+static int fsm_ieee_doubles_equal(const doublereal *x, const doublereal *y);
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_m1 = -1.;
+
+/* Subroutine */ void dsvdc_(x, ldx, n, p, s, e, u, ldu, v, ldv, work, job, info)
+doublereal *x;
+const integer *ldx, *n, *p;
+doublereal *s, *e, *u;
+const integer *ldu;
+doublereal *v;
+const integer *ldv;
+doublereal *work;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer kase, jobu, iter;
+ static doublereal test;
+ static doublereal b, c;
+ static doublereal f, g;
+ static integer i, j, k, l, m;
+ static doublereal t, scale;
+ static doublereal shift;
+ static integer maxit;
+ static logical wantu, wantv;
+ static doublereal t1, ztest, el;
+ static doublereal cs;
+ static integer mm, ls;
+ static doublereal sl;
+ static integer lu;
+ static doublereal sm, sn;
+ static integer lp1, nct, ncu, nrt;
+ static doublereal emm1, smm1;
+
+/* dsvdc is a subroutine to reduce a double precision nxp matrix x */
+/* by orthogonal transformations u and v to diagonal form. The */
+/* diagonal elements s(i) are the singular values of x. The */
+/* columns of u are the corresponding left singular vectors, */
+/* and the columns of v the right singular vectors. */
+/* */
+/* on entry */
+/* */
+/* x double precision(ldx,p), where ldx.ge.n. */
+/* x contains the matrix whose singular value */
+/* decomposition is to be computed. x is */
+/* destroyed by dsvdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* ldu integer. */
+/* ldu is the leading dimension of the array u. */
+/* (see below). */
+/* */
+/* ldv integer. */
+/* ldv is the leading dimension of the array v. */
+/* (see below). */
+/* */
+/* work double precision(n). */
+/* work is a scratch array. */
+/* */
+/* job integer. */
+/* job controls the computation of the singular */
+/* vectors. it has the decimal expansion ab */
+/* with the following meaning */
+/* */
+/* a.eq.0 do not compute the left singular */
+/* vectors. */
+/* a.eq.1 return the n left singular vectors */
+/* in u. */
+/* a.ge.2 return the first min(n,p) singular */
+/* vectors in u. */
+/* b.eq.0 do not compute the right singular */
+/* vectors. */
+/* b.eq.1 return the right singular vectors */
+/* in v. */
+/* */
+/* on return */
+/* */
+/* s double precision(mm), where mm=min(n+1,p). */
+/* the first min(n,p) entries of s contain the */
+/* singular values of x arranged in descending */
+/* order of magnitude. */
+/* */
+/* e double precision(p). */
+/* e ordinarily contains zeros. however see the */
+/* discussion of info for exceptions. */
+/* */
+/* u double precision(ldu,k), where ldu.ge.n. if */
+/* joba.eq.1 then k.eq.n, if joba.ge.2 */
+/* then k.eq.min(n,p). */
+/* u contains the matrix of left singular vectors. */
+/* u is not referenced if joba.eq.0. if n.le.p */
+/* or if joba.eq.2, then u may be identified with x */
+/* in the subroutine call. */
+/* */
+/* v double precision(ldv,p), where ldv.ge.p. */
+/* v contains the matrix of right singular vectors. */
+/* v is not referenced if job.eq.0. if p.le.n, */
+/* then v may be identified with x in the */
+/* subroutine call. */
+/* */
+/* info integer. */
+/* the singular values (and their corresponding */
+/* singular vectors) s(info+1),s(info+2),...,s(m) */
+/* are correct (here m=min(n,p)). thus if */
+/* info.eq.0, all the singular values and their */
+/* vectors are correct. in any event, the matrix */
+/* b = trans(u)*x*v is the bidiagonal matrix */
+/* with the elements of s on its diagonal and the */
+/* elements of e on its super-diagonal (trans(u) */
+/* is the transpose of u). thus the singular */
+/* values of x and b are the same. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* correction made to shift 2/84. */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* dsvdc uses the following functions and subprograms. */
+/* */
+/* external drot */
+/* blas daxpy,ddot,dscal,dswap,dnrm2,drotg */
+/* fortran dabs,dmax1,max0,min0,mod,dsqrt */
+
+/* set the maximum number of iterations. */
+
+ maxit = 1000;
+
+/* determine what is to be computed. */
+
+ wantu = FALSE_;
+ wantv = FALSE_;
+ jobu = *job % 100 / 10;
+ ncu = *n;
+ if (jobu > 1) {
+ ncu = min(*n,*p);
+ }
+ if (jobu != 0) {
+ wantu = TRUE_;
+ }
+ if (*job % 10 != 0) {
+ wantv = TRUE_;
+ }
+
+/* reduce x to bidiagonal form, storing the diagonal elements */
+/* in s and the super-diagonal elements in e. */
+
+ *info = 0;
+ nct = min(*n-1,*p);
+ nrt = max(0,min(*p-2,*n));
+ lu = max(nct,nrt);
+ for (l = 0; l < lu; ++l) {
+ lp1 = l+1;
+ if (lp1 > nct) {
+ goto L20;
+ }
+
+/* compute the transformation for the l-th column and */
+/* place the l-th diagonal in s(l). */
+
+ i__1 = *n - l;
+ s[l] = dnrm2_(&i__1, &x[l + l * *ldx], &c__1);
+ if (s[l] == 0.) {
+ goto L10;
+ }
+ if (x[l + l * *ldx] != 0.) {
+ s[l] = d_sign(&s[l], &x[l + l * *ldx]);
+ }
+ i__1 = *n - l;
+ d__1 = 1. / s[l];
+ dscal_(&i__1, &d__1, &x[l + l * *ldx], &c__1);
+ x[l + l * *ldx] += 1.;
+L10:
+ s[l] = -s[l];
+L20:
+ for (j = lp1; j < *p; ++j) {
+
+/* apply the transformation. */
+
+ if (l < nct && s[l] != 0.) {
+ i__1 = *n - l;
+ t = -ddot_(&i__1, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1) / x[l + l * *ldx];
+ daxpy_(&i__1, &t, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1);
+ }
+
+/* place the l-th row of x into e for the */
+/* subsequent calculation of the row transformation. */
+
+ e[j] = x[l + j * *ldx];
+ }
+
+/* place the transformation in u for subsequent back */
+/* multiplication. */
+
+ if (wantu && l < nct)
+ for (i = l; i < *n; ++i) {
+ u[i + l * *ldu] = x[i + l * *ldx];
+ }
+ if (lp1 > nrt) {
+ continue;
+ }
+
+/* compute the l-th row transformation and place the */
+/* l-th super-diagonal in e(l). */
+
+ i__1 = *p - lp1;
+ e[l] = dnrm2_(&i__1, &e[lp1], &c__1);
+ if (e[l] == 0.) {
+ goto L80;
+ }
+ if (e[lp1] != 0.) {
+ e[l] = d_sign(&e[l], &e[lp1]);
+ }
+ i__1 = *p - lp1;
+ d__1 = 1. / e[l];
+ dscal_(&i__1, &d__1, &e[lp1], &c__1);
+ e[lp1] += 1.;
+L80:
+ e[l] = -e[l];
+ if (l+2 > *n || e[l] == 0.) {
+ goto L120;
+ }
+
+/* apply the transformation. */
+
+ for (i = lp1; i < *n; ++i) {
+ work[i] = 0.;
+ }
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *n - lp1;
+ daxpy_(&i__1, &e[j], &x[lp1 + j * *ldx], &c__1, &work[lp1], &c__1);
+ }
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *n - lp1;
+ d__1 = -e[j] / e[lp1];
+ daxpy_(&i__1, &d__1, &work[lp1], &c__1, &x[lp1 + j * *ldx], &c__1);
+ }
+L120:
+
+/* place the transformation in v for subsequent */
+/* back multiplication. */
+
+ if (wantv)
+ for (i = lp1; i < *p; ++i) {
+ v[i + l * *ldv] = e[i];
+ }
+ }
+
+/* set up the final bidiagonal matrix or order m. */
+
+ m = min(*p-1,*n);
+ if (nct < *p) {
+ s[nct] = x[nct + nct * *ldx];
+ }
+ if (*n < m+1) {
+ s[m] = 0.;
+ }
+ if (nrt < m) {
+ e[nrt] = x[nrt + m * *ldx];
+ }
+ e[m] = 0.;
+
+/* if required, generate u. */
+
+ if (wantu)
+ for (j = nct; j < ncu; ++j) {
+ for (i = 0; i < *n; ++i) {
+ u[i + j * *ldu] = 0.;
+ }
+ u[j + j * *ldu] = 1.;
+ }
+ if (wantu)
+ for (l = nct-1; l >= 0; --l) {
+ if (s[l] == 0.) {
+ for (i = 0; i < *n; ++i) {
+ u[i + l * *ldu] = 0.;
+ }
+ u[l + l * *ldu] = 1.;
+ continue;
+ }
+ for (j = l+1; j < ncu; ++j) {
+ i__1 = *n - l;
+ t = -ddot_(&i__1, &u[l + l * *ldu], &c__1, &u[l + j * *ldu], &c__1) / u[l + l * *ldu];
+ daxpy_(&i__1, &t, &u[l + l * *ldu], &c__1, &u[l + j * *ldu], &c__1);
+ }
+ i__1 = *n - l;
+ dscal_(&i__1, &c_m1, &u[l + l * *ldu], &c__1);
+ u[l + l * *ldu] += 1.;
+ for (i = 0; i < l; ++i) {
+ u[i + l * *ldu] = 0.;
+ }
+ }
+
+/* if it is required, generate v. */
+
+ if (wantv)
+ for (l = *p-1; l >= 0; --l) {
+ lp1 = l+1;
+ if (l < nrt && e[l] != 0.)
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *p - lp1;
+ t = -ddot_(&i__1, &v[lp1 + l * *ldv], &c__1, &v[lp1 + j * *ldv], &c__1) / v[lp1 + l * *ldv];
+ daxpy_(&i__1, &t, &v[lp1 + l * *ldv], &c__1, &v[lp1 + j * *ldv], &c__1);
+ }
+ for (i = 0; i < *p; ++i) {
+ v[i + l * *ldv] = 0.;
+ }
+ v[l + l * *ldv] = 1.;
+ }
+
+/* main iteration loop for the singular values. */
+
+ mm = m;
+ iter = 0;
+L360:
+
+/* quit if all the singular values have been found. */
+
+ if (m < 0) {
+ return;
+ }
+
+/* if too many iterations have been performed, set */
+/* flag and return. */
+
+ if (iter >= maxit) {
+ *info = m+1;
+ return;
+ }
+
+/* this section of the program inspects for */
+/* negligible elements in the s and e arrays. on */
+/* completion the variables kase and l are set as follows. */
+
+/* kase = 1 if s(m) and e(l-1) are negligible and l.lt.m */
+/* kase = 2 if s(l) is negligible and l.lt.m */
+/* kase = 3 if e(l-1) is negligible, l.lt.m, and */
+/* s(l), ..., s(m) are not negligible (qr step). */
+/* kase = 4 if e(m-1) is negligible (convergence). */
+
+ for (l = m-1; l >= 0; --l) {
+ test = abs(s[l]) + abs(s[l+1]);
+ ztest = test + abs(e[l]);
+ if (fsm_ieee_doubles_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ e[l] = 0.;
+ break;
+ }
+ }
+ if (l == m-1) {
+ kase = 4;
+ goto L480;
+ }
+ for (ls = m; ls > l; --ls) {
+ test = 0.;
+ if (ls != m) {
+ test += abs(e[ls]);
+ }
+ if (ls != l+1) {
+ test += abs(e[ls-1]);
+ }
+ ztest = test + abs(s[ls]);
+ if (fsm_ieee_doubles_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ s[ls] = 0.;
+ break;
+ }
+ }
+ if (ls == l) {
+ kase = 3;
+ }
+ else if (ls == m) {
+ kase = 1;
+ }
+ else {
+ kase = 2;
+ l = ls;
+ }
+L480:
+ ++l;
+
+/* perform the task indicated by kase. */
+
+ switch ((int)kase) {
+ case 1: goto L490;
+ case 2: goto L520;
+ case 3: goto L540;
+ case 4: goto L570;
+ }
+
+/* deflate negligible s(m). */
+
+L490:
+ f = e[m-1];
+ e[m-1] = 0.;
+ for (k = m-1; k >= l; --k) {
+ t1 = s[k];
+ drotg_(&t1, &f, &cs, &sn);
+ s[k] = t1;
+ if (k != l) {
+ f = -sn * e[k-1];
+ e[k-1] *= cs;
+ }
+ if (wantv) {
+ drot_(p, &v[k * *ldv], &c__1, &v[m * *ldv], &c__1, &cs, &sn);
+ }
+ }
+ goto L360;
+
+/* split at negligible s(l). */
+
+L520:
+ f = e[l-1];
+ e[l-1] = 0.;
+ for (k = l; k <= m; ++k) {
+ t1 = s[k];
+ drotg_(&t1, &f, &cs, &sn);
+ s[k] = t1;
+ f = -sn * e[k];
+ e[k] *= cs;
+ if (wantu) {
+ drot_(n, &u[k * *ldu], &c__1, &u[(l-1) * *ldu], &c__1, &cs, &sn);
+ }
+ }
+ goto L360;
+
+/* perform one qr step. */
+
+L540:
+
+/* calculate the shift. */
+
+ scale = max(max(max(max(abs(s[m]),abs(s[m-1])),abs(e[m-1])),abs(s[l])),abs(e[l]));
+ sm = s[m] / scale;
+ smm1 = s[m-1] / scale;
+ emm1 = e[m-1] / scale;
+ sl = s[l] / scale;
+ el = e[l] / scale;
+ b = ((smm1 + sm) * (smm1 - sm) + emm1 * emm1) / 2.;
+ c = sm * emm1; c *= c;
+ if (b == 0. && c == 0.) {
+ shift = 0.;
+ }
+ else {
+ shift = sqrt(b * b + c);
+ if (b < 0.) {
+ shift = -shift;
+ }
+ shift = c / (b + shift);
+ }
+ f = (sl + sm) * (sl - sm) + shift;
+ g = sl * el;
+
+/* chase zeros. */
+
+ for (k = l; k < m; ++k) {
+ drotg_(&f, &g, &cs, &sn);
+ if (k != l) {
+ e[k-1] = f;
+ }
+ f = cs * s[k] + sn * e[k];
+ e[k] = cs * e[k] - sn * s[k];
+ g = sn * s[k+1];
+ s[k+1] *= cs;
+ if (wantv) {
+ drot_(p, &v[k * *ldv], &c__1, &v[(k+1) * *ldv], &c__1, &cs, &sn);
+ }
+ drotg_(&f, &g, &cs, &sn);
+ s[k] = f;
+ f = cs * e[k] + sn * s[k+1];
+ s[k+1] = -sn * e[k] + cs * s[k+1];
+ g = sn * e[k+1];
+ e[k+1] *= cs;
+ if (wantu && k+1 < *n) {
+ drot_(n, &u[k * *ldu], &c__1, &u[(k+1) * *ldu], &c__1, &cs, &sn);
+ }
+ }
+ e[m-1] = f;
+ ++iter;
+ goto L360;
+
+/* convergence. */
+
+L570:
+
+/* make the singular value positive. */
+
+ if (s[l] < 0.) {
+ s[l] = -s[l];
+ if (wantv) {
+ dscal_(p, &c_m1, &v[l * *ldv], &c__1);
+ }
+ }
+
+/* order the singular value. */
+
+L590:
+ if (l == mm) {
+ goto L600;
+ }
+ if (s[l] >= s[l+1]) {
+ goto L600;
+ }
+ t = s[l];
+ s[l] = s[l+1];
+ ++l;
+ s[l] = t;
+ if (wantv && l < *p) {
+ dswap_(p, &v[(l-1) * *ldv], &c__1, &v[l * *ldv], &c__1);
+ }
+ if (wantu && l < *n) {
+ dswap_(n, &u[(l-1) * *ldu], &c__1, &u[l * *ldu], &c__1);
+ }
+ goto L590;
+L600:
+ iter = 0;
+ --m;
+ goto L360;
+} /* dsvdc_ */
+
+static int fsm_ieee_doubles_equal(const doublereal *x, const doublereal *y)
+{
+ return *x == *y;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dswap.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dswap.c
new file mode 100644
index 0000000000000000000000000000000000000000..5f718d79987aa75ac3b28b36686479a2f5fbf8e6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dswap.c
@@ -0,0 +1,58 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dswap_(n, dx, incx, dy, incy)
+const integer *n;
+doublereal *dx;
+const integer *incx;
+doublereal *dy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, m;
+ static doublereal dtemp;
+ static integer ix, iy;
+
+/* interchanges two vectors. */
+/* uses unrolled loops for increments equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 3;
+ for (i = 0; i < m; ++i) {
+ dtemp = dx[i];
+ dx[i] = dy[i];
+ dy[i] = dtemp;
+ }
+ for (i = m; i < *n; i += 3) {
+ dtemp = dx[i];
+ dx[i] = dy[i];
+ dy[i] = dtemp;
+ dtemp = dx[i + 1];
+ dx[i + 1] = dy[i + 1];
+ dy[i + 1] = dtemp;
+ dtemp = dx[i + 2];
+ dx[i + 2] = dy[i + 2];
+ dy[i + 2] = dtemp;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ dtemp = dx[ix];
+ dx[ix] = dy[iy];
+ dy[iy] = dtemp;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* dswap_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.c
new file mode 100644
index 0000000000000000000000000000000000000000..ea68af4ac65e21701ce6ba04415751c18ea71061
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.c
@@ -0,0 +1,555 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__16 = 16;
+static doublereal c_b3 = 0.;
+static integer c__0 = 0;
+static integer c__1 = 1;
+static integer c__4 = 4;
+static integer c__2 = 2;
+static doublereal c_b38 = 1.;
+static doublereal c_b44 = -1.;
+
+/* Subroutine */ void dtgex2_(wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, j1, n1, n2, work, lwork, info)
+logical *wantq, *wantz;
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *q;
+integer *ldq;
+doublereal *z;
+integer *ldz, *j1, *n1, *n2;
+doublereal *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical weak;
+ static doublereal ddum;
+ static integer idum;
+ static doublereal taul[4], dsum;
+ static doublereal taur[4], scpy[16] /* was [4][4] */, tcpy[16] /* was [4][4] */, f, g;
+ static integer i, m;
+ static doublereal s[16] /* was [4][4] */, t[16] /* was [4][4] */;
+ static doublereal scale, bqra21, brqa21;
+ static doublereal licop[16] /* was [4][4] */;
+ static integer linfo;
+ static doublereal ircop[16] /* was [4][4] */;
+ static doublereal dnorm;
+ static integer iwork[4];
+ static doublereal be[2], ai[2];
+ static doublereal ar[2], sa, sb, li[16] /* was [4][4] */;
+ static doublereal dscale, ir[16] /* was [4][4] */, ss, ws;
+ static logical dtrong;
+ static doublereal thresh, smlnum, eps;
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22) */
+/* of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair */
+/* (A, B) by an orthogonal equivalence transformation. */
+/* */
+/* (A, B) must be in generalized real Schur canonical form (as returned */
+/* by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 */
+/* diagonal blocks. B is upper triangular. */
+/* */
+/* Optionally, the matrices Q and Z of generalized Schur vectors are */
+/* updated. */
+/* */
+/* Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)' */
+/* Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)' */
+/* */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* WANTQ (input) LOGICAL */
+/* .TRUE. : update the left transformation matrix Q; */
+/* .FALSE.: do not update Q. */
+/* */
+/* WANTZ (input) LOGICAL */
+/* .TRUE. : update the right transformation matrix Z; */
+/* .FALSE.: do not update Z. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrices A and B. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION arrays, dimensions (LDA,N) */
+/* On entry, the matrix A in the pair (A, B). */
+/* On exit, the updated matrix A. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* B (input/output) DOUBLE PRECISION arrays, dimensions (LDB,N) */
+/* On entry, the matrix B in the pair (A, B). */
+/* On exit, the updated matrix B. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+/* */
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N) */
+/* On entry, if WANTQ = .TRUE., the orthogonal matrix Q. */
+/* On exit, the updated matrix Q. */
+/* Not referenced if WANTQ = .FALSE.. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= 1. */
+/* If WANTQ = .TRUE., LDQ >= N. */
+/* */
+/* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) */
+/* On entry, if WANTZ =.TRUE., the orthogonal matrix Z. */
+/* On exit, the updated matrix Z. */
+/* Not referenced if WANTZ = .FALSE.. */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDZ >= 1. */
+/* If WANTZ = .TRUE., LDZ >= N. */
+/* */
+/* J1 (input) INTEGER */
+/* The index to the first block (A11, B11). 1 <= J1 <= N. */
+/* */
+/* N1 (input) INTEGER */
+/* The order of the first block (A11, B11). N1 = 0, 1 or 2. */
+/* */
+/* N2 (input) INTEGER */
+/* The order of the second block (A22, B22). N2 = 0, 1 or 2. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK). */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. */
+/* LWORK >= MAX( N*(N2+N1), (N2+N1)*(N2+N1)*2 ) */
+/* */
+/* INFO (output) INTEGER */
+/* =0: Successful exit */
+/* >0: If INFO = 1, the transformed matrix (A, B) would be */
+/* too far from generalized Schur form; the blocks are */
+/* not swapped and (A, B) and (Q, Z) are unchanged. */
+/* The problem of swapping is too ill-conditioned. */
+/* <0: If INFO = -16: LWORK is too small. Appropriate value */
+/* for LWORK is returned in WORK(1). */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+/* */
+/* In the current code both weak and strong stability tests are */
+/* performed. The user can omit the strong stability test by changing */
+/* the internal logical parameter WANDS to .FALSE.. See ref. [2] for */
+/* details. */
+/* */
+/* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the */
+/* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in */
+/* M.S. Moonen et al (eds), Linear Algebra for Large Scale and */
+/* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. */
+/* */
+/* [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified */
+/* Eigenvalues of a Regular Matrix Pair (A, B) and Condition */
+/* Estimation: Theory, Algorithms and Software, */
+/* Report UMINF - 94.04, Department of Computing Science, Umea */
+/* University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working */
+/* Note 87. To appear in Numerical Algorithms, 1996. */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+
+/* Quick return if possible */
+
+ if (*n <= 1 || *n1 <= 0 || *n2 <= 0) {
+ return;
+ }
+ if (*n1 > *n || *j1 + *n1 > *n) {
+ return;
+ }
+ m = *n1 + *n2;
+ if (*lwork < max(*n * m, m * m * 2)) {
+ *info = -16;
+ work[0] = (doublereal) max(*n * m, m * m * 2);
+ return;
+ }
+
+ /* Parameter adjustments */
+ *j1 -= 1;
+
+ weak = FALSE_;
+ dtrong = FALSE_;
+
+/* Make a local copy of selected block */
+
+ dcopy_(&c__16, &c_b3, &c__0, li, &c__1);
+ dcopy_(&c__16, &c_b3, &c__0, ir, &c__1);
+ dlacpy_("Full", &m, &m, &a[*j1 + *j1 * *lda], lda, s, &c__4);
+ dlacpy_("Full", &m, &m, &b[*j1 + *j1 * *ldb], ldb, t, &c__4);
+
+/* Compute threshold for testing acceptance of swapping. */
+
+ eps = dlamch_("P");
+ smlnum = dlamch_("S") / eps;
+ dscale = 0.;
+ dsum = 1.;
+ dlacpy_("Full", &m, &m, s, &c__4, work, &m);
+ i__1 = m * m;
+ dlassq_(&i__1, work, &c__1, &dscale, &dsum);
+ dlacpy_("Full", &m, &m, t, &c__4, work, &m);
+ i__1 = m * m;
+ dlassq_(&i__1, work, &c__1, &dscale, &dsum);
+ dnorm = dscale * sqrt(dsum);
+ thresh = max(eps * 10. * dnorm, smlnum);
+
+ if (m == 2) {
+
+/* CASE 1: Swap 1-by-1 and 1-by-1 blocks. */
+
+/* Compute orthogonal QL and RQ that swap 1-by-1 and 1-by-1 blocks */
+/* using Givens rotations and perform the swap tentatively. */
+
+ f = s[5] * t[0] - t[5] * s[0];
+ g = s[5] * t[4] - t[5] * s[4];
+ sb = abs(t[5]);
+ sa = abs(s[5]);
+ dlartg_(&f, &g, &ir[4], ir, &ddum);
+ ir[1] = -ir[4];
+ ir[5] = ir[0];
+ drot_(&c__2, s, &c__1, &s[4], &c__1, ir, &ir[1]);
+ drot_(&c__2, t, &c__1, &t[4], &c__1, ir, &ir[1]);
+ if (sa >= sb) {
+ dlartg_(s, &s[1], li, &li[1], &ddum);
+ } else {
+ dlartg_(t, &t[1], li, &li[1], &ddum);
+ }
+ drot_(&c__2, s, &c__4, &s[1], &c__4, li, &li[1]);
+ drot_(&c__2, t, &c__4, &t[1], &c__4, li, &li[1]);
+ li[5] = li[0];
+ li[4] = -li[1];
+
+/* Weak stability test: */
+/* |S21| + |T21| <= O(EPS * F-norm((S, T))) */
+
+ ws = abs(s[1]) + abs(t[1]);
+ weak = ws <= thresh;
+ if (! weak) {
+ goto L70;
+ }
+
+ if (TRUE_) {
+
+/* Strong stability test: */
+/* F-norm((A-QL'*S*QR, B-QL'*T*QR)) <= O(EPS*F-norm((A,B))) */
+
+ dlacpy_("Full", &m, &m, &a[*j1 + *j1 * *lda], lda, &work[m*m], &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b38, li, &c__4, s, &c__4, &c_b3, work, &m);
+ dgemm_("N", "T", &m, &m, &m, &c_b44, work, &m, ir, &c__4, &c_b38, &work[m*m], &m);
+ dscale = 0.;
+ dsum = 1.;
+ i__1 = m * m;
+ dlassq_(&i__1, &work[m*m], &c__1, &dscale, &dsum);
+
+ dlacpy_("Full", &m, &m, &b[*j1 + *j1 * *ldb], ldb, &work[m*m], &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b38, li, &c__4, t, &c__4, &c_b3, work, &m);
+ dgemm_("N", "T", &m, &m, &m, &c_b44, work, &m, ir, &c__4, &c_b38, &work[m*m], &m);
+ i__1 = m * m;
+ dlassq_(&i__1, &work[m*m], &c__1, &dscale, &dsum);
+ ss = dscale * sqrt(dsum);
+ dtrong = ss <= thresh;
+ if (! dtrong) {
+ goto L70;
+ }
+ }
+
+/* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and */
+/* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)). */
+
+ i__1 = *j1 + 2;
+ drot_(&i__1, &a[*j1 * *lda], &c__1, &a[(*j1+1) * *lda], &c__1, ir, &ir[1]);
+ drot_(&i__1, &b[*j1 * *ldb], &c__1, &b[(*j1+1) * *ldb], &c__1, ir, &ir[1]);
+ i__1 = *n - *j1;
+ drot_(&i__1, &a[*j1 + *j1 * *lda], lda, &a[(*j1+1) + *j1 * *lda], lda, li, &li[1]);
+ drot_(&i__1, &b[*j1 + *j1 * *ldb], ldb, &b[(*j1+1) + *j1 * *ldb], ldb, li, &li[1]);
+
+/* Set N1-by-N2 (2,1) - blocks to ZERO. */
+
+ a[*j1+1 + *j1 * *lda] = 0.;
+ b[*j1+1 + *j1 * *ldb] = 0.;
+
+/* Accumulate transformations into Q and Z if requested. */
+
+ if (*wantz) {
+ drot_(n, &z[*j1 * *ldz], &c__1, &z[(*j1+1) * *ldz], &c__1, ir, &ir[1]);
+ }
+ if (*wantq) {
+ drot_(n, &q[*j1 * *ldq], &c__1, &q[(*j1+1) * *ldq], &c__1, li, &li[1]);
+ }
+ } else {
+
+/* CASE 2: Swap 1-by-1 and 2-by-2 blocks, or 2-by-2 */
+/* and 2-by-2 blocks. */
+
+/* Solve the generalized Sylvester equation */
+/* S11 * R - L * S22 = SCALE * S12 */
+/* T11 * R - L * T22 = SCALE * T12 */
+/* for R and L. Solutions in LI and IR. */
+
+ dlacpy_("Full", n1, n2, &t[4 * *n1], &c__4, li, &c__4);
+ dlacpy_("Full", n1, n2, &s[4 * *n1], &c__4, &ir[*n2 + 4 * *n1], &c__4);
+ dtgsy2_("N", &c__0, n1, n2, s, &c__4, &s[5 * *n1],
+ &c__4, &ir[*n2 + 4 * *n1], &c__4, t, &c__4,
+ &t[5 * *n1], &c__4, li, &c__4, &scale,
+ &dsum, &dscale, iwork, &idum, &linfo);
+
+/* Compute orthogonal matrix QL: */
+
+/* QL' * LI = [ TL ] */
+/* [ 0 ] */
+/* where */
+/* LI = [ -L ] */
+/* [ SCALE * identity(N2) ] */
+
+ for (i = 0; i < *n2; ++i) {
+ dscal_(n1, &c_b44, &li[4*i], &c__1);
+ li[*n1 + 5*i] = scale;
+ }
+ dgeqr2_(&m, n2, li, &c__4, taul, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+ dorg2r_(&m, &m, n2, li, &c__4, taul, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+
+/* Compute orthogonal matrix RQ: */
+
+/* IR * RQ' = [ 0 TR], */
+
+/* where IR = [ SCALE * identity(N1), R ] */
+
+ for (i = 0; i < *n1; ++i) {
+ ir[*n2 + 5*i] = scale;
+ }
+ dgerq2_(n1, &m, &ir[*n2], &c__4, taur, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+ dorgr2_(&m, &m, n1, ir, &c__4, taur, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+
+/* Perform the swapping tentatively: */
+
+ dgemm_("T", "N", &m, &m, &m, &c_b38, li, &c__4, s, &c__4, &c_b3, work, &m);
+ dgemm_("N", "T", &m, &m, &m, &c_b38, work, &m, ir, &c__4, &c_b3, s, &c__4);
+ dgemm_("T", "N", &m, &m, &m, &c_b38, li, &c__4, t, &c__4, &c_b3, work, &m);
+ dgemm_("N", "T", &m, &m, &m, &c_b38, work, &m, ir, &c__4, &c_b3, t, &c__4);
+ dlacpy_("F", &m, &m, s, &c__4, scpy, &c__4);
+ dlacpy_("F", &m, &m, t, &c__4, tcpy, &c__4);
+ dlacpy_("F", &m, &m, ir, &c__4, ircop, &c__4);
+ dlacpy_("F", &m, &m, li, &c__4, licop, &c__4);
+
+/* Triangularize the B-part by an RQ factorization. */
+/* Apply transformation (from left) to A-part, giving S. */
+
+ dgerq2_(&m, &m, t, &c__4, taur, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+ dormr2_("R", "T", &m, &m, &m, t, &c__4, taur, s, &c__4, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+ dormr2_("L", "N", &m, &m, &m, t, &c__4, taur, ir, &c__4, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+
+/* Compute F-norm(S21) in BRQA21. (T21 is 0.) */
+
+ dscale = 0.;
+ dsum = 1.;
+ for (i = 0; i < *n2; ++i) {
+ dlassq_(n1, &s[*n2 + 4*i], &c__1, &dscale, &dsum);
+ }
+ brqa21 = dscale * sqrt(dsum);
+
+/* Triangularize the B-part by a QR factorization. */
+/* Apply transformation (from right) to A-part, giving S. */
+
+ dgeqr2_(&m, &m, tcpy, &c__4, taul, work, &linfo);
+ if (linfo != 0) {
+ goto L70;
+ }
+ dorm2r_("L", "T", &m, &m, &m, tcpy, &c__4, taul, scpy, &c__4, work, info);
+ dorm2r_("R", "N", &m, &m, &m, tcpy, &c__4, taul, licop, &c__4, work, info);
+ if (linfo != 0) {
+ goto L70;
+ }
+
+/* Compute F-norm(S21) in BQRA21. (T21 is 0.) */
+
+ dscale = 0.;
+ dsum = 1.;
+ for (i = 0; i < *n2; ++i) {
+ dlassq_(n1, &scpy[*n2 + 4*i], &c__1, &dscale, &dsum);
+ }
+ bqra21 = dscale * sqrt(dsum);
+
+/* Decide which method to use. */
+/* Weak stability test: */
+/* F-norm(S21) <= O(EPS * F-norm((S, T))) */
+
+ if (bqra21 <= brqa21 && bqra21 <= thresh) {
+ dlacpy_("F", &m, &m, scpy, &c__4, s, &c__4);
+ dlacpy_("F", &m, &m, tcpy, &c__4, t, &c__4);
+ dlacpy_("F", &m, &m, ircop, &c__4, ir, &c__4);
+ dlacpy_("F", &m, &m, licop, &c__4, li, &c__4);
+ } else if (brqa21 >= thresh) {
+ goto L70;
+ }
+
+/* Set lower triangle of B-part to zero */
+
+ for (i = 1; i < m; ++i) {
+ i__1 = m - i;
+ dcopy_(&i__1, &c_b3, &c__0, &t[5*i-4], &c__1);
+ }
+
+ if (TRUE_) {
+
+/* Strong stability test: */
+/* F-norm((A-QL*S*QR', B-QL*T*QR')) <= O(EPS*F-norm((A,B))) */
+
+ dlacpy_("Full", &m, &m, &a[*j1 + *j1 * *lda], lda, &work[m*m], &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b38, li, &c__4, s, &c__4, &c_b3, work, &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b44, work, &m, ir, &c__4, &c_b38, &work[m*m], &m);
+ dscale = 0.;
+ dsum = 1.;
+ i__1 = m * m;
+ dlassq_(&i__1, &work[m*m], &c__1, &dscale, &dsum);
+
+ dlacpy_("Full", &m, &m, &b[*j1 + *j1 * *ldb], ldb, &work[m*m], &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b38, li, &c__4, t, &c__4, &c_b3, work, &m);
+ dgemm_("N", "N", &m, &m, &m, &c_b44, work, &m, ir, &c__4, &c_b38, &work[m*m], &m);
+ i__1 = m * m;
+ dlassq_(&i__1, &work[m*m], &c__1, &dscale, &dsum);
+ ss = dscale * sqrt(dsum);
+ dtrong = ss <= thresh;
+ if (! dtrong) {
+ goto L70;
+ }
+ }
+
+/* If the swap is accepted ("weakly" and "strongly"), apply the */
+/* transformations and set N1-by-N2 (2,1)-block to zero. */
+
+ for (i = 0; i < *n2; ++i) {
+ dcopy_(n1, &c_b3, &c__0, &s[*n2 + 4*i], &c__1);
+ }
+
+/* copy back M-by-M diagonal block starting at index J1 of (A, B) */
+
+ dlacpy_("F", &m, &m, s, &c__4, &a[*j1 + *j1 * *lda], lda);
+ dlacpy_("F", &m, &m, t, &c__4, &b[*j1 + *j1 * *ldb], ldb);
+ dcopy_(&c__16, &c_b3, &c__0, t, &c__1);
+
+/* Standardize existing 2-by-2 blocks. */
+
+ i__1 = m * m;
+ dcopy_(&i__1, &c_b3, &c__0, work, &c__1);
+ work[0] = 1.;
+ t[0] = 1.;
+ idum = *lwork - m * m - 2;
+ if (*n2 > 1) {
+ dlagv2_(&a[*j1 + *j1 * *lda], lda, &b[*j1 + *j1 * *ldb], ldb,
+ ar, ai, be, work, &work[1], t, &t[1]);
+ work[m] = -work[1];
+ work[m+1] = work[0];
+ t[5 * *n2 - 5] = t[0];
+ t[4] = -t[1];
+ }
+ work[m*m-1] = 1.;
+ t[5*m-5] = 1.;
+
+ if (*n1 > 1) {
+ dlagv2_(&a[(*j1 + *n2) * (*lda+1)], lda, &b[(*j1 + *n2) * (*ldb+1)], ldb,
+ taur, taul, &work[m*m], &work[*n2 * (m+1)], &work[*n2 * (m+1) + 1], &t[5 * *n2], &t[5*m-9]);
+ work[m * m - 1] = work[*n2 * m + *n2];
+ work[m * m - 2] = -work[*n2 * m + *n2 + 1];
+ t[5*m - 5] = t[5 * *n2];
+ t[5*m - 6] = -t[5*m - 9];
+ }
+ dgemm_("T", "N", n2, n1, n2, &c_b38, work, &m, &a[*j1 + (*j1 + * n2) * *lda], lda, &c_b3, &work[m*m], n2);
+ dlacpy_("Full", n2, n1, &work[m*m], n2, &a[*j1 + (*j1 + *n2) * *lda], lda);
+ dgemm_("T", "N", n2, n1, n2, &c_b38, work, &m, &b[*j1 + (*j1 + * n2) * *ldb], ldb, &c_b3, &work[m*m], n2);
+ dlacpy_("Full", n2, n1, &work[m*m], n2, &b[*j1 + (*j1 + *n2) * *ldb], ldb);
+ dgemm_("N", "N", &m, &m, &m, &c_b38, li, &c__4, work, &m, &c_b3, &work[m*m], &m);
+ dlacpy_("Full", &m, &m, &work[m*m], &m, li, &c__4);
+ dgemm_("N", "N", n2, n1, n1, &c_b38, &a[*j1 + (*j1 + *n2) * *lda], lda, &t[5 * *n2], &c__4, &c_b3, work, n2);
+ dlacpy_("Full", n2, n1, work, n2, &a[*j1 + (*j1 + *n2) * *lda], lda);
+ dgemm_("N", "N", n2, n1, n1, &c_b38, &b[*j1 + (*j1 + *n2) * *ldb], lda, &t[5 * *n2], &c__4, &c_b3, work, n2);
+ dlacpy_("Full", n2, n1, work, n2, &b[*j1 + (*j1 + *n2) * *ldb], ldb);
+ dgemm_("T", "N", &m, &m, &m, &c_b38, ir, &c__4, t, &c__4, &c_b3, work, &m);
+ dlacpy_("Full", &m, &m, work, &m, ir, &c__4);
+
+/* Accumulate transformations into Q and Z if requested. */
+
+ if (*wantq) {
+ dgemm_("N", "N", n, &m, &m, &c_b38, &q[*j1 * *ldq], ldq, li, &c__4, &c_b3, work, n);
+ dlacpy_("Full", n, &m, work, n, &q[*j1 * *ldq], ldq);
+ }
+
+ if (*wantz) {
+ dgemm_("N", "N", n, &m, &m, &c_b38, &z[*j1 * *ldz], ldz, ir, &c__4, &c_b3, work, n);
+ dlacpy_("Full", n, &m, work, n, &z[*j1 * *ldz], ldz);
+ }
+
+/* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and */
+/* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)). */
+
+ i = *j1 + m;
+ if (i < *n) {
+ i__1 = *n - i;
+ dgemm_("T", "N", &m, &i__1, &m, &c_b38, li, &c__4, &a[*j1 + i * *lda], lda, &c_b3, work, &m);
+ dlacpy_("Full", &m, &i__1, work, &m, &a[*j1 + i * *lda], lda);
+ dgemm_("T", "N", &m, &i__1, &m, &c_b38, li, &c__4, &b[*j1 + i * *ldb], lda, &c_b3, work, &m);
+ dlacpy_("Full", &m, &i__1, work, &m, &b[*j1 + i * *ldb], lda);
+ }
+ if (*j1 > 0) {
+ dgemm_("N", "N", j1, &m, &m, &c_b38, &a[*j1 * *lda], lda, ir, &c__4, &c_b3, work, j1);
+ dlacpy_("Full", j1, &m, work, j1, &a[*j1 * *lda], lda);
+ dgemm_("N", "N", j1, &m, &m, &c_b38, &b[*j1 * *ldb], ldb, ir, &c__4, &c_b3, work, j1);
+ dlacpy_("Full", j1, &m, work, j1, &b[*j1 * *ldb], ldb);
+ }
+ }
+
+/* Exit with INFO = 0 if swap was successfully performed. */
+
+ *info = 0;
+ /* Parameter adjustments */
+ *j1 += 1;
+ return;
+
+/* Exit with INFO = 1 if swap was rejected. */
+
+L70:
+ *info = 1;
+ /* Parameter adjustments */
+ *j1 += 1;
+
+} /* dtgex2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.f
new file mode 100644
index 0000000000000000000000000000000000000000..81b085e256c0e7ac19a0d3e7a5d2f538e92d0ac6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgex2.f
@@ -0,0 +1,582 @@
+ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, J1, N1, N2, WORK, LWORK, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ LOGICAL WANTQ, WANTZ
+ INTEGER INFO, J1, LDA, LDB, LDQ, LDZ, LWORK, N, N1, N2
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
+ $ WORK( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGEX2 swaps adjacent diagonal blocks (A11, B11) and (A22, B22)
+* of size 1-by-1 or 2-by-2 in an upper (quasi) triangular matrix pair
+* (A, B) by an orthogonal equivalence transformation.
+*
+* (A, B) must be in generalized real Schur canonical form (as returned
+* by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+* diagonal blocks. B is upper triangular.
+*
+* Optionally, the matrices Q and Z of generalized Schur vectors are
+* updated.
+*
+* Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+* Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+*
+*
+* Arguments
+* =========
+*
+* WANTQ (input) LOGICAL
+* .TRUE. : update the left transformation matrix Q;
+* .FALSE.: do not update Q.
+*
+* WANTZ (input) LOGICAL
+* .TRUE. : update the right transformation matrix Z;
+* .FALSE.: do not update Z.
+*
+* N (input) INTEGER
+* The order of the matrices A and B. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION arrays, dimensions (LDA,N)
+* On entry, the matrix A in the pair (A, B).
+* On exit, the updated matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION arrays, dimensions (LDB,N)
+* On entry, the matrix B in the pair (A, B).
+* On exit, the updated matrix B.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,N).
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+* On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+* On exit, the updated matrix Q.
+* Not referenced if WANTQ = .FALSE..
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= 1.
+* If WANTQ = .TRUE., LDQ >= N.
+*
+* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+* On entry, if WANTZ =.TRUE., the orthogonal matrix Z.
+* On exit, the updated matrix Z.
+* Not referenced if WANTZ = .FALSE..
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDZ >= 1.
+* If WANTZ = .TRUE., LDZ >= N.
+*
+* J1 (input) INTEGER
+* The index to the first block (A11, B11). 1 <= J1 <= N.
+*
+* N1 (input) INTEGER
+* The order of the first block (A11, B11). N1 = 0, 1 or 2.
+*
+* N2 (input) INTEGER
+* The order of the second block (A22, B22). N2 = 0, 1 or 2.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK).
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK.
+* LWORK >= MAX( N*(N2+N1), (N2+N1)*(N2+N1)*2 )
+*
+* INFO (output) INTEGER
+* =0: Successful exit
+* >0: If INFO = 1, the transformed matrix (A, B) would be
+* too far from generalized Schur form; the blocks are
+* not swapped and (A, B) and (Q, Z) are unchanged.
+* The problem of swapping is too ill-conditioned.
+* <0: If INFO = -16: LWORK is too small. Appropriate value
+* for LWORK is returned in WORK(1).
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* In the current code both weak and strong stability tests are
+* performed. The user can omit the strong stability test by changing
+* the internal logical parameter WANDS to .FALSE.. See ref. [2] for
+* details.
+*
+* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+* M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+*
+* [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+* Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+* Estimation: Theory, Algorithms and Software,
+* Report UMINF - 94.04, Department of Computing Science, Umea
+* University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+* Note 87. To appear in Numerical Algorithms, 1996.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ DOUBLE PRECISION TEN
+ PARAMETER ( TEN = 1.0D+01 )
+ INTEGER LDST
+ PARAMETER ( LDST = 4 )
+ LOGICAL WANDS
+ PARAMETER ( WANDS = .TRUE. )
+* ..
+* .. Local Scalars ..
+ LOGICAL DTRONG, WEAK
+ INTEGER I, IDUM, LINFO, M
+ DOUBLE PRECISION BQRA21, BRQA21, DDUM, DNORM, DSCALE, DSUM, EPS,
+ $ F, G, SA, SB, SCALE, SMLNUM, SS, THRESH, WS
+* ..
+* .. Local Arrays ..
+ INTEGER IWORK( LDST )
+ DOUBLE PRECISION AI( 2 ), AR( 2 ), BE( 2 ), IR( LDST, LDST ),
+ $ IRCOP( LDST, LDST ), LI( LDST, LDST ),
+ $ LICOP( LDST, LDST ), S( LDST, LDST ),
+ $ SCPY( LDST, LDST ), T( LDST, LDST ),
+ $ TAUL( LDST ), TAUR( LDST ), TCPY( LDST, LDST )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY, DGEMM, DGEQR2, DGERQ2, DLACPY, DLAGV2,
+ $ DLARTG, DLASSQ, DORG2R, DORGR2, DORM2R, DORMR2,
+ $ DROT, DSCAL, DTGSY2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.LE.1 .OR. N1.LE.0 .OR. N2.LE.0 )
+ $ RETURN
+ IF( N1.GT.N .OR. ( J1+N1 ).GT.N )
+ $ RETURN
+ M = N1 + N2
+ IF( LWORK.LT.MAX( N*M, M*M*2 ) ) THEN
+ INFO = -16
+ WORK( 1 ) = MAX( N*M, M*M*2 )
+ RETURN
+ END IF
+*
+ WEAK = .FALSE.
+ DTRONG = .FALSE.
+*
+* Make a local copy of selected block
+*
+ CALL DCOPY( LDST*LDST, ZERO, 0, LI, 1 )
+ CALL DCOPY( LDST*LDST, ZERO, 0, IR, 1 )
+ CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, S, LDST )
+ CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, T, LDST )
+*
+* Compute threshold for testing acceptance of swapping.
+*
+ EPS = DLAMCH( 'P' )
+ SMLNUM = DLAMCH( 'S' ) / EPS
+ DSCALE = ZERO
+ DSUM = ONE
+ CALL DLACPY( 'Full', M, M, S, LDST, WORK, M )
+ CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
+ CALL DLACPY( 'Full', M, M, T, LDST, WORK, M )
+ CALL DLASSQ( M*M, WORK, 1, DSCALE, DSUM )
+ DNORM = DSCALE*SQRT( DSUM )
+ THRESH = MAX( TEN*EPS*DNORM, SMLNUM )
+*
+ IF( M.EQ.2 ) THEN
+*
+* CASE 1: Swap 1-by-1 and 1-by-1 blocks.
+*
+* Compute orthogonal QL and RQ that swap 1-by-1 and 1-by-1 blocks
+* using Givens rotations and perform the swap tentatively.
+*
+ F = S( 2, 2 )*T( 1, 1 ) - T( 2, 2 )*S( 1, 1 )
+ G = S( 2, 2 )*T( 1, 2 ) - T( 2, 2 )*S( 1, 2 )
+ SB = ABS( T( 2, 2 ) )
+ SA = ABS( S( 2, 2 ) )
+ CALL DLARTG( F, G, IR( 1, 2 ), IR( 1, 1 ), DDUM )
+ IR( 2, 1 ) = -IR( 1, 2 )
+ IR( 2, 2 ) = IR( 1, 1 )
+ CALL DROT( 2, S( 1, 1 ), 1, S( 1, 2 ), 1, IR( 1, 1 ),
+ $ IR( 2, 1 ) )
+ CALL DROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ),
+ $ IR( 2, 1 ) )
+ IF( SA.GE.SB ) THEN
+ CALL DLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
+ $ DDUM )
+ ELSE
+ CALL DLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ),
+ $ DDUM )
+ END IF
+ CALL DROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ),
+ $ LI( 2, 1 ) )
+ CALL DROT( 2, T( 1, 1 ), LDST, T( 2, 1 ), LDST, LI( 1, 1 ),
+ $ LI( 2, 1 ) )
+ LI( 2, 2 ) = LI( 1, 1 )
+ LI( 1, 2 ) = -LI( 2, 1 )
+*
+* Weak stability test:
+* |S21| + |T21| <= O(EPS * F-norm((S, T)))
+*
+ WS = ABS( S( 2, 1 ) ) + ABS( T( 2, 1 ) )
+ WEAK = WS.LE.THRESH
+ IF( .NOT.WEAK )
+ $ GO TO 70
+*
+ IF( WANDS ) THEN
+*
+* Strong stability test:
+* F-norm((A-QL'*S*QR, B-QL'*T*QR)) <= O(EPS*F-norm((A,B)))
+*
+ CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
+ $ M )
+ CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
+ $ WORK( M*M+1 ), M )
+ DSCALE = ZERO
+ DSUM = ONE
+ CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
+*
+ CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
+ $ M )
+ CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
+ $ WORK( M*M+1 ), M )
+ CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
+ SS = DSCALE*SQRT( DSUM )
+ DTRONG = SS.LE.THRESH
+ IF( .NOT.DTRONG )
+ $ GO TO 70
+ END IF
+*
+* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
+* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
+*
+ CALL DROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, IR( 1, 1 ),
+ $ IR( 2, 1 ) )
+ CALL DROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, IR( 1, 1 ),
+ $ IR( 2, 1 ) )
+ CALL DROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA,
+ $ LI( 1, 1 ), LI( 2, 1 ) )
+ CALL DROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB,
+ $ LI( 1, 1 ), LI( 2, 1 ) )
+*
+* Set N1-by-N2 (2,1) - blocks to ZERO.
+*
+ A( J1+1, J1 ) = ZERO
+ B( J1+1, J1 ) = ZERO
+*
+* Accumulate transformations into Q and Z if requested.
+*
+ IF( WANTZ )
+ $ CALL DROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, IR( 1, 1 ),
+ $ IR( 2, 1 ) )
+ IF( WANTQ )
+ $ CALL DROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, LI( 1, 1 ),
+ $ LI( 2, 1 ) )
+*
+* Exit with INFO = 0 if swap was successfully performed.
+*
+ RETURN
+*
+ ELSE
+*
+* CASE 2: Swap 1-by-1 and 2-by-2 blocks, or 2-by-2
+* and 2-by-2 blocks.
+*
+* Solve the generalized Sylvester equation
+* S11 * R - L * S22 = SCALE * S12
+* T11 * R - L * T22 = SCALE * T12
+* for R and L. Solutions in LI and IR.
+*
+ CALL DLACPY( 'Full', N1, N2, T( 1, N1+1 ), LDST, LI, LDST )
+ CALL DLACPY( 'Full', N1, N2, S( 1, N1+1 ), LDST,
+ $ IR( N2+1, N1+1 ), LDST )
+ CALL DTGSY2( 'N', 0, N1, N2, S, LDST, S( N1+1, N1+1 ), LDST,
+ $ IR( N2+1, N1+1 ), LDST, T, LDST, T( N1+1, N1+1 ),
+ $ LDST, LI, LDST, SCALE, DSUM, DSCALE, IWORK, IDUM,
+ $ LINFO )
+*
+* Compute orthogonal matrix QL:
+*
+* QL' * LI = [ TL ]
+* [ 0 ]
+* where
+* LI = [ -L ]
+* [ SCALE * identity(N2) ]
+*
+ DO 10 I = 1, N2
+ CALL DSCAL( N1, -ONE, LI( 1, I ), 1 )
+ LI( N1+I, I ) = SCALE
+ 10 CONTINUE
+ CALL DGEQR2( M, N2, LI, LDST, TAUL, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+ CALL DORG2R( M, M, N2, LI, LDST, TAUL, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+*
+* Compute orthogonal matrix RQ:
+*
+* IR * RQ' = [ 0 TR],
+*
+* where IR = [ SCALE * identity(N1), R ]
+*
+ DO 20 I = 1, N1
+ IR( N2+I, I ) = SCALE
+ 20 CONTINUE
+ CALL DGERQ2( N1, M, IR( N2+1, 1 ), LDST, TAUR, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+ CALL DORGR2( M, M, N1, IR, LDST, TAUR, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+*
+* Perform the swapping tentatively:
+*
+ CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S,
+ $ LDST )
+ CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T,
+ $ LDST )
+ CALL DLACPY( 'F', M, M, S, LDST, SCPY, LDST )
+ CALL DLACPY( 'F', M, M, T, LDST, TCPY, LDST )
+ CALL DLACPY( 'F', M, M, IR, LDST, IRCOP, LDST )
+ CALL DLACPY( 'F', M, M, LI, LDST, LICOP, LDST )
+*
+* Triangularize the B-part by an RQ factorization.
+* Apply transformation (from left) to A-part, giving S.
+*
+ CALL DGERQ2( M, M, T, LDST, TAUR, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+ CALL DORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK,
+ $ LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+ CALL DORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK,
+ $ LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+*
+* Compute F-norm(S21) in BRQA21. (T21 is 0.)
+*
+ DSCALE = ZERO
+ DSUM = ONE
+ DO 30 I = 1, N2
+ CALL DLASSQ( N1, S( N2+1, I ), 1, DSCALE, DSUM )
+ 30 CONTINUE
+ BRQA21 = DSCALE*SQRT( DSUM )
+*
+* Triangularize the B-part by a QR factorization.
+* Apply transformation (from right) to A-part, giving S.
+*
+ CALL DGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+ CALL DORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST,
+ $ WORK, INFO )
+ CALL DORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST,
+ $ WORK, INFO )
+ IF( LINFO.NE.0 )
+ $ GO TO 70
+*
+* Compute F-norm(S21) in BQRA21. (T21 is 0.)
+*
+ DSCALE = ZERO
+ DSUM = ONE
+ DO 40 I = 1, N2
+ CALL DLASSQ( N1, SCPY( N2+1, I ), 1, DSCALE, DSUM )
+ 40 CONTINUE
+ BQRA21 = DSCALE*SQRT( DSUM )
+*
+* Decide which method to use.
+* Weak stability test:
+* F-norm(S21) <= O(EPS * F-norm((S, T)))
+*
+ IF( BQRA21.LE.BRQA21 .AND. BQRA21.LE.THRESH ) THEN
+ CALL DLACPY( 'F', M, M, SCPY, LDST, S, LDST )
+ CALL DLACPY( 'F', M, M, TCPY, LDST, T, LDST )
+ CALL DLACPY( 'F', M, M, IRCOP, LDST, IR, LDST )
+ CALL DLACPY( 'F', M, M, LICOP, LDST, LI, LDST )
+ ELSE IF( BRQA21.GE.THRESH ) THEN
+ GO TO 70
+ END IF
+*
+* Set lower triangle of B-part to zero
+*
+ DO 50 I = 2, M
+ CALL DCOPY( M-I+1, ZERO, 0, T( I, I-1 ), 1 )
+ 50 CONTINUE
+*
+ IF( WANDS ) THEN
+*
+* Strong stability test:
+* F-norm((A-QL*S*QR', B-QL*T*QR')) <= O(EPS*F-norm((A,B)))
+*
+ CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ),
+ $ M )
+ CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
+ $ WORK( M*M+1 ), M )
+ DSCALE = ZERO
+ DSUM = ONE
+ CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
+*
+ CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ),
+ $ M )
+ CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO,
+ $ WORK, M )
+ CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE,
+ $ WORK( M*M+1 ), M )
+ CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM )
+ SS = DSCALE*SQRT( DSUM )
+ DTRONG = ( SS.LE.THRESH )
+ IF( .NOT.DTRONG )
+ $ GO TO 70
+*
+ END IF
+*
+* If the swap is accepted ("weakly" and "strongly"), apply the
+* transformations and set N1-by-N2 (2,1)-block to zero.
+*
+ DO 60 I = 1, N2
+ CALL DCOPY( N1, ZERO, 0, S( N2+1, I ), 1 )
+ 60 CONTINUE
+*
+* copy back M-by-M diagonal block starting at index J1 of (A, B)
+*
+ CALL DLACPY( 'F', M, M, S, LDST, A( J1, J1 ), LDA )
+ CALL DLACPY( 'F', M, M, T, LDST, B( J1, J1 ), LDB )
+ CALL DCOPY( LDST*LDST, ZERO, 0, T, 1 )
+*
+* Standardize existing 2-by-2 blocks.
+*
+ CALL DCOPY( M*M, ZERO, 0, WORK, 1 )
+ WORK( 1 ) = ONE
+ T( 1, 1 ) = ONE
+ IDUM = LWORK - M*M - 2
+ IF( N2.GT.1 ) THEN
+ CALL DLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE,
+ $ WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) )
+ WORK( M+1 ) = -WORK( 2 )
+ WORK( M+2 ) = WORK( 1 )
+ T( N2, N2 ) = T( 1, 1 )
+ T( 1, 2 ) = -T( 2, 1 )
+ END IF
+ WORK( M*M ) = ONE
+ T( M, M ) = ONE
+*
+ IF( N1.GT.1 ) THEN
+ CALL DLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB,
+ $ TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ),
+ $ WORK( N2*M+N2+2 ), T( N2+1, N2+1 ),
+ $ T( M, M-1 ) )
+ WORK( M*M ) = WORK( N2*M+N2+1 )
+ WORK( M*M-1 ) = -WORK( N2*M+N2+2 )
+ T( M, M ) = T( N2+1, N2+1 )
+ T( M-1, M ) = -T( M, M-1 )
+ END IF
+ CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ),
+ $ LDA, ZERO, WORK( M*M+1 ), N2 )
+ CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ),
+ $ LDA )
+ CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ),
+ $ LDB, ZERO, WORK( M*M+1 ), N2 )
+ CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ),
+ $ LDB )
+ CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO,
+ $ WORK( M*M+1 ), M )
+ CALL DLACPY( 'Full', M, M, WORK( M*M+1 ), M, LI, LDST )
+ CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, A( J1, J1+N2 ), LDA,
+ $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
+ CALL DLACPY( 'Full', N2, N1, WORK, N2, A( J1, J1+N2 ), LDA )
+ CALL DGEMM( 'N', 'N', N2, N1, N1, ONE, B( J1, J1+N2 ), LDA,
+ $ T( N2+1, N2+1 ), LDST, ZERO, WORK, N2 )
+ CALL DLACPY( 'Full', N2, N1, WORK, N2, B( J1, J1+N2 ), LDB )
+ CALL DGEMM( 'T', 'N', M, M, M, ONE, IR, LDST, T, LDST, ZERO,
+ $ WORK, M )
+ CALL DLACPY( 'Full', M, M, WORK, M, IR, LDST )
+*
+* Accumulate transformations into Q and Z if requested.
+*
+ IF( WANTQ ) THEN
+ CALL DGEMM( 'N', 'N', N, M, M, ONE, Q( 1, J1 ), LDQ, LI,
+ $ LDST, ZERO, WORK, N )
+ CALL DLACPY( 'Full', N, M, WORK, N, Q( 1, J1 ), LDQ )
+*
+ END IF
+*
+ IF( WANTZ ) THEN
+ CALL DGEMM( 'N', 'N', N, M, M, ONE, Z( 1, J1 ), LDZ, IR,
+ $ LDST, ZERO, WORK, N )
+ CALL DLACPY( 'Full', N, M, WORK, N, Z( 1, J1 ), LDZ )
+*
+ END IF
+*
+* Update (A(J1:J1+M-1, M+J1:N), B(J1:J1+M-1, M+J1:N)) and
+* (A(1:J1-1, J1:J1+M), B(1:J1-1, J1:J1+M)).
+*
+ I = J1 + M
+ IF( I.LE.N ) THEN
+ CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
+ $ A( J1, I ), LDA, ZERO, WORK, M )
+ CALL DLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA )
+ CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST,
+ $ B( J1, I ), LDA, ZERO, WORK, M )
+ CALL DLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDA )
+ END IF
+ I = J1 - 1
+ IF( I.GT.0 ) THEN
+ CALL DGEMM( 'N', 'N', I, M, M, ONE, A( 1, J1 ), LDA, IR,
+ $ LDST, ZERO, WORK, I )
+ CALL DLACPY( 'Full', I, M, WORK, I, A( 1, J1 ), LDA )
+ CALL DGEMM( 'N', 'N', I, M, M, ONE, B( 1, J1 ), LDB, IR,
+ $ LDST, ZERO, WORK, I )
+ CALL DLACPY( 'Full', I, M, WORK, I, B( 1, J1 ), LDB )
+ END IF
+*
+* Exit with INFO = 0 if swap was successfully performed.
+*
+ RETURN
+*
+ END IF
+*
+* Exit with INFO = 1 if swap was rejected.
+*
+ 70 CONTINUE
+*
+ INFO = 1
+ RETURN
+*
+* End of DTGEX2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.c
new file mode 100644
index 0000000000000000000000000000000000000000..197ada7932970094eec157b571008e63d37d27fd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.c
@@ -0,0 +1,467 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__2 = 2;
+
+/* Subroutine */ void dtgexc_(wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, work, lwork, info)
+logical *wantq, *wantz;
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *q;
+integer *ldq;
+doublereal *z;
+integer *ldz, *ifst, *ilst;
+doublereal *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, z_dim1, z_offset, i__1;
+
+ /* Local variables */
+ static integer here, lwmin;
+ static integer nbnext;
+ static logical lquery;
+ static integer nbf, nbl;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+
+/* DTGEXC reorders the generalized real Schur decomposition of a real */
+/* matrix pair (A,B) using an orthogonal equivalence transformation */
+
+/* (A, B) = Q * (A, B) * Z', */
+
+/* so that the diagonal block of (A, B) with row index IFST is moved */
+/* to row ILST. */
+
+/* (A, B) must be in generalized real Schur canonical form (as returned */
+/* by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2 */
+/* diagonal blocks. B is upper triangular. */
+
+/* Optionally, the matrices Q and Z of generalized Schur vectors are */
+/* updated. */
+
+/* Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)' */
+/* Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)' */
+
+
+/* Arguments */
+/* ========= */
+
+/* WANTQ (input) LOGICAL */
+/* .TRUE. : update the left transformation matrix Q; */
+/* .FALSE.: do not update Q. */
+
+/* WANTZ (input) LOGICAL */
+/* .TRUE. : update the right transformation matrix Z; */
+/* .FALSE.: do not update Z. */
+
+/* N (input) INTEGER */
+/* The order of the matrices A and B. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the matrix A in generalized real Schur canonical */
+/* form. */
+/* On exit, the updated matrix A, again in generalized */
+/* real Schur canonical form. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On entry, the matrix B in generalized real Schur canonical */
+/* form (A,B). */
+/* On exit, the updated matrix B, again in generalized */
+/* real Schur canonical form (A,B). */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N) */
+/* On entry, if WANTQ = .TRUE., the orthogonal matrix Q. */
+/* On exit, the updated matrix Q. */
+/* If WANTQ = .FALSE., Q is not referenced. */
+
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= 1. */
+/* If WANTQ = .TRUE., LDQ >= N. */
+
+/* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) */
+/* On entry, if WANTZ = .TRUE., the orthogonal matrix Z. */
+/* On exit, the updated matrix Z. */
+/* If WANTZ = .FALSE., Z is not referenced. */
+
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDZ >= 1. */
+/* If WANTZ = .TRUE., LDZ >= N. */
+
+/* IFST (input/output) INTEGER */
+/* ILST (input/output) INTEGER */
+/* Specify the reordering of the diagonal blocks of (A, B). */
+/* The block with row index IFST is moved to row ILST, by a */
+/* sequence of swapping between adjacent blocks. */
+/* On exit, if IFST pointed on entry to the second row of */
+/* a 2-by-2 block, it is changed to point to the first row; */
+/* ILST always points to the first row of the block in its */
+/* final position (which may differ from its input value by */
+/* +1 or -1). 1 <= IFST, ILST <= N. */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= 4*N + 16. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* =0: successful exit. */
+/* <0: if INFO = -i, the i-th argument had an illegal value. */
+/* =1: The transformed matrix pair (A, B) would be too far */
+/* from generalized Schur form; the problem is ill- */
+/* conditioned. (A, B) may have been partially reordered, */
+/* and ILST points to the first row of the current */
+/* position of the block being moved. */
+
+/* Further Details */
+/* =============== */
+
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+
+/* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the */
+/* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in */
+/* M.S. Moonen et al (eds), Linear Algebra for Large Scale and */
+/* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z -= z_offset;
+ --work;
+
+/* Decode and test input arguments. */
+
+ *info = 0;
+ lwmin = max(1, (*n << 2) + 16);
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldb < max(1,*n)) {
+ *info = -7;
+ } else if (*ldq < 1 || (*wantq && *ldq < max(1,*n))) {
+ *info = -9;
+ } else if (*ldz < 1 || (*wantz && *ldz < max(1,*n))) {
+ *info = -11;
+ } else if (*ifst < 1 || *ifst > *n) {
+ *info = -12;
+ } else if (*ilst < 1 || *ilst > *n) {
+ *info = -13;
+ } else if (*lwork < lwmin && ! lquery) {
+ *info = -15;
+ }
+
+ if (*info == 0) {
+ work[1] = (doublereal) lwmin;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGEXC", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ return;
+ }
+
+/* Determine the first row of the specified block and find out */
+/* if it is 1-by-1 or 2-by-2. */
+
+ if (*ifst > 1) {
+ if (a[*ifst + (*ifst - 1) * a_dim1] != 0.) {
+ --(*ifst);
+ }
+ }
+ nbf = 1;
+ if (*ifst < *n) {
+ if (a[*ifst + 1 + *ifst * a_dim1] != 0.) {
+ nbf = 2;
+ }
+ }
+
+/* Determine the first row of the final block */
+/* and find out if it is 1-by-1 or 2-by-2. */
+
+ if (*ilst > 1) {
+ if (a[*ilst + (*ilst - 1) * a_dim1] != 0.) {
+ --(*ilst);
+ }
+ }
+ nbl = 1;
+ if (*ilst < *n) {
+ if (a[*ilst + 1 + *ilst * a_dim1] != 0.) {
+ nbl = 2;
+ }
+ }
+ if (*ifst == *ilst) {
+ return;
+ }
+
+ if (*ifst < *ilst) {
+
+/* Update ILST. */
+
+ if (nbf == 2 && nbl == 1) {
+ --(*ilst);
+ }
+ if (nbf == 1 && nbl == 2) {
+ ++(*ilst);
+ }
+
+ here = *ifst;
+
+L10:
+
+/* Swap with next one below. */
+
+ if (nbf == 1 || nbf == 2) {
+
+/* Current block either 1-by-1 or 2-by-2. */
+
+ nbnext = 1;
+ if (here + nbf + 1 <= *n) {
+ if (a[here + nbf + 1 + (here + nbf) * a_dim1] != 0.) {
+ nbnext = 2;
+ }
+ }
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb,
+ &q[q_offset], ldq, &z[z_offset], ldz, &here, &nbf, &nbnext, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ here += nbnext;
+
+/* Test if 2-by-2 block breaks into two 1-by-1 blocks. */
+
+ if (nbf == 2) {
+ if (a[here + 1 + here * a_dim1] == 0.) {
+ nbf = 3;
+ }
+ }
+ } else {
+
+/* Current block consists of two 1-by-1 blocks, each of which */
+/* must be swapped individually. */
+
+ nbnext = 1;
+ if (here + 3 <= *n) {
+ if (a[here + 3 + (here + 2) * a_dim1] != 0.) {
+ nbnext = 2;
+ }
+ }
+ i__1 = here + 1;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb,
+ &q[q_offset], ldq, &z[z_offset], ldz, &i__1, &c__1, &nbnext, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ if (nbnext == 1) {
+
+/* Swap two 1-by-1 blocks. */
+
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb,
+ &q[q_offset], ldq, &z[z_offset], ldz, &here, &c__1,
+ &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ ++here;
+
+ } else {
+
+/* Recompute NBNEXT in case of 2-by-2 split. */
+
+ if (a[here + 2 + (here + 1) * a_dim1] == 0.) {
+ nbnext = 1;
+ }
+ if (nbnext == 2) {
+
+/* 2-by-2 block did not split. */
+
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &c__1, &nbnext, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ here += 2;
+ } else {
+
+/* 2-by-2 block did split. */
+
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &c__1, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ ++here;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &c__1, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ ++here;
+ }
+ }
+ }
+ if (here < *ilst) {
+ goto L10;
+ }
+ } else {
+ here = *ifst;
+
+L20:
+
+/* Swap with next one below. */
+
+ if (nbf == 1 || nbf == 2) {
+
+/* Current block either 1-by-1 or 2-by-2. */
+
+ nbnext = 1;
+ if (here >= 3) {
+ if (a[here - 1 + (here - 2) * a_dim1] != 0.) {
+ nbnext = 2;
+ }
+ }
+ i__1 = here - nbnext;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &i__1, &nbnext, &nbf, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ here -= nbnext;
+
+/* Test if 2-by-2 block breaks into two 1-by-1 blocks. */
+
+ if (nbf == 2) {
+ if (a[here + 1 + here * a_dim1] == 0.) {
+ nbf = 3;
+ }
+ }
+
+ } else {
+
+/* Current block consists of two 1-by-1 blocks, each of which */
+/* must be swapped individually. */
+
+ nbnext = 1;
+ if (here >= 3) {
+ if (a[here - 1 + (here - 2) * a_dim1] != 0.) {
+ nbnext = 2;
+ }
+ }
+ i__1 = here - nbnext;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &i__1, &nbnext, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ if (nbnext == 1) {
+
+/* Swap two 1-by-1 blocks. */
+
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &nbnext, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ --here;
+ } else {
+
+/* Recompute NBNEXT in case of 2-by-2 split. */
+
+ if (a[here + (here - 1) * a_dim1] == 0.) {
+ nbnext = 1;
+ }
+ if (nbnext == 2) {
+
+/* 2-by-2 block did not split. */
+
+ i__1 = here - 1;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &i__1, &c__2, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ here += -2;
+ } else {
+
+/* 2-by-2 block did split. */
+
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &c__1, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ --here;
+ dtgex2_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset], ldb, &q[q_offset], ldq,
+ &z[z_offset], ldz, &here, &c__1, &c__1, &work[1], lwork, info);
+ if (*info != 0) {
+ *ilst = here;
+ return;
+ }
+ --here;
+ }
+ }
+ }
+ if (here > *ilst) {
+ goto L20;
+ }
+ }
+ *ilst = here;
+ work[1] = (doublereal) lwmin;
+} /* dtgexc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.f
new file mode 100644
index 0000000000000000000000000000000000000000..169f0467ee0e1b4c41c3d696d68a2ef80f7354ec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgexc.f
@@ -0,0 +1,434 @@
+ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, IFST, ILST, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ LOGICAL WANTQ, WANTZ
+ INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
+ $ WORK( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGEXC reorders the generalized real Schur decomposition of a real
+* matrix pair (A,B) using an orthogonal equivalence transformation
+*
+* (A, B) = Q * (A, B) * Z',
+*
+* so that the diagonal block of (A, B) with row index IFST is moved
+* to row ILST.
+*
+* (A, B) must be in generalized real Schur canonical form (as returned
+* by DGGES), i.e. A is block upper triangular with 1-by-1 and 2-by-2
+* diagonal blocks. B is upper triangular.
+*
+* Optionally, the matrices Q and Z of generalized Schur vectors are
+* updated.
+*
+* Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
+* Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
+*
+*
+* Arguments
+* =========
+*
+* WANTQ (input) LOGICAL
+* .TRUE. : update the left transformation matrix Q;
+* .FALSE.: do not update Q.
+*
+* WANTZ (input) LOGICAL
+* .TRUE. : update the right transformation matrix Z;
+* .FALSE.: do not update Z.
+*
+* N (input) INTEGER
+* The order of the matrices A and B. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the matrix A in generalized real Schur canonical
+* form.
+* On exit, the updated matrix A, again in generalized
+* real Schur canonical form.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+* On entry, the matrix B in generalized real Schur canonical
+* form (A,B).
+* On exit, the updated matrix B, again in generalized
+* real Schur canonical form (A,B).
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,N).
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+* On entry, if WANTQ = .TRUE., the orthogonal matrix Q.
+* On exit, the updated matrix Q.
+* If WANTQ = .FALSE., Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= 1.
+* If WANTQ = .TRUE., LDQ >= N.
+*
+* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+* On entry, if WANTZ = .TRUE., the orthogonal matrix Z.
+* On exit, the updated matrix Z.
+* If WANTZ = .FALSE., Z is not referenced.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDZ >= 1.
+* If WANTZ = .TRUE., LDZ >= N.
+*
+* IFST (input/output) INTEGER
+* ILST (input/output) INTEGER
+* Specify the reordering of the diagonal blocks of (A, B).
+* The block with row index IFST is moved to row ILST, by a
+* sequence of swapping between adjacent blocks.
+* On exit, if IFST pointed on entry to the second row of
+* a 2-by-2 block, it is changed to point to the first row;
+* ILST always points to the first row of the block in its
+* final position (which may differ from its input value by
+* +1 or -1). 1 <= IFST, ILST <= N.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= 4*N + 16.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* =0: successful exit.
+* <0: if INFO = -i, the i-th argument had an illegal value.
+* =1: The transformed matrix pair (A, B) would be too far
+* from generalized Schur form; the problem is ill-
+* conditioned. (A, B) may have been partially reordered,
+* and ILST points to the first row of the current
+* position of the block being moved.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+* M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY
+ INTEGER HERE, LWMIN, NBF, NBL, NBNEXT
+* ..
+* .. External Subroutines ..
+ EXTERNAL DTGEX2, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Decode and test input arguments.
+*
+ INFO = 0
+ LWMIN = MAX( 1, 4*N+16 )
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
+ INFO = -9
+ ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
+ INFO = -11
+ ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
+ INFO = -12
+ ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
+ INFO = -13
+ ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+ INFO = -15
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LWMIN
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGEXC', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.1 )
+ $ RETURN
+*
+* Determine the first row of the specified block and find out
+* if it is 1-by-1 or 2-by-2.
+*
+ IF( IFST.GT.1 ) THEN
+ IF( A( IFST, IFST-1 ).NE.ZERO )
+ $ IFST = IFST - 1
+ END IF
+ NBF = 1
+ IF( IFST.LT.N ) THEN
+ IF( A( IFST+1, IFST ).NE.ZERO )
+ $ NBF = 2
+ END IF
+*
+* Determine the first row of the final block
+* and find out if it is 1-by-1 or 2-by-2.
+*
+ IF( ILST.GT.1 ) THEN
+ IF( A( ILST, ILST-1 ).NE.ZERO )
+ $ ILST = ILST - 1
+ END IF
+ NBL = 1
+ IF( ILST.LT.N ) THEN
+ IF( A( ILST+1, ILST ).NE.ZERO )
+ $ NBL = 2
+ END IF
+ IF( IFST.EQ.ILST )
+ $ RETURN
+*
+ IF( IFST.LT.ILST ) THEN
+*
+* Update ILST.
+*
+ IF( NBF.EQ.2 .AND. NBL.EQ.1 )
+ $ ILST = ILST - 1
+ IF( NBF.EQ.1 .AND. NBL.EQ.2 )
+ $ ILST = ILST + 1
+*
+ HERE = IFST
+*
+ 10 CONTINUE
+*
+* Swap with next one below.
+*
+ IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
+*
+* Current block either 1-by-1 or 2-by-2.
+*
+ NBNEXT = 1
+ IF( HERE+NBF+1.LE.N ) THEN
+ IF( A( HERE+NBF+1, HERE+NBF ).NE.ZERO )
+ $ NBNEXT = 2
+ END IF
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE, NBF, NBNEXT, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE + NBNEXT
+*
+* Test if 2-by-2 block breaks into two 1-by-1 blocks.
+*
+ IF( NBF.EQ.2 ) THEN
+ IF( A( HERE+1, HERE ).EQ.ZERO )
+ $ NBF = 3
+ END IF
+*
+ ELSE
+*
+* Current block consists of two 1-by-1 blocks, each of which
+* must be swapped individually.
+*
+ NBNEXT = 1
+ IF( HERE+3.LE.N ) THEN
+ IF( A( HERE+3, HERE+2 ).NE.ZERO )
+ $ NBNEXT = 2
+ END IF
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE+1, 1, NBNEXT, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ IF( NBNEXT.EQ.1 ) THEN
+*
+* Swap two 1-by-1 blocks.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE, 1, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE + 1
+*
+ ELSE
+*
+* Recompute NBNEXT in case of 2-by-2 split.
+*
+ IF( A( HERE+2, HERE+1 ).EQ.ZERO )
+ $ NBNEXT = 1
+ IF( NBNEXT.EQ.2 ) THEN
+*
+* 2-by-2 block did not split.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK,
+ $ INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE + 2
+ ELSE
+*
+* 2-by-2 block did split.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE + 1
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE + 1
+ END IF
+*
+ END IF
+ END IF
+ IF( HERE.LT.ILST )
+ $ GO TO 10
+ ELSE
+ HERE = IFST
+*
+ 20 CONTINUE
+*
+* Swap with next one below.
+*
+ IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
+*
+* Current block either 1-by-1 or 2-by-2.
+*
+ NBNEXT = 1
+ IF( HERE.GE.3 ) THEN
+ IF( A( HERE-1, HERE-2 ).NE.ZERO )
+ $ NBNEXT = 2
+ END IF
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE-NBNEXT, NBNEXT, NBF, WORK, LWORK,
+ $ INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE - NBNEXT
+*
+* Test if 2-by-2 block breaks into two 1-by-1 blocks.
+*
+ IF( NBF.EQ.2 ) THEN
+ IF( A( HERE+1, HERE ).EQ.ZERO )
+ $ NBF = 3
+ END IF
+*
+ ELSE
+*
+* Current block consists of two 1-by-1 blocks, each of which
+* must be swapped individually.
+*
+ NBNEXT = 1
+ IF( HERE.GE.3 ) THEN
+ IF( A( HERE-1, HERE-2 ).NE.ZERO )
+ $ NBNEXT = 2
+ END IF
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE-NBNEXT, NBNEXT, 1, WORK, LWORK,
+ $ INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ IF( NBNEXT.EQ.1 ) THEN
+*
+* Swap two 1-by-1 blocks.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
+ $ LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE - 1
+ ELSE
+*
+* Recompute NBNEXT in case of 2-by-2 split.
+*
+ IF( A( HERE, HERE-1 ).EQ.ZERO )
+ $ NBNEXT = 1
+ IF( NBNEXT.EQ.2 ) THEN
+*
+* 2-by-2 block did not split.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE - 2
+ ELSE
+*
+* 2-by-2 block did split.
+*
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE - 1
+ CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
+ IF( INFO.NE.0 ) THEN
+ ILST = HERE
+ RETURN
+ END IF
+ HERE = HERE - 1
+ END IF
+ END IF
+ END IF
+ IF( HERE.GT.ILST )
+ $ GO TO 20
+ END IF
+ ILST = HERE
+ WORK( 1 ) = LWMIN
+ RETURN
+*
+* End of DTGEXC
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.c
new file mode 100644
index 0000000000000000000000000000000000000000..801f3d7e4b447e3c8279c715592fe594333efd85
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.c
@@ -0,0 +1,751 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__2 = 2;
+static doublereal c_b28 = 1.;
+
+/* Subroutine */ void dtgsen_(ijob, wantq, wantz, select, n, a, lda, b, ldb,
+ alphar, alphai, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork, info)
+integer *ijob;
+logical *wantq, *wantz, *select;
+integer *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *alphar, *alphai, *beta, *q;
+integer *ldq;
+doublereal *z;
+integer *ldz, *m;
+doublereal *pl, *pr, *dif, *work;
+integer *lwork, *iwork, *liwork, *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, z_dim1, z_offset, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer kase;
+ static logical pair;
+ static integer ierr;
+ static doublereal dsum;
+ static logical swap;
+ static integer i, k;
+ static logical wantd;
+ static integer lwmin;
+ static logical wantp;
+ static integer n1, n2;
+ static logical wantd1, wantd2;
+ static integer kk;
+ static doublereal dscale;
+ static integer ks;
+ static doublereal rdscal;
+ static integer liwmin;
+ static doublereal smlnum;
+ static integer mn2;
+ static logical lquery;
+ static integer ijb;
+ static doublereal eps;
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* DTGSEN reorders the generalized real Schur decomposition of a real */
+/* matrix pair (A, B) (in terms of an orthonormal equivalence trans- */
+/* formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues */
+/* appears in the leading diagonal blocks of the upper quasi-triangular */
+/* matrix A and the upper triangular B. The leading columns of Q and */
+/* Z form orthonormal bases of the corresponding left and right eigen- */
+/* spaces (deflating subspaces). (A, B) must be in generalized real */
+/* Schur canonical form (as returned by DGGES), i.e. A is block upper */
+/* triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper */
+/* triangular. */
+/* */
+/* DTGSEN also computes the generalized eigenvalues */
+/* */
+/* w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j) */
+/* */
+/* of the reordered matrix pair (A, B). */
+/* */
+/* Optionally, DTGSEN computes the estimates of reciprocal condition */
+/* numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11), */
+/* (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s) */
+/* between the matrix pairs (A11, B11) and (A22,B22) that correspond to */
+/* the selected cluster and the eigenvalues outside the cluster, resp., */
+/* and norms of "projections" onto left and right eigenspaces w.r.t. */
+/* the selected cluster in the (1,1)-block. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* IJOB (input) INTEGER */
+/* Specifies whether condition numbers are required for the */
+/* cluster of eigenvalues (PL and PR) or the deflating subspaces */
+/* (Difu and Difl): */
+/* =0: Only reorder w.r.t. SELECT. No extras. */
+/* =1: Reciprocal of norms of "projections" onto left and right */
+/* eigenspaces w.r.t. the selected cluster (PL and PR). */
+/* =2: Upper bounds on Difu and Difl. F-norm-based estimate */
+/* (DIF(1:2)). */
+/* =3: Estimate of Difu and Difl. 1-norm-based estimate */
+/* (DIF(1:2)). */
+/* About 5 times as expensive as IJOB = 2. */
+/* =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic */
+/* version to get it all. */
+/* =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above) */
+/* */
+/* WANTQ (input) LOGICAL */
+/* .TRUE. : update the left transformation matrix Q; */
+/* .FALSE.: do not update Q. */
+/* */
+/* WANTZ (input) LOGICAL */
+/* .TRUE. : update the right transformation matrix Z; */
+/* .FALSE.: do not update Z. */
+/* */
+/* SELECT (input) LOGICAL array, dimension (N) */
+/* SELECT specifies the eigenvalues in the selected cluster. */
+/* To select a real eigenvalue w(j), SELECT(j) must be set to */
+/* .TRUE.. To select a complex conjugate pair of eigenvalues */
+/* w(j) and w(j+1), corresponding to a 2-by-2 diagonal block, */
+/* either SELECT(j) or SELECT(j+1) or both must be set to */
+/* .TRUE.; a complex conjugate pair of eigenvalues must be */
+/* either both included in the cluster or both excluded. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrices A and B. N >= 0. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension(LDA,N) */
+/* On entry, the upper quasi-triangular matrix A, with (A, B) in */
+/* generalized real Schur canonical form. */
+/* On exit, A is overwritten by the reordered matrix A. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension(LDB,N) */
+/* On entry, the upper triangular matrix B, with (A, B) in */
+/* generalized real Schur canonical form. */
+/* On exit, B is overwritten by the reordered matrix B. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+/* */
+/* ALPHAR (output) DOUBLE PRECISION array, dimension (N) */
+/* ALPHAI (output) DOUBLE PRECISION array, dimension (N) */
+/* BETA (output) DOUBLE PRECISION array, dimension (N) */
+/* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will */
+/* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i */
+/* and BETA(j),j=1,...,N are the diagonals of the complex Schur */
+/* form (S,T) that would result if the 2-by-2 diagonal blocks of */
+/* the real generalized Schur form of (A,B) were further reduced */
+/* to triangular form using complex unitary transformations. */
+/* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if */
+/* positive, then the j-th and (j+1)-st eigenvalues are a */
+/* complex conjugate pair, with ALPHAI(j+1) negative. */
+/* */
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N) */
+/* On entry, if WANTQ = .TRUE., Q is an N-by-N matrix. */
+/* On exit, Q has been postmultiplied by the left orthogonal */
+/* transformation matrix which reorder (A, B); The leading M */
+/* columns of Q form orthonormal bases for the specified pair of */
+/* left eigenspaces (deflating subspaces). */
+/* If WANTQ = .FALSE., Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= 1; */
+/* and if WANTQ = .TRUE., LDQ >= N. */
+/* */
+/* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) */
+/* On entry, if WANTZ = .TRUE., Z is an N-by-N matrix. */
+/* On exit, Z has been postmultiplied by the left orthogonal */
+/* transformation matrix which reorder (A, B); The leading M */
+/* columns of Z form orthonormal bases for the specified pair of */
+/* left eigenspaces (deflating subspaces). */
+/* If WANTZ = .FALSE., Z is not referenced. */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDZ >= 1; */
+/* If WANTZ = .TRUE., LDZ >= N. */
+/* */
+/* M (output) INTEGER */
+/* The dimension of the specified pair of left and right eigen- */
+/* spaces (deflating subspaces). 0 <= M <= N. */
+/* */
+/* PL, PR (output) DOUBLE PRECISION */
+/* If IJOB = 1, 4 or 5, PL, PR are lower bounds on the */
+/* reciprocal of the norm of "projections" onto left and right */
+/* eigenspaces with respect to the selected cluster. */
+/* 0 < PL, PR <= 1. */
+/* If M = 0 or M = N, PL = PR = 1. */
+/* If IJOB = 0, 2 or 3, PL and PR are not referenced. */
+/* */
+/* DIF (output) DOUBLE PRECISION array, dimension (2). */
+/* If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl. */
+/* If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on */
+/* Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based */
+/* estimates of Difu and Difl. */
+/* If M = 0 or N, DIF(1:2) = F-norm([A, B]). */
+/* If IJOB = 0 or 1, DIF is not referenced. */
+/* */
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* IF IJOB = 0, WORK is not referenced. Otherwise, */
+/* on exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= 4*N+16. */
+/* If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)). */
+/* If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)). */
+/* */
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+/* */
+/* IWORK (workspace/output) INTEGER array, dimension (LIWORK) */
+/* IF IJOB = 0, IWORK is not referenced. Otherwise, */
+/* on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. */
+/* */
+/* LIWORK (input) INTEGER */
+/* The dimension of the array IWORK. LIWORK >= 1. */
+/* If IJOB = 1, 2 or 4, LIWORK >= N+6. */
+/* If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6). */
+/* */
+/* If LIWORK = -1, then a workspace query is assumed; the */
+/* routine only calculates the optimal size of the IWORK array, */
+/* returns this value as the first entry of the IWORK array, and */
+/* no error message related to LIWORK is issued by XERBLA. */
+/* */
+/* INFO (output) INTEGER */
+/* =0: Successful exit. */
+/* <0: If INFO = -i, the i-th argument had an illegal value. */
+/* =1: Reordering of (A, B) failed because the transformed */
+/* matrix pair (A, B) would be too far from generalized */
+/* Schur form; the problem is very ill-conditioned. */
+/* (A, B) may have been partially reordered. */
+/* If requested, 0 is returned in DIF(*), PL and PR. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* DTGSEN first collects the selected eigenvalues by computing */
+/* orthogonal U and W that move them to the top left corner of (A, B). */
+/* In other words, the selected eigenvalues are the eigenvalues of */
+/* (A11, B11) in: */
+/* */
+/* U'*(A, B)*W = (A11 A12) (B11 B12) n1 */
+/* ( 0 A22),( 0 B22) n2 */
+/* n1 n2 n1 n2 */
+/* */
+/* where N = n1+n2 and U' means the transpose of U. The first n1 columns */
+/* of U and W span the specified pair of left and right eigenspaces */
+/* (deflating subspaces) of (A, B). */
+/* */
+/* If (A, B) has been obtained from the generalized real Schur */
+/* decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the */
+/* reordered generalized real Schur form of (C, D) is given by */
+/* */
+/* (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)', */
+/* */
+/* and the first n1 columns of Q*U and Z*W span the corresponding */
+/* deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.). */
+/* */
+/* Note that if the selected eigenvalue is sufficiently ill-conditioned, */
+/* then its value may differ significantly from its value before */
+/* reordering. */
+/* */
+/* The reciprocal condition numbers of the left and right eigenspaces */
+/* spanned by the first n1 columns of U and W (or Q*U and Z*W) may */
+/* be returned in DIF(1:2), corresponding to Difu and Difl, resp. */
+/* */
+/* The Difu and Difl are defined as: */
+/* */
+/* Difu[(A11, B11), (A22, B22)] = sigma-min( Zu ) */
+/* and */
+/* Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)], */
+/* */
+/* where sigma-min(Zu) is the smallest singular value of the */
+/* (2*n1*n2)-by-(2*n1*n2) matrix */
+/* */
+/* Zu = [ kron(In2, A11) -kron(A22', In1) ] */
+/* [ kron(In2, B11) -kron(B22', In1) ]. */
+/* */
+/* Here, Inx is the identity matrix of size nx and A22' is the */
+/* transpose of A22. kron(X, Y) is the Kronecker product between */
+/* the matrices X and Y. */
+/* */
+/* When DIF(2) is small, small changes in (A, B) can cause large changes */
+/* in the deflating subspace. An approximate (asymptotic) bound on the */
+/* maximum angular error in the computed deflating subspaces is */
+/* */
+/* EPS * norm((A, B)) / DIF(2), */
+/* */
+/* where EPS is the machine precision. */
+/* */
+/* The reciprocal norm of the projectors on the left and right */
+/* eigenspaces associated with (A11, B11) may be returned in PL and PR. */
+/* They are computed as follows. First we compute L and R so that */
+/* P*(A, B)*Q is block diagonal, where */
+/* */
+/* P = ( I -L ) n1 Q = ( I R ) n1 */
+/* ( 0 I ) n2 and ( 0 I ) n2 */
+/* n1 n2 n1 n2 */
+/* */
+/* and (L, R) is the solution to the generalized Sylvester equation */
+/* */
+/* A11*R - L*A22 = -A12 */
+/* B11*R - L*B22 = -B12 */
+/* */
+/* Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2). */
+/* An approximate (asymptotic) bound on the average absolute error of */
+/* the selected eigenvalues is */
+/* */
+/* EPS * norm((A, B)) / PL. */
+/* */
+/* There are also global error bounds which valid for perturbations up */
+/* to a certain restriction: A lower bound (x) on the smallest */
+/* F-norm(E,F) for which an eigenvalue of (A11, B11) may move and */
+/* coalesce with an eigenvalue of (A22, B22) under perturbation (E,F), */
+/* (i.e. (A + E, B + F), is */
+/* */
+/* x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)). */
+/* */
+/* An approximate bound on x can be computed from DIF(1:2), PL and PR. */
+/* */
+/* If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed */
+/* (L', R') and unperturbed (L, R) left and right deflating subspaces */
+/* associated with the selected cluster in the (1,1)-blocks can be */
+/* bounded as */
+/* */
+/* max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2)) */
+/* max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2)) */
+/* */
+/* See LAPACK User's Guide section 4.11 or the following references */
+/* for more information. */
+/* */
+/* Note that if the default method for computing the Frobenius-norm- */
+/* based estimate DIF is not wanted (see DLATDF), then the parameter */
+/* IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF */
+/* (IJOB = 2 will be used)). See DTGSYL for more details. */
+/* */
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+/* */
+/* References */
+/* ========== */
+/* */
+/* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the */
+/* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in */
+/* M.S. Moonen et al (eds), Linear Algebra for Large Scale and */
+/* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. */
+/* */
+/* [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified */
+/* Eigenvalues of a Regular Matrix Pair (A, B) and Condition */
+/* Estimation: Theory, Algorithms and Software, */
+/* Report UMINF - 94.04, Department of Computing Science, Umea */
+/* University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working */
+/* Note 87. To appear in Numerical Algorithms, 1996. */
+/* */
+/* [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software */
+/* for Solving the Generalized Sylvester Equation and Estimating the */
+/* Separation between Regular Matrix Pairs, Report UMINF - 93.23, */
+/* Department of Computing Science, Umea University, S-901 87 Umea, */
+/* Sweden, December 1993, Revised April 1994, Also as LAPACK Working */
+/* Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1, */
+/* 1996. */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ --select;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --alphar;
+ --alphai;
+ --beta;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z -= z_offset;
+ --dif;
+ --work;
+ --iwork;
+
+/* Decode and test the input parameters */
+
+ *info = 0;
+ lquery = *lwork == -1 || *liwork == -1;
+
+ if (*ijob < 0 || *ijob > 5) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,*n)) {
+ *info = -7;
+ } else if (*ldb < max(1,*n)) {
+ *info = -9;
+ } else if (*ldq < 1 || (*wantq && *ldq < *n)) {
+ *info = -14;
+ } else if (*ldz < 1 || (*wantz && *ldz < *n)) {
+ *info = -16;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGSEN", &i__1);
+ return;
+ }
+
+/* Get machine constants */
+
+ eps = dlamch_("P");
+ smlnum = dlamch_("S") / eps;
+ ierr = 0;
+
+ wantp = *ijob == 1 || *ijob >= 4;
+ wantd1 = *ijob == 2 || *ijob == 4;
+ wantd2 = *ijob == 3 || *ijob == 5;
+ wantd = wantd1 || wantd2;
+
+/* Set M to the dimension of the specified pair of deflating */
+/* subspaces. */
+
+ *m = 0;
+ pair = FALSE_;
+ for (k = 1; k <= *n; ++k) {
+ if (pair) {
+ pair = FALSE_;
+ } else {
+ if (k < *n) {
+ if (a[k + 1 + k * a_dim1] == 0.) {
+ if (select[k]) {
+ ++(*m);
+ }
+ } else {
+ pair = TRUE_;
+ if (select[k] || select[k + 1]) {
+ *m += 2;
+ }
+ }
+ } else {
+ if (select[*n]) {
+ ++(*m);
+ }
+ }
+ }
+ }
+
+ if (*ijob == 1 || *ijob == 2 || *ijob == 4) {
+ lwmin = max(max(1, (*n << 2) + 16), (*m << 1) * (*n - *m));
+ liwmin = max(1, *n + 6);
+ } else if (*ijob == 3 || *ijob == 5) {
+ lwmin = max(max(1, (*n << 2) + 16), (*m << 2) * (*n - *m));
+ liwmin = max(max(1, (*m << 1) * (*n - *m)), *n + 6);
+ } else {
+ lwmin = max(1,(*n << 2) + 16);
+ liwmin = 1;
+ }
+
+ work[1] = (doublereal) lwmin;
+ iwork[1] = liwmin;
+
+ if (*lwork < lwmin && ! lquery) {
+ *info = -22;
+ } else if (*liwork < liwmin && ! lquery) {
+ *info = -24;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGSEN", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == *n || *m == 0) {
+ if (wantp) {
+ *pl = 1.;
+ *pr = 1.;
+ }
+ if (wantd) {
+ dscale = 0.;
+ dsum = 1.;
+ for (i = 1; i <= *n; ++i) {
+ dlassq_(n, &a[i * a_dim1 + 1], &c__1, &dscale, &dsum);
+ dlassq_(n, &b[i * b_dim1 + 1], &c__1, &dscale, &dsum);
+ }
+ dif[1] = dscale * sqrt(dsum);
+ dif[2] = dif[1];
+ }
+ goto L60;
+ }
+
+/* Collect the selected blocks at the top-left corner of (A, B). */
+
+ ks = 0;
+ pair = FALSE_;
+ for (k = 1; k <= *n; ++k) {
+ if (pair) {
+ pair = FALSE_;
+ } else {
+
+ swap = select[k];
+ if (k < *n) {
+ if (a[k + 1 + k * a_dim1] != 0.) {
+ pair = TRUE_;
+ swap = swap || select[k + 1];
+ }
+ }
+
+ if (swap) {
+ ++ks;
+
+/* Swap the K-th block to position KS. */
+/* Perform the reordering of diagonal blocks in (A, B) */
+/* by orthogonal transformation matrices and update */
+/* Q and Z accordingly (if requested): */
+
+ kk = k;
+ if (k != ks) {
+ dtgexc_(wantq, wantz, n, &a[a_offset], lda, &b[b_offset],
+ ldb, &q[q_offset], ldq, &z[z_offset], ldz, &kk,
+ &ks, &work[1], lwork, &ierr);
+ }
+
+ if (ierr > 0) {
+
+/* Swap is rejected: exit. */
+
+ *info = 1;
+ if (wantp) {
+ *pl = 0.;
+ *pr = 0.;
+ }
+ if (wantd) {
+ dif[1] = 0.;
+ dif[2] = 0.;
+ }
+ goto L60;
+ }
+
+ if (pair) {
+ ++ks;
+ }
+ }
+ }
+ }
+ if (wantp) {
+
+/* Solve generalized Sylvester equation for R and L */
+/* and compute PL and PR. */
+
+ n1 = *m;
+ n2 = *n - *m;
+ i = n1 + 1;
+ ijb = 0;
+ dlacpy_("Full", &n1, &n2, &a[i * a_dim1 + 1], lda, &work[1], &n1);
+ dlacpy_("Full", &n1, &n2, &b[i * b_dim1 + 1], ldb, &work[n1 * n2 + 1], &n1);
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a[i + i * a_dim1], lda,
+ &work[1], &n1, &b[b_offset], ldb, &b[i + i * b_dim1], ldb,
+ &work[n1 * n2 + 1], &n1, &dscale, &dif[1],
+ &work[(n1 * n2 << 1) + 1], &i__1, &iwork[1], &ierr);
+
+/* Estimate the reciprocal of norms of "projections" onto left */
+/* and right eigenspaces. */
+
+ rdscal = 0.;
+ dsum = 1.;
+ i__1 = n1 * n2;
+ dlassq_(&i__1, &work[1], &c__1, &rdscal, &dsum);
+ *pl = rdscal * sqrt(dsum);
+ if (*pl == 0.) {
+ *pl = 1.;
+ } else {
+ *pl = dscale / (sqrt(dscale * dscale / *pl + *pl) * sqrt(*pl));
+ }
+ rdscal = 0.;
+ dsum = 1.;
+ i__1 = n1 * n2;
+ dlassq_(&i__1, &work[n1 * n2 + 1], &c__1, &rdscal, &dsum);
+ *pr = rdscal * sqrt(dsum);
+ if (*pr == 0.) {
+ *pr = 1.;
+ } else {
+ *pr = dscale / (sqrt(dscale * dscale / *pr + *pr) * sqrt(*pr));
+ }
+ }
+
+ if (wantd) {
+
+/* Compute estimates of Difu and Difl. */
+
+ if (wantd1) {
+ n1 = *m;
+ n2 = *n - *m;
+ i = n1 + 1;
+ ijb = 3;
+
+/* Frobenius norm-based Difu-estimate. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a[i + i * a_dim1], lda,
+ &work[1], &n1, &b[b_offset], ldb, &b[i + i * b_dim1], ldb,
+ &work[n1 * n2 + 1], &n1, &dscale, &dif[1], &work[(n1 << 1) * n2 + 1],
+ &i__1, &iwork[1], &ierr);
+
+/* Frobenius norm-based Difl-estimate. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("N", &ijb, &n2, &n1, &a[i + i * a_dim1], lda, &a[a_offset], lda,
+ &work[1], &n2, &b[i + i * b_dim1], ldb, &b[b_offset], ldb,
+ &work[n1 * n2 + 1], &n2, &dscale, &dif[2], &work[(n1 << 1) * n2 + 1],
+ &i__1, &iwork[1], &ierr);
+ } else {
+
+
+/* Compute 1-norm-based estimates of Difu and Difl using */
+/* reversed communication with DLACON. In each step a */
+/* generalized Sylvester equation or a transposed variant */
+/* is solved. */
+
+ kase = 0;
+ n1 = *m;
+ n2 = *n - *m;
+ i = n1 + 1;
+ ijb = 0;
+ mn2 = (n1 << 1) * n2;
+
+/* 1-norm-based estimate of Difu. */
+
+L40:
+ dlacon_(&mn2, &work[mn2 + 1], &work[1], &iwork[1], &dif[1], &kase);
+ if (kase != 0) {
+ if (kase == 1) {
+
+/* Solve generalized Sylvester equation. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("N", &ijb, &n1, &n2, &a[a_offset], lda, &a[i + i * a_dim1], lda,
+ &work[1], &n1, &b[b_offset], ldb, &b[i + i * b_dim1], ldb,
+ &work[n1 * n2 + 1], &n1, &dscale, &dif[1],
+ &work[(n1 << 1) * n2 + 1], &i__1, &iwork[1], &ierr);
+ } else {
+
+/* Solve the transposed variant. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("T", &ijb, &n1, &n2, &a[a_offset], lda, &a[i + i * a_dim1], lda,
+ &work[1], &n1, &b[b_offset], ldb, &b[i + i * b_dim1], ldb,
+ &work[n1 * n2 + 1], &n1, &dscale, &dif[1], &work[(n1 << 1) * n2 + 1],
+ &i__1, &iwork[1], &ierr);
+ }
+ goto L40;
+ }
+ dif[1] = dscale / dif[1];
+
+/* 1-norm-based estimate of Difl. */
+
+L50:
+ dlacon_(&mn2, &work[mn2 + 1], &work[1], &iwork[1], &dif[2], &kase);
+ if (kase != 0) {
+ if (kase == 1) {
+
+/* Solve generalized Sylvester equation. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("N", &ijb, &n2, &n1, &a[i + i * a_dim1], lda, &a[a_offset], lda,
+ &work[1], &n2, &b[i + i * b_dim1], ldb, &b[b_offset], ldb,
+ &work[n1 * n2 + 1], &n2, &dscale, &dif[2],
+ &work[(n1 << 1) * n2 + 1], &i__1, &iwork[1], &ierr);
+ } else {
+
+/* Solve the transposed variant. */
+
+ i__1 = *lwork - (n1 << 1) * n2;
+ dtgsyl_("T", &ijb, &n2, &n1, &a[i + i * a_dim1], lda, &a[a_offset], lda,
+ &work[1], &n2, &b[i + i * b_dim1], ldb, &b[b_offset], ldb,
+ &work[n1 * n2 + 1], &n2, &dscale, &dif[2],
+ &work[(n1 << 1) * n2 + 1], &i__1, &iwork[1], &ierr);
+ }
+ goto L50;
+ }
+ dif[2] = dscale / dif[2];
+ }
+ }
+
+L60:
+
+/* Compute generalized eigenvalues of reordered pair (A, B) and */
+/* normalize the generalized Schur form. */
+
+ pair = FALSE_;
+ for (k = 1; k <= *n; ++k) {
+ if (pair) {
+ pair = FALSE_;
+ } else {
+
+ if (k < *n) {
+ if (a[k + 1 + k * a_dim1] != 0.) {
+ pair = TRUE_;
+ }
+ }
+
+ if (pair) {
+
+/* Compute the eigenvalue(s) at position K. */
+
+ work[1] = a[k + k * a_dim1];
+ work[2] = a[k + 1 + k * a_dim1];
+ work[3] = a[k + (k + 1) * a_dim1];
+ work[4] = a[k + 1 + (k + 1) * a_dim1];
+ work[5] = b[k + k * b_dim1];
+ work[6] = b[k + 1 + k * b_dim1];
+ work[7] = b[k + (k + 1) * b_dim1];
+ work[8] = b[k + 1 + (k + 1) * b_dim1];
+ d__1 = smlnum * eps;
+ dlag2_(&work[1], &c__2, &work[5], &c__2, &d__1,
+ &beta[k], &beta[k + 1], &alphar[k], &alphar[k + 1], &alphai[k]);
+ alphai[k + 1] = -alphai[k];
+
+ } else {
+
+ if (d_sign(&c_b28, &b[k + k * b_dim1]) < 0.) {
+
+/* If B(K,K) is negative, make it positive */
+
+ for (i = 1; i <= *n; ++i) {
+ a[k + i * a_dim1] = -a[k + i * a_dim1];
+ b[k + i * b_dim1] = -b[k + i * b_dim1];
+ q[i + k * q_dim1] = -q[i + k * q_dim1];
+ }
+ }
+
+ alphar[k] = a[k + k * a_dim1];
+ alphai[k] = 0.;
+ beta[k] = b[k + k * b_dim1];
+ }
+ }
+ }
+
+ work[1] = (doublereal) lwmin;
+ iwork[1] = liwmin;
+
+} /* dtgsen_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.f
new file mode 100644
index 0000000000000000000000000000000000000000..417adfe93fccb5c4c84c1bd1266b7609849a9828
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsen.f
@@ -0,0 +1,718 @@
+ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB,
+ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL,
+ $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ LOGICAL WANTQ, WANTZ
+ INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
+ $ M, N
+ DOUBLE PRECISION PL, PR
+* ..
+* .. Array Arguments ..
+ LOGICAL SELECT( * )
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
+ $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
+ $ WORK( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGSEN reorders the generalized real Schur decomposition of a real
+* matrix pair (A, B) (in terms of an orthonormal equivalence trans-
+* formation Q' * (A, B) * Z), so that a selected cluster of eigenvalues
+* appears in the leading diagonal blocks of the upper quasi-triangular
+* matrix A and the upper triangular B. The leading columns of Q and
+* Z form orthonormal bases of the corresponding left and right eigen-
+* spaces (deflating subspaces). (A, B) must be in generalized real
+* Schur canonical form (as returned by DGGES), i.e. A is block upper
+* triangular with 1-by-1 and 2-by-2 diagonal blocks. B is upper
+* triangular.
+*
+* DTGSEN also computes the generalized eigenvalues
+*
+* w(j) = (ALPHAR(j) + i*ALPHAI(j))/BETA(j)
+*
+* of the reordered matrix pair (A, B).
+*
+* Optionally, DTGSEN computes the estimates of reciprocal condition
+* numbers for eigenvalues and eigenspaces. These are Difu[(A11,B11),
+* (A22,B22)] and Difl[(A11,B11), (A22,B22)], i.e. the separation(s)
+* between the matrix pairs (A11, B11) and (A22,B22) that correspond to
+* the selected cluster and the eigenvalues outside the cluster, resp.,
+* and norms of "projections" onto left and right eigenspaces w.r.t.
+* the selected cluster in the (1,1)-block.
+*
+* Arguments
+* =========
+*
+* IJOB (input) INTEGER
+* Specifies whether condition numbers are required for the
+* cluster of eigenvalues (PL and PR) or the deflating subspaces
+* (Difu and Difl):
+* =0: Only reorder w.r.t. SELECT. No extras.
+* =1: Reciprocal of norms of "projections" onto left and right
+* eigenspaces w.r.t. the selected cluster (PL and PR).
+* =2: Upper bounds on Difu and Difl. F-norm-based estimate
+* (DIF(1:2)).
+* =3: Estimate of Difu and Difl. 1-norm-based estimate
+* (DIF(1:2)).
+* About 5 times as expensive as IJOB = 2.
+* =4: Compute PL, PR and DIF (i.e. 0, 1 and 2 above): Economic
+* version to get it all.
+* =5: Compute PL, PR and DIF (i.e. 0, 1 and 3 above)
+*
+* WANTQ (input) LOGICAL
+* .TRUE. : update the left transformation matrix Q;
+* .FALSE.: do not update Q.
+*
+* WANTZ (input) LOGICAL
+* .TRUE. : update the right transformation matrix Z;
+* .FALSE.: do not update Z.
+*
+* SELECT (input) LOGICAL array, dimension (N)
+* SELECT specifies the eigenvalues in the selected cluster.
+* To select a real eigenvalue w(j), SELECT(j) must be set to
+* .TRUE.. To select a complex conjugate pair of eigenvalues
+* w(j) and w(j+1), corresponding to a 2-by-2 diagonal block,
+* either SELECT(j) or SELECT(j+1) or both must be set to
+* .TRUE.; a complex conjugate pair of eigenvalues must be
+* either both included in the cluster or both excluded.
+*
+* N (input) INTEGER
+* The order of the matrices A and B. N >= 0.
+*
+* A (input/output) DOUBLE PRECISION array, dimension(LDA,N)
+* On entry, the upper quasi-triangular matrix A, with (A, B) in
+* generalized real Schur canonical form.
+* On exit, A is overwritten by the reordered matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* B (input/output) DOUBLE PRECISION array, dimension(LDB,N)
+* On entry, the upper triangular matrix B, with (A, B) in
+* generalized real Schur canonical form.
+* On exit, B is overwritten by the reordered matrix B.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,N).
+*
+* ALPHAR (output) DOUBLE PRECISION array, dimension (N)
+* ALPHAI (output) DOUBLE PRECISION array, dimension (N)
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
+* be the generalized eigenvalues. ALPHAR(j) + ALPHAI(j)*i
+* and BETA(j),j=1,...,N are the diagonals of the complex Schur
+* form (S,T) that would result if the 2-by-2 diagonal blocks of
+* the real generalized Schur form of (A,B) were further reduced
+* to triangular form using complex unitary transformations.
+* If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
+* positive, then the j-th and (j+1)-st eigenvalues are a
+* complex conjugate pair, with ALPHAI(j+1) negative.
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+* On entry, if WANTQ = .TRUE., Q is an N-by-N matrix.
+* On exit, Q has been postmultiplied by the left orthogonal
+* transformation matrix which reorder (A, B); The leading M
+* columns of Q form orthonormal bases for the specified pair of
+* left eigenspaces (deflating subspaces).
+* If WANTQ = .FALSE., Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= 1;
+* and if WANTQ = .TRUE., LDQ >= N.
+*
+* Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+* On entry, if WANTZ = .TRUE., Z is an N-by-N matrix.
+* On exit, Z has been postmultiplied by the left orthogonal
+* transformation matrix which reorder (A, B); The leading M
+* columns of Z form orthonormal bases for the specified pair of
+* left eigenspaces (deflating subspaces).
+* If WANTZ = .FALSE., Z is not referenced.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDZ >= 1;
+* If WANTZ = .TRUE., LDZ >= N.
+*
+* M (output) INTEGER
+* The dimension of the specified pair of left and right eigen-
+* spaces (deflating subspaces). 0 <= M <= N.
+*
+* PL, PR (output) DOUBLE PRECISION
+* If IJOB = 1, 4 or 5, PL, PR are lower bounds on the
+* reciprocal of the norm of "projections" onto left and right
+* eigenspaces with respect to the selected cluster.
+* 0 < PL, PR <= 1.
+* If M = 0 or M = N, PL = PR = 1.
+* If IJOB = 0, 2 or 3, PL and PR are not referenced.
+*
+* DIF (output) DOUBLE PRECISION array, dimension (2).
+* If IJOB >= 2, DIF(1:2) store the estimates of Difu and Difl.
+* If IJOB = 2 or 4, DIF(1:2) are F-norm-based upper bounds on
+* Difu and Difl. If IJOB = 3 or 5, DIF(1:2) are 1-norm-based
+* estimates of Difu and Difl.
+* If M = 0 or N, DIF(1:2) = F-norm([A, B]).
+* If IJOB = 0 or 1, DIF is not referenced.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* IF IJOB = 0, WORK is not referenced. Otherwise,
+* on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= 4*N+16.
+* If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)).
+* If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)).
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+* IF IJOB = 0, IWORK is not referenced. Otherwise,
+* on exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+*
+* LIWORK (input) INTEGER
+* The dimension of the array IWORK. LIWORK >= 1.
+* If IJOB = 1, 2 or 4, LIWORK >= N+6.
+* If IJOB = 3 or 5, LIWORK >= MAX(2*M*(N-M), N+6).
+*
+* If LIWORK = -1, then a workspace query is assumed; the
+* routine only calculates the optimal size of the IWORK array,
+* returns this value as the first entry of the IWORK array, and
+* no error message related to LIWORK is issued by XERBLA.
+*
+* INFO (output) INTEGER
+* =0: Successful exit.
+* <0: If INFO = -i, the i-th argument had an illegal value.
+* =1: Reordering of (A, B) failed because the transformed
+* matrix pair (A, B) would be too far from generalized
+* Schur form; the problem is very ill-conditioned.
+* (A, B) may have been partially reordered.
+* If requested, 0 is returned in DIF(*), PL and PR.
+*
+* Further Details
+* ===============
+*
+* DTGSEN first collects the selected eigenvalues by computing
+* orthogonal U and W that move them to the top left corner of (A, B).
+* In other words, the selected eigenvalues are the eigenvalues of
+* (A11, B11) in:
+*
+* U'*(A, B)*W = (A11 A12) (B11 B12) n1
+* ( 0 A22),( 0 B22) n2
+* n1 n2 n1 n2
+*
+* where N = n1+n2 and U' means the transpose of U. The first n1 columns
+* of U and W span the specified pair of left and right eigenspaces
+* (deflating subspaces) of (A, B).
+*
+* If (A, B) has been obtained from the generalized real Schur
+* decomposition of a matrix pair (C, D) = Q*(A, B)*Z', then the
+* reordered generalized real Schur form of (C, D) is given by
+*
+* (C, D) = (Q*U)*(U'*(A, B)*W)*(Z*W)',
+*
+* and the first n1 columns of Q*U and Z*W span the corresponding
+* deflating subspaces of (C, D) (Q and Z store Q*U and Z*W, resp.).
+*
+* Note that if the selected eigenvalue is sufficiently ill-conditioned,
+* then its value may differ significantly from its value before
+* reordering.
+*
+* The reciprocal condition numbers of the left and right eigenspaces
+* spanned by the first n1 columns of U and W (or Q*U and Z*W) may
+* be returned in DIF(1:2), corresponding to Difu and Difl, resp.
+*
+* The Difu and Difl are defined as:
+*
+* Difu[(A11, B11), (A22, B22)] = sigma-min( Zu )
+* and
+* Difl[(A11, B11), (A22, B22)] = Difu[(A22, B22), (A11, B11)],
+*
+* where sigma-min(Zu) is the smallest singular value of the
+* (2*n1*n2)-by-(2*n1*n2) matrix
+*
+* Zu = [ kron(In2, A11) -kron(A22', In1) ]
+* [ kron(In2, B11) -kron(B22', In1) ].
+*
+* Here, Inx is the identity matrix of size nx and A22' is the
+* transpose of A22. kron(X, Y) is the Kronecker product between
+* the matrices X and Y.
+*
+* When DIF(2) is small, small changes in (A, B) can cause large changes
+* in the deflating subspace. An approximate (asymptotic) bound on the
+* maximum angular error in the computed deflating subspaces is
+*
+* EPS * norm((A, B)) / DIF(2),
+*
+* where EPS is the machine precision.
+*
+* The reciprocal norm of the projectors on the left and right
+* eigenspaces associated with (A11, B11) may be returned in PL and PR.
+* They are computed as follows. First we compute L and R so that
+* P*(A, B)*Q is block diagonal, where
+*
+* P = ( I -L ) n1 Q = ( I R ) n1
+* ( 0 I ) n2 and ( 0 I ) n2
+* n1 n2 n1 n2
+*
+* and (L, R) is the solution to the generalized Sylvester equation
+*
+* A11*R - L*A22 = -A12
+* B11*R - L*B22 = -B12
+*
+* Then PL = (F-norm(L)**2+1)**(-1/2) and PR = (F-norm(R)**2+1)**(-1/2).
+* An approximate (asymptotic) bound on the average absolute error of
+* the selected eigenvalues is
+*
+* EPS * norm((A, B)) / PL.
+*
+* There are also global error bounds which valid for perturbations up
+* to a certain restriction: A lower bound (x) on the smallest
+* F-norm(E,F) for which an eigenvalue of (A11, B11) may move and
+* coalesce with an eigenvalue of (A22, B22) under perturbation (E,F),
+* (i.e. (A + E, B + F), is
+*
+* x = min(Difu,Difl)/((1/(PL*PL)+1/(PR*PR))**(1/2)+2*max(1/PL,1/PR)).
+*
+* An approximate bound on x can be computed from DIF(1:2), PL and PR.
+*
+* If y = ( F-norm(E,F) / x) <= 1, the angles between the perturbed
+* (L', R') and unperturbed (L, R) left and right deflating subspaces
+* associated with the selected cluster in the (1,1)-blocks can be
+* bounded as
+*
+* max-angle(L, L') <= arctan( y * PL / (1 - y * (1 - PL * PL)**(1/2))
+* max-angle(R, R') <= arctan( y * PR / (1 - y * (1 - PR * PR)**(1/2))
+*
+* See LAPACK User's Guide section 4.11 or the following references
+* for more information.
+*
+* Note that if the default method for computing the Frobenius-norm-
+* based estimate DIF is not wanted (see DLATDF), then the parameter
+* IDIFJB (see below) should be changed from 3 to 4 (routine DLATDF
+* (IJOB = 2 will be used)). See DTGSYL for more details.
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* References
+* ==========
+*
+* [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
+* Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
+* M.S. Moonen et al (eds), Linear Algebra for Large Scale and
+* Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
+*
+* [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
+* Eigenvalues of a Regular Matrix Pair (A, B) and Condition
+* Estimation: Theory, Algorithms and Software,
+* Report UMINF - 94.04, Department of Computing Science, Umea
+* University, S-901 87 Umea, Sweden, 1994. Also as LAPACK Working
+* Note 87. To appear in Numerical Algorithms, 1996.
+*
+* [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+* for Solving the Generalized Sylvester Equation and Estimating the
+* Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+* Department of Computing Science, Umea University, S-901 87 Umea,
+* Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+* Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
+* 1996.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER IDIFJB
+ PARAMETER ( IDIFJB = 3 )
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, PAIR, SWAP, WANTD, WANTD1, WANTD2,
+ $ WANTP
+ INTEGER I, IERR, IJB, K, KASE, KK, KS, LIWMIN, LWMIN,
+ $ MN2, N1, N2
+ DOUBLE PRECISION DSCALE, DSUM, EPS, RDSCAL, SMLNUM
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLACON, DLACPY, DLAG2, DLASSQ, DTGEXC, DTGSYL,
+ $ XERBLA
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, SIGN, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Decode and test the input parameters
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
+*
+ IF( IJOB.LT.0 .OR. IJOB.GT.5 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -9
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -14
+ ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
+ INFO = -16
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGSEN', -INFO )
+ RETURN
+ END IF
+*
+* Get machine constants
+*
+ EPS = DLAMCH( 'P' )
+ SMLNUM = DLAMCH( 'S' ) / EPS
+ IERR = 0
+*
+ WANTP = IJOB.EQ.1 .OR. IJOB.GE.4
+ WANTD1 = IJOB.EQ.2 .OR. IJOB.EQ.4
+ WANTD2 = IJOB.EQ.3 .OR. IJOB.EQ.5
+ WANTD = WANTD1 .OR. WANTD2
+*
+* Set M to the dimension of the specified pair of deflating
+* subspaces.
+*
+ M = 0
+ PAIR = .FALSE.
+ DO 10 K = 1, N
+ IF( PAIR ) THEN
+ PAIR = .FALSE.
+ ELSE
+ IF( K.LT.N ) THEN
+ IF( A( K+1, K ).EQ.ZERO ) THEN
+ IF( SELECT( K ) )
+ $ M = M + 1
+ ELSE
+ PAIR = .TRUE.
+ IF( SELECT( K ) .OR. SELECT( K+1 ) )
+ $ M = M + 2
+ END IF
+ ELSE
+ IF( SELECT( N ) )
+ $ M = M + 1
+ END IF
+ END IF
+ 10 CONTINUE
+*
+ IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN
+ LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) )
+ LIWMIN = MAX( 1, N+6 )
+ ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN
+ LWMIN = MAX( 1, 4*N+16, 4*M*( N-M ) )
+ LIWMIN = MAX( 1, 2*M*( N-M ), N+6 )
+ ELSE
+ LWMIN = MAX( 1, 4*N+16 )
+ LIWMIN = 1
+ END IF
+*
+ WORK( 1 ) = LWMIN
+ IWORK( 1 ) = LIWMIN
+*
+ IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+ INFO = -22
+ ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
+ INFO = -24
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGSEN', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( M.EQ.N .OR. M.EQ.0 ) THEN
+ IF( WANTP ) THEN
+ PL = ONE
+ PR = ONE
+ END IF
+ IF( WANTD ) THEN
+ DSCALE = ZERO
+ DSUM = ONE
+ DO 20 I = 1, N
+ CALL DLASSQ( N, A( 1, I ), 1, DSCALE, DSUM )
+ CALL DLASSQ( N, B( 1, I ), 1, DSCALE, DSUM )
+ 20 CONTINUE
+ DIF( 1 ) = DSCALE*SQRT( DSUM )
+ DIF( 2 ) = DIF( 1 )
+ END IF
+ GO TO 60
+ END IF
+*
+* Collect the selected blocks at the top-left corner of (A, B).
+*
+ KS = 0
+ PAIR = .FALSE.
+ DO 30 K = 1, N
+ IF( PAIR ) THEN
+ PAIR = .FALSE.
+ ELSE
+*
+ SWAP = SELECT( K )
+ IF( K.LT.N ) THEN
+ IF( A( K+1, K ).NE.ZERO ) THEN
+ PAIR = .TRUE.
+ SWAP = SWAP .OR. SELECT( K+1 )
+ END IF
+ END IF
+*
+ IF( SWAP ) THEN
+ KS = KS + 1
+*
+* Swap the K-th block to position KS.
+* Perform the reordering of diagonal blocks in (A, B)
+* by orthogonal transformation matrices and update
+* Q and Z accordingly (if requested):
+*
+ KK = K
+ IF( K.NE.KS )
+ $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
+ $ Z, LDZ, KK, KS, WORK, LWORK, IERR )
+*
+ IF( IERR.GT.0 ) THEN
+*
+* Swap is rejected: exit.
+*
+ INFO = 1
+ IF( WANTP ) THEN
+ PL = ZERO
+ PR = ZERO
+ END IF
+ IF( WANTD ) THEN
+ DIF( 1 ) = ZERO
+ DIF( 2 ) = ZERO
+ END IF
+ GO TO 60
+ END IF
+*
+ IF( PAIR )
+ $ KS = KS + 1
+ END IF
+ END IF
+ 30 CONTINUE
+ IF( WANTP ) THEN
+*
+* Solve generalized Sylvester equation for R and L
+* and compute PL and PR.
+*
+ N1 = M
+ N2 = N - M
+ I = N1 + 1
+ IJB = 0
+ CALL DLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 )
+ CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ),
+ $ N1 )
+ CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
+ $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1,
+ $ DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ),
+ $ LWORK-2*N1*N2, IWORK, IERR )
+*
+* Estimate the reciprocal of norms of "projections" onto left
+* and right eigenspaces.
+*
+ RDSCAL = ZERO
+ DSUM = ONE
+ CALL DLASSQ( N1*N2, WORK, 1, RDSCAL, DSUM )
+ PL = RDSCAL*SQRT( DSUM )
+ IF( PL.EQ.ZERO ) THEN
+ PL = ONE
+ ELSE
+ PL = DSCALE / ( SQRT( DSCALE*DSCALE / PL+PL )*SQRT( PL ) )
+ END IF
+ RDSCAL = ZERO
+ DSUM = ONE
+ CALL DLASSQ( N1*N2, WORK( N1*N2+1 ), 1, RDSCAL, DSUM )
+ PR = RDSCAL*SQRT( DSUM )
+ IF( PR.EQ.ZERO ) THEN
+ PR = ONE
+ ELSE
+ PR = DSCALE / ( SQRT( DSCALE*DSCALE / PR+PR )*SQRT( PR ) )
+ END IF
+ END IF
+*
+ IF( WANTD ) THEN
+*
+* Compute estimates of Difu and Difl.
+*
+ IF( WANTD1 ) THEN
+ N1 = M
+ N2 = N - M
+ I = N1 + 1
+ IJB = IDIFJB
+*
+* Frobenius norm-based Difu-estimate.
+*
+ CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK,
+ $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ),
+ $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ),
+ $ LWORK-2*N1*N2, IWORK, IERR )
+*
+* Frobenius norm-based Difl-estimate.
+*
+ CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK,
+ $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ),
+ $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ),
+ $ LWORK-2*N1*N2, IWORK, IERR )
+ ELSE
+*
+*
+* Compute 1-norm-based estimates of Difu and Difl using
+* reversed communication with DLACON. In each step a
+* generalized Sylvester equation or a transposed variant
+* is solved.
+*
+ KASE = 0
+ N1 = M
+ N2 = N - M
+ I = N1 + 1
+ IJB = 0
+ MN2 = 2*N1*N2
+*
+* 1-norm-based estimate of Difu.
+*
+ 40 CONTINUE
+ CALL DLACON( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 1 ),
+ $ KASE )
+ IF( KASE.NE.0 ) THEN
+ IF( KASE.EQ.1 ) THEN
+*
+* Solve generalized Sylvester equation.
+*
+ CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA,
+ $ WORK, N1, B, LDB, B( I, I ), LDB,
+ $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
+ $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
+ $ IERR )
+ ELSE
+*
+* Solve the transposed variant.
+*
+ CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA,
+ $ WORK, N1, B, LDB, B( I, I ), LDB,
+ $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ),
+ $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
+ $ IERR )
+ END IF
+ GO TO 40
+ END IF
+ DIF( 1 ) = DSCALE / DIF( 1 )
+*
+* 1-norm-based estimate of Difl.
+*
+ 50 CONTINUE
+ CALL DLACON( MN2, WORK( MN2+1 ), WORK, IWORK, DIF( 2 ),
+ $ KASE )
+ IF( KASE.NE.0 ) THEN
+ IF( KASE.EQ.1 ) THEN
+*
+* Solve generalized Sylvester equation.
+*
+ CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA,
+ $ WORK, N2, B( I, I ), LDB, B, LDB,
+ $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
+ $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
+ $ IERR )
+ ELSE
+*
+* Solve the transposed variant.
+*
+ CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA,
+ $ WORK, N2, B( I, I ), LDB, B, LDB,
+ $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ),
+ $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK,
+ $ IERR )
+ END IF
+ GO TO 50
+ END IF
+ DIF( 2 ) = DSCALE / DIF( 2 )
+*
+ END IF
+ END IF
+*
+ 60 CONTINUE
+*
+* Compute generalized eigenvalues of reordered pair (A, B) and
+* normalize the generalized Schur form.
+*
+ PAIR = .FALSE.
+ DO 80 K = 1, N
+ IF( PAIR ) THEN
+ PAIR = .FALSE.
+ ELSE
+*
+ IF( K.LT.N ) THEN
+ IF( A( K+1, K ).NE.ZERO ) THEN
+ PAIR = .TRUE.
+ END IF
+ END IF
+*
+ IF( PAIR ) THEN
+*
+* Compute the eigenvalue(s) at position K.
+*
+ WORK( 1 ) = A( K, K )
+ WORK( 2 ) = A( K+1, K )
+ WORK( 3 ) = A( K, K+1 )
+ WORK( 4 ) = A( K+1, K+1 )
+ WORK( 5 ) = B( K, K )
+ WORK( 6 ) = B( K+1, K )
+ WORK( 7 ) = B( K, K+1 )
+ WORK( 8 ) = B( K+1, K+1 )
+ CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ),
+ $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ),
+ $ ALPHAI( K ) )
+ ALPHAI( K+1 ) = -ALPHAI( K )
+*
+ ELSE
+*
+ IF( SIGN( ONE, B( K, K ) ).LT.ZERO ) THEN
+*
+* If B(K,K) is negative, make it positive
+*
+ DO 70 I = 1, N
+ A( K, I ) = -A( K, I )
+ B( K, I ) = -B( K, I )
+ Q( I, K ) = -Q( I, K )
+ 70 CONTINUE
+ END IF
+*
+ ALPHAR( K ) = A( K, K )
+ ALPHAI( K ) = ZERO
+ BETA( K ) = B( K, K )
+*
+ END IF
+ END IF
+ 80 CONTINUE
+*
+ WORK( 1 ) = LWMIN
+ IWORK( 1 ) = LIWMIN
+*
+ RETURN
+*
+* End of DTGSEN
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.c
new file mode 100644
index 0000000000000000000000000000000000000000..65a290496b87f7082dfe0a35f8f215764f147e0b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.c
@@ -0,0 +1,504 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static doublereal c_b13 = 0.;
+static doublereal c_b14 = 1.;
+static integer c__1 = 1;
+static doublereal c_b43 = -1.;
+
+/* Subroutine */ void dtgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, doublereal *tola, doublereal *tolb,
+ doublereal *alpha, doublereal *beta, doublereal *u, integer *ldu,
+ doublereal *v, integer *ldv, doublereal *q, integer *ldq,
+ doublereal *work, integer *ncycle, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i, j;
+ static doublereal gamma;
+ static doublereal a1;
+ static logical initq;
+ static doublereal a2, a3, b1;
+ static logical initu, initv, wantq, upper;
+ static doublereal b2, b3;
+ static logical wantu, wantv;
+ static doublereal error, ssmin;
+ static integer kcycle;
+ static doublereal csq, csu, csv, snq, rwk, snu, snv;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* DTGSJA computes the generalized singular value decomposition (GSVD) */
+/* of two real upper triangular (or trapezoidal) matrices A and B. */
+/* */
+/* On entry, it is assumed that matrices A and B have the following */
+/* forms, which may be obtained by the preprocessing subroutine DGGSVP */
+/* from a general M-by-N matrix A and P-by-N matrix B: */
+/* */
+/* N-K-L K L */
+/* A = K ( 0 A12 A13 ) if M-K-L >= 0; */
+/* L ( 0 0 A23 ) */
+/* M-K-L ( 0 0 0 ) */
+/* */
+/* N-K-L K L */
+/* A = K ( 0 A12 A13 ) if M-K-L < 0; */
+/* M-K ( 0 0 A23 ) */
+/* */
+/* N-K-L K L */
+/* B = L ( 0 0 B13 ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular */
+/* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, */
+/* otherwise A23 is (M-K)-by-L upper trapezoidal. */
+/* */
+/* On exit, */
+/* */
+/* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ), */
+/* */
+/* where U, V and Q are orthogonal matrices, Z' denotes the transpose */
+/* of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are */
+/* ``diagonal'' matrices, which are of the following structures: */
+/* */
+/* If M-K-L >= 0, */
+/* */
+/* K L */
+/* D1 = K ( I 0 ) */
+/* L ( 0 C ) */
+/* M-K-L ( 0 0 ) */
+/* */
+/* K L */
+/* D2 = L ( 0 S ) */
+/* P-L ( 0 0 ) */
+/* */
+/* N-K-L K L */
+/* ( 0 R ) = K ( 0 R11 R12 ) K */
+/* L ( 0 0 R22 ) L */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */
+/* S = diag( BETA(K+1), ... , BETA(K+L) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R is stored in A(1:K+L,N-K-L+1:N) on exit. */
+/* */
+/* If M-K-L < 0, */
+/* */
+/* K M-K K+L-M */
+/* D1 = K ( I 0 0 ) */
+/* M-K ( 0 C 0 ) */
+/* */
+/* K M-K K+L-M */
+/* D2 = M-K ( 0 S 0 ) */
+/* K+L-M ( 0 0 I ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* N-K-L K M-K K+L-M */
+/* ( 0 R ) = K ( 0 R11 R12 R13 ) */
+/* M-K ( 0 0 R22 R23 ) */
+/* K+L-M ( 0 0 0 R33 ) */
+/* */
+/* where */
+/* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */
+/* S = diag( BETA(K+1), ... , BETA(M) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored */
+/* ( 0 R22 R23 ) */
+/* in B(M-K+1:L,N+M-K-L+1:N) on exit. */
+/* */
+/* The computation of the orthogonal transformation matrices U, V or Q */
+/* is optional. These matrices may either be formed explicitly, or they */
+/* may be postmultiplied into input matrices U1, V1, or Q1. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': U must contain an orthogonal matrix U1 on entry, and */
+/* the product U1*U is returned; */
+/* = 'I': U is initialized to the unit matrix, and the */
+/* orthogonal matrix U is returned; */
+/* = 'N': U is not computed. */
+/* */
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': V must contain an orthogonal matrix V1 on entry, and */
+/* the product V1*V is returned; */
+/* = 'I': V is initialized to the unit matrix, and the */
+/* orthogonal matrix V is returned; */
+/* = 'N': V is not computed. */
+/* */
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Q must contain an orthogonal matrix Q1 on entry, and */
+/* the product Q1*Q is returned; */
+/* = 'I': Q is initialized to the unit matrix, and the */
+/* orthogonal matrix Q is returned; */
+/* = 'N': Q is not computed. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* L (input) INTEGER */
+/* K and L specify the subblocks in the input matrices A and B: */
+/* A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N) */
+/* of A and B, whose GSVD is going to be computed by DTGSJA. */
+/* See Further details. */
+/* */
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular */
+/* matrix R or part of R. See Purpose for details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains */
+/* a part of R. See Purpose for details. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,P). */
+/* */
+/* TOLA (input) DOUBLE PRECISION */
+/* TOLB (input) DOUBLE PRECISION */
+/* TOLA and TOLB are the convergence criteria for the Jacobi- */
+/* Kogbetliantz iteration procedure. Generally, they are the */
+/* same as used in the preprocessing step, say */
+/* TOLA = max(M,N)*norm(A)*MACHEPS, */
+/* TOLB = max(P,N)*norm(B)*MACHEPS. */
+/* */
+/* ALPHA (output) DOUBLE PRECISION array, dimension (N) */
+/* BETA (output) DOUBLE PRECISION array, dimension (N) */
+/* On exit, ALPHA and BETA contain the generalized singular */
+/* value pairs of A and B; */
+/* ALPHA(1:K) = 1, */
+/* BETA(1:K) = 0, */
+/* and if M-K-L >= 0, */
+/* ALPHA(K+1:K+L) = diag(C), */
+/* BETA(K+1:K+L) = diag(S), */
+/* or if M-K-L < 0, */
+/* ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0 */
+/* BETA(K+1:M) = S, BETA(M+1:K+L) = 1. */
+/* Furthermore, if K+L < N, */
+/* ALPHA(K+L+1:N) = 0 and */
+/* BETA(K+L+1:N) = 0. */
+/* */
+/* U (input/output) DOUBLE PRECISION array, dimension (LDU,M) */
+/* On entry, if JOBU = 'U', U must contain a matrix U1 (usually */
+/* the orthogonal matrix returned by DGGSVP). */
+/* On exit, */
+/* if JOBU = 'I', U contains the orthogonal matrix U; */
+/* if JOBU = 'U', U contains the product U1*U. */
+/* If JOBU = 'N', U is not referenced. */
+/* */
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+/* */
+/* V (input/output) DOUBLE PRECISION array, dimension (LDV,P) */
+/* On entry, if JOBV = 'V', V must contain a matrix V1 (usually */
+/* the orthogonal matrix returned by DGGSVP). */
+/* On exit, */
+/* if JOBV = 'I', V contains the orthogonal matrix V; */
+/* if JOBV = 'V', V contains the product V1*V. */
+/* If JOBV = 'N', V is not referenced. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+/* */
+/* Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N) */
+/* On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually */
+/* the orthogonal matrix returned by DGGSVP). */
+/* On exit, */
+/* if JOBQ = 'I', Q contains the orthogonal matrix Q; */
+/* if JOBQ = 'Q', Q contains the product Q1*Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (2*N) */
+/* */
+/* NCYCLE (output) INTEGER */
+/* The number of cycles required for convergence. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* = 1: the procedure does not converge after MAXIT cycles. */
+/* */
+/* Internal Parameters */
+/* =================== */
+/* */
+/* MAXIT INTEGER */
+/* MAXIT specifies the total loops that the iterative procedure */
+/* may take. If after MAXIT cycles, the routine fails to */
+/* converge, we return INFO = 1. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* DTGSJA essentially uses a variant of Kogbetliantz algorithm to reduce */
+/* min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L */
+/* matrix B13 to the form: */
+/* */
+/* U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1, */
+/* */
+/* where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose */
+/* of Z. C1 and S1 are diagonal matrices satisfying */
+/* */
+/* C1**2 + S1**2 = I, */
+/* */
+/* and R1 is an L-by-L nonsingular upper triangular matrix. */
+/* */
+/* ===================================================================== */
+
+/* Decode and test the input parameters */
+
+ initu = lsame_(jobu, "I");
+ wantu = initu || lsame_(jobu, "U");
+
+ initv = lsame_(jobv, "I");
+ wantv = initv || lsame_(jobv, "V");
+
+ initq = lsame_(jobq, "I");
+ wantq = initq || lsame_(jobq, "Q");
+
+ *info = 0;
+ if (! (initu || wantu || lsame_(jobu, "N"))) {
+ *info = -1;
+ } else if (! (initv || wantv || lsame_(jobv, "N"))) {
+ *info = -2;
+ } else if (! (initq || wantq || lsame_(jobq, "N"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*p < 0) {
+ *info = -5;
+ } else if (*n < 0) {
+ *info = -6;
+ } else if (*lda < max(1,*m)) {
+ *info = -10;
+ } else if (*ldb < max(1,*p)) {
+ *info = -12;
+ } else if (*ldu < 1 || (wantu && *ldu < *m)) {
+ *info = -18;
+ } else if (*ldv < 1 || (wantv && *ldv < *p)) {
+ *info = -20;
+ } else if (*ldq < 1 || (wantq && *ldq < *n)) {
+ *info = -22;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGSJA", &i__1);
+ return;
+ }
+
+/* Initialize U, V and Q, if necessary */
+
+ if (initu) {
+ dlaset_("Full", m, m, &c_b13, &c_b14, u, ldu);
+ }
+ if (initv) {
+ dlaset_("Full", p, p, &c_b13, &c_b14, v, ldv);
+ }
+ if (initq) {
+ dlaset_("Full", n, n, &c_b13, &c_b14, q, ldq);
+ }
+
+/* Loop until convergence */
+
+ upper = FALSE_;
+ for (kcycle = 1; kcycle <= 40; ++kcycle) {
+ upper = ! upper;
+ for (i = 0; i < *l; ++i) {
+ for (j = i + 1; j < *l; ++j) {
+ a1 = a2 = a3 = 0.;
+ if (*k + i < *m) {
+ a1 = a[*k + i + (*n - *l + i) * *lda];
+ }
+ if (*k + j < *m) {
+ a3 = a[*k + j + (*n - *l + j) * *lda];
+ }
+
+ b1 = b[i + (*n - *l + i) * *ldb];
+ b3 = b[j + (*n - *l + j) * *ldb];
+
+ if (upper) {
+ if (*k + i < *m) {
+ a2 = a[*k + i + (*n - *l + j) * *lda];
+ }
+ b2 = b[i + (*n - *l + j) * *ldb];
+ } else {
+ if (*k + j < *m) {
+ a2 = a[*k + j + (*n - *l + i) * *lda];
+ }
+ b2 = b[j + (*n - *l + i) * *ldb];
+ }
+
+ dlags2_(&upper, &a1, &a2, &a3, &b1, &b2, &b3, &csu, &snu, &csv, &snv, &csq, &snq);
+
+/* Update (K+I)-th and (K+J)-th rows of matrix A: U'*A */
+
+ if (*k + j < *m) {
+ drot_(l, &a[*k + j + (*n - *l) * *lda], lda, &a[*k + i + (*n - *l) * *lda], lda, &csu, &snu);
+ }
+
+/* Update I-th and J-th rows of matrix B: V'*B */
+
+ drot_(l, &b[j + (*n - *l) * *ldb], ldb, &b[i + (*n - *l) * *ldb], ldb, &csv, &snv);
+
+/* Update (N-L+I)-th and (N-L+J)-th columns of matrices */
+/* A and B: A*Q and B*Q */
+
+ i__1 = min(*k + *l,*m);
+ drot_(&i__1, &a[(*n - *l + j) * *lda], &c__1, &a[(*n - *l + i) * *lda], &c__1, &csq, &snq);
+ drot_(l, &b[(*n - *l + j) * *ldb], &c__1, &b[(*n - *l + i) * *ldb], &c__1, &csq, &snq);
+
+ if (upper) {
+ if (*k + i < *m) {
+ a[*k + i + (*n - *l + j) * *lda] = 0.;
+ }
+ b[i + (*n - *l + j) * *ldb] = 0.;
+ } else {
+ if (*k + j < *m) {
+ a[*k + j + (*n - *l + i) * *lda] = 0.;
+ }
+ b[j + (*n - *l + i) * *ldb] = 0.;
+ }
+
+/* Update orthogonal matrices U, V, Q, if desired. */
+
+ if (wantu && *k + j < *m) {
+ drot_(m, &u[(*k + j) * *ldu], &c__1, &u[(*k + i) * *ldu], &c__1, &csu, &snu);
+ }
+
+ if (wantv) {
+ drot_(p, &v[j * *ldv], &c__1, &v[i * *ldv], &c__1, &csv, &snv);
+ }
+
+ if (wantq) {
+ drot_(n, &q[(*n - *l + j) * *ldq], &c__1, &q[(*n - *l + i) * *ldq], &c__1, &csq, &snq);
+ }
+ }
+ }
+
+ if (! upper) {
+
+/* The matrices A13 and B13 were lower triangular at the start */
+/* of the cycle, and are now upper triangular. */
+
+/* Convergence test: test the parallelism of the corresponding */
+/* rows of A and B. */
+
+ error = 0.;
+ for (i = 0; i < min(*l,*m - *k); ++i) {
+ i__1 = *l - i;
+ dcopy_(&i__1, &a[*k + i + (*n - *l + i) * *lda], lda, work, &c__1);
+ dcopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &work[*l], &c__1);
+ dlapll_(&i__1, work, &c__1, &work[*l], &c__1, &ssmin);
+ error = max(error,ssmin);
+ }
+
+ if (abs(error) <= (doublereal) (*n) * min(*tola,*tolb)) {
+ goto L50;
+ }
+ }
+/* End of cycle loop */
+ }
+
+/* The algorithm has not converged after MAXIT cycles. */
+
+ *info = 1;
+ *ncycle = kcycle;
+ return;
+
+L50:
+
+/* If ERROR <= N*MIN(TOLA,TOLB), then the algorithm has converged. */
+/* Compute the generalized singular value pairs (ALPHA, BETA), and */
+/* set the triangular matrix R to array A. */
+
+ for (i = 0; i < *k; ++i) {
+ alpha[i] = 1.;
+ beta[i] = 0.;
+ }
+
+ for (i = 0; i < min(*l,*m - *k); ++i) {
+ a1 = a[*k + i + (*n - *l + i) * *lda];
+ b1 = b[i + (*n - *l + i) * *ldb];
+
+ if (a1 != 0.) {
+ gamma = b1 / a1;
+
+/* change sign if necessary */
+
+ if (gamma < 0.) {
+ i__1 = *l - i;
+ dscal_(&i__1, &c_b43, &b[i + (*n - *l + i) * *ldb], ldb);
+ if (wantv) {
+ dscal_(p, &c_b43, &v[i * *ldv], &c__1);
+ }
+ }
+
+ d__1 = abs(gamma);
+ dlartg_(&d__1, &c_b14, &beta[*k + i], &alpha[*k + i], &rwk);
+
+ if (alpha[*k + i] >= beta[*k + i]) {
+ i__1 = *l - i;
+ d__1 = 1. / alpha[*k + i];
+ dscal_(&i__1, &d__1, &a[*k + i + (*n - *l + i) * *lda], lda);
+ } else {
+ i__1 = *l - i;
+ d__1 = 1. / beta[*k + i];
+ dscal_(&i__1, &d__1, &b[i + (*n - *l + i) * *ldb], ldb);
+ dcopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &a[*k + i + (*n - *l + i) * *lda], lda);
+ }
+ } else {
+ alpha[*k + i] = 0.;
+ beta[*k + i] = 1.;
+ i__1 = *l - i;
+ dcopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &a[*k + i + (*n - *l + i) * *lda], lda);
+ }
+ }
+
+/* Post-assignment */
+
+ for (i = *m; i < *k + *l; ++i) {
+ alpha[i] = 0.;
+ beta[i] = 1.;
+ }
+
+ if (*k + *l < *n) {
+ for (i = *k + *l; i < *n; ++i) {
+ alpha[i] = 0.;
+ beta[i] = 0.;
+ }
+ }
+
+ *ncycle = kcycle;
+ return;
+
+} /* dtgsja_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.f
new file mode 100644
index 0000000000000000000000000000000000000000..380818a5426da39af9a24709cc7edffdb11e7757
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsja.f
@@ -0,0 +1,516 @@
+ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
+ $ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
+ $ Q, LDQ, WORK, NCYCLE, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
+ $ NCYCLE, P
+ DOUBLE PRECISION TOLA, TOLB
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), ALPHA( * ), B( LDB, * ),
+ $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
+ $ V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGSJA computes the generalized singular value decomposition (GSVD)
+* of two real upper triangular (or trapezoidal) matrices A and B.
+*
+* On entry, it is assumed that matrices A and B have the following
+* forms, which may be obtained by the preprocessing subroutine DGGSVP
+* from a general M-by-N matrix A and P-by-N matrix B:
+*
+* N-K-L K L
+* A = K ( 0 A12 A13 ) if M-K-L >= 0;
+* L ( 0 0 A23 )
+* M-K-L ( 0 0 0 )
+*
+* N-K-L K L
+* A = K ( 0 A12 A13 ) if M-K-L < 0;
+* M-K ( 0 0 A23 )
+*
+* N-K-L K L
+* B = L ( 0 0 B13 )
+* P-L ( 0 0 0 )
+*
+* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+* otherwise A23 is (M-K)-by-L upper trapezoidal.
+*
+* On exit,
+*
+* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+*
+* where U, V and Q are orthogonal matrices, Z' denotes the transpose
+* of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+* ``diagonal'' matrices, which are of the following structures:
+*
+* If M-K-L >= 0,
+*
+* K L
+* D1 = K ( I 0 )
+* L ( 0 C )
+* M-K-L ( 0 0 )
+*
+* K L
+* D2 = L ( 0 S )
+* P-L ( 0 0 )
+*
+* N-K-L K L
+* ( 0 R ) = K ( 0 R11 R12 ) K
+* L ( 0 0 R22 ) L
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+* S = diag( BETA(K+1), ... , BETA(K+L) ),
+* C**2 + S**2 = I.
+*
+* R is stored in A(1:K+L,N-K-L+1:N) on exit.
+*
+* If M-K-L < 0,
+*
+* K M-K K+L-M
+* D1 = K ( I 0 0 )
+* M-K ( 0 C 0 )
+*
+* K M-K K+L-M
+* D2 = M-K ( 0 S 0 )
+* K+L-M ( 0 0 I )
+* P-L ( 0 0 0 )
+*
+* N-K-L K M-K K+L-M
+* ( 0 R ) = K ( 0 R11 R12 R13 )
+* M-K ( 0 0 R22 R23 )
+* K+L-M ( 0 0 0 R33 )
+*
+* where
+* C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+* S = diag( BETA(K+1), ... , BETA(M) ),
+* C**2 + S**2 = I.
+*
+* R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+* ( 0 R22 R23 )
+* in B(M-K+1:L,N+M-K-L+1:N) on exit.
+*
+* The computation of the orthogonal transformation matrices U, V or Q
+* is optional. These matrices may either be formed explicitly, or they
+* may be postmultiplied into input matrices U1, V1, or Q1.
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': U must contain an orthogonal matrix U1 on entry, and
+* the product U1*U is returned;
+* = 'I': U is initialized to the unit matrix, and the
+* orthogonal matrix U is returned;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': V must contain an orthogonal matrix V1 on entry, and
+* the product V1*V is returned;
+* = 'I': V is initialized to the unit matrix, and the
+* orthogonal matrix V is returned;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+* the product Q1*Q is returned;
+* = 'I': Q is initialized to the unit matrix, and the
+* orthogonal matrix Q is returned;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* K (input) INTEGER
+* L (input) INTEGER
+* K and L specify the subblocks in the input matrices A and B:
+* A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+* of A and B, whose GSVD is going to be computed by DTGSJA.
+* See Further details.
+*
+* A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+* matrix R or part of R. See Purpose for details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) DOUBLE PRECISION array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+* a part of R. See Purpose for details.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,P).
+*
+* TOLA (input) DOUBLE PRECISION
+* TOLB (input) DOUBLE PRECISION
+* TOLA and TOLB are the convergence criteria for the Jacobi-
+* Kogbetliantz iteration procedure. Generally, they are the
+* same as used in the preprocessing step, say
+* TOLA = max(M,N)*norm(A)*MACHEPS,
+* TOLB = max(P,N)*norm(B)*MACHEPS.
+*
+* ALPHA (output) DOUBLE PRECISION array, dimension (N)
+* BETA (output) DOUBLE PRECISION array, dimension (N)
+* On exit, ALPHA and BETA contain the generalized singular
+* value pairs of A and B;
+* ALPHA(1:K) = 1,
+* BETA(1:K) = 0,
+* and if M-K-L >= 0,
+* ALPHA(K+1:K+L) = diag(C),
+* BETA(K+1:K+L) = diag(S),
+* or if M-K-L < 0,
+* ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+* BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+* Furthermore, if K+L < N,
+* ALPHA(K+L+1:N) = 0 and
+* BETA(K+L+1:N) = 0.
+*
+* U (input/output) DOUBLE PRECISION array, dimension (LDU,M)
+* On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+* the orthogonal matrix returned by DGGSVP).
+* On exit,
+* if JOBU = 'I', U contains the orthogonal matrix U;
+* if JOBU = 'U', U contains the product U1*U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (input/output) DOUBLE PRECISION array, dimension (LDV,P)
+* On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+* the orthogonal matrix returned by DGGSVP).
+* On exit,
+* if JOBV = 'I', V contains the orthogonal matrix V;
+* if JOBV = 'V', V contains the product V1*V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+* On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+* the orthogonal matrix returned by DGGSVP).
+* On exit,
+* if JOBQ = 'I', Q contains the orthogonal matrix Q;
+* if JOBQ = 'Q', Q contains the product Q1*Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+*
+* NCYCLE (output) INTEGER
+* The number of cycles required for convergence.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* = 1: the procedure does not converge after MAXIT cycles.
+*
+* Internal Parameters
+* ===================
+*
+* MAXIT INTEGER
+* MAXIT specifies the total loops that the iterative procedure
+* may take. If after MAXIT cycles, the routine fails to
+* converge, we return INFO = 1.
+*
+* Further Details
+* ===============
+*
+* DTGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+* min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+* matrix B13 to the form:
+*
+* U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+*
+* where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+* of Z. C1 and S1 are diagonal matrices satisfying
+*
+* C1**2 + S1**2 = I,
+*
+* and R1 is an L-by-L nonsingular upper triangular matrix.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER MAXIT
+ PARAMETER ( MAXIT = 40 )
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+*
+ LOGICAL INITQ, INITU, INITV, UPPER, WANTQ, WANTU, WANTV
+ INTEGER I, J, KCYCLE
+ DOUBLE PRECISION A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, ERROR,
+ $ GAMMA, RWK, SNQ, SNU, SNV, SSMIN
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY, DLAGS2, DLAPLL, DLARTG, DLASET, DROT,
+ $ DSCAL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Decode and test the input parameters
+*
+ INITU = LSAME( JOBU, 'I' )
+ WANTU = INITU .OR. LSAME( JOBU, 'U' )
+*
+ INITV = LSAME( JOBV, 'I' )
+ WANTV = INITV .OR. LSAME( JOBV, 'V' )
+*
+ INITQ = LSAME( JOBQ, 'I' )
+ WANTQ = INITQ .OR. LSAME( JOBQ, 'Q' )
+*
+ INFO = 0
+ IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -12
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -18
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -20
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -22
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGSJA', -INFO )
+ RETURN
+ END IF
+*
+* Initialize U, V and Q, if necessary
+*
+ IF( INITU )
+ $ CALL DLASET( 'Full', M, M, ZERO, ONE, U, LDU )
+ IF( INITV )
+ $ CALL DLASET( 'Full', P, P, ZERO, ONE, V, LDV )
+ IF( INITQ )
+ $ CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+*
+* Loop until convergence
+*
+ UPPER = .FALSE.
+ DO 40 KCYCLE = 1, MAXIT
+*
+ UPPER = .NOT.UPPER
+*
+ DO 20 I = 1, L - 1
+ DO 10 J = I + 1, L
+*
+ A1 = ZERO
+ A2 = ZERO
+ A3 = ZERO
+ IF( K+I.LE.M )
+ $ A1 = A( K+I, N-L+I )
+ IF( K+J.LE.M )
+ $ A3 = A( K+J, N-L+J )
+*
+ B1 = B( I, N-L+I )
+ B3 = B( J, N-L+J )
+*
+ IF( UPPER ) THEN
+ IF( K+I.LE.M )
+ $ A2 = A( K+I, N-L+J )
+ B2 = B( I, N-L+J )
+ ELSE
+ IF( K+J.LE.M )
+ $ A2 = A( K+J, N-L+I )
+ B2 = B( J, N-L+I )
+ END IF
+*
+ CALL DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU,
+ $ CSV, SNV, CSQ, SNQ )
+*
+* Update (K+I)-th and (K+J)-th rows of matrix A: U'*A
+*
+ IF( K+J.LE.M )
+ $ CALL DROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ),
+ $ LDA, CSU, SNU )
+*
+* Update I-th and J-th rows of matrix B: V'*B
+*
+ CALL DROT( L, B( J, N-L+1 ), LDB, B( I, N-L+1 ), LDB,
+ $ CSV, SNV )
+*
+* Update (N-L+I)-th and (N-L+J)-th columns of matrices
+* A and B: A*Q and B*Q
+*
+ CALL DROT( MIN( K+L, M ), A( 1, N-L+J ), 1,
+ $ A( 1, N-L+I ), 1, CSQ, SNQ )
+*
+ CALL DROT( L, B( 1, N-L+J ), 1, B( 1, N-L+I ), 1, CSQ,
+ $ SNQ )
+*
+ IF( UPPER ) THEN
+ IF( K+I.LE.M )
+ $ A( K+I, N-L+J ) = ZERO
+ B( I, N-L+J ) = ZERO
+ ELSE
+ IF( K+J.LE.M )
+ $ A( K+J, N-L+I ) = ZERO
+ B( J, N-L+I ) = ZERO
+ END IF
+*
+* Update orthogonal matrices U, V, Q, if desired.
+*
+ IF( WANTU .AND. K+J.LE.M )
+ $ CALL DROT( M, U( 1, K+J ), 1, U( 1, K+I ), 1, CSU,
+ $ SNU )
+*
+ IF( WANTV )
+ $ CALL DROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV )
+*
+ IF( WANTQ )
+ $ CALL DROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ,
+ $ SNQ )
+*
+ 10 CONTINUE
+ 20 CONTINUE
+*
+ IF( .NOT.UPPER ) THEN
+*
+* The matrices A13 and B13 were lower triangular at the start
+* of the cycle, and are now upper triangular.
+*
+* Convergence test: test the parallelism of the corresponding
+* rows of A and B.
+*
+ ERROR = ZERO
+ DO 30 I = 1, MIN( L, M-K )
+ CALL DCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 )
+ CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 )
+ CALL DLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN )
+ ERROR = MAX( ERROR, SSMIN )
+ 30 CONTINUE
+*
+ IF( ABS( ERROR ).LE.DBLE( N )*MIN( TOLA, TOLB ) )
+ $ GO TO 50
+ END IF
+*
+* End of cycle loop
+*
+ 40 CONTINUE
+*
+* The algorithm has not converged after MAXIT cycles.
+*
+ INFO = 1
+ GO TO 100
+*
+ 50 CONTINUE
+*
+* If ERROR <= N*MIN(TOLA,TOLB), then the algorithm has converged.
+* Compute the generalized singular value pairs (ALPHA, BETA), and
+* set the triangular matrix R to array A.
+*
+ DO 60 I = 1, K
+ ALPHA( I ) = ONE
+ BETA( I ) = ZERO
+ 60 CONTINUE
+*
+ DO 70 I = 1, MIN( L, M-K )
+*
+ A1 = A( K+I, N-L+I )
+ B1 = B( I, N-L+I )
+*
+ IF( A1.NE.ZERO ) THEN
+ GAMMA = B1 / A1
+*
+* change sign if necessary
+*
+ IF( GAMMA.LT.ZERO ) THEN
+ CALL DSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB )
+ IF( WANTV )
+ $ CALL DSCAL( P, -ONE, V( 1, I ), 1 )
+ END IF
+*
+ CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ),
+ $ RWK )
+*
+ IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN
+ CALL DSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ),
+ $ LDA )
+ ELSE
+ CALL DSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ),
+ $ LDB )
+ CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
+ $ LDA )
+ END IF
+*
+ ELSE
+*
+ ALPHA( K+I ) = ZERO
+ BETA( K+I ) = ONE
+ CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
+ $ LDA )
+*
+ END IF
+*
+ 70 CONTINUE
+*
+* Post-assignment
+*
+ DO 80 I = M + 1, K + L
+ ALPHA( I ) = ZERO
+ BETA( I ) = ONE
+ 80 CONTINUE
+*
+ IF( K+L.LT.N ) THEN
+ DO 90 I = K + L + 1, N
+ ALPHA( I ) = ZERO
+ BETA( I ) = ZERO
+ 90 CONTINUE
+ END IF
+*
+ 100 CONTINUE
+ NCYCLE = KCYCLE
+ RETURN
+*
+* End of DTGSJA
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.c
new file mode 100644
index 0000000000000000000000000000000000000000..355cee25a0aa7ac0c340871fdc040d3d12821c45
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.c
@@ -0,0 +1,991 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__8 = 8;
+static integer c__1 = 1;
+static doublereal c_b27 = -1.;
+static doublereal c_b42 = 1.;
+static integer c__64 = 64;
+static doublereal c_b54 = 0.;
+static integer c__0 = 0;
+
+/* Subroutine */ void dtgsy2_(trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,
+ ldd, e, lde, f, ldf, scale, rdsum, rdscal, iwork, pq, info)
+char *trans;
+integer *ijob, *m, *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *c;
+integer *ldc;
+doublereal *d;
+integer *ldd;
+doublereal *e;
+integer *lde;
+doublereal *f;
+integer *ldf;
+doublereal *scale, *rdsum, *rdscal;
+integer *iwork, *pq, *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, d_dim1,
+ d_offset, e_dim1, e_offset, f_dim1, f_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer ierr, zdim, ipiv[8], jpiv[8], i, j, k, p, q;
+ static doublereal alpha;
+ static doublereal z[64] /* was [8][8] */;
+ static integer ie, je, mb, nb, ii, jj, is, js;
+ static doublereal scaloc;
+ static logical notran;
+ static doublereal rhs[8];
+ static integer isp1, jsp1;
+
+
+/* -- LAPACK auxiliary routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+
+/* DTGSY2 solves the generalized Sylvester equation: */
+
+/* A * R - L * B = scale * C (1) */
+/* D * R - L * E = scale * F, */
+
+/* using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices, */
+/* (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M, */
+/* N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E) */
+/* must be in generalized Schur canonical form, i.e. A, B are upper */
+/* quasi triangular and D, E are upper triangular. The solution (R, L) */
+/* overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor */
+/* chosen to avoid overflow. */
+
+/* In matrix notation solving equation (1) corresponds to solve */
+/* Z*x = scale*b, where Z is defined as */
+
+/* Z = [ kron(In, A) -kron(B', Im) ] (2) */
+/* [ kron(In, D) -kron(E', Im) ], */
+
+/* Ik is the identity matrix of size k and X' is the transpose of X. */
+/* kron(X, Y) is the Kronecker product between the matrices X and Y. */
+/* In the process of solving (1), we solve a number of such systems */
+/* where Dim(In), Dim(In) = 1 or 2. */
+
+/* If TRANS = 'T', solve the transposed system Z'*y = scale*b for y, */
+/* which is equivalent to solve for R and L in */
+
+/* A' * R + D' * L = scale * C (3) */
+/* R * B' + L * E' = scale * -F */
+
+/* This case is used to compute an estimate of Dif[(A, D), (B, E)] = */
+/* sigma_min(Z) using reverse communicaton with DLACON. */
+
+/* DTGSY2 also (IJOB >= 1) contributes to the computation in STGSYL */
+/* of an upper bound on the separation between to matrix pairs. Then */
+/* the input (A, D), (B, E) are sub-pencils of the matrix pair in */
+/* DTGSYL. See STGSYL for details. */
+
+/* Arguments */
+/* ========= */
+
+/* TRANS (input) CHARACTER */
+/* = 'N', solve the generalized Sylvester equation (1). */
+/* = 'T': solve the 'transposed' system (3). */
+
+/* IJOB (input) INTEGER */
+/* Specifies what kind of functionality to be performed. */
+/* = 0: solve (1) only. */
+/* = 1: A contribution from this subsystem to a Frobenius */
+/* norm-based estimate of the separation between two matrix */
+/* pairs is computed. (look ahead strategy is used). */
+/* = 2: A contribution from this subsystem to a Frobenius */
+/* norm-based estimate of the separation between two matrix */
+/* pairs is computed. (DGECON on sub-systems is used.) */
+/* Not referenced if TRANS = 'T'. */
+
+/* M (input) INTEGER */
+/* On entry, M specifies the order of A and D, and the row */
+/* dimension of C, F, R and L. */
+
+/* N (input) INTEGER */
+/* On entry, N specifies the order of B and E, and the column */
+/* dimension of C, F, R and L. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA, M) */
+/* On entry, A contains an upper quasi triangular matrix. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the matrix A. LDA >= max(1, M). */
+
+/* B (input) DOUBLE PRECISION array, dimension (LDB, N) */
+/* On entry, B contains an upper quasi triangular matrix. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the matrix B. LDB >= max(1, N). */
+
+/* C (input/ output) DOUBLE PRECISION array, dimension (LDC, N) */
+/* On entry, C contains the right-hand-side of the first matrix */
+/* equation in (1). */
+/* On exit, if IJOB = 0, C has been overwritten by the */
+/* solution R. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the matrix C. LDC >= max(1, M). */
+
+/* D (input) DOUBLE PRECISION array, dimension (LDD, M) */
+/* On entry, D contains an upper triangular matrix. */
+
+/* LDD (input) INTEGER */
+/* The leading dimension of the matrix D. LDD >= max(1, M). */
+
+/* E (input) DOUBLE PRECISION array, dimension (LDE, N) */
+/* On entry, E contains an upper triangular matrix. */
+
+/* LDE (input) INTEGER */
+/* The leading dimension of the matrix E. LDE >= max(1, N). */
+
+/* F (input/ output) DOUBLE PRECISION array, dimension (LDF, N) */
+/* On entry, F contains the right-hand-side of the second matrix */
+/* equation in (1). */
+/* On exit, if IJOB = 0, F has been overwritten by the */
+/* solution L. */
+
+/* LDF (input) INTEGER */
+/* The leading dimension of the matrix F. LDF >= max(1, M). */
+
+/* SCALE (output) DOUBLE PRECISION */
+/* On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions */
+/* R and L (C and F on entry) will hold the solutions to a */
+/* slightly perturbed system but the input matrices A, B, D and */
+/* E have not been changed. If SCALE = 0, R and L will hold the */
+/* solutions to the homogeneous system with C = F = 0. Normally, */
+/* SCALE = 1. */
+
+/* RDSUM (input/output) DOUBLE PRECISION */
+/* On entry, the sum of squares of computed contributions to */
+/* the Dif-estimate under computation by DTGSYL, where the */
+/* scaling factor RDSCAL (see below) has been factored out. */
+/* On exit, the corresponding sum of squares updated with the */
+/* contributions from the current sub-system. */
+/* If TRANS = 'T' RDSUM is not touched. */
+/* NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL. */
+
+/* RDSCAL (input/output) DOUBLE PRECISION */
+/* On entry, scaling factor used to prevent overflow in RDSUM. */
+/* On exit, RDSCAL is updated w.r.t. the current contributions */
+/* in RDSUM. */
+/* If TRANS = 'T', RDSCAL is not touched. */
+/* NOTE: RDSCAL only makes sense when DTGSY2 is called by */
+/* DTGSYL. */
+
+/* IWORK (workspace) INTEGER array, dimension (M+N+2) */
+
+/* PQ (output) INTEGER */
+/* On exit, the number of subsystems (of size 2-by-2, 4-by-4 and */
+/* 8-by-8) solved by this routine. */
+
+/* INFO (output) INTEGER */
+/* On exit, if INFO is set to */
+/* =0: Successful exit */
+/* <0: If INFO = -i, the i-th argument had an illegal value. */
+/* >0: The matrix pairs (A, D) and (B, E) have common or very */
+/* close eigenvalues. */
+
+/* Further Details */
+/* =============== */
+
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c -= c_offset;
+ d_dim1 = *ldd;
+ d_offset = 1 + d_dim1 * 1;
+ d -= d_offset;
+ e_dim1 = *lde;
+ e_offset = 1 + e_dim1 * 1;
+ e -= e_offset;
+ f_dim1 = *ldf;
+ f_offset = 1 + f_dim1 * 1;
+ f -= f_offset;
+ --iwork;
+
+/* Decode and test input parameters */
+
+ *info = 0;
+ ierr = 0;
+ notran = lsame_(trans, "N");
+ if (! notran && ! lsame_(trans, "T")) {
+ *info = -1;
+ } else if (*ijob < 0 || *ijob > 2) {
+ *info = -2;
+ } else if (*m <= 0) {
+ *info = -3;
+ } else if (*n <= 0) {
+ *info = -4;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*ldb < max(1,*n)) {
+ *info = -8;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if (*ldd < max(1,*m)) {
+ *info = -12;
+ } else if (*lde < max(1,*n)) {
+ *info = -14;
+ } else if (*ldf < max(1,*m)) {
+ *info = -16;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGSY2", &i__1);
+ return;
+ }
+
+/* Determine block structure of A */
+
+ *pq = 0;
+ p = 0;
+ i = 1;
+L10:
+ if (i > *m) {
+ goto L20;
+ }
+ ++p;
+ iwork[p] = i;
+ if (i == *m) {
+ goto L20;
+ }
+ if (a[i + 1 + i * a_dim1] != 0.) {
+ i += 2;
+ } else {
+ ++i;
+ }
+ goto L10;
+L20:
+ iwork[p + 1] = *m + 1;
+
+/* Determine block structure of B */
+
+ q = p + 1;
+ j = 1;
+L30:
+ if (j > *n) {
+ goto L40;
+ }
+ ++q;
+ iwork[q] = j;
+ if (j == *n) {
+ goto L40;
+ }
+ if (b[j + 1 + j * b_dim1] != 0.) {
+ j += 2;
+ } else {
+ ++j;
+ }
+ goto L30;
+L40:
+ iwork[q + 1] = *n + 1;
+ *pq = p * (q - p - 1);
+
+ if (notran) {
+
+/* Solve (I, J) - subsystem */
+/* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J) */
+/* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J) */
+/* for I = P, P - 1, ..., 1; J = 1, 2, ..., Q */
+
+ *scale = 1.;
+ scaloc = 1.;
+ i__1 = q;
+ for (j = p + 2; j <= i__1; ++j) {
+ js = iwork[j];
+ jsp1 = js + 1;
+ je = iwork[j + 1] - 1;
+ nb = je - js + 1;
+ for (i = p; i >= 1; --i) {
+
+ is = iwork[i];
+ isp1 = is + 1;
+ ie = iwork[i + 1] - 1;
+ mb = ie - is + 1;
+ zdim = mb * nb << 1;
+
+ if (mb == 1 && nb == 1) {
+
+/* Build a 2-by-2 system Z * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = d[is + is * d_dim1];
+ z[8] = -b[js + js * b_dim1];
+ z[9] = -e[js + js * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = f[is + js * f_dim1];
+
+/* Solve Z * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+
+ if (*ijob == 0) {
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+ } else {
+ dlatdf_(ijob, &zdim, z, &c__8, rhs, rdsum, rdscal, ipiv, jpiv);
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ f[is + js * f_dim1] = rhs[1];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (i > 1) {
+ alpha = -rhs[0];
+ i__2 = is - 1;
+ daxpy_(&i__2, &alpha, &a[is * a_dim1 + 1], &c__1, &c[js * c_dim1 + 1], &c__1);
+ i__2 = is - 1;
+ daxpy_(&i__2, &alpha, &d[is * d_dim1 + 1], &c__1, &f[js * f_dim1 + 1], &c__1);
+ }
+ if (j < q) {
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[1], &b[js + (je + 1) * b_dim1], ldb, &c[is + (je + 1) * c_dim1], ldc);
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[1], &e[js + (je + 1) * e_dim1], lde, &f[is + (je + 1) * f_dim1], ldf);
+ }
+
+ } else if (mb == 1 && nb == 2) {
+
+/* Build a 4-by-4 system Z * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = 0.;
+ z[2] = d[is + is * d_dim1];
+ z[3] = 0.;
+
+ z[8] = 0.;
+ z[9] = a[is + is * a_dim1];
+ z[10] = 0.;
+ z[11] = d[is + is * d_dim1];
+
+ z[16] = -b[js + js * b_dim1];
+ z[17] = -b[js + jsp1 * b_dim1];
+ z[18] = -e[js + js * e_dim1];
+ z[19] = -e[js + jsp1 * e_dim1];
+
+ z[24] = -b[jsp1 + js * b_dim1];
+ z[25] = -b[jsp1 + jsp1 * b_dim1];
+ z[26] = 0.;
+ z[27] = -e[jsp1 + jsp1 * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = c[is + jsp1 * c_dim1];
+ rhs[2] = f[is + js * f_dim1];
+ rhs[3] = f[is + jsp1 * f_dim1];
+
+/* Solve Z * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+
+ if (*ijob == 0) {
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+ } else {
+ dlatdf_(ijob, &zdim, z, &c__8, rhs, rdsum, rdscal, ipiv, jpiv);
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ c[is + jsp1 * c_dim1] = rhs[1];
+ f[is + js * f_dim1] = rhs[2];
+ f[is + jsp1 * f_dim1] = rhs[3];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (i > 1) {
+ i__2 = is - 1;
+ dger_(&i__2, &nb, &c_b27, &a[is * a_dim1 + 1], &c__1, rhs, &c__1, &c[js * c_dim1 + 1], ldc);
+ i__2 = is - 1;
+ dger_(&i__2, &nb, &c_b27, &d[is * d_dim1 + 1], &c__1, rhs, &c__1, &f[js * f_dim1 + 1], ldf);
+ }
+ if (j < q) {
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[2], &b[js + (je + 1) * b_dim1], ldb, &c[is + (je + 1) * c_dim1], ldc);
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[2], &e[js + (je + 1) * e_dim1], lde, &f[is + (je + 1) * f_dim1], ldf);
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[3], &b[jsp1 + (je + 1) * b_dim1], ldb, &c[is + (je + 1) * c_dim1], ldc);
+ i__2 = *n - je;
+ daxpy_(&i__2, &rhs[3], &e[jsp1 + (je + 1) * e_dim1], lde, &f[is + (je + 1) * f_dim1], ldf);
+ }
+
+ } else if (mb == 2 && nb == 1) {
+
+/* Build a 4-by-4 system Z * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = a[isp1 + is * a_dim1];
+ z[2] = d[is + is * d_dim1];
+ z[3] = 0.;
+
+ z[8] = a[is + isp1 * a_dim1];
+ z[9] = a[isp1 + isp1 * a_dim1];
+ z[10] = d[is + isp1 * d_dim1];
+ z[11] = d[isp1 + isp1 * d_dim1];
+
+ z[16] = -b[js + js * b_dim1];
+ z[17] = 0.;
+ z[18] = -e[js + js * e_dim1];
+ z[19] = 0.;
+
+ z[24] = 0.;
+ z[25] = -b[js + js * b_dim1];
+ z[26] = 0.;
+ z[27] = -e[js + js * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = c[isp1 + js * c_dim1];
+ rhs[2] = f[is + js * f_dim1];
+ rhs[3] = f[isp1 + js * f_dim1];
+
+/* Solve Z * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+ if (*ijob == 0) {
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+ } else {
+ dlatdf_(ijob, &zdim, z, &c__8, rhs, rdsum, rdscal, ipiv, jpiv);
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ c[isp1 + js * c_dim1] = rhs[1];
+ f[is + js * f_dim1] = rhs[2];
+ f[isp1 + js * f_dim1] = rhs[3];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (i > 1) {
+ i__2 = is - 1;
+ dgemv_("N", &i__2, &mb, &c_b27, &a[is * a_dim1 + 1], lda,
+ rhs, &c__1, &c_b42, &c[js * c_dim1 + 1], &c__1);
+ i__2 = is - 1;
+ dgemv_("N", &i__2, &mb, &c_b27, &d[is * d_dim1 + 1], ldd,
+ rhs, &c__1, &c_b42, &f[js * f_dim1 + 1], &c__1);
+ }
+ if (j < q) {
+ i__2 = *n - je;
+ dger_(&mb, &i__2, &c_b42, &rhs[2], &c__1,
+ &b[js + (je + 1) * b_dim1], ldb, &c[is + (je + 1) * c_dim1], ldc);
+ i__2 = *n - je;
+ dger_(&mb, &i__2, &c_b42, &rhs[2], &c__1,
+ &e[js + (je + 1) * e_dim1], ldb, &f[is + (je + 1) * f_dim1], ldc);
+ }
+
+ } else if (mb == 2 && nb == 2) {
+
+/* Build an 8-by-8 system Z * x = RHS */
+
+ dcopy_(&c__64, &c_b54, &c__0, z, &c__1);
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = a[isp1 + is * a_dim1];
+ z[4] = d[is + is * d_dim1];
+
+ z[8] = a[is + isp1 * a_dim1];
+ z[9] = a[isp1 + isp1 * a_dim1];
+ z[12] = d[is + isp1 * d_dim1];
+ z[13] = d[isp1 + isp1 * d_dim1];
+
+ z[18] = a[is + is * a_dim1];
+ z[19] = a[isp1 + is * a_dim1];
+ z[22] = d[is + is * d_dim1];
+
+ z[26] = a[is + isp1 * a_dim1];
+ z[27] = a[isp1 + isp1 * a_dim1];
+ z[30] = d[is + isp1 * d_dim1];
+ z[31] = d[isp1 + isp1 * d_dim1];
+
+ z[32] = -b[js + js * b_dim1];
+ z[34] = -b[js + jsp1 * b_dim1];
+ z[36] = -e[js + js * e_dim1];
+ z[38] = -e[js + jsp1 * e_dim1];
+
+ z[41] = -b[js + js * b_dim1];
+ z[43] = -b[js + jsp1 * b_dim1];
+ z[45] = -e[js + js * e_dim1];
+ z[47] = -e[js + jsp1 * e_dim1];
+
+ z[48] = -b[jsp1 + js * b_dim1];
+ z[50] = -b[jsp1 + jsp1 * b_dim1];
+ z[54] = -e[jsp1 + jsp1 * e_dim1];
+
+ z[57] = -b[jsp1 + js * b_dim1];
+ z[59] = -b[jsp1 + jsp1 * b_dim1];
+ z[63] = -e[jsp1 + jsp1 * e_dim1];
+
+/* Set up right hand side(s) */
+
+ k = 1;
+ ii = mb * nb + 1;
+ i__2 = nb - 1;
+ for (jj = 0; jj <= i__2; ++jj) {
+ dcopy_(&mb, &c[is + (js + jj) * c_dim1], &c__1, &rhs[k - 1], &c__1);
+ dcopy_(&mb, &f[is + (js + jj) * f_dim1], &c__1, &rhs[ii - 1], &c__1);
+ k += mb;
+ ii += mb;
+ }
+
+/* Solve Z * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+ if (*ijob == 0) {
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+ } else {
+ dlatdf_(ijob, &zdim, z, &c__8, rhs, rdsum, rdscal, ipiv, jpiv);
+ }
+
+/* Unpack solution vector(s) */
+
+ k = 1;
+ ii = mb * nb + 1;
+ i__2 = nb - 1;
+ for (jj = 0; jj <= i__2; ++jj) {
+ dcopy_(&mb, &rhs[k - 1], &c__1, &c[is + (js + jj) * c_dim1], &c__1);
+ dcopy_(&mb, &rhs[ii - 1], &c__1, &f[is + (js + jj) * f_dim1], &c__1);
+ k += mb;
+ ii += mb;
+ }
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (i > 1) {
+ i__2 = is - 1;
+ dgemm_("N", "N", &i__2, &nb, &mb, &c_b27, &a[is * a_dim1 + 1], lda,
+ rhs, &mb, &c_b42, &c[js * c_dim1 + 1], ldc);
+ i__2 = is - 1;
+ dgemm_("N", "N", &i__2, &nb, &mb, &c_b27, &d[is * d_dim1 + 1], ldd,
+ rhs, &mb, &c_b42, &f[js * f_dim1 + 1], ldf);
+ }
+ if (j < q) {
+ k = mb * nb + 1;
+ i__2 = *n - je;
+ dgemm_("N", "N", &mb, &i__2, &nb, &c_b42, &rhs[k - 1], &mb,
+ &b[js + (je + 1) * b_dim1], ldb, &c_b42,
+ &c[is + (je + 1) * c_dim1], ldc);
+ i__2 = *n - je;
+ dgemm_("N", "N", &mb, &i__2, &nb, &c_b42, &rhs[k - 1], &mb,
+ &e[js + (je + 1) * e_dim1], lde, &c_b42,
+ &f[is + (je + 1) * f_dim1], ldf);
+ }
+ }
+ }
+ }
+ } else {
+
+/* Solve (I, J) - subsystem */
+/* A(I, I)' * R(I, J) + D(I, I)' * L(J, J) = C(I, J) */
+/* R(I, I) * B(J, J) + L(I, J) * E(J, J) = -F(I, J) */
+/* for I = 1, 2, ..., P, J = Q, Q - 1, ..., 1 */
+
+ *scale = 1.;
+ scaloc = 1.;
+ i__1 = p;
+ for (i = 1; i <= i__1; ++i) {
+
+ is = iwork[i];
+ isp1 = is + 1;
+ ie = iwork[i + 1] - 1;
+ mb = ie - is + 1;
+ i__2 = p + 2;
+ for (j = q; j >= i__2; --j) {
+
+ js = iwork[j];
+ jsp1 = js + 1;
+ je = iwork[j + 1] - 1;
+ nb = je - js + 1;
+ zdim = mb * nb << 1;
+ if (mb == 1 && nb == 1) {
+
+/* Build a 2-by-2 system Z' * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = -b[js + js * b_dim1];
+ z[8] = d[is + is * d_dim1];
+ z[9] = -e[js + js * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = f[is + js * f_dim1];
+
+/* Solve Z' * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__3 = *n;
+ for (k = 1; k <= i__3; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ f[is + js * f_dim1] = rhs[1];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (j > p + 2) {
+ alpha = rhs[0];
+ i__3 = js - 1;
+ daxpy_(&i__3, &alpha, &b[js * b_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ alpha = rhs[1];
+ i__3 = js - 1;
+ daxpy_(&i__3, &alpha, &e[js * e_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ }
+ if (i < p) {
+ alpha = -rhs[0];
+ i__3 = *m - ie;
+ daxpy_(&i__3, &alpha, &a[is + (ie + 1) * a_dim1], lda, &c[ie + 1 + js * c_dim1], &c__1);
+ alpha = -rhs[1];
+ i__3 = *m - ie;
+ daxpy_(&i__3, &alpha, &d[is + (ie + 1) * d_dim1], ldd, &c[ie + 1 + js * c_dim1], &c__1);
+ }
+
+ } else if (mb == 1 && nb == 2) {
+
+/* Build a 4-by-4 system Z' * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = 0.;
+ z[2] = -b[js + js * b_dim1];
+ z[3] = -b[jsp1 + js * b_dim1];
+
+ z[8] = 0.;
+ z[9] = a[is + is * a_dim1];
+ z[10] = -b[js + jsp1 * b_dim1];
+ z[11] = -b[jsp1 + jsp1 * b_dim1];
+
+ z[16] = d[is + is * d_dim1];
+ z[17] = 0.;
+ z[18] = -e[js + js * e_dim1];
+ z[19] = 0.;
+
+ z[24] = 0.;
+ z[25] = d[is + is * d_dim1];
+ z[26] = -e[js + jsp1 * e_dim1];
+ z[27] = -e[jsp1 + jsp1 * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = c[is + jsp1 * c_dim1];
+ rhs[2] = f[is + js * f_dim1];
+ rhs[3] = f[is + jsp1 * f_dim1];
+
+/* Solve Z' * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__3 = *n;
+ for (k = 1; k <= i__3; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ c[is + jsp1 * c_dim1] = rhs[1];
+ f[is + js * f_dim1] = rhs[2];
+ f[is + jsp1 * f_dim1] = rhs[3];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (j > p + 2) {
+ i__3 = js - 1;
+ daxpy_(&i__3, rhs, &b[js * b_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ i__3 = js - 1;
+ daxpy_(&i__3, &rhs[1], &b[jsp1 * b_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ i__3 = js - 1;
+ daxpy_(&i__3, &rhs[2], &e[js * e_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ i__3 = js - 1;
+ daxpy_(&i__3, &rhs[3], &e[jsp1 * e_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ }
+ if (i < p) {
+ i__3 = *m - ie;
+ dger_(&i__3, &nb, &c_b27, &a[is + (ie + 1) * a_dim1], lda, rhs,
+ &c__1, &c[ie + 1 + js * c_dim1], ldc);
+ i__3 = *m - ie;
+ dger_(&i__3, &nb, &c_b27, &d[is + (ie + 1) * d_dim1], ldd,
+ &rhs[2], &c__1, &c[ie + 1 + js * c_dim1], ldc);
+ }
+
+ } else if (mb == 2 && nb == 1) {
+
+/* Build a 4-by-4 system Z' * x = RHS */
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = a[is + isp1 * a_dim1];
+ z[2] = -b[js + js * b_dim1];
+ z[3] = 0.;
+
+ z[8] = a[isp1 + is * a_dim1];
+ z[9] = a[isp1 + isp1 * a_dim1];
+ z[10] = 0.;
+ z[11] = -b[js + js * b_dim1];
+
+ z[16] = d[is + is * d_dim1];
+ z[17] = d[is + isp1 * d_dim1];
+ z[18] = -e[js + js * e_dim1];
+ z[19] = 0.;
+
+ z[24] = 0.;
+ z[25] = d[isp1 + isp1 * d_dim1];
+ z[26] = 0.;
+ z[27] = -e[js + js * e_dim1];
+
+/* Set up right hand side(s) */
+
+ rhs[0] = c[is + js * c_dim1];
+ rhs[1] = c[isp1 + js * c_dim1];
+ rhs[2] = f[is + js * f_dim1];
+ rhs[3] = f[isp1 + js * f_dim1];
+
+/* Solve Z' * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__3 = *n;
+ for (k = 1; k <= i__3; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Unpack solution vector(s) */
+
+ c[is + js * c_dim1] = rhs[0];
+ c[isp1 + js * c_dim1] = rhs[1];
+ f[is + js * f_dim1] = rhs[2];
+ f[isp1 + js * f_dim1] = rhs[3];
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (j > p + 2) {
+ i__3 = js - 1;
+ dger_(&mb, &i__3, &c_b42, rhs, &c__1, &b[js * b_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ i__3 = js - 1;
+ dger_(&mb, &i__3, &c_b42, &rhs[2], &c__1, &e[js * e_dim1 + 1], &c__1, &f[is + f_dim1], ldf);
+ }
+ if (i < p) {
+ i__3 = *m - ie;
+ dgemv_("T", &mb, &i__3, &c_b27, &a[is + (ie + 1) * a_dim1], lda,
+ rhs, &c__1, &c_b42, &c[ie + 1 + js * c_dim1], &c__1);
+ i__3 = *m - ie;
+ dgemv_("T", &mb, &i__3, &c_b27, &d[is + (ie + 1) * d_dim1], ldd,
+ &rhs[2], &c__1, &c_b42, &c[ie + 1 + js * c_dim1], &c__1);
+ }
+
+ } else if (mb == 2 && nb == 2) {
+
+/* Build an 8-by-8 system Z' * x = RHS */
+
+ dcopy_(&c__64, &c_b54, &c__0, z, &c__1);
+
+ z[0] = a[is + is * a_dim1];
+ z[1] = a[is + isp1 * a_dim1];
+ z[4] = -b[js + js * b_dim1];
+ z[6] = -b[jsp1 + js * b_dim1];
+
+ z[8] = a[isp1 + is * a_dim1];
+ z[9] = a[isp1 + isp1 * a_dim1];
+ z[13] = -b[js + js * b_dim1];
+ z[15] = -b[jsp1 + js * b_dim1];
+
+ z[18] = a[is + is * a_dim1];
+ z[19] = a[is + isp1 * a_dim1];
+ z[20] = -b[js + jsp1 * b_dim1];
+ z[22] = -b[jsp1 + jsp1 * b_dim1];
+
+ z[26] = a[isp1 + is * a_dim1];
+ z[27] = a[isp1 + isp1 * a_dim1];
+ z[29] = -b[js + jsp1 * b_dim1];
+ z[31] = -b[jsp1 + jsp1 * b_dim1];
+
+ z[32] = d[is + is * d_dim1];
+ z[33] = d[is + isp1 * d_dim1];
+ z[36] = -e[js + js * e_dim1];
+
+ z[41] = d[isp1 + isp1 * d_dim1];
+ z[45] = -e[js + js * e_dim1];
+
+ z[50] = d[is + is * d_dim1];
+ z[51] = d[is + isp1 * d_dim1];
+ z[52] = -e[js + jsp1 * e_dim1];
+ z[54] = -e[jsp1 + jsp1 * e_dim1];
+
+ z[59] = d[isp1 + isp1 * d_dim1];
+ z[61] = -e[js + jsp1 * e_dim1];
+ z[63] = -e[jsp1 + jsp1 * e_dim1];
+
+/* Set up right hand side(s) */
+
+ k = 1;
+ ii = mb * nb + 1;
+ i__3 = nb - 1;
+ for (jj = 0; jj <= i__3; ++jj) {
+ dcopy_(&mb, &c[is + (js + jj) * c_dim1], &c__1, &rhs[k - 1], &c__1);
+ dcopy_(&mb, &f[is + (js + jj) * f_dim1], &c__1, &rhs[ii - 1], &c__1);
+ k += mb;
+ ii += mb;
+ }
+
+
+/* Solve Z' * x = RHS */
+
+ dgetc2_(&zdim, z, &c__8, ipiv, jpiv, &ierr);
+ if (ierr > 0) {
+ *info = ierr;
+ }
+
+ dgesc2_(&zdim, z, &c__8, rhs, ipiv, jpiv, &scaloc);
+ if (scaloc != 1.) {
+ i__3 = *n;
+ for (k = 1; k <= i__3; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Unpack solution vector(s) */
+
+ k = 1;
+ ii = mb * nb + 1;
+ i__3 = nb - 1;
+ for (jj = 0; jj <= i__3; ++jj) {
+ dcopy_(&mb, &rhs[k - 1], &c__1, &c[is + (js + jj) * c_dim1], &c__1);
+ dcopy_(&mb, &rhs[ii - 1], &c__1, &f[is + (js + jj) * f_dim1], &c__1);
+ k += mb;
+ ii += mb;
+ }
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (j > p + 2) {
+ i__3 = js - 1;
+ dgemm_("N", "T", &mb, &i__3, &nb, &c_b42, &c[is + js * c_dim1], ldc,
+ &b[js * b_dim1 + 1], ldb, &c_b42, &f[is + f_dim1], ldf);
+ i__3 = js - 1;
+ dgemm_("N", "T", &mb, &i__3, &nb, &c_b42, &f[is + js * f_dim1], ldf,
+ &e[js * e_dim1 + 1], lde, &c_b42, &f[is + f_dim1], ldf);
+ }
+ if (i < p) {
+ i__3 = *m - ie;
+ dgemm_("T", "N", &i__3, &nb, &mb, &c_b27, &a[is + (ie + 1) * a_dim1], lda,
+ &c[is + js * c_dim1], ldc, &c_b42, &c[ie + 1 + js * c_dim1], ldc);
+ i__3 = *m - ie;
+ dgemm_("T", "N", &i__3, &nb, &mb, &c_b27, &d[is + (ie + 1) * d_dim1], ldd,
+ &f[is + js * f_dim1], ldf, &c_b42, &c[ie + 1 + js * c_dim1], ldc);
+ }
+ }
+ }
+ }
+ }
+} /* dtgsy2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.f
new file mode 100644
index 0000000000000000000000000000000000000000..114e753af696c2f64a9249fdace52c3537202666
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsy2.f
@@ -0,0 +1,950 @@
+ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
+ $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
+ $ IWORK, PQ, INFO )
+*
+* -- LAPACK auxiliary routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ CHARACTER TRANS
+ INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N,
+ $ PQ
+ DOUBLE PRECISION RDSCAL, RDSUM, SCALE
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
+ $ D( LDD, * ), E( LDE, * ), F( LDF, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGSY2 solves the generalized Sylvester equation:
+*
+* A * R - L * B = scale * C (1)
+* D * R - L * E = scale * F,
+*
+* using Level 1 and 2 BLAS. where R and L are unknown M-by-N matrices,
+* (A, D), (B, E) and (C, F) are given matrix pairs of size M-by-M,
+* N-by-N and M-by-N, respectively, with real entries. (A, D) and (B, E)
+* must be in generalized Schur canonical form, i.e. A, B are upper
+* quasi triangular and D, E are upper triangular. The solution (R, L)
+* overwrites (C, F). 0 <= SCALE <= 1 is an output scaling factor
+* chosen to avoid overflow.
+*
+* In matrix notation solving equation (1) corresponds to solve
+* Z*x = scale*b, where Z is defined as
+*
+* Z = [ kron(In, A) -kron(B', Im) ] (2)
+* [ kron(In, D) -kron(E', Im) ],
+*
+* Ik is the identity matrix of size k and X' is the transpose of X.
+* kron(X, Y) is the Kronecker product between the matrices X and Y.
+* In the process of solving (1), we solve a number of such systems
+* where Dim(In), Dim(In) = 1 or 2.
+*
+* If TRANS = 'T', solve the transposed system Z'*y = scale*b for y,
+* which is equivalent to solve for R and L in
+*
+* A' * R + D' * L = scale * C (3)
+* R * B' + L * E' = scale * -F
+*
+* This case is used to compute an estimate of Dif[(A, D), (B, E)] =
+* sigma_min(Z) using reverse communicaton with DLACON.
+*
+* DTGSY2 also (IJOB >= 1) contributes to the computation in STGSYL
+* of an upper bound on the separation between to matrix pairs. Then
+* the input (A, D), (B, E) are sub-pencils of the matrix pair in
+* DTGSYL. See STGSYL for details.
+*
+* Arguments
+* =========
+*
+* TRANS (input) CHARACTER
+* = 'N', solve the generalized Sylvester equation (1).
+* = 'T': solve the 'transposed' system (3).
+*
+* IJOB (input) INTEGER
+* Specifies what kind of functionality to be performed.
+* = 0: solve (1) only.
+* = 1: A contribution from this subsystem to a Frobenius
+* norm-based estimate of the separation between two matrix
+* pairs is computed. (look ahead strategy is used).
+* = 2: A contribution from this subsystem to a Frobenius
+* norm-based estimate of the separation between two matrix
+* pairs is computed. (DGECON on sub-systems is used.)
+* Not referenced if TRANS = 'T'.
+*
+* M (input) INTEGER
+* On entry, M specifies the order of A and D, and the row
+* dimension of C, F, R and L.
+*
+* N (input) INTEGER
+* On entry, N specifies the order of B and E, and the column
+* dimension of C, F, R and L.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA, M)
+* On entry, A contains an upper quasi triangular matrix.
+*
+* LDA (input) INTEGER
+* The leading dimension of the matrix A. LDA >= max(1, M).
+*
+* B (input) DOUBLE PRECISION array, dimension (LDB, N)
+* On entry, B contains an upper quasi triangular matrix.
+*
+* LDB (input) INTEGER
+* The leading dimension of the matrix B. LDB >= max(1, N).
+*
+* C (input/ output) DOUBLE PRECISION array, dimension (LDC, N)
+* On entry, C contains the right-hand-side of the first matrix
+* equation in (1).
+* On exit, if IJOB = 0, C has been overwritten by the
+* solution R.
+*
+* LDC (input) INTEGER
+* The leading dimension of the matrix C. LDC >= max(1, M).
+*
+* D (input) DOUBLE PRECISION array, dimension (LDD, M)
+* On entry, D contains an upper triangular matrix.
+*
+* LDD (input) INTEGER
+* The leading dimension of the matrix D. LDD >= max(1, M).
+*
+* E (input) DOUBLE PRECISION array, dimension (LDE, N)
+* On entry, E contains an upper triangular matrix.
+*
+* LDE (input) INTEGER
+* The leading dimension of the matrix E. LDE >= max(1, N).
+*
+* F (input/ output) DOUBLE PRECISION array, dimension (LDF, N)
+* On entry, F contains the right-hand-side of the second matrix
+* equation in (1).
+* On exit, if IJOB = 0, F has been overwritten by the
+* solution L.
+*
+* LDF (input) INTEGER
+* The leading dimension of the matrix F. LDF >= max(1, M).
+*
+* SCALE (output) DOUBLE PRECISION
+* On exit, 0 <= SCALE <= 1. If 0 < SCALE < 1, the solutions
+* R and L (C and F on entry) will hold the solutions to a
+* slightly perturbed system but the input matrices A, B, D and
+* E have not been changed. If SCALE = 0, R and L will hold the
+* solutions to the homogeneous system with C = F = 0. Normally,
+* SCALE = 1.
+*
+* RDSUM (input/output) DOUBLE PRECISION
+* On entry, the sum of squares of computed contributions to
+* the Dif-estimate under computation by DTGSYL, where the
+* scaling factor RDSCAL (see below) has been factored out.
+* On exit, the corresponding sum of squares updated with the
+* contributions from the current sub-system.
+* If TRANS = 'T' RDSUM is not touched.
+* NOTE: RDSUM only makes sense when DTGSY2 is called by STGSYL.
+*
+* RDSCAL (input/output) DOUBLE PRECISION
+* On entry, scaling factor used to prevent overflow in RDSUM.
+* On exit, RDSCAL is updated w.r.t. the current contributions
+* in RDSUM.
+* If TRANS = 'T', RDSCAL is not touched.
+* NOTE: RDSCAL only makes sense when DTGSY2 is called by
+* DTGSYL.
+*
+* IWORK (workspace) INTEGER array, dimension (M+N+2)
+*
+* PQ (output) INTEGER
+* On exit, the number of subsystems (of size 2-by-2, 4-by-4 and
+* 8-by-8) solved by this routine.
+*
+* INFO (output) INTEGER
+* On exit, if INFO is set to
+* =0: Successful exit
+* <0: If INFO = -i, the i-th argument had an illegal value.
+* >0: The matrix pairs (A, D) and (B, E) have common or very
+* close eigenvalues.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER LDZ
+ PARAMETER ( LDZ = 8 )
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL NOTRAN
+ INTEGER I, IE, IERR, II, IS, ISP1, J, JE, JJ, JS, JSP1,
+ $ K, MB, NB, P, Q, ZDIM
+ DOUBLE PRECISION ALPHA, SCALOC
+* ..
+* .. Local Arrays ..
+ INTEGER IPIV( LDZ ), JPIV( LDZ )
+ DOUBLE PRECISION RHS( LDZ ), Z( LDZ, LDZ )
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DGER, DGESC2,
+ $ DGETC2, DLATDF, DSCAL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Decode and test input parameters
+*
+ INFO = 0
+ IERR = 0
+ NOTRAN = LSAME( TRANS, 'N' )
+ IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -1
+ ELSE IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.2 ) ) THEN
+ INFO = -2
+ ELSE IF( M.LE.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LE.0 ) THEN
+ INFO = -4
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -8
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
+ INFO = -12
+ ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
+ INFO = -14
+ ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
+ INFO = -16
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGSY2', -INFO )
+ RETURN
+ END IF
+*
+* Determine block structure of A
+*
+ PQ = 0
+ P = 0
+ I = 1
+ 10 CONTINUE
+ IF( I.GT.M )
+ $ GO TO 20
+ P = P + 1
+ IWORK( P ) = I
+ IF( I.EQ.M )
+ $ GO TO 20
+ IF( A( I+1, I ).NE.ZERO ) THEN
+ I = I + 2
+ ELSE
+ I = I + 1
+ END IF
+ GO TO 10
+ 20 CONTINUE
+ IWORK( P+1 ) = M + 1
+*
+* Determine block structure of B
+*
+ Q = P + 1
+ J = 1
+ 30 CONTINUE
+ IF( J.GT.N )
+ $ GO TO 40
+ Q = Q + 1
+ IWORK( Q ) = J
+ IF( J.EQ.N )
+ $ GO TO 40
+ IF( B( J+1, J ).NE.ZERO ) THEN
+ J = J + 2
+ ELSE
+ J = J + 1
+ END IF
+ GO TO 30
+ 40 CONTINUE
+ IWORK( Q+1 ) = N + 1
+ PQ = P*( Q-P-1 )
+*
+ IF( NOTRAN ) THEN
+*
+* Solve (I, J) - subsystem
+* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
+* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
+* for I = P, P - 1, ..., 1; J = 1, 2, ..., Q
+*
+ SCALE = ONE
+ SCALOC = ONE
+ DO 120 J = P + 2, Q
+ JS = IWORK( J )
+ JSP1 = JS + 1
+ JE = IWORK( J+1 ) - 1
+ NB = JE - JS + 1
+ DO 110 I = P, 1, -1
+*
+ IS = IWORK( I )
+ ISP1 = IS + 1
+ IE = IWORK( I+1 ) - 1
+ MB = IE - IS + 1
+ ZDIM = MB*NB*2
+*
+ IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
+*
+* Build a 2-by-2 system Z * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = D( IS, IS )
+ Z( 1, 2 ) = -B( JS, JS )
+ Z( 2, 2 ) = -E( JS, JS )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = F( IS, JS )
+*
+* Solve Z * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+*
+ IF( IJOB.EQ.0 ) THEN
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
+ $ SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 50 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 50 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+ ELSE
+ CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
+ $ RDSCAL, IPIV, JPIV )
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ F( IS, JS ) = RHS( 2 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( I.GT.1 ) THEN
+ ALPHA = -RHS( 1 )
+ CALL DAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ),
+ $ 1 )
+ CALL DAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ),
+ $ 1 )
+ END IF
+ IF( J.LT.Q ) THEN
+ CALL DAXPY( N-JE, RHS( 2 ), B( JS, JE+1 ), LDB,
+ $ C( IS, JE+1 ), LDC )
+ CALL DAXPY( N-JE, RHS( 2 ), E( JS, JE+1 ), LDE,
+ $ F( IS, JE+1 ), LDF )
+ END IF
+*
+ ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
+*
+* Build a 4-by-4 system Z * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = ZERO
+ Z( 3, 1 ) = D( IS, IS )
+ Z( 4, 1 ) = ZERO
+*
+ Z( 1, 2 ) = ZERO
+ Z( 2, 2 ) = A( IS, IS )
+ Z( 3, 2 ) = ZERO
+ Z( 4, 2 ) = D( IS, IS )
+*
+ Z( 1, 3 ) = -B( JS, JS )
+ Z( 2, 3 ) = -B( JS, JSP1 )
+ Z( 3, 3 ) = -E( JS, JS )
+ Z( 4, 3 ) = -E( JS, JSP1 )
+*
+ Z( 1, 4 ) = -B( JSP1, JS )
+ Z( 2, 4 ) = -B( JSP1, JSP1 )
+ Z( 3, 4 ) = ZERO
+ Z( 4, 4 ) = -E( JSP1, JSP1 )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = C( IS, JSP1 )
+ RHS( 3 ) = F( IS, JS )
+ RHS( 4 ) = F( IS, JSP1 )
+*
+* Solve Z * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+*
+ IF( IJOB.EQ.0 ) THEN
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
+ $ SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 60 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 60 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+ ELSE
+ CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
+ $ RDSCAL, IPIV, JPIV )
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ C( IS, JSP1 ) = RHS( 2 )
+ F( IS, JS ) = RHS( 3 )
+ F( IS, JSP1 ) = RHS( 4 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( I.GT.1 ) THEN
+ CALL DGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ),
+ $ 1, C( 1, JS ), LDC )
+ CALL DGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ),
+ $ 1, F( 1, JS ), LDF )
+ END IF
+ IF( J.LT.Q ) THEN
+ CALL DAXPY( N-JE, RHS( 3 ), B( JS, JE+1 ), LDB,
+ $ C( IS, JE+1 ), LDC )
+ CALL DAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE,
+ $ F( IS, JE+1 ), LDF )
+ CALL DAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB,
+ $ C( IS, JE+1 ), LDC )
+ CALL DAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE,
+ $ F( IS, JE+1 ), LDF )
+ END IF
+*
+ ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
+*
+* Build a 4-by-4 system Z * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = A( ISP1, IS )
+ Z( 3, 1 ) = D( IS, IS )
+ Z( 4, 1 ) = ZERO
+*
+ Z( 1, 2 ) = A( IS, ISP1 )
+ Z( 2, 2 ) = A( ISP1, ISP1 )
+ Z( 3, 2 ) = D( IS, ISP1 )
+ Z( 4, 2 ) = D( ISP1, ISP1 )
+*
+ Z( 1, 3 ) = -B( JS, JS )
+ Z( 2, 3 ) = ZERO
+ Z( 3, 3 ) = -E( JS, JS )
+ Z( 4, 3 ) = ZERO
+*
+ Z( 1, 4 ) = ZERO
+ Z( 2, 4 ) = -B( JS, JS )
+ Z( 3, 4 ) = ZERO
+ Z( 4, 4 ) = -E( JS, JS )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = C( ISP1, JS )
+ RHS( 3 ) = F( IS, JS )
+ RHS( 4 ) = F( ISP1, JS )
+*
+* Solve Z * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+ IF( IJOB.EQ.0 ) THEN
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
+ $ SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 70 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 70 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+ ELSE
+ CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
+ $ RDSCAL, IPIV, JPIV )
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ C( ISP1, JS ) = RHS( 2 )
+ F( IS, JS ) = RHS( 3 )
+ F( ISP1, JS ) = RHS( 4 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( I.GT.1 ) THEN
+ CALL DGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA,
+ $ RHS( 1 ), 1, ONE, C( 1, JS ), 1 )
+ CALL DGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD,
+ $ RHS( 1 ), 1, ONE, F( 1, JS ), 1 )
+ END IF
+ IF( J.LT.Q ) THEN
+ CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
+ $ B( JS, JE+1 ), LDB, C( IS, JE+1 ), LDC )
+ CALL DGER( MB, N-JE, ONE, RHS( 3 ), 1,
+ $ E( JS, JE+1 ), LDB, F( IS, JE+1 ), LDC )
+ END IF
+*
+ ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
+*
+* Build an 8-by-8 system Z * x = RHS
+*
+ CALL DCOPY( LDZ*LDZ, ZERO, 0, Z, 1 )
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = A( ISP1, IS )
+ Z( 5, 1 ) = D( IS, IS )
+*
+ Z( 1, 2 ) = A( IS, ISP1 )
+ Z( 2, 2 ) = A( ISP1, ISP1 )
+ Z( 5, 2 ) = D( IS, ISP1 )
+ Z( 6, 2 ) = D( ISP1, ISP1 )
+*
+ Z( 3, 3 ) = A( IS, IS )
+ Z( 4, 3 ) = A( ISP1, IS )
+ Z( 7, 3 ) = D( IS, IS )
+*
+ Z( 3, 4 ) = A( IS, ISP1 )
+ Z( 4, 4 ) = A( ISP1, ISP1 )
+ Z( 7, 4 ) = D( IS, ISP1 )
+ Z( 8, 4 ) = D( ISP1, ISP1 )
+*
+ Z( 1, 5 ) = -B( JS, JS )
+ Z( 3, 5 ) = -B( JS, JSP1 )
+ Z( 5, 5 ) = -E( JS, JS )
+ Z( 7, 5 ) = -E( JS, JSP1 )
+*
+ Z( 2, 6 ) = -B( JS, JS )
+ Z( 4, 6 ) = -B( JS, JSP1 )
+ Z( 6, 6 ) = -E( JS, JS )
+ Z( 8, 6 ) = -E( JS, JSP1 )
+*
+ Z( 1, 7 ) = -B( JSP1, JS )
+ Z( 3, 7 ) = -B( JSP1, JSP1 )
+ Z( 7, 7 ) = -E( JSP1, JSP1 )
+*
+ Z( 2, 8 ) = -B( JSP1, JS )
+ Z( 4, 8 ) = -B( JSP1, JSP1 )
+ Z( 8, 8 ) = -E( JSP1, JSP1 )
+*
+* Set up right hand side(s)
+*
+ K = 1
+ II = MB*NB + 1
+ DO 80 JJ = 0, NB - 1
+ CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
+ CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
+ K = K + MB
+ II = II + MB
+ 80 CONTINUE
+*
+* Solve Z * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+ IF( IJOB.EQ.0 ) THEN
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV,
+ $ SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 90 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 90 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+ ELSE
+ CALL DLATDF( IJOB, ZDIM, Z, LDZ, RHS, RDSUM,
+ $ RDSCAL, IPIV, JPIV )
+ END IF
+*
+* Unpack solution vector(s)
+*
+ K = 1
+ II = MB*NB + 1
+ DO 100 JJ = 0, NB - 1
+ CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
+ CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
+ K = K + MB
+ II = II + MB
+ 100 CONTINUE
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( I.GT.1 ) THEN
+ CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
+ $ A( 1, IS ), LDA, RHS( 1 ), MB, ONE,
+ $ C( 1, JS ), LDC )
+ CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
+ $ D( 1, IS ), LDD, RHS( 1 ), MB, ONE,
+ $ F( 1, JS ), LDF )
+ END IF
+ IF( J.LT.Q ) THEN
+ K = MB*NB + 1
+ CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
+ $ MB, B( JS, JE+1 ), LDB, ONE,
+ $ C( IS, JE+1 ), LDC )
+ CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ),
+ $ MB, E( JS, JE+1 ), LDE, ONE,
+ $ F( IS, JE+1 ), LDF )
+ END IF
+*
+ END IF
+*
+ 110 CONTINUE
+ 120 CONTINUE
+ ELSE
+*
+* Solve (I, J) - subsystem
+* A(I, I)' * R(I, J) + D(I, I)' * L(J, J) = C(I, J)
+* R(I, I) * B(J, J) + L(I, J) * E(J, J) = -F(I, J)
+* for I = 1, 2, ..., P, J = Q, Q - 1, ..., 1
+*
+ SCALE = ONE
+ SCALOC = ONE
+ DO 200 I = 1, P
+*
+ IS = IWORK( I )
+ ISP1 = IS + 1
+ IE = IWORK( I+1 ) - 1
+ MB = IE - IS + 1
+ DO 190 J = Q, P + 2, -1
+*
+ JS = IWORK( J )
+ JSP1 = JS + 1
+ JE = IWORK( J+1 ) - 1
+ NB = JE - JS + 1
+ ZDIM = MB*NB*2
+ IF( ( MB.EQ.1 ) .AND. ( NB.EQ.1 ) ) THEN
+*
+* Build a 2-by-2 system Z' * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = -B( JS, JS )
+ Z( 1, 2 ) = D( IS, IS )
+ Z( 2, 2 ) = -E( JS, JS )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = F( IS, JS )
+*
+* Solve Z' * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+*
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 130 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 130 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ F( IS, JS ) = RHS( 2 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( J.GT.P+2 ) THEN
+ ALPHA = RHS( 1 )
+ CALL DAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ),
+ $ LDF )
+ ALPHA = RHS( 2 )
+ CALL DAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ),
+ $ LDF )
+ END IF
+ IF( I.LT.P ) THEN
+ ALPHA = -RHS( 1 )
+ CALL DAXPY( M-IE, ALPHA, A( IS, IE+1 ), LDA,
+ $ C( IE+1, JS ), 1 )
+ ALPHA = -RHS( 2 )
+ CALL DAXPY( M-IE, ALPHA, D( IS, IE+1 ), LDD,
+ $ C( IE+1, JS ), 1 )
+ END IF
+*
+ ELSE IF( ( MB.EQ.1 ) .AND. ( NB.EQ.2 ) ) THEN
+*
+* Build a 4-by-4 system Z' * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = ZERO
+ Z( 3, 1 ) = -B( JS, JS )
+ Z( 4, 1 ) = -B( JSP1, JS )
+*
+ Z( 1, 2 ) = ZERO
+ Z( 2, 2 ) = A( IS, IS )
+ Z( 3, 2 ) = -B( JS, JSP1 )
+ Z( 4, 2 ) = -B( JSP1, JSP1 )
+*
+ Z( 1, 3 ) = D( IS, IS )
+ Z( 2, 3 ) = ZERO
+ Z( 3, 3 ) = -E( JS, JS )
+ Z( 4, 3 ) = ZERO
+*
+ Z( 1, 4 ) = ZERO
+ Z( 2, 4 ) = D( IS, IS )
+ Z( 3, 4 ) = -E( JS, JSP1 )
+ Z( 4, 4 ) = -E( JSP1, JSP1 )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = C( IS, JSP1 )
+ RHS( 3 ) = F( IS, JS )
+ RHS( 4 ) = F( IS, JSP1 )
+*
+* Solve Z' * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 140 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 140 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ C( IS, JSP1 ) = RHS( 2 )
+ F( IS, JS ) = RHS( 3 )
+ F( IS, JSP1 ) = RHS( 4 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( J.GT.P+2 ) THEN
+ CALL DAXPY( JS-1, RHS( 1 ), B( 1, JS ), 1,
+ $ F( IS, 1 ), LDF )
+ CALL DAXPY( JS-1, RHS( 2 ), B( 1, JSP1 ), 1,
+ $ F( IS, 1 ), LDF )
+ CALL DAXPY( JS-1, RHS( 3 ), E( 1, JS ), 1,
+ $ F( IS, 1 ), LDF )
+ CALL DAXPY( JS-1, RHS( 4 ), E( 1, JSP1 ), 1,
+ $ F( IS, 1 ), LDF )
+ END IF
+ IF( I.LT.P ) THEN
+ CALL DGER( M-IE, NB, -ONE, A( IS, IE+1 ), LDA,
+ $ RHS( 1 ), 1, C( IE+1, JS ), LDC )
+ CALL DGER( M-IE, NB, -ONE, D( IS, IE+1 ), LDD,
+ $ RHS( 3 ), 1, C( IE+1, JS ), LDC )
+ END IF
+*
+ ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.1 ) ) THEN
+*
+* Build a 4-by-4 system Z' * x = RHS
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = A( IS, ISP1 )
+ Z( 3, 1 ) = -B( JS, JS )
+ Z( 4, 1 ) = ZERO
+*
+ Z( 1, 2 ) = A( ISP1, IS )
+ Z( 2, 2 ) = A( ISP1, ISP1 )
+ Z( 3, 2 ) = ZERO
+ Z( 4, 2 ) = -B( JS, JS )
+*
+ Z( 1, 3 ) = D( IS, IS )
+ Z( 2, 3 ) = D( IS, ISP1 )
+ Z( 3, 3 ) = -E( JS, JS )
+ Z( 4, 3 ) = ZERO
+*
+ Z( 1, 4 ) = ZERO
+ Z( 2, 4 ) = D( ISP1, ISP1 )
+ Z( 3, 4 ) = ZERO
+ Z( 4, 4 ) = -E( JS, JS )
+*
+* Set up right hand side(s)
+*
+ RHS( 1 ) = C( IS, JS )
+ RHS( 2 ) = C( ISP1, JS )
+ RHS( 3 ) = F( IS, JS )
+ RHS( 4 ) = F( ISP1, JS )
+*
+* Solve Z' * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+*
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 150 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 150 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Unpack solution vector(s)
+*
+ C( IS, JS ) = RHS( 1 )
+ C( ISP1, JS ) = RHS( 2 )
+ F( IS, JS ) = RHS( 3 )
+ F( ISP1, JS ) = RHS( 4 )
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( J.GT.P+2 ) THEN
+ CALL DGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ),
+ $ 1, F( IS, 1 ), LDF )
+ CALL DGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ),
+ $ 1, F( IS, 1 ), LDF )
+ END IF
+ IF( I.LT.P ) THEN
+ CALL DGEMV( 'T', MB, M-IE, -ONE, A( IS, IE+1 ),
+ $ LDA, RHS( 1 ), 1, ONE, C( IE+1, JS ),
+ $ 1 )
+ CALL DGEMV( 'T', MB, M-IE, -ONE, D( IS, IE+1 ),
+ $ LDD, RHS( 3 ), 1, ONE, C( IE+1, JS ),
+ $ 1 )
+ END IF
+*
+ ELSE IF( ( MB.EQ.2 ) .AND. ( NB.EQ.2 ) ) THEN
+*
+* Build an 8-by-8 system Z' * x = RHS
+*
+ CALL DCOPY( LDZ*LDZ, ZERO, 0, Z, 1 )
+*
+ Z( 1, 1 ) = A( IS, IS )
+ Z( 2, 1 ) = A( IS, ISP1 )
+ Z( 5, 1 ) = -B( JS, JS )
+ Z( 7, 1 ) = -B( JSP1, JS )
+*
+ Z( 1, 2 ) = A( ISP1, IS )
+ Z( 2, 2 ) = A( ISP1, ISP1 )
+ Z( 6, 2 ) = -B( JS, JS )
+ Z( 8, 2 ) = -B( JSP1, JS )
+*
+ Z( 3, 3 ) = A( IS, IS )
+ Z( 4, 3 ) = A( IS, ISP1 )
+ Z( 5, 3 ) = -B( JS, JSP1 )
+ Z( 7, 3 ) = -B( JSP1, JSP1 )
+*
+ Z( 3, 4 ) = A( ISP1, IS )
+ Z( 4, 4 ) = A( ISP1, ISP1 )
+ Z( 6, 4 ) = -B( JS, JSP1 )
+ Z( 8, 4 ) = -B( JSP1, JSP1 )
+*
+ Z( 1, 5 ) = D( IS, IS )
+ Z( 2, 5 ) = D( IS, ISP1 )
+ Z( 5, 5 ) = -E( JS, JS )
+*
+ Z( 2, 6 ) = D( ISP1, ISP1 )
+ Z( 6, 6 ) = -E( JS, JS )
+*
+ Z( 3, 7 ) = D( IS, IS )
+ Z( 4, 7 ) = D( IS, ISP1 )
+ Z( 5, 7 ) = -E( JS, JSP1 )
+ Z( 7, 7 ) = -E( JSP1, JSP1 )
+*
+ Z( 4, 8 ) = D( ISP1, ISP1 )
+ Z( 6, 8 ) = -E( JS, JSP1 )
+ Z( 8, 8 ) = -E( JSP1, JSP1 )
+*
+* Set up right hand side(s)
+*
+ K = 1
+ II = MB*NB + 1
+ DO 160 JJ = 0, NB - 1
+ CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 )
+ CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 )
+ K = K + MB
+ II = II + MB
+ 160 CONTINUE
+*
+*
+* Solve Z' * x = RHS
+*
+ CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR )
+ IF( IERR.GT.0 )
+ $ INFO = IERR
+*
+ CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC )
+ IF( SCALOC.NE.ONE ) THEN
+ DO 170 K = 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 170 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Unpack solution vector(s)
+*
+ K = 1
+ II = MB*NB + 1
+ DO 180 JJ = 0, NB - 1
+ CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 )
+ CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 )
+ K = K + MB
+ II = II + MB
+ 180 CONTINUE
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( J.GT.P+2 ) THEN
+ CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
+ $ C( IS, JS ), LDC, B( 1, JS ), LDB, ONE,
+ $ F( IS, 1 ), LDF )
+ CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE,
+ $ F( IS, JS ), LDF, E( 1, JS ), LDE, ONE,
+ $ F( IS, 1 ), LDF )
+ END IF
+ IF( I.LT.P ) THEN
+ CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
+ $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC,
+ $ ONE, C( IE+1, JS ), LDC )
+ CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
+ $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF,
+ $ ONE, C( IE+1, JS ), LDC )
+ END IF
+*
+ END IF
+*
+ 190 CONTINUE
+ 200 CONTINUE
+*
+ END IF
+ RETURN
+*
+* End of DTGSY2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.c
new file mode 100644
index 0000000000000000000000000000000000000000..c7182f674ce9c6a6a6c2d831d443fcd3dc530b3e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.c
@@ -0,0 +1,582 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c_n1 = -1;
+static integer c__5 = 5;
+static doublereal c_b14 = 0.;
+static integer c__0 = 0;
+static integer c__1 = 1;
+static doublereal c_b53 = -1.;
+static doublereal c_b54 = 1.;
+
+/* Subroutine */ void dtgsyl_(trans, ijob, m, n, a, lda, b, ldb, c, ldc, d,
+ ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork, info)
+char *trans;
+integer *ijob, *m, *n;
+doublereal *a;
+integer *lda;
+doublereal *b;
+integer *ldb;
+doublereal *c;
+integer *ldc;
+doublereal *d;
+integer *ldd;
+doublereal *e;
+integer *lde;
+doublereal *f;
+integer *ldf;
+doublereal *scale, *dif, *work;
+integer *lwork, *iwork, *info;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, d_dim1,
+ d_offset, e_dim1, e_offset, f_dim1, f_offset, i__1;
+
+ /* Local variables */
+ static doublereal dsum;
+ static integer ppqq, i, j, k, p, q;
+ static integer ifunc, linfo;
+ static integer lwmin;
+ static doublereal scale2;
+ static integer ie, je, mb, nb;
+ static doublereal dscale;
+ static integer is, js, pq;
+ static doublereal scaloc;
+ static integer iround;
+ static logical notran;
+ static integer isolve;
+ static logical lquery;
+
+
+/* -- LAPACK routine (version 3.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1999 */
+
+/* Purpose */
+/* ======= */
+
+/* DTGSYL solves the generalized Sylvester equation: */
+
+/* A * R - L * B = scale * C (1) */
+/* D * R - L * E = scale * F */
+
+/* where R and L are unknown m-by-n matrices, (A, D), (B, E) and */
+/* (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n, */
+/* respectively, with real entries. (A, D) and (B, E) must be in */
+/* generalized (real) Schur canonical form, i.e. A, B are upper quasi */
+/* triangular and D, E are upper triangular. */
+
+/* The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output */
+/* scaling factor chosen to avoid overflow. */
+
+/* In matrix notation (1) is equivalent to solve Zx = scale b, where */
+/* Z is defined as */
+
+/* Z = [ kron(In, A) -kron(B', Im) ] (2) */
+/* [ kron(In, D) -kron(E', Im) ]. */
+
+/* Here Ik is the identity matrix of size k and X' is the transpose of */
+/* X. kron(X, Y) is the Kronecker product between the matrices X and Y. */
+
+/* If TRANS = 'T', DTGSYL solves the transposed system Z'*y = scale*b, */
+/* which is equivalent to solve for R and L in */
+
+/* A' * R + D' * L = scale * C (3) */
+/* R * B' + L * E' = scale * (-F) */
+
+/* This case (TRANS = 'T') is used to compute an one-norm-based estimate */
+/* of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D) */
+/* and (B,E), using DLACON. */
+
+/* If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate */
+/* of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the */
+/* reciprocal of the smallest singular value of Z. See [1-2] for more */
+/* information. */
+
+/* This is a level 3 BLAS algorithm. */
+
+/* Arguments */
+/* ========= */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N', solve the generalized Sylvester equation (1). */
+/* = 'T', solve the 'transposed' system (3). */
+
+/* IJOB (input) INTEGER */
+/* Specifies what kind of functionality to be performed. */
+/* =0: solve (1) only. */
+/* =1: The functionality of 0 and 3. */
+/* =2: The functionality of 0 and 4. */
+/* =3: Only an estimate of Dif[(A,D), (B,E)] is computed. */
+/* (look ahead strategy IJOB = 1 is used). */
+/* =4: Only an estimate of Dif[(A,D), (B,E)] is computed. */
+/* ( DGECON on sub-systems is used ). */
+/* Not referenced if TRANS = 'T'. */
+
+/* M (input) INTEGER */
+/* The order of the matrices A and D, and the row dimension of */
+/* the matrices C, F, R and L. */
+
+/* N (input) INTEGER */
+/* The order of the matrices B and E, and the column dimension */
+/* of the matrices C, F, R and L. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA, M) */
+/* The upper quasi triangular matrix A. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1, M). */
+
+/* B (input) DOUBLE PRECISION array, dimension (LDB, N) */
+/* The upper quasi triangular matrix B. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1, N). */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC, N) */
+/* On entry, C contains the right-hand-side of the first matrix */
+/* equation in (1) or (3). */
+/* On exit, if IJOB = 0, 1 or 2, C has been overwritten by */
+/* the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R, */
+/* the solution achieved during the computation of the */
+/* Dif-estimate. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1, M). */
+
+/* D (input) DOUBLE PRECISION array, dimension (LDD, M) */
+/* The upper triangular matrix D. */
+
+/* LDD (input) INTEGER */
+/* The leading dimension of the array D. LDD >= max(1, M). */
+
+/* E (input) DOUBLE PRECISION array, dimension (LDE, N) */
+/* The upper triangular matrix E. */
+
+/* LDE (input) INTEGER */
+/* The leading dimension of the array E. LDE >= max(1, N). */
+
+/* F (input/output) DOUBLE PRECISION array, dimension (LDF, N) */
+/* On entry, F contains the right-hand-side of the second matrix */
+/* equation in (1) or (3). */
+/* On exit, if IJOB = 0, 1 or 2, F has been overwritten by */
+/* the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L, */
+/* the solution achieved during the computation of the */
+/* Dif-estimate. */
+
+/* LDF (input) INTEGER */
+/* The leading dimension of the array F. LDF >= max(1, M). */
+
+/* DIF (output) DOUBLE PRECISION */
+/* On exit DIF is the reciprocal of a lower bound of the */
+/* reciprocal of the Dif-function, i.e. DIF is an upper bound of */
+/* Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2). */
+/* IF IJOB = 0 or TRANS = 'T', DIF is not touched. */
+
+/* SCALE (output) DOUBLE PRECISION */
+/* On exit SCALE is the scaling factor in (1) or (3). */
+/* If 0 < SCALE < 1, C and F hold the solutions R and L, resp., */
+/* to a slightly perturbed system but the input matrices A, B, D */
+/* and E have not been changed. If SCALE = 0, C and F hold the */
+/* solutions R and L, respectively, to the homogeneous system */
+/* with C = F = 0. Normally, SCALE = 1. */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+/* If IJOB = 0, WORK is not referenced. Otherwise, */
+/* on exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK > = 1. */
+/* If IJOB = 1 or 2 and TRANS = 'N', LWORK >= 2*M*N. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* IWORK (workspace) INTEGER array, dimension (M+N+6) */
+
+/* INFO (output) INTEGER */
+/* =0: successful exit */
+/* <0: If INFO = -i, the i-th argument had an illegal value. */
+/* >0: (A, D) and (B, E) have common or close eigenvalues. */
+
+/* Further Details */
+/* =============== */
+
+/* Based on contributions by */
+/* Bo Kagstrom and Peter Poromaa, Department of Computing Science, */
+/* Umea University, S-901 87 Umea, Sweden. */
+
+/* [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software */
+/* for Solving the Generalized Sylvester Equation and Estimating the */
+/* Separation between Regular Matrix Pairs, Report UMINF - 93.23, */
+/* Department of Computing Science, Umea University, S-901 87 Umea, */
+/* Sweden, December 1993, Revised April 1994, Also as LAPACK Working */
+/* Note 75. To appear in ACM Trans. on Math. Software, Vol 22, */
+/* No 1, 1996. */
+
+/* [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester */
+/* Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal. */
+/* Appl., 15(4):1045-1060, 1994 */
+
+/* [3] B. Kagstrom and L. Westin, Generalized Schur Methods with */
+/* Condition Estimators for Solving the Generalized Sylvester */
+/* Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7, */
+/* July 1989, pp 745-751. */
+
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c -= c_offset;
+ d_dim1 = *ldd;
+ d_offset = 1 + d_dim1 * 1;
+ d -= d_offset;
+ e_dim1 = *lde;
+ e_offset = 1 + e_dim1 * 1;
+ e -= e_offset;
+ f_dim1 = *ldf;
+ f_offset = 1 + f_dim1 * 1;
+ f -= f_offset;
+ --work;
+ --iwork;
+
+/* Decode and test input parameters */
+
+ *info = 0;
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+ if ((*ijob == 1 || *ijob == 2) && notran) {
+ lwmin = max(1, 2 * *m * *n);
+ } else {
+ lwmin = 1;
+ }
+
+ if (! notran && ! lsame_(trans, "T")) {
+ *info = -1;
+ } else if (*ijob < 0 || *ijob > 4) {
+ *info = -2;
+ } else if (*m <= 0) {
+ *info = -3;
+ } else if (*n <= 0) {
+ *info = -4;
+ } else if (*lda < max(1,*m)) {
+ *info = -6;
+ } else if (*ldb < max(1,*n)) {
+ *info = -8;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if (*ldd < max(1,*m)) {
+ *info = -12;
+ } else if (*lde < max(1,*n)) {
+ *info = -14;
+ } else if (*ldf < max(1,*m)) {
+ *info = -16;
+ } else if (*lwork < lwmin && ! lquery) {
+ *info = -20;
+ }
+
+ if (*info == 0) {
+ work[1] = (doublereal) lwmin;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTGSYL", &i__1);
+ return;
+ } else if (lquery) {
+ return;
+ }
+
+/* Determine optimal block sizes MB and NB */
+
+ mb = ilaenv_(&c__2, "DTGSYL", trans, m, n, &c_n1, &c_n1);
+ nb = ilaenv_(&c__5, "DTGSYL", trans, m, n, &c_n1, &c_n1);
+
+ isolve = 1;
+ ifunc = 0;
+ if (*ijob >= 3 && notran) {
+ ifunc = *ijob - 2;
+ for (j = 1; j <= *n; ++j) {
+ dcopy_(m, &c_b14, &c__0, &c[j * c_dim1 + 1], &c__1);
+ dcopy_(m, &c_b14, &c__0, &f[j * f_dim1 + 1], &c__1);
+ }
+ } else if (*ijob >= 1 && notran) {
+ isolve = 2;
+ }
+
+ if ((mb <= 1 && nb <= 1) || (mb >= *m && nb >= *n)) {
+
+ for (iround = 1; iround <= isolve; ++iround) {
+
+/* Use unblocked Level 2 solver */
+
+ dscale = 0.;
+ dsum = 1.;
+ pq = 0;
+ dtgsy2_(trans, &ifunc, m, n, &a[a_offset], lda, &b[b_offset], ldb,
+ &c[c_offset], ldc, &d[d_offset], ldd, &e[e_offset],
+ lde, &f[f_offset], ldf, scale, &dsum, &dscale, &iwork[1],
+ &pq, info);
+ if (dscale != 0.) {
+ if (*ijob == 1 || *ijob == 3) {
+ *dif = sqrt((doublereal) ((*m << 1) * *n)) / (dscale * sqrt(dsum));
+ } else {
+ *dif = sqrt((doublereal) pq) / (dscale * sqrt(dsum));
+ }
+ }
+
+ if (isolve == 2 && iround == 1) {
+ ifunc = *ijob;
+ scale2 = *scale;
+ dlacpy_("F", m, n, &c[c_offset], ldc, &work[1], m);
+ dlacpy_("F", m, n, &f[f_offset], ldf, &work[*m * *n + 1], m);
+ for (j = 1; j <= *n; ++j) {
+ dcopy_(m, &c_b14, &c__0, &c[j * c_dim1 + 1], &c__1);
+ dcopy_(m, &c_b14, &c__0, &f[j * f_dim1 + 1], &c__1);
+ }
+ } else if (isolve == 2 && iround == 2) {
+ dlacpy_("F", m, n, &work[1], m, &c[c_offset], ldc);
+ dlacpy_("F", m, n, &work[*m * *n + 1], m, &f[f_offset], ldf);
+ *scale = scale2;
+ }
+ }
+
+ return;
+ }
+
+/* Determine block structure of A */
+
+ p = 0;
+ i = 1;
+L40:
+ if (i > *m) {
+ goto L50;
+ }
+ ++p;
+ iwork[p] = i;
+ i += mb;
+ if (i >= *m) {
+ goto L50;
+ }
+ if (a[i + (i - 1) * a_dim1] != 0.) {
+ ++i;
+ }
+ goto L40;
+L50:
+
+ iwork[p + 1] = *m + 1;
+ if (iwork[p] == iwork[p + 1]) {
+ --p;
+ }
+
+/* Determine block structure of B */
+
+ q = p + 1;
+ j = 1;
+L60:
+ if (j > *n) {
+ goto L70;
+ }
+ ++q;
+ iwork[q] = j;
+ j += nb;
+ if (j >= *n) {
+ goto L70;
+ }
+ if (b[j + (j - 1) * b_dim1] != 0.) {
+ ++j;
+ }
+ goto L60;
+L70:
+
+ iwork[q + 1] = *n + 1;
+ if (iwork[q] == iwork[q + 1]) {
+ --q;
+ }
+
+ if (notran) {
+
+ for (iround = 1; iround <= isolve; ++iround) {
+
+/* Solve (I, J)-subsystem */
+/* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J) */
+/* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J) */
+/* for I = P, P - 1,..., 1; J = 1, 2,..., Q */
+
+ dscale = 0.;
+ dsum = 1.;
+ pq = 0;
+ *scale = 1.;
+ for (j = p + 2; j <= q; ++j) {
+ js = iwork[j];
+ je = iwork[j + 1] - 1;
+ nb = je - js + 1;
+ for (i = p; i >= 1; --i) {
+ is = iwork[i];
+ ie = iwork[i + 1] - 1;
+ mb = ie - is + 1;
+ ppqq = 0;
+ dtgsy2_(trans, &ifunc, &mb, &nb, &a[is + is * a_dim1], lda,
+ &b[js + js * b_dim1], ldb, &c[is + js * c_dim1], ldc,
+ &d[is + is * d_dim1], ldd, &e[js + js * e_dim1], lde,
+ &f[is + js * f_dim1], ldf, &scaloc, &dsum, &dscale,
+ &iwork[q + 2], &ppqq, &linfo);
+ if (linfo > 0) {
+ *info = linfo;
+ }
+
+ pq += ppqq;
+ if (scaloc != 1.) {
+ for (k = 1; k < js; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ for (k = js; k <= je; ++k) {
+ i__1 = is - 1;
+ dscal_(&i__1, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ i__1 = is - 1;
+ dscal_(&i__1, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ for (k = js; k <= je; ++k) {
+ i__1 = *m - ie;
+ dscal_(&i__1, &scaloc, &c[ie + 1 + k * c_dim1], &c__1);
+ i__1 = *m - ie;
+ dscal_(&i__1, &scaloc, &f[ie + 1 + k * f_dim1], &c__1);
+ }
+ for (k = je + 1; k <= *n; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Substitute R(I, J) and L(I, J) into remaining */
+/* equation. */
+
+ if (i > 1) {
+ i__1 = is - 1;
+ dgemm_("N", "N", &i__1, &nb, &mb, &c_b53, &a[is * a_dim1 + 1], lda,
+ &c[is + js * c_dim1], ldc, &c_b54, &c[js * c_dim1 + 1], ldc);
+ i__1 = is - 1;
+ dgemm_("N", "N", &i__1, &nb, &mb, &c_b53, &d[is * d_dim1 + 1], ldd,
+ &c[is + js * c_dim1], ldc, &c_b54, &f[js * f_dim1 + 1], ldf);
+ }
+ if (j < q) {
+ i__1 = *n - je;
+ dgemm_("N", "N", &mb, &i__1, &nb, &c_b54, &f[is + js * f_dim1], ldf,
+ &b[js + (je + 1) * b_dim1], ldb, &c_b54, &c[is + (je + 1) * c_dim1], ldc);
+ i__1 = *n - je;
+ dgemm_("N", "N", &mb, &i__1, &nb, &c_b54, &f[is + js * f_dim1], ldf,
+ &e[js + (je + 1) * e_dim1], lde, &c_b54, &f[is + (je + 1) * f_dim1], ldf);
+ }
+ }
+ }
+ if (dscale != 0.) {
+ if (*ijob == 1 || *ijob == 3) {
+ *dif = sqrt((doublereal) ((*m << 1) * *n)) / (dscale * sqrt(dsum));
+ } else {
+ *dif = sqrt((doublereal) pq) / (dscale * sqrt(dsum));
+ }
+ }
+ if (isolve == 2 && iround == 1) {
+ ifunc = *ijob;
+ scale2 = *scale;
+ dlacpy_("F", m, n, &c[c_offset], ldc, &work[1], m);
+ dlacpy_("F", m, n, &f[f_offset], ldf, &work[*m * *n + 1], m);
+ for (j = 1; j <= *n; ++j) {
+ dcopy_(m, &c_b14, &c__0, &c[j * c_dim1 + 1], &c__1);
+ dcopy_(m, &c_b14, &c__0, &f[j * f_dim1 + 1], &c__1);
+ }
+ } else if (isolve == 2 && iround == 2) {
+ dlacpy_("F", m, n, &work[1], m, &c[c_offset], ldc);
+ dlacpy_("F", m, n, &work[*m * *n + 1], m, &f[f_offset], ldf);
+ *scale = scale2;
+ }
+ }
+
+ } else {
+
+/* Solve transposed (I, J)-subsystem */
+/* A(I, I)' * R(I, J) + D(I, I)' * L(I, J) = C(I, J) */
+/* R(I, J) * B(J, J)' + L(I, J) * E(J, J)' = -F(I, J) */
+/* for I = 1,2,..., P; J = Q, Q-1,..., 1 */
+
+ *scale = 1.;
+ for (i = 1; i <= p; ++i) {
+ is = iwork[i];
+ ie = iwork[i + 1] - 1;
+ mb = ie - is + 1;
+ for (j = q; j >= p + 2; --j) {
+ js = iwork[j];
+ je = iwork[j + 1] - 1;
+ nb = je - js + 1;
+ dtgsy2_(trans, &ifunc, &mb, &nb, &a[is + is * a_dim1], lda,
+ &b[js + js * b_dim1], ldb, &c[is + js * c_dim1], ldc,
+ &d[is + is * d_dim1], ldd, &e[js + js * e_dim1], lde,
+ &f[is + js * f_dim1], ldf, &scaloc, &dsum, &dscale, &iwork[q + 2], &ppqq, &linfo);
+ if (linfo > 0) {
+ *info = linfo;
+ }
+ if (scaloc != 1.) {
+ for (k = 1; k < js; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ for (k = js; k <= je; ++k) {
+ i__1 = is - 1;
+ dscal_(&i__1, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ i__1 = is - 1;
+ dscal_(&i__1, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ for (k = js; k <= je; ++k) {
+ i__1 = *m - ie;
+ dscal_(&i__1, &scaloc, &c[ie + 1 + k * c_dim1], &c__1);
+ i__1 = *m - ie;
+ dscal_(&i__1, &scaloc, &f[ie + 1 + k * f_dim1], &c__1);
+ }
+ for (k = je + 1; k <= *n; ++k) {
+ dscal_(m, &scaloc, &c[k * c_dim1 + 1], &c__1);
+ dscal_(m, &scaloc, &f[k * f_dim1 + 1], &c__1);
+ }
+ *scale *= scaloc;
+ }
+
+/* Substitute R(I, J) and L(I, J) into remaining equation. */
+
+ if (j > p + 2) {
+ i__1 = js - 1;
+ dgemm_("N", "T", &mb, &i__1, &nb, &c_b54, &c[is + js * c_dim1], ldc,
+ &b[js * b_dim1 + 1], ldb, &c_b54, &f[is + f_dim1], ldf);
+ i__1 = js - 1;
+ dgemm_("N", "T", &mb, &i__1, &nb, &c_b54, &f[is + js * f_dim1], ldf,
+ &e[js * e_dim1 + 1], lde, &c_b54, &f[is + f_dim1], ldf);
+ }
+ if (i < p) {
+ i__1 = *m - ie;
+ dgemm_("T", "N", &i__1, &nb, &mb, &c_b53, &a[is + (ie + 1) * a_dim1], lda,
+ &c[is + js * c_dim1], ldc, &c_b54, &c[ie + 1 + js * c_dim1], ldc);
+ i__1 = *m - ie;
+ dgemm_("T", "N", &i__1, &nb, &mb, &c_b53, &d[is + (ie + 1) * d_dim1], ldd,
+ &f[is + js * f_dim1], ldf, &c_b54, &c[ie + 1 + js * c_dim1], ldc);
+ }
+ }
+ }
+ }
+
+ work[1] = (doublereal) lwmin;
+
+} /* dtgsyl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.f
new file mode 100644
index 0000000000000000000000000000000000000000..ff00f18f1039a644661dad6fcd33e959c4b0a28f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtgsyl.f
@@ -0,0 +1,534 @@
+ SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
+ $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK,
+ $ IWORK, INFO )
+*
+* -- LAPACK routine (version 3.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1999
+*
+* .. Scalar Arguments ..
+ CHARACTER TRANS
+ INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF,
+ $ LWORK, M, N
+ DOUBLE PRECISION DIF, SCALE
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ),
+ $ D( LDD, * ), E( LDE, * ), F( LDF, * ),
+ $ WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTGSYL solves the generalized Sylvester equation:
+*
+* A * R - L * B = scale * C (1)
+* D * R - L * E = scale * F
+*
+* where R and L are unknown m-by-n matrices, (A, D), (B, E) and
+* (C, F) are given matrix pairs of size m-by-m, n-by-n and m-by-n,
+* respectively, with real entries. (A, D) and (B, E) must be in
+* generalized (real) Schur canonical form, i.e. A, B are upper quasi
+* triangular and D, E are upper triangular.
+*
+* The solution (R, L) overwrites (C, F). 0 <= SCALE <= 1 is an output
+* scaling factor chosen to avoid overflow.
+*
+* In matrix notation (1) is equivalent to solve Zx = scale b, where
+* Z is defined as
+*
+* Z = [ kron(In, A) -kron(B', Im) ] (2)
+* [ kron(In, D) -kron(E', Im) ].
+*
+* Here Ik is the identity matrix of size k and X' is the transpose of
+* X. kron(X, Y) is the Kronecker product between the matrices X and Y.
+*
+* If TRANS = 'T', DTGSYL solves the transposed system Z'*y = scale*b,
+* which is equivalent to solve for R and L in
+*
+* A' * R + D' * L = scale * C (3)
+* R * B' + L * E' = scale * (-F)
+*
+* This case (TRANS = 'T') is used to compute an one-norm-based estimate
+* of Dif[(A,D), (B,E)], the separation between the matrix pairs (A,D)
+* and (B,E), using DLACON.
+*
+* If IJOB >= 1, DTGSYL computes a Frobenius norm-based estimate
+* of Dif[(A,D),(B,E)]. That is, the reciprocal of a lower bound on the
+* reciprocal of the smallest singular value of Z. See [1-2] for more
+* information.
+*
+* This is a level 3 BLAS algorithm.
+*
+* Arguments
+* =========
+*
+* TRANS (input) CHARACTER*1
+* = 'N', solve the generalized Sylvester equation (1).
+* = 'T', solve the 'transposed' system (3).
+*
+* IJOB (input) INTEGER
+* Specifies what kind of functionality to be performed.
+* =0: solve (1) only.
+* =1: The functionality of 0 and 3.
+* =2: The functionality of 0 and 4.
+* =3: Only an estimate of Dif[(A,D), (B,E)] is computed.
+* (look ahead strategy IJOB = 1 is used).
+* =4: Only an estimate of Dif[(A,D), (B,E)] is computed.
+* ( DGECON on sub-systems is used ).
+* Not referenced if TRANS = 'T'.
+*
+* M (input) INTEGER
+* The order of the matrices A and D, and the row dimension of
+* the matrices C, F, R and L.
+*
+* N (input) INTEGER
+* The order of the matrices B and E, and the column dimension
+* of the matrices C, F, R and L.
+*
+* A (input) DOUBLE PRECISION array, dimension (LDA, M)
+* The upper quasi triangular matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1, M).
+*
+* B (input) DOUBLE PRECISION array, dimension (LDB, N)
+* The upper quasi triangular matrix B.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1, N).
+*
+* C (input/output) DOUBLE PRECISION array, dimension (LDC, N)
+* On entry, C contains the right-hand-side of the first matrix
+* equation in (1) or (3).
+* On exit, if IJOB = 0, 1 or 2, C has been overwritten by
+* the solution R. If IJOB = 3 or 4 and TRANS = 'N', C holds R,
+* the solution achieved during the computation of the
+* Dif-estimate.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1, M).
+*
+* D (input) DOUBLE PRECISION array, dimension (LDD, M)
+* The upper triangular matrix D.
+*
+* LDD (input) INTEGER
+* The leading dimension of the array D. LDD >= max(1, M).
+*
+* E (input) DOUBLE PRECISION array, dimension (LDE, N)
+* The upper triangular matrix E.
+*
+* LDE (input) INTEGER
+* The leading dimension of the array E. LDE >= max(1, N).
+*
+* F (input/output) DOUBLE PRECISION array, dimension (LDF, N)
+* On entry, F contains the right-hand-side of the second matrix
+* equation in (1) or (3).
+* On exit, if IJOB = 0, 1 or 2, F has been overwritten by
+* the solution L. If IJOB = 3 or 4 and TRANS = 'N', F holds L,
+* the solution achieved during the computation of the
+* Dif-estimate.
+*
+* LDF (input) INTEGER
+* The leading dimension of the array F. LDF >= max(1, M).
+*
+* DIF (output) DOUBLE PRECISION
+* On exit DIF is the reciprocal of a lower bound of the
+* reciprocal of the Dif-function, i.e. DIF is an upper bound of
+* Dif[(A,D), (B,E)] = sigma_min(Z), where Z as in (2).
+* IF IJOB = 0 or TRANS = 'T', DIF is not touched.
+*
+* SCALE (output) DOUBLE PRECISION
+* On exit SCALE is the scaling factor in (1) or (3).
+* If 0 < SCALE < 1, C and F hold the solutions R and L, resp.,
+* to a slightly perturbed system but the input matrices A, B, D
+* and E have not been changed. If SCALE = 0, C and F hold the
+* solutions R and L, respectively, to the homogeneous system
+* with C = F = 0. Normally, SCALE = 1.
+*
+* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+* If IJOB = 0, WORK is not referenced. Otherwise,
+* on exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK > = 1.
+* If IJOB = 1 or 2 and TRANS = 'N', LWORK >= 2*M*N.
+*
+* If LWORK = -1, then a workspace query is assumed; the routine
+* only calculates the optimal size of the WORK array, returns
+* this value as the first entry of the WORK array, and no error
+* message related to LWORK is issued by XERBLA.
+*
+* IWORK (workspace) INTEGER array, dimension (M+N+6)
+*
+* INFO (output) INTEGER
+* =0: successful exit
+* <0: If INFO = -i, the i-th argument had an illegal value.
+* >0: (A, D) and (B, E) have common or close eigenvalues.
+*
+* Further Details
+* ===============
+*
+* Based on contributions by
+* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
+* Umea University, S-901 87 Umea, Sweden.
+*
+* [1] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
+* for Solving the Generalized Sylvester Equation and Estimating the
+* Separation between Regular Matrix Pairs, Report UMINF - 93.23,
+* Department of Computing Science, Umea University, S-901 87 Umea,
+* Sweden, December 1993, Revised April 1994, Also as LAPACK Working
+* Note 75. To appear in ACM Trans. on Math. Software, Vol 22,
+* No 1, 1996.
+*
+* [2] B. Kagstrom, A Perturbation Analysis of the Generalized Sylvester
+* Equation (AR - LB, DR - LE ) = (C, F), SIAM J. Matrix Anal.
+* Appl., 15(4):1045-1060, 1994
+*
+* [3] B. Kagstrom and L. Westin, Generalized Schur Methods with
+* Condition Estimators for Solving the Generalized Sylvester
+* Equation, IEEE Transactions on Automatic Control, Vol. 34, No. 7,
+* July 1989, pp 745-751.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, NOTRAN
+ INTEGER I, IE, IFUNC, IROUND, IS, ISOLVE, J, JE, JS, K,
+ $ LINFO, LWMIN, MB, NB, P, PPQQ, PQ, Q
+ DOUBLE PRECISION DSCALE, DSUM, SCALE2, SCALOC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV
+ EXTERNAL LSAME, ILAENV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DCOPY, DGEMM, DLACPY, DSCAL, DTGSY2, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, MAX, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Decode and test input parameters
+*
+ INFO = 0
+ NOTRAN = LSAME( TRANS, 'N' )
+ LQUERY = ( LWORK.EQ.-1 )
+*
+ IF( ( IJOB.EQ.1 .OR. IJOB.EQ.2 ) .AND. NOTRAN ) THEN
+ LWMIN = MAX( 1, 2*M*N )
+ ELSE
+ LWMIN = 1
+ END IF
+*
+ IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -1
+ ELSE IF( ( IJOB.LT.0 ) .OR. ( IJOB.GT.4 ) ) THEN
+ INFO = -2
+ ELSE IF( M.LE.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LE.0 ) THEN
+ INFO = -4
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -6
+ ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+ INFO = -8
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDD.LT.MAX( 1, M ) ) THEN
+ INFO = -12
+ ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
+ INFO = -14
+ ELSE IF( LDF.LT.MAX( 1, M ) ) THEN
+ INFO = -16
+ ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
+ INFO = -20
+ END IF
+*
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LWMIN
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DTGSYL', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Determine optimal block sizes MB and NB
+*
+ MB = ILAENV( 2, 'DTGSYL', TRANS, M, N, -1, -1 )
+ NB = ILAENV( 5, 'DTGSYL', TRANS, M, N, -1, -1 )
+*
+ ISOLVE = 1
+ IFUNC = 0
+ IF( IJOB.GE.3 .AND. NOTRAN ) THEN
+ IFUNC = IJOB - 2
+ DO 10 J = 1, N
+ CALL DCOPY( M, ZERO, 0, C( 1, J ), 1 )
+ CALL DCOPY( M, ZERO, 0, F( 1, J ), 1 )
+ 10 CONTINUE
+ ELSE IF( IJOB.GE.1 .AND. NOTRAN ) THEN
+ ISOLVE = 2
+ END IF
+*
+ IF( ( MB.LE.1 .AND. NB.LE.1 ) .OR. ( MB.GE.M .AND. NB.GE.N ) )
+ $ THEN
+*
+ DO 30 IROUND = 1, ISOLVE
+*
+* Use unblocked Level 2 solver
+*
+ DSCALE = ZERO
+ DSUM = ONE
+ PQ = 0
+ CALL DTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D,
+ $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE,
+ $ IWORK, PQ, INFO )
+ IF( DSCALE.NE.ZERO ) THEN
+ IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
+ DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
+ ELSE
+ DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
+ END IF
+ END IF
+*
+ IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
+ IFUNC = IJOB
+ SCALE2 = SCALE
+ CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
+ CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
+ DO 20 J = 1, N
+ CALL DCOPY( M, ZERO, 0, C( 1, J ), 1 )
+ CALL DCOPY( M, ZERO, 0, F( 1, J ), 1 )
+ 20 CONTINUE
+ ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
+ CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
+ CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
+ SCALE = SCALE2
+ END IF
+ 30 CONTINUE
+*
+ RETURN
+ END IF
+*
+* Determine block structure of A
+*
+ P = 0
+ I = 1
+ 40 CONTINUE
+ IF( I.GT.M )
+ $ GO TO 50
+ P = P + 1
+ IWORK( P ) = I
+ I = I + MB
+ IF( I.GE.M )
+ $ GO TO 50
+ IF( A( I, I-1 ).NE.ZERO )
+ $ I = I + 1
+ GO TO 40
+ 50 CONTINUE
+*
+ IWORK( P+1 ) = M + 1
+ IF( IWORK( P ).EQ.IWORK( P+1 ) )
+ $ P = P - 1
+*
+* Determine block structure of B
+*
+ Q = P + 1
+ J = 1
+ 60 CONTINUE
+ IF( J.GT.N )
+ $ GO TO 70
+ Q = Q + 1
+ IWORK( Q ) = J
+ J = J + NB
+ IF( J.GE.N )
+ $ GO TO 70
+ IF( B( J, J-1 ).NE.ZERO )
+ $ J = J + 1
+ GO TO 60
+ 70 CONTINUE
+*
+ IWORK( Q+1 ) = N + 1
+ IF( IWORK( Q ).EQ.IWORK( Q+1 ) )
+ $ Q = Q - 1
+*
+ IF( NOTRAN ) THEN
+*
+ DO 150 IROUND = 1, ISOLVE
+*
+* Solve (I, J)-subsystem
+* A(I, I) * R(I, J) - L(I, J) * B(J, J) = C(I, J)
+* D(I, I) * R(I, J) - L(I, J) * E(J, J) = F(I, J)
+* for I = P, P - 1,..., 1; J = 1, 2,..., Q
+*
+ DSCALE = ZERO
+ DSUM = ONE
+ PQ = 0
+ SCALE = ONE
+ DO 130 J = P + 2, Q
+ JS = IWORK( J )
+ JE = IWORK( J+1 ) - 1
+ NB = JE - JS + 1
+ DO 120 I = P, 1, -1
+ IS = IWORK( I )
+ IE = IWORK( I+1 ) - 1
+ MB = IE - IS + 1
+ PPQQ = 0
+ CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
+ $ B( JS, JS ), LDB, C( IS, JS ), LDC,
+ $ D( IS, IS ), LDD, E( JS, JS ), LDE,
+ $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
+ $ IWORK( Q+2 ), PPQQ, LINFO )
+ IF( LINFO.GT.0 )
+ $ INFO = LINFO
+*
+ PQ = PQ + PPQQ
+ IF( SCALOC.NE.ONE ) THEN
+ DO 80 K = 1, JS - 1
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 80 CONTINUE
+ DO 90 K = JS, JE
+ CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
+ 90 CONTINUE
+ DO 100 K = JS, JE
+ CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
+ CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
+ 100 CONTINUE
+ DO 110 K = JE + 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 110 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Substitute R(I, J) and L(I, J) into remaining
+* equation.
+*
+ IF( I.GT.1 ) THEN
+ CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
+ $ A( 1, IS ), LDA, C( IS, JS ), LDC, ONE,
+ $ C( 1, JS ), LDC )
+ CALL DGEMM( 'N', 'N', IS-1, NB, MB, -ONE,
+ $ D( 1, IS ), LDD, C( IS, JS ), LDC, ONE,
+ $ F( 1, JS ), LDF )
+ END IF
+ IF( J.LT.Q ) THEN
+ CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
+ $ F( IS, JS ), LDF, B( JS, JE+1 ), LDB,
+ $ ONE, C( IS, JE+1 ), LDC )
+ CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE,
+ $ F( IS, JS ), LDF, E( JS, JE+1 ), LDE,
+ $ ONE, F( IS, JE+1 ), LDF )
+ END IF
+ 120 CONTINUE
+ 130 CONTINUE
+ IF( DSCALE.NE.ZERO ) THEN
+ IF( IJOB.EQ.1 .OR. IJOB.EQ.3 ) THEN
+ DIF = SQRT( DBLE( 2*M*N ) ) / ( DSCALE*SQRT( DSUM ) )
+ ELSE
+ DIF = SQRT( DBLE( PQ ) ) / ( DSCALE*SQRT( DSUM ) )
+ END IF
+ END IF
+ IF( ISOLVE.EQ.2 .AND. IROUND.EQ.1 ) THEN
+ IFUNC = IJOB
+ SCALE2 = SCALE
+ CALL DLACPY( 'F', M, N, C, LDC, WORK, M )
+ CALL DLACPY( 'F', M, N, F, LDF, WORK( M*N+1 ), M )
+ DO 140 J = 1, N
+ CALL DCOPY( M, ZERO, 0, C( 1, J ), 1 )
+ CALL DCOPY( M, ZERO, 0, F( 1, J ), 1 )
+ 140 CONTINUE
+ ELSE IF( ISOLVE.EQ.2 .AND. IROUND.EQ.2 ) THEN
+ CALL DLACPY( 'F', M, N, WORK, M, C, LDC )
+ CALL DLACPY( 'F', M, N, WORK( M*N+1 ), M, F, LDF )
+ SCALE = SCALE2
+ END IF
+ 150 CONTINUE
+*
+ ELSE
+*
+* Solve transposed (I, J)-subsystem
+* A(I, I)' * R(I, J) + D(I, I)' * L(I, J) = C(I, J)
+* R(I, J) * B(J, J)' + L(I, J) * E(J, J)' = -F(I, J)
+* for I = 1,2,..., P; J = Q, Q-1,..., 1
+*
+ SCALE = ONE
+ DO 210 I = 1, P
+ IS = IWORK( I )
+ IE = IWORK( I+1 ) - 1
+ MB = IE - IS + 1
+ DO 200 J = Q, P + 2, -1
+ JS = IWORK( J )
+ JE = IWORK( J+1 ) - 1
+ NB = JE - JS + 1
+ CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA,
+ $ B( JS, JS ), LDB, C( IS, JS ), LDC,
+ $ D( IS, IS ), LDD, E( JS, JS ), LDE,
+ $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE,
+ $ IWORK( Q+2 ), PPQQ, LINFO )
+ IF( LINFO.GT.0 )
+ $ INFO = LINFO
+ IF( SCALOC.NE.ONE ) THEN
+ DO 160 K = 1, JS - 1
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 160 CONTINUE
+ DO 170 K = JS, JE
+ CALL DSCAL( IS-1, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( IS-1, SCALOC, F( 1, K ), 1 )
+ 170 CONTINUE
+ DO 180 K = JS, JE
+ CALL DSCAL( M-IE, SCALOC, C( IE+1, K ), 1 )
+ CALL DSCAL( M-IE, SCALOC, F( IE+1, K ), 1 )
+ 180 CONTINUE
+ DO 190 K = JE + 1, N
+ CALL DSCAL( M, SCALOC, C( 1, K ), 1 )
+ CALL DSCAL( M, SCALOC, F( 1, K ), 1 )
+ 190 CONTINUE
+ SCALE = SCALE*SCALOC
+ END IF
+*
+* Substitute R(I, J) and L(I, J) into remaining equation.
+*
+ IF( J.GT.P+2 ) THEN
+ CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ),
+ $ LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ),
+ $ LDF )
+ CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ),
+ $ LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ),
+ $ LDF )
+ END IF
+ IF( I.LT.P ) THEN
+ CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
+ $ A( IS, IE+1 ), LDA, C( IS, JS ), LDC, ONE,
+ $ C( IE+1, JS ), LDC )
+ CALL DGEMM( 'T', 'N', M-IE, NB, MB, -ONE,
+ $ D( IS, IE+1 ), LDD, F( IS, JS ), LDF, ONE,
+ $ C( IE+1, JS ), LDC )
+ END IF
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ END IF
+*
+ WORK( 1 ) = LWMIN
+*
+ RETURN
+*
+* End of DTGSYL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.c
new file mode 100644
index 0000000000000000000000000000000000000000..5941ea2479dec14639608bd44ab5d6b583cb05cf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.c
@@ -0,0 +1,168 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dtrans_(a, m, n, mn, move, iwrk, iok)
+doublereal *a;
+const integer *m, *n, *mn;
+integer *move, *iwrk, *iok;
+{
+ /* Local variables */
+ static doublereal b, c, d;
+ static integer i, j, k, i1, i2, im, i1c, i2c, ncount, ir0, ir1, ir2, kmi, max_;
+
+/* ***** */
+/* ALGORITHM 380 - REVISED */
+/* ***** */
+/* A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
+/* CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED */
+/* COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
+/* USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
+/* VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
+/* SUCCESS OR FAILURE OF THE ROUTINE. */
+/* NORMAL RETURN IOK=0 */
+/* ERRORS IOK=-1 ,MN NOT EQUAL TO M*N */
+/* IOK=-2 ,IWRK NEGATIVE OR ZERO */
+/* IOK.GT.0, (SHOULD NEVER OCCUR),IN THIS CASE */
+/* WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
+/* IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED */
+/* NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS */
+
+/* CHECK ARGUMENTS AND INITIALIZE. */
+
+ if (*m < 2 || *n < 2) {
+ goto L120;
+ }
+ if (*mn != *m * *n) {
+ goto L180;
+ }
+ if (*iwrk < 1) {
+ goto L190;
+ }
+ if (*m == *n) {
+ goto L130;
+ }
+ ncount = 2;
+ k = *mn - 1;
+ for (i = 0; i < *iwrk; ++i) {
+ move[i] = 0;
+ }
+ if (*m < 3 || *n < 3) {
+ goto L30;
+ }
+/* CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM */
+/* FOR GCD(M-1,N-1). */
+ ir2 = *m - 1;
+ ir1 = *n - 1;
+L20:
+ ir0 = ir2 % ir1;
+ ir2 = ir1;
+ ir1 = ir0;
+ if (ir0 != 0) {
+ goto L20;
+ }
+ ncount = ncount + ir2 - 1;
+/* SET INITIAL VALUES FOR SEARCH */
+L30:
+ i = 0;
+ im = *m;
+/* AT LEAST ONE LOOP MUST BE RE-ARRANGED */
+ goto L80;
+/* SEARCH FOR LOOPS TO REARRANGE */
+L40:
+ ++i;
+ max_ = k - i;
+ if (i >= max_) {
+ goto L160;
+ }
+ im += *m;
+ if (im > k) {
+ im -= k;
+ }
+ i2 = im;
+ if (i+1 == i2) {
+ goto L40;
+ }
+ if (i >= *iwrk) {
+ goto L60;
+ }
+ if (move[i] == 0) {
+ goto L80;
+ }
+ goto L40;
+L50:
+ i2 = *m * i1 - k * (i1 / *n);
+L60:
+ if (i2 <= i+1 || i2 >= max_) {
+ goto L70;
+ }
+ i1 = i2;
+ goto L50;
+L70:
+ if (i2 != i+1) {
+ goto L40;
+ }
+/* REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP */
+L80:
+ i1 = i + 1;
+ kmi = k - i - 1;
+ b = a[i1];
+ i1c = kmi;
+ c = a[i1c];
+L90:
+ i2 = *m * i1 - k * (i1 / *n);
+ i2c = k - i2;
+ if (i1 <= *iwrk) {
+ move[i1-1] = 2;
+ }
+ if (i1c <= *iwrk) {
+ move[i1c-1] = 2;
+ }
+ ncount += 2;
+ if (i2 == i+1) {
+ goto L110;
+ }
+ if (i2 == kmi) {
+ goto L100;
+ }
+ a[i1] = a[i2];
+ a[i1c] = a[i2c];
+ i1 = i2;
+ i1c = i2c;
+ goto L90;
+/* FINAL STORE AND TEST FOR FINISHED */
+L100:
+ d = b;
+ b = c;
+ c = d;
+L110:
+ a[i1] = b;
+ a[i1c] = c;
+ if (ncount < *mn) {
+ goto L40;
+ }
+/* NORMAL RETURN */
+L120:
+ *iok = 0;
+ return;
+/* IF MATRIX IS SQUARE,EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
+L130:
+ for (i = 0; i < *n; ++i) {
+ for (j = i+1; j < *n; ++j) {
+ i1 = i + j * *n;
+ i2 = j + i * *m;
+ b = a[i1]; a[i1] = a[i2]; a[i2] = b;
+ }
+ }
+ goto L120;
+/* ERROR RETURNS. */
+L160:
+ *iok = i+1;
+L170:
+ return;
+L180:
+ *iok = -1;
+ goto L170;
+L190:
+ *iok = -2;
+ goto L170;
+} /* dtrans_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.f
new file mode 100644
index 0000000000000000000000000000000000000000..e12b78e04e4c78ac55149d36a9e2274a8e80035e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrans.f
@@ -0,0 +1,109 @@
+ SUBROUTINE DTRANS(A, M, N, MN, MOVE, IWRK, IOK) TRA 10
+C *****
+C ALGORITHM 380 - REVISED
+C *****
+C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH
+C CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED
+C COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK
+C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE
+C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE
+C SUCCESS OR FAILURE OF THE ROUTINE.
+C NORMAL RETURN IOK=0
+C ERRORS IOK=-1 ,MN NOT EQUAL TO M*N
+C IOK=-2 ,IWRK NEGATIVE OR ZERO
+C IOK.GT.0, (SHOULD NEVER OCCUR),IN THIS CASE
+C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH
+C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED
+C NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS
+ DOUBLE PRECISION A, B, C, D
+ DIMENSION A(MN), MOVE(IWRK)
+C CHECK ARGUMENTS AND INITIALIZE.
+ IF (M.LT.2 .OR. N.LT.2) GO TO 120
+ IF (MN.NE.M*N) GO TO 180
+ IF (IWRK.LT.1) GO TO 190
+ IF (M.EQ.N) GO TO 130
+ NCOUNT = 2
+ K = MN - 1
+ DO 10 I=1,IWRK
+ MOVE(I) = 0
+ 10 CONTINUE
+ IF (M.LT.3 .OR. N.LT.3) GO TO 30
+C CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM
+C FOR GCD(M-1,N-1).
+ IR2 = M - 1
+ IR1 = N - 1
+ 20 IR0 = MOD(IR2,IR1)
+ IR2 = IR1
+ IR1 = IR0
+ IF (IR0.NE.0) GO TO 20
+ NCOUNT = NCOUNT + IR2 - 1
+C SET INITIAL VALUES FOR SEARCH
+ 30 I = 1
+ IM = M
+C AT LEAST ONE LOOP MUST BE RE-ARRANGED
+ GO TO 80
+C SEARCH FOR LOOPS TO REARRANGE
+ 40 MAX = K - I
+ I = I + 1
+ IF (I.GT.MAX) GO TO 160
+ IM = IM + M
+ IF (IM.GT.K) IM = IM - K
+ I2 = IM
+ IF (I.EQ.I2) GO TO 40
+ IF (I.GT.IWRK) GO TO 60
+ IF (MOVE(I).EQ.0) GO TO 80
+ GO TO 40
+ 50 I2 = M*I1 - K*(I1/N)
+ 60 IF (I2.LE.I .OR. I2.GE.MAX) GO TO 70
+ I1 = I2
+ GO TO 50
+ 70 IF (I2.NE.I) GO TO 40
+C REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP
+ 80 I1 = I
+ KMI = K - I
+ B = A(I1+1)
+ I1C = KMI
+ C = A(I1C+1)
+ 90 I2 = M*I1 - K*(I1/N)
+ I2C = K - I2
+ IF (I1.LE.IWRK) MOVE(I1) = 2
+ IF (I1C.LE.IWRK) MOVE(I1C) = 2
+ NCOUNT = NCOUNT + 2
+ IF (I2.EQ.I) GO TO 110
+ IF (I2.EQ.KMI) GO TO 100
+ A(I1+1) = A(I2+1)
+ A(I1C+1) = A(I2C+1)
+ I1 = I2
+ I1C = I2C
+ GO TO 90
+C FINAL STORE AND TEST FOR FINISHED
+ 100 D = B
+ B = C
+ C = D
+ 110 A(I1+1) = B
+ A(I1C+1) = C
+ IF (NCOUNT.LT.MN) GO TO 40
+C NORMAL RETURN
+ 120 IOK = 0
+ RETURN
+C IF MATRIX IS SQUARE,EXCHANGE ELEMENTS A(I,J) AND A(J,I).
+ 130 N1 = N - 1
+ DO 150 I=1,N1
+ J1 = I + 1
+ DO 140 J=J1,N
+ I1 = I + (J-1)*N
+ I2 = J + (I-1)*M
+ B = A(I1)
+ A(I1) = A(I2)
+ A(I2) = B
+ 140 CONTINUE
+ 150 CONTINUE
+ GO TO 120
+C ERROR RETURNS.
+ 160 IOK = I
+ 170 RETURN
+ 180 IOK = -1
+ GO TO 170
+ 190 IOK = -2
+ GO TO 170
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.c
new file mode 100644
index 0000000000000000000000000000000000000000..b80b2fb2bcf585a4b363c057821ef319b1237ab1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.c
@@ -0,0 +1,384 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dtrmm_(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
+const char *side, *uplo, *transa, *diag;
+const integer *m, *n;
+doublereal *alpha, *a;
+const integer *lda;
+doublereal *b;
+const integer *ldb;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer info;
+ static doublereal temp;
+ static integer i, j, k;
+ static logical lside;
+ static integer nrowa;
+ static logical upper;
+ static logical nounit;
+
+/* Purpose */
+/* ======= */
+
+/* DTRMM performs one of the matrix-matrix operations */
+
+/* B := alpha*op( A )*B, or B := alpha*B*op( A ), */
+
+/* where alpha is a scalar, B is an m by n matrix, A is a unit, or */
+/* non-unit, upper or lower triangular matrix and op( A ) is one of */
+
+/* op( A ) = A or op( A ) = A'. */
+
+/* Parameters */
+/* ========== */
+
+/* SIDE - CHARACTER*1. */
+/* On entry, SIDE specifies whether op( A ) multiplies B from */
+/* the left or right as follows: */
+
+/* SIDE = 'L' or 'l' B := alpha*op( A )*B. */
+
+/* SIDE = 'R' or 'r' B := alpha*B*op( A ). */
+
+/* Unchanged on exit. */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix A is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+
+/* TRANSA = 'N' or 'n' op( A ) = A. */
+
+/* TRANSA = 'T' or 't' op( A ) = A'. */
+
+/* TRANSA = 'C' or 'c' op( A ) = A'. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit triangular */
+/* as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of B. M must be at */
+/* least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of B. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. When alpha is */
+/* zero then A is not referenced and B need not be set before */
+/* entry. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m */
+/* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. */
+/* Before entry with UPLO = 'U' or 'u', the leading k by k */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading k by k */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When SIDE = 'L' or 'l' then */
+/* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' */
+/* then LDA must be at least max( 1, n ). */
+/* Unchanged on exit. */
+
+/* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). */
+/* Before entry, the leading m by n part of the array B must */
+/* contain the matrix B, and on exit is overwritten by the */
+/* transformed matrix. */
+
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. LDB must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+/* Test the input parameters. */
+
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if (! lside && ! lsame_(side, "R")) {
+ info = 1;
+ } else if (! upper && ! lsame_(uplo, "L")) {
+ info = 2;
+ } else if (! lsame_(transa, "N") && ! lsame_(transa, "T") && ! lsame_(transa, "C")) {
+ info = 3;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DTRMM ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ b[i + j * b_dim1] = 0.;
+ }
+ }
+ return;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*A*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ i__3 = k - 1;
+ for (i = 1; i <= i__3; ++i) {
+ b[i + j * b_dim1] += temp * a[i + k * a_dim1];
+ }
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ b[k + j * b_dim1] = temp;
+ }
+ }
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (k = *m; k >= 1; --k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ b[k + j * b_dim1] = temp;
+ if (nounit) {
+ b[k + j * b_dim1] *= a[k + k * a_dim1];
+ }
+ i__2 = *m;
+ for (i = k + 1; i <= i__2; ++i) {
+ b[i + j * b_dim1] += temp * a[i + k * a_dim1];
+ }
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form B := alpha*A'*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i = *m; i >= 1; --i) {
+ temp = b[i + j * b_dim1];
+ if (nounit) {
+ temp *= a[i + i * a_dim1];
+ }
+ i__2 = i - 1;
+ for (k = 1; k <= i__2; ++k) {
+ temp += a[k + i * a_dim1] * b[k + j * b_dim1];
+ }
+ b[i + j * b_dim1] = *alpha * temp;
+ }
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ temp = b[i + j * b_dim1];
+ if (nounit) {
+ temp *= a[i + i * a_dim1];
+ }
+ i__3 = *m;
+ for (k = i + 1; k <= i__3; ++k) {
+ temp += a[k + i * a_dim1] * b[k + j * b_dim1];
+ }
+ b[i + j * b_dim1] = *alpha * temp;
+ }
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*A. */
+
+ if (upper) {
+ for (j = *n; j >= 1; --j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__1 = *m;
+ for (i = 1; i <= i__1; ++i) {
+ b[i + j * b_dim1] *= temp;
+ }
+ i__1 = j - 1;
+ for (k = 1; k <= i__1; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ b[i + j * b_dim1] += temp * b[i + k * b_dim1];
+ }
+ }
+ }
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ b[i + j * b_dim1] *= temp;
+ }
+ i__2 = *n;
+ for (k = j + 1; k <= i__2; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__3 = *m;
+ for (i = 1; i <= i__3; ++i) {
+ b[i + j * b_dim1] += temp * b[i + k * b_dim1];
+ }
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A'. */
+
+ if (upper) {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k - 1;
+ for (j = 1; j <= i__2; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__3 = *m;
+ for (i = 1; i <= i__3; ++i) {
+ b[i + j * b_dim1] += temp * b[i + k * b_dim1];
+ }
+ }
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ b[i + k * b_dim1] *= temp;
+ }
+ }
+ }
+ } else {
+ for (k = *n; k >= 1; --k) {
+ i__1 = *n;
+ for (j = k + 1; j <= i__1; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__2 = *m;
+ for (i = 1; i <= i__2; ++i) {
+ b[i + j * b_dim1] += temp * b[i + k * b_dim1];
+ }
+ }
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__1 = *m;
+ for (i = 1; i <= i__1; ++i) {
+ b[i + k * b_dim1] *= temp;
+ }
+ }
+ }
+ }
+ }
+ }
+} /* dtrmm_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.f
new file mode 100644
index 0000000000000000000000000000000000000000..40c7740c9d2e6b72d3e4e485588b192259deec51
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmm.f
@@ -0,0 +1,355 @@
+ SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+ $ B, LDB )
+* .. Scalar Arguments ..
+ CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
+ INTEGER M, N, LDA, LDB
+ DOUBLE PRECISION ALPHA
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTRMM performs one of the matrix-matrix operations
+*
+* B := alpha*op( A )*B, or B := alpha*B*op( A ),
+*
+* where alpha is a scalar, B is an m by n matrix, A is a unit, or
+* non-unit, upper or lower triangular matrix and op( A ) is one of
+*
+* op( A ) = A or op( A ) = A'.
+*
+* Parameters
+* ==========
+*
+* SIDE - CHARACTER*1.
+* On entry, SIDE specifies whether op( A ) multiplies B from
+* the left or right as follows:
+*
+* SIDE = 'L' or 'l' B := alpha*op( A )*B.
+*
+* SIDE = 'R' or 'r' B := alpha*B*op( A ).
+*
+* Unchanged on exit.
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix A is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANSA - CHARACTER*1.
+* On entry, TRANSA specifies the form of op( A ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSA = 'N' or 'n' op( A ) = A.
+*
+* TRANSA = 'T' or 't' op( A ) = A'.
+*
+* TRANSA = 'C' or 'c' op( A ) = A'.
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit triangular
+* as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of B. M must be at
+* least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of B. N must be
+* at least zero.
+* Unchanged on exit.
+*
+* ALPHA - DOUBLE PRECISION.
+* On entry, ALPHA specifies the scalar alpha. When alpha is
+* zero then A is not referenced and B need not be set before
+* entry.
+* Unchanged on exit.
+*
+* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+* Before entry with UPLO = 'U' or 'u', the leading k by k
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading k by k
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. When SIDE = 'L' or 'l' then
+* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+* then LDA must be at least max( 1, n ).
+* Unchanged on exit.
+*
+* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+* Before entry, the leading m by n part of the array B must
+* contain the matrix B, and on exit is overwritten by the
+* transformed matrix.
+*
+* LDB - INTEGER.
+* On entry, LDB specifies the first dimension of B as declared
+* in the calling (sub) program. LDB must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 3 Blas routine.
+*
+* -- Written on 8-February-1989.
+* Jack Dongarra, Argonne National Laboratory.
+* Iain Duff, AERE Harwell.
+* Jeremy Du Croz, Numerical Algorithms Group Ltd.
+* Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* .. Local Scalars ..
+ LOGICAL LSIDE, NOUNIT, UPPER
+ INTEGER I, INFO, J, K, NROWA
+ DOUBLE PRECISION TEMP
+* .. Parameters ..
+ DOUBLE PRECISION ONE , ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ LSIDE = LSAME( SIDE , 'L' )
+ IF( LSIDE )THEN
+ NROWA = M
+ ELSE
+ NROWA = N
+ END IF
+ NOUNIT = LSAME( DIAG , 'N' )
+ UPPER = LSAME( UPLO , 'U' )
+*
+ INFO = 0
+ IF( ( .NOT.LSIDE ).AND.
+ $ ( .NOT.LSAME( SIDE , 'R' ) ) )THEN
+ INFO = 1
+ ELSE IF( ( .NOT.UPPER ).AND.
+ $ ( .NOT.LSAME( UPLO , 'L' ) ) )THEN
+ INFO = 2
+ ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'C' ) ) )THEN
+ INFO = 3
+ ELSE IF( ( .NOT.LSAME( DIAG , 'U' ) ).AND.
+ $ ( .NOT.LSAME( DIAG , 'N' ) ) )THEN
+ INFO = 4
+ ELSE IF( M .LT.0 )THEN
+ INFO = 5
+ ELSE IF( N .LT.0 )THEN
+ INFO = 6
+ ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+ INFO = 9
+ ELSE IF( LDB.LT.MAX( 1, M ) )THEN
+ INFO = 11
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'DTRMM ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* And when alpha.eq.zero.
+*
+ IF( ALPHA.EQ.ZERO )THEN
+ DO 20, J = 1, N
+ DO 10, I = 1, M
+ B( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END IF
+*
+* Start the operations.
+*
+ IF( LSIDE )THEN
+ IF( LSAME( TRANSA, 'N' ) )THEN
+*
+* Form B := alpha*A*B.
+*
+ IF( UPPER )THEN
+ DO 50, J = 1, N
+ DO 40, K = 1, M
+ IF( B( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( K, J )
+ DO 30, I = 1, K - 1
+ B( I, J ) = B( I, J ) + TEMP*A( I, K )
+ 30 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( K, K )
+ B( K, J ) = TEMP
+ END IF
+ 40 CONTINUE
+ 50 CONTINUE
+ ELSE
+ DO 80, J = 1, N
+ DO 70 K = M, 1, -1
+ IF( B( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( K, J )
+ B( K, J ) = TEMP
+ IF( NOUNIT )
+ $ B( K, J ) = B( K, J )*A( K, K )
+ DO 60, I = K + 1, M
+ B( I, J ) = B( I, J ) + TEMP*A( I, K )
+ 60 CONTINUE
+ END IF
+ 70 CONTINUE
+ 80 CONTINUE
+ END IF
+ ELSE
+*
+* Form B := alpha*A'*B.
+*
+ IF( UPPER )THEN
+ DO 110, J = 1, N
+ DO 100, I = M, 1, -1
+ TEMP = B( I, J )
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( I, I )
+ DO 90, K = 1, I - 1
+ TEMP = TEMP + A( K, I )*B( K, J )
+ 90 CONTINUE
+ B( I, J ) = ALPHA*TEMP
+ 100 CONTINUE
+ 110 CONTINUE
+ ELSE
+ DO 140, J = 1, N
+ DO 130, I = 1, M
+ TEMP = B( I, J )
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( I, I )
+ DO 120, K = I + 1, M
+ TEMP = TEMP + A( K, I )*B( K, J )
+ 120 CONTINUE
+ B( I, J ) = ALPHA*TEMP
+ 130 CONTINUE
+ 140 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IF( LSAME( TRANSA, 'N' ) )THEN
+*
+* Form B := alpha*B*A.
+*
+ IF( UPPER )THEN
+ DO 180, J = N, 1, -1
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 150, I = 1, M
+ B( I, J ) = TEMP*B( I, J )
+ 150 CONTINUE
+ DO 170, K = 1, J - 1
+ IF( A( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*A( K, J )
+ DO 160, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 160 CONTINUE
+ END IF
+ 170 CONTINUE
+ 180 CONTINUE
+ ELSE
+ DO 220, J = 1, N
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 190, I = 1, M
+ B( I, J ) = TEMP*B( I, J )
+ 190 CONTINUE
+ DO 210, K = J + 1, N
+ IF( A( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*A( K, J )
+ DO 200, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 200 CONTINUE
+ END IF
+ 210 CONTINUE
+ 220 CONTINUE
+ END IF
+ ELSE
+*
+* Form B := alpha*B*A'.
+*
+ IF( UPPER )THEN
+ DO 260, K = 1, N
+ DO 240, J = 1, K - 1
+ IF( A( J, K ).NE.ZERO )THEN
+ TEMP = ALPHA*A( J, K )
+ DO 230, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 230 CONTINUE
+ END IF
+ 240 CONTINUE
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( K, K )
+ IF( TEMP.NE.ONE )THEN
+ DO 250, I = 1, M
+ B( I, K ) = TEMP*B( I, K )
+ 250 CONTINUE
+ END IF
+ 260 CONTINUE
+ ELSE
+ DO 300, K = N, 1, -1
+ DO 280, J = K + 1, N
+ IF( A( J, K ).NE.ZERO )THEN
+ TEMP = ALPHA*A( J, K )
+ DO 270, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 270 CONTINUE
+ END IF
+ 280 CONTINUE
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( K, K )
+ IF( TEMP.NE.ONE )THEN
+ DO 290, I = 1, M
+ B( I, K ) = TEMP*B( I, K )
+ 290 CONTINUE
+ END IF
+ 300 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DTRMM .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.c
new file mode 100644
index 0000000000000000000000000000000000000000..81389c25adb5d6cd7975354a257af864fb2c0484
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.c
@@ -0,0 +1,298 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dtrmv_(uplo, trans, diag, n, a, lda, x, incx)
+const char *uplo, *trans, *diag;
+const integer *n;
+doublereal *a;
+const integer *lda;
+doublereal *x;
+const integer *incx;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer info;
+ static doublereal temp;
+ static integer i, j;
+ static integer ix, jx, kx;
+ static logical nounit;
+
+/* Purpose */
+/* ======= */
+
+/* DTRMV performs one of the matrix-vector operations */
+
+/* x := A*x, or x := A'*x, */
+
+/* where x is an n element vector and A is an n by n unit, or non-unit, */
+/* upper or lower triangular matrix. */
+
+/* Parameters */
+/* ========== */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the operation to be performed as */
+/* follows: */
+
+/* TRANS = 'N' or 'n' x := A*x. */
+
+/* TRANS = 'T' or 't' x := A'*x. */
+
+/* TRANS = 'C' or 'c' x := A'*x. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit */
+/* triangular as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, n ). */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element vector x. On exit, X is overwritten with the */
+/* transformed vector x. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 2;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("DTRMV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+ nounit = lsame_(diag, "N");
+
+/* Set up the start point in X if the increment is not unity. This */
+/* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := A*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__2 = j - 1;
+ for (i = 1; i <= i__2; ++i) {
+ x[i] += temp * a[i + j * a_dim1];
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__2 = j - 1;
+ for (i = 1; i <= i__2; ++i) {
+ x[ix] += temp * a[i + j * a_dim1];
+ ix += *incx;
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx += *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__1 = j + 1;
+ for (i = *n; i >= i__1; --i) {
+ x[i] += temp * a[i + j * a_dim1];
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__1 = j + 1;
+ for (i = *n; i >= i__1; --i) {
+ x[ix] += temp * a[i + j * a_dim1];
+ ix -= *incx;
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx -= *incx;
+ }
+ }
+ }
+ } else {
+
+/* Form x := A'*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i = j - 1; i >= 1; --i) {
+ temp += a[i + j * a_dim1] * x[i];
+ }
+ x[j] = temp;
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i = j - 1; i >= 1; --i) {
+ ix -= *incx;
+ temp += a[i + j * a_dim1] * x[ix];
+ }
+ x[jx] = temp;
+ jx -= *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i = j + 1; i <= i__2; ++i) {
+ temp += a[i + j * a_dim1] * x[i];
+ }
+ x[j] = temp;
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i = j + 1; i <= i__2; ++i) {
+ ix += *incx;
+ temp += a[i + j * a_dim1] * x[ix];
+ }
+ x[jx] = temp;
+ jx += *incx;
+ }
+ }
+ }
+ }
+} /* dtrmv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.f
new file mode 100644
index 0000000000000000000000000000000000000000..c0c5429baf7c095c23b4981a6a1ce2ef5f215bb3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrmv.f
@@ -0,0 +1,286 @@
+ SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, LDA, N
+ CHARACTER*1 DIAG, TRANS, UPLO
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTRMV performs one of the matrix-vector operations
+*
+* x := A*x, or x := A'*x,
+*
+* where x is an n element vector and A is an n by n unit, or non-unit,
+* upper or lower triangular matrix.
+*
+* Parameters
+* ==========
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the operation to be performed as
+* follows:
+*
+* TRANS = 'N' or 'n' x := A*x.
+*
+* TRANS = 'T' or 't' x := A'*x.
+*
+* TRANS = 'C' or 'c' x := A'*x.
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit
+* triangular as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the order of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+* Before entry with UPLO = 'U' or 'u', the leading n by n
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading n by n
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, n ).
+* Unchanged on exit.
+*
+* X - DOUBLE PRECISION array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the n
+* element vector x. On exit, X is overwritten with the
+* transformed vector x.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* .. Local Scalars ..
+ DOUBLE PRECISION TEMP
+ INTEGER I, INFO, IX, J, JX, KX
+ LOGICAL NOUNIT
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( UPLO , 'U' ).AND.
+ $ .NOT.LSAME( UPLO , 'L' ) )THEN
+ INFO = 1
+ ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 2
+ ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+ $ .NOT.LSAME( DIAG , 'N' ) )THEN
+ INFO = 3
+ ELSE IF( N.LT.0 )THEN
+ INFO = 4
+ ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'DTRMV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ NOUNIT = LSAME( DIAG, 'N' )
+*
+* Set up the start point in X if the increment is not unity. This
+* will be ( N - 1 )*INCX too small for descending loops.
+*
+ IF( INCX.LE.0 )THEN
+ KX = 1 - ( N - 1 )*INCX
+ ELSE IF( INCX.NE.1 )THEN
+ KX = 1
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form x := A*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = 1, N
+ IF( X( J ).NE.ZERO )THEN
+ TEMP = X( J )
+ DO 10, I = 1, J - 1
+ X( I ) = X( I ) + TEMP*A( I, J )
+ 10 CONTINUE
+ IF( NOUNIT )
+ $ X( J ) = X( J )*A( J, J )
+ END IF
+ 20 CONTINUE
+ ELSE
+ JX = KX
+ DO 40, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = X( JX )
+ IX = KX
+ DO 30, I = 1, J - 1
+ X( IX ) = X( IX ) + TEMP*A( I, J )
+ IX = IX + INCX
+ 30 CONTINUE
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )*A( J, J )
+ END IF
+ JX = JX + INCX
+ 40 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 60, J = N, 1, -1
+ IF( X( J ).NE.ZERO )THEN
+ TEMP = X( J )
+ DO 50, I = N, J + 1, -1
+ X( I ) = X( I ) + TEMP*A( I, J )
+ 50 CONTINUE
+ IF( NOUNIT )
+ $ X( J ) = X( J )*A( J, J )
+ END IF
+ 60 CONTINUE
+ ELSE
+ KX = KX + ( N - 1 )*INCX
+ JX = KX
+ DO 80, J = N, 1, -1
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = X( JX )
+ IX = KX
+ DO 70, I = N, J + 1, -1
+ X( IX ) = X( IX ) + TEMP*A( I, J )
+ IX = IX - INCX
+ 70 CONTINUE
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )*A( J, J )
+ END IF
+ JX = JX - INCX
+ 80 CONTINUE
+ END IF
+ END IF
+ ELSE
+*
+* Form x := A'*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 100, J = N, 1, -1
+ TEMP = X( J )
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 90, I = J - 1, 1, -1
+ TEMP = TEMP + A( I, J )*X( I )
+ 90 CONTINUE
+ X( J ) = TEMP
+ 100 CONTINUE
+ ELSE
+ JX = KX + ( N - 1 )*INCX
+ DO 120, J = N, 1, -1
+ TEMP = X( JX )
+ IX = JX
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 110, I = J - 1, 1, -1
+ IX = IX - INCX
+ TEMP = TEMP + A( I, J )*X( IX )
+ 110 CONTINUE
+ X( JX ) = TEMP
+ JX = JX - INCX
+ 120 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 140, J = 1, N
+ TEMP = X( J )
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 130, I = J + 1, N
+ TEMP = TEMP + A( I, J )*X( I )
+ 130 CONTINUE
+ X( J ) = TEMP
+ 140 CONTINUE
+ ELSE
+ JX = KX
+ DO 160, J = 1, N
+ TEMP = X( JX )
+ IX = JX
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 150, I = J + 1, N
+ IX = IX + INCX
+ TEMP = TEMP + A( I, J )*X( IX )
+ 150 CONTINUE
+ X( JX ) = TEMP
+ JX = JX + INCX
+ 160 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DTRMV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.c
new file mode 100644
index 0000000000000000000000000000000000000000..3beb685d7dbcc3acbd12ef1b560f7d433feda87e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.c
@@ -0,0 +1,301 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void dtrsv_(uplo, trans, diag, n, a, lda, x, incx)
+const char *uplo, *trans, *diag;
+const integer *n;
+const doublereal *a;
+const integer *lda;
+doublereal *x;
+const integer *incx;
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer info;
+ static doublereal temp;
+ static integer i, j;
+ static integer ix, jx, kx;
+ static logical nounit;
+
+/* Purpose */
+/* ======= */
+
+/* DTRSV solves one of the systems of equations */
+
+/* A*x = b, or A'*x = b, */
+
+/* where b and x are n element vectors and A is an n by n unit, or */
+/* non-unit, upper or lower triangular matrix. */
+
+/* No test for singularity or near-singularity is included in this */
+/* routine. Such tests must be performed before calling this routine. */
+
+/* Parameters */
+/* ========== */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the equations to be solved as */
+/* follows: */
+
+/* TRANS = 'N' or 'n' A*x = b. */
+
+/* TRANS = 'T' or 't' A'*x = b. */
+
+/* TRANS = 'C' or 'c' A'*x = b. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit */
+/* triangular as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, n ). */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element right-hand side vector b. On exit, X is overwritten */
+/* with the solution vector x. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 2;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("DTRSV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+ nounit = lsame_(diag, "N");
+
+/* Set up the start point in X if the increment is not unity. This */
+/* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := inv( A )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.) {
+ if (nounit) {
+ x[j] /= a[j + j * a_dim1];
+ }
+ temp = x[j];
+ for (i = j - 1; i >= 1; --i) {
+ x[i] -= temp * a[i + j * a_dim1];
+ }
+ }
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.) {
+ if (nounit) {
+ x[jx] /= a[j + j * a_dim1];
+ }
+ temp = x[jx];
+ ix = jx;
+ for (i = j - 1; i >= 1; --i) {
+ ix -= *incx;
+ x[ix] -= temp * a[i + j * a_dim1];
+ }
+ }
+ jx -= *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.) {
+ if (nounit) {
+ x[j] /= a[j + j * a_dim1];
+ }
+ temp = x[j];
+ i__2 = *n;
+ for (i = j + 1; i <= i__2; ++i) {
+ x[i] -= temp * a[i + j * a_dim1];
+ }
+ }
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ if (nounit) {
+ x[jx] /= a[j + j * a_dim1];
+ }
+ temp = x[jx];
+ ix = jx;
+ i__2 = *n;
+ for (i = j + 1; i <= i__2; ++i) {
+ ix += *incx;
+ x[ix] -= temp * a[i + j * a_dim1];
+ }
+ }
+ jx += *incx;
+ }
+ }
+ }
+ } else {
+
+/* Form x := inv( A' )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[j];
+ i__2 = j - 1;
+ for (i = 1; i <= i__2; ++i) {
+ temp -= a[i + j * a_dim1] * x[i];
+ }
+ if (nounit) {
+ temp /= a[j + j * a_dim1];
+ }
+ x[j] = temp;
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[jx];
+ ix = kx;
+ i__2 = j - 1;
+ for (i = 1; i <= i__2; ++i) {
+ temp -= a[i + j * a_dim1] * x[ix];
+ ix += *incx;
+ }
+ if (nounit) {
+ temp /= a[j + j * a_dim1];
+ }
+ x[jx] = temp;
+ jx += *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ i__1 = j + 1;
+ for (i = *n; i >= i__1; --i) {
+ temp -= a[i + j * a_dim1] * x[i];
+ }
+ if (nounit) {
+ temp /= a[j + j * a_dim1];
+ }
+ x[j] = temp;
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ ix = kx;
+ i__1 = j + 1;
+ for (i = *n; i >= i__1; --i) {
+ temp -= a[i + j * a_dim1] * x[ix];
+ ix -= *incx;
+ }
+ if (nounit) {
+ temp /= a[j + j * a_dim1];
+ }
+ x[jx] = temp;
+ jx -= *incx;
+ }
+ }
+ }
+ }
+} /* dtrsv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.f
new file mode 100644
index 0000000000000000000000000000000000000000..9c3e90a97bb016616aa45a2c5672dbeee9abac46
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dtrsv.f
@@ -0,0 +1,289 @@
+ SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, LDA, N
+ CHARACTER*1 DIAG, TRANS, UPLO
+* .. Array Arguments ..
+ DOUBLE PRECISION A( LDA, * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* DTRSV solves one of the systems of equations
+*
+* A*x = b, or A'*x = b,
+*
+* where b and x are n element vectors and A is an n by n unit, or
+* non-unit, upper or lower triangular matrix.
+*
+* No test for singularity or near-singularity is included in this
+* routine. Such tests must be performed before calling this routine.
+*
+* Parameters
+* ==========
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the equations to be solved as
+* follows:
+*
+* TRANS = 'N' or 'n' A*x = b.
+*
+* TRANS = 'T' or 't' A'*x = b.
+*
+* TRANS = 'C' or 'c' A'*x = b.
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit
+* triangular as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the order of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+* Before entry with UPLO = 'U' or 'u', the leading n by n
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading n by n
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, n ).
+* Unchanged on exit.
+*
+* X - DOUBLE PRECISION array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the n
+* element right-hand side vector b. On exit, X is overwritten
+* with the solution vector x.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* .. Local Scalars ..
+ DOUBLE PRECISION TEMP
+ INTEGER I, INFO, IX, J, JX, KX
+ LOGICAL NOUNIT
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( UPLO , 'U' ).AND.
+ $ .NOT.LSAME( UPLO , 'L' ) )THEN
+ INFO = 1
+ ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 2
+ ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+ $ .NOT.LSAME( DIAG , 'N' ) )THEN
+ INFO = 3
+ ELSE IF( N.LT.0 )THEN
+ INFO = 4
+ ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'DTRSV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ NOUNIT = LSAME( DIAG, 'N' )
+*
+* Set up the start point in X if the increment is not unity. This
+* will be ( N - 1 )*INCX too small for descending loops.
+*
+ IF( INCX.LE.0 )THEN
+ KX = 1 - ( N - 1 )*INCX
+ ELSE IF( INCX.NE.1 )THEN
+ KX = 1
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form x := inv( A )*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = N, 1, -1
+ IF( X( J ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( J ) = X( J )/A( J, J )
+ TEMP = X( J )
+ DO 10, I = J - 1, 1, -1
+ X( I ) = X( I ) - TEMP*A( I, J )
+ 10 CONTINUE
+ END IF
+ 20 CONTINUE
+ ELSE
+ JX = KX + ( N - 1 )*INCX
+ DO 40, J = N, 1, -1
+ IF( X( JX ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )/A( J, J )
+ TEMP = X( JX )
+ IX = JX
+ DO 30, I = J - 1, 1, -1
+ IX = IX - INCX
+ X( IX ) = X( IX ) - TEMP*A( I, J )
+ 30 CONTINUE
+ END IF
+ JX = JX - INCX
+ 40 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 60, J = 1, N
+ IF( X( J ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( J ) = X( J )/A( J, J )
+ TEMP = X( J )
+ DO 50, I = J + 1, N
+ X( I ) = X( I ) - TEMP*A( I, J )
+ 50 CONTINUE
+ END IF
+ 60 CONTINUE
+ ELSE
+ JX = KX
+ DO 80, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )/A( J, J )
+ TEMP = X( JX )
+ IX = JX
+ DO 70, I = J + 1, N
+ IX = IX + INCX
+ X( IX ) = X( IX ) - TEMP*A( I, J )
+ 70 CONTINUE
+ END IF
+ JX = JX + INCX
+ 80 CONTINUE
+ END IF
+ END IF
+ ELSE
+*
+* Form x := inv( A' )*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 100, J = 1, N
+ TEMP = X( J )
+ DO 90, I = 1, J - 1
+ TEMP = TEMP - A( I, J )*X( I )
+ 90 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ X( J ) = TEMP
+ 100 CONTINUE
+ ELSE
+ JX = KX
+ DO 120, J = 1, N
+ TEMP = X( JX )
+ IX = KX
+ DO 110, I = 1, J - 1
+ TEMP = TEMP - A( I, J )*X( IX )
+ IX = IX + INCX
+ 110 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ X( JX ) = TEMP
+ JX = JX + INCX
+ 120 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 140, J = N, 1, -1
+ TEMP = X( J )
+ DO 130, I = N, J + 1, -1
+ TEMP = TEMP - A( I, J )*X( I )
+ 130 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ X( J ) = TEMP
+ 140 CONTINUE
+ ELSE
+ KX = KX + ( N - 1 )*INCX
+ JX = KX
+ DO 160, J = N, 1, -1
+ TEMP = X( JX )
+ IX = KX
+ DO 150, I = N, J + 1, -1
+ TEMP = TEMP - A( I, J )*X( IX )
+ IX = IX - INCX
+ 150 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ X( JX ) = TEMP
+ JX = JX - INCX
+ 160 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of DTRSV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.c
new file mode 100644
index 0000000000000000000000000000000000000000..026231ed6fbb5473f719ae6be2e27f82207cce57
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.c
@@ -0,0 +1,39 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+doublereal dzasum_(n, zx, incx)
+const integer *n;
+const doublecomplex *zx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i;
+ static doublereal stemp;
+ static integer ix;
+
+/* takes the sum of the absolute values (1-norm). */
+/* jack dongarra, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ stemp = 0.;
+ if (*n <= 0 || *incx <= 0) {
+ return stemp;
+ }
+ if (*incx == 1) {
+ for (i = 0; i < *n; ++i) {
+ stemp += abs(zx[i].r) + abs(zx[i].i);
+ }
+ }
+ else {
+ ix = 0;
+ for (i = 0; i < *n; ++i) {
+ stemp += abs(zx[ix].r) + abs(zx[ix].i);
+ ix += *incx;
+ }
+ }
+ return stemp;
+} /* dzasum_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.f
new file mode 100644
index 0000000000000000000000000000000000000000..d21c1ffc91d6fb386aa1d30ac8572ebb5db667fe
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dzasum.f
@@ -0,0 +1,34 @@
+ double precision function dzasum(n,zx,incx)
+c
+c takes the sum of the absolute values.
+c jack dongarra, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*)
+ double precision stemp,dcabs1
+ integer i,incx,ix,n
+c
+ dzasum = 0.0d0
+ stemp = 0.0d0
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ do 10 i = 1,n
+ stemp = stemp + dcabs1(zx(ix))
+ ix = ix + incx
+ 10 continue
+ dzasum = stemp
+ return
+c
+c code for increment equal to 1
+c
+ 20 do 30 i = 1,n
+ stemp = stemp + dcabs1(zx(i))
+ 30 continue
+ dzasum = stemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/dznrm2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/dznrm2.c
new file mode 100644
index 0000000000000000000000000000000000000000..325dcbb1e8999b1328c49556c827423ebb992618
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/dznrm2.c
@@ -0,0 +1,62 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+doublereal dznrm2_(n, x, incx)
+const integer *n;
+const doublecomplex *x;
+const integer *incx;
+{
+ /* Local variables */
+ static doublereal temp, norm, scale;
+ static integer ix;
+ static doublereal ssq;
+
+/* DZNRM2 returns the euclidean norm of a vector via the function */
+/* name, so that */
+/* */
+/* DZNRM2 := sqrt( conjg( x' )*x ) */
+
+
+/* -- This version written on 25-October-1982. */
+/* Modified on 14-October-1993 to inline the call to ZLASSQ. */
+/* Sven Hammarling, Nag Ltd. */
+
+ if (*n < 1 || *incx < 1) {
+ norm = 0.;
+ } else {
+ scale = 0.;
+ ssq = 1.;
+/* The following loop is equivalent to this call to the LAPACK */
+/* auxiliary routine: */
+/* CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+ for (ix = 0; ix < *n * *incx; ix += *incx) {
+ if (x[ix].r != 0.) {
+ temp = abs(x[ix].r);
+ if (scale < temp) {
+ scale /= temp;
+ ssq = ssq * (scale * scale) + 1.;
+ scale = temp;
+ } else {
+ temp /= scale;
+ ssq += temp * temp;
+ }
+ }
+ if (x[ix].i != 0.) {
+ temp = abs(x[ix].i);
+ if (scale < temp) {
+ scale /= temp;
+ ssq = ssq * (scale * scale) + 1.;
+ scale = temp;
+ } else {
+ temp /= scale;
+ ssq += temp * temp;
+ }
+ }
+ }
+ norm = scale * sqrt(ssq);
+ }
+
+ return norm;
+} /* dznrm2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/enorm.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/enorm.c
new file mode 100644
index 0000000000000000000000000000000000000000..dc9581ce2371efbf4f16f8bf0fb094b0f4529085
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/enorm.c
@@ -0,0 +1,101 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+doublereal enorm_(n, x)
+const integer *n;
+const doublereal *x;
+{
+ /* Initialized data */
+ static doublereal rdwarf = 3.834e-20;
+ static doublereal rgiant = 1.304e19;
+
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal xabs, x1max, x3max;
+ static integer i;
+ static doublereal s1, s2, s3, agiant;
+
+/* ********** */
+/* */
+/* function enorm */
+/* */
+/* given an n-vector x, this function calculates the */
+/* euclidean norm of x. */
+/* */
+/* the euclidean norm is computed by accumulating the sum of */
+/* squares in three different sums. the sums of squares for the */
+/* small and large components are scaled so that no overflows */
+/* occur. non-destructive underflows are permitted. underflows */
+/* and overflows do not occur in the computation of the unscaled */
+/* sum of squares for the intermediate components. */
+/* the definitions of small, intermediate and large components */
+/* depend on two constants, rdwarf and rgiant. the main */
+/* restrictions on these constants are that rdwarf**2 not */
+/* underflow and rgiant**2 not overflow. the constants */
+/* given here are suitable for every known computer. */
+/* */
+/* the function statement is */
+/* */
+/* double precision function enorm(n,x) */
+/* */
+/* where */
+/* */
+/* n is a positive integer input variable. */
+/* */
+/* x is an input array of length n. */
+/* */
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+/* */
+/* ********** */
+
+ s1 = 0.; s2 = 0.; s3 = 0.;
+ x1max = 0.; x3max = 0.;
+ agiant = rgiant / (*n);
+ for (i = 0; i < *n; ++i) {
+ xabs = abs(x[i]);
+ if (xabs > rdwarf && xabs < agiant) {
+/* sum for intermediate components. */
+ s2 += xabs * xabs;
+ }
+ else if (xabs <= rdwarf) {
+/* sum for small components. */
+ if (xabs <= x3max) {
+ if (xabs != 0.) {
+ d__1 = xabs / x3max;
+ s3 += d__1 * d__1;
+ }
+ }
+ else {
+ d__1 = x3max / xabs;
+ s3 = 1. + s3 * d__1 * d__1;
+ x3max = xabs;
+ }
+ }
+/* sum for large components. */
+ else if (xabs <= x1max) {
+ d__1 = xabs / x1max;
+ s1 += d__1 * d__1;
+ }
+ else {
+ d__1 = x1max / xabs;
+ s1 = 1. + s1 * d__1 * d__1;
+ x1max = xabs;
+ }
+ }
+
+/* calculation of norm. */
+
+ if (s1 != 0.)
+ return x1max * sqrt(s1 + s2 / x1max / x1max);
+ else if (s2 == 0.)
+ return x3max * sqrt(s3);
+ else if (s2 >= x3max)
+ return sqrt(s2 * (1. + x3max / s2 * (x3max * s3)));
+ else
+ return sqrt(x3max * (s2 / x3max + x3max * s3));
+
+} /* enorm_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/A.poly b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/A.poly
new file mode 100644
index 0000000000000000000000000000000000000000..166a71773a6b72b6393e09a9fdd6530ff01cf426
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/A.poly
@@ -0,0 +1,62 @@
+29 2 1 0
+1 0.200000 -0.776400 -0.57
+2 0.220000 -0.773200 -0.55
+3 0.245600 -0.756400 -0.51
+4 0.277600 -0.702000 -0.53
+5 0.488800 -0.207600 0.28
+6 0.504800 -0.207600 0.30
+7 0.740800 -0.739600 0
+8 0.756000 -0.761200 -0.01
+9 0.774400 -0.772400 0
+10 0.800000 -0.776400 0.02
+11 0.800000 -0.792400 0.01
+12 0.579200 -0.792400 -0.21
+13 0.579200 -0.776400 -0.2
+14 0.621600 -0.771600 -0.15
+15 0.633600 -0.762800 -0.13
+16 0.639200 -0.744400 -0.1
+17 0.620800 -0.684400 -0.06
+18 0.587200 -0.604400 -0.01
+19 0.360800 -0.604400 -0.24
+20 0.319200 -0.706800 -0.39
+21 0.312000 -0.739600 -0.43
+22 0.318400 -0.761200 -0.44
+23 0.334400 -0.771600 -0.44
+24 0.371200 -0.776400 -0.41
+25 0.371200 -0.792400 -0.42
+26 0.374400 -0.570000 -0.2
+27 0.574400 -0.570000 0
+28 0.473600 -0.330800 0.14
+29 0.200000 -0.792400 -0.59
+29 0
+1 29 1
+2 1 2
+3 2 3
+4 3 4
+5 4 5
+6 5 6
+7 6 7
+8 7 8
+9 8 9
+10 9 10
+11 10 11
+12 11 12
+13 12 13
+14 13 14
+15 14 15
+16 15 16
+17 16 17
+18 17 18
+19 18 19
+20 19 20
+21 20 21
+22 21 22
+23 22 23
+24 23 24
+25 24 25
+26 25 29
+27 26 27
+28 27 28
+29 28 26
+1
+1 0.47 -0.5
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..c7f139dc075b38e6ddc77fd9faac456ba593f1c3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/CMakeLists.txt
@@ -0,0 +1,16 @@
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/v3p/netlib/examples)
+
+LINK_LIBRARIES(netlib)
+
+INCLUDE(${MODULE_PATH}/FindNetlib.cmake)
+IF(NETLIB_FOUND)
+ INCLUDE_DIRECTORIES(${NETLIB_INCLUDE_DIR})
+
+ INCLUDE(${MODULE_PATH}/NewCMake/FindX11.cmake)
+ IF(X11_FOUND)
+ INCLUDE_DIRECTORIES(${X11_INCLUDE_DIR})
+ LINK_LIBRARIES(${X11_X11_LIBRARY})
+ ADD_EXECUTABLE(netlib_showme showme.c)
+ ENDIF(X11_FOUND)
+
+ENDIF(NETLIB_FOUND)
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/showme.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/showme.c
new file mode 100644
index 0000000000000000000000000000000000000000..9f044020004d735f0785aacfc2b908aec101d38b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/examples/showme.c
@@ -0,0 +1,3390 @@
+/*****************************************************************************/
+/* */
+/* ,d88^^o 888 o o */
+/* 8888 888o^88, o88^^o Y88b o / d8b d8b o88^^8o */
+/* "Y88b 888 888 d888 b Y88b d8b / d888bdY88b d888 88b */
+/* "Y88b, 888 888 8888 8 Y888/Y88b/ / Y88Y Y888b 8888oo888 */
+/* o 8888 888 888 q888 p Y8/ Y8/ / YY Y888b q888 */
+/* "oo88P" 888 888 "88oo" Y Y / Y888b "88oooo" */
+/* */
+/* A Display Program for Meshes and More. */
+/* (showme.c) */
+/* */
+/* Version 1.3 */
+/* July 20, 1996 */
+/* */
+/* Copyright 1996 */
+/* Jonathan Richard Shewchuk */
+/* School of Computer Science */
+/* Carnegie Mellon University */
+/* 5000 Forbes Avenue */
+/* Pittsburgh, Pennsylvania 15213-3891 */
+/* jrs@cs.cmu.edu */
+/* */
+/* This program may be freely redistributed under the condition that the */
+/* copyright notices (including this entire header and the copyright */
+/* notice printed when the `-h' switch is selected) are not removed, and */
+/* no compensation is received. Private, research, and institutional */
+/* use is free. You may distribute modified versions of this code UNDER */
+/* THE CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE TO IT IN THE */
+/* SAME FILE REMAIN UNDER COPYRIGHT OF THE ORIGINAL AUTHOR, BOTH SOURCE */
+/* AND OBJECT CODE ARE MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR */
+/* NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution of this code as */
+/* part of a commercial system is permissible ONLY BY DIRECT ARRANGEMENT */
+/* WITH THE AUTHOR. (If you are not directly supplying this code to a */
+/* customer, and you are instead telling them how they can obtain it for */
+/* free, then you are not required to make any arrangement with me.) */
+/* */
+/* Hypertext instructions for Triangle are available on the Web at */
+/* */
+/* http://www.cs.cmu.edu/~quake/showme.html */
+/* */
+/* Show Me was created as part of the Archimedes project in the School of */
+/* Computer Science at Carnegie Mellon University. Archimedes is a */
+/* system for compiling parallel finite element solvers. For further */
+/* information, see Anja Feldmann, Omar Ghattas, John R. Gilbert, Gary L. */
+/* Miller, David R. O'Hallaron, Eric J. Schwabe, Jonathan R. Shewchuk, */
+/* and Shang-Hua Teng. "Automated Parallel Solution of Unstructured PDE */
+/* Problems." To appear in Communications of the ACM, we hope. */
+/* */
+/* If you make any improvements to this code, please please please let me */
+/* know, so that I may obtain the improvements. Even if you don't change */
+/* the code, I'd still love to hear what it's being used for. */
+/* */
+/* Disclaimer: Neither I nor Carnegie Mellon warrant this code in any way */
+/* whatsoever. Use at your own risk. */
+/* */
+/*****************************************************************************/
+
+/* For single precision (which will save some memory and reduce paging), */
+/* write "#define SINGLE" below. */
+/* */
+/* For double precision (which will allow you to display triangulations of */
+/* a finer resolution), leave SINGLE undefined. */
+
+/* #define SINGLE */
+
+#ifdef SINGLE
+#define REAL float
+#else
+#define REAL double
+#endif
+
+/* Maximum number of characters in a file name (including the null). */
+
+#define FILENAMESIZE 1024
+
+/* Maximum number of characters in a line read from a file (including the */
+/* null). */
+
+#define INPUTLINESIZE 512
+
+#define STARTWIDTH 414
+#define STARTHEIGHT 414
+#define MINWIDTH 50
+#define MINHEIGHT 50
+#define BUTTONHEIGHT 21
+#define BUTTONROWS 3
+#define PANELHEIGHT (BUTTONHEIGHT * BUTTONROWS)
+#define MAXCOLORS 64
+
+#define IMAGE_TYPES 7
+#define NOTHING -1
+#define NODE 0
+#define POLY 1
+#define ELE 2
+#define EDGE 3
+#define PART 4
+#define ADJ 5
+#define VORO 6
+
+#define STARTEXPLOSION 0.5
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include <X11/Xatom.h>
+
+/* The following obscenity seems to be necessary to ensure that this program */
+/* will port to Dec Alphas running OSF/1, because their stdio.h file commits */
+/* the unpardonable sin of including stdlib.h. Hence, malloc(), free(), and */
+/* exit() may or may not already be defined at this point. I declare these */
+/* functions explicitly because some non-ANSI C compilers lack stdlib.h. */
+
+#if !defined(_STDLIB_H_) && !defined(_STDLIB_H) && defined(__need_malloc_and_calloc)
+extern char *malloc();
+extern void free();
+extern void exit();
+extern double strtod();
+extern long strtol();
+#endif
+
+/* A necessary forward declaration. */
+
+int load_image();
+
+Display *display;
+int screen;
+Window rootwindow;
+Window mainwindow;
+Window quitwin;
+Window leftwin;
+Window rightwin;
+Window upwin;
+Window downwin;
+Window resetwin;
+Window pswin;
+Window epswin;
+Window expwin;
+Window exppluswin;
+Window expminuswin;
+Window widthpluswin;
+Window widthminuswin;
+Window versionpluswin;
+Window versionminuswin;
+Window fillwin;
+Window nodewin[2];
+Window polywin[2];
+Window elewin[2];
+Window edgewin[2];
+Window partwin[2];
+Window adjwin[2];
+Window voronoiwin[2];
+
+int windowdepth;
+XEvent event;
+Colormap rootmap;
+XFontStruct *font;
+int width, height;
+int black, white;
+int showme_foreground;
+GC fontgc;
+GC blackfontgc;
+GC linegc;
+GC trianglegc;
+int colors[MAXCOLORS];
+XColor rgb[MAXCOLORS];
+int color;
+
+int start_image, current_image;
+int start_inc, current_inc;
+int loweriteration;
+int line_width;
+int loaded[2][IMAGE_TYPES];
+REAL xlo[2][IMAGE_TYPES], ylo[2][IMAGE_TYPES];
+REAL xhi[2][IMAGE_TYPES], yhi[2][IMAGE_TYPES];
+REAL xscale, yscale;
+REAL xoffset, yoffset;
+int zoom;
+
+int nodes[2], node_dim[2];
+REAL *nodeptr[2];
+int polynodes[2], poly_dim[2], polyedges[2], polyholes[2];
+REAL *polynodeptr[2], *polyholeptr[2];
+int *polyedgeptr[2];
+int elems[2], ele_corners[2];
+int *eleptr[2];
+int edges[2];
+int *edgeptr[2];
+REAL *normptr[2];
+int subdomains[2];
+int *partpart[2];
+REAL *partcenter[2], *partshift[2];
+int adjsubdomains[2];
+int *adjptr[2];
+int vnodes[2], vnode_dim[2];
+REAL *vnodeptr[2];
+int vedges[2];
+int *vedgeptr[2];
+REAL *vnormptr[2];
+int firstnumber[2];
+
+int quiet, fillelem, bw_ps, explode;
+REAL explosion;
+
+char filename[FILENAMESIZE];
+char nodefilename[2][FILENAMESIZE];
+char polyfilename[2][FILENAMESIZE];
+char elefilename[2][FILENAMESIZE];
+char edgefilename[2][FILENAMESIZE];
+char partfilename[2][FILENAMESIZE];
+char adjfilename[2][FILENAMESIZE];
+char vnodefilename[2][FILENAMESIZE];
+char vedgefilename[2][FILENAMESIZE];
+
+const
+char *colorname[] = {"aquamarine", "red", "green yellow", "magenta",
+ "yellow", "green", "orange", "blue",
+ "white", "sandy brown", "cyan", "moccasin",
+ "cadet blue", "coral", "cornflower blue", "sky blue",
+ "firebrick", "forest green", "gold", "goldenrod",
+ "gray", "hot pink", "chartreuse", "pale violet red",
+ "indian red", "khaki", "lavender", "light blue",
+ "light gray", "light steel blue", "lime green", "azure",
+ "maroon", "medium aquamarine", "dodger blue", "honeydew",
+ "medium orchid", "medium sea green", "moccasin",
+ "medium slate blue", "medium spring green",
+ "medium turquoise", "medium violet red",
+ "orange red", "chocolate", "light goldenrod",
+ "orchid", "pale green", "pink", "plum",
+ "purple", "salmon", "sea green",
+ "sienna", "slate blue", "spring green",
+ "steel blue", "tan", "thistle", "turquoise",
+ "violet", "violet red", "wheat",
+ "yellow green"};
+
+void syntax()
+{
+ printf("showme [-bfw_Qh] input_file\n");
+ printf(" -b Black and white PostScript (default is color).\n");
+ printf(" -f Fill triangles of partitioned mesh with color.\n");
+ printf(" -w Set line width to some specified number.\n");
+ printf(" -Q Quiet: No terminal output except errors.\n");
+ printf(" -h Help: Detailed instructions for Show Me.\n");
+ exit(0);
+}
+
+void info()
+{
+ printf("Show Me\n");
+ printf("A Display Program for Meshes and More.\n");
+ printf("Version 1.3\n\n");
+ printf(
+"Copyright 1996 Jonathan Richard Shewchuk (bugs/comments to jrs@cs.cmu.edu)\n"
+);
+ printf("School of Computer Science / Carnegie Mellon University\n");
+ printf("5000 Forbes Avenue / Pittsburgh, Pennsylvania 15213-3891\n");
+ printf(
+"Created as part of the Archimedes project (tools for parallel FEM).\n");
+ printf(
+"Supported in part by NSF Grant CMS-9318163 and an NSERC 1967 Scholarship.\n");
+ printf("There is no warranty whatsoever. Use at your own risk.\n");
+#ifdef SINGLE
+ printf("This executable is compiled for single precision arithmetic.\n\n\n");
+#else
+ printf("This executable is compiled for double precision arithmetic.\n\n\n");
+#endif
+ printf(
+"Show Me graphically displays the contents of geometric files, especially\n");
+ printf(
+"those generated by Triangle, my two-dimensional quality mesh generator and\n"
+);
+ printf(
+"Delaunay triangulator. Show Me can also write images in PostScript form.\n");
+ printf(
+"Show Me is also useful for checking the consistency of the files you create\n"
+);
+ printf(
+"as input to Triangle; Show Me does these checks more thoroughly than\n");
+ printf("Triangle does. The command syntax is:\n\n");
+ printf("showme [-bfw_Qh] input_file\n\n");
+ printf(
+"The underscore indicates that a number should follow the -w switch.\n");
+ printf(
+"input_file may be one of several types of file. It must have extension\n");
+ printf(
+".node, .poly, .ele, .edge, .part, or .adj. If no extension is provided,\n");
+ printf(
+"Show Me will assume the extension .ele. A .node file represents a set of\n");
+ printf(
+"points; a .poly file represents a Planar Straight Line Graph; an .ele file\n"
+);
+ printf(
+"(coupled with a .node file) represents the elements of a mesh or the\n");
+ printf(
+"triangles of a triangulation; an .edge file (coupled with a .node file)\n");
+ printf(
+"represents a set of edges; a .part file specifies a partition of a mesh;\n");
+ printf(
+"and a .adj file represents the adjacency graph defined by a partition.\n");
+ printf("\n");
+ printf("Command Line Switches:\n");
+ printf("\n");
+ printf(
+" -b Makes all PostScript output black and white. If this switch is not\n"
+);
+ printf(
+" selected, color PostScript is used for partitioned meshes and\n");
+ printf(" adjacency graphs (.part and .adj files).\n");
+ printf(
+" -f On color displays and in color PostScript, displays partitioned\n");
+ printf(
+" meshes by filling triangles with color, rather than by coloring the\n"
+);
+ printf(
+" edges. This switch will result in a clearer picture if all\n");
+ printf(
+" triangles are reasonably large, and a less clear picture if small\n");
+ printf(
+" triangles are present. (There is also a button to toggle this\n");
+ printf(" behavior.)\n");
+ printf(
+" -w Followed by an integer, specifies the line width used in all\n");
+ printf(
+" images. (There are also buttons to change the line width.)\n");
+ printf(
+" -Q Quiet: Suppresses all explanation of what Show Me is doing, unless\n"
+);
+ printf(" an error occurs.\n");
+ printf(" -h Help: Displays these instructions.\n");
+ printf("\n");
+ printf("Controls:\n");
+ printf("\n");
+ printf(
+" To zoom in on an image, point at the location where you want a closer\n");
+ printf(
+" look, and click the left mouse button. To zoom out, click the right\n");
+ printf(
+" mouse button. In either case, the point you click on will be centered in\n"
+);
+ printf(
+" the window. If you want to know the coordinates of a point, click the\n");
+ printf(
+" middle mouse button; the coordinates will be printed on the terminal you\n"
+);
+ printf(" invoked Show Me from.\n\n");
+ printf(
+" If you resize the window, the image will grow or shrink to match.\n");
+ printf("\n");
+ printf(
+" There is a panel of control buttons at the bottom of the Show Me window:\n"
+);
+ printf("\n");
+ printf(" Quit: Shuts down Show Me.\n");
+ printf(" <, >, ^, v: Moves the image in the indicated direction.\n");
+ printf(
+" Reset: Unzooms and centers the image in the window. When you switch from\n"
+);
+ printf(
+" one image to another, the viewing region does not change, so you may\n");
+ printf(
+" need to reset the new image to make it fully visible. This often is\n");
+ printf(
+" the case when switching between Delaunay triangulations and their\n");
+ printf(
+" corresponding Voronoi diagrams, as Voronoi vertices can be far from the\n"
+);
+ printf(" initial point set.\n");
+ printf(
+" Width+, -: Increases or decreases the width of all lines and points.\n");
+ printf(
+" Exp, +, -: These buttons appear only when you are viewing a partitioned\n"
+);
+ printf(
+" mesh (.part file). `Exp' toggles between an exploded and non-exploded\n"
+);
+ printf(
+" image of the mesh. The non-exploded image will not show the partition\n"
+);
+ printf(
+" on a black and white monitor. `+' and `-' allow you to adjust the\n");
+ printf(
+" spacing between pieces of the mesh to better distinguish them.\n");
+ printf(
+" Fill: This button appears only when you are viewing a partitioned mesh\n");
+ printf(
+" (.part file). It toggles between color-filled triangles and colored\n");
+ printf(
+" edges (as the -f switch does). Filled triangles look better when all\n");
+ printf(
+" triangles are reasonably large; colored edges look better when there\n");
+ printf(" are very small triangles present.\n");
+ printf(
+" PS: Creates a PostScript file containing the image you are viewing. If\n"
+);
+ printf(
+" the -b switch is selected, all PostScript output will be black and\n");
+ printf(
+" white; otherwise, .part.ps and .adj.ps files will be color, independent\n"
+);
+ printf(
+" of whether you are using a color monitor. Normally the output will\n");
+ printf(
+" preserve the properties of the image you see on the screen, including\n");
+ printf(
+" zoom and line width; however, if black and white output is selected (-b\n"
+);
+ printf(
+" switch), partitioned meshes will always be drawn exploded. The output\n"
+);
+ printf(
+" file name depends on the image being viewed. If you want several\n");
+ printf(
+" different snapshots (zooming in on different parts) of the same object,\n"
+);
+ printf(
+" you'll have to rename each file after Show Me creates it so that it\n");
+ printf(" isn't overwritten by the next snapshot.\n");
+ printf(
+" EPS: Creates an encapsulated PostScript file, suitable for inclusion in\n"
+);
+ printf(
+" documents. Otherwise, this button is just like the PS button. (The\n");
+ printf(
+" main difference is that .eps files lack a `showpage' command at the\n");
+ printf(" end.)\n\n");
+ printf(
+" There are two nearly-identical rows of buttons that load different images\n"
+);
+ printf(" from disk. Each row contains the following buttons:\n\n");
+ printf(" node: Loads a .node file.\n");
+ printf(
+" poly: Loads a .poly file (and possibly an associated .node file).\n");
+ printf(" ele: Loads an .ele file (and associated .node file).\n");
+ printf(" edge: Loads an .edge file (and associated .node file).\n");
+ printf(
+" part: Loads a .part file (and associated .node and .ele files).\n");
+ printf(
+" adj: Loads an .adj file (and associated .node, .ele, and .part files).\n");
+ printf(" voro: Loads a .v.node and .v.edge file for a Voronoi diagram.\n");
+ printf("\n");
+ printf(
+" Each row represents a different iteration number of the geometry files.\n");
+ printf(
+" For a full explanation of iteration numbers, read the instructions for\n");
+ printf(
+" Triangle. Briefly, iteration numbers are used to allow a user to easily\n"
+);
+ printf(
+" represent a sequence of related triangulations. Iteration numbers are\n");
+ printf(
+" used in the names of geometry files; for instance, mymesh.3.ele is a\n");
+ printf(
+" triangle file with iteration number three, and mymesh.ele has an implicit\n"
+);
+ printf(" iteration number of zero.\n\n");
+ printf(
+" The control buttons at the right end of each row display the two\n");
+ printf(
+" iterations currently under view. These buttons can be clicked to\n");
+ printf(
+" increase or decrease the iteration numbers, and thus conveniently view\n");
+ printf(" a sequence of meshes.\n\n");
+ printf(
+" Show Me keeps each file in memory after loading it, but you can force\n");
+ printf(
+" Show Me to reread a set of files (for one iteration number) by reclicking\n"
+);
+ printf(
+" the button that corresponds to the current image. This is convenient if\n"
+);
+ printf(" you have changed a geometry file.\n\n");
+ printf("File Formats:\n\n");
+ printf(
+" All files may contain comments prefixed by the character '#'. Points,\n");
+ printf(
+" segments, holes, triangles, edges, and subdomains must be numbered\n");
+ printf(
+" consecutively, starting from either 1 or 0. Whichever you choose, all\n");
+ printf(
+" input files must be consistent (for any single iteration number); if the\n"
+);
+ printf(
+" nodes are numbered from 1, so must be all other objects. Show Me\n");
+ printf(
+" automatically detects your choice while reading a .node (or .poly) file.\n"
+);
+ printf(" Examples of these file formats are given below.\n\n");
+ printf(" .node files:\n");
+ printf(
+" First line: <# of points> <dimension (must be 2)> <# of attributes>\n");
+ printf(
+" <# of boundary markers (0 or 1)>\n"
+);
+ printf(
+" Remaining lines: <point #> <x> <y> [attributes] [boundary marker]\n");
+ printf("\n");
+ printf(
+" The attributes, which are typically floating-point values of physical\n");
+ printf(
+" quantities (such as mass or conductivity) associated with the nodes of\n"
+);
+ printf(
+" a finite element mesh, are ignored by Show Me. Show Me also ignores\n");
+ printf(
+" boundary markers. See the instructions for Triangle to find out what\n");
+ printf(" attributes and boundary markers are.\n\n");
+ printf(" .poly files:\n");
+ printf(
+" First line: <# of points> <dimension (must be 2)> <# of attributes>\n");
+ printf(
+" <# of boundary markers (0 or 1)>\n"
+);
+ printf(
+" Following lines: <point #> <x> <y> [attributes] [boundary marker]\n");
+ printf(" One line: <# of segments> <# of boundary markers (0 or 1)>\n");
+ printf(
+" Following lines: <segment #> <endpoint> <endpoint> [boundary marker]\n");
+ printf(" One line: <# of holes>\n");
+ printf(" Following lines: <hole #> <x> <y>\n");
+ printf(" [Optional additional lines that are ignored]\n\n");
+ printf(
+" A .poly file represents a Planar Straight Line Graph (PSLG), an idea\n");
+ printf(
+" familiar to computational geometers. By definition, a PSLG is just a\n");
+ printf(
+" list of points and edges. A .poly file also contains some additional\n");
+ printf(" information.\n\n");
+ printf(
+" The first section lists all the points, and is identical to the format\n"
+);
+ printf(
+" of .node files. <# of points> may be set to zero to indicate that the\n"
+);
+ printf(
+" points are listed in a separate .node file; .poly files produced by\n");
+ printf(
+" Triangle always have this format. When Show Me reads such a file, it\n");
+ printf(" also reads the corresponding .node file.\n\n");
+ printf(
+" The second section lists the segments. Segments are edges whose\n");
+ printf(
+" presence in a triangulation produced from the PSLG is enforced. Each\n");
+ printf(
+" segment is specified by listing the indices of its two endpoints. This\n"
+);
+ printf(
+" means that its endpoints must be included in the point list. Each\n");
+ printf(
+" segment, like each point, may have a boundary marker, which is ignored\n"
+);
+ printf(" by Show Me.\n\n");
+ printf(
+" The third section lists holes and concavities that are desired in any\n");
+ printf(
+" triangulation generated from the PSLG. Holes are specified by\n");
+ printf(" identifying a point inside each hole.\n\n");
+ printf(" .ele files:\n");
+ printf(
+" First line: <# of triangles> <points per triangle> <# of attributes>\n");
+ printf(
+" Remaining lines: <triangle #> <point> <point> <point> ... [attributes]\n"
+);
+ printf("\n");
+ printf(
+" Points are indices into the corresponding .node file. Show Me ignores\n"
+);
+ printf(
+" all but the first three points of each triangle; these should be the\n");
+ printf(
+" corners listed in counterclockwise order around the triangle. The\n");
+ printf(" attributes are ignored by Show Me.\n\n");
+ printf(" .edge files:\n");
+ printf(" First line: <# of edges> <# of boundary markers (0 or 1)>\n");
+ printf(
+" Following lines: <edge #> <endpoint> <endpoint> [boundary marker]\n");
+ printf("\n");
+ printf(
+" Endpoints are indices into the corresponding .node file. The boundary\n"
+);
+ printf(" markers are ignored by Show Me.\n\n");
+ printf(
+" In Voronoi diagrams, one also finds a special kind of edge that is an\n");
+ printf(
+" infinite ray with only one endpoint. For these edges, a different\n");
+ printf(" format is used:\n\n");
+ printf(" <edge #> <endpoint> -1 <direction x> <direction y>\n\n");
+ printf(
+" The `direction' is a floating-point vector that indicates the direction\n"
+);
+ printf(" of the infinite ray.\n\n");
+ printf(" .part files:\n");
+ printf(" First line: <# of triangles> <# of subdomains>\n");
+ printf(" Remaining lines: <triangle #> <subdomain #>\n\n");
+ printf(
+" The set of triangles is partitioned by a .part file; each triangle is\n");
+ printf(" mapped to a subdomain.\n\n");
+ printf(" .adj files:\n");
+ printf(" First line: <# of subdomains>\n");
+ printf(" Remaining lines: <adjacency matrix entry>\n\n");
+ printf(
+" An .adj file represents adjacencies between subdomains (presumably\n");
+ printf(" computed by a partitioner). The first line is followed by\n");
+ printf(
+" (subdomains X subdomains) lines, each containing one entry of the\n");
+ printf(
+" adjacency matrix. A nonzero entry indicates that two subdomains are\n");
+ printf(" adjacent (share a point).\n\n");
+ printf("Example:\n\n");
+ printf(
+" Here is a sample file `box.poly' describing a square with a square hole:\n"
+);
+ printf("\n");
+ printf(
+" # A box with eight points in 2D, no attributes, no boundary marker.\n");
+ printf(" 8 2 0 0\n");
+ printf(" # Outer box has these vertices:\n");
+ printf(" 1 0 0\n");
+ printf(" 2 0 3\n");
+ printf(" 3 3 0\n");
+ printf(" 4 3 3\n");
+ printf(" # Inner square has these vertices:\n");
+ printf(" 5 1 1\n");
+ printf(" 6 1 2\n");
+ printf(" 7 2 1\n");
+ printf(" 8 2 2\n");
+ printf(" # Five segments without boundary markers.\n");
+ printf(" 5 0\n");
+ printf(" 1 1 2 # Left side of outer box.\n");
+ printf(" 2 5 7 # Segments 2 through 5 enclose the hole.\n");
+ printf(" 3 7 8\n");
+ printf(" 4 8 6\n");
+ printf(" 5 6 5\n");
+ printf(" # One hole in the middle of the inner square.\n");
+ printf(" 1\n");
+ printf(" 1 1.5 1.5\n\n");
+ printf(
+" After this PSLG is triangulated by Triangle, the resulting triangulation\n"
+);
+ printf(
+" consists of a .node and .ele file. Here is the former, `box.1.node',\n");
+ printf(" which duplicates the points of the PSLG:\n\n");
+ printf(" 8 2 0 0\n");
+ printf(" 1 0 0\n");
+ printf(" 2 0 3\n");
+ printf(" 3 3 0\n");
+ printf(" 4 3 3\n");
+ printf(" 5 1 1\n");
+ printf(" 6 1 2\n");
+ printf(" 7 2 1\n");
+ printf(" 8 2 2\n");
+ printf(" # Generated by triangle -pcBev box\n");
+ printf("\n");
+ printf(" Here is the triangulation file, `box.1.ele'.\n");
+ printf("\n");
+ printf(" 8 3 0\n");
+ printf(" 1 1 5 6\n");
+ printf(" 2 5 1 3\n");
+ printf(" 3 2 6 8\n");
+ printf(" 4 6 2 1\n");
+ printf(" 5 7 3 4\n");
+ printf(" 6 3 7 5\n");
+ printf(" 7 8 4 2\n");
+ printf(" 8 4 8 7\n");
+ printf(" # Generated by triangle -pcBev box\n\n");
+ printf(" Here is the edge file for the triangulation, `box.1.edge'.\n\n");
+ printf(" 16 0\n");
+ printf(" 1 1 5\n");
+ printf(" 2 5 6\n");
+ printf(" 3 6 1\n");
+ printf(" 4 1 3\n");
+ printf(" 5 3 5\n");
+ printf(" 6 2 6\n");
+ printf(" 7 6 8\n");
+ printf(" 8 8 2\n");
+ printf(" 9 2 1\n");
+ printf(" 10 7 3\n");
+ printf(" 11 3 4\n");
+ printf(" 12 4 7\n");
+ printf(" 13 7 5\n");
+ printf(" 14 8 4\n");
+ printf(" 15 4 2\n");
+ printf(" 16 8 7\n");
+ printf(" # Generated by triangle -pcBev box\n");
+ printf("\n");
+ printf(
+" Here's a file `box.1.part' that partitions the mesh into four subdomains.\n"
+);
+ printf("\n");
+ printf(" 8 4\n");
+ printf(" 1 3\n");
+ printf(" 2 3\n");
+ printf(" 3 4\n");
+ printf(" 4 4\n");
+ printf(" 5 1\n");
+ printf(" 6 1\n");
+ printf(" 7 2\n");
+ printf(" 8 2\n");
+ printf(" # Generated by slice -s4 box.1\n\n");
+ printf(
+" Here's a file `box.1.adj' that represents the resulting adjacencies.\n");
+ printf("\n");
+ printf(" 4\n");
+ printf(" 9\n");
+ printf(" 2\n");
+ printf(" 2\n");
+ printf(" 0\n");
+ printf(" 2\n");
+ printf(" 9\n");
+ printf(" 0\n");
+ printf(" 2\n");
+ printf(" 2\n");
+ printf(" 0\n");
+ printf(" 9\n");
+ printf(" 2\n");
+ printf(" 0\n");
+ printf(" 2\n");
+ printf(" 2\n");
+ printf(" 9\n");
+ printf("\n");
+ printf("Display Speed:\n");
+ printf("\n");
+ printf(
+" It is worthwhile to note that .edge files typically plot and print twice\n"
+);
+ printf(
+" as quickly as .ele files, because .ele files cause each internal edge to\n"
+);
+ printf(
+" be drawn twice. For the same reason, PostScript files created from edge\n"
+);
+ printf(" sets are smaller than those created from triangulations.\n\n");
+ printf("Show Me on the Web:\n\n");
+ printf(
+" To see an illustrated, updated version of these instructions, check out\n");
+ printf("\n");
+ printf(" http://www.cs.cmu.edu/~quake/showme.html\n");
+ printf("\n");
+ printf("A Brief Plea:\n");
+ printf("\n");
+ printf(
+" If you use Show Me (or Triangle), and especially if you use it to\n");
+ printf(
+" accomplish real work, I would like very much to hear from you. A short\n");
+ printf(
+" letter or email (to jrs@cs.cmu.edu) describing how you use Show Me (and\n");
+ printf(
+" its sister programs) will mean a lot to me. The more people I know\n");
+ printf(
+" are using my programs, the more easily I can justify spending time on\n");
+ printf(
+" improvements, which in turn will benefit you. Also, I can put you\n");
+ printf(
+" on a list to receive email whenever new versions are available.\n");
+ printf("\n");
+ printf(
+" If you use a PostScript file generated by Show Me in a publication,\n");
+ printf(" please include an acknowledgment as well.\n\n");
+ exit(0);
+}
+
+void set_filenames(filename, lowermeshnumber)
+char *filename;
+int lowermeshnumber;
+{
+ char numberstring[100];
+ int i;
+
+ for (i = 0; i < 2; i++) {
+ strcpy(nodefilename[i], filename);
+ strcpy(polyfilename[i], filename);
+ strcpy(elefilename[i], filename);
+ strcpy(edgefilename[i], filename);
+ strcpy(partfilename[i], filename);
+ strcpy(adjfilename[i], filename);
+ strcpy(vnodefilename[i], filename);
+ strcpy(vedgefilename[i], filename);
+
+ if (lowermeshnumber + i > 0) {
+ sprintf(numberstring, ".%d", lowermeshnumber + i);
+ strcat(nodefilename[i], numberstring);
+ strcat(polyfilename[i], numberstring);
+ strcat(elefilename[i], numberstring);
+ strcat(edgefilename[i], numberstring);
+ strcat(partfilename[i], numberstring);
+ strcat(adjfilename[i], numberstring);
+ strcat(vnodefilename[i], numberstring);
+ strcat(vedgefilename[i], numberstring);
+ }
+
+ strcat(nodefilename[i], ".node");
+ strcat(polyfilename[i], ".poly");
+ strcat(elefilename[i], ".ele");
+ strcat(edgefilename[i], ".edge");
+ strcat(partfilename[i], ".part");
+ strcat(adjfilename[i], ".adj");
+ strcat(vnodefilename[i], ".v.node");
+ strcat(vedgefilename[i], ".v.edge");
+ }
+}
+
+#if 1 /* This function is already in netlib.lib, see triangle.c */
+void parsecommandline(int argc, char **argv);
+#else
+void parsecommandline(argc, argv)
+int argc;
+char **argv;
+{
+ int increment;
+ int meshnumber;
+ int i, j;
+
+ quiet = 0;
+ fillelem = 0;
+ line_width = 1;
+ bw_ps = 0;
+ start_image = ELE;
+ filename[0] = '\0';
+ for (i = 1; i < argc; i++) {
+ if (argv[i][0] == '-') {
+ for (j = 1; argv[i][j] != '\0'; j++) {
+ if (argv[i][j] == 'f') {
+ fillelem = 1;
+ }
+ if (argv[i][j] == 'w') {
+ if ((argv[i][j + 1] >= '1') && (argv[i][j + 1] <= '9')) {
+ line_width = 0;
+ while ((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) {
+ j++;
+ line_width = line_width * 10 + (int) (argv[i][j] - '0');
+ }
+ if (line_width > 100) {
+ printf("Error: Line width cannot exceed 100.\n");
+ line_width = 1;
+ }
+ }
+ }
+ if (argv[i][j] == 'b') {
+ bw_ps = 1;
+ }
+ if (argv[i][j] == 'Q') {
+ quiet = 1;
+ }
+ if ((argv[i][j] == 'h') || (argv[i][j] == 'H') ||
+ (argv[i][j] == '?')) {
+ info();
+ }
+ }
+ } else {
+ strcpy(filename, argv[i]);
+ }
+ }
+ if (filename[0] == '\0') {
+ syntax();
+ }
+ if (!strcmp(&filename[strlen(filename) - 5], ".node")) {
+ filename[strlen(filename) - 5] = '\0';
+ start_image = NODE;
+ }
+ if (!strcmp(&filename[strlen(filename) - 5], ".poly")) {
+ filename[strlen(filename) - 5] = '\0';
+ start_image = POLY;
+ }
+ if (!strcmp(&filename[strlen(filename) - 4], ".ele")) {
+ filename[strlen(filename) - 4] = '\0';
+ start_image = ELE;
+ }
+ if (!strcmp(&filename[strlen(filename) - 5], ".edge")) {
+ filename[strlen(filename) - 5] = '\0';
+ start_image = EDGE;
+ }
+ if (!strcmp(&filename[strlen(filename) - 5], ".part")) {
+ filename[strlen(filename) - 5] = '\0';
+ start_image = PART;
+ }
+ if (!strcmp(&filename[strlen(filename) - 4], ".adj")) {
+ filename[strlen(filename) - 4] = '\0';
+ start_image = ADJ;
+ }
+
+ increment = 0;
+ j = 1;
+ while (filename[j] != '\0') {
+ if ((filename[j] == '.') && (filename[j + 1] != '\0')) {
+ increment = j + 1;
+ }
+ j++;
+ }
+ meshnumber = 0;
+ if (increment > 0) {
+ j = increment;
+ do {
+ if ((filename[j] >= '0') && (filename[j] <= '9')) {
+ meshnumber = meshnumber * 10 + (int) (filename[j] - '0');
+ } else {
+ increment = 0;
+ }
+ j++;
+ } while (filename[j] != '\0');
+ }
+ if (increment > 0) {
+ filename[increment - 1] = '\0';
+ }
+
+ if (meshnumber == 0) {
+ start_inc = 0;
+ loweriteration = 0;
+ } else {
+ start_inc = 1;
+ loweriteration = meshnumber - 1;
+ }
+ set_filenames(filename, loweriteration);
+}
+#endif /* 0 */
+
+void free_inc(inc)
+int inc;
+{
+ if (loaded[inc][NODE]) {
+ free(nodeptr[inc]);
+ }
+ if (loaded[inc][POLY]) {
+ if (polynodes[inc] > 0) {
+ free(polynodeptr[inc]);
+ }
+ free(polyedgeptr[inc]);
+ free(polyholeptr[inc]);
+ }
+ if (loaded[inc][ELE]) {
+ free(eleptr[inc]);
+ }
+ if (loaded[inc][PART]) {
+ free(partpart[inc]);
+ free(partcenter[inc]);
+ free(partshift[inc]);
+ }
+ if (loaded[inc][EDGE]) {
+ free(edgeptr[inc]);
+ free(normptr[inc]);
+ }
+ if (loaded[inc][ADJ]) {
+ free(adjptr[inc]);
+ }
+ if (loaded[inc][VORO]) {
+ free(vnodeptr[inc]);
+ free(vedgeptr[inc]);
+ free(vnormptr[inc]);
+ }
+}
+
+void move_inc(inc)
+int inc;
+{
+ int i;
+
+ free_inc(1 - inc);
+ for (i = 0; i < IMAGE_TYPES; i++) {
+ loaded[1 - inc][i] = loaded[inc][i];
+ loaded[inc][i] = 0;
+ xlo[1 - inc][i] = xlo[inc][i];
+ ylo[1 - inc][i] = ylo[inc][i];
+ xhi[1 - inc][i] = xhi[inc][i];
+ yhi[1 - inc][i] = yhi[inc][i];
+ }
+ nodes[1 - inc] = nodes[inc];
+ node_dim[1 - inc] = node_dim[inc];
+ nodeptr[1 - inc] = nodeptr[inc];
+ polynodes[1 - inc] = polynodes[inc];
+ poly_dim[1 - inc] = poly_dim[inc];
+ polyedges[1 - inc] = polyedges[inc];
+ polyholes[1 - inc] = polyholes[inc];
+ polynodeptr[1 - inc] = polynodeptr[inc];
+ polyedgeptr[1 - inc] = polyedgeptr[inc];
+ polyholeptr[1 - inc] = polyholeptr[inc];
+ elems[1 - inc] = elems[inc];
+ ele_corners[1 - inc] = ele_corners[inc];
+ eleptr[1 - inc] = eleptr[inc];
+ edges[1 - inc] = edges[inc];
+ edgeptr[1 - inc] = edgeptr[inc];
+ normptr[1 - inc] = normptr[inc];
+ subdomains[1 - inc] = subdomains[inc];
+ partpart[1 - inc] = partpart[inc];
+ partcenter[1 - inc] = partcenter[inc];
+ partshift[1 - inc] = partshift[inc];
+ adjsubdomains[1 - inc] = adjsubdomains[inc];
+ adjptr[1 - inc] = adjptr[inc];
+ vnodes[1 - inc] = vnodes[inc];
+ vnode_dim[1 - inc] = vnode_dim[inc];
+ vnodeptr[1 - inc] = vnodeptr[inc];
+ vedges[1 - inc] = vedges[inc];
+ vedgeptr[1 - inc] = vedgeptr[inc];
+ vnormptr[1 - inc] = vnormptr[inc];
+ firstnumber[1 - inc] = firstnumber[inc];
+ firstnumber[inc] = -1;
+}
+
+void unload_inc(inc)
+int inc;
+{
+ int i;
+
+ current_image = NOTHING;
+ for (i = 0; i < IMAGE_TYPES; i++) {
+ loaded[inc][i] = 0;
+ firstnumber[inc] = -1;
+ }
+}
+
+void showme_init()
+{
+ current_image = NOTHING;
+ current_inc = 0;
+ explosion = STARTEXPLOSION;
+ unload_inc(0);
+ unload_inc(1);
+}
+
+char *readline(string, infile, infilename)
+char *string;
+FILE *infile;
+char *infilename;
+{
+ char *result;
+
+ do {
+ result = fgets(string, INPUTLINESIZE, infile);
+ if (result == (char *) NULL) {
+ printf(" Error: Unexpected end of file in %s.\n",
+ infilename);
+ exit(1);
+ }
+ while ((*result != '\0') && (*result != '#')
+ && (*result != '.') && (*result != '+') && (*result != '-')
+ && ((*result < '0') || (*result > '9'))) {
+ result++;
+ }
+ } while ((*result == '#') || (*result == '\0'));
+ return result;
+}
+
+char *findfield(string)
+char *string;
+{
+ char *result;
+
+ result = string;
+ while ((*result != '\0') && (*result != '#')
+ && (*result != ' ') && (*result != '\t')) {
+ result++;
+ }
+ while ((*result != '\0') && (*result != '#')
+ && (*result != '.') && (*result != '+') && (*result != '-')
+ && ((*result < '0') || (*result > '9'))) {
+ result++;
+ }
+ if (*result == '#') {
+ *result = '\0';
+ }
+ return result;
+}
+
+int load_node(fname, firstnumber, nodes, dim, ptr, xmin, ymin, xmax, ymax)
+char *fname;
+int *firstnumber;
+int *nodes;
+int *dim;
+REAL **ptr;
+REAL *xmin;
+REAL *ymin;
+REAL *xmax;
+REAL *ymax;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int extras;
+ int nodemarks;
+ int index;
+ int nodenumber;
+ int i, j;
+ int smallerr;
+ REAL x, y;
+
+ *xmin = *ymin = 0.0;
+ *xmax = *ymax = 1.0;
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *nodes = (int) strtol (stringptr, &stringptr, 0);
+ if (*nodes < 3) {
+ printf(" Error: %s contains %d points.\n", fname, *nodes);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ *dim = 2;
+ } else {
+ *dim = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (*dim < 1) {
+ printf(" Error: %s has dimensionality %d.\n", fname, *dim);
+ return 1;
+ }
+ if (*dim != 2) {
+ printf(" I only understand two-dimensional meshes.\n");
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ extras = 0;
+ } else {
+ extras = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (extras < 0) {
+ printf(" Error: %s has negative value for number of attributes.\n",
+ fname);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nodemarks = 0;
+ } else {
+ nodemarks = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (nodemarks < 0) {
+ printf(" Warning: %s has negative value for number of point markers.\n",
+ fname);
+ }
+ if (nodemarks > 1) {
+ printf(
+ " Warning: %s has value greater than one for number of point markers.\n",
+ fname);
+ }
+ *ptr = (REAL *) malloc((*nodes + 1) * *dim * sizeof(REAL));
+ if (*ptr == (REAL *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ index = *dim;
+ smallerr = 1;
+ for (i = 0; i < *nodes; i++) {
+ stringptr = readline(inputline, infile, fname);
+ nodenumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((i == 0) && (*firstnumber == -1)) {
+ if (nodenumber == 0) {
+ *firstnumber = 0;
+ } else {
+ *firstnumber = 1;
+ }
+ }
+ if ((nodenumber != *firstnumber + i) && (smallerr)) {
+ printf(" Warning: Points in %s are not numbered correctly\n", fname);
+ printf(" (starting with point %d).\n", *firstnumber + i);
+ smallerr = 0;
+ }
+ for (j = 0; j < *dim; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Point %d is missing a coordinate in %s.\n",
+ *firstnumber + i, fname);
+ free(*ptr);
+ return 1;
+ }
+ (*ptr)[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ }
+ fclose(infile);
+ index = *dim;
+ *xmin = *xmax = (*ptr)[index];
+ *ymin = *ymax = (*ptr)[index + 1];
+ for (i = 2; i <= *nodes; i++) {
+ index += *dim;
+ x = (*ptr)[index];
+ y = (*ptr)[index + 1];
+ if (x < *xmin) {
+ *xmin = x;
+ }
+ if (y < *ymin) {
+ *ymin = y;
+ }
+ if (x > *xmax) {
+ *xmax = x;
+ }
+ if (y > *ymax) {
+ *ymax = y;
+ }
+ }
+ if (*xmin == *xmax) {
+ *xmin -= 0.5;
+ *xmax += 0.5;
+ }
+ if (*ymin == *ymax) {
+ *ymin -= 0.5;
+ *ymax += 0.5;
+ }
+ return 0;
+}
+
+int load_poly(inc, fname, firstnumber, pnodes, dim, edges, holes, nodeptr,
+ edgeptr, holeptr, xmin, ymin, xmax, ymax)
+int inc;
+char *fname;
+int *firstnumber;
+int *pnodes;
+int *dim;
+int *edges;
+int *holes;
+REAL **nodeptr;
+int **edgeptr;
+REAL **holeptr;
+REAL *xmin;
+REAL *ymin;
+REAL *xmax;
+REAL *ymax;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int extras;
+ int nodemarks;
+ int segmentmarks;
+ int index;
+ int nodenumber, edgenumber, holenumber;
+ int maxnode;
+ int i, j;
+ int smallerr;
+ REAL x, y;
+
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *pnodes = (int) strtol (stringptr, &stringptr, 0);
+ if (*pnodes == 0) {
+ if (!loaded[inc][NODE]) {
+ if (load_image(inc, NODE)) {
+ return 1;
+ }
+ }
+ maxnode = nodes[inc];
+ *xmin = xlo[inc][NODE];
+ *ymin = ylo[inc][NODE];
+ *xmax = xhi[inc][NODE];
+ *ymax = yhi[inc][NODE];
+ } else {
+ if (*pnodes < 1) {
+ printf(" Error: %s contains %d points.\n", fname, *pnodes);
+ return 1;
+ }
+ maxnode = *pnodes;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ *dim = 2;
+ } else {
+ *dim = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (*dim < 1) {
+ printf(" Error: %s has dimensionality %d.\n", fname, *dim);
+ return 1;
+ }
+ if (*dim != 2) {
+ printf(" I only understand two-dimensional meshes.\n");
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ extras = 0;
+ } else {
+ extras = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (extras < 0) {
+ printf(" Error: %s has negative value for number of attributes.\n",
+ fname);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nodemarks = 0;
+ } else {
+ nodemarks = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (nodemarks < 0) {
+ printf(" Warning: %s has negative value for number of point markers.\n",
+ fname);
+ }
+ if (nodemarks > 1) {
+ printf(
+ " Warning: %s has value greater than one for number of point markers.\n",
+ fname);
+ }
+ if (*pnodes > 0) {
+ *nodeptr = (REAL *) malloc((*pnodes + 1) * *dim * sizeof(REAL));
+ if (*nodeptr == (REAL *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ index = *dim;
+ smallerr = 1;
+ for (i = 0; i < *pnodes; i++) {
+ stringptr = readline(inputline, infile, fname);
+ nodenumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((i == 0) && (*firstnumber == -1)) {
+ if (nodenumber == 0) {
+ *firstnumber = 0;
+ } else {
+ *firstnumber = 1;
+ }
+ }
+ if ((nodenumber != *firstnumber + i) && (smallerr)) {
+ printf(" Warning: Points in %s are not numbered correctly.\n",
+ fname);
+ printf(" (starting with point %d).\n", *firstnumber + i);
+ smallerr = 0;
+ }
+ for (j = 0; j < *dim; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Point %d is missing a coordinate in %s.\n",
+ *firstnumber + i, fname);
+ free(*nodeptr);
+ return 1;
+ }
+ (*nodeptr)[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ }
+ }
+ stringptr = readline(inputline, infile, fname);
+ *edges = (int) strtol (stringptr, &stringptr, 0);
+ if (*edges < 0) {
+ printf(" Error: %s contains %d segments.\n", fname, *edges);
+ free(*nodeptr);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ segmentmarks = 0;
+ } else {
+ segmentmarks = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (segmentmarks < 0) {
+ printf(" Error: %s has negative value for number of segment markers.\n",
+ fname);
+ free(*nodeptr);
+ return 1;
+ }
+ if (segmentmarks > 1) {
+ printf(
+ " Error: %s has value greater than one for number of segment markers.\n",
+ fname);
+ free(*nodeptr);
+ return 1;
+ }
+ *edgeptr = (int *) malloc(((*edges + 1) << 1) * sizeof(int));
+ if (*edgeptr == (int *) NULL) {
+ printf(" Out of memory.\n");
+ free(*nodeptr);
+ return 1;
+ }
+ index = 2;
+ smallerr = 1;
+ for (i = *firstnumber; i < *firstnumber + *edges; i++) {
+ stringptr = readline(inputline, infile, fname);
+ edgenumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((edgenumber != i) && (smallerr)) {
+ printf(" Warning: Segments in %s are not numbered correctly.\n",
+ fname);
+ printf(" (starting with segment %d).\n", i);
+ smallerr = 0;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d is missing its endpoints in %s.\n", i, fname);
+ free(*nodeptr);
+ free(*edgeptr);
+ return 1;
+ }
+ (*edgeptr)[index] = (int) strtol (stringptr, &stringptr, 0) + 1 -
+ *firstnumber;
+ if (((*edgeptr)[index] < 1) || ((*edgeptr)[index] > maxnode)) {
+ printf("Error: Segment %d has invalid endpoint in %s.\n", i, fname);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d is missing an endpoint in %s.\n", i, fname);
+ free(*nodeptr);
+ free(*edgeptr);
+ return 1;
+ }
+ (*edgeptr)[index + 1] = (int) strtol (stringptr, &stringptr, 0) + 1 -
+ *firstnumber;
+ if (((*edgeptr)[index + 1] < 1) || ((*edgeptr)[index + 1] > maxnode)) {
+ printf("Error: Segment %d has invalid endpoint in %s.\n", i, fname);
+ return 1;
+ }
+ index += 2;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *holes = (int) strtol (stringptr, &stringptr, 0);
+ if (*holes < 0) {
+ printf(" Error: %s contains %d holes.\n", fname, *holes);
+ free(*nodeptr);
+ free(*edgeptr);
+ return 1;
+ }
+ *holeptr = (REAL *) malloc((*holes + 1) * *dim * sizeof(REAL));
+ if (*holeptr == (REAL *) NULL) {
+ printf(" Out of memory.\n");
+ free(*nodeptr);
+ free(*edgeptr);
+ return 1;
+ }
+ index = *dim;
+ smallerr = 1;
+ for (i = *firstnumber; i < *firstnumber + *holes; i++) {
+ stringptr = readline(inputline, infile, fname);
+ holenumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((holenumber != i) && (smallerr)) {
+ printf(" Warning: Holes in %s are not numbered correctly.\n", fname);
+ printf(" (starting with hole %d).\n", i);
+ smallerr = 0;
+ }
+ for (j = 0; j < *dim; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Hole %d is missing a coordinate in %s.\n", i,
+ fname);
+ free(*nodeptr);
+ free(*edgeptr);
+ free(*holeptr);
+ return 1;
+ }
+ (*holeptr)[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ }
+ fclose(infile);
+ if (*pnodes > 0) {
+ index = *dim;
+ *xmin = *xmax = (*nodeptr)[index];
+ *ymin = *ymax = (*nodeptr)[index + 1];
+ for (i = 2; i <= *pnodes; i++) {
+ index += *dim;
+ x = (*nodeptr)[index];
+ y = (*nodeptr)[index + 1];
+ if (x < *xmin) {
+ *xmin = x;
+ }
+ if (y < *ymin) {
+ *ymin = y;
+ }
+ if (x > *xmax) {
+ *xmax = x;
+ }
+ if (y > *ymax) {
+ *ymax = y;
+ }
+ }
+ }
+ index = *dim;
+ for (i = 1; i <= *holes; i++) {
+ x = (*holeptr)[index];
+ y = (*holeptr)[index + 1];
+ if (x < *xmin) {
+ *xmin = x;
+ }
+ if (y < *ymin) {
+ *ymin = y;
+ }
+ if (x > *xmax) {
+ *xmax = x;
+ }
+ if (y > *ymax) {
+ *ymax = y;
+ }
+ index += *dim;
+ }
+ return 0;
+}
+
+int load_ele(fname, firstnumber, nodes, elems, corners, ptr)
+char *fname;
+int firstnumber;
+int nodes;
+int *elems;
+int *corners;
+int **ptr;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int extras;
+ int index;
+ int elemnumber;
+ int i, j;
+ int smallerr;
+
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *elems = (int) strtol (stringptr, &stringptr, 0);
+ if (*elems < 1) {
+ printf(" Error: %s contains %d triangles.\n", fname, *elems);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ *corners = 3;
+ } else {
+ *corners = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (*corners < 3) {
+ printf(" Error: Triangles in %s have only %d corners.\n", fname,
+ *corners);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ extras = 0;
+ } else {
+ extras = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (extras < 0) {
+ printf(" Error: %s has negative value for extra fields.\n", fname);
+ return 1;
+ }
+ *ptr = (int *) malloc((*elems + 1) * 3 * sizeof(int));
+ if (*ptr == (int *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ index = 3;
+ smallerr = 1;
+ for (i = firstnumber; i < firstnumber + *elems; i++) {
+ stringptr = readline(inputline, infile, fname);
+ elemnumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((elemnumber != i) && (smallerr)) {
+ printf(" Warning: Triangles in %s are not numbered correctly.\n",
+ fname);
+ printf(" (starting with triangle %d).\n", i);
+ smallerr = 0;
+ }
+ for (j = 0; j < 3; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Triangle %d is missing a corner in %s.\n", i, fname);
+ free(*ptr);
+ return 1;
+ }
+ (*ptr)[index] = (int) strtol (stringptr, &stringptr, 0) + 1 -
+ firstnumber;
+ if (((*ptr)[index] < 1) || ((*ptr)[index] > nodes)) {
+ printf("Error: Triangle %d has invalid corner in %s.\n", i, fname);
+ return 1;
+ }
+ index++;
+ }
+ }
+ fclose(infile);
+ return 0;
+}
+
+int load_edge(fname, firstnumber, nodes, edges, edgeptr, normptr)
+char *fname;
+int firstnumber;
+int nodes;
+int *edges;
+int **edgeptr;
+REAL **normptr;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int index;
+ int edgenumber;
+ int edgemarks;
+ int i;
+ int smallerr;
+
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *edges = (int) strtol (stringptr, &stringptr, 0);
+ if (*edges < 1) {
+ printf(" Error: %s contains %d edges.\n", fname, *edges);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ edgemarks = 0;
+ } else {
+ edgemarks = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (edgemarks < 0) {
+ printf(" Error: %s has negative value for number of edge markers.\n",
+ fname);
+ return 1;
+ }
+ if (edgemarks > 1) {
+ printf(
+ " Error: %s has value greater than one for number of edge markers.\n",
+ fname);
+ return 1;
+ }
+ *edgeptr = (int *) malloc(((*edges + 1) << 1) * sizeof(int));
+ if (*edgeptr == (int *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ *normptr = (REAL *) malloc(((*edges + 1) << 1) * sizeof(REAL));
+ if (*normptr == (REAL *) NULL) {
+ printf(" Out of memory.\n");
+ free(*edgeptr);
+ return 1;
+ }
+ index = 2;
+ smallerr = 1;
+ for (i = firstnumber; i < firstnumber + *edges; i++) {
+ stringptr = readline(inputline, infile, fname);
+ edgenumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((edgenumber != i) && (smallerr)) {
+ printf(" Warning: Edges in %s are not numbered correctly.\n", fname);
+ printf(" (starting with edge %d).\n", i);
+ smallerr = 0;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Edge %d is missing its endpoints in %s.\n", i, fname);
+ free(*edgeptr);
+ free(*normptr);
+ return 1;
+ }
+ (*edgeptr)[index] = (int) strtol (stringptr, &stringptr, 0) + 1 -
+ firstnumber;
+ if (((*edgeptr)[index] < 1) || ((*edgeptr)[index] > nodes)) {
+ printf("Error: Edge %d has invalid endpoint in %s.\n", i, fname);
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Edge %d is missing an endpoint in %s.\n", i, fname);
+ free(*edgeptr);
+ free(*normptr);
+ return 1;
+ }
+ (*edgeptr)[index + 1] = (int) strtol (stringptr, &stringptr, 0);
+ if ((*edgeptr)[index + 1] == -1) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Edge %d is missing its direction in %s.\n", i, fname);
+ free(*edgeptr);
+ free(*normptr);
+ return 1;
+ }
+ (*normptr)[index] = (REAL) strtod(stringptr, &stringptr);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Edge %d is missing a direction coordinate in %s.\n",
+ i, fname);
+ free(*edgeptr);
+ free(*normptr);
+ return 1;
+ }
+ (*normptr)[index + 1] = (REAL) strtod(stringptr, &stringptr);
+ } else {
+ (*edgeptr)[index + 1] += 1 - firstnumber;
+ if (((*edgeptr)[index + 1] < 1) || ((*edgeptr)[index + 1] > nodes)) {
+ printf("Error: Edge %d has invalid endpoint in %s.\n", i, fname);
+ return 1;
+ }
+ }
+ index += 2;
+ }
+ fclose(infile);
+ return 0;
+}
+
+int load_part(fname, dim, firstnumber, elems, nodeptr, eleptr, parts,
+ partition, partcenter, partshift)
+char *fname;
+int dim;
+int firstnumber;
+int elems;
+REAL *nodeptr;
+int *eleptr;
+int *parts;
+int **partition;
+REAL **partcenter;
+REAL **partshift;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int partelems;
+ int index;
+ int elemnumber;
+ int i, j;
+ int smallerr;
+ int *partsize;
+
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ partelems = (int) strtol (stringptr, &stringptr, 0);
+ if (partelems != elems) {
+ printf(
+ " Error: .ele and .part files do not agree on number of triangles.\n");
+ return 1;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ *parts = 1;
+ } else {
+ *parts = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (*parts < 1) {
+ printf(" Error: %s specifies %d subdomains.\n", fname, *parts);
+ return 1;
+ }
+ *partition = (int *) malloc((elems + 1) * sizeof(int));
+ if (*partition == (int *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ smallerr = 1;
+ for (i = firstnumber; i < firstnumber + partelems; i++) {
+ stringptr = readline(inputline, infile, fname);
+ elemnumber = (int) strtol (stringptr, &stringptr, 0);
+ if ((elemnumber != i) && (smallerr)) {
+ printf(" Warning: Triangles in %s are not numbered correctly.\n",
+ fname);
+ printf(" (starting with triangle %d).\n", i);
+ smallerr = 0;
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Triangle %d has no subdomain in %s.\n", i, fname);
+ free(*partition);
+ return 1;
+ }
+ (*partition)[i] = (int) strtol (stringptr, &stringptr, 0) - firstnumber;
+ if (((*partition)[i] >= *parts) || ((*partition)[i] < 0)) {
+ printf(" Error: Triangle %d of %s has an invalid subdomain.\n",
+ i, fname);
+ free(*partition);
+ return 1;
+ }
+ }
+ fclose(infile);
+ *partcenter = (REAL *) malloc(((*parts + 1) << 1) * sizeof(REAL));
+ if (*partcenter == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ free(*partition);
+ return 1;
+ }
+ *partshift = (REAL *) malloc((*parts << 1) * sizeof(REAL));
+ if (*partshift == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ free(*partition);
+ free(*partcenter);
+ return 1;
+ }
+ partsize = (int *) malloc((*parts + 1) * sizeof(int));
+ if (partsize == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ free(*partition);
+ free(*partcenter);
+ free(*partshift);
+ return 1;
+ }
+ index = 3;
+ for (i = 0; i <= *parts; i++) {
+ partsize[i] = 0;
+ (*partcenter)[i << 1] = 0.0;
+ (*partcenter)[(i << 1) + 1] = 0.0;
+ }
+ for (i = 1; i <= elems; i++) {
+ partsize[(*partition)[i]] += 3;
+ for (j = 0; j < 3; j++) {
+ (*partcenter)[(*partition)[i] << 1] +=
+ nodeptr[eleptr[index] * dim];
+ (*partcenter)[((*partition)[i] << 1) + 1] +=
+ nodeptr[eleptr[index++] * dim + 1];
+ }
+ }
+ for (i = 0; i < *parts; i++) {
+ (*partcenter)[i << 1] /= (REAL) partsize[i];
+ (*partcenter)[(i << 1) + 1] /= (REAL) partsize[i];
+ (*partcenter)[*parts << 1] += (*partcenter)[i << 1];
+ (*partcenter)[(*parts << 1) + 1] += (*partcenter)[(i << 1) + 1];
+ }
+ (*partcenter)[*parts << 1] /= (REAL) *parts;
+ (*partcenter)[(*parts << 1) + 1] /= (REAL) *parts;
+ free(partsize);
+ return 0;
+}
+
+int load_adj(fname, subdomains, ptr)
+char *fname;
+int *subdomains;
+int **ptr;
+{
+ FILE *infile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int i, j;
+
+ if (!quiet) {
+ printf("Opening %s.\n", fname);
+ }
+ infile = fopen(fname, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", fname);
+ return 1;
+ }
+ stringptr = readline(inputline, infile, fname);
+ *subdomains = (int) strtol (stringptr, &stringptr, 0);
+ if (*subdomains < 1) {
+ printf(" Error: %s contains %d subdomains.\n", fname, *subdomains);
+ return 1;
+ }
+ *ptr = (int *) malloc(*subdomains * *subdomains * sizeof(int));
+ if (*ptr == (int *) NULL) {
+ printf(" Out of memory.\n");
+ return 1;
+ }
+ for (i = 0; i < *subdomains; i++) {
+ for (j = 0; j < *subdomains; j++) {
+ stringptr = readline(inputline, infile, fname);
+ (*ptr)[i * *subdomains + j] = (int) strtol (stringptr, &stringptr, 0);
+ }
+ }
+ return 0;
+}
+
+void findpartshift(parts, explosion, partcenter, partshift)
+int parts;
+REAL explosion;
+REAL *partcenter;
+REAL *partshift;
+{
+ int i;
+
+ for (i = 0; i < parts; i++) {
+ partshift[i << 1] = explosion *
+ (partcenter[i << 1] - partcenter[parts << 1]);
+ partshift[(i << 1) + 1] = explosion *
+ (partcenter[(i << 1) + 1] - partcenter[(parts << 1) + 1]);
+ }
+}
+
+int load_image(inc, image)
+int inc;
+int image;
+{
+ int error;
+
+ switch (image) {
+ case NODE:
+ error = load_node(nodefilename[inc], &firstnumber[inc], &nodes[inc],
+ &node_dim[inc], &nodeptr[inc], &xlo[inc][NODE],
+ &ylo[inc][NODE], &xhi[inc][NODE], &yhi[inc][NODE]);
+ break;
+ case POLY:
+ error = load_poly(inc, polyfilename[inc], &firstnumber[inc],
+ &polynodes[inc], &poly_dim[inc], &polyedges[inc],
+ &polyholes[inc], &polynodeptr[inc], &polyedgeptr[inc],
+ &polyholeptr[inc],
+ &xlo[inc][POLY], &ylo[inc][POLY],
+ &xhi[inc][POLY], &yhi[inc][POLY]);
+ break;
+ case ELE:
+ error = load_ele(elefilename[inc], firstnumber[inc], nodes[inc],
+ &elems[inc], &ele_corners[inc], &eleptr[inc]);
+ xlo[inc][ELE] = xlo[inc][NODE];
+ ylo[inc][ELE] = ylo[inc][NODE];
+ xhi[inc][ELE] = xhi[inc][NODE];
+ yhi[inc][ELE] = yhi[inc][NODE];
+ break;
+ case EDGE:
+ error = load_edge(edgefilename[inc], firstnumber[inc], nodes[inc],
+ &edges[inc], &edgeptr[inc], &normptr[inc]);
+ xlo[inc][EDGE] = xlo[inc][NODE];
+ ylo[inc][EDGE] = ylo[inc][NODE];
+ xhi[inc][EDGE] = xhi[inc][NODE];
+ yhi[inc][EDGE] = yhi[inc][NODE];
+ break;
+ case PART:
+ error = load_part(partfilename[inc], node_dim[inc], firstnumber[inc],
+ elems[inc], nodeptr[inc], eleptr[inc],
+ &subdomains[inc], &partpart[inc], &partcenter[inc],
+ &partshift[inc]);
+ if (!error) {
+ findpartshift(subdomains[inc], explosion, partcenter[inc],
+ partshift[inc]);
+ }
+ xlo[inc][PART] = xlo[inc][NODE];
+ ylo[inc][PART] = ylo[inc][NODE];
+ xhi[inc][PART] = xhi[inc][NODE];
+ yhi[inc][PART] = yhi[inc][NODE];
+ break;
+ case ADJ:
+ error = load_adj(adjfilename[inc], &adjsubdomains[inc], &adjptr[inc]);
+ xlo[inc][ADJ] = xlo[inc][NODE];
+ ylo[inc][ADJ] = ylo[inc][NODE];
+ xhi[inc][ADJ] = xhi[inc][NODE];
+ yhi[inc][ADJ] = yhi[inc][NODE];
+ break;
+ case VORO:
+ error = load_node(vnodefilename[inc], &firstnumber[inc], &vnodes[inc],
+ &vnode_dim[inc], &vnodeptr[inc], &xlo[inc][VORO],
+ &ylo[inc][VORO], &xhi[inc][VORO], &yhi[inc][VORO]);
+ if (!error) {
+ error = load_edge(vedgefilename[inc], firstnumber[inc], vnodes[inc],
+ &vedges[inc], &vedgeptr[inc], &vnormptr[inc]);
+ }
+ break;
+ default:
+ error = 1;
+ }
+ if (!error) {
+ loaded[inc][image] = 1;
+ }
+ return error;
+}
+
+void choose_image(inc, image)
+int inc;
+int image;
+{
+ if (!loaded[inc][image]) {
+ if ((image == ELE) || (image == EDGE) || (image == PART)
+ || (image == ADJ)) {
+ if (!loaded[inc][NODE]) {
+ if (load_image(inc, NODE)) {
+ return;
+ }
+ }
+ }
+ if ((image == PART) || (image == ADJ)) {
+ if (!loaded[inc][ELE]) {
+ if (load_image(inc, ELE)) {
+ return;
+ }
+ }
+ }
+ if (image == ADJ) {
+ if (!loaded[inc][PART]) {
+ if (load_image(inc, PART)) {
+ return;
+ }
+ }
+ }
+ if (load_image(inc, image)) {
+ return;
+ }
+ }
+ current_inc = inc;
+ current_image = image;
+}
+
+Window make_button(name, x, y, width)
+char *name;
+int x;
+int y;
+int width;
+{
+ XSetWindowAttributes attr;
+ XSizeHints hints;
+ Window button;
+
+ attr.background_pixel = black;
+ attr.border_pixel = white;
+ attr.backing_store = NotUseful;
+ attr.event_mask = ExposureMask | ButtonReleaseMask | ButtonPressMask;
+ attr.bit_gravity = SouthWestGravity;
+ attr.win_gravity = SouthWestGravity;
+ attr.save_under = False;
+ button = XCreateWindow(display, mainwindow, x, y, width, BUTTONHEIGHT - 4,
+ 2, 0, InputOutput, CopyFromParent,
+ CWBackPixel | CWBorderPixel | CWEventMask |
+ CWBitGravity | CWWinGravity | CWBackingStore |
+ CWSaveUnder, &attr);
+ hints.width = width;
+ hints.height = BUTTONHEIGHT - 4;
+ hints.min_width = 0;
+ hints.min_height = BUTTONHEIGHT - 4;
+ hints.max_width = width;
+ hints.max_height = BUTTONHEIGHT - 4;
+ hints.width_inc = 1;
+ hints.height_inc = 1;
+ hints.flags = PMinSize | PMaxSize | PSize | PResizeInc;
+ XSetStandardProperties(display, button, name, "showme", None, (char **) NULL,
+ 0, &hints);
+ return button;
+}
+
+void make_buttons(y)
+int y;
+{
+ int i;
+
+ for (i = 1; i >= 0; i--) {
+ nodewin[i] = make_button("node", 0, y + (1 - i) * BUTTONHEIGHT, 42);
+ XMapWindow(display, nodewin[i]);
+ polywin[i] = make_button("poly", 44, y + (1 - i) * BUTTONHEIGHT, 42);
+ XMapWindow(display, polywin[i]);
+ elewin[i] = make_button("ele", 88, y + (1 - i) * BUTTONHEIGHT, 33);
+ XMapWindow(display, elewin[i]);
+ edgewin[i] = make_button("edge", 123, y + (1 - i) * BUTTONHEIGHT, 42);
+ XMapWindow(display, edgewin[i]);
+ partwin[i] = make_button("part", 167, y + (1 - i) * BUTTONHEIGHT, 42);
+ XMapWindow(display, partwin[i]);
+ adjwin[i] = make_button("adj", 211, y + (1 - i) * BUTTONHEIGHT, 33);
+ XMapWindow(display, adjwin[i]);
+ voronoiwin[i] = make_button("voro", 246, y + (1 - i) * BUTTONHEIGHT, 42);
+ XMapWindow(display, voronoiwin[i]);
+ }
+ versionpluswin = make_button(" +", 290, y, 52);
+ XMapWindow(display, versionpluswin);
+ versionminuswin = make_button(" -", 290, y + BUTTONHEIGHT, 52);
+ XMapWindow(display, versionminuswin);
+
+ quitwin = make_button("Quit", 0, y + 2 * BUTTONHEIGHT, 42);
+ XMapWindow(display, quitwin);
+ leftwin = make_button("<", 44, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, leftwin);
+ rightwin = make_button(">", 60, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, rightwin);
+ upwin = make_button("^", 76, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, upwin);
+ downwin = make_button("v", 92, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, downwin);
+ resetwin = make_button("Reset", 108, y + 2 * BUTTONHEIGHT, 52);
+ XMapWindow(display, resetwin);
+ widthpluswin = make_button("Width+", 162, y + 2 * BUTTONHEIGHT, 61);
+ XMapWindow(display, widthpluswin);
+ widthminuswin = make_button("-", 225, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, widthminuswin);
+ expwin = make_button("Exp", 241, y + 2 * BUTTONHEIGHT, 33);
+ XMapWindow(display, expwin);
+ exppluswin = make_button("+", 276, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, exppluswin);
+ expminuswin = make_button("-", 292, y + 2 * BUTTONHEIGHT, 14);
+ XMapWindow(display, expminuswin);
+ fillwin = make_button("Fill", 308, y + 2 * BUTTONHEIGHT, 41);
+ XMapWindow(display, fillwin);
+ pswin = make_button("PS", 351, y + 2 * BUTTONHEIGHT, 24);
+ XMapWindow(display, pswin);
+ epswin = make_button("EPS", 377, y + 2 * BUTTONHEIGHT, 33);
+ XMapWindow(display, epswin);
+}
+
+void fill_button(button)
+Window button;
+{
+ int x, y;
+ unsigned int w, h, d, b;
+ Window rootw;
+
+ XGetGeometry(display, button, &rootw, &x, &y, &w, &h, &d, &b);
+ XFillRectangle(display, button, fontgc, 0, 0, w, h);
+}
+
+void draw_buttons()
+{
+ char numberstring[32];
+ char buttonstring[6];
+ int i;
+
+ for (i = 1; i >= 0; i--) {
+ if ((current_image == NODE) && (current_inc == i)) {
+ fill_button(nodewin[i]);
+ XDrawString(display, nodewin[i], blackfontgc, 2, 13, "node", 4);
+ } else {
+ XClearWindow(display, nodewin[i]);
+ XDrawString(display, nodewin[i], fontgc, 2, 13, "node", 4);
+ }
+ if ((current_image == POLY) && (current_inc == i)) {
+ fill_button(polywin[i]);
+ XDrawString(display, polywin[i], blackfontgc, 2, 13, "poly", 4);
+ } else {
+ XClearWindow(display, polywin[i]);
+ XDrawString(display, polywin[i], fontgc, 2, 13, "poly", 4);
+ }
+ if ((current_image == ELE) && (current_inc == i)) {
+ fill_button(elewin[i]);
+ XDrawString(display, elewin[i], blackfontgc, 2, 13, "ele", 3);
+ } else {
+ XClearWindow(display, elewin[i]);
+ XDrawString(display, elewin[i], fontgc, 2, 13, "ele", 3);
+ }
+ if ((current_image == EDGE) && (current_inc == i)) {
+ fill_button(edgewin[i]);
+ XDrawString(display, edgewin[i], blackfontgc, 2, 13, "edge", 4);
+ } else {
+ XClearWindow(display, edgewin[i]);
+ XDrawString(display, edgewin[i], fontgc, 2, 13, "edge", 4);
+ }
+ if ((current_image == PART) && (current_inc == i)) {
+ fill_button(partwin[i]);
+ XDrawString(display, partwin[i], blackfontgc, 2, 13, "part", 4);
+ } else {
+ XClearWindow(display, partwin[i]);
+ XDrawString(display, partwin[i], fontgc, 2, 13, "part", 4);
+ }
+ if ((current_image == ADJ) && (current_inc == i)) {
+ fill_button(adjwin[i]);
+ XDrawString(display, adjwin[i], blackfontgc, 2, 13, "adj", 3);
+ } else {
+ XClearWindow(display, adjwin[i]);
+ XDrawString(display, adjwin[i], fontgc, 2, 13, "adj", 3);
+ }
+ if ((current_image == VORO) && (current_inc == i)) {
+ fill_button(voronoiwin[i]);
+ XDrawString(display, voronoiwin[i], blackfontgc, 2, 13, "voro", 4);
+ } else {
+ XClearWindow(display, voronoiwin[i]);
+ XDrawString(display, voronoiwin[i], fontgc, 2, 13, "voro", 4);
+ }
+ }
+
+ XClearWindow(display, versionpluswin);
+ sprintf(numberstring, "%d", loweriteration + 1);
+ sprintf(buttonstring, "%-4.4s+", numberstring);
+ XDrawString(display, versionpluswin, fontgc, 2, 13, buttonstring, 5);
+ XClearWindow(display, versionminuswin);
+ sprintf(numberstring, "%d", loweriteration);
+ if (loweriteration == 0) {
+ sprintf(buttonstring, "%-4.4s", numberstring);
+ } else {
+ sprintf(buttonstring, "%-4.4s-", numberstring);
+ }
+ XDrawString(display, versionminuswin, fontgc, 2, 13, buttonstring, 5);
+
+ XClearWindow(display, quitwin);
+ XDrawString(display, quitwin, fontgc, 2, 13, "Quit", 4);
+ XClearWindow(display, leftwin);
+ XDrawString(display, leftwin, fontgc, 2, 13, "<", 1);
+ XClearWindow(display, rightwin);
+ XDrawString(display, rightwin, fontgc, 2, 13, ">", 1);
+ XClearWindow(display, upwin);
+ XDrawString(display, upwin, fontgc, 2, 13, "^", 1);
+ XClearWindow(display, downwin);
+ XDrawString(display, downwin, fontgc, 2, 13, "v", 1);
+ XClearWindow(display, resetwin);
+ XDrawString(display, resetwin, fontgc, 2, 13, "Reset", 6);
+ XClearWindow(display, widthpluswin);
+ if (line_width < 100) {
+ XDrawString(display, widthpluswin, fontgc, 2, 13, "Width+", 6);
+ } else {
+ XDrawString(display, widthpluswin, fontgc, 2, 13, "Width ", 6);
+ }
+ XClearWindow(display, widthminuswin);
+ if (line_width > 1) {
+ XDrawString(display, widthminuswin, fontgc, 2, 13, "-", 1);
+ }
+ XClearWindow(display, expwin);
+ XClearWindow(display, exppluswin);
+ XClearWindow(display, expminuswin);
+ XClearWindow(display, fillwin);
+ if (current_image == PART) {
+ if (explode) {
+ fill_button(expwin);
+ XDrawString(display, expwin, blackfontgc, 2, 13, "Exp", 3);
+ } else {
+ XDrawString(display, expwin, fontgc, 2, 13, "Exp", 3);
+ }
+ XDrawString(display, exppluswin, fontgc, 2, 13, "+", 1);
+ XDrawString(display, expminuswin, fontgc, 2, 13, "-", 1);
+ if (fillelem) {
+ fill_button(fillwin);
+ XDrawString(display, fillwin, blackfontgc, 2, 13, "Fill", 4);
+ } else {
+ XDrawString(display, fillwin, fontgc, 2, 13, "Fill", 4);
+ }
+ }
+ XClearWindow(display, pswin);
+ XDrawString(display, pswin, fontgc, 2, 13, "PS", 2);
+ XClearWindow(display, epswin);
+ XDrawString(display, epswin, fontgc, 2, 13, "EPS", 3);
+}
+
+void showme_window(argc, argv)
+int argc;
+char **argv;
+{
+ XSetWindowAttributes attr;
+ XSizeHints hints;
+ XGCValues fontvalues, linevalues;
+ XColor alloc_color, exact_color;
+ int i;
+
+ display = XOpenDisplay((char *) NULL);
+ if (!display) {
+ printf("Error: Cannot open display.\n");
+ exit(1);
+ }
+ screen = DefaultScreen(display);
+ rootwindow = DefaultRootWindow(display);
+ black = BlackPixel(display, screen);
+ white = WhitePixel(display, screen);
+ windowdepth = DefaultDepth(display, screen);
+ rootmap = DefaultColormap(display, screen);
+ width = STARTWIDTH;
+ height = STARTHEIGHT;
+ attr.background_pixel = black;
+ attr.border_pixel = white;
+ attr.backing_store = NotUseful;
+ attr.event_mask = ExposureMask | ButtonReleaseMask | ButtonPressMask |
+ StructureNotifyMask;
+ attr.bit_gravity = NorthWestGravity;
+ attr.win_gravity = NorthWestGravity;
+ attr.save_under = False;
+ mainwindow = XCreateWindow(display, rootwindow, 0, 0, width,
+ height + PANELHEIGHT, 3, 0,
+ InputOutput, CopyFromParent,
+ CWBackPixel | CWBorderPixel | CWEventMask |
+ CWBitGravity | CWWinGravity | CWBackingStore |
+ CWSaveUnder, &attr);
+ hints.width = width;
+ hints.height = height + PANELHEIGHT;
+ hints.min_width = MINWIDTH;
+ hints.min_height = MINHEIGHT + PANELHEIGHT;
+ hints.width_inc = 1;
+ hints.height_inc = 1;
+ hints.flags = PMinSize | PSize | PResizeInc;
+ XSetStandardProperties(display, mainwindow, "Show Me", "showme", None,
+ argv, argc, &hints);
+ XChangeProperty(display, mainwindow, XA_WM_CLASS, XA_STRING, 8,
+ PropModeReplace, "showme\0Archimedes", 18);
+ XClearWindow(display, mainwindow);
+ XMapWindow(display, mainwindow);
+ if ((windowdepth > 1) &&
+ XAllocNamedColor(display, rootmap, "yellow", &alloc_color,
+ &exact_color)) {
+ color = 1;
+ explode = bw_ps;
+ fontvalues.foreground = alloc_color.pixel;
+ linevalues.foreground = alloc_color.pixel;
+ showme_foreground = alloc_color.pixel;
+ for (i = 0; i < 64; i++) {
+ if (XAllocNamedColor(display, rootmap, colorname[i], &alloc_color,
+ &rgb[i])) {
+ colors[i] = alloc_color.pixel;
+ } else {
+ colors[i] = white;
+ rgb[i].red = alloc_color.red;
+ rgb[i].green = alloc_color.green;
+ rgb[i].blue = alloc_color.blue;
+ if (!quiet) {
+ printf("Warning: I could not allocate %s.\n", colorname[i]);
+ }
+ }
+ }
+ } else {
+ color = 0;
+ fillelem = 0;
+ explode = 1;
+ fontvalues.foreground = white;
+ linevalues.foreground = white;
+ showme_foreground = white;
+ }
+ font = XLoadQueryFont(display, "9x15");
+ fontvalues.background = black;
+ fontvalues.font = font->fid;
+ fontvalues.fill_style = FillSolid;
+ fontvalues.line_width = 2;
+ fontgc = XCreateGC(display, rootwindow, GCForeground | GCBackground |
+ GCFont | GCLineWidth | GCFillStyle, &fontvalues);
+ fontvalues.foreground = black;
+ blackfontgc = XCreateGC(display, rootwindow, GCForeground | GCBackground |
+ GCFont | GCLineWidth | GCFillStyle, &fontvalues);
+ linevalues.background = black;
+ linevalues.line_width = line_width;
+ linevalues.cap_style = CapRound;
+ linevalues.join_style = JoinRound;
+ linevalues.fill_style = FillSolid;
+ linegc = XCreateGC(display, rootwindow, GCForeground | GCBackground |
+ GCLineWidth | GCCapStyle | GCJoinStyle | GCFillStyle,
+ &linevalues);
+ trianglegc = XCreateGC(display, rootwindow, GCForeground | GCBackground |
+ GCLineWidth | GCCapStyle | GCJoinStyle | GCFillStyle,
+ &linevalues);
+ make_buttons(height);
+ XFlush(display);
+}
+
+void draw_node(nodes, dim, ptr, xscale, yscale, xoffset, yoffset)
+int nodes;
+int dim;
+REAL *ptr;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i;
+ int index;
+
+ index = dim;
+ for (i = 1; i <= nodes; i++) {
+ XFillRectangle(display, mainwindow, linegc,
+ (int) (ptr[index] * xscale + xoffset) - (line_width >> 1),
+ (int) (ptr[index + 1] * yscale + yoffset) -
+ (line_width >> 1), line_width, line_width);
+ index += dim;
+ }
+}
+
+void draw_poly(nodes, dim, edges, holes, nodeptr, edgeptr, holeptr,
+ xscale, yscale, xoffset, yoffset)
+int nodes;
+int dim;
+int edges;
+int holes;
+REAL *nodeptr;
+int *edgeptr;
+REAL *holeptr;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i;
+ int index;
+ REAL *point1, *point2;
+ int x1, y1, x2, y2;
+
+ index = dim;
+ for (i = 1; i <= nodes; i++) {
+ XFillRectangle(display, mainwindow, linegc,
+ (int) (nodeptr[index] * xscale + xoffset) -
+ (line_width >> 1),
+ (int) (nodeptr[index + 1] * yscale + yoffset) -
+ (line_width >> 1), line_width, line_width);
+ index += dim;
+ }
+ index = 2;
+ for (i = 1; i <= edges; i++) {
+ point1 = &nodeptr[edgeptr[index++] * dim];
+ point2 = &nodeptr[edgeptr[index++] * dim];
+ XDrawLine(display, mainwindow, linegc,
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+ index = dim;
+ if (color) {
+ XSetForeground(display, linegc, colors[0]);
+ }
+ for (i = 1; i <= holes; i++) {
+ x1 = (int) (holeptr[index] * xscale + xoffset) - 3;
+ y1 = (int) (holeptr[index + 1] * yscale + yoffset) - 3;
+ x2 = x1 + 6;
+ y2 = y1 + 6;
+ XDrawLine(display, mainwindow, linegc, x1, y1, x2, y2);
+ XDrawLine(display, mainwindow, linegc, x1, y2, x2, y1);
+ index += dim;
+ }
+ XSetForeground(display, linegc, showme_foreground);
+}
+
+void draw_ele(inc, elems, corners, ptr, partition, shift,
+ xscale, yscale, xoffset, yoffset)
+int inc;
+int elems;
+int corners; /* unused */
+int *ptr;
+int *partition;
+REAL *shift;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i, j;
+ int index;
+ REAL shiftx = 0.0, shifty = 0.0;
+ REAL *prevpoint, *nowpoint;
+ XPoint *vertices = (XPoint *) NULL;
+
+ if (color && fillelem && (partition != (int *) NULL)) {
+ vertices = (XPoint *) malloc(3 * sizeof(XPoint));
+ if (vertices == (XPoint *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ index = 3;
+ for (i = 1; i <= elems; i++) {
+ if ((partition != (int *) NULL) && explode) {
+ shiftx = shift[partition[i] << 1];
+ shifty = shift[(partition[i] << 1) + 1];
+ }
+ if (color && (partition != (int *) NULL)) {
+ if (fillelem) {
+ XSetForeground(display, trianglegc, colors[partition[i] & 63]);
+ } else {
+ XSetForeground(display, linegc, colors[partition[i] & 63]);
+ }
+ }
+ if (color && fillelem && (partition != (int *) NULL)) {
+ if ((partition != (int *) NULL) && explode) {
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[inc][ptr[index + j] * node_dim[inc]];
+ vertices[j].x = (nowpoint[0] + shiftx) * xscale + xoffset;
+ vertices[j].y = (nowpoint[1] + shifty) * yscale + yoffset;
+ }
+ } else {
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[inc][ptr[index + j] * node_dim[inc]];
+ vertices[j].x = nowpoint[0] * xscale + xoffset;
+ vertices[j].y = nowpoint[1] * yscale + yoffset;
+ }
+ }
+ XFillPolygon(display, mainwindow, trianglegc, vertices, 3,
+ Convex, CoordModeOrigin);
+ }
+ prevpoint = &nodeptr[inc][ptr[index + 2] * node_dim[inc]];
+ if ((partition != (int *) NULL) && explode) {
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[inc][ptr[index++] * node_dim[inc]];
+ XDrawLine(display, mainwindow, linegc,
+ (int) ((prevpoint[0] + shiftx) * xscale + xoffset),
+ (int) ((prevpoint[1] + shifty) * yscale + yoffset),
+ (int) ((nowpoint[0] + shiftx) * xscale + xoffset),
+ (int) ((nowpoint[1] + shifty) * yscale + yoffset));
+ prevpoint = nowpoint;
+ }
+ } else {
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[inc][ptr[index++] * node_dim[inc]];
+ XDrawLine(display, mainwindow, linegc,
+ (int) (prevpoint[0] * xscale + xoffset),
+ (int) (prevpoint[1] * yscale + yoffset),
+ (int) (nowpoint[0] * xscale + xoffset),
+ (int) (nowpoint[1] * yscale + yoffset));
+ prevpoint = nowpoint;
+ }
+ }
+ }
+ if (color && fillelem && (partition != (int *) NULL)) {
+ free(vertices);
+ }
+ XSetForeground(display, linegc, showme_foreground);
+}
+
+void draw_edge(nodes, dim, edges, nodeptr, edgeptr, normptr,
+ xscale, yscale, xoffset, yoffset)
+int nodes; /* unused */
+int dim;
+int edges;
+REAL *nodeptr;
+int *edgeptr;
+REAL *normptr;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i;
+ int index;
+ REAL *point1, *point2;
+ REAL normx, normy;
+ REAL normmult, normmultx, normmulty;
+ REAL windowxmin, windowymin, windowxmax, windowymax;
+
+ index = 2;
+ for (i = 1; i <= edges; i++) {
+ point1 = &nodeptr[edgeptr[index++] * dim];
+ if (edgeptr[index] == -1) {
+ normx = normptr[index - 1];
+ normy = normptr[index++];
+ normmultx = 0.0;
+ if (normx > 0) {
+ windowxmax = (width - 1 - xoffset) / xscale;
+ normmultx = (windowxmax - point1[0]) / normx;
+ } else if (normx < 0) {
+ windowxmin = -xoffset / xscale;
+ normmultx = (windowxmin - point1[0]) / normx;
+ }
+ normmulty = 0.0;
+ if (normy > 0) {
+ windowymax = -yoffset / yscale;
+ normmulty = (windowymax - point1[1]) / normy;
+ } else if (normy < 0) {
+ windowymin = (height - 1 - yoffset) / yscale;
+ normmulty = (windowymin - point1[1]) / normy;
+ }
+ if (normmultx == 0.0) {
+ normmult = normmulty;
+ } else if (normmulty == 0.0) {
+ normmult = normmultx;
+ } else if (normmultx < normmulty) {
+ normmult = normmultx;
+ } else {
+ normmult = normmulty;
+ }
+ if (normmult > 0.0) {
+ XDrawLine(display, mainwindow, linegc,
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ (int) ((point1[0] + normmult * normx) * xscale + xoffset),
+ (int) ((point1[1] + normmult * normy) * yscale + yoffset));
+ }
+ } else {
+ point2 = &nodeptr[edgeptr[index++] * dim];
+ XDrawLine(display, mainwindow, linegc,
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+ }
+}
+
+void draw_adj(dim, subdomains, ptr, center, xscale, yscale,
+ xoffset, yoffset)
+int dim;
+int subdomains;
+int *ptr;
+REAL *center;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i, j;
+ REAL *point1, *point2;
+
+ for (i = 0; i < subdomains; i++) {
+ for (j = i + 1; j < subdomains; j++) {
+ if (ptr[i * subdomains + j]) {
+ point1 = ¢er[i * dim];
+ point2 = ¢er[j * dim];
+ XDrawLine(display, mainwindow, linegc,
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+ }
+ }
+ for (i = 0; i < subdomains; i++) {
+ point1 = ¢er[i * dim];
+ if (color) {
+ XSetForeground(display, linegc, colors[i & 63]);
+ }
+ XFillArc(display, mainwindow, linegc,
+ (int) (point1[0] * xscale + xoffset) - 5 - (line_width >> 1),
+ (int) (point1[1] * yscale + yoffset) - 5 - (line_width >> 1),
+ line_width + 10, line_width + 10, 0, 23040);
+ }
+ XSetForeground(display, linegc, showme_foreground);
+}
+
+void draw(inc, image, xmin, ymin, xmax, ymax)
+int inc;
+int image;
+REAL xmin;
+REAL ymin;
+REAL xmax;
+REAL ymax;
+{
+ draw_buttons();
+ XClearWindow(display, mainwindow);
+ if (image == NOTHING) {
+ return;
+ }
+ if (!loaded[inc][image]) {
+ return;
+ }
+ if ((image == PART) && explode) {
+ xmin += (xmin - partcenter[inc][subdomains[inc] << 1]) * explosion;
+ xmax += (xmax - partcenter[inc][subdomains[inc] << 1]) * explosion;
+ ymin += (ymin - partcenter[inc][(subdomains[inc] << 1) + 1]) * explosion;
+ ymax += (ymax - partcenter[inc][(subdomains[inc] << 1) + 1]) * explosion;
+ }
+ xscale = (REAL) (width - line_width - 4) / (xmax - xmin);
+ yscale = (REAL) (height - line_width - 4) / (ymax - ymin);
+ if (xscale > yscale) {
+ xscale = yscale;
+ } else {
+ yscale = xscale;
+ }
+ xoffset = 0.5 * ((REAL) width - xscale * (xmax - xmin)) -
+ xscale * xmin;
+ yoffset = (REAL) height - 0.5 * ((REAL) height - yscale * (ymax - ymin)) +
+ yscale * ymin;
+ yscale = - yscale;
+ switch(image) {
+ case NODE:
+ draw_node(nodes[inc], node_dim[inc], nodeptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ break;
+ case POLY:
+ if (polynodes[inc] > 0) {
+ draw_poly(polynodes[inc], poly_dim[inc], polyedges[inc],
+ polyholes[inc], polynodeptr[inc], polyedgeptr[inc],
+ polyholeptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ } else {
+ draw_poly(nodes[inc], node_dim[inc], polyedges[inc],
+ polyholes[inc], nodeptr[inc], polyedgeptr[inc],
+ polyholeptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ }
+ break;
+ case ELE:
+ draw_ele(inc, elems[inc], ele_corners[inc], eleptr[inc],
+ (int *) NULL, (REAL *) NULL,
+ xscale, yscale, xoffset, yoffset);
+ break;
+ case EDGE:
+ draw_edge(nodes[inc], node_dim[inc], edges[inc],
+ nodeptr[inc], edgeptr[inc], normptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ break;
+ case PART:
+ draw_ele(inc, elems[inc], ele_corners[inc], eleptr[inc],
+ partpart[inc], partshift[inc],
+ xscale, yscale, xoffset, yoffset);
+ break;
+ case ADJ:
+ draw_adj(node_dim[inc], adjsubdomains[inc], adjptr[inc], partcenter[inc],
+ xscale, yscale, xoffset, yoffset);
+ break;
+ case VORO:
+ if (loaded[inc][NODE]) {
+ draw_node(nodes[inc], node_dim[inc], nodeptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ }
+ draw_edge(vnodes[inc], vnode_dim[inc], vedges[inc],
+ vnodeptr[inc], vedgeptr[inc], vnormptr[inc],
+ xscale, yscale, xoffset, yoffset);
+ break;
+ default:
+ break;
+ }
+}
+
+void addps(instring, outstring, eps)
+char *instring;
+char *outstring;
+int eps;
+{
+ strcpy(outstring, instring);
+ if (eps) {
+ strcat(outstring, ".eps");
+ } else {
+ strcat(outstring, ".ps");
+ }
+}
+
+int print_head(fname, file, llcornerx, llcornery, eps)
+char *fname;
+FILE **file;
+int llcornerx;
+int llcornery;
+int eps;
+{
+ if (!quiet) {
+ printf("Writing %s\n", fname);
+ }
+ *file = fopen(fname, "w");
+ if (*file == (FILE *) NULL) {
+ printf(" Error: Could not open %s\n", fname);
+ return 1;
+ }
+ if (eps) {
+ fprintf(*file, "%%!PS-Adobe-2.0 EPSF-2.0\n");
+ } else {
+ fprintf(*file, "%%!PS-Adobe-2.0\n");
+ }
+ fprintf(*file, "%%%%BoundingBox: %d %d %d %d\n", llcornerx, llcornery,
+ 612 - llcornerx, 792 - llcornery);
+ fprintf(*file, "%%%%Creator: Show Me\n");
+ fprintf(*file, "%%%%EndComments\n\n");
+ fprintf(*file, "1 setlinecap\n");
+ fprintf(*file, "1 setlinejoin\n");
+ fprintf(*file, "%d setlinewidth\n", line_width);
+ fprintf(*file, "%d %d moveto\n", llcornerx, llcornery);
+ fprintf(*file, "%d %d lineto\n", 612 - llcornerx, llcornery);
+ fprintf(*file, "%d %d lineto\n", 612 - llcornerx, 792 - llcornery);
+ fprintf(*file, "%d %d lineto\n", llcornerx, 792 - llcornery);
+ fprintf(*file, "closepath\nclip\nnewpath\n");
+ return 0;
+}
+
+void print_node(nodefile, nodes, dim, ptr, xscale, yscale,
+ xoffset, yoffset)
+FILE *nodefile;
+int nodes;
+int dim;
+REAL *ptr;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i;
+ int index;
+
+ index = dim;
+ for (i = 1; i <= nodes; i++) {
+ fprintf(nodefile, "%d %d %d 0 360 arc\nfill\n",
+ (int) (ptr[index] * xscale + xoffset),
+ (int) (ptr[index + 1] * yscale + yoffset),
+ 1 + (line_width >> 1));
+ index += dim;
+ }
+}
+
+void print_poly(polyfile, nodes, dim, edges, holes, nodeptr, edgeptr, holeptr,
+ xscale, yscale, xoffset, yoffset)
+FILE *polyfile;
+int nodes;
+int dim;
+int edges;
+int holes; /* unused */
+REAL *nodeptr;
+int *edgeptr;
+REAL *holeptr; /* unused */
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+{
+ int i;
+ int index;
+ REAL *point1, *point2;
+
+ index = dim;
+ for (i = 1; i <= nodes; i++) {
+ fprintf(polyfile, "%d %d %d 0 360 arc\nfill\n",
+ (int) (nodeptr[index] * xscale + xoffset),
+ (int) (nodeptr[index + 1] * yscale + yoffset),
+ 1 + (line_width >> 1));
+ index += dim;
+ }
+ index = 2;
+ for (i = 1; i <= edges; i++) {
+ point1 = &nodeptr[edgeptr[index++] * dim];
+ point2 = &nodeptr[edgeptr[index++] * dim];
+ fprintf(polyfile, "%d %d moveto\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset));
+ fprintf(polyfile, "%d %d lineto\nstroke\n",
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+}
+
+void print_ele(elefile, nodes, dim, elems, corners, nodeptr, eleptr,
+ partition, shift,
+ xscale, yscale, xoffset, yoffset, llcornerx, llcornery)
+FILE *elefile;
+int nodes; /* unused */
+int dim;
+int elems;
+int corners; /* unused */
+REAL *nodeptr;
+int *eleptr;
+int *partition;
+REAL *shift;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+int llcornerx;
+int llcornery;
+{
+ int i, j;
+ int index, colorindex;
+ REAL shiftx, shifty;
+ REAL *nowpoint;
+
+ index = 3;
+ if ((partition != (int *) NULL) && !bw_ps) {
+ fprintf(elefile, "0 0 0 setrgbcolor\n");
+ fprintf(elefile, "%d %d moveto\n", llcornerx, llcornery);
+ fprintf(elefile, "%d %d lineto\n", 612 - llcornerx, llcornery);
+ fprintf(elefile, "%d %d lineto\n", 612 - llcornerx, 792 - llcornery);
+ fprintf(elefile, "%d %d lineto\n", llcornerx, 792 - llcornery);
+ fprintf(elefile, "fill\n");
+ }
+ for (i = 1; i <= elems; i++) {
+ if ((partition != (int *) NULL) && !bw_ps) {
+ colorindex = partition[i] & 63;
+ fprintf(elefile, "%6.3f %6.3f %6.3f setrgbcolor\n",
+ (REAL) rgb[colorindex].red / 65535.0,
+ (REAL) rgb[colorindex].green / 65535.0,
+ (REAL) rgb[colorindex].blue / 65535.0);
+ }
+ nowpoint = &nodeptr[eleptr[index + 2] * dim];
+ if ((partition != (int *) NULL) && (explode || bw_ps)) {
+ shiftx = shift[partition[i] << 1];
+ shifty = shift[(partition[i] << 1) + 1];
+ fprintf(elefile, "%d %d moveto\n",
+ (int) ((nowpoint[0] + shiftx) * xscale + xoffset),
+ (int) ((nowpoint[1] + shifty) * yscale + yoffset));
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[eleptr[index++] * dim];
+ fprintf(elefile, "%d %d lineto\n",
+ (int) ((nowpoint[0] + shiftx) * xscale + xoffset),
+ (int) ((nowpoint[1] + shifty) * yscale + yoffset));
+ }
+ } else {
+ fprintf(elefile, "%d %d moveto\n",
+ (int) (nowpoint[0] * xscale + xoffset),
+ (int) (nowpoint[1] * yscale + yoffset));
+ for (j = 0; j < 3; j++) {
+ nowpoint = &nodeptr[eleptr[index++] * dim];
+ fprintf(elefile, "%d %d lineto\n",
+ (int) (nowpoint[0] * xscale + xoffset),
+ (int) (nowpoint[1] * yscale + yoffset));
+ }
+ }
+ if (fillelem && !bw_ps) {
+ fprintf(elefile, "gsave\nfill\ngrestore\n1 1 0 setrgbcolor\n");
+ }
+ fprintf(elefile, "stroke\n");
+ }
+}
+
+void print_edge(edgefile, nodes, dim, edges, nodeptr, edgeptr, normptr,
+ xscale, yscale, xoffset, yoffset, llcornerx, llcornery)
+FILE *edgefile;
+int nodes; /* unused */
+int dim;
+int edges;
+REAL *nodeptr;
+int *edgeptr;
+REAL *normptr;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+int llcornerx;
+int llcornery;
+{
+ int i;
+ int index;
+ REAL *point1, *point2;
+ REAL normx, normy;
+ REAL normmult, normmultx, normmulty;
+ REAL windowxmin, windowymin, windowxmax, windowymax;
+
+ index = 2;
+ for (i = 1; i <= edges; i++) {
+ point1 = &nodeptr[edgeptr[index++] * dim];
+ if (edgeptr[index] == -1) {
+ normx = normptr[index - 1];
+ normy = normptr[index++];
+ normmultx = 0.0;
+ if (normx > 0) {
+ windowxmax = ((REAL) (612 - llcornerx) - xoffset) / xscale;
+ normmultx = (windowxmax - point1[0]) / normx;
+ } else if (normx < 0) {
+ windowxmin = ((REAL) llcornerx - xoffset) / xscale;
+ normmultx = (windowxmin - point1[0]) / normx;
+ }
+ normmulty = 0.0;
+ if (normy > 0) {
+ windowymax = ((REAL) (792 - llcornery) - yoffset) / yscale;
+ normmulty = (windowymax - point1[1]) / normy;
+ } else if (normy < 0) {
+ windowymin = ((REAL) llcornery - yoffset) / yscale;
+ normmulty = (windowymin - point1[1]) / normy;
+ }
+ if (normmultx == 0.0) {
+ normmult = normmulty;
+ } else if (normmulty == 0.0) {
+ normmult = normmultx;
+ } else if (normmultx < normmulty) {
+ normmult = normmultx;
+ } else {
+ normmult = normmulty;
+ }
+ if (normmult > 0.0) {
+ fprintf(edgefile, "%d %d moveto\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset));
+ fprintf(edgefile, "%d %d lineto\nstroke\n",
+ (int) ((point1[0] + normmult * normx) * xscale + xoffset),
+ (int) ((point1[1] + normmult * normy) * yscale + yoffset));
+ }
+ } else {
+ point2 = &nodeptr[edgeptr[index++] * dim];
+ fprintf(edgefile, "%d %d moveto\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset));
+ fprintf(edgefile, "%d %d lineto\nstroke\n",
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+ }
+}
+
+void print_adj(adjfile, dim, subdomains, ptr, center, xscale, yscale,
+ xoffset, yoffset, llcornerx, llcornery)
+FILE *adjfile;
+int dim;
+int subdomains;
+int *ptr;
+REAL *center;
+REAL xscale;
+REAL yscale;
+REAL xoffset;
+REAL yoffset;
+int llcornerx;
+int llcornery;
+{
+ int i, j;
+ REAL *point1, *point2;
+ int colorindex;
+
+ if (!bw_ps) {
+ fprintf(adjfile, "0 0 0 setrgbcolor\n");
+ fprintf(adjfile, "%d %d moveto\n", llcornerx, llcornery);
+ fprintf(adjfile, "%d %d lineto\n", 612 - llcornerx, llcornery);
+ fprintf(adjfile, "%d %d lineto\n", 612 - llcornerx, 792 - llcornery);
+ fprintf(adjfile, "%d %d lineto\n", llcornerx, 792 - llcornery);
+ fprintf(adjfile, "fill\n");
+ fprintf(adjfile, "1 1 0 setrgbcolor\n");
+ }
+ for (i = 0; i < subdomains; i++) {
+ for (j = i + 1; j < subdomains; j++) {
+ if (ptr[i * subdomains + j]) {
+ point1 = ¢er[i * dim];
+ point2 = ¢er[j * dim];
+ fprintf(adjfile, "%d %d moveto\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset));
+ fprintf(adjfile, "%d %d lineto\nstroke\n",
+ (int) (point2[0] * xscale + xoffset),
+ (int) (point2[1] * yscale + yoffset));
+ }
+ }
+ }
+ for (i = 0; i < subdomains; i++) {
+ point1 = ¢er[i * dim];
+ if (!bw_ps) {
+ colorindex = i & 63;
+ fprintf(adjfile, "%6.3f %6.3f %6.3f setrgbcolor\n",
+ (REAL) rgb[colorindex].red / 65535.0,
+ (REAL) rgb[colorindex].green / 65535.0,
+ (REAL) rgb[colorindex].blue / 65535.0);
+ fprintf(adjfile, "%d %d %d 0 360 arc\nfill\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ 5 + (line_width >> 1));
+ } else {
+ fprintf(adjfile, "%d %d %d 0 360 arc\nfill\n",
+ (int) (point1[0] * xscale + xoffset),
+ (int) (point1[1] * yscale + yoffset),
+ 3 + (line_width >> 1));
+ }
+ }
+}
+
+void print(inc, image, xmin, ymin, xmax, ymax, eps)
+int inc;
+int image;
+REAL xmin;
+REAL ymin;
+REAL xmax;
+REAL ymax;
+int eps;
+{
+ REAL xxscale, yyscale, xxoffset, yyoffset;
+ char psfilename[FILENAMESIZE];
+ int llcornerx, llcornery;
+ FILE *psfile;
+
+ if (image == NOTHING) {
+ return;
+ }
+ if (!loaded[inc][image]) {
+ return;
+ }
+ if ((image == PART) && (explode || bw_ps)) {
+ xmin += (xmin - partcenter[inc][subdomains[inc] << 1]) * explosion;
+ xmax += (xmax - partcenter[inc][subdomains[inc] << 1]) * explosion;
+ ymin += (ymin - partcenter[inc][(subdomains[inc] << 1) + 1]) * explosion;
+ ymax += (ymax - partcenter[inc][(subdomains[inc] << 1) + 1]) * explosion;
+ }
+ xxscale = (460.0 - (REAL) line_width) / (xmax - xmin);
+ yyscale = (640.0 - (REAL) line_width) / (ymax - ymin);
+ if (xxscale > yyscale) {
+ xxscale = yyscale;
+ llcornerx = (604 - (int) (yyscale * (xmax - xmin)) - line_width) >> 1;
+ llcornery = 72;
+ } else {
+ yyscale = xxscale;
+ llcornerx = 72;
+ llcornery = (784 - (int) (xxscale * (ymax - ymin)) - line_width) >> 1;
+ }
+ xxoffset = 0.5 * (612.0 - xxscale * (xmax - xmin)) - xxscale * xmin +
+ (line_width >> 1);
+ yyoffset = 0.5 * (792.0 - yyscale * (ymax - ymin)) - yyscale * ymin +
+ (line_width >> 1);
+ switch(image) {
+ case NODE:
+ addps(nodefilename[inc], psfilename, eps);
+ break;
+ case POLY:
+ addps(polyfilename[inc], psfilename, eps);
+ break;
+ case ELE:
+ addps(elefilename[inc], psfilename, eps);
+ break;
+ case EDGE:
+ addps(edgefilename[inc], psfilename, eps);
+ break;
+ case PART:
+ addps(partfilename[inc], psfilename, eps);
+ break;
+ case ADJ:
+ addps(adjfilename[inc], psfilename, eps);
+ break;
+ case VORO:
+ addps(vedgefilename[inc], psfilename, eps);
+ break;
+ default:
+ break;
+ }
+ if (print_head(psfilename, &psfile, llcornerx, llcornery, eps)) {
+ return;
+ }
+ switch (image) {
+ case NODE:
+ print_node(psfile, nodes[inc], node_dim[inc], nodeptr[inc],
+ xxscale, yyscale, xxoffset, yyoffset);
+ break;
+ case POLY:
+ if (polynodes[inc] > 0) {
+ print_poly(psfile, polynodes[inc], poly_dim[inc], polyedges[inc],
+ polyholes[inc], polynodeptr[inc], polyedgeptr[inc],
+ polyholeptr[inc], xxscale, yyscale, xxoffset, yyoffset);
+ } else {
+ print_poly(psfile, nodes[inc], node_dim[inc], polyedges[inc],
+ polyholes[inc], nodeptr[inc], polyedgeptr[inc],
+ polyholeptr[inc], xxscale, yyscale, xxoffset, yyoffset);
+ }
+ break;
+ case ELE:
+ print_ele(psfile, nodes[inc], node_dim[inc], elems[inc],
+ ele_corners[inc], nodeptr[inc], eleptr[inc],
+ (int *) NULL, (REAL *) NULL,
+ xxscale, yyscale, xxoffset, yyoffset, llcornerx, llcornery);
+ break;
+ case EDGE:
+ print_edge(psfile, nodes[inc], node_dim[inc], edges[inc],
+ nodeptr[inc], edgeptr[inc], normptr[inc],
+ xxscale, yyscale, xxoffset, yyoffset, llcornerx, llcornery);
+ break;
+ case PART:
+ print_ele(psfile, nodes[inc], node_dim[inc], elems[inc],
+ ele_corners[inc], nodeptr[inc], eleptr[inc],
+ partpart[inc], partshift[inc],
+ xxscale, yyscale, xxoffset, yyoffset, llcornerx, llcornery);
+ break;
+ case ADJ:
+ print_adj(psfile, node_dim[inc], adjsubdomains[inc], adjptr[inc],
+ partcenter[inc],
+ xxscale, yyscale, xxoffset, yyoffset, llcornerx, llcornery);
+ break;
+ case VORO:
+ print_edge(psfile, vnodes[inc], vnode_dim[inc], vedges[inc],
+ vnodeptr[inc], vedgeptr[inc], vnormptr[inc],
+ xxscale, yyscale, xxoffset, yyoffset, llcornerx, llcornery);
+ break;
+ default:
+ break;
+ }
+ if (!eps) {
+ fprintf(psfile, "showpage\n");
+ }
+ fclose(psfile);
+}
+
+int main(argc, argv)
+int argc;
+char **argv;
+{
+ REAL xmin = 0.0, ymin = 0.0, xmax = 0.0, ymax = 0.0;
+ REAL xptr, yptr, xspan, yspan;
+ int past_image;
+ int new_image = 0;
+ int new_inc = 0;
+
+ parsecommandline(argc, argv);
+ showme_init();
+ choose_image(start_inc, start_image);
+ showme_window(argc, argv);
+
+ if (current_image != NOTHING) {
+ xmin = xlo[current_inc][current_image];
+ ymin = ylo[current_inc][current_image];
+ xmax = xhi[current_inc][current_image];
+ ymax = yhi[current_inc][current_image];
+ zoom = 0;
+ }
+
+ XMaskEvent(display, ExposureMask, &event);
+ while (1) {
+ switch (event.type) {
+ case ButtonRelease:
+ if (event.xany.window == quitwin) {
+ XDestroyWindow(display, mainwindow);
+ XCloseDisplay(display);
+ return 0;
+ } else if (event.xany.window == leftwin) {
+ xspan = 0.25 * (xmax - xmin);
+ xmin += xspan;
+ xmax += xspan;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xany.window == rightwin) {
+ xspan = 0.25 * (xmax - xmin);
+ xmin -= xspan;
+ xmax -= xspan;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xany.window == upwin) {
+ yspan = 0.25 * (ymax - ymin);
+ ymin -= yspan;
+ ymax -= yspan;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xany.window == downwin) {
+ yspan = 0.25 * (ymax - ymin);
+ ymin += yspan;
+ ymax += yspan;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xany.window == resetwin) {
+ xmin = xlo[current_inc][current_image];
+ ymin = ylo[current_inc][current_image];
+ xmax = xhi[current_inc][current_image];
+ ymax = yhi[current_inc][current_image];
+ zoom = 0;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xany.window == widthpluswin) {
+ if (line_width < 100) {
+ line_width++;
+ XSetLineAttributes(display, linegc, line_width, LineSolid,
+ CapRound, JoinRound);
+ XSetLineAttributes(display, trianglegc, line_width, LineSolid,
+ CapRound, JoinRound);
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == widthminuswin) {
+ if (line_width > 1) {
+ line_width--;
+ XSetLineAttributes(display, linegc, line_width, LineSolid,
+ CapRound, JoinRound);
+ XSetLineAttributes(display, trianglegc, line_width, LineSolid,
+ CapRound, JoinRound);
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == expwin) {
+ if ((current_image == PART) && loaded[current_inc][PART]) {
+ explode = !explode;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == exppluswin) {
+ if ((current_image == PART) && loaded[current_inc][PART] && explode) {
+ explosion += 0.125;
+ findpartshift(subdomains[current_inc], explosion,
+ partcenter[current_inc], partshift[current_inc]);
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == expminuswin) {
+ if ((current_image == PART) && loaded[current_inc][PART] && explode &&
+ (explosion >= 0.125)) {
+ explosion -= 0.125;
+ findpartshift(subdomains[current_inc], explosion,
+ partcenter[current_inc], partshift[current_inc]);
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == fillwin) {
+ if ((current_image == PART) && loaded[current_inc][PART]) {
+ fillelem = !fillelem;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ }
+ } else if (event.xany.window == pswin) {
+ fill_button(pswin);
+ XFlush(display);
+ print(current_inc, current_image, xmin, ymin, xmax, ymax, 0);
+ XClearWindow(display, pswin);
+ XDrawString(display, pswin, fontgc, 2, 13, "PS", 2);
+ } else if (event.xany.window == epswin) {
+ fill_button(epswin);
+ XFlush(display);
+ print(current_inc, current_image, xmin, ymin, xmax, ymax, 1);
+ XClearWindow(display, epswin);
+ XDrawString(display, epswin, fontgc, 2, 13, "EPS", 3);
+ } else if (event.xany.window == versionpluswin) {
+ move_inc(1);
+ loweriteration++;
+ set_filenames(filename, loweriteration);
+ if (current_inc == 1) {
+ current_inc = 0;
+ } else {
+ current_image = NOTHING;
+ XClearWindow(display, mainwindow);
+ }
+ draw_buttons();
+ } else if (event.xany.window == versionminuswin) {
+ if (loweriteration > 0) {
+ move_inc(0);
+ loweriteration--;
+ set_filenames(filename, loweriteration);
+ if (current_inc == 0) {
+ current_inc = 1;
+ } else {
+ current_image = NOTHING;
+ XClearWindow(display, mainwindow);
+ }
+ draw_buttons();
+ }
+ } else if ((event.xany.window == nodewin[0]) ||
+ (event.xany.window == polywin[0]) ||
+ (event.xany.window == elewin[0]) ||
+ (event.xany.window == edgewin[0]) ||
+ (event.xany.window == partwin[0]) ||
+ (event.xany.window == adjwin[0]) ||
+ (event.xany.window == voronoiwin[0]) ||
+ (event.xany.window == nodewin[1]) ||
+ (event.xany.window == polywin[1]) ||
+ (event.xany.window == elewin[1]) ||
+ (event.xany.window == edgewin[1]) ||
+ (event.xany.window == partwin[1]) ||
+ (event.xany.window == adjwin[1]) ||
+ (event.xany.window == voronoiwin[1])) {
+ if (event.xany.window == nodewin[0]) {
+ new_inc = 0;
+ new_image = NODE;
+ }
+ if (event.xany.window == polywin[0]) {
+ new_inc = 0;
+ new_image = POLY;
+ }
+ if (event.xany.window == elewin[0]) {
+ new_inc = 0;
+ new_image = ELE;
+ }
+ if (event.xany.window == edgewin[0]) {
+ new_inc = 0;
+ new_image = EDGE;
+ }
+ if (event.xany.window == partwin[0]) {
+ new_inc = 0;
+ new_image = PART;
+ }
+ if (event.xany.window == adjwin[0]) {
+ new_inc = 0;
+ new_image = ADJ;
+ }
+ if (event.xany.window == voronoiwin[0]) {
+ new_inc = 0;
+ new_image = VORO;
+ }
+ if (event.xany.window == nodewin[1]) {
+ new_inc = 1;
+ new_image = NODE;
+ }
+ if (event.xany.window == polywin[1]) {
+ new_inc = 1;
+ new_image = POLY;
+ }
+ if (event.xany.window == elewin[1]) {
+ new_inc = 1;
+ new_image = ELE;
+ }
+ if (event.xany.window == edgewin[1]) {
+ new_inc = 1;
+ new_image = EDGE;
+ }
+ if (event.xany.window == partwin[1]) {
+ new_inc = 1;
+ new_image = PART;
+ }
+ if (event.xany.window == adjwin[1]) {
+ new_inc = 1;
+ new_image = ADJ;
+ }
+ if (event.xany.window == voronoiwin[1]) {
+ new_inc = 1;
+ new_image = VORO;
+ }
+ past_image = current_image;
+ if ((current_inc == new_inc) && (current_image == new_image)) {
+ free_inc(new_inc);
+ unload_inc(new_inc);
+ }
+ choose_image(new_inc, new_image);
+ if ((past_image == NOTHING) && (current_image != NOTHING)) {
+ xmin = xlo[current_inc][current_image];
+ ymin = ylo[current_inc][current_image];
+ xmax = xhi[current_inc][current_image];
+ ymax = yhi[current_inc][current_image];
+ zoom = 0;
+ }
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else {
+ xptr = ((REAL) event.xbutton.x - xoffset) / xscale;
+ yptr = ((REAL) event.xbutton.y - yoffset) / yscale;
+ if ((current_image == PART) && loaded[current_inc][PART] && explode) {
+ xptr = (xptr + partcenter[current_inc]
+ [subdomains[current_inc] << 1]
+ * explosion) / (1.0 + explosion);
+ yptr = (yptr + partcenter[current_inc]
+ [(subdomains[current_inc] << 1) + 1]
+ * explosion) / (1.0 + explosion);
+ }
+ if ((event.xbutton.button == Button1)
+ || (event.xbutton.button == Button3)) {
+ if (event.xbutton.button == Button1) {
+ xspan = 0.25 * (xmax - xmin);
+ yspan = 0.25 * (ymax - ymin);
+ zoom++;
+ } else {
+ xspan = xmax - xmin;
+ yspan = ymax - ymin;
+ zoom--;
+ }
+ xmin = xptr - xspan;
+ ymin = yptr - yspan;
+ xmax = xptr + xspan;
+ ymax = yptr + yspan;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ } else if (event.xbutton.button == Button2) {
+ printf("x = %.4g, y = %.4g\n", xptr, yptr);
+ }
+ }
+ break;
+ case DestroyNotify:
+ XDestroyWindow(display, mainwindow);
+ XCloseDisplay(display);
+ return 0;
+ case ConfigureNotify:
+ if ((width != event.xconfigure.width) ||
+ (height != event.xconfigure.height - PANELHEIGHT)) {
+ width = event.xconfigure.width;
+ height = event.xconfigure.height - PANELHEIGHT;
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ while (XCheckMaskEvent(display, ExposureMask, &event));
+ }
+ break;
+ case Expose:
+ draw(current_inc, current_image, xmin, ymin, xmax, ymax);
+ while (XCheckMaskEvent(display, ExposureMask, &event));
+ break;
+ default:
+ break;
+ }
+ XNextEvent(display, &event);
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/exit.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/exit.c
new file mode 100644
index 0000000000000000000000000000000000000000..97a40835c2a75b97899b9989751078a9362f2f28
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/exit.c
@@ -0,0 +1,38 @@
+/* This gives the effect of
+
+ subroutine exit(rc)
+ integer*4 rc
+ stop
+ end
+
+ * with the added side effect of supplying rc as the program's exit code.
+ */
+
+#include "f2c.h"
+#include "netlib.h"
+#undef abs
+#undef min
+#undef max
+#ifndef KR_headers
+#include <stdlib.h>
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void f_exit(void);
+#endif
+
+ void
+#ifdef KR_headers
+exit_(rc) integer *rc;
+#else
+exit_(integer *rc)
+#endif
+{
+#ifdef NO_ONEXIT
+ f_exit();
+#endif
+ exit(*rc);
+ }
+#ifdef __cplusplus
+}
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/f2c.h b/Utilities/ITK/Utilities/vxl/v3p/netlib/f2c.h
new file mode 100644
index 0000000000000000000000000000000000000000..f0e2b623b1e19a99956b0f04469be81eb247743f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/f2c.h
@@ -0,0 +1,236 @@
+/* f2c.h -- Standard Fortran to C header file */
+
+/* barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
+
+ - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef int integer; /* awf changed from long */
+typedef const char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef int logical; /* awf changed from long */
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef long flag;
+typedef long ftnlen;
+typedef long ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{
+ flag cierr;
+ ftnint ciunit;
+ flag ciend;
+ char *cifmt;
+ ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{
+ flag icierr;
+ char *iciunit;
+ flag iciend;
+ char *icifmt;
+ ftnint icirlen;
+ ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{
+ flag oerr;
+ ftnint ounit;
+ char *ofnm;
+ ftnlen ofnmlen;
+ char *osta;
+ char *oacc;
+ char *ofm;
+ ftnint orl;
+ char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{
+ flag c_err;
+ ftnint cunit;
+ char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{
+ flag aerr;
+ ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{
+ flag inerr;
+ ftnint inunit;
+ char *infile;
+ ftnlen infilen;
+ ftnint *inex; /*parameters in standard's order*/
+ ftnint *inopen;
+ ftnint *innum;
+ ftnint *innamed;
+ char *inname;
+ ftnlen innamlen;
+ char *inacc;
+ ftnlen inacclen;
+ char *inseq;
+ ftnlen inseqlen;
+ char *indir;
+ ftnlen indirlen;
+ char *infmt;
+ ftnlen infmtlen;
+ char *inform;
+ ftnint informlen;
+ char *inunf;
+ ftnlen inunflen;
+ ftnint *inrecl;
+ ftnint *innrec;
+ char *inblank;
+ ftnlen inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype { /* for multiple entry points */
+ shortint h;
+ integer i;
+ real r;
+ doublereal d;
+ complex c;
+ doublecomplex z;
+ };
+
+typedef union Multitype Multitype;
+
+typedef long Long; /* No longer used; formerly in Namelist */
+
+struct Vardesc { /* for Namelist */
+ char *name;
+ char *addr;
+ ftnlen *dims;
+ int type;
+ };
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+ char *name;
+ Vardesc **vars;
+ int nvars;
+ };
+typedef struct Namelist Namelist;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+
+#ifdef __cplusplus
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+#else
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef int /* Unknown procedure type */ (*U_fp)();
+#endif
+
+#ifndef IUE /* These are not used in netlib, and cause the gcc compiler warning
+ "function declaration isn't a prototype" */
+/*
+// d.capel@2d3.com - Actually, they are used in many netlib functions,
+// just not any that are included in v3p/netlib (yet). However, I am
+// at liberty to use those netlib routines in my own code, and I
+// therefore require that the f2c.h seen by my compiler not be
+// broken. I don't think I should need to have two different versions
+// of f2c.h lying around in order to facilitate this.
+*/
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef shortint (*J_fp)(void);
+typedef integer (*I_fp)(void);
+typedef real (*R_fp)(void);
+typedef /* Complex */ VOID (*C_fp)(void);
+typedef /* Double Complex */ VOID (*Z_fp)(void);
+typedef logical (*L_fp)(void);
+typedef shortlogical (*K_fp)(void);
+typedef /* Character */ VOID (*H_fp)(void);
+typedef /* Subroutine */ int (*S_fp)(void);
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f; /* complex function */
+typedef VOID H_f; /* character function */
+typedef VOID Z_f; /* double complex function */
+typedef doublereal E_f; /* real function with -R not specified */
+
+#endif /* not used */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#ifndef como4301 /* Comeau C++ does not allow #undef of "unix" */
+#undef unix
+#endif
+#undef vax
+#endif
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/fdjac2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/fdjac2.c
new file mode 100644
index 0000000000000000000000000000000000000000..250286fae6f12e246c404abd6e38edab1f136676
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/fdjac2.c
@@ -0,0 +1,114 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void fdjac2_(fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn, wa)
+/* Subroutine */ void (*fcn) (integer*,integer*,doublereal*,doublereal*,integer*);
+integer *m, *n;
+doublereal *x, *fvec, *fjac;
+integer *ldfjac, *iflag;
+doublereal *epsfcn, *wa;
+{
+ /* Initialized data */
+ static doublereal zero = 0.;
+
+ /* Local variables */
+ static doublereal temp, h;
+ static integer i, j;
+ static doublereal epsmch;
+ static doublereal eps;
+
+/* ********** */
+
+/* subroutine fdjac2 */
+/* */
+/* this subroutine computes a forward-difference approximation */
+/* to the m by n jacobian matrix associated with a specified */
+/* problem of m functions in n variables. */
+/* */
+/* the subroutine statement is */
+/* */
+/* subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) */
+/* */
+/* where */
+/* */
+/* fcn is the name of the user-supplied subroutine which */
+/* calculates the functions. fcn must be declared */
+/* in an external statement in the user calling */
+/* program, and should be written as follows. */
+/* */
+/* subroutine fcn(m,n,x,fvec,iflag) */
+/* integer m,n,iflag */
+/* double precision x(n),fvec(m) */
+/* ---------- */
+/* calculate the functions at x and */
+/* return this vector in fvec. */
+/* ---------- */
+/* return */
+/* end */
+/* */
+/* the value of iflag should not be changed by fcn unless */
+/* the user wants to terminate execution of fdjac2. */
+/* in this case set iflag to a negative integer. */
+/* */
+/* m is a positive integer input variable set to the number */
+/* of functions. */
+/* */
+/* n is a positive integer input variable set to the number */
+/* of variables. n must not exceed m. */
+/* */
+/* x is an input array of length n. */
+/* */
+/* fvec is an input array of length m which must contain the */
+/* functions evaluated at x. */
+/* */
+/* fjac is an output m by n array which contains the */
+/* approximation to the jacobian matrix evaluated at x. */
+/* */
+/* ldfjac is a positive integer input variable not less than m */
+/* which specifies the leading dimension of the array fjac. */
+/* */
+/* iflag is an integer variable which can be used to terminate */
+/* the execution of fdjac2. see description of fcn. */
+/* */
+/* epsfcn is an input variable used in determining a suitable */
+/* step length for the forward-difference approximation. this */
+/* approximation assumes that the relative errors in the */
+/* functions are of the order of epsfcn. if epsfcn is less */
+/* than the machine precision, it is assumed that the relative */
+/* errors in the functions are of the order of the machine */
+/* precision. */
+/* */
+/* wa is a work array of length m. */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+
+/* ********** */
+
+/* epsmch is the machine precision. */
+
+ epsmch = dpmpar_(&c__1);
+
+ eps = sqrt((max(*epsfcn,epsmch)));
+ for (j = 0; j < *n; ++j) {
+ temp = x[j];
+ h = eps * abs(temp);
+ if (h == zero) {
+ h = eps;
+ }
+ x[j] = temp + h;
+ (*fcn)(m, n, x, wa, iflag);
+ if (*iflag < 0) {
+ break;
+ }
+ x[j] = temp;
+ for (i = 0; i < *m; ++i) {
+ fjac[i + j * *ldfjac] = (wa[i] - fvec[i]) / h;
+ }
+ }
+ return;
+} /* fdjac2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/full-dpoco.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/full-dpoco.f
new file mode 100644
index 0000000000000000000000000000000000000000..51877e1da24ca134c8e3b09e89d7cf1525e38662
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/full-dpoco.f
@@ -0,0 +1,449 @@
+ subroutine dpoco(a,lda,n,rcond,z,info)
+ integer lda,n,info
+ double precision a(lda,1),z(1)
+ double precision rcond
+c
+c dpoco factors a double precision symmetric positive definite
+c matrix and estimates the condition of the matrix.
+c
+c if rcond is not needed, dpofa is slightly faster.
+c to solve a*x = b , follow dpoco by dposl.
+c to compute inverse(a)*c , follow dpoco by dposl.
+c to compute determinant(a) , follow dpoco by dpodi.
+c to compute inverse(a) , follow dpoco by dpodi.
+c
+c on entry
+c
+c a double precision(lda, n)
+c the symmetric matrix to be factored. only the
+c diagonal and upper triangle are used.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c on return
+c
+c a an upper triangular matrix r so that a = trans(r)*r
+c where trans(r) is the transpose.
+c the strict lower triangle is unaltered.
+c if info .ne. 0 , the factorization is not complete.
+c
+c rcond double precision
+c an estimate of the reciprocal condition of a .
+c for the system a*x = b , relative perturbations
+c in a and b of size epsilon may cause
+c relative perturbations in x of size epsilon/rcond .
+c if rcond is so small that the logical expression
+c 1.0 + rcond .eq. 1.0
+c is true, then a may be singular to working
+c precision. in particular, rcond is zero if
+c exact singularity is detected or the estimate
+c underflows. if info .ne. 0 , rcond is unchanged.
+c
+c z double precision(n)
+c a work vector whose contents are usually unimportant.
+c if a is close to a singular matrix, then z is
+c an approximate null vector in the sense that
+c norm(a*z) = rcond*norm(a)*norm(z) .
+c if info .ne. 0 , z is unchanged.
+c
+c info integer
+c = 0 for normal return.
+c = k signals an error condition. the leading minor
+c of order k is not positive definite.
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c linpack dpofa
+c blas daxpy,ddot,dscal,dasum
+c fortran dabs,dmax1,dreal,dsign
+c
+c internal variables
+c
+ double precision ddot,ek,t,wk,wkm
+ double precision anorm,s,dasum,sm,ynorm
+ integer i,j,jm1,k,kb,kp1
+c
+c
+c find norm of a using only upper half
+c
+ do 30 j = 1, n
+ z(j) = dasum(j,a(1,j),1)
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 20
+ do 10 i = 1, jm1
+ z(i) = z(i) + dabs(a(i,j))
+ 10 continue
+ 20 continue
+ 30 continue
+ anorm = 0.0d0
+ do 40 j = 1, n
+ anorm = dmax1(anorm,z(j))
+ 40 continue
+c
+c factor
+c
+ call dpofa(a,lda,n,info)
+ if (info .ne. 0) go to 180
+c
+c rcond = 1/(norm(a)*(estimate of norm(inverse(a)))) .
+c estimate = norm(z)/norm(y) where a*z = y and a*y = e .
+c the components of e are chosen to cause maximum local
+c growth in the elements of w where trans(r)*w = e .
+c the vectors are frequently rescaled to avoid overflow.
+c
+c solve trans(r)*w = e
+c
+ ek = 1.0d0
+ do 50 j = 1, n
+ z(j) = 0.0d0
+ 50 continue
+ do 110 k = 1, n
+ if (z(k) .ne. 0.0d0) ek = dsign(ek,-z(k))
+ if (dabs(ek-z(k)) .le. a(k,k)) go to 60
+ s = a(k,k)/dabs(ek-z(k))
+ call dscal(n,s,z,1)
+ ek = s*ek
+ 60 continue
+ wk = ek - z(k)
+ wkm = -ek - z(k)
+ s = dabs(wk)
+ sm = dabs(wkm)
+ wk = wk/a(k,k)
+ wkm = wkm/a(k,k)
+ kp1 = k + 1
+ if (kp1 .gt. n) go to 100
+ do 70 j = kp1, n
+ sm = sm + dabs(z(j)+wkm*a(k,j))
+ z(j) = z(j) + wk*a(k,j)
+ s = s + dabs(z(j))
+ 70 continue
+ if (s .ge. sm) go to 90
+ t = wkm - wk
+ wk = wkm
+ do 80 j = kp1, n
+ z(j) = z(j) + t*a(k,j)
+ 80 continue
+ 90 continue
+ 100 continue
+ z(k) = wk
+ 110 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+c
+c solve r*y = w
+c
+ do 130 kb = 1, n
+ k = n + 1 - kb
+ if (dabs(z(k)) .le. a(k,k)) go to 120
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ 120 continue
+ z(k) = z(k)/a(k,k)
+ t = -z(k)
+ call daxpy(k-1,t,a(1,k),1,z(1),1)
+ 130 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+c
+ ynorm = 1.0d0
+c
+c solve trans(r)*v = y
+c
+ do 150 k = 1, n
+ z(k) = z(k) - ddot(k-1,a(1,k),1,z(1),1)
+ if (dabs(z(k)) .le. a(k,k)) go to 140
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+ 140 continue
+ z(k) = z(k)/a(k,k)
+ 150 continue
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+c
+c solve r*z = v
+c
+ do 170 kb = 1, n
+ k = n + 1 - kb
+ if (dabs(z(k)) .le. a(k,k)) go to 160
+ s = a(k,k)/dabs(z(k))
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+ 160 continue
+ z(k) = z(k)/a(k,k)
+ t = -z(k)
+ call daxpy(k-1,t,a(1,k),1,z(1),1)
+ 170 continue
+c make znorm = 1.0
+ s = 1.0d0/dasum(n,z,1)
+ call dscal(n,s,z,1)
+ ynorm = s*ynorm
+c
+ if (anorm .ne. 0.0d0) rcond = ynorm/anorm
+ if (anorm .eq. 0.0d0) rcond = 0.0d0
+ 180 continue
+ return
+ end
+ double precision function dasum(n,dx,incx)
+c
+c takes the sum of the absolute values.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dtemp
+ integer i,incx,m,mp1,n,nincx
+c
+ dasum = 0.0d0
+ dtemp = 0.0d0
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ dtemp = dtemp + dabs(dx(i))
+ 10 continue
+ dasum = dtemp
+ return
+c
+c code for increment equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,6)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dtemp = dtemp + dabs(dx(i))
+ 30 continue
+ if( n .lt. 6 ) go to 60
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,6
+ dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
+ * + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
+ 50 continue
+ 60 dasum = dtemp
+ return
+ end
+ subroutine daxpy(n,da,dx,incx,dy,incy)
+c
+c constant times a vector plus a vector.
+c uses unrolled loops for increments equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dy(*),da
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if (da .eq. 0.0d0) return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ dy(iy) = dy(iy) + da*dx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,4)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dy(i) = dy(i) + da*dx(i)
+ 30 continue
+ if( n .lt. 4 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,4
+ dy(i) = dy(i) + da*dx(i)
+ dy(i + 1) = dy(i + 1) + da*dx(i + 1)
+ dy(i + 2) = dy(i + 2) + da*dx(i + 2)
+ dy(i + 3) = dy(i + 3) + da*dx(i + 3)
+ 50 continue
+ return
+ end
+ double precision function ddot(n,dx,incx,dy,incy)
+c
+c forms the dot product of two vectors.
+c uses unrolled loops for increments equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dy(*),dtemp
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ ddot = 0.0d0
+ dtemp = 0.0d0
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ dtemp = dtemp + dx(ix)*dy(iy)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ ddot = dtemp
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,5)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dtemp = dtemp + dx(i)*dy(i)
+ 30 continue
+ if( n .lt. 5 ) go to 60
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,5
+ dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
+ * dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
+ 50 continue
+ 60 ddot = dtemp
+ return
+ end
+ subroutine dscal(n,da,dx,incx)
+c
+c scales a vector by a constant.
+c uses unrolled loops for increment equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision da,dx(*)
+ integer i,incx,m,mp1,n,nincx
+c
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ dx(i) = da*dx(i)
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,5)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dx(i) = da*dx(i)
+ 30 continue
+ if( n .lt. 5 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,5
+ dx(i) = da*dx(i)
+ dx(i + 1) = da*dx(i + 1)
+ dx(i + 2) = da*dx(i + 2)
+ dx(i + 3) = da*dx(i + 3)
+ dx(i + 4) = da*dx(i + 4)
+ 50 continue
+ return
+ end
+ subroutine dpofa(a,lda,n,info)
+ integer lda,n,info
+ double precision a(lda,1)
+c
+c dpofa factors a double precision symmetric positive definite
+c matrix.
+c
+c dpofa is usually called by dpoco, but it can be called
+c directly with a saving in time if rcond is not needed.
+c (time for dpoco) = (1 + 18/n)*(time for dpofa) .
+c
+c on entry
+c
+c a double precision(lda, n)
+c the symmetric matrix to be factored. only the
+c diagonal and upper triangle are used.
+c
+c lda integer
+c the leading dimension of the array a .
+c
+c n integer
+c the order of the matrix a .
+c
+c on return
+c
+c a an upper triangular matrix r so that a = trans(r)*r
+c where trans(r) is the transpose.
+c the strict lower triangle is unaltered.
+c if info .ne. 0 , the factorization is not complete.
+c
+c info integer
+c = 0 for normal return.
+c = k signals an error condition. the leading minor
+c of order k is not positive definite.
+c
+c linpack. this version dated 08/14/78 .
+c cleve moler, university of new mexico, argonne national lab.
+c
+c subroutines and functions
+c
+c blas ddot
+c fortran dsqrt
+c
+c internal variables
+c
+ double precision ddot,t
+ double precision s
+ integer j,jm1,k
+c begin block with ...exits to 40
+c
+c
+ do 30 j = 1, n
+ info = j
+ s = 0.0d0
+ jm1 = j - 1
+ if (jm1 .lt. 1) go to 20
+ do 10 k = 1, jm1
+ t = a(k,j) - ddot(k-1,a(1,k),1,a(1,j),1)
+ t = t/a(k,k)
+ a(k,j) = t
+ s = s + t*t
+ 10 continue
+ 20 continue
+ s = a(j,j) - s
+c ......exit
+ if (s .le. 0.0d0) go to 40
+ a(j,j) = dsqrt(s)
+ 30 continue
+ info = 0
+ 40 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa.c
new file mode 100644
index 0000000000000000000000000000000000000000..59a8adc3f7e2b2c77570594fa74dd093515b6de7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa.c
@@ -0,0 +1,79 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c__3 = 3;
+
+/* SUBROUTINE 'GPFA' */
+/* SELF-SORTING IN-PLACE GENERALIZED PRIME FACTOR (COMPLEX) FFT */
+/* */
+/* *** THIS IS THE ALL-FORTRAN VERSION *** */
+/* ------------------------------- */
+/* */
+/* CALL GPFA(A,B,TRIGS,INC,JUMP,N,LOT,ISIGN) */
+/* */
+/* A IS FIRST REAL INPUT/OUTPUT VECTOR */
+/* B IS FIRST IMAGINARY INPUT/OUTPUT VECTOR */
+/* TRIGS IS A TABLE OF TWIDDLE FACTORS, PRECALCULATED */
+/* BY CALLING SUBROUTINE 'SETGPFA' */
+/* INC IS THE INCREMENT WITHIN EACH DATA VECTOR */
+/* JUMP IS THE INCREMENT BETWEEN DATA VECTORS */
+/* N IS THE LENGTH OF THE TRANSFORMS: */
+/* ----------------------------------- */
+/* N = (2**IP) * (3**IQ) * (5**IR) */
+/* ----------------------------------- */
+/* LOT IS THE NUMBER OF TRANSFORMS */
+/* ISIGN = +1 FOR FORWARD TRANSFORM */
+/* = -1 FOR INVERSE TRANSFORM */
+/* */
+/* WRITTEN BY CLIVE TEMPERTON */
+/* RECHERCHE EN PREVISION NUMERIQUE */
+/* ATMOSPHERIC ENVIRONMENT SERVICE, CANADA */
+/* */
+/* ---------------------------------------------------------------------- */
+/* */
+/* DEFINITION OF TRANSFORM */
+/* ----------------------- */
+/* */
+/* X(J) = SUM(K=0,...,N-1)(C(K)*EXP(ISIGN*2*I*J*K*PI/N)) */
+/* */
+/* --------------------------------------------------------------------- */
+/* */
+/* FOR A MATHEMATICAL DEVELOPMENT OF THE ALGORITHM USED, */
+/* SEE: */
+/* */
+/* C TEMPERTON : "A GENERALIZED PRIME FACTOR FFT ALGORITHM */
+/* FOR ANY N = (2**P)(3**Q)(5**R)", */
+/* SIAM J. SCI. STAT. COMP., MAY 1992. */
+/* */
+/* ---------------------------------------------------------------------- */
+
+/* Subroutine */ void gpfa_(real *a, real *b, const real *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *lot,
+ const integer *isign, const integer *npqr, integer *info)
+{
+ /* Local variables */
+ static integer i, ip, iq, ir;
+
+ ip = npqr[0];
+ iq = npqr[1];
+ ir = npqr[2];
+
+/* COMPUTE THE TRANSFORM */
+/* --------------------- */
+ i = 0;
+ if (ip > 0) {
+ gpfa2f_(a, b, trigs, inc, jump, n, &ip, lot, isign);
+ i += pow_ii(&c__2, &ip) << 1;
+ }
+ if (iq > 0) {
+ gpfa3f_(a, b, &trigs[i], inc, jump, n, &iq, lot, isign);
+ i += pow_ii(&c__3, &iq) << 1;
+ }
+ if (ir > 0) {
+ gpfa5f_(a, b, &trigs[i], inc, jump, n, &ir, lot, isign);
+ }
+
+ *info = 0;
+} /* gpfa_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa2f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa2f.c
new file mode 100644
index 0000000000000000000000000000000000000000..7a8dce389c60b77eece1985549e23862ef338454
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa2f.c
@@ -0,0 +1,1106 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+
+/* fortran version of *gpfa2* - */
+/* radix-2 section of self-sorting, in-place, generalized pfa */
+/* central radix-2 and radix-8 passes included */
+/* so that transform length can be any power of 2 */
+/* */
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void gpfa2f_(real *a, real *b, const real *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *mm, const integer *lot, const integer *isign)
+{
+ /* Initialized data */
+ static integer lvr = 1024;
+
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static real s;
+ static integer ipass, nblox;
+ static real c1;
+ static integer jstep;
+ static real c2, c3;
+ static integer m2, n2;
+ static real t0;
+ static integer m8;
+ static real t2, t1, t3, u0, u2, u1, u3;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, jj, jk, jl, jm, jn, jo, jp, la, nb, mh, kk, ll, mu, nu, laincl;
+ static real ss;
+ static integer jstepl;
+ static real co1, co2, co3;
+ static integer istart;
+ static real co4, co5, co6, co7;
+ static integer jstepx;
+ static real si1, si2, si3, si4, si5, si6, si7, aja, ajb, ajc, ajd, bja,
+ bjc, bjb, bjd, aje, ajg, ajf, ajh, bje, bjg, bjf, bjh, aji;
+ static integer jjj;
+ static real bjm, ajj;
+ static integer ink;
+ static real bjj, ajk, ajl, bji, bjk;
+ static integer inq;
+ static real ajo, bjl, bjo, ajm, ajn, ajp, bjn, bjp;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n2 = pow_ii(&c__2, mm);
+ inq = *n / n2;
+ jstepx = (n2 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+
+ m2 = 0;
+ m8 = 0;
+ if (*mm % 2 == 0) {
+ m = *mm / 2;
+ } else if (*mm % 4 == 1) {
+ m = (*mm - 1) / 2;
+ m2 = 1;
+ } else if (*mm % 4 == 3) {
+ m = (*mm - 3) / 2;
+ m8 = 1;
+ }
+ mh = (m + 1) / 2;
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (real) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+ for (nb = 0; nb < nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-4 passes */
+ mu = inq % 4;
+ if (*isign == -1) {
+ mu = 4 - mu;
+ }
+ ss = 1.f;
+ if (mu == 3) {
+ ss = -1.f;
+ }
+
+ if (mh == 0) {
+ goto L200;
+ }
+
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la << 2);
+ jstepl = jstep - ninc;
+
+/* k = 0 loop (no twiddle factors) */
+ i__1 = jstep << 2;
+ for (jjj = 0; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ a[ja + j] = t0 + t1;
+ a[jc + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ b[jc + j] = u0 - u1;
+ a[jb + j] = t2 - u3;
+ a[jd + j] = t2 + u3;
+ b[jb + j] = u2 + t3;
+ b[jd + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n2 = 4 */
+ if (n2 == 4) {
+ goto L490;
+ }
+ kk = la << 1;
+
+/* loop on nonzero k */
+ for (k = ink; ink < 0 ? k >= jstep - ink : k <= jstep - ink; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+
+/* loop along transform */
+ i__1 = jstep << 2;
+ for (jjj = k; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* dir$ ivdep,shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[jb + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jb + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jc + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jc + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jd + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jd + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la <<= 2;
+ }
+
+/* central radix-2 pass */
+L200:
+ if (m2 == 0) {
+ goto L300;
+ }
+
+ jstep = *n * *inc / (la << 1);
+ jstepl = jstep - ninc;
+
+/* k=0 loop (no twiddle factors) */
+ for (jjj = 0; jjj <= (*n - 1) * *inc; jjj += (jstep<<1)) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = aja - ajb;
+ a[ja + j] = aja + ajb;
+ a[jb + j] = t0;
+ bja = b[ja + j];
+ bjb = b[jb + j];
+ u0 = bja - bjb;
+ b[ja + j] = bja + bjb;
+ b[jb + j] = u0;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n2=2 */
+ if (n2 == 2) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+ for (k = ink; ink < 0 ? k >= jstep - ink : k <= jstep - ink; k += ink) {
+ co1 = trigs[kk];
+ si1 = s * trigs[kk + 1];
+
+/* loop along transforms */
+ i__1 = jstep << 1;
+ for (jjj = k; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+ if (kk == n2 / 2) {
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = ss * (aja - ajb);
+ a[ja + j] = aja + ajb;
+ bjb = b[jb + j];
+ bja = b[ja + j];
+ a[jb + j] = ss * (bjb - bja);
+ b[ja + j] = bja + bjb;
+ b[jb + j] = t0;
+ j += *jump;
+ }
+ } else {
+
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajb = a[jb + j];
+ t0 = aja - ajb;
+ a[ja + j] = aja + ajb;
+ bja = b[ja + j];
+ bjb = b[jb + j];
+ u0 = bja - bjb;
+ b[ja + j] = bja + bjb;
+ a[jb + j] = co1 * t0 - si1 * u0;
+ b[jb + j] = si1 * t0 + co1 * u0;
+ j += *jump;
+ }
+ }
+
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+
+ la <<= 1;
+ goto L400;
+
+/* central radix-8 pass */
+L300:
+ if (m8 == 0) {
+ goto L400;
+ }
+ jstep = *n * *inc / (la << 3);
+ jstepl = jstep - ninc;
+ mu = inq % 8;
+ if (*isign == -1) {
+ mu = 8 - mu;
+ }
+ c1 = 1.f;
+ if (mu == 3 || mu == 7) {
+ c1 = -1.f;
+ }
+ c2 = sqrtf(.5f);
+ if (mu == 3 || mu == 5) {
+ c2 = -c2;
+ }
+ c3 = c1 * c2;
+
+/* stage 1 */
+ for (k = 0; ink < 0 ? k >= jstep - ink : k <= jstep - ink; k += ink) {
+ i__1 = jstep << 3;
+ for (jjj = k; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja - aje;
+ a[ja + j] = aja + aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = c1 * (ajc - ajg);
+ a[je + j] = ajc + ajg;
+ ajb = a[jb + j];
+ ajf = a[jf + j];
+ t2 = ajb - ajf;
+ a[jc + j] = ajb + ajf;
+ ajd = a[jd + j];
+ ajh = a[jh + j];
+ t3 = ajd - ajh;
+ a[jg + j] = ajd + ajh;
+ a[jb + j] = t0;
+ a[jf + j] = t1;
+ a[jd + j] = c2 * (t2 - t3);
+ a[jh + j] = c3 * (t2 + t3);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja - bje;
+ b[ja + j] = bja + bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = c1 * (bjc - bjg);
+ b[je + j] = bjc + bjg;
+ bjb = b[jb + j];
+ bjf = b[jf + j];
+ u2 = bjb - bjf;
+ b[jc + j] = bjb + bjf;
+ bjd = b[jd + j];
+ bjh = b[jh + j];
+ u3 = bjd - bjh;
+ b[jg + j] = bjd + bjh;
+ b[jb + j] = u0;
+ b[jf + j] = u1;
+ b[jd + j] = c2 * (u2 - u3);
+ b[jh + j] = c3 * (u2 + u3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+
+/* stage 2 */
+
+/* k=0 (no twiddle factors) */
+ i__1 = jstep << 3;
+ for (jjj = 0; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja + aje;
+ t2 = aja - aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = ajc + ajg;
+ t3 = c1 * (ajc - ajg);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja + bje;
+ u2 = bja - bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = bjc + bjg;
+ u3 = c1 * (bjc - bjg);
+ a[ja + j] = t0 + t1;
+ a[je + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ b[je + j] = u0 - u1;
+ a[jc + j] = t2 - u3;
+ a[jg + j] = t2 + u3;
+ b[jc + j] = u2 + t3;
+ b[jg + j] = u2 - t3;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t0 = ajb + ajd;
+ t2 = ajb - ajd;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf - ajh;
+ t3 = ajf + ajh;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u0 = bjb + bjd;
+ u2 = bjb - bjd;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf - bjh;
+ u3 = bjf + bjh;
+ a[jb + j] = t0 - u3;
+ a[jh + j] = t0 + u3;
+ b[jb + j] = u0 + t3;
+ b[jh + j] = u0 - t3;
+ a[jd + j] = t2 + u1;
+ a[jf + j] = t2 - u1;
+ b[jd + j] = u2 - t1;
+ b[jf + j] = u2 + t1;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+ if (n2 == 8) {
+ goto L490;
+ }
+
+/* loop on nonzero k */
+ kk = la << 1;
+
+ for (k = ink; ink < 0 ? k >= jstep - ink : k <= jstep - ink; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ co5 = trigs[kk * 5]; si5 = s * trigs[kk * 5 + 1];
+ co6 = trigs[kk * 6]; si6 = s * trigs[kk * 6 + 1];
+ co7 = trigs[kk * 7]; si7 = s * trigs[kk * 7 + 1];
+
+ i__1 = jstep << 3;
+ for (jjj = k; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ j = 0;
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ aje = a[je + j];
+ t0 = aja + aje;
+ t2 = aja - aje;
+ ajc = a[jc + j];
+ ajg = a[jg + j];
+ t1 = ajc + ajg;
+ t3 = c1 * (ajc - ajg);
+ bja = b[ja + j];
+ bje = b[je + j];
+ u0 = bja + bje;
+ u2 = bja - bje;
+ bjc = b[jc + j];
+ bjg = b[jg + j];
+ u1 = bjc + bjg;
+ u3 = c1 * (bjc - bjg);
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[je + j] = co4 * (t0 - t1) - si4 * (u0 - u1);
+ b[je + j] = si4 * (t0 - t1) + co4 * (u0 - u1);
+ a[jc + j] = co2 * (t2 - u3) - si2 * (u2 + t3);
+ b[jc + j] = si2 * (t2 - u3) + co2 * (u2 + t3);
+ a[jg + j] = co6 * (t2 + u3) - si6 * (u2 - t3);
+ b[jg + j] = si6 * (t2 + u3) + co6 * (u2 - t3);
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t0 = ajb + ajd;
+ t2 = ajb - ajd;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf - ajh;
+ t3 = ajf + ajh;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u0 = bjb + bjd;
+ u2 = bjb - bjd;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf - bjh;
+ u3 = bjf + bjh;
+ a[jb + j] = co1 * (t0 - u3) - si1 * (u0 + t3);
+ b[jb + j] = si1 * (t0 - u3) + co1 * (u0 + t3);
+ a[jh + j] = co7 * (t0 + u3) - si7 * (u0 - t3);
+ b[jh + j] = si7 * (t0 + u3) + co7 * (u0 - t3);
+ a[jd + j] = co3 * (t2 + u1) - si3 * (u2 - t1);
+ b[jd + j] = si3 * (t2 + u1) + co3 * (u2 - t1);
+ a[jf + j] = co5 * (t2 - u1) - si5 * (u2 + t1);
+ b[jf + j] = si5 * (t2 - u1) + co5 * (u2 + t1);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+
+ la <<= 3;
+
+/* loop on type II radix-4 passes */
+L400:
+ mu = inq % 4;
+ if (*isign == -1) {
+ mu = 4 - mu;
+ }
+ ss = 1.f;
+ if (mu == 3) {
+ ss = -1.f;
+ }
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la << 2);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+
+/* k=0 loop (no twiddle factors) */
+ i__1 = jstep << 2;
+ for (ll = 0; i__1 < 0 ? ll >= (la - 1) * ink : ll <= (la - 1) * ink; ll += i__1) {
+
+ i__1 = (la << 2) * ink;
+ for (jjj = ll; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = ja + laincl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = je + laincl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jj + jstepl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = ji + laincl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jo + jstepl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ aji = a[ji + j];
+ ajc = aji;
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ aje = a[je + j];
+ ajb = aje;
+ a[ja + j] = t0 + t1;
+ a[ji + j] = t0 - t1;
+ b[ja + j] = u0 + u1;
+ bjc = u0 - u1;
+ bjm = b[jm + j];
+ bjd = bjm;
+ a[je + j] = t2 - u3;
+ ajd = t2 + u3;
+ bjb = u2 + t3;
+ b[jm + j] = u2 - t3;
+
+ ajg = a[jg + j];
+ t0 = ajb + ajg;
+ t2 = ajb - ajg;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf + ajh;
+ t3 = ss * (ajf - ajh);
+ ajj = a[jj + j];
+ ajg = ajj;
+ bje = b[je + j];
+ bjg = b[jg + j];
+ u0 = bje + bjg;
+ u2 = bje - bjg;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf + bjh;
+ u3 = ss * (bjf - bjh);
+ b[je + j] = bjb;
+ a[jb + j] = t0 + t1;
+ a[jj + j] = t0 - t1;
+ bjj = b[jj + j];
+ bjg = bjj;
+ b[jb + j] = u0 + u1;
+ b[jj + j] = u0 - u1;
+ a[jf + j] = t2 - u3;
+ ajh = t2 + u3;
+ b[jf + j] = u2 + t3;
+ bjh = u2 - t3;
+
+ ajk = a[jk + j];
+ t0 = ajc + ajk;
+ t2 = ajc - ajk;
+ ajl = a[jl + j];
+ t1 = ajg + ajl;
+ t3 = ss * (ajg - ajl);
+ bji = b[ji + j];
+ bjk = b[jk + j];
+ u0 = bji + bjk;
+ u2 = bji - bjk;
+ ajo = a[jo + j];
+ ajl = ajo;
+ bjl = b[jl + j];
+ u1 = bjg + bjl;
+ u3 = ss * (bjg - bjl);
+ b[ji + j] = bjc;
+ a[jc + j] = t0 + t1;
+ a[jk + j] = t0 - t1;
+ bjo = b[jo + j];
+ bjl = bjo;
+ b[jc + j] = u0 + u1;
+ b[jk + j] = u0 - u1;
+ a[jg + j] = t2 - u3;
+ a[jo + j] = t2 + u3;
+ b[jg + j] = u2 + t3;
+ b[jo + j] = u2 - t3;
+
+ ajm = a[jm + j];
+ t0 = ajm + ajl;
+ t2 = ajm - ajl;
+ ajn = a[jn + j];
+ ajp = a[jp + j];
+ t1 = ajn + ajp;
+ t3 = ss * (ajn - ajp);
+ a[jm + j] = ajd;
+ u0 = bjd + bjl;
+ u2 = bjd - bjl;
+ bjn = b[jn + j];
+ bjp = b[jp + j];
+ u1 = bjn + bjp;
+ u3 = ss * (bjn - bjp);
+ a[jn + j] = ajh;
+ a[jd + j] = t0 + t1;
+ a[jl + j] = t0 - t1;
+ b[jd + j] = u0 + u1;
+ b[jl + j] = u0 - u1;
+ b[jn + j] = bjh;
+ a[jh + j] = t2 - u3;
+ a[jp + j] = t2 + u3;
+ b[jh + j] = u2 + t3;
+ b[jp + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+
+/* finished if last pass */
+ if (ipass == m-1) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+ for (k = ink; ink < 0 ? k >= jstep - ink : k <= jstep - ink; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+
+/* double loop along first transform in block */
+ i__1 = jstep << 2;
+ for (ll = k; i__1 < 0 ? ll >= (la - 1) * ink : ll <= (la - 1) * ink; ll += i__1) {
+
+ i__1 = (la << 2) * ink;
+ for (jjj = ll; i__1 < 0 ? jjj >= (*n - 1) * *inc : jjj <= (*n - 1) * *inc; jjj += i__1) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+ for (nu = 0; nu < inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = ja + laincl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = je + laincl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jj + jstepl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = ji + laincl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jo + jstepl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* dir$ ivdep, shortloop */
+ for (l = 0; l < nvex; ++l) {
+ aja = a[ja + j];
+ ajc = a[jc + j];
+ t0 = aja + ajc;
+ t2 = aja - ajc;
+ ajb = a[jb + j];
+ ajd = a[jd + j];
+ t1 = ajb + ajd;
+ t3 = ss * (ajb - ajd);
+ aji = a[ji + j];
+ ajc = aji;
+ bja = b[ja + j];
+ bjc = b[jc + j];
+ u0 = bja + bjc;
+ u2 = bja - bjc;
+ bjb = b[jb + j];
+ bjd = b[jd + j];
+ u1 = bjb + bjd;
+ u3 = ss * (bjb - bjd);
+ aje = a[je + j];
+ ajb = aje;
+ a[ja + j] = t0 + t1;
+ b[ja + j] = u0 + u1;
+ a[je + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ bjb = si1 * (t2 - u3) + co1 * (u2 + t3);
+ bjm = b[jm + j];
+ bjd = bjm;
+ a[ji + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ bjc = si2 * (t0 - t1) + co2 * (u0 - u1);
+ ajd = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jm + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+
+ ajg = a[jg + j];
+ t0 = ajb + ajg;
+ t2 = ajb - ajg;
+ ajf = a[jf + j];
+ ajh = a[jh + j];
+ t1 = ajf + ajh;
+ t3 = ss * (ajf - ajh);
+ ajj = a[jj + j];
+ ajg = ajj;
+ bje = b[je + j];
+ bjg = b[jg + j];
+ u0 = bje + bjg;
+ u2 = bje - bjg;
+ bjf = b[jf + j];
+ bjh = b[jh + j];
+ u1 = bjf + bjh;
+ u3 = ss * (bjf - bjh);
+ b[je + j] = bjb;
+ a[jb + j] = t0 + t1;
+ b[jb + j] = u0 + u1;
+ bjj = b[jj + j];
+ bjg = bjj;
+ a[jf + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jf + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jj + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jj + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ ajh = co3 * (t2 + u3) - si3 * (u2 - t3);
+ bjh = si3 * (t2 + u3) + co3 * (u2 - t3);
+
+ ajk = a[jk + j];
+ t0 = ajc + ajk;
+ t2 = ajc - ajk;
+ ajl = a[jl + j];
+ t1 = ajg + ajl;
+ t3 = ss * (ajg - ajl);
+ bji = b[ji + j];
+ bjk = b[jk + j];
+ u0 = bji + bjk;
+ u2 = bji - bjk;
+ ajo = a[jo + j];
+ ajl = ajo;
+ bjl = b[jl + j];
+ u1 = bjg + bjl;
+ u3 = ss * (bjg - bjl);
+ b[ji + j] = bjc;
+ a[jc + j] = t0 + t1;
+ b[jc + j] = u0 + u1;
+ bjo = b[jo + j];
+ bjl = bjo;
+ a[jg + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jg + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jk + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jk + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jo + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jo + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+
+ ajm = a[jm + j];
+ t0 = ajm + ajl;
+ t2 = ajm - ajl;
+ ajn = a[jn + j];
+ ajp = a[jp + j];
+ t1 = ajn + ajp;
+ t3 = ss * (ajn - ajp);
+ a[jm + j] = ajd;
+ u0 = bjd + bjl;
+ u2 = bjd - bjl;
+ a[jn + j] = ajh;
+ bjn = b[jn + j];
+ bjp = b[jp + j];
+ u1 = bjn + bjp;
+ u3 = ss * (bjn - bjp);
+ b[jn + j] = bjh;
+ a[jd + j] = t0 + t1;
+ b[jd + j] = u0 + u1;
+ a[jh + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jh + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jl + j] = co2 * (t0 - t1) - si2 * (u0 - u1);
+ b[jl + j] = si2 * (t0 - t1) + co2 * (u0 - u1);
+ a[jp + j] = co3 * (t2 + u3) - si3 * (u2 - t3);
+ b[jp + j] = si3 * (t2 + u3) + co3 * (u2 - t3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la <<= 2;
+ }
+L490:
+ istart += nvex * *jump;
+ }
+} /* gpfa2f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa3f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa3f.c
new file mode 100644
index 0000000000000000000000000000000000000000..7058810a176dce062b5b7f2ebd57bda5d142546e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa3f.c
@@ -0,0 +1,492 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__3 = 3;
+
+/* fortran version of *gpfa3* - */
+/* radix-3 section of self-sorting, in-place */
+/* generalized PFA */
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void gpfa3f_(real *a, real *b, const real *trigs,
+ const integer *inc, const integer *jump, const integer *n, const integer *mm,
+ const integer *lot, const integer *isign)
+{
+ /* Initialized data */
+ static real sin60 = .866025403784437f;
+ static integer lvr = 128;
+
+ /* System generated locals */
+ integer i__3, i__4, i__5, i__6, i__7, i__8;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static real s;
+ static integer ipass, nblox;
+ static real c1;
+ static integer jstep, n3;
+ static real t1, t2, t3, u1, u2, u3;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, la, nb, mh, kk, ll, mu, nu, laincl, jstepl;
+ static real co1, co2;
+ static integer istart, jstepx;
+ static real si1, si2, aja, ajb, ajc, bjb, bjc, bja, ajd, bjd, aje, ajf, ajh, bje, bjf, bjh, aji, ajg, bji;
+ static integer jjj;
+ static real bjg;
+ static integer ink, inq;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n3 = pow_ii(&c__3, mm);
+ inq = *n / n3;
+ jstepx = (n3 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+ mu = inq % 3;
+ if (*isign == -1) {
+ mu = 3 - mu;
+ }
+ m = *mm;
+ mh = (m + 1) / 2;
+ s = (real) (*isign);
+ c1 = sin60;
+ if (mu == 2) {
+ c1 = -c1;
+ }
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (real) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+/* -------------------------------- */
+ for (nb = 1; nb <= nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-3 passes */
+/* ----------------------------- */
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la * 3);
+ jstepl = jstep - ninc;
+
+/* k = 0 loop (no twiddle factors) */
+/* ------------------------------- */
+ i__3 = (*n - 1) * *inc;
+ i__4 = jstep * 3;
+ for (jjj = 0; i__4 < 0 ? jjj >= i__3 : jjj <= i__3; jjj += i__4) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5f;
+ t3 = c1 * (ajb - ajc);
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5f;
+ u3 = c1 * (bjb - bjc);
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jb + j] = t2 - u3;
+ b[jb + j] = u2 + t3;
+ a[jc + j] = t2 + u3;
+ b[jc + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+
+/* finished if n3 = 3 */
+/* ------------------ */
+ if (n3 == 3) {
+ goto L490;
+ }
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__4 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+
+/* loop along transform */
+/* -------------------- */
+ i__5 = (*n - 1) * *inc;
+ i__6 = jstep * 3;
+ for (jjj = k; i__6 < 0 ? jjj >= i__5 : jjj <= i__5; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep,shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5f;
+ t3 = c1 * (ajb - ajc);
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5f;
+ u3 = c1 * (bjb - bjc);
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jb + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jb + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jc + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[jc + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la *= 3;
+ }
+
+/* loop on type II radix-3 passes */
+/* ------------------------------ */
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la * 3);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+
+/* k=0 loop (no twiddle factors) */
+/* ----------------------------- */
+ i__3 = (la - 1) * ink;
+ i__4 = jstep * 3;
+ for (ll = 0; i__4 < 0 ? ll >= i__3 : ll <= i__3; ll += i__4) {
+
+ i__6 = (*n - 1) * *inc;
+ i__5 = la * 3 * ink;
+ for (jjj = ll; i__5 < 0 ? jjj >= i__6 : jjj <= i__6; jjj += i__5) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = ja + laincl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jd + laincl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5f;
+ t3 = c1 * (ajb - ajc);
+ ajd = a[jd + j];
+ ajb = ajd;
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5f;
+ u3 = c1 * (bjb - bjc);
+ bjd = b[jd + j];
+ bjb = bjd;
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jd + j] = t2 - u3;
+ b[jd + j] = u2 + t3;
+ ajc = t2 + u3;
+ bjc = u2 - t3;
+/* ---------------------- */
+ aje = a[je + j];
+ ajf = a[jf + j];
+ t1 = aje + ajf;
+ t2 = ajb - t1 * .5f;
+ t3 = c1 * (aje - ajf);
+ ajh = a[jh + j];
+ ajf = ajh;
+ bje = b[je + j];
+ bjf = b[jf + j];
+ u1 = bje + bjf;
+ u2 = bjb - u1 * .5f;
+ u3 = c1 * (bje - bjf);
+ bjh = b[jh + j];
+ bjf = bjh;
+ a[jb + j] = ajb + t1;
+ b[jb + j] = bjb + u1;
+ a[je + j] = t2 - u3;
+ b[je + j] = u2 + t3;
+ a[jh + j] = t2 + u3;
+ b[jh + j] = u2 - t3;
+/* ---------------------- */
+ aji = a[ji + j];
+ t1 = ajf + aji;
+ ajg = a[jg + j];
+ t2 = ajg - t1 * .5f;
+ t3 = c1 * (ajf - aji);
+ t1 += ajg;
+ a[jg + j] = ajc;
+ bji = b[ji + j];
+ u1 = bjf + bji;
+ bjg = b[jg + j];
+ u2 = bjg - u1 * .5f;
+ u3 = c1 * (bjf - bji);
+ u1 += bjg;
+ b[jg + j] = bjc;
+ a[jc + j] = t1;
+ b[jc + j] = u1;
+ a[jf + j] = t2 - u3;
+ b[jf + j] = u2 + t3;
+ a[ji + j] = t2 + u3;
+ b[ji + j] = u2 - t3;
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+
+/* finished if last pass */
+/* --------------------- */
+ if (ipass == m-1) {
+ goto L490;
+ }
+
+ kk = la << 1;
+
+/* loop on nonzero k */
+/* ----------------- */
+ i__4 = jstep - ink;
+ for (k = ink; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+
+/* double loop along first transform in block */
+/* ------------------------------------------ */
+ i__5 = (la - 1) * ink;
+ i__6 = jstep * 3;
+ for (ll = k; i__6 < 0 ? ll >= i__5 : ll <= i__5; ll += i__6) {
+
+ i__7 = (*n - 1) * *inc;
+ i__8 = la * 3 * ink;
+ for (jjj = ll; i__8 < 0 ? jjj >= i__7 : jjj <= i__7; jjj += i__8) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = ja + laincl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = je + jstepl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jd + laincl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ ajc = a[jc + j];
+ t1 = ajb + ajc;
+ aja = a[ja + j];
+ t2 = aja - t1 * .5f;
+ t3 = c1 * (ajb - ajc);
+ ajd = a[jd + j];
+ ajb = ajd;
+ bjb = b[jb + j];
+ bjc = b[jc + j];
+ u1 = bjb + bjc;
+ bja = b[ja + j];
+ u2 = bja - u1 * .5f;
+ u3 = c1 * (bjb - bjc);
+ bjd = b[jd + j];
+ bjb = bjd;
+ a[ja + j] = aja + t1;
+ b[ja + j] = bja + u1;
+ a[jd + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jd + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ ajc = co2 * (t2 + u3) - si2 * (u2 - t3);
+ bjc = si2 * (t2 + u3) + co2 * (u2 - t3);
+/* ---------------------- */
+ aje = a[je + j];
+ ajf = a[jf + j];
+ t1 = aje + ajf;
+ t2 = ajb - t1 * .5f;
+ t3 = c1 * (aje - ajf);
+ ajh = a[jh + j];
+ ajf = ajh;
+ bje = b[je + j];
+ bjf = b[jf + j];
+ u1 = bje + bjf;
+ u2 = bjb - u1 * .5f;
+ u3 = c1 * (bje - bjf);
+ bjh = b[jh + j];
+ bjf = bjh;
+ a[jb + j] = ajb + t1;
+ b[jb + j] = bjb + u1;
+ a[je + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[je + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[jh + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[jh + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+/* ---------------------- */
+ aji = a[ji + j];
+ t1 = ajf + aji;
+ ajg = a[jg + j];
+ t2 = ajg - t1 * .5f;
+ t3 = c1 * (ajf - aji);
+ t1 += ajg;
+ a[jg + j] = ajc;
+ bji = b[ji + j];
+ u1 = bjf + bji;
+ bjg = b[jg + j];
+ u2 = bjg - u1 * .5f;
+ u3 = c1 * (bjf - bji);
+ u1 += bjg;
+ b[jg + j] = bjc;
+ a[jc + j] = t1;
+ b[jc + j] = u1;
+ a[jf + j] = co1 * (t2 - u3) - si1 * (u2 + t3);
+ b[jf + j] = si1 * (t2 - u3) + co1 * (u2 + t3);
+ a[ji + j] = co2 * (t2 + u3) - si2 * (u2 - t3);
+ b[ji + j] = si2 * (t2 + u3) + co2 * (u2 - t3);
+ j += *jump;
+ }
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la *= 3;
+ }
+L490:
+ istart += nvex * *jump;
+ }
+} /* gpfa3f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa5f.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa5f.c
new file mode 100644
index 0000000000000000000000000000000000000000..2fd22cb860ff6c20bbe25cafadea15d55d635c9f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/gpfa5f.c
@@ -0,0 +1,910 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__5 = 5;
+
+/* fortran version of *gpfa5* - */
+/* radix-5 section of self-sorting, in-place, */
+/* generalized pfa */
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */ void gpfa5f_(real *a, real *b, const real *trigs, const integer *inc,
+ const integer *jump, const integer *n, const integer *mm, const integer *lot, const integer *isign)
+{
+ /* Initialized data */
+ static real sin36 = .587785252292473f;
+ static real sin72 = .951056516295154f;
+ static real qrt5 = .559016994374947f;
+ static integer lvr = 128;
+
+ /* System generated locals */
+ integer i__3, i__4, i__5, i__6, i__7, i__8;
+
+ /* Local variables */
+ static integer ninc, left, nvex, j, k, l, m;
+ static real s;
+ static integer ipass, nblox;
+ static real c1, c2, c3;
+ static integer jstep, n5;
+ static real t1, t2, t3, t4, t5, t6, t7, t8, t9, u1, u2, u3, u4, u5, u6, u7, u8, u9;
+ static integer ja, jb, jc, jd, je, jf, jg, jh, ji, jj, jk, jl, jm, jn, jo, jp, jq, jr, js, jt, ju, jv, jw, jx, jy;
+ static real t10, t11, u10, u11;
+ static integer ll, mu, nu, laincl, la, nb, mh, kk;
+ static real ax, bx;
+ static integer jstepl;
+ static real co1, co2, co3;
+ static integer istart;
+ static real co4;
+ static integer jstepx;
+ static real si1, si2, si3, si4, aja, ajb, ajc, ajd, aje, bjb, bje, bjc, bjd, bja, ajf, ajk, bjf, bjk, ajg, ajj, ajh;
+ static integer jjj;
+ static real aji, ajl;
+ static integer ink;
+ static real ajq, bjg, bjj, bjh, bji;
+ static integer inq;
+ static real bjl, bjq, ajo, ajm, ajn, ajr, ajw, bjo, bjm, bjn, bjr, bjw,
+ ajt, ajs, ajx, ajp, bjt, bjs, bjx, bjp, ajv, ajy, aju, bjv, bjy, bju;
+
+/* *************************************************************** */
+/* * * */
+/* * N.B. LVR = LENGTH OF VECTOR REGISTERS, SET TO 128 FOR C90. * */
+/* * RESET TO 64 FOR OTHER CRAY MACHINES, OR TO ANY LARGE VALUE * */
+/* * (GREATER THAN OR EQUAL TO LOT) FOR A SCALAR COMPUTER. * */
+/* * * */
+/* *************************************************************** */
+
+ n5 = pow_ii(&c__5, mm);
+ inq = *n / n5;
+ jstepx = (n5 - *n) * *inc;
+ ninc = *n * *inc;
+ ink = *inc * inq;
+ mu = inq % 5;
+ if (*isign == -1) {
+ mu = 5 - mu;
+ }
+
+ m = *mm;
+ mh = (m + 1) / 2;
+ s = (real) (*isign);
+ c1 = qrt5;
+ c2 = sin72;
+ c3 = sin36;
+ if (mu == 2 || mu == 3) {
+ c1 = -c1;
+ c2 = sin36;
+ c3 = sin72;
+ }
+ if (mu == 3 || mu == 4) {
+ c2 = -c2;
+ }
+ if (mu == 2 || mu == 4) {
+ c3 = -c3;
+ }
+
+ nblox = (*lot - 1) / lvr + 1;
+ left = *lot;
+ s = (real) (*isign);
+ istart = 0;
+
+/* loop on blocks of lvr transforms */
+/* -------------------------------- */
+ for (nb = 1; nb <= nblox; ++nb) {
+
+ if (left <= lvr) {
+ nvex = left;
+ } else if (left < lvr << 1) {
+ nvex = left / 2;
+ nvex += nvex % 2;
+ } else {
+ nvex = lvr;
+ }
+ left -= nvex;
+
+ la = 1;
+
+/* loop on type I radix-5 passes */
+/* ----------------------------- */
+ for (ipass = 0; ipass < mh; ++ipass) {
+ jstep = *n * *inc / (la * 5);
+ jstepl = jstep - ninc;
+ kk = 0;
+
+/* loop on k */
+/* --------- */
+ i__3 = jstep - ink;
+ for (k = 0; ink < 0 ? k >= i__3 : k <= i__3; k += ink) {
+
+ if (k > 0) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ }
+
+/* loop along transform */
+/* -------------------- */
+ i__5 = (*n - 1) * *inc;
+ i__6 = jstep * 5;
+ for (jjj = k; i__6 < 0 ? jjj >= i__5 : jjj <= i__5; jjj += i__6) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+ if (k == 0) {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25f;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25f;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jb + j] = t8 - u11;
+ b[jb + j] = u8 + t11;
+ a[je + j] = t8 + u11;
+ b[je + j] = u8 - t11;
+ a[jc + j] = t9 - u10;
+ b[jc + j] = u9 + t10;
+ a[jd + j] = t9 + u10;
+ b[jd + j] = u9 - t10;
+ j += *jump;
+ }
+
+ } else {
+
+/* dir$ ivdep,shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25f;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25f;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jb + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jb + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[je + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[je + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jc + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jc + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jd + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jd + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+ j += *jump;
+ }
+ }
+
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la *= 5;
+ }
+
+ if (*n == 5) {
+ goto L490;
+ }
+
+/* loop on type II radix-5 passes */
+/* ------------------------------ */
+
+ for (ipass = mh; ipass < m; ++ipass) {
+ jstep = *n * *inc / (la * 5);
+ jstepl = jstep - ninc;
+ laincl = la * ink - ninc;
+ kk = 0;
+
+/* loop on k */
+/* --------- */
+ i__4 = jstep - ink;
+ for (k = 0; ink < 0 ? k >= i__4 : k <= i__4; k += ink) {
+
+ if (k > 0) {
+ co1 = trigs[kk]; si1 = s * trigs[kk + 1];
+ co2 = trigs[kk * 2]; si2 = s * trigs[kk * 2 + 1];
+ co3 = trigs[kk * 3]; si3 = s * trigs[kk * 3 + 1];
+ co4 = trigs[kk * 4]; si4 = s * trigs[kk * 4 + 1];
+ }
+
+/* double loop along first transform in block */
+/* ------------------------------------------ */
+ i__6 = (la - 1) * ink;
+ i__5 = jstep * 5;
+ for (ll = k; i__5 < 0 ? ll >= i__6 : ll <= i__6; ll += i__5) {
+
+ i__7 = (*n - 1) * *inc;
+ i__8 = la * 5 * ink;
+ for (jjj = ll; i__8 < 0 ? jjj >= i__7 : jjj <= i__7; jjj += i__8) {
+ ja = istart + jjj;
+
+/* "transverse" loop */
+/* ----------------- */
+ for (nu = 1; nu <= inq; ++nu) {
+ jb = ja + jstepl;
+ if (jb < istart) {
+ jb += ninc;
+ }
+ jc = jb + jstepl;
+ if (jc < istart) {
+ jc += ninc;
+ }
+ jd = jc + jstepl;
+ if (jd < istart) {
+ jd += ninc;
+ }
+ je = jd + jstepl;
+ if (je < istart) {
+ je += ninc;
+ }
+ jf = ja + laincl;
+ if (jf < istart) {
+ jf += ninc;
+ }
+ jg = jf + jstepl;
+ if (jg < istart) {
+ jg += ninc;
+ }
+ jh = jg + jstepl;
+ if (jh < istart) {
+ jh += ninc;
+ }
+ ji = jh + jstepl;
+ if (ji < istart) {
+ ji += ninc;
+ }
+ jj = ji + jstepl;
+ if (jj < istart) {
+ jj += ninc;
+ }
+ jk = jf + laincl;
+ if (jk < istart) {
+ jk += ninc;
+ }
+ jl = jk + jstepl;
+ if (jl < istart) {
+ jl += ninc;
+ }
+ jm = jl + jstepl;
+ if (jm < istart) {
+ jm += ninc;
+ }
+ jn = jm + jstepl;
+ if (jn < istart) {
+ jn += ninc;
+ }
+ jo = jn + jstepl;
+ if (jo < istart) {
+ jo += ninc;
+ }
+ jp = jk + laincl;
+ if (jp < istart) {
+ jp += ninc;
+ }
+ jq = jp + jstepl;
+ if (jq < istart) {
+ jq += ninc;
+ }
+ jr = jq + jstepl;
+ if (jr < istart) {
+ jr += ninc;
+ }
+ js = jr + jstepl;
+ if (js < istart) {
+ js += ninc;
+ }
+ jt = js + jstepl;
+ if (jt < istart) {
+ jt += ninc;
+ }
+ ju = jp + laincl;
+ if (ju < istart) {
+ ju += ninc;
+ }
+ jv = ju + jstepl;
+ if (jv < istart) {
+ jv += ninc;
+ }
+ jw = jv + jstepl;
+ if (jw < istart) {
+ jw += ninc;
+ }
+ jx = jw + jstepl;
+ if (jx < istart) {
+ jx += ninc;
+ }
+ jy = jx + jstepl;
+ if (jy < istart) {
+ jy += ninc;
+ }
+ j = 0;
+
+/* loop across transforms */
+/* ---------------------- */
+ if (k == 0) {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ ajf = a[jf + j];
+ ajb = ajf;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25f;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajk = a[jk + j];
+ ajc = ajk;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ bjf = b[jf + j];
+ bjb = bjf;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25f;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjk = b[jk + j];
+ bjc = bjk;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jf + j] = t8 - u11;
+ b[jf + j] = u8 + t11;
+ aje = t8 + u11;
+ bje = u8 - t11;
+ a[jk + j] = t9 - u10;
+ b[jk + j] = u9 + t10;
+ ajd = t9 + u10;
+ bjd = u9 - t10;
+/* ---------------------- */
+ ajg = a[jg + j];
+ ajj = a[jj + j];
+ t1 = ajg + ajj;
+ ajh = a[jh + j];
+ aji = a[ji + j];
+ t2 = ajh + aji;
+ t3 = ajg - ajj;
+ t4 = ajh - aji;
+ ajl = a[jl + j];
+ ajh = ajl;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajb - t5 * .25f;
+ a[jb + j] = ajb + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajq = a[jq + j];
+ aji = ajq;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjg = b[jg + j];
+ bjj = b[jj + j];
+ u1 = bjg + bjj;
+ bjh = b[jh + j];
+ bji = b[ji + j];
+ u2 = bjh + bji;
+ u3 = bjg - bjj;
+ u4 = bjh - bji;
+ bjl = b[jl + j];
+ bjh = bjl;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjb - u5 * .25f;
+ b[jb + j] = bjb + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjq = b[jq + j];
+ bji = bjq;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jg + j] = t8 - u11;
+ b[jg + j] = u8 + t11;
+ ajj = t8 + u11;
+ bjj = u8 - t11;
+ a[jl + j] = t9 - u10;
+ b[jl + j] = u9 + t10;
+ a[jq + j] = t9 + u10;
+ b[jq + j] = u9 - t10;
+/* ---------------------- */
+ ajo = a[jo + j];
+ t1 = ajh + ajo;
+ ajm = a[jm + j];
+ ajn = a[jn + j];
+ t2 = ajm + ajn;
+ t3 = ajh - ajo;
+ t4 = ajm - ajn;
+ ajr = a[jr + j];
+ ajn = ajr;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajc - t5 * .25f;
+ a[jc + j] = ajc + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajw = a[jw + j];
+ ajo = ajw;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjo = b[jo + j];
+ u1 = bjh + bjo;
+ bjm = b[jm + j];
+ bjn = b[jn + j];
+ u2 = bjm + bjn;
+ u3 = bjh - bjo;
+ u4 = bjm - bjn;
+ bjr = b[jr + j];
+ bjn = bjr;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjc - u5 * .25f;
+ b[jc + j] = bjc + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjw = b[jw + j];
+ bjo = bjw;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jh + j] = t8 - u11;
+ b[jh + j] = u8 + t11;
+ a[jw + j] = t8 + u11;
+ b[jw + j] = u8 - t11;
+ a[jm + j] = t9 - u10;
+ b[jm + j] = u9 + t10;
+ a[jr + j] = t9 + u10;
+ b[jr + j] = u9 - t10;
+/* ---------------------- */
+ ajt = a[jt + j];
+ t1 = aji + ajt;
+ ajs = a[js + j];
+ t2 = ajn + ajs;
+ t3 = aji - ajt;
+ t4 = ajn - ajs;
+ ajx = a[jx + j];
+ ajt = ajx;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ ajp = a[jp + j];
+ t7 = ajp - t5 * .25f;
+ ax = ajp + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[jp + j] = ajd;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[jd + j] = ax;
+ bjt = b[jt + j];
+ u1 = bji + bjt;
+ bjs = b[js + j];
+ u2 = bjn + bjs;
+ u3 = bji - bjt;
+ u4 = bjn - bjs;
+ bjx = b[jx + j];
+ bjt = bjx;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bjp = b[jp + j];
+ u7 = bjp - u5 * .25f;
+ bx = bjp + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[jp + j] = bjd;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[jd + j] = bx;
+ a[ji + j] = t8 - u11;
+ b[ji + j] = u8 + t11;
+ a[jx + j] = t8 + u11;
+ b[jx + j] = u8 - t11;
+ a[jn + j] = t9 - u10;
+ b[jn + j] = u9 + t10;
+ a[js + j] = t9 + u10;
+ b[js + j] = u9 - t10;
+/* ---------------------- */
+ ajv = a[jv + j];
+ ajy = a[jy + j];
+ t1 = ajv + ajy;
+ t2 = ajo + ajt;
+ t3 = ajv - ajy;
+ t4 = ajo - ajt;
+ a[jv + j] = ajj;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aju = a[ju + j];
+ t7 = aju - t5 * .25f;
+ ax = aju + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[ju + j] = aje;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[je + j] = ax;
+ bjv = b[jv + j];
+ bjy = b[jy + j];
+ u1 = bjv + bjy;
+ u2 = bjo + bjt;
+ u3 = bjv - bjy;
+ u4 = bjo - bjt;
+ b[jv + j] = bjj;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bju = b[ju + j];
+ u7 = bju - u5 * .25f;
+ bx = bju + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[ju + j] = bje;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[je + j] = bx;
+ a[jj + j] = t8 - u11;
+ b[jj + j] = u8 + t11;
+ a[jy + j] = t8 + u11;
+ b[jy + j] = u8 - t11;
+ a[jo + j] = t9 - u10;
+ b[jo + j] = u9 + t10;
+ a[jt + j] = t9 + u10;
+ b[jt + j] = u9 - t10;
+ j += *jump;
+ }
+
+ } else {
+
+/* dir$ ivdep, shortloop */
+ for (l = 1; l <= nvex; ++l) {
+ ajb = a[jb + j];
+ aje = a[je + j];
+ t1 = ajb + aje;
+ ajc = a[jc + j];
+ ajd = a[jd + j];
+ t2 = ajc + ajd;
+ t3 = ajb - aje;
+ t4 = ajc - ajd;
+ ajf = a[jf + j];
+ ajb = ajf;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aja = a[ja + j];
+ t7 = aja - t5 * .25f;
+ a[ja + j] = aja + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajk = a[jk + j];
+ ajc = ajk;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjb = b[jb + j];
+ bje = b[je + j];
+ u1 = bjb + bje;
+ bjc = b[jc + j];
+ bjd = b[jd + j];
+ u2 = bjc + bjd;
+ u3 = bjb - bje;
+ u4 = bjc - bjd;
+ bjf = b[jf + j];
+ bjb = bjf;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bja = b[ja + j];
+ u7 = bja - u5 * .25f;
+ b[ja + j] = bja + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjk = b[jk + j];
+ bjc = bjk;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jf + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jf + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ aje = co4 * (t8 + u11) - si4 * (u8 - t11);
+ bje = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jk + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jk + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ ajd = co3 * (t9 + u10) - si3 * (u9 - t10);
+ bjd = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajg = a[jg + j];
+ ajj = a[jj + j];
+ t1 = ajg + ajj;
+ ajh = a[jh + j];
+ aji = a[ji + j];
+ t2 = ajh + aji;
+ t3 = ajg - ajj;
+ t4 = ajh - aji;
+ ajl = a[jl + j];
+ ajh = ajl;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajb - t5 * .25f;
+ a[jb + j] = ajb + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajq = a[jq + j];
+ aji = ajq;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjg = b[jg + j];
+ bjj = b[jj + j];
+ u1 = bjg + bjj;
+ bjh = b[jh + j];
+ bji = b[ji + j];
+ u2 = bjh + bji;
+ u3 = bjg - bjj;
+ u4 = bjh - bji;
+ bjl = b[jl + j];
+ bjh = bjl;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjb - u5 * .25f;
+ b[jb + j] = bjb + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjq = b[jq + j];
+ bji = bjq;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jg + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jg + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ ajj = co4 * (t8 + u11) - si4 * (u8 - t11);
+ bjj = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jl + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jl + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jq + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jq + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajo = a[jo + j];
+ t1 = ajh + ajo;
+ ajm = a[jm + j];
+ ajn = a[jn + j];
+ t2 = ajm + ajn;
+ t3 = ajh - ajo;
+ t4 = ajm - ajn;
+ ajr = a[jr + j];
+ ajn = ajr;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ t7 = ajc - t5 * .25f;
+ a[jc + j] = ajc + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ ajw = a[jw + j];
+ ajo = ajw;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ bjo = b[jo + j];
+ u1 = bjh + bjo;
+ bjm = b[jm + j];
+ bjn = b[jn + j];
+ u2 = bjm + bjn;
+ u3 = bjh - bjo;
+ u4 = bjm - bjn;
+ bjr = b[jr + j];
+ bjn = bjr;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ u7 = bjc - u5 * .25f;
+ b[jc + j] = bjc + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ bjw = b[jw + j];
+ bjo = bjw;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ a[jh + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jh + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jw + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jw + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jm + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jm + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jr + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jr + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajt = a[jt + j];
+ t1 = aji + ajt;
+ ajs = a[js + j];
+ t2 = ajn + ajs;
+ t3 = aji - ajt;
+ t4 = ajn - ajs;
+ ajx = a[jx + j];
+ ajt = ajx;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ ajp = a[jp + j];
+ t7 = ajp - t5 * .25f;
+ ax = ajp + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[jp + j] = ajd;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[jd + j] = ax;
+ bjt = b[jt + j];
+ u1 = bji + bjt;
+ bjs = b[js + j];
+ u2 = bjn + bjs;
+ u3 = bji - bjt;
+ u4 = bjn - bjs;
+ bjx = b[jx + j];
+ bjt = bjx;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bjp = b[jp + j];
+ u7 = bjp - u5 * .25f;
+ bx = bjp + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[jp + j] = bjd;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[jd + j] = bx;
+ a[ji + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[ji + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jx + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jx + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jn + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jn + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[js + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[js + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+/* ---------------------- */
+ ajv = a[jv + j];
+ ajy = a[jy + j];
+ t1 = ajv + ajy;
+ t2 = ajo + ajt;
+ t3 = ajv - ajy;
+ t4 = ajo - ajt;
+ a[jv + j] = ajj;
+ t5 = t1 + t2;
+ t6 = c1 * (t1 - t2);
+ aju = a[ju + j];
+ t7 = aju - t5 * .25f;
+ ax = aju + t5;
+ t8 = t7 + t6;
+ t9 = t7 - t6;
+ a[ju + j] = aje;
+ t10 = c3 * t3 - c2 * t4;
+ t11 = c2 * t3 + c3 * t4;
+ a[je + j] = ax;
+ bjv = b[jv + j];
+ bjy = b[jy + j];
+ u1 = bjv + bjy;
+ u2 = bjo + bjt;
+ u3 = bjv - bjy;
+ u4 = bjo - bjt;
+ b[jv + j] = bjj;
+ u5 = u1 + u2;
+ u6 = c1 * (u1 - u2);
+ bju = b[ju + j];
+ u7 = bju - u5 * .25f;
+ bx = bju + u5;
+ u8 = u7 + u6;
+ u9 = u7 - u6;
+ b[ju + j] = bje;
+ u10 = c3 * u3 - c2 * u4;
+ u11 = c2 * u3 + c3 * u4;
+ b[je + j] = bx;
+ a[jj + j] = co1 * (t8 - u11) - si1 * (u8 + t11);
+ b[jj + j] = si1 * (t8 - u11) + co1 * (u8 + t11);
+ a[jy + j] = co4 * (t8 + u11) - si4 * (u8 - t11);
+ b[jy + j] = si4 * (t8 + u11) + co4 * (u8 - t11);
+ a[jo + j] = co2 * (t9 - u10) - si2 * (u9 + t10);
+ b[jo + j] = si2 * (t9 - u10) + co2 * (u9 + t10);
+ a[jt + j] = co3 * (t9 + u10) - si3 * (u9 - t10);
+ b[jt + j] = si3 * (t9 + u10) + co3 * (u9 - t10);
+ j += *jump;
+ }
+ }
+
+ ja += jstepx;
+ if (ja < istart) {
+ ja += ninc;
+ }
+ }
+ }
+ }
+ kk += la << 1;
+ }
+ la *= 5;
+ }
+L490:
+ istart += nvex * *jump;
+ }
+} /* gpfa5f_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/i_dnnt.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/i_dnnt.c
new file mode 100644
index 0000000000000000000000000000000000000000..fe598ef3744d3363d3a5f7a3a5c4e6d5b5f50fbb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/i_dnnt.c
@@ -0,0 +1,13 @@
+#include "f2c.h"
+#include "netlib.h"
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h> /* for abort() */
+
+int i_dnnt(const double *x)
+{
+ (void)x;
+ abort();
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.c
new file mode 100644
index 0000000000000000000000000000000000000000..dad88751a02ad74ff504df4c8fa73d61ff64a945
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+
+integer idamax_(const integer *n, const doublereal *dx, const integer *incx)
+{
+ /* System generated locals */
+ integer ret_val = 1;
+
+ /* Local variables */
+ static doublereal maxv;
+ static integer i, ix;
+
+/* finds the index of element having max. absolute value. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n < 1 || *incx <= 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ return 1;
+ }
+ maxv = abs(dx[0]);
+/* code for increment equal to 1 */
+ if (*incx == 1) {
+ for (i = 1; i < *n; ++i)
+ if (abs(dx[i]) > maxv) {
+ ret_val = i+1;
+ maxv = abs(dx[i]);
+ }
+ }
+/* code for increment not equal to 1 */
+ else {
+ ix = *incx;
+ for (i = 1; i < *n; ++i, ix += *incx)
+ if (abs(dx[ix]) > maxv) {
+ ret_val = i+1;
+ maxv = abs(dx[ix]);
+ }
+ }
+ return ret_val;
+} /* idamax_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.f
new file mode 100644
index 0000000000000000000000000000000000000000..59d80dc41ca7fed968ead305eaccd44bbab288f7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/idamax.f
@@ -0,0 +1,39 @@
+ integer function idamax(n,dx,incx)
+c
+c finds the index of element having max. absolute value.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dmax
+ integer i,incx,ix,n
+c
+ idamax = 0
+ if( n.lt.1 .or. incx.le.0 ) return
+ idamax = 1
+ if(n.eq.1)return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ dmax = dabs(dx(1))
+ ix = ix + incx
+ do 10 i = 2,n
+ if(dabs(dx(ix)).le.dmax) go to 5
+ idamax = i
+ dmax = dabs(dx(ix))
+ 5 ix = ix + incx
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 dmax = dabs(dx(1))
+ do 30 i = 2,n
+ if(dabs(dx(i)).le.dmax) go to 30
+ idamax = i
+ dmax = dabs(dx(i))
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.c
new file mode 100644
index 0000000000000000000000000000000000000000..5ef545afee48b555fbd3ce27863e655bf99d087b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.c
@@ -0,0 +1,549 @@
+#include "f2c.h"
+#include "netlib.h"
+
+integer ilaenv_(ispec, name, opts, n1, n2, n3, n4)
+const integer *ispec;
+const char *name, *opts;
+const integer *n1, *n2, *n3, *n4;
+{
+ /* Local variables */
+ static integer i;
+ static logical cname, sname;
+ static integer nbmin;
+ static char c1[1], c2[2], c3[3], c4[2];
+ static integer ic, nb, iz, nx;
+ static char subnam[6];
+
+ (void)opts; (void)n3;
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+
+/* ILAENV is called from the LAPACK routines to choose problem-dependent */
+/* parameters for the local environment. See ISPEC for a description of */
+/* the parameters. */
+
+/* This version provides a set of parameters which should give good, */
+/* but not optimal, performance on many of the currently available */
+/* computers. Users are encouraged to modify this subroutine to set */
+/* the tuning parameters for their particular machine using the option */
+/* and problem size information in the arguments. */
+
+/* This routine will not function correctly if it is converted to all */
+/* lower case. Converting it to all upper case is allowed. */
+
+/* Arguments */
+/* ========= */
+
+/* ISPEC (input) INTEGER */
+/* Specifies the parameter to be returned as the value of */
+/* ILAENV. */
+/* = 1: the optimal blocksize; if this value is 1, an unblocked */
+/* algorithm will give the best performance. */
+/* = 2: the minimum block size for which the block routine */
+/* should be used; if the usable block size is less than */
+/* this value, an unblocked routine should be used. */
+/* = 3: the crossover point (in a block routine, for N less */
+/* than this value, an unblocked routine should be used) */
+/* = 4: the number of shifts, used in the nonsymmetric */
+/* eigenvalue routines */
+/* = 5: the minimum column dimension for blocking to be used; */
+/* rectangular blocks must have dimension at least k by m, */
+/* where k is given by ILAENV(2,...) and m by ILAENV(5,...) */
+/* = 6: the crossover point for the SVD (when reducing an m by n */
+/* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds */
+/* this value, a QR factorization is used first to reduce */
+/* the matrix to a triangular form.) */
+/* = 7: the number of processors */
+/* = 8: the crossover point for the multishift QR and QZ methods */
+/* for nonsymmetric eigenvalue problems. */
+
+/* NAME (input) CHARACTER*(*) */
+/* The name of the calling subroutine, in either upper case or */
+/* lower case. */
+
+/* OPTS (input) CHARACTER*(*) */
+/* The character options to the subroutine NAME, concatenated */
+/* into a single character string. For example, UPLO = 'U', */
+/* TRANS = 'T', and DIAG = 'N' for a triangular routine would */
+/* be specified as OPTS = 'UTN'. */
+
+/* N1 (input) INTEGER */
+/* N2 (input) INTEGER */
+/* N3 (input) INTEGER */
+/* N4 (input) INTEGER */
+/* Problem dimensions for the subroutine NAME; these may not all */
+/* be required. */
+
+/* (ILAENV) (output) INTEGER */
+/* >= 0: the value of the parameter specified by ISPEC */
+/* < 0: if ILAENV = -k, the k-th argument had an illegal value. */
+
+/* Further Details */
+/* =============== */
+
+/* The following conventions have been used when calling ILAENV from the */
+/* LAPACK routines: */
+/* 1) OPTS is a concatenation of all of the character options to */
+/* subroutine NAME, in the same order that they appear in the */
+/* argument list for NAME, even if they are not used in determining */
+/* the value of the parameter specified by ISPEC. */
+/* 2) The problem dimensions N1, N2, N3, N4 are specified in the order */
+/* that they appear in the argument list for NAME. N1 is used */
+/* first, N2 second, and so on, and unused problem dimensions are */
+/* passed a value of -1. */
+/* 3) The parameter value returned by ILAENV is checked for validity in */
+/* the calling subroutine. For example, ILAENV is used to retrieve */
+/* the optimal blocksize for STRTRI as follows: */
+
+/* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) */
+/* IF( NB.LE.1 ) NB = MAX( 1, N ) */
+
+/* ===================================================================== */
+
+ switch ((int)*ispec) {
+ case 1: goto L100;
+ case 2: goto L100;
+ case 3: goto L100;
+ case 4: goto L400;
+ case 5: goto L500;
+ case 6: goto L600;
+ case 7: goto L700;
+ case 8: goto L800;
+ }
+
+/* Invalid value for ISPEC */
+
+ return -1;
+
+L100:
+
+/* Convert NAME to upper case if the first character is lower case. */
+
+ s_copy(subnam, name, 6L, 6L);
+ ic = *subnam;
+ iz = 'Z';
+ if (iz == 90 || iz == 122) {
+
+/* ASCII character set */
+
+ if (ic >= 97 && ic <= 122) {
+ *subnam = (char) (ic - 32);
+ for (i = 2; i <= 6; ++i) {
+ ic = (integer) subnam[i - 1];
+ if (ic >= 97 && ic <= 122) {
+ subnam[i - 1] = (char) (ic - 32);
+ }
+ }
+ }
+
+ } else if (iz == 233 || iz == 169) {
+
+/* EBCDIC character set */
+
+ if ((ic >= 129 && ic <= 137) || (ic >= 145 && ic <= 153) || (ic >= 162 && ic <= 169)) {
+ *subnam = (char) (ic + 64);
+ for (i = 2; i <= 6; ++i) {
+ ic = (integer) subnam[i - 1];
+ if ((ic >= 129 && ic <= 137) || (ic >= 145 && ic <= 153) || (ic >= 162 && ic <= 169)) {
+ subnam[i - 1] = (char) (ic + 64);
+ }
+ }
+ }
+
+ } else if (iz == 218 || iz == 250) {
+
+/* Prime machines: ASCII+128 */
+
+ if (ic >= 225 && ic <= 250) {
+ *subnam = (char) (ic - 32);
+ for (i = 2; i <= 6; ++i) {
+ ic = (integer) subnam[i - 1];
+ if (ic >= 225 && ic <= 250) {
+ subnam[i - 1] = (char) (ic - 32);
+ }
+ }
+ }
+ }
+
+ *c1 = *subnam;
+ sname = *c1 == 'S' || *c1 == 'D';
+ cname = *c1 == 'C' || *c1 == 'Z';
+ if (! (cname || sname)) {
+ return 1;
+ }
+ s_copy(c2, subnam + 1, 2L, 2L);
+ s_copy(c3, subnam + 3, 3L, 3L);
+ s_copy(c4, c3 + 1, 2L, 2L);
+
+ switch ((int)*ispec) {
+ case 1: goto L110;
+ case 2: goto L200;
+ case 3: goto L300;
+ }
+
+L110:
+
+/* ISPEC = 1: block size */
+
+/* In these examples, separate code is provided for setting NB for */
+/* real and complex. We assume that NB will take the same value in */
+/* single or double precision. */
+
+ nb = 1;
+
+ if (s_cmp(c2, "GE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if (s_cmp(c3, "QRF", 3L, 3L) == 0 ||
+ s_cmp(c3, "RQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "LQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "QLF", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "HRD", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "BRD", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "TRI", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "PO", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "SY", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if (sname && s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nb = 1;
+ } else if (sname && s_cmp(c3, "GST", 3L, 3L) == 0) {
+ nb = 64;
+ }
+ } else if (cname && s_cmp(c2, "HE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ nb = 64;
+ } else if (s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nb = 1;
+ } else if (s_cmp(c3, "GST", 3L, 3L) == 0) {
+ nb = 64;
+ }
+ } else if (sname && s_cmp(c2, "OR", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nb = 32;
+ }
+ } else if (*c3 == 'M') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nb = 32;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nb = 32;
+ }
+ } else if (*c3 == 'M') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nb = 32;
+ }
+ }
+ } else if (s_cmp(c2, "GB", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "PB", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "TR", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRI", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "LA", 2L, 2L) == 0) {
+ if (s_cmp(c3, "UUM", 3L, 3L) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (sname && s_cmp(c2, "ST", 2L, 2L) == 0) {
+ if (s_cmp(c3, "EBZ", 3L, 3L) == 0) {
+ nb = 1;
+ }
+ }
+ return nb;
+
+L200:
+
+/* ISPEC = 2: minimum block size */
+
+ nbmin = 2;
+ if (s_cmp(c2, "GE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "QRF", 3L, 3L) == 0 ||
+ s_cmp(c3, "RQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "LQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "QLF", 3L, 3L) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "HRD", 3L, 3L) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "BRD", 3L, 3L) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "TRI", 3L, 3L) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ }
+ } else if (s_cmp(c2, "SY", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRF", 3L, 3L) == 0) {
+ if (sname) {
+ nbmin = 8;
+ } else {
+ nbmin = 8;
+ }
+ } else if (sname && s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nbmin = 2;
+ }
+ } else if (cname && s_cmp(c2, "HE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nbmin = 2;
+ }
+ } else if (sname && s_cmp(c2, "OR", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nbmin = 2;
+ }
+ } else if (*c3 == 'M') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nbmin = 2;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nbmin = 2;
+ }
+ } else if (*c3 == 'M') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nbmin = 2;
+ }
+ }
+ }
+ return nbmin;
+
+L300:
+
+/* ISPEC = 3: crossover point */
+
+ nx = 0;
+ if (s_cmp(c2, "GE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "QRF", 3L, 3L) == 0 ||
+ s_cmp(c3, "RQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "LQF", 3L, 3L) == 0 ||
+ s_cmp(c3, "QLF", 3L, 3L) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "HRD", 3L, 3L) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "BRD", 3L, 3L) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ }
+ } else if (s_cmp(c2, "SY", 2L, 2L) == 0) {
+ if (sname && s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nx = 1;
+ }
+ } else if (cname && s_cmp(c2, "HE", 2L, 2L) == 0) {
+ if (s_cmp(c3, "TRD", 3L, 3L) == 0) {
+ nx = 1;
+ }
+ } else if (sname && s_cmp(c2, "OR", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nx = 128;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", 2L, 2L) == 0) {
+ if (*c3 == 'G') {
+ if (s_cmp(c4, "QR", 2L, 2L) == 0 ||
+ s_cmp(c4, "RQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "LQ", 2L, 2L) == 0 ||
+ s_cmp(c4, "QL", 2L, 2L) == 0 ||
+ s_cmp(c4, "HR", 2L, 2L) == 0 ||
+ s_cmp(c4, "TR", 2L, 2L) == 0 ||
+ s_cmp(c4, "BR", 2L, 2L) == 0) {
+ nx = 128;
+ }
+ }
+ }
+ return nx;
+
+L400:
+
+/* ISPEC = 4: number of shifts (used by xHSEQR) */
+
+ return 6;
+
+L500:
+
+/* ISPEC = 5: minimum column dimension (not used) */
+
+ return 2;
+
+L600:
+
+/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */
+
+ return (integer) ((real) min(*n1,*n2) * 1.6f);
+
+L700:
+
+/* ISPEC = 7: number of processors (not used) */
+
+ return 1;
+
+L800:
+
+/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */
+
+ return 50;
+
+} /* ilaenv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.f
new file mode 100644
index 0000000000000000000000000000000000000000..e3d296a88014fbbc81333113ecd7e0a770b20527
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ilaenv.f
@@ -0,0 +1,506 @@
+ INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
+ $ N4 )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER*( * ) NAME, OPTS
+ INTEGER ISPEC, N1, N2, N3, N4
+* ..
+*
+* Purpose
+* =======
+*
+* ILAENV is called from the LAPACK routines to choose problem-dependent
+* parameters for the local environment. See ISPEC for a description of
+* the parameters.
+*
+* This version provides a set of parameters which should give good,
+* but not optimal, performance on many of the currently available
+* computers. Users are encouraged to modify this subroutine to set
+* the tuning parameters for their particular machine using the option
+* and problem size information in the arguments.
+*
+* This routine will not function correctly if it is converted to all
+* lower case. Converting it to all upper case is allowed.
+*
+* Arguments
+* =========
+*
+* ISPEC (input) INTEGER
+* Specifies the parameter to be returned as the value of
+* ILAENV.
+* = 1: the optimal blocksize; if this value is 1, an unblocked
+* algorithm will give the best performance.
+* = 2: the minimum block size for which the block routine
+* should be used; if the usable block size is less than
+* this value, an unblocked routine should be used.
+* = 3: the crossover point (in a block routine, for N less
+* than this value, an unblocked routine should be used)
+* = 4: the number of shifts, used in the nonsymmetric
+* eigenvalue routines
+* = 5: the minimum column dimension for blocking to be used;
+* rectangular blocks must have dimension at least k by m,
+* where k is given by ILAENV(2,...) and m by ILAENV(5,...)
+* = 6: the crossover point for the SVD (when reducing an m by n
+* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
+* this value, a QR factorization is used first to reduce
+* the matrix to a triangular form.)
+* = 7: the number of processors
+* = 8: the crossover point for the multishift QR and QZ methods
+* for nonsymmetric eigenvalue problems.
+*
+* NAME (input) CHARACTER*(*)
+* The name of the calling subroutine, in either upper case or
+* lower case.
+*
+* OPTS (input) CHARACTER*(*)
+* The character options to the subroutine NAME, concatenated
+* into a single character string. For example, UPLO = 'U',
+* TRANS = 'T', and DIAG = 'N' for a triangular routine would
+* be specified as OPTS = 'UTN'.
+*
+* N1 (input) INTEGER
+* N2 (input) INTEGER
+* N3 (input) INTEGER
+* N4 (input) INTEGER
+* Problem dimensions for the subroutine NAME; these may not all
+* be required.
+*
+* (ILAENV) (output) INTEGER
+* >= 0: the value of the parameter specified by ISPEC
+* < 0: if ILAENV = -k, the k-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* The following conventions have been used when calling ILAENV from the
+* LAPACK routines:
+* 1) OPTS is a concatenation of all of the character options to
+* subroutine NAME, in the same order that they appear in the
+* argument list for NAME, even if they are not used in determining
+* the value of the parameter specified by ISPEC.
+* 2) The problem dimensions N1, N2, N3, N4 are specified in the order
+* that they appear in the argument list for NAME. N1 is used
+* first, N2 second, and so on, and unused problem dimensions are
+* passed a value of -1.
+* 3) The parameter value returned by ILAENV is checked for validity in
+* the calling subroutine. For example, ILAENV is used to retrieve
+* the optimal blocksize for STRTRI as follows:
+*
+* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
+* IF( NB.LE.1 ) NB = MAX( 1, N )
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL CNAME, SNAME
+ CHARACTER*1 C1
+ CHARACTER*2 C2, C4
+ CHARACTER*3 C3
+ CHARACTER*6 SUBNAM
+ INTEGER I, IC, IZ, NB, NBMIN, NX
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CHAR, ICHAR, INT, MIN, REAL
+* ..
+* .. Executable Statements ..
+*
+ GO TO ( 100, 100, 100, 400, 500, 600, 700, 800 ) ISPEC
+*
+* Invalid value for ISPEC
+*
+ ILAENV = -1
+ RETURN
+*
+ 100 CONTINUE
+*
+* Convert NAME to upper case if the first character is lower case.
+*
+ ILAENV = 1
+ SUBNAM = NAME
+ IC = ICHAR( SUBNAM( 1:1 ) )
+ IZ = ICHAR( 'Z' )
+ IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN
+*
+* ASCII character set
+*
+ IF( IC.GE.97 .AND. IC.LE.122 ) THEN
+ SUBNAM( 1:1 ) = CHAR( IC-32 )
+ DO 10 I = 2, 6
+ IC = ICHAR( SUBNAM( I:I ) )
+ IF( IC.GE.97 .AND. IC.LE.122 )
+ $ SUBNAM( I:I ) = CHAR( IC-32 )
+ 10 CONTINUE
+ END IF
+*
+ ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN
+*
+* EBCDIC character set
+*
+ IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+ $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+ $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN
+ SUBNAM( 1:1 ) = CHAR( IC+64 )
+ DO 20 I = 2, 6
+ IC = ICHAR( SUBNAM( I:I ) )
+ IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR.
+ $ ( IC.GE.145 .AND. IC.LE.153 ) .OR.
+ $ ( IC.GE.162 .AND. IC.LE.169 ) )
+ $ SUBNAM( I:I ) = CHAR( IC+64 )
+ 20 CONTINUE
+ END IF
+*
+ ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN
+*
+* Prime machines: ASCII+128
+*
+ IF( IC.GE.225 .AND. IC.LE.250 ) THEN
+ SUBNAM( 1:1 ) = CHAR( IC-32 )
+ DO 30 I = 2, 6
+ IC = ICHAR( SUBNAM( I:I ) )
+ IF( IC.GE.225 .AND. IC.LE.250 )
+ $ SUBNAM( I:I ) = CHAR( IC-32 )
+ 30 CONTINUE
+ END IF
+ END IF
+*
+ C1 = SUBNAM( 1:1 )
+ SNAME = C1.EQ.'S' .OR. C1.EQ.'D'
+ CNAME = C1.EQ.'C' .OR. C1.EQ.'Z'
+ IF( .NOT.( CNAME .OR. SNAME ) )
+ $ RETURN
+ C2 = SUBNAM( 2:3 )
+ C3 = SUBNAM( 4:6 )
+ C4 = C3( 2:3 )
+*
+ GO TO ( 110, 200, 300 ) ISPEC
+*
+ 110 CONTINUE
+*
+* ISPEC = 1: block size
+*
+* In these examples, separate code is provided for setting NB for
+* real and complex. We assume that NB will take the same value in
+* single or double precision.
+*
+ NB = 1
+*
+ IF( C2.EQ.'GE' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
+ $ C3.EQ.'QLF' ) THEN
+ IF( SNAME ) THEN
+ NB = 32
+ ELSE
+ NB = 32
+ END IF
+ ELSE IF( C3.EQ.'HRD' ) THEN
+ IF( SNAME ) THEN
+ NB = 32
+ ELSE
+ NB = 32
+ END IF
+ ELSE IF( C3.EQ.'BRD' ) THEN
+ IF( SNAME ) THEN
+ NB = 32
+ ELSE
+ NB = 32
+ END IF
+ ELSE IF( C3.EQ.'TRI' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'PO' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'SY' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
+ NB = 1
+ ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN
+ NB = 64
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ NB = 64
+ ELSE IF( C3.EQ.'TRD' ) THEN
+ NB = 1
+ ELSE IF( C3.EQ.'GST' ) THEN
+ NB = 64
+ END IF
+ ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NB = 32
+ END IF
+ ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NB = 32
+ END IF
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NB = 32
+ END IF
+ ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NB = 32
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'GB' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ IF( N4.LE.64 ) THEN
+ NB = 1
+ ELSE
+ NB = 32
+ END IF
+ ELSE
+ IF( N4.LE.64 ) THEN
+ NB = 1
+ ELSE
+ NB = 32
+ END IF
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'PB' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ IF( N2.LE.64 ) THEN
+ NB = 1
+ ELSE
+ NB = 32
+ END IF
+ ELSE
+ IF( N2.LE.64 ) THEN
+ NB = 1
+ ELSE
+ NB = 32
+ END IF
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'TR' ) THEN
+ IF( C3.EQ.'TRI' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'LA' ) THEN
+ IF( C3.EQ.'UUM' ) THEN
+ IF( SNAME ) THEN
+ NB = 64
+ ELSE
+ NB = 64
+ END IF
+ END IF
+ ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN
+ IF( C3.EQ.'EBZ' ) THEN
+ NB = 1
+ END IF
+ END IF
+ ILAENV = NB
+ RETURN
+*
+ 200 CONTINUE
+*
+* ISPEC = 2: minimum block size
+*
+ NBMIN = 2
+ IF( C2.EQ.'GE' ) THEN
+ IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
+ $ C3.EQ.'QLF' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 2
+ ELSE
+ NBMIN = 2
+ END IF
+ ELSE IF( C3.EQ.'HRD' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 2
+ ELSE
+ NBMIN = 2
+ END IF
+ ELSE IF( C3.EQ.'BRD' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 2
+ ELSE
+ NBMIN = 2
+ END IF
+ ELSE IF( C3.EQ.'TRI' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 2
+ ELSE
+ NBMIN = 2
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'SY' ) THEN
+ IF( C3.EQ.'TRF' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 8
+ ELSE
+ NBMIN = 8
+ END IF
+ ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN
+ NBMIN = 2
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
+ IF( C3.EQ.'TRD' ) THEN
+ NBMIN = 2
+ END IF
+ ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NBMIN = 2
+ END IF
+ ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NBMIN = 2
+ END IF
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NBMIN = 2
+ END IF
+ ELSE IF( C3( 1:1 ).EQ.'M' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NBMIN = 2
+ END IF
+ END IF
+ END IF
+ ILAENV = NBMIN
+ RETURN
+*
+ 300 CONTINUE
+*
+* ISPEC = 3: crossover point
+*
+ NX = 0
+ IF( C2.EQ.'GE' ) THEN
+ IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR.
+ $ C3.EQ.'QLF' ) THEN
+ IF( SNAME ) THEN
+ NX = 128
+ ELSE
+ NX = 128
+ END IF
+ ELSE IF( C3.EQ.'HRD' ) THEN
+ IF( SNAME ) THEN
+ NX = 128
+ ELSE
+ NX = 128
+ END IF
+ ELSE IF( C3.EQ.'BRD' ) THEN
+ IF( SNAME ) THEN
+ NX = 128
+ ELSE
+ NX = 128
+ END IF
+ END IF
+ ELSE IF( C2.EQ.'SY' ) THEN
+ IF( SNAME .AND. C3.EQ.'TRD' ) THEN
+ NX = 1
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN
+ IF( C3.EQ.'TRD' ) THEN
+ NX = 1
+ END IF
+ ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NX = 128
+ END IF
+ END IF
+ ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN
+ IF( C3( 1:1 ).EQ.'G' ) THEN
+ IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR.
+ $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR.
+ $ C4.EQ.'BR' ) THEN
+ NX = 128
+ END IF
+ END IF
+ END IF
+ ILAENV = NX
+ RETURN
+*
+ 400 CONTINUE
+*
+* ISPEC = 4: number of shifts (used by xHSEQR)
+*
+ ILAENV = 6
+ RETURN
+*
+ 500 CONTINUE
+*
+* ISPEC = 5: minimum column dimension (not used)
+*
+ ILAENV = 2
+ RETURN
+*
+ 600 CONTINUE
+*
+* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
+*
+ ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
+ RETURN
+*
+ 700 CONTINUE
+*
+* ISPEC = 7: number of processors (not used)
+*
+ ILAENV = 1
+ RETURN
+*
+ 800 CONTINUE
+*
+* ISPEC = 8: crossover point for multishift (used by xHSEQR)
+*
+ ILAENV = 50
+ RETURN
+*
+* End of ILAENV
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.c
new file mode 100644
index 0000000000000000000000000000000000000000..f2eae9a3d87ef52cf86425adcdffe5debe578b59
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+
+integer isamax_(const integer *n, const real *sx, const integer *incx)
+{
+ /* System generated locals */
+ integer ret_val = 1;
+
+ /* Local variables */
+ static real maxv;
+ static integer i, ix;
+
+/* finds the index of element having max. absolute value. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n < 1 || *incx <= 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ return 1;
+ }
+ maxv = abs(sx[0]);
+/* code for increment equal to 1 */
+ if (*incx == 1) {
+ for (i = 1; i < *n; ++i)
+ if (abs(sx[i]) > maxv) {
+ ret_val = i+1;
+ maxv = abs(sx[i]);
+ }
+ }
+/* code for increment not equal to 1 */
+ else {
+ ix = *incx;
+ for (i = 1; i < *n; ++i, ix += *incx)
+ if (abs(sx[ix]) > maxv) {
+ ret_val = i+1;
+ maxv = abs(sx[ix]);
+ }
+ }
+ return ret_val;
+} /* isamax_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.f
new file mode 100644
index 0000000000000000000000000000000000000000..a649e02814282e613c56b4faa4ce7eae2c8ed7b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/isamax.f
@@ -0,0 +1,39 @@
+ integer function isamax(n,sx,incx)
+c
+c finds the index of element having max. absolute value.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),smax
+ integer i,incx,ix,n
+c
+ isamax = 0
+ if( n.lt.1 .or. incx.le.0 ) return
+ isamax = 1
+ if(n.eq.1)return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ smax = abs(sx(1))
+ ix = ix + incx
+ do 10 i = 2,n
+ if(abs(sx(ix)).le.smax) go to 5
+ isamax = i
+ smax = abs(sx(ix))
+ 5 ix = ix + incx
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 smax = abs(sx(1))
+ do 30 i = 2,n
+ if(abs(sx(i)).le.smax) go to 30
+ isamax = i
+ smax = abs(sx(i))
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.c
new file mode 100644
index 0000000000000000000000000000000000000000..8c1dd5ba88a74c4dfcec3c4964f998c3bba9f3b0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.c
@@ -0,0 +1,47 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+integer izamax_(n, zx, incx)
+const integer *n;
+const doublecomplex *zx;
+const integer *incx;
+{
+ /* System generated locals */
+ integer ret_val;
+
+ /* Local variables */
+ static doublereal smax, temp;
+ static integer i;
+ static integer ix;
+
+/* finds the index of element having max. absolute value. */
+/* jack dongarra, 1/15/85. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n < 1 || *incx <= 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ return 1;
+ }
+ ret_val = 1;
+ if (*incx == 1) {
+ smax = abs(zx[0].r) + abs(zx[0].i);
+ for (i = 1; i < *n; ++i) {
+ temp = abs(zx[i].r) + abs(zx[i].i);
+ if (temp > smax) { ret_val = i+1; smax = temp; }
+ }
+ }
+ else {
+ smax = abs(zx[0].r) + abs(zx[0].i);
+ for (i = 1, ix = *incx; i < *n; ++i, ix += *incx) {
+ temp = abs(zx[ix].r) + abs(zx[ix].i);
+ if (temp > smax) { ret_val = i+1; smax = temp; }
+ }
+ }
+ return ret_val;
+} /* izamax_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.f
new file mode 100644
index 0000000000000000000000000000000000000000..ec14f827d7e6f6287810dce664d787732a98cf67
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/izamax.f
@@ -0,0 +1,41 @@
+ integer function izamax(n,zx,incx)
+c
+c finds the index of element having max. absolute value.
+c jack dongarra, 1/15/85.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*)
+ double precision smax
+ integer i,incx,ix,n
+ double precision dcabs1
+c
+ izamax = 0
+ if( n.lt.1 .or. incx.le.0 )return
+ izamax = 1
+ if(n.eq.1)return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ smax = dcabs1(zx(1))
+ ix = ix + incx
+ do 10 i = 2,n
+ if(dcabs1(zx(ix)).le.smax) go to 5
+ izamax = i
+ smax = dcabs1(zx(ix))
+ 5 ix = ix + incx
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 smax = dcabs1(zx(1))
+ do 30 i = 2,n
+ if(dcabs1(zx(i)).le.smax) go to 30
+ izamax = i
+ smax = dcabs1(zx(i))
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.c
new file mode 100644
index 0000000000000000000000000000000000000000..79889ce3b1e71feca0889cc6d7a438bfdd3d21d1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.c
@@ -0,0 +1,78 @@
+#include "f2c.h"
+#include "netlib.h"
+
+integer izmax1_(n, cx, incx)
+const integer *n;
+const doublecomplex *cx;
+const integer *incx;
+{
+ /* System generated locals */
+ integer ret_val = 0;
+
+ /* Local variables */
+ static doublereal smax;
+ static integer i, ix;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* IZMAX1 finds the index of the element whose real part has maximum */
+/* absolute value. */
+/* */
+/* Based on IZAMAX from Level 1 BLAS. */
+/* The change is to use the 'genuine' absolute value. */
+/* */
+/* Contributed by Nick Higham for use with ZLACON. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of elements in the vector CX. */
+/* */
+/* CX (input) COMPLEX*16 array, dimension (N) */
+/* The vector whose elements will be summed. */
+/* */
+/* INCX (input) INTEGER */
+/* The spacing between successive values of CX. INCX >= 1. */
+/* */
+/* =====================================================================*/
+
+ if (*n < 1) {
+ return 0;
+ }
+ if (*n == 1) {
+ return 1;
+ }
+/* CODE FOR INCREMENT EQUAL TO 1 */
+ if (*incx == 1) {
+ smax = abs(cx[0].r);
+ for (i = 1; i < *n; ++i) {
+ if (abs(cx[i].r) > smax) {
+ ret_val = i+1;
+ smax = abs(cx[i].r);
+ }
+ }
+ }
+
+/* CODE FOR INCREMENT NOT EQUAL TO 1 */
+ else {
+ ix = 0;
+ smax = abs(cx[0].r);
+ ix += *incx;
+ for (i = 1; i < *n; ++i, ix += *incx) {
+ if (abs(cx[ix].r) > smax) {
+ ret_val = i+1;
+ smax = abs(cx[ix].r);
+ }
+ }
+ }
+ return ret_val;
+
+} /* izmax1_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.f
new file mode 100644
index 0000000000000000000000000000000000000000..785100eb0df8be99c0945f34e23eecc22d2c9aa6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/izmax1.f
@@ -0,0 +1,96 @@
+ INTEGER FUNCTION IZMAX1( N, CX, INCX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 CX( * )
+* ..
+*
+* Purpose
+* =======
+*
+* IZMAX1 finds the index of the element whose real part has maximum
+* absolute value.
+*
+* Based on IZAMAX from Level 1 BLAS.
+* The change is to use the 'genuine' absolute value.
+*
+* Contributed by Nick Higham for use with ZLACON.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of elements in the vector CX.
+*
+* CX (input) COMPLEX*16 array, dimension (N)
+* The vector whose elements will be summed.
+*
+* INCX (input) INTEGER
+* The spacing between successive values of CX. INCX >= 1.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, IX
+ DOUBLE PRECISION SMAX
+ COMPLEX*16 ZDUM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1
+* ..
+* .. Statement Function definitions ..
+*
+* NEXT LINE IS THE ONLY MODIFICATION.
+ CABS1( ZDUM ) = ABS( DBLE( ZDUM ) )
+* ..
+* .. Executable Statements ..
+*
+ IZMAX1 = 0
+ IF( N.LT.1 )
+ $ RETURN
+ IZMAX1 = 1
+ IF( N.EQ.1 )
+ $ RETURN
+ IF( INCX.EQ.1 )
+ $ GO TO 30
+*
+* CODE FOR INCREMENT NOT EQUAL TO 1
+*
+ IX = 1
+ SMAX = CABS1( CX( 1 ) )
+ IX = IX + INCX
+ DO 20 I = 2, N
+ IF( CABS1( CX( IX ) ).LE.SMAX )
+ $ GO TO 10
+ IZMAX1 = I
+ SMAX = CABS1( CX( IX ) )
+ 10 CONTINUE
+ IX = IX + INCX
+ 20 CONTINUE
+ RETURN
+*
+* CODE FOR INCREMENT EQUAL TO 1
+*
+ 30 CONTINUE
+ SMAX = CABS1( CX( 1 ) )
+ DO 40 I = 2, N
+ IF( CABS1( CX( I ) ).LE.SMAX )
+ $ GO TO 40
+ IZMAX1 = I
+ SMAX = CABS1( CX( I ) )
+ 40 CONTINUE
+ RETURN
+*
+* End of IZMAX1
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-example.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-example.f
new file mode 100644
index 0000000000000000000000000000000000000000..e8772b37a7b4ea4e5be9a039b8eb0ef7a55f6eb8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-example.f
@@ -0,0 +1,66 @@
+C
+C ***********************
+C SIMPLE DRIVER FOR LBFGS
+C ***********************
+C
+C Example of driver for LBFGS routine, using a
+C simple test problem. The solution point is at
+C X=(1,...,1) and the optimal function value of 0.
+C
+C JORGE NOCEDAL
+C *** July 1990 ***
+C
+ PROGRAM SDRIVE
+ PARAMETER(NDIM=2000,MSAVE=7,NWORK=NDIM*(2*MSAVE +1)+2*MSAVE)
+ DOUBLE PRECISION X(NDIM),G(NDIM),DIAG(NDIM),W(NWORK)
+ DOUBLE PRECISION F,EPS,XTOL,GTOL,T1,T2,STPMIN,STPMAX
+ INTEGER IPRINT(2),IFLAG,ICALL,N,M,MP,LP,J
+ LOGICAL DIAGCO
+C
+C The driver for LBFGS must always declare LB2 as EXTERNAL
+C
+
+ COMMON /LB3/MP,LP,GTOL,STPMIN,STPMAX
+C
+ lp = 1
+ N=100
+ M=5
+ IPRINT(1)= 1
+ IPRINT(2)= 0
+C
+C We do not wish to provide the diagonal matrices Hk0, and
+C therefore set DIAGCO to FALSE.
+C
+ DIAGCO= .FALSE.
+ EPS= 1.0D-5
+ XTOL= 1.0D-16
+ ICALL=0
+ IFLAG=0
+ DO 10 J=1,N,2
+ X(J)=-1.2D0
+ X(J+1)=1.D0
+ 10 CONTINUE
+C
+ 20 CONTINUE
+ F= 0.D0
+ DO 30 J=1,N,2
+ T1= 1.D0-X(J)
+ T2= 1.D1*(X(J+1)-X(J)**2)
+ G(J+1)= 2.D1*T2
+ G(J)= -2.D0*(X(J)*G(J+1)+T1)
+ F= F+T1**2+T2**2
+ 30 CONTINUE
+ CALL LBFGS(N,M,X,F,G,DIAGCO,DIAG,IPRINT,EPS,XTOL,W,IFLAG)
+ call lbp1f("f = %g\n", F)
+ IF(IFLAG.LE.0) GO TO 50
+ ICALL=ICALL + 1
+C We allow at most 2000 evaluations of F and G
+ IF(ICALL.GT.2000) GO TO 50
+ GO TO 20
+ 50 CONTINUE
+ call lbp1f("f = %g\n", F)
+ call lbp1d("iterations = %d\n", ICALL)
+ END
+C
+C ** LAST LINE OF SIMPLE DRIVER (SDRIVE) **
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-lb1.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-lb1.c
new file mode 100644
index 0000000000000000000000000000000000000000..798d91031745f10c6ee62dc5eefa54c06dead192
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs-lb1.c
@@ -0,0 +1,158 @@
+#include <stdio.h>
+#include <math.h>
+
+void lbptf_(char* msg)
+{
+ printf(msg);
+}
+
+void lbp1d_(char* msg, int* i)
+{
+ printf(msg, *i);
+}
+
+void lbp1f_(char* msg, double* i)
+{
+ printf(msg, *i);
+}
+
+static void write50(double* v, int n)
+{
+ int cols = 15;
+ double vmax = 0;
+ int i;
+ double vmaxscale;
+ for (i = 0; i < n; ++i)
+ if (fabs(v[i]) > vmax)
+ vmax = v[i];
+ vmaxscale = log(fabs(vmax)) / log(10.0);
+ vmaxscale = pow(10.0, ceil(vmaxscale) - 1);
+ if (vmaxscale != 1.0)
+ printf(" %e x\n", vmaxscale);
+
+ for (i = 0; i < n; ++i) {
+ if (i > 0 && i%cols == 0)
+ printf("\n");
+ printf(" %10.5f", v[i] / vmaxscale);
+ }
+ printf("\n");
+}
+
+/*C
+//C -------------------------------------------------------------
+//C THIS ROUTINE PRINTS MONITORING INFORMATION. THE FREQUENCY AND
+//C AMOUNT OF OUTPUT ARE CONTROLLED BY IPRINT.
+//C -------------------------------------------------------------
+*/
+void lb1_(iprint, iter, nfun, gnorm, n, m, x, f, g, stp, finish)
+int *iprint, *iter, *nfun;
+double *gnorm;
+int *n, *m;
+double *x, *f, *g, *stp;
+int *finish; /* logical*/
+{
+ (void)m;
+ --iprint;
+/* C*/
+/*IF (ITER.EQ.0)THEN*/
+ if (*iter == 0) {
+/* 30 FORMAT(' F= ',1PD10.3,' GNORM= ',1PD10.3)*/
+/* WRITE(MP,30)F,GNORM*/
+ printf(" F = %g, GNORM = %g\n", *f, *gnorm);
+/* IF (IPRINT(2).GE.1)THEN*/
+ if (iprint[2] >= 1) {
+/* 40 FORMAT(' VECTOR X= ')*/
+/* WRITE(MP,40)*/
+ printf(" VECTOR X=\n");
+/* WRITE(MP,50) (X(I),I=1,N)*/
+ write50(x, *n);
+/* 60 FORMAT(' GRADIENT VECTOR G= ')*/
+/* WRITE(MP,60)*/
+ printf(" GRADIENT VECTOR G=\n");
+/* WRITE(MP,50) (G(I),I=1,N)*/
+ write50(g, *n);
+/* ENDIF*/
+ }
+/* 10 FORMAT('*************************************************')*/
+ printf("*************************************************\n");
+/* 70 FORMAT(/' I NFN',4X,'FUNC',8X,'GNORM',7X,'STEPLENGTH'/)*/
+/* WRITE(MP,70)*/
+ printf(" I NFN FUNC GNORM STEPLENGTH\n");
+/*ELSE*/
+ } else {
+/* IF ((IPRINT(1).EQ.0).AND.(ITER.NE.1.AND..NOT.FINISH))RETURN*/
+ if ((iprint[1]==0) && (*iter != 1 && !*finish))
+ return;
+/* IF (IPRINT(1).NE.0)THEN*/
+ if (iprint[1] != 0) {
+/* IF(MOD(ITER-1,IPRINT(1)).EQ.0.OR.FINISH)THEN*/
+ if ((*iter - 1)%iprint[1] == 0 || *finish) {
+/* 70 FORMAT(/' I NFN',4X,'FUNC',8X,'GNORM',7X,'STEPLENGTH'/)*/
+/* IF(IPRINT(2).GT.1.AND.ITER.GT.1) WRITE(MP,70)*/
+ if (iprint[2] > 1 && *iter > 1)
+ printf(" I NFN FUNC GNORM STEPLENGTH\n");
+/* 80 FORMAT(2(I4,1X),3X,3(1PD10.3,2X))*/
+/* WRITE(MP,80)ITER,NFUN,F,GNORM,STP*/
+ printf("%4d %4d %10.3f %10.3f %10.3f\n", *iter, *nfun, *f, *gnorm, *stp);
+ }
+/* ELSE*/
+ else {
+/* RETURN*/
+ return;
+/* ENDIF*/
+ }
+ }
+/* ELSE*/
+ else {
+
+/* 70 FORMAT(/' I NFN',4X,'FUNC',8X,'GNORM',7X,'STEPLENGTH'/)*/
+/* IF( IPRINT(2).GT.1.AND.FINISH) WRITE(MP,70)*/
+ if (iprint[2] > 1 && *finish)
+ printf(" I NFN FUNC GNORM STEPLENGTH\n");
+
+/* 80 FORMAT(2(I4,1X),3X,3(1PD10.3,2X))*/
+/* WRITE(MP,80)ITER,NFUN,F,GNORM,STP*/
+ printf("%4d %4d %10.3f %10.3f %10.3f\n", *iter, *nfun, *f, *gnorm, *stp);
+/* ENDIF*/
+ }
+
+/* IF (IPRINT(2).EQ.2.OR.IPRINT(2).EQ.3)THEN*/
+ if (iprint[2] == 2 || iprint[2] == 3) {
+/* IF (FINISH)THEN*/
+ if (*finish)
+/* 90 FORMAT(' FINAL POINT X= ')*/
+/* WRITE(MP,90)*/
+ printf(" FINAL POINT X=\n");
+/* ELSE*/
+ else
+/* 40 FORMAT(' VECTOR X= ')*/
+/* WRITE(MP,40)*/
+ printf(" VECTOR X=\n");
+/* ENDIF*/
+
+/* 50 FORMAT(6(2X,1PD10.3))*/
+/* WRITE(MP,50)(X(I),I=1,N)*/
+ write50(x, *n);
+/* IF (IPRINT(2).EQ.3)THEN*/
+ if (iprint[2] == 3) {
+/* 60 FORMAT(' GRADIENT VECTOR G= ')*/
+/* WRITE(MP,60)*/
+ printf(" GRADIENT VECTOR G=\n");
+/* 50 FORMAT(6(2X,1PD10.3))*/
+/* WRITE(MP,50)(G(I),I=1,N)*/
+ write50(g, *n);
+/* ENDIF*/
+ }
+/* ENDIF*/
+ }
+/* 100 FORMAT(/' THE MINIMIZATION TERMINATED WITHOUT DETECTING ERRORS.',*/
+/* . /' IFLAG = 0')*/
+/* IF (FINISH) WRITE(MP,100)*/
+ if (*finish)
+ printf(" THE MINIMIZATION TERMINATED WITHOUT DETECTING ERRORS.\n");
+ }
+/* ENDIF*/
+/* C*/
+/* RETURN*/
+/* END*/
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.c
new file mode 100644
index 0000000000000000000000000000000000000000..b2b7ffcd1479ff1d7799ec887459445906d770d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.c
@@ -0,0 +1,1191 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+static void mcsrch_(integer *n, doublereal *x, doublereal *f, doublereal *g, doublereal *s, doublereal *stp,
+ doublereal *ftol, doublereal *xtol, integer *maxfev, integer *info, integer *nfev, doublereal *wa);
+static void mcstep_(doublereal *stx, doublereal *fx, doublereal *dx, doublereal *sty, doublereal *fy, doublereal *dy,
+ doublereal *stp, doublereal *fp, doublereal *dp, logical *brackt,
+ doublereal *stpmin, doublereal *stpmax, integer *info);
+void lb1_(int *iprint, int *iter, int *nfun, double *gnorm, int *n, int *m,
+ double *x, double *f, double *g, double *stp, int *finish);
+void lbptf_(char* msg);
+void lbp1d_(char* msg, int* i);
+
+#include "lbfgs.h"
+/* Initialized data */
+struct lb3_1_ lb3_1 = { 6, 6, .9, 1e-20, 1e20, 1. };
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* ----------------------------------------------------------------------*/
+/* This file contains the LBFGS algorithm and supporting routines */
+
+/* **************** */
+/* LBFGS SUBROUTINE */
+/* **************** */
+
+/* Subroutine */ void lbfgs_(n, m, x, f, g, diagco, diag, iprint, eps, xtol, w, iflag)
+integer *n, *m;
+doublereal *x, *f, *g;
+logical *diagco;
+doublereal *diag;
+integer *iprint;
+doublereal *eps, *xtol, *w;
+integer *iflag;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal beta;
+ static integer inmc;
+ static integer info, iscn, nfev, iycn, iter;
+ static doublereal ftol;
+ static integer nfun, ispt, iypt;
+ static integer i, bound;
+ static doublereal gnorm;
+ static integer point;
+ static doublereal xnorm;
+ static integer cp;
+ static doublereal sq, yr, ys;
+ static logical finish;
+ static doublereal yy;
+ static integer maxfev;
+ static integer npt;
+ static doublereal stp, stp1;
+
+/* LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION */
+/* JORGE NOCEDAL */
+/* *** July 1990 *** */
+
+/* This subroutine solves the unconstrained minimization problem */
+
+/* min F(x), x= (x1,x2,...,xN), */
+
+/* using the limited memory BFGS method. The routine is especially */
+/* effective on problems involving a large number of variables. In */
+/* a typical iteration of this method an approximation Hk to the */
+/* inverse of the Hessian is obtained by applying M BFGS updates to */
+/* a diagonal matrix Hk0, using information from the previous M steps. */
+/* The user specifies the number M, which determines the amount of */
+/* storage required by the routine. The user may also provide the */
+/* diagonal matrices Hk0 if not satisfied with the default choice. */
+/* The algorithm is described in "On the limited memory BFGS method */
+/* for large scale optimization", by D. Liu and J. Nocedal, */
+/* Mathematical Programming B 45 (1989) 503-528. */
+
+/* The user is required to calculate the function value F and its */
+/* gradient G. In order to allow the user complete control over */
+/* these computations, reverse communication is used. The routine */
+/* must be called repeatedly under the control of the parameter */
+/* IFLAG. */
+
+/* The steplength is determined at each iteration by means of the */
+/* line search routine MCVSRCH, which is a slight modification of */
+/* the routine CSRCH written by More' and Thuente. */
+
+/* The calling statement is */
+
+/* CALL LBFGS(N,M,X,F,G,DIAGCO,DIAG,IPRINT,EPS,XTOL,W,IFLAG) */
+
+/* where */
+
+/* N is an INTEGER variable that must be set by the user to the */
+/* number of variables. It is not altered by the routine. */
+/* Restriction: N>0. */
+
+/* M is an INTEGER variable that must be set by the user to */
+/* the number of corrections used in the BFGS update. It */
+/* is not altered by the routine. Values of M less than 3 are */
+/* not recommended; large values of M will result in excessive */
+/* computing time. 3<= M <=7 is recommended. Restriction: M>0. */
+
+/* X is a DOUBLE PRECISION array of length N. On initial entry */
+/* it must be set by the user to the values of the initial */
+/* estimate of the solution vector. On exit with IFLAG=0, it */
+/* contains the values of the variables at the best point */
+/* found (usually a solution). */
+
+/* F is a DOUBLE PRECISION variable. Before initial entry and on */
+/* a re-entry with IFLAG=1, it must be set by the user to */
+/* contain the value of the function F at the point X. */
+
+/* G is a DOUBLE PRECISION array of length N. Before initial */
+/* entry and on a re-entry with IFLAG=1, it must be set by */
+/* the user to contain the components of the gradient G at */
+/* the point X. */
+
+/* DIAGCO is a LOGICAL variable that must be set to .TRUE. if the */
+/* user wishes to provide the diagonal matrix Hk0 at each */
+/* iteration. Otherwise it should be set to .FALSE., in which */
+/* case LBFGS will use a default value described below. If */
+/* DIAGCO is set to .TRUE. the routine will return at each */
+/* iteration of the algorithm with IFLAG=2, and the diagonal */
+/* matrix Hk0 must be provided in the array DIAG. */
+
+/* DIAG is a DOUBLE PRECISION array of length N. If DIAGCO=.TRUE., */
+/* then on initial entry or on re-entry with IFLAG=2, DIAG */
+/* it must be set by the user to contain the values of the */
+/* diagonal matrix Hk0. Restriction: all elements of DIAG */
+/* must be positive. */
+
+/* IPRINT is an INTEGER array of length two which must be set by the */
+/* user. */
+
+/* IPRINT(1) specifies the frequency of the output: */
+/* IPRINT(1) < 0 : no output is generated, */
+/* IPRINT(1) = 0 : output only at first and last iteration, */
+/* IPRINT(1) > 0 : output every IPRINT(1) iterations. */
+
+/* IPRINT(2) specifies the type of output generated: */
+/* IPRINT(2) = 0 : iteration count, number of function */
+/* evaluations, function value, norm of the */
+/* gradient, and steplength, */
+/* IPRINT(2) = 1 : same as IPRINT(2)=0, plus vector of */
+/* variables and gradient vector at the */
+/* initial point, */
+/* IPRINT(2) = 2 : same as IPRINT(2)=1, plus vector of */
+/* variables, */
+/* IPRINT(2) = 3 : same as IPRINT(2)=2, plus gradient vector.*/
+
+
+/* EPS is a positive DOUBLE PRECISION variable that must be set by */
+/* the user, and determines the accuracy with which the solution*/
+/* is to be found. The subroutine terminates when */
+
+/* ||G|| < EPS max(1,||X||), */
+
+/* where ||.|| denotes the Euclidean norm. */
+
+/* XTOL is a positive DOUBLE PRECISION variable that must be set by */
+/* the user to an estimate of the machine precision (e.g. */
+/* 10**(-16) on a SUN station 3/60). The line search routine will*/
+/* terminate if the relative width of the interval of uncertainty*/
+/* is less than XTOL. */
+
+/* W is a DOUBLE PRECISION array of length N(2M+1)+2M used as */
+/* workspace for LBFGS. This array must not be altered by the */
+/* user. */
+
+/* IFLAG is an INTEGER variable that must be set to 0 on initial entry*/
+/* to the subroutine. A return with IFLAG<0 indicates an error, */
+/* and IFLAG=0 indicates that the routine has terminated without*/
+/* detecting errors. On a return with IFLAG=1, the user must */
+/* evaluate the function F and gradient G. On a return with */
+/* IFLAG=2, the user must provide the diagonal matrix Hk0. */
+
+/* The following negative values of IFLAG, detecting an error, */
+/* are possible: */
+
+/* IFLAG=-1 The line search routine MCSRCH failed. The */
+/* parameter INFO provides more detailed information */
+/* (see also the documentation of MCSRCH): */
+
+/* INFO = 0 IMPROPER INPUT PARAMETERS. */
+
+/* INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF */
+/* UNCERTAINTY IS AT MOST XTOL. */
+
+/* INFO = 3 MORE THAN 20 FUNCTION EVALUATIONS WERE */
+/* REQUIRED AT THE PRESENT ITERATION. */
+
+/* INFO = 4 THE STEP IS TOO SMALL. */
+
+/* INFO = 5 THE STEP IS TOO LARGE. */
+
+/* INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS.*/
+/* THERE MAY NOT BE A STEP WHICH SATISFIES */
+/* THE SUFFICIENT DECREASE AND CURVATURE */
+/* CONDITIONS. TOLERANCES MAY BE TOO SMALL. */
+
+/* IFLAG=-2 The i-th diagonal element of the diagonal inverse */
+/* Hessian approximation, given in DIAG, is not */
+/* positive. */
+
+/* IFLAG=-3 Improper input parameters for LBFGS (N or M are */
+/* not positive). */
+
+
+/* ON THE DRIVER: */
+
+/* The program that calls LBFGS must contain the declaration: */
+
+/* EXTERNAL LB2 */
+
+/* LB2 is a BLOCK DATA that defines the default values of several */
+/* parameters described in the COMMON section. */
+
+/* COMMON: */
+
+/* The subroutine contains one common area, which the user may wish to */
+/* reference: */
+
+/* awf added stpawf */
+
+/* MP is an INTEGER variable with default value 6. It is used as the */
+/* unit number for the printing of the monitoring information */
+/* controlled by IPRINT. */
+
+/* LP is an INTEGER variable with default value 6. It is used as the */
+/* unit number for the printing of error messages. This printing */
+/* may be suppressed by setting LP to a non-positive value. */
+
+/* GTOL is a DOUBLE PRECISION variable with default value 0.9, which */
+/* controls the accuracy of the line search routine MCSRCH. If the */
+/* function and gradient evaluations are inexpensive with respect */
+/* to the cost of the iteration (which is sometimes the case when */
+/* solving very large problems) it may be advantageous to set GTOL */
+/* to a small value. A typical small value is 0.1. Restriction: */
+/* GTOL should be greater than 1.D-04. */
+
+/* STPMIN and STPMAX are non-negative DOUBLE PRECISION variables which */
+/* specify lower and uper bounds for the step in the line search. */
+/* Their default values are 1.D-20 and 1.D+20, respectively. These */
+/* values need not be modified unless the exponents are too large */
+/* for the machine being used, or unless the problem is extremely */
+/* badly scaled (in which case the exponents should be increased). */
+
+
+/* MACHINE DEPENDENCIES */
+
+/* The only variables that are machine-dependent are XTOL, */
+/* STPMIN and STPMAX. */
+
+
+/* GENERAL INFORMATION */
+
+/* Other routines called directly: DAXPY, DDOT, LB1, MCSRCH */
+
+/* Input/Output : No input; diagnostic messages on unit MP and */
+/* error messages on unit LP. */
+
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
+
+/* ---------------------------------------------------------- */
+/* DATA */
+/* ---------------------------------------------------------- */
+
+/* BLOCK DATA LB3 */
+
+/* INITIALIZE */
+/* ---------- */
+
+ if (*iflag == 0) {
+ goto L10;
+ }
+ switch ((int)*iflag) {
+ case 1: goto L172;
+ case 2: goto L100;
+ }
+L10:
+ iter = 0;
+ if (*n <= 0 || *m <= 0) {
+ goto L196;
+ }
+ if (lb3_1.gtol <= 1e-4) {
+ if (lb3_1.lp > 0) {
+ lbptf_(" GTOL IS LESS THAN OR EQUAL TO 1.D-04");
+ lbptf_(" IT HAS BEEN RESET TO 9.D-01");
+ }
+ lb3_1.gtol = .9;
+ }
+ nfun = 1;
+ point = 0;
+ finish = FALSE_;
+ if (*diagco) {
+ for (i = 0; i < *n; ++i) {
+ if (diag[i] <= 0.) {
+ goto L195;
+ }
+ }
+ } else {
+ for (i = 0; i < *n; ++i) {
+ diag[i] = 1.;
+ }
+ }
+
+/* THE WORK VECTOR W IS DIVIDED AS FOLLOWS: */
+/* --------------------------------------- */
+/* THE FIRST N LOCATIONS ARE USED TO STORE THE GRADIENT AND */
+/* OTHER TEMPORARY INFORMATION. */
+/* LOCATIONS (N+1)...(N+M) STORE THE SCALARS RHO. */
+/* LOCATIONS (N+M+1)...(N+2M) STORE THE NUMBERS ALPHA USED */
+/* IN THE FORMULA THAT COMPUTES H*G. */
+/* LOCATIONS (N+2M+1)...(N+2M+NM) STORE THE LAST M SEARCH */
+/* STEPS. */
+/* LOCATIONS (N+2M+NM+1)...(N+2M+2NM) STORE THE LAST M */
+/* GRADIENT DIFFERENCES. */
+
+/* THE SEARCH STEPS AND GRADIENT DIFFERENCES ARE STORED IN A */
+/* CIRCULAR ORDER CONTROLLED BY THE PARAMETER POINT. */
+
+ ispt = *n + (*m << 1);
+ iypt = ispt + *n * *m;
+ for (i = 0; i < *n; ++i) {
+ w[ispt + i] = -g[i] * diag[i];
+ }
+ gnorm = sqrt(ddot_(n, g, &c__1, g, &c__1));
+ stp1 = 1. / gnorm;
+
+/* PARAMETERS FOR LINE SEARCH ROUTINE */
+
+ ftol = 1e-4;
+ maxfev = 20;
+
+ if (iprint[0] >= 0) {
+ lb1_(iprint, &iter, &nfun, &gnorm, n, m, x, f, g, &stp, &finish);
+ }
+
+/* -------------------- */
+/* MAIN ITERATION LOOP */
+/* -------------------- */
+
+L80:
+ ++iter;
+ info = 0;
+ bound = iter - 1;
+ if (iter == 1) {
+ goto L165;
+ }
+ if (iter > *m) {
+ bound = *m;
+ }
+
+ ys = ddot_(n, &w[iypt + npt], &c__1, &w[ispt + npt], &c__1);
+ if (! (*diagco)) {
+ yy = ddot_(n, &w[iypt + npt], &c__1, &w[iypt + npt], &c__1);
+ for (i = 0; i < *n; ++i) {
+ diag[i] = ys / yy;
+ }
+ } else {
+ *iflag = 2;
+ return;
+ }
+L100:
+ if (*diagco) {
+ for (i = 0; i < *n; ++i) {
+ if (diag[i] <= 0.) {
+ goto L195;
+ }
+ }
+ }
+
+/* COMPUTE -H*G USING THE FORMULA GIVEN IN: Nocedal, J. 1980, */
+/* "Updating quasi-Newton matrices with limited storage", */
+/* Mathematics of Computation, Vol.24, No.151, pp. 773-782. */
+/* --------------------------------------------------------- */
+
+ cp = point;
+ if (point == 0) {
+ cp = *m;
+ }
+ w[*n + cp-1] = 1. / ys;
+ for (i = 0; i < *n; ++i) {
+ w[i] = -g[i];
+ }
+ cp = point;
+ for (i = 0; i < bound; ++i) {
+ --cp;
+ if (cp == -1) {
+ cp = *m - 1;
+ }
+ sq = ddot_(n, &w[ispt + cp * *n], &c__1, w, &c__1);
+ inmc = *n + *m + cp;
+ iycn = iypt + cp * *n;
+ w[inmc] = w[*n + cp] * sq;
+ d__1 = -w[inmc];
+ daxpy_(n, &d__1, &w[iycn], &c__1, w, &c__1);
+ }
+
+ for (i = 0; i < *n; ++i) {
+ w[i] *= diag[i];
+ }
+
+ for (i = 0; i < bound; ++i) {
+ yr = ddot_(n, &w[iypt + cp * *n], &c__1, w, &c__1);
+ beta = w[*n + cp] * yr;
+ inmc = *n + *m + cp;
+ beta = w[inmc] - beta;
+ iscn = ispt + cp * *n;
+ daxpy_(n, &beta, &w[iscn], &c__1, w, &c__1);
+ ++cp;
+ if (cp == *m) {
+ cp = 0;
+ }
+ }
+
+/* STORE THE NEW SEARCH DIRECTION */
+/* ------------------------------ */
+
+ for (i = 0; i < *n; ++i) {
+ w[ispt + point * *n + i] = w[i];
+ }
+
+/* OBTAIN THE ONE-DIMENSIONAL MINIMIZER OF THE FUNCTION */
+/* BY USING THE LINE SEARCH ROUTINE MCSRCH */
+/* ---------------------------------------------------- */
+L165:
+ nfev = 0;
+/* awf changed initial step from ONE to be parametrized. */
+ stp = lb3_1.stpawf;
+ if (iter == 1) {
+ stp = stp1;
+ }
+ for (i = 0; i < *n; ++i) {
+ w[i] = g[i];
+ }
+L172:
+ mcsrch_(n, x, f, g, &w[ispt + point * *n], &stp, &ftol, xtol, &maxfev, &info, &nfev, diag);
+ if (info == -1) {
+ *iflag = 1;
+/* Return, in order to get another sample of F and G. */
+/* Next call comes right back here. */
+ return;
+ }
+ if (info != 1) {
+ goto L190;
+ }
+ nfun += nfev;
+
+/* COMPUTE THE NEW STEP AND GRADIENT CHANGE */
+/* ----------------------------------------- */
+
+ npt = point * *n;
+ for (i = 0; i < *n; ++i) {
+ w[ispt + npt + i] *= stp;
+ w[iypt + npt + i] = g[i] - w[i];
+ }
+ ++point;
+ if (point == *m) {
+ point = 0;
+ }
+
+/* TERMINATION TEST */
+/* ---------------- */
+
+ gnorm = sqrt(ddot_(n, g, &c__1, g, &c__1));
+ xnorm = sqrt(ddot_(n, x, &c__1, x, &c__1));
+ xnorm = max(1.,xnorm);
+ if (gnorm / xnorm <= *eps) {
+ finish = TRUE_;
+ }
+
+ if (iprint[0] >= 0) {
+ lb1_(iprint, &iter, &nfun, &gnorm, n, m, x, f, g, &stp, &finish);
+ }
+ if (finish) {
+ *iflag = 0;
+ return;
+ }
+ goto L80;
+
+/* ------------------------------------------------------------ */
+/* END OF MAIN ITERATION LOOP. ERROR EXITS. */
+/* ------------------------------------------------------------ */
+
+L190:
+ *iflag = -1;
+ if (lb3_1.lp > 0) {
+ lbptf_("IFLAG= -1. LINE SEARCH FAILED.");
+ lbptf_(" SEE DOCUMENTATION OF ROUTINE MCSRCH");
+ lbp1d_(" ERROR RETURN OF LINE SEARCH: INFO=%d", &info);
+ lbptf_(" POSSIBLE CAUSES: FUNCTION OR GRADIENT ARE ");
+ lbptf_(" INCORRECT OR INCORRECT TOLERANCES");
+ }
+ return;
+L195:
+ *iflag = -2;
+ if (lb3_1.lp > 0) {
+ lbp1d_("IFLAG=-2, THE %d-TH DIAGONAL ELEMENT OF THE", &i);
+ lbptf_("INVERSE HESSIAN APPROXIMATION IS NOT POSITIVE");
+ }
+ return;
+L196:
+ *iflag = -3;
+ if (lb3_1.lp > 0) {
+ lbptf_("IFLAG= -3, IMPROPER INPUT PARAMETERS.");
+ lbptf_(" (N OR M ARE NOT POSITIVE)");
+ }
+ return;
+} /* lbfgs_ */
+
+
+/* LAST LINE OF SUBROUTINE LBFGS */
+
+
+/* SUBROUTINE LB1(IPRINT,ITER,NFUN,GNORM,N,M,X,F,G,STP,FINISH) */
+/* ** moved to c file */
+
+/* ---------------------------------------------------------- */
+
+/* These routines removed for insertion into TargetJr netlib */
+
+/* awf subroutine daxpy(n,da,dx,incx,dy,incy) */
+/* awf c */
+/* awf c constant times a vector plus a vector. */
+/* awf c uses unrolled loops for increments equal to one. */
+/* awf c jack dongarra, linpack, 3/11/78. */
+/* awf c */
+/* awf double precision dx(1),dy(1),da */
+/* awf integer i,incx,incy,ix,iy,m,mp1,n */
+/* awf c */
+/* awf if(n.le.0)return */
+/* awf if (da .eq. 0.0d0) return */
+/* awf if(incx.eq.1.and.incy.eq.1)go to 20 */
+/* awf c */
+/* awf c code for unequal increments or equal increments */
+/* awf c not equal to 1 */
+/* awf c */
+/* awf ix = 1 */
+/* awf iy = 1 */
+/* awf if(incx.lt.0)ix = (-n+1)*incx + 1 */
+/* awf if(incy.lt.0)iy = (-n+1)*incy + 1 */
+/* awf do 10 i = 1,n */
+/* awf dy(iy) = dy(iy) + da*dx(ix) */
+/* awf ix = ix + incx */
+/* awf iy = iy + incy */
+/* awf 10 continue */
+/* awf return */
+/* awf c */
+/* awf c code for both increments equal to 1 */
+/* awf c */
+/* awf c */
+/* awf c clean-up loop */
+/* awf c */
+/* awf 20 m = mod(n,4) */
+/* awf if( m .eq. 0 ) go to 40 */
+/* awf do 30 i = 1,m */
+/* awf dy(i) = dy(i) + da*dx(i) */
+/* awf 30 continue */
+/* awf if( n .lt. 4 ) return */
+/* awf 40 mp1 = m + 1 */
+/* awf do 50 i = mp1,n,4 */
+/* awf dy(i) = dy(i) + da*dx(i) */
+/* awf dy(i + 1) = dy(i + 1) + da*dx(i + 1) */
+/* awf dy(i + 2) = dy(i + 2) + da*dx(i + 2) */
+/* awf dy(i + 3) = dy(i + 3) + da*dx(i + 3) */
+/* awf 50 continue */
+/* awf return */
+/* awf end */
+/* awf C */
+/* awf C */
+/* awf C ---------------------------------------------------------- */
+/* awf C */
+/* awf double precision function ddot(n,dx,incx,dy,incy) */
+/* awf c */
+/* awf c forms the dot product of two vectors. */
+/* awf c uses unrolled loops for increments equal to one. */
+/* awf c jack dongarra, linpack, 3/11/78. */
+/* awf c */
+/* awf double precision dx(1),dy(1),dtemp */
+/* awf integer i,incx,incy,ix,iy,m,mp1,n */
+/* awf c */
+/* awf ddot = 0.0d0 */
+/* awf dtemp = 0.0d0 */
+/* awf if(n.le.0)return */
+/* awf if(incx.eq.1.and.incy.eq.1)go to 20 */
+/* awf c */
+/* awf c code for unequal increments or equal increments */
+/* awf c not equal to 1 */
+/* awf c */
+/* awf ix = 1 */
+/* awf iy = 1 */
+/* awf if(incx.lt.0)ix = (-n+1)*incx + 1 */
+/* awf if(incy.lt.0)iy = (-n+1)*incy + 1 */
+/* awf do 10 i = 1,n */
+/* awf dtemp = dtemp + dx(ix)*dy(iy) */
+/* awf ix = ix + incx */
+/* awf iy = iy + incy */
+/* awf 10 continue */
+/* awf ddot = dtemp */
+/* awf return */
+/* awf c */
+/* awf c code for both increments equal to 1 */
+/* awf c */
+/* awf c */
+/* awf c clean-up loop */
+/* awf c */
+/* awf 20 m = mod(n,5) */
+/* awf if( m .eq. 0 ) go to 40 */
+/* awf do 30 i = 1,m */
+/* awf dtemp = dtemp + dx(i)*dy(i) */
+/* awf 30 continue */
+/* awf if( n .lt. 5 ) go to 60 */
+/* awf 40 mp1 = m + 1 */
+/* awf do 50 i = mp1,n,5 */
+/* awf dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) + */
+/* awf * dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4) */
+/* awf 50 continue */
+/* awf 60 ddot = dtemp */
+/* awf return */
+/* awf end */
+/* ------------------------------------------------------------------ */
+
+/* ************************** */
+/* LINE SEARCH ROUTINE MCSRCH */
+/* ************************** */
+
+/* Subroutine */
+static void mcsrch_(n, x, f, g, s, stp, ftol, xtol, maxfev, info, nfev, wa)
+integer *n;
+doublereal *x, *f, *g, *s, *stp, *ftol, *xtol;
+integer *maxfev, *info, *nfev;
+doublereal *wa;
+{
+ /* Initialized data */
+
+ static doublereal xtrapf = 4.;
+
+ /* Local variables */
+ static doublereal dgxm, dgym;
+ static integer j, infoc;
+ static doublereal finit, width, stmin, stmax;
+ static logical stage1;
+ static doublereal width1, ftest1, dg, fm, fx, fy;
+ static logical brackt;
+ static doublereal dginit, dgtest;
+ static doublereal dgm, dgx, dgy, fxm, fym, stx, sty;
+
+
+/* SUBROUTINE MCSRCH */
+
+/* A slight modification of the subroutine CSRCH of More' and Thuente. */
+/* The changes are to allow reverse communication, and do not affect */
+/* the performance of the routine. */
+
+/* THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES */
+/* A SUFFICIENT DECREASE CONDITION AND A CURVATURE CONDITION. */
+
+/* AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF */
+/* UNCERTAINTY WITH ENDPOINTS STX AND STY. THE INTERVAL OF */
+/* UNCERTAINTY IS INITIALLY CHOSEN SO THAT IT CONTAINS A */
+/* MINIMIZER OF THE MODIFIED FUNCTION */
+
+/* F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). */
+
+/* IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION */
+/* HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, */
+/* THEN THE INTERVAL OF UNCERTAINTY IS CHOSEN SO THAT IT */
+/* CONTAINS A MINIMIZER OF F(X+STP*S). */
+
+/* THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES */
+/* THE SUFFICIENT DECREASE CONDITION */
+
+/* F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), */
+
+/* AND THE CURVATURE CONDITION */
+
+/* ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). */
+
+/* IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION */
+/* IS BOUNDED BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES */
+/* BOTH CONDITIONS. IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH */
+/* CONDITIONS, THEN THE ALGORITHM USUALLY STOPS WHEN ROUNDING */
+/* ERRORS PREVENT FURTHER PROGRESS. IN THIS CASE STP ONLY */
+/* SATISFIES THE SUFFICIENT DECREASE CONDITION. */
+
+/* THE SUBROUTINE STATEMENT IS */
+
+/* SUBROUTINE MCSRCH(N,X,F,G,S,STP,FTOL,XTOL, MAXFEV,INFO,NFEV,WA) */
+/* WHERE */
+
+/* N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER */
+/* OF VARIABLES. */
+
+/* X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE */
+/* BASE POINT FOR THE LINE SEARCH. ON OUTPUT IT CONTAINS */
+/* X + STP*S. */
+
+/* F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F */
+/* AT X. ON OUTPUT IT CONTAINS THE VALUE OF F AT X + STP*S. */
+
+/* G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE */
+/* GRADIENT OF F AT X. ON OUTPUT IT CONTAINS THE GRADIENT */
+/* OF F AT X + STP*S. */
+
+/* S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE */
+/* SEARCH DIRECTION. */
+
+/* STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN */
+/* INITIAL ESTIMATE OF A SATISFACTORY STEP. ON OUTPUT */
+/* STP CONTAINS THE FINAL ESTIMATE. */
+
+/* FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. (In this reverse */
+/* communication implementation GTOL is defined in a COMMON */
+/* statement.) TERMINATION OCCURS WHEN THE SUFFICIENT DECREASE */
+/* CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE */
+/* SATISFIED. */
+
+/* XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS */
+/* WHEN THE RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY */
+/* IS AT MOST XTOL. */
+
+/* STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH */
+/* SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP. (In this reverse */
+/* communication implementatin they are defined in a COMMON */
+/* statement). */
+
+/* MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION */
+/* OCCURS WHEN THE NUMBER OF CALLS TO FCN IS AT LEAST */
+/* MAXFEV BY THE END OF AN ITERATION. */
+
+/* INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: */
+
+/* INFO = 0 IMPROPER INPUT PARAMETERS. */
+
+/* INFO =-1 A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT. */
+/* NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF */
+/* CALLS TO FCN. */
+
+/* WA IS A WORK ARRAY OF LENGTH N. */
+
+/* SUBPROGRAMS CALLED */
+
+/* MCSTEP */
+
+/* FORTRAN-SUPPLIED...ABS,MAX,MIN */
+
+/* ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 */
+/* JORGE J. MORE', DAVID J. THUENTE */
+
+/* ********** */
+
+ if (*info == -1) {
+ goto L45;
+ }
+ infoc = 1;
+
+/* CHECK THE INPUT PARAMETERS FOR ERRORS. */
+
+ if (*n <= 0 || *stp <= 0. || *ftol < 0. || lb3_1.gtol < 0. || *xtol < 0. ||
+ lb3_1.stpmin < 0. || lb3_1.stpmax < lb3_1.stpmin || *maxfev <= 0) {
+ return;
+ }
+
+/* COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION */
+/* AND CHECK THAT S IS A DESCENT DIRECTION. */
+
+ dginit = 0.;
+ for (j = 0; j < *n; ++j) {
+ dginit += g[j] * s[j];
+ }
+ if (dginit >= 0.) {
+ lbptf_("THE SEARCH DIRECTION IS NOT A DESCENT DIRECTION");
+ return;
+ }
+
+/* INITIALIZE LOCAL VARIABLES. */
+
+ brackt = FALSE_;
+ stage1 = TRUE_;
+ *nfev = 0;
+ finit = *f;
+ dgtest = *ftol * dginit;
+ width = lb3_1.stpmax - lb3_1.stpmin;
+ width1 = width / .5;
+ for (j = 0; j < *n; ++j) {
+ wa[j] = x[j];
+ }
+
+/* THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, */
+/* FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. */
+/* THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, */
+/* FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF */
+/* THE INTERVAL OF UNCERTAINTY. */
+/* THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, */
+/* FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. */
+
+ stx = 0.;
+ fx = finit;
+ dgx = dginit;
+ sty = 0.;
+ fy = finit;
+ dgy = dginit;
+
+/* START OF ITERATION. */
+
+L30:
+
+/* SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND */
+/* TO THE PRESENT INTERVAL OF UNCERTAINTY. */
+
+ if (brackt) {
+ stmin = min(stx,sty);
+ stmax = max(stx,sty);
+ } else {
+ stmin = stx;
+ stmax = *stp + xtrapf * (*stp - stx);
+ }
+
+/* FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. */
+
+ *stp = max(*stp,lb3_1.stpmin);
+ *stp = min(*stp,lb3_1.stpmax);
+
+/* IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET */
+/* STP BE THE LOWEST POINT OBTAINED SO FAR. */
+
+ if ( (brackt && (*stp <= stmin || *stp >= stmax) ) || *nfev >= *maxfev - 1
+ || infoc == 0 || ( brackt && stmax - stmin <= *xtol * stmax) ) {
+ *stp = stx;
+ }
+
+/* EVALUATE THE FUNCTION AND GRADIENT AT STP */
+/* AND COMPUTE THE DIRECTIONAL DERIVATIVE. */
+/* We return to main program to obtain F and G. */
+
+ for (j = 0; j < *n; ++j) {
+ x[j] = wa[j] + *stp * s[j];
+ }
+ *info = -1;
+ return;
+
+L45:
+ *info = 0;
+ ++(*nfev);
+ dg = 0.;
+ for (j = 0; j < *n; ++j) {
+ dg += g[j] * s[j];
+ }
+ ftest1 = finit + *stp * dgtest;
+
+/* TEST FOR CONVERGENCE. */
+
+ if ( (brackt && (*stp <= stmin || *stp >= stmax) ) || infoc == 0) {
+ *info = 6;
+ }
+ if (*stp == lb3_1.stpmax && *f <= ftest1 && dg <= dgtest) {
+ *info = 5;
+ }
+ if (*stp == lb3_1.stpmin && (*f > ftest1 || dg >= dgtest)) {
+ *info = 4;
+ }
+ if (*nfev >= *maxfev) {
+ *info = 3;
+ }
+ if (brackt && stmax - stmin <= *xtol * stmax) {
+ *info = 2;
+ }
+ if (*f <= ftest1 && abs(dg) <= lb3_1.gtol * (-dginit)) {
+ *info = 1;
+ }
+
+/* CHECK FOR TERMINATION. */
+
+ if (*info != 0) {
+ return;
+ }
+
+/* IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED */
+/* FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. */
+
+ if (stage1 && *f <= ftest1 && dg >= min(*ftol,lb3_1.gtol) * dginit) {
+ stage1 = FALSE_;
+ }
+
+/* A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF */
+/* WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED */
+/* FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE */
+/* DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN */
+/* OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. */
+
+ if (stage1 && *f <= fx && *f > ftest1) {
+
+/* DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. */
+
+ fm = *f - *stp * dgtest;
+ fxm = fx - stx * dgtest;
+ fym = fy - sty * dgtest;
+ dgm = dg - dgtest;
+ dgxm = dgx - dgtest;
+ dgym = dgy - dgtest;
+
+/* CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY */
+/* AND TO COMPUTE THE NEW STEP. */
+
+ mcstep_(&stx, &fxm, &dgxm, &sty, &fym, &dgym, stp, &fm, &dgm, &brackt, &stmin, &stmax, &infoc);
+
+/* RESET THE FUNCTION AND GRADIENT VALUES FOR F. */
+
+ fx = fxm + stx * dgtest;
+ fy = fym + sty * dgtest;
+ dgx = dgxm + dgtest;
+ dgy = dgym + dgtest;
+ } else {
+
+/* CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY */
+/* AND TO COMPUTE THE NEW STEP. */
+
+ mcstep_(&stx, &fx, &dgx, &sty, &fy, &dgy, stp, f, &dg, &brackt, &stmin, &stmax, &infoc);
+ }
+
+/* FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE */
+/* INTERVAL OF UNCERTAINTY. */
+
+ if (brackt) {
+ if (abs(sty - stx) >= .66 * width1) {
+ *stp = stx + .5 * (sty - stx);
+ }
+ width1 = width;
+ width = abs(sty - stx);
+ }
+
+/* END OF ITERATION. */
+
+ goto L30;
+
+/* LAST LINE OF SUBROUTINE MCSRCH. */
+
+} /* mcsrch_ */
+
+/* Subroutine */
+static void mcstep_(stx, fx, dx, sty, fy, dy, stp, fp, dp, brackt, stpmin, stpmax, info)
+doublereal *stx, *fx, *dx, *sty, *fy, *dy, *stp, *fp, *dp;
+logical *brackt;
+doublereal *stpmin, *stpmax;
+integer *info;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal sgnd, stpc, stpf, stpq, p, q, gamma, r, s, theta;
+ static logical bound;
+
+
+/* SUBROUTINE MCSTEP */
+
+/* THE PURPOSE OF MCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR */
+/* A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR */
+/* A MINIMIZER OF THE FUNCTION. */
+
+/* THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION */
+/* VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS */
+/* ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE */
+/* DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A */
+/* MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY */
+/* WITH ENDPOINTS STX AND STY. */
+
+/* THE SUBROUTINE STATEMENT IS */
+
+/* SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT, */
+/* STPMIN,STPMAX,INFO) */
+
+/* WHERE */
+
+/* STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP, */
+/* THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED */
+/* SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION */
+/* OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE */
+/* SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY. */
+
+/* STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP, */
+/* THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF */
+/* THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE */
+/* UPDATED APPROPRIATELY. */
+
+/* STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP, */
+/* THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP. */
+/* IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE */
+/* BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP. */
+
+/* BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER */
+/* HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED */
+/* THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER */
+/* IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE. */
+
+/* STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER */
+/* AND UPPER BOUNDS FOR THE STEP. */
+
+/* INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: */
+/* IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED */
+/* ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE */
+/* INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS. */
+
+/* SUBPROGRAMS CALLED */
+
+/* FORTRAN-SUPPLIED ... ABS,MAX,MIN,SQRT */
+
+/* ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 */
+/* JORGE J. MORE', DAVID J. THUENTE */
+
+ *info = 0;
+
+/* CHECK THE INPUT PARAMETERS FOR ERRORS. */
+
+ if ( ( *brackt && ( *stp <= min(*stx,*sty) || *stp >= max(*stx,*sty) ) )
+ || *dx * (*stp - *stx) >= 0. || *stpmax < *stpmin) {
+ return;
+ }
+
+/* DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. */
+
+ sgnd = *dp * (*dx / abs(*dx));
+
+/* FIRST CASE. A HIGHER FUNCTION VALUE. */
+/* THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER */
+/* TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, */
+/* ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. */
+
+ if (*fp > *fx) {
+ *info = 1;
+ bound = TRUE_;
+ theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
+ s = max(max(abs(theta),abs(*dx)),abs(*dp));
+ d__1 = theta / s;
+ gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
+ if (*stp < *stx) {
+ gamma = -gamma;
+ }
+ p = gamma - *dx + theta;
+ q = gamma - *dx + gamma + *dp;
+ r = p / q;
+ stpc = *stx + r * (*stp - *stx);
+ stpq = *stx + *dx / ((*fx - *fp) / (*stp - *stx) + *dx) / 2 * (*stp - *stx);
+ if (abs(stpc - *stx) < abs(stpq - *stx)) {
+ stpf = stpc;
+ } else {
+ stpf = stpc + (stpq - stpc) / 2;
+ }
+ *brackt = TRUE_;
+
+/* SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF */
+/* OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC */
+/* STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, */
+/* THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. */
+
+ } else if (sgnd < 0.) {
+ *info = 2;
+ bound = FALSE_;
+ theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
+ s = max(max(abs(theta),abs(*dx)),abs(*dp));
+ d__1 = theta / s;
+ gamma = s * sqrt(d__1 * d__1 - *dx / s * (*dp / s));
+ if (*stp > *stx) {
+ gamma = -gamma;
+ }
+ p = gamma - *dp + theta;
+ q = gamma - *dp + gamma + *dx;
+ r = p / q;
+ stpc = *stp + r * (*stx - *stp);
+ stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
+ if (abs(stpc - *stp) > abs(stpq - *stp)) {
+ stpf = stpc;
+ } else {
+ stpf = stpq;
+ }
+ *brackt = TRUE_;
+
+/* THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE */
+/* SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. */
+/* THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY */
+/* IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC */
+/* IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE */
+/* EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO */
+/* COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP */
+/* CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. */
+
+ } else if (abs(*dp) < abs(*dx)) {
+ *info = 3;
+ bound = TRUE_;
+ theta = (*fx - *fp) * 3 / (*stp - *stx) + *dx + *dp;
+ s = max(max(abs(theta),abs(*dx)),abs(*dp));
+
+/* THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND */
+/* TO INFINITY IN THE DIRECTION OF THE STEP. */
+
+ d__1 = theta / s;
+ d__1 = d__1 * d__1 - *dx / s * (*dp / s);
+ gamma = s * sqrt((max(0.,d__1)));
+ if (*stp > *stx) {
+ gamma = -gamma;
+ }
+ p = gamma - *dp + theta;
+ q = gamma + (*dx - *dp) + gamma;
+ r = p / q;
+ if (r < 0. && gamma != 0.) {
+ stpc = *stp + r * (*stx - *stp);
+ } else if (*stp > *stx) {
+ stpc = *stpmax;
+ } else {
+ stpc = *stpmin;
+ }
+ stpq = *stp + *dp / (*dp - *dx) * (*stx - *stp);
+ if (*brackt) {
+ if (abs(*stp - stpc) < abs(*stp - stpq)) {
+ stpf = stpc;
+ } else {
+ stpf = stpq;
+ }
+ } else {
+ if (abs(*stp - stpc) > abs(*stp - stpq)) {
+ stpf = stpc;
+ } else {
+ stpf = stpq;
+ }
+ }
+
+/* FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE */
+/* SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES */
+/* NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP */
+/* IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. */
+
+ } else {
+ *info = 4;
+ bound = FALSE_;
+ if (*brackt) {
+ theta = (*fp - *fy) * 3 / (*sty - *stp) + *dy + *dp;
+ s = max(max(abs(theta),abs(*dy)),abs(*dp));
+ d__1 = theta / s;
+ gamma = s * sqrt(d__1 * d__1 - *dy / s * (*dp / s));
+ if (*stp > *sty) {
+ gamma = -gamma;
+ }
+ p = gamma - *dp + theta;
+ q = gamma - *dp + gamma + *dy;
+ r = p / q;
+ stpc = *stp + r * (*sty - *stp);
+ stpf = stpc;
+ } else if (*stp > *stx) {
+ stpf = *stpmax;
+ } else {
+ stpf = *stpmin;
+ }
+ }
+
+/* UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT */
+/* DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. */
+
+ if (*fp > *fx) {
+ *sty = *stp;
+ *fy = *fp;
+ *dy = *dp;
+ } else {
+ if (sgnd < 0.) {
+ *sty = *stx;
+ *fy = *fx;
+ *dy = *dx;
+ }
+ *stx = *stp;
+ *fx = *fp;
+ *dx = *dp;
+ }
+
+/* COMPUTE THE NEW STEP AND SAFEGUARD IT. */
+
+ stpf = min(*stpmax,stpf);
+ stpf = max(*stpmin,stpf);
+ *stp = stpf;
+ if (*brackt && bound) {
+ if (*sty > *stx) {
+ d__1 = *stx + (*sty - *stx) * .66f;
+ *stp = min(d__1,*stp);
+ } else {
+ d__1 = *stx + (*sty - *stx) * .66f;
+ *stp = max(d__1,*stp);
+ }
+ }
+} /* mcstep_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.f
new file mode 100644
index 0000000000000000000000000000000000000000..f9352a2a504cbca5b9e35e1077b0f34117ab4d93
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.f
@@ -0,0 +1,1093 @@
+C ----------------------------------------------------------------------
+C This file contains the LBFGS algorithm and supporting routines
+C
+C ****************
+C LBFGS SUBROUTINE
+C ****************
+C
+ SUBROUTINE LBFGS(N,M,X,F,G,DIAGCO,DIAG,IPRINT,EPS,XTOL,W,IFLAG)
+C
+ INTEGER N,M,IPRINT(2),IFLAG
+ DOUBLE PRECISION X(N),G(N),DIAG(N),W(N*(2*M+1)+2*M)
+ DOUBLE PRECISION F,EPS,XTOL
+ LOGICAL DIAGCO
+
+C
+C LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION
+C JORGE NOCEDAL
+C *** July 1990 ***
+C
+C
+C This subroutine solves the unconstrained minimization problem
+C
+C min F(x), x= (x1,x2,...,xN),
+C
+C using the limited memory BFGS method. The routine is especially
+C effective on problems involving a large number of variables. In
+C a typical iteration of this method an approximation Hk to the
+C inverse of the Hessian is obtained by applying M BFGS updates to
+C a diagonal matrix Hk0, using information from the previous M steps.
+C The user specifies the number M, which determines the amount of
+C storage required by the routine. The user may also provide the
+C diagonal matrices Hk0 if not satisfied with the default choice.
+C The algorithm is described in "On the limited memory BFGS method
+C for large scale optimization", by D. Liu and J. Nocedal,
+C Mathematical Programming B 45 (1989) 503-528.
+C
+C The user is required to calculate the function value F and its
+C gradient G. In order to allow the user complete control over
+C these computations, reverse communication is used. The routine
+C must be called repeatedly under the control of the parameter
+C IFLAG.
+C
+C The steplength is determined at each iteration by means of the
+C line search routine MCVSRCH, which is a slight modification of
+C the routine CSRCH written by More' and Thuente.
+C
+C The calling statement is
+C
+C CALL LBFGS(N,M,X,F,G,DIAGCO,DIAG,IPRINT,EPS,XTOL,W,IFLAG)
+C
+C where
+C
+C N is an INTEGER variable that must be set by the user to the
+C number of variables. It is not altered by the routine.
+C Restriction: N>0.
+C
+C M is an INTEGER variable that must be set by the user to
+C the number of corrections used in the BFGS update. It
+C is not altered by the routine. Values of M less than 3 are
+C not recommended; large values of M will result in excessive
+C computing time. 3<= M <=7 is recommended. Restriction: M>0.
+C
+C X is a DOUBLE PRECISION array of length N. On initial entry
+C it must be set by the user to the values of the initial
+C estimate of the solution vector. On exit with IFLAG=0, it
+C contains the values of the variables at the best point
+C found (usually a solution).
+C
+C F is a DOUBLE PRECISION variable. Before initial entry and on
+C a re-entry with IFLAG=1, it must be set by the user to
+C contain the value of the function F at the point X.
+C
+C G is a DOUBLE PRECISION array of length N. Before initial
+C entry and on a re-entry with IFLAG=1, it must be set by
+C the user to contain the components of the gradient G at
+C the point X.
+C
+C DIAGCO is a LOGICAL variable that must be set to .TRUE. if the
+C user wishes to provide the diagonal matrix Hk0 at each
+C iteration. Otherwise it should be set to .FALSE., in which
+C case LBFGS will use a default value described below. If
+C DIAGCO is set to .TRUE. the routine will return at each
+C iteration of the algorithm with IFLAG=2, and the diagonal
+C matrix Hk0 must be provided in the array DIAG.
+C
+C
+C DIAG is a DOUBLE PRECISION array of length N. If DIAGCO=.TRUE.,
+C then on initial entry or on re-entry with IFLAG=2, DIAG
+C it must be set by the user to contain the values of the
+C diagonal matrix Hk0. Restriction: all elements of DIAG
+C must be positive.
+C
+C IPRINT is an INTEGER array of length two which must be set by the
+C user.
+C
+C IPRINT(1) specifies the frequency of the output:
+C IPRINT(1) < 0 : no output is generated,
+C IPRINT(1) = 0 : output only at first and last iteration,
+C IPRINT(1) > 0 : output every IPRINT(1) iterations.
+C
+C IPRINT(2) specifies the type of output generated:
+C IPRINT(2) = 0 : iteration count, number of function
+C evaluations, function value, norm of the
+C gradient, and steplength,
+C IPRINT(2) = 1 : same as IPRINT(2)=0, plus vector of
+C variables and gradient vector at the
+C initial point,
+C IPRINT(2) = 2 : same as IPRINT(2)=1, plus vector of
+C variables,
+C IPRINT(2) = 3 : same as IPRINT(2)=2, plus gradient vector.
+C
+C
+C EPS is a positive DOUBLE PRECISION variable that must be set by
+C the user, and determines the accuracy with which the solution
+C is to be found. The subroutine terminates when
+C
+C ||G|| < EPS max(1,||X||),
+C
+C where ||.|| denotes the Euclidean norm.
+C
+C XTOL is a positive DOUBLE PRECISION variable that must be set by
+C the user to an estimate of the machine precision (e.g.
+C 10**(-16) on a SUN station 3/60). The line search routine will
+C terminate if the relative width of the interval of uncertainty
+C is less than XTOL.
+C
+C W is a DOUBLE PRECISION array of length N(2M+1)+2M used as
+C workspace for LBFGS. This array must not be altered by the
+C user.
+C
+C IFLAG is an INTEGER variable that must be set to 0 on initial entry
+C to the subroutine. A return with IFLAG<0 indicates an error,
+C and IFLAG=0 indicates that the routine has terminated without
+C detecting errors. On a return with IFLAG=1, the user must
+C evaluate the function F and gradient G. On a return with
+C IFLAG=2, the user must provide the diagonal matrix Hk0.
+C
+C The following negative values of IFLAG, detecting an error,
+C are possible:
+C
+C IFLAG=-1 The line search routine MCSRCH failed. The
+C parameter INFO provides more detailed information
+C (see also the documentation of MCSRCH):
+C
+C INFO = 0 IMPROPER INPUT PARAMETERS.
+C
+C INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF
+C UNCERTAINTY IS AT MOST XTOL.
+C
+C INFO = 3 MORE THAN 20 FUNCTION EVALUATIONS WERE
+C REQUIRED AT THE PRESENT ITERATION.
+C
+C INFO = 4 THE STEP IS TOO SMALL.
+C
+C INFO = 5 THE STEP IS TOO LARGE.
+C
+C INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS.
+C THERE MAY NOT BE A STEP WHICH SATISFIES
+C THE SUFFICIENT DECREASE AND CURVATURE
+C CONDITIONS. TOLERANCES MAY BE TOO SMALL.
+C
+C
+C IFLAG=-2 The i-th diagonal element of the diagonal inverse
+C Hessian approximation, given in DIAG, is not
+C positive.
+C
+C IFLAG=-3 Improper input parameters for LBFGS (N or M are
+C not positive).
+C
+C
+C
+C ON THE DRIVER:
+C
+C The program that calls LBFGS must contain the declaration:
+C
+C EXTERNAL LB2
+C
+C LB2 is a BLOCK DATA that defines the default values of several
+C parameters described in the COMMON section.
+C
+C
+C
+C COMMON:
+C
+C The subroutine contains one common area, which the user may wish to
+C reference:
+C
+c awf added stpawf
+ COMMON /LB3/MP,LP,GTOL,STPMIN,STPMAX,stpawf
+C
+C MP is an INTEGER variable with default value 6. It is used as the
+C unit number for the printing of the monitoring information
+C controlled by IPRINT.
+C
+C LP is an INTEGER variable with default value 6. It is used as the
+C unit number for the printing of error messages. This printing
+C may be suppressed by setting LP to a non-positive value.
+C
+C GTOL is a DOUBLE PRECISION variable with default value 0.9, which
+C controls the accuracy of the line search routine MCSRCH. If the
+C function and gradient evaluations are inexpensive with respect
+C to the cost of the iteration (which is sometimes the case when
+C solving very large problems) it may be advantageous to set GTOL
+C to a small value. A typical small value is 0.1. Restriction:
+C GTOL should be greater than 1.D-04.
+C
+C STPMIN and STPMAX are non-negative DOUBLE PRECISION variables which
+C specify lower and uper bounds for the step in the line search.
+C Their default values are 1.D-20 and 1.D+20, respectively. These
+C values need not be modified unless the exponents are too large
+C for the machine being used, or unless the problem is extremely
+C badly scaled (in which case the exponents should be increased).
+C
+C
+C MACHINE DEPENDENCIES
+C
+C The only variables that are machine-dependent are XTOL,
+C STPMIN and STPMAX.
+C
+C
+C GENERAL INFORMATION
+C
+C Other routines called directly: DAXPY, DDOT, LB1, MCSRCH
+C
+C Input/Output : No input; diagnostic messages on unit MP and
+C error messages on unit LP.
+C
+C
+C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+C
+ DOUBLE PRECISION GTOL,ONE,ZERO,GNORM,DDOT,STP1,FTOL,STPMIN,
+ . STPMAX,stpawf,STP,YS,YY,SQ,YR,BETA,XNORM
+ INTEGER MP,LP,ITER,NFUN,POINT,ISPT,IYPT,MAXFEV,INFO,
+ . BOUND,NPT,CP,I,NFEV,INMC,IYCN,ISCN
+ LOGICAL FINISH
+C
+ SAVE
+C
+C ----------------------------------------------------------
+C DATA
+C ----------------------------------------------------------
+C
+C BLOCK DATA LB3
+ DATA MP,LP,GTOL,STPMIN,STPMAX,stpawf
+ $ /6,6,9.0D-01,1.0D-20,1.0D+20,1.0D+00/
+
+
+ DATA ONE,ZERO/1.0D+0,0.0D+0/
+C
+C INITIALIZE
+C ----------
+C
+ IF(IFLAG.EQ.0) GO TO 10
+ GO TO (172,100) IFLAG
+ 10 ITER= 0
+ IF(N.LE.0.OR.M.LE.0) GO TO 196
+ IF(GTOL.LE.1.D-04) THEN
+ IF(LP.GT.0) then
+ call lbptf(' GTOL IS LESS THAN OR EQUAL TO 1.D-04')
+ call lbptf(' IT HAS BEEN RESET TO 9.D-01')
+ endif
+ GTOL=9.D-01
+ ENDIF
+ NFUN= 1
+ POINT= 0
+ FINISH= .FALSE.
+ IF(DIAGCO) THEN
+ DO 30 I=1,N
+ 30 IF (DIAG(I).LE.ZERO) GO TO 195
+ ELSE
+ DO 40 I=1,N
+ 40 DIAG(I)= 1.0D0
+ ENDIF
+C
+C THE WORK VECTOR W IS DIVIDED AS FOLLOWS:
+C ---------------------------------------
+C THE FIRST N LOCATIONS ARE USED TO STORE THE GRADIENT AND
+C OTHER TEMPORARY INFORMATION.
+C LOCATIONS (N+1)...(N+M) STORE THE SCALARS RHO.
+C LOCATIONS (N+M+1)...(N+2M) STORE THE NUMBERS ALPHA USED
+C IN THE FORMULA THAT COMPUTES H*G.
+C LOCATIONS (N+2M+1)...(N+2M+NM) STORE THE LAST M SEARCH
+C STEPS.
+C LOCATIONS (N+2M+NM+1)...(N+2M+2NM) STORE THE LAST M
+C GRADIENT DIFFERENCES.
+C
+C THE SEARCH STEPS AND GRADIENT DIFFERENCES ARE STORED IN A
+C CIRCULAR ORDER CONTROLLED BY THE PARAMETER POINT.
+C
+ ISPT= N+2*M
+ IYPT= ISPT+N*M
+ DO 50 I=1,N
+ 50 W(ISPT+I)= -G(I)*DIAG(I)
+ GNORM= DSQRT(DDOT(N,G,1,G,1))
+ STP1= ONE/GNORM
+C
+C PARAMETERS FOR LINE SEARCH ROUTINE
+C
+ FTOL= 1.0D-4
+ MAXFEV= 20
+C
+ IF (IPRINT(1).GE.0)
+ $ CALL LB1(IPRINT,ITER,NFUN,GNORM,N,M,X,F,G,STP,FINISH)
+C
+C --------------------
+C MAIN ITERATION LOOP
+C --------------------
+C
+ 80 ITER= ITER+1
+ INFO=0
+ BOUND=ITER-1
+ IF(ITER.EQ.1) GO TO 165
+ IF (ITER .GT. M)BOUND=M
+C
+ YS= DDOT(N,W(IYPT+NPT+1),1,W(ISPT+NPT+1),1)
+ IF(.NOT.DIAGCO) THEN
+ YY= DDOT(N,W(IYPT+NPT+1),1,W(IYPT+NPT+1),1)
+ DO 90 I=1,N
+ 90 DIAG(I)= YS/YY
+ ELSE
+ IFLAG=2
+ RETURN
+ ENDIF
+ 100 CONTINUE
+ IF(DIAGCO) THEN
+ DO 110 I=1,N
+ 110 IF (DIAG(I).LE.ZERO) GO TO 195
+ ENDIF
+C
+C COMPUTE -H*G USING THE FORMULA GIVEN IN: Nocedal, J. 1980,
+C "Updating quasi-Newton matrices with limited storage",
+C Mathematics of Computation, Vol.24, No.151, pp. 773-782.
+C ---------------------------------------------------------
+C
+ CP= POINT
+ IF (POINT.EQ.0) CP=M
+ W(N+CP)= ONE/YS
+ DO 112 I=1,N
+ 112 W(I)= -G(I)
+ CP= POINT
+ DO 125 I= 1,BOUND
+ CP=CP-1
+ IF (CP.EQ. -1)CP=M-1
+ SQ= DDOT(N,W(ISPT+CP*N+1),1,W,1)
+ INMC=N+M+CP+1
+ IYCN=IYPT+CP*N
+ W(INMC)= W(N+CP+1)*SQ
+ CALL DAXPY(N,-W(INMC),W(IYCN+1),1,W,1)
+ 125 CONTINUE
+C
+ DO 130 I=1,N
+ 130 W(I)=DIAG(I)*W(I)
+C
+ DO 145 I=1,BOUND
+ YR= DDOT(N,W(IYPT+CP*N+1),1,W,1)
+ BETA= W(N+CP+1)*YR
+ INMC=N+M+CP+1
+ BETA= W(INMC)-BETA
+ ISCN=ISPT+CP*N
+ CALL DAXPY(N,BETA,W(ISCN+1),1,W,1)
+ CP=CP+1
+ IF (CP.EQ.M)CP=0
+ 145 CONTINUE
+C
+C STORE THE NEW SEARCH DIRECTION
+C ------------------------------
+C
+ DO 160 I=1,N
+ 160 W(ISPT+POINT*N+I)= W(I)
+C
+C OBTAIN THE ONE-DIMENSIONAL MINIMIZER OF THE FUNCTION
+C BY USING THE LINE SEARCH ROUTINE MCSRCH
+C ----------------------------------------------------
+ 165 NFEV=0
+C awf changed initial step from ONE to be parametrized.
+ STP = stpawf
+ IF (ITER.EQ.1) STP=STP1
+ DO 170 I=1,N
+ 170 W(I)=G(I)
+ 172 CONTINUE
+ CALL MCSRCH(N,X,F,G,W(ISPT+POINT*N+1),STP,FTOL,
+ * XTOL,MAXFEV,INFO,NFEV,DIAG)
+ IF (INFO .EQ. -1) THEN
+ IFLAG=1
+C Return, in order to get another sample of F and G.
+c Next call comes right back here.
+ RETURN
+ ENDIF
+ IF (INFO .NE. 1) GO TO 190
+ NFUN= NFUN + NFEV
+C
+C COMPUTE THE NEW STEP AND GRADIENT CHANGE
+C -----------------------------------------
+C
+ NPT=POINT*N
+ DO 175 I=1,N
+ W(ISPT+NPT+I)= STP*W(ISPT+NPT+I)
+ 175 W(IYPT+NPT+I)= G(I)-W(I)
+ POINT=POINT+1
+ IF (POINT.EQ.M)POINT=0
+C
+C TERMINATION TEST
+C ----------------
+C
+ GNORM= DSQRT(DDOT(N,G,1,G,1))
+ XNORM= DSQRT(DDOT(N,X,1,X,1))
+ XNORM= DMAX1(1.0D0,XNORM)
+ IF (GNORM/XNORM .LE. EPS) FINISH=.TRUE.
+C
+ IF(IPRINT(1).GE.0) CALL LB1(IPRINT,ITER,NFUN,
+ * GNORM,N,M,X,F,G,STP,FINISH)
+ IF (FINISH) THEN
+ IFLAG=0
+ RETURN
+ ENDIF
+ GO TO 80
+C
+C ------------------------------------------------------------
+C END OF MAIN ITERATION LOOP. ERROR EXITS.
+C ------------------------------------------------------------
+C
+ 190 IFLAG=-1
+ IF(LP.GT.0) then
+ call lbptf('IFLAG= -1. LINE SEARCH FAILED.')
+ call lbptf(' SEE DOCUMENTATION OF ROUTINE MCSRCH')
+ call lbp1d(' ERROR RETURN OF LINE SEARCH: INFO=%d', INFO)
+ call lbptf(' POSSIBLE CAUSES: FUNCTION OR GRADIENT ARE ')
+ call lbptf(' INCORRECT OR INCORRECT TOLERANCES')
+ endif
+ RETURN
+ 195 IFLAG=-2
+ IF(LP.GT.0) then
+ call lbp1d('IFLAG=-2, THE %d-TH DIAGONAL ELEMENT OF THE',I)
+ call lbptf('INVERSE HESSIAN APPROXIMATION IS NOT POSITIVE')
+ endif
+ RETURN
+ 196 IFLAG= -3
+ IF(LP.GT.0) then
+ call lbptf('IFLAG= -3, IMPROPER INPUT PARAMETERS.')
+ call lbptf(' (N OR M ARE NOT POSITIVE)')
+ endif
+ RETURN
+ END
+C
+C LAST LINE OF SUBROUTINE LBFGS
+C
+C
+C SUBROUTINE LB1(IPRINT,ITER,NFUN,GNORM,N,M,X,F,G,STP,FINISH)
+C ** moved to c file
+C
+C ----------------------------------------------------------
+C
+C These routines removed for insertion into TargetJr netlib
+C
+c awf subroutine daxpy(n,da,dx,incx,dy,incy)
+c awf c
+c awf c constant times a vector plus a vector.
+c awf c uses unrolled loops for increments equal to one.
+c awf c jack dongarra, linpack, 3/11/78.
+c awf c
+c awf double precision dx(1),dy(1),da
+c awf integer i,incx,incy,ix,iy,m,mp1,n
+c awf c
+c awf if(n.le.0)return
+c awf if (da .eq. 0.0d0) return
+c awf if(incx.eq.1.and.incy.eq.1)go to 20
+c awf c
+c awf c code for unequal increments or equal increments
+c awf c not equal to 1
+c awf c
+c awf ix = 1
+c awf iy = 1
+c awf if(incx.lt.0)ix = (-n+1)*incx + 1
+c awf if(incy.lt.0)iy = (-n+1)*incy + 1
+c awf do 10 i = 1,n
+c awf dy(iy) = dy(iy) + da*dx(ix)
+c awf ix = ix + incx
+c awf iy = iy + incy
+c awf 10 continue
+c awf return
+c awf c
+c awf c code for both increments equal to 1
+c awf c
+c awf c
+c awf c clean-up loop
+c awf c
+c awf 20 m = mod(n,4)
+c awf if( m .eq. 0 ) go to 40
+c awf do 30 i = 1,m
+c awf dy(i) = dy(i) + da*dx(i)
+c awf 30 continue
+c awf if( n .lt. 4 ) return
+c awf 40 mp1 = m + 1
+c awf do 50 i = mp1,n,4
+c awf dy(i) = dy(i) + da*dx(i)
+c awf dy(i + 1) = dy(i + 1) + da*dx(i + 1)
+c awf dy(i + 2) = dy(i + 2) + da*dx(i + 2)
+c awf dy(i + 3) = dy(i + 3) + da*dx(i + 3)
+c awf 50 continue
+c awf return
+c awf end
+c awf C
+c awf C
+c awf C ----------------------------------------------------------
+c awf C
+c awf double precision function ddot(n,dx,incx,dy,incy)
+c awf c
+c awf c forms the dot product of two vectors.
+c awf c uses unrolled loops for increments equal to one.
+c awf c jack dongarra, linpack, 3/11/78.
+c awf c
+c awf double precision dx(1),dy(1),dtemp
+c awf integer i,incx,incy,ix,iy,m,mp1,n
+c awf c
+c awf ddot = 0.0d0
+c awf dtemp = 0.0d0
+c awf if(n.le.0)return
+c awf if(incx.eq.1.and.incy.eq.1)go to 20
+c awf c
+c awf c code for unequal increments or equal increments
+c awf c not equal to 1
+c awf c
+c awf ix = 1
+c awf iy = 1
+c awf if(incx.lt.0)ix = (-n+1)*incx + 1
+c awf if(incy.lt.0)iy = (-n+1)*incy + 1
+c awf do 10 i = 1,n
+c awf dtemp = dtemp + dx(ix)*dy(iy)
+c awf ix = ix + incx
+c awf iy = iy + incy
+c awf 10 continue
+c awf ddot = dtemp
+c awf return
+c awf c
+c awf c code for both increments equal to 1
+c awf c
+c awf c
+c awf c clean-up loop
+c awf c
+c awf 20 m = mod(n,5)
+c awf if( m .eq. 0 ) go to 40
+c awf do 30 i = 1,m
+c awf dtemp = dtemp + dx(i)*dy(i)
+c awf 30 continue
+c awf if( n .lt. 5 ) go to 60
+c awf 40 mp1 = m + 1
+c awf do 50 i = mp1,n,5
+c awf dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
+c awf * dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
+c awf 50 continue
+c awf 60 ddot = dtemp
+c awf return
+c awf end
+C ------------------------------------------------------------------
+C
+C **************************
+C LINE SEARCH ROUTINE MCSRCH
+C **************************
+C
+ SUBROUTINE MCSRCH(N,X,F,G,S,STP,FTOL,XTOL,MAXFEV,INFO,NFEV,WA)
+ INTEGER N,MAXFEV,INFO,NFEV
+ DOUBLE PRECISION F,STP,FTOL,GTOL,XTOL,STPMIN,STPMAX,stpawf
+ DOUBLE PRECISION X(N),G(N),S(N),WA(N)
+ COMMON /LB3/MP,LP,GTOL,STPMIN,STPMAX,stpawf
+ SAVE
+C
+C SUBROUTINE MCSRCH
+C
+C A slight modification of the subroutine CSRCH of More' and Thuente.
+C The changes are to allow reverse communication, and do not affect
+C the performance of the routine.
+C
+C THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES
+C A SUFFICIENT DECREASE CONDITION AND A CURVATURE CONDITION.
+C
+C AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF
+C UNCERTAINTY WITH ENDPOINTS STX AND STY. THE INTERVAL OF
+C UNCERTAINTY IS INITIALLY CHOSEN SO THAT IT CONTAINS A
+C MINIMIZER OF THE MODIFIED FUNCTION
+C
+C F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S).
+C
+C IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION
+C HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE DERIVATIVE,
+C THEN THE INTERVAL OF UNCERTAINTY IS CHOSEN SO THAT IT
+C CONTAINS A MINIMIZER OF F(X+STP*S).
+C
+C THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES
+C THE SUFFICIENT DECREASE CONDITION
+C
+C F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S),
+C
+C AND THE CURVATURE CONDITION
+C
+C ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S).
+C
+C IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION
+C IS BOUNDED BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES
+C BOTH CONDITIONS. IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH
+C CONDITIONS, THEN THE ALGORITHM USUALLY STOPS WHEN ROUNDING
+C ERRORS PREVENT FURTHER PROGRESS. IN THIS CASE STP ONLY
+C SATISFIES THE SUFFICIENT DECREASE CONDITION.
+C
+C THE SUBROUTINE STATEMENT IS
+C
+C SUBROUTINE MCSRCH(N,X,F,G,S,STP,FTOL,XTOL, MAXFEV,INFO,NFEV,WA)
+C WHERE
+C
+C N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER
+C OF VARIABLES.
+C
+C X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE
+C BASE POINT FOR THE LINE SEARCH. ON OUTPUT IT CONTAINS
+C X + STP*S.
+C
+C F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F
+C AT X. ON OUTPUT IT CONTAINS THE VALUE OF F AT X + STP*S.
+C
+C G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE
+C GRADIENT OF F AT X. ON OUTPUT IT CONTAINS THE GRADIENT
+C OF F AT X + STP*S.
+C
+C S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE
+C SEARCH DIRECTION.
+C
+C STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN
+C INITIAL ESTIMATE OF A SATISFACTORY STEP. ON OUTPUT
+C STP CONTAINS THE FINAL ESTIMATE.
+C
+C FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. (In this reverse
+C communication implementation GTOL is defined in a COMMON
+C statement.) TERMINATION OCCURS WHEN THE SUFFICIENT DECREASE
+C CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE
+C SATISFIED.
+C
+C XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS
+C WHEN THE RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY
+C IS AT MOST XTOL.
+C
+C STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH
+C SPECIFY LOWER AND UPPER BOUNDS FOR THE STEP. (In this reverse
+C communication implementatin they are defined in a COMMON
+C statement).
+C
+C MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION
+C OCCURS WHEN THE NUMBER OF CALLS TO FCN IS AT LEAST
+C MAXFEV BY THE END OF AN ITERATION.
+C
+C INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS:
+C
+C INFO = 0 IMPROPER INPUT PARAMETERS.
+C
+C INFO =-1 A RETURN IS MADE TO COMPUTE THE FUNCTION AND GRADIENT.
+C
+C INFO = 1 THE SUFFICIENT DECREASE CONDITION AND THE
+C DIRECTIONAL DERIVATIVE CONDITION HOLD.
+C
+C INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY
+C IS AT MOST XTOL.
+C
+C INFO = 3 NUMBER OF CALLS TO FCN HAS REACHED MAXFEV.
+C
+C INFO = 4 THE STEP IS AT THE LOWER BOUND STPMIN.
+C
+C INFO = 5 THE STEP IS AT THE UPPER BOUND STPMAX.
+C
+C INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS.
+C THERE MAY NOT BE A STEP WHICH SATISFIES THE
+C SUFFICIENT DECREASE AND CURVATURE CONDITIONS.
+C TOLERANCES MAY BE TOO SMALL.
+C
+C NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF
+C CALLS TO FCN.
+C
+C WA IS A WORK ARRAY OF LENGTH N.
+C
+C SUBPROGRAMS CALLED
+C
+C MCSTEP
+C
+C FORTRAN-SUPPLIED...ABS,MAX,MIN
+C
+C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983
+C JORGE J. MORE', DAVID J. THUENTE
+C
+C **********
+ INTEGER INFOC,J
+ LOGICAL BRACKT,STAGE1
+ DOUBLE PRECISION DG,DGM,DGINIT,DGTEST,DGX,DGXM,DGY,DGYM,
+ * FINIT,FTEST1,FM,FX,FXM,FY,FYM,P5,P66,STX,STY,
+ * STMIN,STMAX,WIDTH,WIDTH1,XTRAPF,ZERO
+ DATA P5,P66,XTRAPF,ZERO /0.5D0,0.66D0,4.0D0,0.0D0/
+ IF(INFO.EQ.-1) GO TO 45
+ INFOC = 1
+C
+C CHECK THE INPUT PARAMETERS FOR ERRORS.
+C
+ IF (N .LE. 0 .OR. STP .LE. ZERO .OR. FTOL .LT. ZERO .OR.
+ * GTOL .LT. ZERO .OR. XTOL .LT. ZERO .OR. STPMIN .LT. ZERO
+ * .OR. STPMAX .LT. STPMIN .OR. MAXFEV .LE. 0) RETURN
+C
+C COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION
+C AND CHECK THAT S IS A DESCENT DIRECTION.
+C
+ DGINIT = ZERO
+ DO 10 J = 1, N
+ DGINIT = DGINIT + G(J)*S(J)
+ 10 CONTINUE
+ IF (DGINIT .GE. ZERO) then
+ CALL LBPTF
+ * ('THE SEARCH DIRECTION IS NOT A DESCENT DIRECTION')
+ RETURN
+ ENDIF
+C
+C INITIALIZE LOCAL VARIABLES.
+C
+ BRACKT = .FALSE.
+ STAGE1 = .TRUE.
+ NFEV = 0
+ FINIT = F
+ DGTEST = FTOL*DGINIT
+ WIDTH = STPMAX - STPMIN
+ WIDTH1 = WIDTH/P5
+ DO 20 J = 1, N
+ WA(J) = X(J)
+ 20 CONTINUE
+C
+C THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP,
+C FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP.
+C THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP,
+C FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF
+C THE INTERVAL OF UNCERTAINTY.
+C THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP,
+C FUNCTION, AND DERIVATIVE AT THE CURRENT STEP.
+C
+ STX = ZERO
+ FX = FINIT
+ DGX = DGINIT
+ STY = ZERO
+ FY = FINIT
+ DGY = DGINIT
+C
+C START OF ITERATION.
+C
+ 30 CONTINUE
+C
+C SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND
+C TO THE PRESENT INTERVAL OF UNCERTAINTY.
+C
+ IF (BRACKT) THEN
+ STMIN = MIN(STX,STY)
+ STMAX = MAX(STX,STY)
+ ELSE
+ STMIN = STX
+ STMAX = STP + XTRAPF*(STP - STX)
+ END IF
+C
+C FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN.
+C
+ STP = MAX(STP,STPMIN)
+ STP = MIN(STP,STPMAX)
+C
+C IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET
+C STP BE THE LOWEST POINT OBTAINED SO FAR.
+C
+ IF ((BRACKT .AND. (STP .LE. STMIN .OR. STP .GE. STMAX))
+ * .OR. NFEV .GE. MAXFEV-1 .OR. INFOC .EQ. 0
+ * .OR. (BRACKT .AND. STMAX-STMIN .LE. XTOL*STMAX)) STP = STX
+C
+C EVALUATE THE FUNCTION AND GRADIENT AT STP
+C AND COMPUTE THE DIRECTIONAL DERIVATIVE.
+C We return to main program to obtain F and G.
+C
+ DO 40 J = 1, N
+ X(J) = WA(J) + STP*S(J)
+ 40 CONTINUE
+ INFO=-1
+ RETURN
+C
+ 45 INFO=0
+ NFEV = NFEV + 1
+ DG = ZERO
+ DO 50 J = 1, N
+ DG = DG + G(J)*S(J)
+ 50 CONTINUE
+ FTEST1 = FINIT + STP*DGTEST
+C
+C TEST FOR CONVERGENCE.
+C
+ IF ((BRACKT .AND. (STP .LE. STMIN .OR. STP .GE. STMAX))
+ * .OR. INFOC .EQ. 0) INFO = 6
+ IF (STP .EQ. STPMAX .AND.
+ * F .LE. FTEST1 .AND. DG .LE. DGTEST) INFO = 5
+ IF (STP .EQ. STPMIN .AND.
+ * (F .GT. FTEST1 .OR. DG .GE. DGTEST)) INFO = 4
+ IF (NFEV .GE. MAXFEV) INFO = 3
+ IF (BRACKT .AND. STMAX-STMIN .LE. XTOL*STMAX) INFO = 2
+ IF (F .LE. FTEST1 .AND. ABS(DG) .LE. GTOL*(-DGINIT)) INFO = 1
+C
+C CHECK FOR TERMINATION.
+C
+ IF (INFO .NE. 0) RETURN
+C
+C IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED
+C FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE.
+C
+ IF (STAGE1 .AND. F .LE. FTEST1 .AND.
+ * DG .GE. MIN(FTOL,GTOL)*DGINIT) STAGE1 = .FALSE.
+C
+C A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF
+C WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED
+C FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE
+C DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN
+C OBTAINED BUT THE DECREASE IS NOT SUFFICIENT.
+C
+ IF (STAGE1 .AND. F .LE. FX .AND. F .GT. FTEST1) THEN
+C
+C DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES.
+C
+ FM = F - STP*DGTEST
+ FXM = FX - STX*DGTEST
+ FYM = FY - STY*DGTEST
+ DGM = DG - DGTEST
+ DGXM = DGX - DGTEST
+ DGYM = DGY - DGTEST
+C
+C CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY
+C AND TO COMPUTE THE NEW STEP.
+C
+ CALL MCSTEP(STX,FXM,DGXM,STY,FYM,DGYM,STP,FM,DGM,
+ * BRACKT,STMIN,STMAX,INFOC)
+C
+C RESET THE FUNCTION AND GRADIENT VALUES FOR F.
+C
+ FX = FXM + STX*DGTEST
+ FY = FYM + STY*DGTEST
+ DGX = DGXM + DGTEST
+ DGY = DGYM + DGTEST
+ ELSE
+C
+C CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY
+C AND TO COMPUTE THE NEW STEP.
+C
+ CALL MCSTEP(STX,FX,DGX,STY,FY,DGY,STP,F,DG,
+ * BRACKT,STMIN,STMAX,INFOC)
+ END IF
+C
+C FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE
+C INTERVAL OF UNCERTAINTY.
+C
+ IF (BRACKT) THEN
+ IF (ABS(STY-STX) .GE. P66*WIDTH1)
+ * STP = STX + P5*(STY - STX)
+ WIDTH1 = WIDTH
+ WIDTH = ABS(STY-STX)
+ END IF
+C
+C END OF ITERATION.
+C
+ GO TO 30
+C
+C LAST LINE OF SUBROUTINE MCSRCH.
+C
+ END
+ SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,
+ * STPMIN,STPMAX,INFO)
+ INTEGER INFO
+ DOUBLE PRECISION STX,FX,DX,STY,FY,DY,STP,FP,DP,STPMIN,STPMAX
+ LOGICAL BRACKT,BOUND
+C
+C SUBROUTINE MCSTEP
+C
+C THE PURPOSE OF MCSTEP IS TO COMPUTE A SAFEGUARDED STEP FOR
+C A LINESEARCH AND TO UPDATE AN INTERVAL OF UNCERTAINTY FOR
+C A MINIMIZER OF THE FUNCTION.
+C
+C THE PARAMETER STX CONTAINS THE STEP WITH THE LEAST FUNCTION
+C VALUE. THE PARAMETER STP CONTAINS THE CURRENT STEP. IT IS
+C ASSUMED THAT THE DERIVATIVE AT STX IS NEGATIVE IN THE
+C DIRECTION OF THE STEP. IF BRACKT IS SET TRUE THEN A
+C MINIMIZER HAS BEEN BRACKETED IN AN INTERVAL OF UNCERTAINTY
+C WITH ENDPOINTS STX AND STY.
+C
+C THE SUBROUTINE STATEMENT IS
+C
+C SUBROUTINE MCSTEP(STX,FX,DX,STY,FY,DY,STP,FP,DP,BRACKT,
+C STPMIN,STPMAX,INFO)
+C
+C WHERE
+C
+C STX, FX, AND DX ARE VARIABLES WHICH SPECIFY THE STEP,
+C THE FUNCTION, AND THE DERIVATIVE AT THE BEST STEP OBTAINED
+C SO FAR. THE DERIVATIVE MUST BE NEGATIVE IN THE DIRECTION
+C OF THE STEP, THAT IS, DX AND STP-STX MUST HAVE OPPOSITE
+C SIGNS. ON OUTPUT THESE PARAMETERS ARE UPDATED APPROPRIATELY.
+C
+C STY, FY, AND DY ARE VARIABLES WHICH SPECIFY THE STEP,
+C THE FUNCTION, AND THE DERIVATIVE AT THE OTHER ENDPOINT OF
+C THE INTERVAL OF UNCERTAINTY. ON OUTPUT THESE PARAMETERS ARE
+C UPDATED APPROPRIATELY.
+C
+C STP, FP, AND DP ARE VARIABLES WHICH SPECIFY THE STEP,
+C THE FUNCTION, AND THE DERIVATIVE AT THE CURRENT STEP.
+C IF BRACKT IS SET TRUE THEN ON INPUT STP MUST BE
+C BETWEEN STX AND STY. ON OUTPUT STP IS SET TO THE NEW STEP.
+C
+C BRACKT IS A LOGICAL VARIABLE WHICH SPECIFIES IF A MINIMIZER
+C HAS BEEN BRACKETED. IF THE MINIMIZER HAS NOT BEEN BRACKETED
+C THEN ON INPUT BRACKT MUST BE SET FALSE. IF THE MINIMIZER
+C IS BRACKETED THEN ON OUTPUT BRACKT IS SET TRUE.
+C
+C STPMIN AND STPMAX ARE INPUT VARIABLES WHICH SPECIFY LOWER
+C AND UPPER BOUNDS FOR THE STEP.
+C
+C INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS:
+C IF INFO = 1,2,3,4,5, THEN THE STEP HAS BEEN COMPUTED
+C ACCORDING TO ONE OF THE FIVE CASES BELOW. OTHERWISE
+C INFO = 0, AND THIS INDICATES IMPROPER INPUT PARAMETERS.
+C
+C SUBPROGRAMS CALLED
+C
+C FORTRAN-SUPPLIED ... ABS,MAX,MIN,SQRT
+C
+C ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983
+C JORGE J. MORE', DAVID J. THUENTE
+C
+ DOUBLE PRECISION GAMMA,P,Q,R,S,SGND,STPC,STPF,STPQ,THETA
+ INFO = 0
+C
+C CHECK THE INPUT PARAMETERS FOR ERRORS.
+C
+ IF ((BRACKT .AND. (STP .LE. MIN(STX,STY) .OR.
+ * STP .GE. MAX(STX,STY))) .OR.
+ * DX*(STP-STX) .GE. 0.0 .OR. STPMAX .LT. STPMIN) RETURN
+C
+C DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN.
+C
+ SGND = DP*(DX/ABS(DX))
+C
+C FIRST CASE. A HIGHER FUNCTION VALUE.
+C THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER
+C TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN,
+C ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN.
+C
+ IF (FP .GT. FX) THEN
+ INFO = 1
+ BOUND = .TRUE.
+ THETA = 3*(FX - FP)/(STP - STX) + DX + DP
+ S = MAX(ABS(THETA),ABS(DX),ABS(DP))
+ GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))
+ IF (STP .LT. STX) GAMMA = -GAMMA
+ P = (GAMMA - DX) + THETA
+ Q = ((GAMMA - DX) + GAMMA) + DP
+ R = P/Q
+ STPC = STX + R*(STP - STX)
+ STPQ = STX + ((DX/((FX-FP)/(STP-STX)+DX))/2)*(STP - STX)
+ IF (ABS(STPC-STX) .LT. ABS(STPQ-STX)) THEN
+ STPF = STPC
+ ELSE
+ STPF = STPC + (STPQ - STPC)/2
+ END IF
+ BRACKT = .TRUE.
+C
+C SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF
+C OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC
+C STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP,
+C THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN.
+C
+ ELSE IF (SGND .LT. 0.0) THEN
+ INFO = 2
+ BOUND = .FALSE.
+ THETA = 3*(FX - FP)/(STP - STX) + DX + DP
+ S = MAX(ABS(THETA),ABS(DX),ABS(DP))
+ GAMMA = S*SQRT((THETA/S)**2 - (DX/S)*(DP/S))
+ IF (STP .GT. STX) GAMMA = -GAMMA
+ P = (GAMMA - DP) + THETA
+ Q = ((GAMMA - DP) + GAMMA) + DX
+ R = P/Q
+ STPC = STP + R*(STX - STP)
+ STPQ = STP + (DP/(DP-DX))*(STX - STP)
+ IF (ABS(STPC-STP) .GT. ABS(STPQ-STP)) THEN
+ STPF = STPC
+ ELSE
+ STPF = STPQ
+ END IF
+ BRACKT = .TRUE.
+C
+C THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE
+C SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES.
+C THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY
+C IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC
+C IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE
+C EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO
+C COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP
+C CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN.
+C
+ ELSE IF (ABS(DP) .LT. ABS(DX)) THEN
+ INFO = 3
+ BOUND = .TRUE.
+ THETA = 3*(FX - FP)/(STP - STX) + DX + DP
+ S = MAX(ABS(THETA),ABS(DX),ABS(DP))
+C
+C THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND
+C TO INFINITY IN THE DIRECTION OF THE STEP.
+C
+ GAMMA = S*SQRT(MAX(0.0D0,(THETA/S)**2 - (DX/S)*(DP/S)))
+ IF (STP .GT. STX) GAMMA = -GAMMA
+ P = (GAMMA - DP) + THETA
+ Q = (GAMMA + (DX - DP)) + GAMMA
+ R = P/Q
+ IF (R .LT. 0.0 .AND. GAMMA .NE. 0.0) THEN
+ STPC = STP + R*(STX - STP)
+ ELSE IF (STP .GT. STX) THEN
+ STPC = STPMAX
+ ELSE
+ STPC = STPMIN
+ END IF
+ STPQ = STP + (DP/(DP-DX))*(STX - STP)
+ IF (BRACKT) THEN
+ IF (ABS(STP-STPC) .LT. ABS(STP-STPQ)) THEN
+ STPF = STPC
+ ELSE
+ STPF = STPQ
+ END IF
+ ELSE
+ IF (ABS(STP-STPC) .GT. ABS(STP-STPQ)) THEN
+ STPF = STPC
+ ELSE
+ STPF = STPQ
+ END IF
+ END IF
+C
+C FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE
+C SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES
+C NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP
+C IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN.
+C
+ ELSE
+ INFO = 4
+ BOUND = .FALSE.
+ IF (BRACKT) THEN
+ THETA = 3*(FP - FY)/(STY - STP) + DY + DP
+ S = MAX(ABS(THETA),ABS(DY),ABS(DP))
+ GAMMA = S*SQRT((THETA/S)**2 - (DY/S)*(DP/S))
+ IF (STP .GT. STY) GAMMA = -GAMMA
+ P = (GAMMA - DP) + THETA
+ Q = ((GAMMA - DP) + GAMMA) + DY
+ R = P/Q
+ STPC = STP + R*(STY - STP)
+ STPF = STPC
+ ELSE IF (STP .GT. STX) THEN
+ STPF = STPMAX
+ ELSE
+ STPF = STPMIN
+ END IF
+ END IF
+C
+C UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT
+C DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE.
+C
+ IF (FP .GT. FX) THEN
+ STY = STP
+ FY = FP
+ DY = DP
+ ELSE
+ IF (SGND .LT. 0.0) THEN
+ STY = STX
+ FY = FX
+ DY = DX
+ END IF
+ STX = STP
+ FX = FP
+ DX = DP
+ END IF
+C
+C COMPUTE THE NEW STEP AND SAFEGUARD IT.
+C
+ STPF = MIN(STPMAX,STPF)
+ STPF = MAX(STPMIN,STPF)
+ STP = STPF
+ IF (BRACKT .AND. BOUND) THEN
+ IF (STY .GT. STX) THEN
+ STP = MIN(STX+0.66*(STY-STX),STP)
+ ELSE
+ STP = MAX(STX+0.66*(STY-STX),STP)
+ END IF
+ END IF
+ RETURN
+C
+C LAST LINE OF SUBROUTINE MCSTEP.
+C
+ END
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.h b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.h
new file mode 100644
index 0000000000000000000000000000000000000000..084fd887a222e5a2e01d92d6d3853a06a04fffba
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lbfgs.h
@@ -0,0 +1,31 @@
+#ifndef lbfgs_h_
+#define lbfgs_h_
+
+struct lb3_1_ {
+/*
+C GTOL is a DOUBLE PRECISION variable with default value 0.9, which
+C controls the accuracy of the line search routine MCSRCH. If the
+C function and gradient evaluations are inexpensive with respect
+C to the cost of the iteration (which is sometimes the case when
+C solving very large problems) it may be advantageous to set GTOL
+C to a small value. A typical small value is 0.1. Restriction:
+C GTOL should be greater than 1.D-04.
+C
+C STPMIN and STPMAX are non-negative DOUBLE PRECISION variables which
+C specify lower and upper bounds for the step in the line search.
+C Their default values are 1.D-20 and 1.D+20, respectively. These
+C values need not be modified unless the exponents are too large
+C for the machine being used, or unless the problem is extremely
+C badly scaled (in which case the exponents should be increased).
+*/
+ int mp, lp; /* Fortran i/o stuff. Unused here. */
+ double gtol, stpmin, stpmax;
+ double stpawf; /* line search default step length, added by awf */
+};
+
+/*#define lb3_1 (*(struct lb3_1_ *) &lb3_)*/
+#define lb3_1 lb3_
+
+extern struct lb3_1_ lb3_1;
+
+#endif /* lbfgs_h_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.c
new file mode 100644
index 0000000000000000000000000000000000000000..30dd1446ba738e73d0399b8f5a6bc0752ef44dd2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.c
@@ -0,0 +1,508 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void lmder_(fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol,
+ maxfev, diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf, wa1, wa2, wa3, wa4)
+/* Subroutine */ void (*fcn) (integer*,integer*,doublereal*,doublereal*,doublereal*,integer*,integer*);
+integer *m, *n;
+doublereal *x, *fvec, *fjac;
+integer *ldfjac;
+doublereal *ftol, *xtol, *gtol;
+integer *maxfev;
+doublereal *diag;
+integer *mode;
+doublereal *factor;
+integer *nprint, *info, *nfev, *njev, *ipvt;
+doublereal *qtf, *wa1, *wa2, *wa3, *wa4;
+{
+ /* Local variables */
+ static integer iter;
+ static doublereal temp, temp1, temp2;
+ static integer i, j, l, iflag;
+ static doublereal delta;
+ static doublereal ratio;
+ static doublereal fnorm, gnorm, pnorm, xnorm, fnorm1, actred, dirder, epsmch, prered;
+ static doublereal par, sum;
+
+/* ********** */
+
+/* subroutine lmder */
+
+/* the purpose of lmder is to minimize the sum of the squares of */
+/* m nonlinear functions in n variables by a modification of */
+/* the levenberg-marquardt algorithm. the user must provide a */
+/* subroutine which calculates the functions and the jacobian. */
+
+/* the subroutine statement is */
+
+/* subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
+/* maxfev,diag,mode,factor,nprint,info,nfev, */
+/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
+
+/* where */
+
+/* fcn is the name of the user-supplied subroutine which */
+/* calculates the functions and the jacobian. fcn must */
+/* be declared in an external statement in the user */
+/* calling program, and should be written as follows. */
+
+/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
+/* integer m,n,ldfjac,iflag */
+/* double precision x(n),fvec(m),fjac(ldfjac,n) */
+/* ---------- */
+/* if iflag = 1 calculate the functions at x and */
+/* return this vector in fvec. do not alter fjac. */
+/* if iflag = 2 calculate the jacobian at x and */
+/* return this matrix in fjac. do not alter fvec. */
+/* ---------- */
+/* return */
+/* end */
+
+/* the value of iflag should not be changed by fcn unless */
+/* the user wants to terminate execution of lmder. */
+/* in this case set iflag to a negative integer. */
+
+/* m is a positive integer input variable set to the number */
+/* of functions. */
+
+/* n is a positive integer input variable set to the number */
+/* of variables. n must not exceed m. */
+
+/* x is an array of length n. on input x must contain */
+/* an initial estimate of the solution vector. on output x */
+/* contains the final estimate of the solution vector. */
+
+/* fvec is an output array of length m which contains */
+/* the functions evaluated at the output x. */
+
+/* fjac is an output m by n array. the upper n by n submatrix */
+/* of fjac contains an upper triangular matrix r with */
+/* diagonal elements of nonincreasing magnitude such that */
+
+/* t t t */
+/* p *(jac *jac)*p = r *r, */
+
+/* where p is a permutation matrix and jac is the final */
+/* calculated jacobian. column j of p is column ipvt(j) */
+/* (see below) of the identity matrix. the lower trapezoidal */
+/* part of fjac contains information generated during */
+/* the computation of r. */
+
+/* ldfjac is a positive integer input variable not less than m */
+/* which specifies the leading dimension of the array fjac. */
+
+/* ftol is a nonnegative input variable. termination */
+/* occurs when both the actual and predicted relative */
+/* reductions in the sum of squares are at most ftol. */
+/* therefore, ftol measures the relative error desired */
+/* in the sum of squares. */
+
+/* xtol is a nonnegative input variable. termination */
+/* occurs when the relative error between two consecutive */
+/* iterates is at most xtol. therefore, xtol measures the */
+/* relative error desired in the approximate solution. */
+
+/* gtol is a nonnegative input variable. termination */
+/* occurs when the cosine of the angle between fvec and */
+/* any column of the jacobian is at most gtol in absolute */
+/* value. therefore, gtol measures the orthogonality */
+/* desired between the function vector and the columns */
+/* of the jacobian. */
+
+/* maxfev is a positive integer input variable. termination */
+/* occurs when the number of calls to fcn with iflag = 1 */
+/* has reached maxfev. */
+
+/* diag is an array of length n. if mode = 1 (see */
+/* below), diag is internally set. if mode = 2, diag */
+/* must contain positive entries that serve as */
+/* multiplicative scale factors for the variables. */
+
+/* mode is an integer input variable. if mode = 1, the */
+/* variables will be scaled internally. if mode = 2, */
+/* the scaling is specified by the input diag. other */
+/* values of mode are equivalent to mode = 1. */
+
+/* factor is a positive input variable used in determining the */
+/* initial step bound. this bound is set to the product of */
+/* factor and the euclidean norm of diag*x if nonzero, or else */
+/* to factor itself. in most cases factor should lie in the */
+/* interval (.1,100.).100. is a generally recommended value. */
+
+/* nprint is an integer input variable that enables controlled */
+/* printing of iterates if it is positive. in this case, */
+/* fcn is called with iflag = 0 at the beginning of the first */
+/* iteration and every nprint iterations thereafter and */
+/* immediately prior to return, with x, fvec, and fjac */
+/* available for printing. fvec and fjac should not be */
+/* altered. if nprint is not positive, no special calls */
+/* of fcn with iflag = 0 are made. */
+
+/* info is an integer output variable. if the user has */
+/* terminated execution, info is set to the (negative) */
+/* value of iflag. see description of fcn. otherwise, */
+/* info is set as follows. */
+
+/* info = 0 improper input parameters. */
+
+/* info = 1 both actual and predicted relative reductions */
+/* in the sum of squares are at most ftol. */
+
+/* info = 2 relative error between two consecutive iterates */
+/* is at most xtol. */
+
+/* info = 3 conditions for info = 1 and info = 2 both hold. */
+
+/* info = 4 the cosine of the angle between fvec and any */
+/* column of the jacobian is at most gtol in */
+/* absolute value. */
+
+/* info = 5 number of calls to fcn with iflag = 1 has */
+/* reached maxfev. */
+
+/* info = 6 ftol is too small. no further reduction in */
+/* the sum of squares is possible. */
+
+/* info = 7 xtol is too small. no further improvement in */
+/* the approximate solution x is possible. */
+
+/* info = 8 gtol is too small. fvec is orthogonal to the */
+/* columns of the jacobian to machine precision. */
+
+/* nfev is an integer output variable set to the number of */
+/* calls to fcn with iflag = 1. */
+
+/* njev is an integer output variable set to the number of */
+/* calls to fcn with iflag = 2. */
+
+/* ipvt is an integer output array of length n. ipvt */
+/* defines a permutation matrix p such that jac*p = q*r, */
+/* where jac is the final calculated jacobian, q is */
+/* orthogonal (not stored), and r is upper triangular */
+/* with diagonal elements of nonincreasing magnitude. */
+/* column j of p is column ipvt(j) of the identity matrix. */
+
+/* qtf is an output array of length n which contains */
+/* the first n elements of the vector (q transpose)*fvec. */
+
+/* wa1, wa2, and wa3 are work arrays of length n. */
+
+/* wa4 is a work array of length m. */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+
+/* ********** */
+
+/* epsmch is the machine precision. */
+
+ epsmch = dpmpar_(&c__1);
+
+ *info = 0;
+ iflag = 0;
+ *nfev = 0;
+ *njev = 0;
+
+/* check the input parameters for errors. */
+
+ if (*n <= 0 || *m < *n || *ldfjac < *m || *ftol < 0. || *xtol < 0. || *gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
+ goto L300;
+ }
+ if (*mode == 2)
+ for (j = 0; j < *n; ++j) {
+ if (diag[j] <= 0.) {
+ goto L300;
+ }
+ }
+
+/* evaluate the function at the starting point */
+/* and calculate its norm. */
+
+ iflag = 1;
+ (*fcn)(m, n, x, fvec, fjac, ldfjac, &iflag);
+ *nfev = 1;
+ if (iflag < 0) {
+ goto L300;
+ }
+ fnorm = enorm_(m, fvec);
+
+/* initialize levenberg-marquardt parameter and iteration counter. */
+
+ par = 0.;
+ iter = 1;
+
+/* beginning of the outer loop. */
+
+L30:
+
+/* calculate the jacobian matrix. */
+
+ iflag = 2;
+ (*fcn)(m, n, x, fvec, fjac, ldfjac, &iflag);
+ ++(*njev);
+ if (iflag < 0) {
+ goto L300;
+ }
+
+/* if requested, call fcn to enable printing of iterates. */
+
+ if (*nprint > 0)
+ if ((iter - 1) % *nprint == 0) {
+ iflag = 0;
+ (*fcn)(m, n, x, fvec, fjac, ldfjac, &iflag);
+ if (iflag < 0) {
+ goto L300;
+ }
+ }
+
+/* compute the qr factorization of the jacobian. */
+
+ qrfac_(m, n, fjac, ldfjac, &c__1, ipvt, n, wa1, wa2, wa3);
+
+/* on the first iteration and if mode is 1, scale according */
+/* to the norms of the columns of the initial jacobian. */
+
+ if (iter != 1) {
+ goto L80;
+ }
+ if (*mode != 2)
+ for (j = 0; j < *n; ++j) {
+ diag[j] = wa2[j];
+ if (wa2[j] == 0.) {
+ diag[j] = 1.;
+ }
+ }
+
+/* on the first iteration, calculate the norm of the scaled x */
+/* and initialize the step bound delta. */
+
+ for (j = 0; j < *n; ++j) {
+ wa3[j] = diag[j] * x[j];
+ }
+ xnorm = enorm_(n, wa3);
+ delta = *factor * xnorm;
+ if (delta == 0.) {
+ delta = *factor;
+ }
+L80:
+
+/* form (q transpose)*fvec and store the first n components in */
+/* qtf. */
+
+ for (i = 0; i < *m; ++i) {
+ wa4[i] = fvec[i];
+ }
+ for (j = 0; j < *n; ++j) {
+ if (fjac[j + j * *ldfjac] == 0.) {
+ goto L120;
+ }
+ sum = 0.;
+ for (i = j; i < *m; ++i) {
+ sum += fjac[i + j * *ldfjac] * wa4[i];
+ }
+ temp = -sum / fjac[j + j * *ldfjac];
+ for (i = j; i < *m; ++i) {
+ wa4[i] += fjac[i + j * *ldfjac] * temp;
+ }
+L120:
+ fjac[j + j * *ldfjac] = wa1[j];
+ qtf[j] = wa4[j];
+ }
+
+/* compute the norm of the scaled gradient. */
+
+ gnorm = 0.;
+ if (fnorm != 0.)
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ if (wa2[l] == 0.)
+ continue;
+ sum = 0.;
+ for (i = 0; i <= j; ++i) {
+ sum += fjac[i + j * *ldfjac] * (qtf[i] / fnorm);
+ }
+ gnorm = max(gnorm,abs(sum / wa2[l]));
+ }
+
+/* test for convergence of the gradient norm. */
+
+ if (gnorm <= *gtol) {
+ *info = 4;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* rescale if necessary. */
+
+ if (*mode != 2)
+ for (j = 0; j < *n; ++j) {
+ diag[j] = max(diag[j],wa2[j]);
+ }
+
+/* beginning of the inner loop. */
+
+L200:
+
+/* determine the levenberg-marquardt parameter. */
+
+ lmpar_(n, fjac, ldfjac, ipvt, diag, qtf, &delta, &par, wa1, wa2, wa3, wa4);
+
+/* store the direction p and x + p. calculate the norm of p. */
+
+ for (j = 0; j < *n; ++j) {
+ wa1[j] = -wa1[j];
+ wa2[j] = x[j] + wa1[j];
+ wa3[j] = diag[j] * wa1[j];
+ }
+ pnorm = enorm_(n, wa3);
+
+/* on the first iteration, adjust the initial step bound. */
+
+ if (iter == 1) {
+ delta = min(delta,pnorm);
+ }
+
+/* evaluate the function at x + p and calculate its norm. */
+
+ iflag = 1;
+ (*fcn)(m, n, wa2, wa4, fjac, ldfjac, &iflag);
+ ++(*nfev);
+ if (iflag < 0) {
+ goto L300;
+ }
+ fnorm1 = enorm_(m, wa4);
+
+/* compute the scaled actual reduction. */
+
+ actred = -1.;
+ if (.1 * fnorm1 < fnorm) {
+ actred = fnorm1 / fnorm;
+ actred = 1. - actred * actred;
+ }
+
+/* compute the scaled predicted reduction and */
+/* the scaled directional derivative. */
+
+ for (j = 0; j < *n; ++j) {
+ wa3[j] = 0.;
+ l = ipvt[j] - 1;
+ temp = wa1[l];
+ for (i = 0; i <= j; ++i) {
+ wa3[i] += fjac[i + j * *ldfjac] * temp;
+ }
+ }
+ temp1 = enorm_(n, wa3) / fnorm;
+ temp2 = sqrt(par) * pnorm / fnorm;
+ prered = temp1 * temp1 + temp2 * temp2 / .5;
+ dirder = -(temp1 * temp1 + temp2 * temp2);
+
+/* compute the ratio of the actual to the predicted */
+/* reduction. */
+
+ ratio = 0.;
+ if (prered != 0.) {
+ ratio = actred / prered;
+ }
+
+/* update the step bound. */
+
+ if (ratio > .25) {
+ if (par == 0. || ratio >= .75) {
+ delta = pnorm / .5;
+ par *= .5;
+ }
+ goto L240;
+ }
+ if (actred >= 0.) {
+ temp = .5;
+ }
+ if (actred < 0.) {
+ temp = .5 * dirder / (dirder + .5 * actred);
+ }
+ if (.1 * fnorm1 >= fnorm || temp < .1) {
+ temp = .1;
+ }
+ delta = temp * min(delta,pnorm/.1);
+ par /= temp;
+L240:
+
+/* test for successful iteration. */
+
+ if (ratio < .0001) {
+ goto L290;
+ }
+
+/* successful iteration. update x, fvec, and their norms. */
+
+ for (j = 0; j < *n; ++j) {
+ x[j] = wa2[j];
+ wa2[j] = diag[j] * x[j];
+ }
+ for (i = 0; i < *m; ++i) {
+ fvec[i] = wa4[i];
+ }
+ xnorm = enorm_(n, wa2);
+ fnorm = fnorm1;
+ ++iter;
+L290:
+
+/* tests for convergence. */
+
+ if (abs(actred) <= *ftol && prered <= *ftol && .5 * ratio <= 1.) {
+ *info = 1;
+ }
+ if (delta <= *xtol * xnorm) {
+ *info = 2;
+ }
+ if (abs(actred) <= *ftol && prered <= *ftol && .5 * ratio <= 1. && *info == 2) {
+ *info = 3;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* tests for termination and stringent tolerances. */
+
+ if (*nfev >= *maxfev) {
+ *info = 5;
+ }
+ if (abs(actred) <= epsmch && prered <= epsmch && .5 * ratio <= 1.) {
+ *info = 6;
+ }
+ if (delta <= epsmch * xnorm) {
+ *info = 7;
+ }
+ if (gnorm <= epsmch) {
+ *info = 8;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* end of the inner loop. repeat if iteration unsuccessful. */
+
+ if (ratio < .0001) {
+ goto L200;
+ }
+
+/* end of the outer loop. */
+
+ goto L30;
+L300:
+
+/* termination, either normal or user imposed. */
+
+ if (iflag < 0) {
+ *info = iflag;
+ }
+ iflag = 0;
+ if (*nprint > 0) {
+ (*fcn)(m, n, x, fvec, fjac, ldfjac, &iflag);
+ }
+
+} /* lmder_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.f
new file mode 100644
index 0000000000000000000000000000000000000000..8797d8bed89883c79ed741575e502d24ae2140a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder.f
@@ -0,0 +1,452 @@
+ subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol,
+ * maxfev,diag,mode,factor,nprint,info,nfev,njev,
+ * ipvt,qtf,wa1,wa2,wa3,wa4)
+ integer m,n,ldfjac,maxfev,mode,nprint,info,nfev,njev
+ integer ipvt(n)
+ double precision ftol,xtol,gtol,factor
+ double precision x(n),fvec(m),fjac(ldfjac,n),diag(n),qtf(n),
+ * wa1(n),wa2(n),wa3(n),wa4(m)
+c **********
+c
+c subroutine lmder
+c
+c the purpose of lmder is to minimize the sum of the squares of
+c m nonlinear functions in n variables by a modification of
+c the levenberg-marquardt algorithm. the user must provide a
+c subroutine which calculates the functions and the jacobian.
+c
+c the subroutine statement is
+c
+c subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol,
+c maxfev,diag,mode,factor,nprint,info,nfev,
+c njev,ipvt,qtf,wa1,wa2,wa3,wa4)
+c
+c where
+c
+c fcn is the name of the user-supplied subroutine which
+c calculates the functions and the jacobian. fcn must
+c be declared in an external statement in the user
+c calling program, and should be written as follows.
+c
+c subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+c integer m,n,ldfjac,iflag
+c double precision x(n),fvec(m),fjac(ldfjac,n)
+c ----------
+c if iflag = 1 calculate the functions at x and
+c return this vector in fvec. do not alter fjac.
+c if iflag = 2 calculate the jacobian at x and
+c return this matrix in fjac. do not alter fvec.
+c ----------
+c return
+c end
+c
+c the value of iflag should not be changed by fcn unless
+c the user wants to terminate execution of lmder.
+c in this case set iflag to a negative integer.
+c
+c m is a positive integer input variable set to the number
+c of functions.
+c
+c n is a positive integer input variable set to the number
+c of variables. n must not exceed m.
+c
+c x is an array of length n. on input x must contain
+c an initial estimate of the solution vector. on output x
+c contains the final estimate of the solution vector.
+c
+c fvec is an output array of length m which contains
+c the functions evaluated at the output x.
+c
+c fjac is an output m by n array. the upper n by n submatrix
+c of fjac contains an upper triangular matrix r with
+c diagonal elements of nonincreasing magnitude such that
+c
+c t t t
+c p *(jac *jac)*p = r *r,
+c
+c where p is a permutation matrix and jac is the final
+c calculated jacobian. column j of p is column ipvt(j)
+c (see below) of the identity matrix. the lower trapezoidal
+c part of fjac contains information generated during
+c the computation of r.
+c
+c ldfjac is a positive integer input variable not less than m
+c which specifies the leading dimension of the array fjac.
+c
+c ftol is a nonnegative input variable. termination
+c occurs when both the actual and predicted relative
+c reductions in the sum of squares are at most ftol.
+c therefore, ftol measures the relative error desired
+c in the sum of squares.
+c
+c xtol is a nonnegative input variable. termination
+c occurs when the relative error between two consecutive
+c iterates is at most xtol. therefore, xtol measures the
+c relative error desired in the approximate solution.
+c
+c gtol is a nonnegative input variable. termination
+c occurs when the cosine of the angle between fvec and
+c any column of the jacobian is at most gtol in absolute
+c value. therefore, gtol measures the orthogonality
+c desired between the function vector and the columns
+c of the jacobian.
+c
+c maxfev is a positive integer input variable. termination
+c occurs when the number of calls to fcn with iflag = 1
+c has reached maxfev.
+c
+c diag is an array of length n. if mode = 1 (see
+c below), diag is internally set. if mode = 2, diag
+c must contain positive entries that serve as
+c multiplicative scale factors for the variables.
+c
+c mode is an integer input variable. if mode = 1, the
+c variables will be scaled internally. if mode = 2,
+c the scaling is specified by the input diag. other
+c values of mode are equivalent to mode = 1.
+c
+c factor is a positive input variable used in determining the
+c initial step bound. this bound is set to the product of
+c factor and the euclidean norm of diag*x if nonzero, or else
+c to factor itself. in most cases factor should lie in the
+c interval (.1,100.).100. is a generally recommended value.
+c
+c nprint is an integer input variable that enables controlled
+c printing of iterates if it is positive. in this case,
+c fcn is called with iflag = 0 at the beginning of the first
+c iteration and every nprint iterations thereafter and
+c immediately prior to return, with x, fvec, and fjac
+c available for printing. fvec and fjac should not be
+c altered. if nprint is not positive, no special calls
+c of fcn with iflag = 0 are made.
+c
+c info is an integer output variable. if the user has
+c terminated execution, info is set to the (negative)
+c value of iflag. see description of fcn. otherwise,
+c info is set as follows.
+c
+c info = 0 improper input parameters.
+c
+c info = 1 both actual and predicted relative reductions
+c in the sum of squares are at most ftol.
+c
+c info = 2 relative error between two consecutive iterates
+c is at most xtol.
+c
+c info = 3 conditions for info = 1 and info = 2 both hold.
+c
+c info = 4 the cosine of the angle between fvec and any
+c column of the jacobian is at most gtol in
+c absolute value.
+c
+c info = 5 number of calls to fcn with iflag = 1 has
+c reached maxfev.
+c
+c info = 6 ftol is too small. no further reduction in
+c the sum of squares is possible.
+c
+c info = 7 xtol is too small. no further improvement in
+c the approximate solution x is possible.
+c
+c info = 8 gtol is too small. fvec is orthogonal to the
+c columns of the jacobian to machine precision.
+c
+c nfev is an integer output variable set to the number of
+c calls to fcn with iflag = 1.
+c
+c njev is an integer output variable set to the number of
+c calls to fcn with iflag = 2.
+c
+c ipvt is an integer output array of length n. ipvt
+c defines a permutation matrix p such that jac*p = q*r,
+c where jac is the final calculated jacobian, q is
+c orthogonal (not stored), and r is upper triangular
+c with diagonal elements of nonincreasing magnitude.
+c column j of p is column ipvt(j) of the identity matrix.
+c
+c qtf is an output array of length n which contains
+c the first n elements of the vector (q transpose)*fvec.
+c
+c wa1, wa2, and wa3 are work arrays of length n.
+c
+c wa4 is a work array of length m.
+c
+c subprograms called
+c
+c user-supplied ...... fcn
+c
+c minpack-supplied ... dpmpar,enorm,lmpar,qrfac
+c
+c fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod
+c
+c argonne national laboratory. minpack project. march 1980.
+c burton s. garbow, kenneth e. hillstrom, jorge j. more
+c
+c **********
+ integer i,iflag,iter,j,l
+ double precision actred,delta,dirder,epsmch,fnorm,fnorm1,gnorm,
+ * one,par,pnorm,prered,p1,p5,p25,p75,p0001,ratio,
+ * sum,temp,temp1,temp2,xnorm,zero
+ double precision dpmpar,enorm
+ data one,p1,p5,p25,p75,p0001,zero
+ * /1.0d0,1.0d-1,5.0d-1,2.5d-1,7.5d-1,1.0d-4,0.0d0/
+c
+c epsmch is the machine precision.
+c
+ epsmch = dpmpar(1)
+c
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+c
+c check the input parameters for errors.
+c
+ if (n .le. 0 .or. m .lt. n .or. ldfjac .lt. m
+ * .or. ftol .lt. zero .or. xtol .lt. zero .or. gtol .lt. zero
+ * .or. maxfev .le. 0 .or. factor .le. zero) go to 300
+ if (mode .ne. 2) go to 20
+ do 10 j = 1, n
+ if (diag(j) .le. zero) go to 300
+ 10 continue
+ 20 continue
+c
+c evaluate the function at the starting point
+c and calculate its norm.
+c
+ iflag = 1
+ call fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+ nfev = 1
+ if (iflag .lt. 0) go to 300
+ fnorm = enorm(m,fvec)
+c
+c initialize levenberg-marquardt parameter and iteration counter.
+c
+ par = zero
+ iter = 1
+c
+c beginning of the outer loop.
+c
+ 30 continue
+c
+c calculate the jacobian matrix.
+c
+ iflag = 2
+ call fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+ njev = njev + 1
+ if (iflag .lt. 0) go to 300
+c
+c if requested, call fcn to enable printing of iterates.
+c
+ if (nprint .le. 0) go to 40
+ iflag = 0
+ if (mod(iter-1,nprint) .eq. 0)
+ * call fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+ if (iflag .lt. 0) go to 300
+ 40 continue
+c
+c compute the qr factorization of the jacobian.
+c
+ call qrfac(m,n,fjac,ldfjac,.true.,ipvt,n,wa1,wa2,wa3)
+c
+c on the first iteration and if mode is 1, scale according
+c to the norms of the columns of the initial jacobian.
+c
+ if (iter .ne. 1) go to 80
+ if (mode .eq. 2) go to 60
+ do 50 j = 1, n
+ diag(j) = wa2(j)
+ if (wa2(j) .eq. zero) diag(j) = one
+ 50 continue
+ 60 continue
+c
+c on the first iteration, calculate the norm of the scaled x
+c and initialize the step bound delta.
+c
+ do 70 j = 1, n
+ wa3(j) = diag(j)*x(j)
+ 70 continue
+ xnorm = enorm(n,wa3)
+ delta = factor*xnorm
+ if (delta .eq. zero) delta = factor
+ 80 continue
+c
+c form (q transpose)*fvec and store the first n components in
+c qtf.
+c
+ do 90 i = 1, m
+ wa4(i) = fvec(i)
+ 90 continue
+ do 130 j = 1, n
+ if (fjac(j,j) .eq. zero) go to 120
+ sum = zero
+ do 100 i = j, m
+ sum = sum + fjac(i,j)*wa4(i)
+ 100 continue
+ temp = -sum/fjac(j,j)
+ do 110 i = j, m
+ wa4(i) = wa4(i) + fjac(i,j)*temp
+ 110 continue
+ 120 continue
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+ 130 continue
+c
+c compute the norm of the scaled gradient.
+c
+ gnorm = zero
+ if (fnorm .eq. zero) go to 170
+ do 160 j = 1, n
+ l = ipvt(j)
+ if (wa2(l) .eq. zero) go to 150
+ sum = zero
+ do 140 i = 1, j
+ sum = sum + fjac(i,j)*(qtf(i)/fnorm)
+ 140 continue
+ gnorm = dmax1(gnorm,dabs(sum/wa2(l)))
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c test for convergence of the gradient norm.
+c
+ if (gnorm .le. gtol) info = 4
+ if (info .ne. 0) go to 300
+c
+c rescale if necessary.
+c
+ if (mode .eq. 2) go to 190
+ do 180 j = 1, n
+ diag(j) = dmax1(diag(j),wa2(j))
+ 180 continue
+ 190 continue
+c
+c beginning of the inner loop.
+c
+ 200 continue
+c
+c determine the levenberg-marquardt parameter.
+c
+ call lmpar(n,fjac,ldfjac,ipvt,diag,qtf,delta,par,wa1,wa2,
+ * wa3,wa4)
+c
+c store the direction p and x + p. calculate the norm of p.
+c
+ do 210 j = 1, n
+ wa1(j) = -wa1(j)
+ wa2(j) = x(j) + wa1(j)
+ wa3(j) = diag(j)*wa1(j)
+ 210 continue
+ pnorm = enorm(n,wa3)
+c
+c on the first iteration, adjust the initial step bound.
+c
+ if (iter .eq. 1) delta = dmin1(delta,pnorm)
+c
+c evaluate the function at x + p and calculate its norm.
+c
+ iflag = 1
+ call fcn(m,n,wa2,wa4,fjac,ldfjac,iflag)
+ nfev = nfev + 1
+ if (iflag .lt. 0) go to 300
+ fnorm1 = enorm(m,wa4)
+c
+c compute the scaled actual reduction.
+c
+ actred = -one
+ if (p1*fnorm1 .lt. fnorm) actred = one - (fnorm1/fnorm)**2
+c
+c compute the scaled predicted reduction and
+c the scaled directional derivative.
+c
+ do 230 j = 1, n
+ wa3(j) = zero
+ l = ipvt(j)
+ temp = wa1(l)
+ do 220 i = 1, j
+ wa3(i) = wa3(i) + fjac(i,j)*temp
+ 220 continue
+ 230 continue
+ temp1 = enorm(n,wa3)/fnorm
+ temp2 = (dsqrt(par)*pnorm)/fnorm
+ prered = temp1**2 + temp2**2/p5
+ dirder = -(temp1**2 + temp2**2)
+c
+c compute the ratio of the actual to the predicted
+c reduction.
+c
+ ratio = zero
+ if (prered .ne. zero) ratio = actred/prered
+c
+c update the step bound.
+c
+ if (ratio .gt. p25) go to 240
+ if (actred .ge. zero) temp = p5
+ if (actred .lt. zero)
+ * temp = p5*dirder/(dirder + p5*actred)
+ if (p1*fnorm1 .ge. fnorm .or. temp .lt. p1) temp = p1
+ delta = temp*dmin1(delta,pnorm/p1)
+ par = par/temp
+ go to 260
+ 240 continue
+ if (par .ne. zero .and. ratio .lt. p75) go to 250
+ delta = pnorm/p5
+ par = p5*par
+ 250 continue
+ 260 continue
+c
+c test for successful iteration.
+c
+ if (ratio .lt. p0001) go to 290
+c
+c successful iteration. update x, fvec, and their norms.
+c
+ do 270 j = 1, n
+ x(j) = wa2(j)
+ wa2(j) = diag(j)*x(j)
+ 270 continue
+ do 280 i = 1, m
+ fvec(i) = wa4(i)
+ 280 continue
+ xnorm = enorm(n,wa2)
+ fnorm = fnorm1
+ iter = iter + 1
+ 290 continue
+c
+c tests for convergence.
+c
+ if (dabs(actred) .le. ftol .and. prered .le. ftol
+ * .and. p5*ratio .le. one) info = 1
+ if (delta .le. xtol*xnorm) info = 2
+ if (dabs(actred) .le. ftol .and. prered .le. ftol
+ * .and. p5*ratio .le. one .and. info .eq. 2) info = 3
+ if (info .ne. 0) go to 300
+c
+c tests for termination and stringent tolerances.
+c
+ if (nfev .ge. maxfev) info = 5
+ if (dabs(actred) .le. epsmch .and. prered .le. epsmch
+ * .and. p5*ratio .le. one) info = 6
+ if (delta .le. epsmch*xnorm) info = 7
+ if (gnorm .le. epsmch) info = 8
+ if (info .ne. 0) go to 300
+c
+c end of the inner loop. repeat if iteration unsuccessful.
+c
+ if (ratio .lt. p0001) go to 200
+c
+c end of the outer loop.
+c
+ go to 30
+ 300 continue
+c
+c termination, either normal or user imposed.
+c
+ if (iflag .lt. 0) info = iflag
+ iflag = 0
+ if (nprint .gt. 0) call fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+ return
+c
+c last card of subroutine lmder.
+c
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.c
new file mode 100644
index 0000000000000000000000000000000000000000..c9b9d7fa5af0ed3e42fe415980638c05ffcb2757
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.c
@@ -0,0 +1,170 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void lmder1_(fcn, m, n, x, fvec, fjac, ldfjac, tol, info, ipvt, wa, lwa)
+void (*fcn)(integer*,integer*,doublereal*,doublereal*,doublereal*,integer*,integer*);
+integer *m, *n;
+doublereal *x, *fvec, *fjac;
+integer *ldfjac;
+doublereal *tol;
+integer *info, *ipvt;
+doublereal *wa;
+integer *lwa;
+{
+ /* Initialized data */
+
+ static doublereal factor = 100.;
+
+ /* Local variables */
+ static integer mode, nfev, njev;
+ static doublereal ftol, gtol, xtol;
+ static integer maxfev, nprint;
+
+/* ********** */
+
+/* subroutine lmder1 */
+
+/* the purpose of lmder1 is to minimize the sum of the squares of */
+/* m nonlinear functions in n variables by a modification of the */
+/* levenberg-marquardt algorithm. this is done by using the more */
+/* general least-squares solver lmder. the user must provide a */
+/* subroutine which calculates the functions and the jacobian. */
+
+/* the subroutine statement is */
+
+/* subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
+/* ipvt,wa,lwa) */
+
+/* where */
+
+/* fcn is the name of the user-supplied subroutine which */
+/* calculates the functions and the jacobian. fcn must */
+/* be declared in an external statement in the user */
+/* calling program, and should be written as follows. */
+
+/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
+/* integer m,n,ldfjac,iflag */
+/* double precision x(n),fvec(m),fjac(ldfjac,n) */
+/* ---------- */
+/* if iflag = 1 calculate the functions at x and */
+/* return this vector in fvec. do not alter fjac. */
+/* if iflag = 2 calculate the jacobian at x and */
+/* return this matrix in fjac. do not alter fvec. */
+/* ---------- */
+/* return */
+/* end */
+
+/* the value of iflag should not be changed by fcn unless */
+/* the user wants to terminate execution of lmder1. */
+/* in this case set iflag to a negative integer. */
+
+/* m is a positive integer input variable set to the number */
+/* of functions. */
+
+/* n is a positive integer input variable set to the number */
+/* of variables. n must not exceed m. */
+
+/* x is an array of length n. on input x must contain */
+/* an initial estimate of the solution vector. on output x */
+/* contains the final estimate of the solution vector. */
+
+/* fvec is an output array of length m which contains */
+/* the functions evaluated at the output x. */
+
+/* fjac is an output m by n array. the upper n by n submatrix */
+/* of fjac contains an upper triangular matrix r with */
+/* diagonal elements of nonincreasing magnitude such that */
+
+/* t t t */
+/* p *(jac *jac)*p = r *r, */
+
+/* where p is a permutation matrix and jac is the final */
+/* calculated jacobian. column j of p is column ipvt(j) */
+/* (see below) of the identity matrix. the lower trapezoidal */
+/* part of fjac contains information generated during */
+/* the computation of r. */
+
+/* ldfjac is a positive integer input variable not less than m */
+/* which specifies the leading dimension of the array fjac. */
+
+/* tol is a nonnegative input variable. termination occurs */
+/* when the algorithm estimates either that the relative */
+/* error in the sum of squares is at most tol or that */
+/* the relative error between x and the solution is at */
+/* most tol. */
+
+/* info is an integer output variable. if the user has */
+/* terminated execution, info is set to the (negative) */
+/* value of iflag. see description of fcn. otherwise, */
+/* info is set as follows. */
+
+/* info = 0 improper input parameters. */
+
+/* info = 1 algorithm estimates that the relative error */
+/* in the sum of squares is at most tol. */
+
+/* info = 2 algorithm estimates that the relative error */
+/* between x and the solution is at most tol. */
+
+/* info = 3 conditions for info = 1 and info = 2 both hold. */
+
+/* info = 4 fvec is orthogonal to the columns of the */
+/* jacobian to machine precision. */
+
+/* info = 5 number of calls to fcn with iflag = 1 has */
+/* reached 100*(n+1). */
+
+/* info = 6 tol is too small. no further reduction in */
+/* the sum of squares is possible. */
+
+/* info = 7 tol is too small. no further improvement in */
+/* the approximate solution x is possible. */
+
+/* ipvt is an integer output array of length n. ipvt */
+/* defines a permutation matrix p such that jac*p = q*r, */
+/* where jac is the final calculated jacobian, q is */
+/* orthogonal (not stored), and r is upper triangular */
+/* with diagonal elements of nonincreasing magnitude. */
+/* column j of p is column ipvt(j) of the identity matrix. */
+
+/* wa is a work array of length lwa. */
+
+/* lwa is a positive integer input variable not less than 5*n+m. */
+
+/* subprograms called */
+
+/* user-supplied ...... fcn */
+
+/* minpack-supplied ... lmder */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+
+/* ********** */
+
+ *info = 0;
+
+/* check the input parameters for errors. */
+
+ if (*n <= 0 || *m < *n || *ldfjac < *m || *tol < 0. || *lwa < *n * 5 + *m)
+ return;
+
+/* call lmder. */
+
+ maxfev = (*n + 1) * 100;
+ ftol = *tol;
+ xtol = *tol;
+ gtol = 0.;
+ mode = 1;
+ nprint = 0;
+ lmder_(fcn, m, n, x, fvec, fjac, ldfjac, &ftol, &xtol, >ol, &maxfev, wa, &mode, &factor, &nprint,
+ info, &nfev, &njev, ipvt, &wa[*n], &wa[*n << 1], &wa[*n * 3], &wa[(*n << 2)], &wa[*n * 5]);
+
+#ifdef NUMERICS_DEBUG
+ printf("INFO = %d\n", *info);
+#endif
+ if (*info == 8) {
+ *info = 4;
+ }
+
+} /* lmder1_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.f
new file mode 100644
index 0000000000000000000000000000000000000000..d691940fd7b76378a6752ce69fcc798575d67433
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmder1.f
@@ -0,0 +1,156 @@
+ subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info,ipvt,wa,
+ * lwa)
+ integer m,n,ldfjac,info,lwa
+ integer ipvt(n)
+ double precision tol
+ double precision x(n),fvec(m),fjac(ldfjac,n),wa(lwa)
+ external fcn
+c **********
+c
+c subroutine lmder1
+c
+c the purpose of lmder1 is to minimize the sum of the squares of
+c m nonlinear functions in n variables by a modification of the
+c levenberg-marquardt algorithm. this is done by using the more
+c general least-squares solver lmder. the user must provide a
+c subroutine which calculates the functions and the jacobian.
+c
+c the subroutine statement is
+c
+c subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info,
+c ipvt,wa,lwa)
+c
+c where
+c
+c fcn is the name of the user-supplied subroutine which
+c calculates the functions and the jacobian. fcn must
+c be declared in an external statement in the user
+c calling program, and should be written as follows.
+c
+c subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag)
+c integer m,n,ldfjac,iflag
+c double precision x(n),fvec(m),fjac(ldfjac,n)
+c ----------
+c if iflag = 1 calculate the functions at x and
+c return this vector in fvec. do not alter fjac.
+c if iflag = 2 calculate the jacobian at x and
+c return this matrix in fjac. do not alter fvec.
+c ----------
+c return
+c end
+c
+c the value of iflag should not be changed by fcn unless
+c the user wants to terminate execution of lmder1.
+c in this case set iflag to a negative integer.
+c
+c m is a positive integer input variable set to the number
+c of functions.
+c
+c n is a positive integer input variable set to the number
+c of variables. n must not exceed m.
+c
+c x is an array of length n. on input x must contain
+c an initial estimate of the solution vector. on output x
+c contains the final estimate of the solution vector.
+c
+c fvec is an output array of length m which contains
+c the functions evaluated at the output x.
+c
+c fjac is an output m by n array. the upper n by n submatrix
+c of fjac contains an upper triangular matrix r with
+c diagonal elements of nonincreasing magnitude such that
+c
+c t t t
+c p *(jac *jac)*p = r *r,
+c
+c where p is a permutation matrix and jac is the final
+c calculated jacobian. column j of p is column ipvt(j)
+c (see below) of the identity matrix. the lower trapezoidal
+c part of fjac contains information generated during
+c the computation of r.
+c
+c ldfjac is a positive integer input variable not less than m
+c which specifies the leading dimension of the array fjac.
+c
+c tol is a nonnegative input variable. termination occurs
+c when the algorithm estimates either that the relative
+c error in the sum of squares is at most tol or that
+c the relative error between x and the solution is at
+c most tol.
+c
+c info is an integer output variable. if the user has
+c terminated execution, info is set to the (negative)
+c value of iflag. see description of fcn. otherwise,
+c info is set as follows.
+c
+c info = 0 improper input parameters.
+c
+c info = 1 algorithm estimates that the relative error
+c in the sum of squares is at most tol.
+c
+c info = 2 algorithm estimates that the relative error
+c between x and the solution is at most tol.
+c
+c info = 3 conditions for info = 1 and info = 2 both hold.
+c
+c info = 4 fvec is orthogonal to the columns of the
+c jacobian to machine precision.
+c
+c info = 5 number of calls to fcn with iflag = 1 has
+c reached 100*(n+1).
+c
+c info = 6 tol is too small. no further reduction in
+c the sum of squares is possible.
+c
+c info = 7 tol is too small. no further improvement in
+c the approximate solution x is possible.
+c
+c ipvt is an integer output array of length n. ipvt
+c defines a permutation matrix p such that jac*p = q*r,
+c where jac is the final calculated jacobian, q is
+c orthogonal (not stored), and r is upper triangular
+c with diagonal elements of nonincreasing magnitude.
+c column j of p is column ipvt(j) of the identity matrix.
+c
+c wa is a work array of length lwa.
+c
+c lwa is a positive integer input variable not less than 5*n+m.
+c
+c subprograms called
+c
+c user-supplied ...... fcn
+c
+c minpack-supplied ... lmder
+c
+c argonne national laboratory. minpack project. march 1980.
+c burton s. garbow, kenneth e. hillstrom, jorge j. more
+c
+c **********
+ integer maxfev,mode,nfev,njev,nprint
+ double precision factor,ftol,gtol,xtol,zero
+ data factor,zero /1.0d2,0.0d0/
+ info = 0
+c
+c check the input parameters for errors.
+c
+ if (n .le. 0 .or. m .lt. n .or. ldfjac .lt. m .or. tol .lt. zero
+ * .or. lwa .lt. 5*n + m) go to 10
+c
+c call lmder.
+c
+ maxfev = 100*(n + 1)
+ ftol = tol
+ xtol = tol
+ gtol = zero
+ mode = 1
+ nprint = 0
+ call lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol,maxfev,
+ * wa(1),mode,factor,nprint,info,nfev,njev,ipvt,wa(n+1),
+ * wa(2*n+1),wa(3*n+1),wa(4*n+1),wa(5*n+1))
+ if (info .eq. 8) info = 4
+ 10 continue
+ return
+c
+c last card of subroutine lmder1.
+c
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmdif.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmdif.c
new file mode 100644
index 0000000000000000000000000000000000000000..9eb8cdbfde96cbae2883bd1a1ba8db3c4c89b3d5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmdif.c
@@ -0,0 +1,522 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* ====================================================================== */
+/* NIST Guide to Available Math Software. */
+/* Fullsource for module LMDIF from package MINPACK. */
+/* Retrieved from NETLIB on Wed Jul 3 14:18:04 1996. */
+/* ====================================================================== */
+/* Subroutine */ void lmdif_(fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev,
+ epsfcn, diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt,
+ qtf, wa1, wa2, wa3, wa4, errors)
+void (*fcn) (integer*,integer*,doublereal*,doublereal*,integer*);
+integer *m, *n;
+doublereal *x, *fvec, *ftol, *xtol, *gtol;
+integer *maxfev;
+doublereal *epsfcn, *diag;
+integer *mode;
+doublereal *factor;
+integer *nprint, *info, *nfev;
+doublereal *fjac;
+integer *ldfjac, *ipvt;
+doublereal *qtf, *wa1, *wa2, *wa3, *wa4;
+doublereal *errors;
+{
+ /* Local variables */
+ static integer iter;
+ static doublereal temp, temp1, temp2;
+ static integer i, j, l, iflag;
+ static doublereal delta;
+ static doublereal ratio;
+ static doublereal fnorm, gnorm;
+ static doublereal pnorm, xnorm, fnorm1, actred, dirder, epsmch, prered;
+ static doublereal par, sum;
+
+/* ********** */
+
+/* subroutine lmdif */
+
+/* the purpose of lmdif is to minimize the sum of the squares of */
+/* m nonlinear functions in n variables by a modification of */
+/* the levenberg-marquardt algorithm. the user must provide a */
+/* subroutine which calculates the functions. the jacobian is */
+/* then calculated by a forward-difference approximation. */
+
+/* the subroutine statement is */
+
+/* subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, */
+/* diag,mode,factor,nprint,info,nfev,fjac, */
+/* ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) */
+
+/* where */
+
+/* fcn is the name of the user-supplied subroutine which */
+/* calculates the functions. fcn must be declared */
+/* in an external statement in the user calling */
+/* program, and should be written as follows. */
+
+/* subroutine fcn(m,n,x,fvec,iflag) */
+/* integer m,n,iflag */
+/* double precision x(n),fvec(m) */
+/* ---------- */
+/* calculate the functions at x and */
+/* return this vector in fvec. */
+/* ---------- */
+/* return */
+/* end */
+
+/* the value of iflag should not be changed by fcn unless */
+/* the user wants to terminate execution of lmdif. */
+/* in this case set iflag to a negative integer. */
+
+/* m is a positive integer input variable set to the number */
+/* of functions. */
+
+/* n is a positive integer input variable set to the number */
+/* of variables. n must not exceed m. */
+
+/* x is an array of length n. on input x must contain */
+/* an initial estimate of the solution vector. on output x */
+/* contains the final estimate of the solution vector. */
+
+/* fvec is an output array of length m which contains */
+/* the functions evaluated at the output x. */
+
+/* ftol is a nonnegative input variable. termination */
+/* occurs when both the actual and predicted relative */
+/* reductions in the sum of squares are at most ftol. */
+/* therefore, ftol measures the relative error desired */
+/* in the sum of squares. */
+
+/* xtol is a nonnegative input variable. termination */
+/* occurs when the relative error between two consecutive */
+/* iterates is at most xtol. therefore, xtol measures the */
+/* relative error desired in the approximate solution. */
+
+/* gtol is a nonnegative input variable. termination */
+/* occurs when the cosine of the angle between fvec and */
+/* any column of the jacobian is at most gtol in absolute */
+/* value. therefore, gtol measures the orthogonality */
+/* desired between the function vector and the columns */
+/* of the jacobian. */
+
+/* maxfev is a positive integer input variable. termination */
+/* occurs when the number of calls to fcn is at least */
+/* maxfev by the end of an iteration. */
+
+/* epsfcn is an input variable used in determining a suitable */
+/* step length for the forward-difference approximation. this */
+/* approximation assumes that the relative errors in the */
+/* functions are of the order of epsfcn. if epsfcn is less */
+/* than the machine precision, it is assumed that the relative */
+/* errors in the functions are of the order of the machine */
+/* precision. */
+
+/* diag is an array of length n. if mode = 1 (see */
+/* below), diag is internally set. if mode = 2, diag */
+/* must contain positive entries that serve as */
+/* multiplicative scale factors for the variables. */
+
+/* mode is an integer input variable. if mode = 1, the */
+/* variables will be scaled internally. if mode = 2, */
+/* the scaling is specified by the input diag. other */
+/* values of mode are equivalent to mode = 1. */
+
+/* factor is a positive input variable used in determining the */
+/* initial step bound. this bound is set to the product of */
+/* factor and the euclidean norm of diag*x if nonzero, or else */
+/* to factor itself. in most cases factor should lie in the */
+/* interval (.1,100.). 100. is a generally recommended value. */
+
+/* nprint is an integer input variable that enables controlled */
+/* printing of iterates if it is positive. in this case, */
+/* fcn is called with iflag = 0 at the beginning of the first */
+/* iteration and every nprint iterations thereafter and */
+/* immediately prior to return, with x and fvec available */
+/* for printing. if nprint is not positive, no special calls */
+/* of fcn with iflag = 0 are made. */
+
+/* info is an integer output variable. if the user has */
+/* terminated execution, info is set to the (negative) */
+/* value of iflag. see description of fcn. otherwise, */
+/* info is set as follows. */
+
+/* info = 0 improper input parameters. */
+
+/* info = 1 both actual and predicted relative reductions */
+/* in the sum of squares are at most ftol. */
+
+/* info = 2 relative error between two consecutive iterates */
+/* is at most xtol. */
+
+/* info = 3 conditions for info = 1 and info = 2 both hold. */
+
+/* info = 4 the cosine of the angle between fvec and any */
+/* column of the jacobian is at most gtol in */
+/* absolute value. */
+
+/* info = 5 number of calls to fcn has reached or */
+/* exceeded maxfev. */
+
+/* info = 6 ftol is too small. no further reduction in */
+/* the sum of squares is possible. */
+
+/* info = 7 xtol is too small. no further improvement in */
+/* the approximate solution x is possible. */
+
+/* info = 8 gtol is too small. fvec is orthogonal to the */
+/* columns of the jacobian to machine precision. */
+
+/* nfev is an integer output variable set to the number of */
+/* calls to fcn. */
+
+/* fjac is an output m by n array. the upper n by n submatrix */
+/* of fjac contains an upper triangular matrix r with */
+/* diagonal elements of nonincreasing magnitude such that */
+
+/* t t t */
+/* p *(jac *jac)*p = r *r, */
+
+/* where p is a permutation matrix and jac is the final */
+/* calculated jacobian. column j of p is column ipvt(j) */
+/* (see below) of the identity matrix. the lower trapezoidal */
+/* part of fjac contains information generated during */
+/* the computation of r. */
+
+/* ldfjac is a positive integer input variable not less than m */
+/* which specifies the leading dimension of the array fjac. */
+
+/* ipvt is an integer output array of length n. ipvt */
+/* defines a permutation matrix p such that jac*p = q*r, */
+/* where jac is the final calculated jacobian, q is */
+/* orthogonal (not stored), and r is upper triangular */
+/* with diagonal elements of nonincreasing magnitude. */
+/* column j of p is column ipvt(j) of the identity matrix. */
+
+/* qtf is an output array of length n which contains */
+/* the first n elements of the vector (q transpose)*fvec. */
+
+/* wa1, wa2, and wa3 are work arrays of length n. */
+
+/* wa4 is a work array of length m. */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+
+/* ********** */
+
+/* epsmch is the machine precision. */
+
+ epsmch = dpmpar_(&c__1);
+
+ *info = 0;
+ iflag = 0;
+ *nfev = 0;
+
+/* check the input parameters for errors. */
+
+ if (*n <= 0 || *m < *n || *ldfjac < *m || *ftol < 0. || *xtol < 0. || *gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
+ goto L300;
+ }
+ if (*mode == 2)
+ for (j = 0; j < *n; ++j) {
+ if (diag[j] <= 0.) {
+ goto L300;
+ }
+ }
+
+/* evaluate the function at the starting point */
+/* and calculate its norm. */
+
+ iflag = 1;
+ (*fcn)(m, n, x, fvec, &iflag);
+ *nfev = 1;
+ if (iflag < 0) {
+ goto L300;
+ }
+ fnorm = enorm_(m, fvec);
+ errors[0] = fnorm;
+
+/* initialize levenberg-marquardt parameter and iteration counter. */
+
+ par = 0.;
+ iter = 1;
+
+/* beginning of the outer loop. */
+
+L30:
+
+/* calculate the jacobian matrix. */
+
+ iflag = 2;
+ fdjac2_(fcn, m, n, x, fvec, fjac, ldfjac, &iflag, epsfcn, wa4);
+ *nfev += *n;
+ if (iflag < 0) {
+ goto L300;
+ }
+
+/* if requested, call fcn to enable printing of iterates. */
+
+ if (*nprint > 0)
+ if ((iter - 1) % *nprint == 0) {
+ iflag = 0;
+ (*fcn)(m, n, x, fvec, &iflag);
+ if (iflag < 0) {
+ goto L300;
+ }
+ }
+
+/* compute the qr factorization of the jacobian. */
+
+ qrfac_(m, n, fjac, ldfjac, &c__1, ipvt, n, wa1, wa2, wa3);
+
+/* on the first iteration and if mode is 1, scale according */
+/* to the norms of the columns of the initial jacobian. */
+
+ if (iter != 1) {
+ goto L80;
+ }
+ if (*mode != 2)
+ for (j = 0; j < *n; ++j) {
+ diag[j] = wa2[j];
+ if (wa2[j] == 0.) {
+ diag[j] = 1.;
+ }
+ }
+
+/* on the first iteration, calculate the norm of the scaled x */
+/* and initialize the step bound delta. */
+
+ for (j = 0; j < *n; ++j) {
+ wa3[j] = diag[j] * x[j];
+ }
+ xnorm = enorm_(n, wa3);
+ delta = *factor * xnorm;
+ if (delta == 0.) {
+ delta = *factor;
+ }
+L80:
+
+/* form (q transpose)*fvec and store the first n components in */
+/* qtf. */
+
+ for (i = 0; i < *m; ++i) {
+ wa4[i] = fvec[i];
+ }
+ for (j = 0; j < *n; ++j) {
+ if (fjac[j + j * *ldfjac] == 0.) {
+ goto L120;
+ }
+ sum = 0.;
+ for (i = j; i < *m; ++i) {
+ sum += fjac[i + j * *ldfjac] * wa4[i];
+ }
+ temp = -sum / fjac[j + j * *ldfjac];
+ for (i = j; i < *m; ++i) {
+ wa4[i] += fjac[i + j * *ldfjac] * temp;
+ }
+L120:
+ fjac[j + j * *ldfjac] = wa1[j];
+ qtf[j] = wa4[j];
+ }
+
+/* compute the norm of the scaled gradient. */
+
+ gnorm = 0.;
+ if (fnorm != 0.)
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ if (wa2[l] == 0.) {
+ continue;
+ }
+ sum = 0.;
+ for (i = 0; i <= j; ++i) {
+ sum += fjac[i + j * *ldfjac] * (qtf[i] / fnorm);
+ }
+ gnorm = max(gnorm,abs(sum / wa2[l]));
+ }
+
+/* test for convergence of the gradient norm. */
+
+ if (gnorm <= *gtol) {
+ *info = 4;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* rescale if necessary. */
+
+ if (*mode != 2)
+ for (j = 0; j < *n; ++j) {
+ diag[j] = max(diag[j],wa2[j]);
+ }
+
+/* beginning of the inner loop. */
+
+L200:
+
+/* determine the levenberg-marquardt parameter. */
+
+ lmpar_(n, fjac, ldfjac, ipvt, diag, qtf, &delta, &par, wa1, wa2, wa3, wa4);
+
+/* store the direction p and x + p. calculate the norm of p. */
+
+ for (j = 0; j < *n; ++j) {
+ wa1[j] = -wa1[j];
+ wa2[j] = x[j] + wa1[j];
+ wa3[j] = diag[j] * wa1[j];
+ }
+ pnorm = enorm_(n, wa3);
+
+/* on the first iteration, adjust the initial step bound. */
+
+ if (iter == 1) {
+ delta = min(delta,pnorm);
+ }
+
+/* evaluate the function at x + p and calculate its norm. */
+
+ iflag = 1;
+ (*fcn)(m, n, wa2, wa4, &iflag);
+ ++(*nfev);
+ if (iflag < 0) {
+ goto L300;
+ }
+ fnorm1 = enorm_(m, wa4);
+
+/* compute the scaled actual reduction. */
+
+ actred = -1.;
+ if (.1 * fnorm1 < fnorm) {
+ actred = fnorm1 / fnorm;
+ actred = 1. - actred * actred;
+ }
+
+/* compute the scaled predicted reduction and */
+/* the scaled directional derivative. */
+
+ for (j = 0; j < *n; ++j) {
+ wa3[j] = 0.;
+ l = ipvt[j] - 1;
+ temp = wa1[l];
+ for (i = 0; i <= j; ++i) {
+ wa3[i] += fjac[i + j * *ldfjac] * temp;
+ }
+ }
+ temp1 = enorm_(n, wa3) / fnorm;
+ temp2 = sqrt(par) * pnorm / fnorm;
+ prered = temp1 * temp1 + temp2 * temp2 / .5;
+ dirder = -(temp1 * temp1 + temp2 * temp2);
+
+/* compute the ratio of the actual to the predicted */
+/* reduction. */
+
+ ratio = 0.;
+ if (prered != 0.) {
+ ratio = actred / prered;
+ }
+
+/* update the step bound. */
+
+ if (ratio > .25) {
+ if (par == 0. || ratio >= .75) {
+ delta = pnorm / .5;
+ par *= .5;
+ }
+ goto L240;
+ }
+ if (actred >= 0.) {
+ temp = .5;
+ }
+ if (actred < 0.) {
+ temp = .5 * dirder / (dirder + .5 * actred);
+ }
+ if (.1 * fnorm1 >= fnorm || temp < .1) {
+ temp = .1;
+ }
+ delta = temp * min(delta,pnorm/.1);
+ par /= temp;
+L240:
+
+/* test for successful iteration. */
+
+ if (ratio < .0001) {
+ goto L290;
+ }
+
+/* successful iteration. update x, fvec, and their norms. */
+
+ for (j = 0; j < *n; ++j) {
+ x[j] = wa2[j];
+ wa2[j] = diag[j] * x[j];
+ }
+ for (i = 0; i < *m; ++i) {
+ fvec[i] = wa4[i];
+ }
+ xnorm = enorm_(n, wa2);
+ fnorm = fnorm1;
+ errors[1] = fnorm;
+ ++iter;
+L290:
+
+/* tests for convergence. */
+
+ if (abs(actred) <= *ftol && prered <= *ftol && .5 * ratio <= 1.) {
+ *info = 1;
+ }
+ if (delta <= *xtol * xnorm) {
+ *info = 2;
+ }
+ if (abs(actred) <= *ftol && prered <= *ftol && .5 * ratio <= 1. && *info == 2) {
+ *info = 3;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* tests for termination and stringent tolerances. */
+
+ if (*nfev >= *maxfev) {
+ *info = 5;
+ }
+ if (abs(actred) <= epsmch && prered <= epsmch && .5 * ratio <= 1.) {
+ *info = 6;
+ }
+ if (delta <= epsmch * xnorm) {
+ *info = 7;
+ }
+ if (gnorm <= epsmch) {
+ *info = 8;
+ }
+ if (*info != 0) {
+ goto L300;
+ }
+
+/* end of the inner loop. repeat if iteration unsuccessful. */
+
+ if (ratio < .0001) {
+ goto L200;
+ }
+
+/* end of the outer loop. */
+
+ goto L30;
+L300:
+
+/* termination, either normal or user imposed. */
+
+ if (iflag < 0) {
+ *info = iflag;
+ }
+ iflag = 0;
+ if (*nprint > 0) {
+ (*fcn)(m, n, x, fvec, &iflag);
+ }
+ return;
+
+} /* lmdif_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lmpar.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmpar.c
new file mode 100644
index 0000000000000000000000000000000000000000..14e0ac2718afb936273c1101ae608bcf399f9c20
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lmpar.c
@@ -0,0 +1,286 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+
+/* Subroutine */ void lmpar_(n, r, ldr, ipvt, diag, qtb, delta, par, x, sdiag, wa1, wa2)
+integer *n;
+doublereal *r;
+integer *ldr, *ipvt;
+doublereal *diag, *qtb, *delta, *par, *x, *sdiag, *wa1, *wa2;
+{
+ /* Local variables */
+ static doublereal parc, parl;
+ static integer iter;
+ static doublereal temp, paru;
+ static integer i, j, l;
+ static doublereal dwarf;
+ static integer nsing;
+ static doublereal gnorm, fp;
+ static doublereal dxnorm;
+ static doublereal sum;
+
+/* ********** */
+
+/* subroutine lmpar */
+
+/* given an m by n matrix a, an n by n nonsingular diagonal */
+/* matrix d, an m-vector b, and a positive number delta, */
+/* the problem is to determine a value for the parameter */
+/* par such that if x solves the system */
+
+/* a*x = b , sqrt(par)*d*x = 0 , */
+
+/* in the least squares sense, and dxnorm is the euclidean */
+/* norm of d*x, then either par is zero and */
+
+/* (dxnorm-delta) .le. 0.1*delta , */
+
+/* or par is positive and */
+
+/* abs(dxnorm-delta) .le. 0.1*delta . */
+
+/* this subroutine completes the solution of the problem */
+/* if it is provided with the necessary information from the */
+/* qr factorization, with column pivoting, of a. that is, if */
+/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
+/* columns, and r is an upper triangular matrix with diagonal */
+/* elements of nonincreasing magnitude, then lmpar expects */
+/* the full upper triangle of r, the permutation matrix p, */
+/* and the first n components of (q transpose)*b. on output */
+/* lmpar also provides an upper triangular matrix s such that */
+
+/* t t t */
+/* p *(a *a + par*d*d)*p = s *s . */
+
+/* s is employed within lmpar and may be of separate interest. */
+
+/* only a few iterations are generally needed for convergence */
+/* of the algorithm. if, however, the limit of 10 iterations */
+/* is reached, then the output par will contain the best */
+/* value obtained so far. */
+
+/* the subroutine statement is */
+
+/* subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, */
+/* wa1,wa2) */
+
+/* where */
+
+/* n is a positive integer input variable set to the order of r. */
+
+/* r is an n by n array. on input the full upper triangle */
+/* must contain the full upper triangle of the matrix r. */
+/* on output the full upper triangle is unaltered, and the */
+/* strict lower triangle contains the strict upper triangle */
+/* (transposed) of the upper triangular matrix s. */
+
+/* ldr is a positive integer input variable not less than n */
+/* which specifies the leading dimension of the array r. */
+
+/* ipvt is an integer input array of length n which defines the */
+/* permutation matrix p such that a*p = q*r. column j of p */
+/* is column ipvt(j) of the identity matrix. */
+
+/* diag is an input array of length n which must contain the */
+/* diagonal elements of the matrix d. */
+
+/* qtb is an input array of length n which must contain the first */
+/* n elements of the vector (q transpose)*b. */
+
+/* delta is a positive input variable which specifies an upper */
+/* bound on the euclidean norm of d*x. */
+
+/* par is a nonnegative variable. on input par contains an */
+/* initial estimate of the levenberg-marquardt parameter. */
+/* on output par contains the final estimate. */
+
+/* x is an output array of length n which contains the least */
+/* squares solution of the system a*x = b, sqrt(par)*d*x = 0, */
+/* for the output par. */
+
+/* sdiag is an output array of length n which contains the */
+/* diagonal elements of the upper triangular matrix s. */
+
+/* wa1 and wa2 are work arrays of length n. */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+
+/* ********** */
+
+/* dwarf is the smallest positive magnitude. */
+
+ dwarf = dpmpar_(&c__2);
+
+/* compute and store in x the gauss-newton direction. if the */
+/* jacobian is rank-deficient, obtain a least squares solution. */
+
+ nsing = *n;
+ for (j = 0; j < *n; ++j) {
+ wa1[j] = qtb[j];
+ if (r[j + j * *ldr] == 0. && nsing == *n) {
+ nsing = j;
+ }
+ if (nsing < *n) {
+ wa1[j] = 0.;
+ }
+ }
+ for (j = nsing-1; j >= 0; --j) {
+ wa1[j] /= r[j + j * *ldr];
+ temp = wa1[j];
+ if (j < 1) {
+ continue;
+ }
+ for (i = 0; i < j; ++i) {
+ wa1[i] -= r[i + j * *ldr] * temp;
+ }
+ }
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ x[l] = wa1[j];
+ }
+
+/* initialize the iteration counter. */
+/* evaluate the function at the origin, and test */
+/* for acceptance of the gauss-newton direction. */
+
+ iter = 0;
+ for (j = 0; j < *n; ++j) {
+ wa2[j] = diag[j] * x[j];
+ }
+ dxnorm = enorm_(n, wa2);
+ fp = dxnorm - *delta;
+ if (fp <= .1 * *delta) {
+ goto L220;
+ }
+
+/* if the jacobian is not rank deficient, the newton */
+/* step provides a lower bound, parl, for the zero of */
+/* the function. otherwise set this bound to zero. */
+
+ parl = 0.;
+ if (nsing < *n) {
+ goto L120;
+ }
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ wa1[j] = diag[l] * (wa2[l] / dxnorm);
+ }
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ if (j < 2) {
+ goto L100;
+ }
+ for (i = 0; i < j; ++i) {
+ sum += r[i + j * *ldr] * wa1[i];
+ }
+L100:
+ wa1[j] = (wa1[j] - sum) / r[j + j * *ldr];
+ }
+ temp = enorm_(n, wa1);
+ parl = fp / *delta / temp / temp;
+L120:
+
+/* calculate an upper bound, paru, for the zero of the function. */
+
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ for (i = 0; i <= j; ++i) {
+ sum += r[i + j * *ldr] * qtb[i];
+ }
+ l = ipvt[j] - 1;
+ wa1[j] = sum / diag[l];
+ }
+ gnorm = enorm_(n, wa1);
+ paru = gnorm / *delta;
+ if (paru == 0.) {
+ paru = dwarf / min(*delta,.1);
+ }
+
+/* if the input par lies outside of the interval (parl,paru), */
+/* set par to the closer endpoint. */
+
+ *par = max(*par,parl);
+ *par = min(*par,paru);
+ if (*par == 0.) {
+ *par = gnorm / dxnorm;
+ }
+
+/* beginning of an iteration. */
+
+L150:
+ ++iter;
+
+/* evaluate the function at the current value of par. */
+
+ if (*par == 0.) {
+ *par = max(dwarf,.001 * paru);
+ }
+ temp = sqrt(*par);
+ for (j = 0; j < *n; ++j) {
+ wa1[j] = temp * diag[j];
+ }
+ qrsolv_(n, r, ldr, ipvt, wa1, qtb, x, sdiag, wa2);
+ for (j = 0; j < *n; ++j) {
+ wa2[j] = diag[j] * x[j];
+ }
+ dxnorm = enorm_(n, wa2);
+ temp = fp;
+ fp = dxnorm - *delta;
+
+/* if the function is small enough, accept the current value */
+/* of par. also test for the exceptional cases where parl */
+/* is zero or the number of iterations has reached 10. */
+
+ if (abs(fp) <= .1 * *delta || ( parl == 0. && fp <= temp && temp < 0. ) || iter == 10) {
+ goto L220;
+ }
+
+/* compute the newton correction. */
+
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ wa1[j] = diag[l] * (wa2[l] / dxnorm);
+ }
+ for (j = 0; j < *n; ++j) {
+ wa1[j] /= sdiag[j];
+ temp = wa1[j];
+ if (*n <= j+1) {
+ continue;
+ }
+ for (i = j+1; i < *n; ++i) {
+ wa1[i] -= r[i + j * *ldr] * temp;
+ }
+ }
+ temp = enorm_(n, wa1);
+ parc = fp / *delta / temp / temp;
+
+/* depending on the sign of the function, update parl or paru. */
+
+ if (fp > 0.) {
+ parl = max(parl,*par);
+ }
+ if (fp < 0.) {
+ paru = min(paru,*par);
+ }
+
+/* compute an improved estimate for par. */
+
+ *par = max(parl,*par + parc);
+
+/* end of an iteration. */
+
+ goto L150;
+L220:
+
+/* termination. */
+
+ if (iter == 0) {
+ *par = 0.;
+ }
+ return;
+
+} /* lmpar_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.c
new file mode 100644
index 0000000000000000000000000000000000000000..46acb8a8ca7df7bd417dc7204f40b10676e4c60d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.c
@@ -0,0 +1,88 @@
+#include "f2c.h"
+#include "netlib.h"
+
+logical lsame_(const char *ca, const char *cb)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+*/
+
+ /* Local variables */
+ static integer inta, intb, zcode;
+
+ /* Test if the characters are equal */
+
+ if ( *(unsigned char *)ca == *(unsigned char *)cb )
+ return 1; /* TRUE */
+
+/* Now test for equivalence if both characters are alphabetic. */
+
+ zcode = 'Z';
+
+/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
+ machines, on which ICHAR returns a value with bit 8 set.
+ ICHAR('A') on Prime machines returns 193 which is the same as
+ ICHAR('A') on an EBCDIC machine.
+*/
+
+ inta = *(unsigned char *)ca;
+ intb = *(unsigned char *)cb;
+
+ if (zcode == 90 || zcode == 122) {
+
+/* ASCII is assumed - ZCODE is the ASCII code of either lower or
+ upper case 'Z'.
+*/
+
+ if (inta >= 97 && inta <= 122) {
+ inta += -32;
+ }
+ if (intb >= 97 && intb <= 122) {
+ intb += -32;
+ }
+
+ } else if (zcode == 233 || zcode == 169) {
+
+/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
+ upper case 'Z'.
+*/
+
+ if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta >= 162 && inta <= 169)) {
+ inta += 64;
+ }
+ if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb >= 162 && intb <= 169)) {
+ intb += 64;
+ }
+
+ } else if (zcode == 218 || zcode == 250) {
+
+/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
+ plus 128 of either lower or upper case 'Z'.
+*/
+
+ if (inta >= 225 && inta <= 250) {
+ inta += -32;
+ }
+ if (intb >= 225 && intb <= 250) {
+ intb += -32;
+ }
+ }
+ return inta == intb;
+} /* lsame_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.f
new file mode 100644
index 0000000000000000000000000000000000000000..db133b54450b889606b6b0f173349596e236d0d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsame.f
@@ -0,0 +1,87 @@
+ LOGICAL FUNCTION LSAME( CA, CB )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER CA, CB
+* ..
+*
+* Purpose
+* =======
+*
+* LSAME returns .TRUE. if CA is the same letter as CB regardless of
+* case.
+*
+* Arguments
+* =========
+*
+* CA (input) CHARACTER*1
+* CB (input) CHARACTER*1
+* CA and CB specify the single characters to be compared.
+*
+* =====================================================================
+*
+* .. Intrinsic Functions ..
+ INTRINSIC ICHAR
+* ..
+* .. Local Scalars ..
+ INTEGER INTA, INTB, ZCODE
+* ..
+* .. Executable Statements ..
+*
+* Test if the characters are equal
+*
+ LSAME = CA.EQ.CB
+ IF( LSAME )
+ $ RETURN
+*
+* Now test for equivalence if both characters are alphabetic.
+*
+ ZCODE = ICHAR( 'Z' )
+*
+* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
+* machines, on which ICHAR returns a value with bit 8 set.
+* ICHAR('A') on Prime machines returns 193 which is the same as
+* ICHAR('A') on an EBCDIC machine.
+*
+ INTA = ICHAR( CA )
+ INTB = ICHAR( CB )
+*
+ IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
+*
+* ASCII is assumed - ZCODE is the ASCII code of either lower or
+* upper case 'Z'.
+*
+ IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
+ IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
+*
+ ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
+*
+* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
+* upper case 'Z'.
+*
+ IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
+ $ INTA.GE.145 .AND. INTA.LE.153 .OR.
+ $ INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
+ IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
+ $ INTB.GE.145 .AND. INTB.LE.153 .OR.
+ $ INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
+*
+ ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
+*
+* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
+* plus 128 of either lower or upper case 'Z'.
+*
+ IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
+ IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
+ END IF
+ LSAME = INTA.EQ.INTB
+*
+* RETURN
+*
+* End of LSAME
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr-test.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr-test.f
new file mode 100644
index 0000000000000000000000000000000000000000..57a5f2702b4abc44b0d55283e73ccf0a44656431
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr-test.f
@@ -0,0 +1,461 @@
+C ******************************************************
+C
+C WARNING. Delete the following imitation BLAS routines
+C if a genuine BLAS library is available.
+C
+C ******************************************************
+C
+C SUBROUTINE DCOPY ( N,X,INCX,Y,INCY )
+C INTEGER N,INCX,INCY
+C DOUBLE PRECISION X(N),Y(N)
+C
+C This may be replaced by the corresponding BLAS routine.
+C The following is a simple version for use with LSQR.
+C
+C DO 10 I = 1, N
+C Y(I) = X(I)
+C 10 CONTINUE
+C RETURN
+C
+C END OF DCOPY
+C END
+C DOUBLE PRECISION FUNCTION DNRM2 ( N,X,INCX )
+C INTEGER N,INCX
+C DOUBLE PRECISION X(N)
+C
+C This may be replaced by the corresponding BLAS routine.
+C The following is a simple version for use with LSQR.
+C
+C INTEGER I
+C DOUBLE PRECISION D, DSQRT
+C
+C D = 0.0
+C DO 10 I = 1, N
+C D = D + X(I)**2
+C 10 CONTINUE
+C DNRM2 = DSQRT(D)
+C RETURN
+C
+C END OF DNRM2
+C END
+C SUBROUTINE DSCAL ( N,A,X,INCX )
+C INTEGER N,INCX
+C DOUBLE PRECISION A,X(N)
+C
+C This may be replaced by the corresponding BLAS routine.
+C The following is a simple version for use with LSQR.
+C
+C DO 10 I = 1, N
+C X(I) = A*X(I)
+C 10 CONTINUE
+C RETURN
+C
+C END OF DSCAL
+C END
+*********************************************************
+*
+* These routines are for testing LSQR.
+*
+*********************************************************
+
+ SUBROUTINE APROD ( MODE, M, N, X, Y, LENIW, LENRW, IW, RW )
+ INTEGER MODE, M, N, LENIW, LENRW
+ INTEGER IW(LENIW)
+ DOUBLE PRECISION X(N), Y(M), RW(LENRW)
+
+* ------------------------------------------------------------------
+* This is the matrix-vector product routine required by LSQR
+* for a test matrix of the form A = HY*D*HZ. The quantities
+* defining D, HY, HZ are in the work array RW, followed by a
+* work array W. These are passed to APROD1 and APROD2 in order to
+* make the code readable.
+* ------------------------------------------------------------------
+
+ INTEGER LOCD, LOCHY, LOCHZ, LOCW
+
+ LOCD = 1
+ LOCHY = LOCD + N
+ LOCHZ = LOCHY + M
+ LOCW = LOCHZ + N
+
+ IF (MODE .EQ. 1) CALL APROD1( M, N, X, Y,
+ $ RW(LOCD), RW(LOCHY), RW(LOCHZ), RW(LOCW) )
+
+ IF (MODE .NE. 1) CALL APROD2( M, N, X, Y,
+ $ RW(LOCD), RW(LOCHY), RW(LOCHZ), RW(LOCW) )
+
+* End of APROD
+ END
+
+ SUBROUTINE APROD1( M, N, X, Y, D, HY, HZ, W )
+ INTEGER M, N
+ DOUBLE PRECISION X(N), Y(M), D(N), HY(M), HZ(N), W(M)
+
+* ------------------------------------------------------------------
+* APROD1 computes Y = Y + A*X for subroutine APROD,
+* where A is a test matrix of the form A = HY*D*HZ,
+* and the latter matrices HY, D, HZ are represented by
+* input vectors with the same name.
+* ------------------------------------------------------------------
+
+ INTEGER I
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0 )
+
+ CALL HPROD ( N, HZ, X, W )
+
+ DO 100 I = 1, N
+ W(I) = D(I) * W(I)
+ 100 CONTINUE
+
+ DO 200 I = N + 1, M
+ W(I) = ZERO
+ 200 CONTINUE
+
+ CALL HPROD ( M, HY, W, W )
+
+ DO 600 I = 1, M
+ Y(I) = Y(I) + W(I)
+ 600 CONTINUE
+
+* End of APROD1
+ END
+
+ SUBROUTINE APROD2( M, N, X, Y, D, HY, HZ, W )
+ INTEGER M, N
+ DOUBLE PRECISION X(N), Y(M), D(N), HY(M), HZ(N), W(M)
+
+* ------------------------------------------------------------------
+* APROD2 computes X = X + A(T)*Y for subroutine APROD,
+* where A is a test matrix of the form A = HY*D*HZ,
+* and the latter matrices HY, D, HZ are represented by
+* input vectors with the same name.
+* ------------------------------------------------------------------
+
+ INTEGER I
+
+ CALL HPROD ( M, HY, Y, W )
+
+ DO 100 I = 1, N
+ W(I) = D(I)*W(I)
+ 100 CONTINUE
+
+ CALL HPROD ( N, HZ, W, W )
+
+ DO 600 I = 1, N
+ X(I) = X(I) + W(I)
+ 600 CONTINUE
+
+* End of APROD2
+ END
+
+ SUBROUTINE HPROD ( N, HZ, X, Y )
+ INTEGER N
+ DOUBLE PRECISION HZ(N), X(N), Y(N)
+
+* ------------------------------------------------------------------
+* HPROD applies a Householder transformation stored in HZ
+* to get Y = ( I - 2*HZ*HZ(transpose) ) * X.
+* ------------------------------------------------------------------
+
+ INTEGER I
+ DOUBLE PRECISION S
+
+ S = 0.0
+ DO 100 I = 1, N
+ S = HZ(I) * X(I) + S
+ 100 CONTINUE
+
+ S = S + S
+ DO 200 I = 1, N
+ Y(I) = X(I) - S * HZ(I)
+ 200 CONTINUE
+
+* End of HPROD
+ END
+
+ SUBROUTINE LSTP ( M, N, NDUPLC, NPOWER, DAMP, X,
+ $ B, D, HY, HZ, W, ACOND, RNORM )
+
+ INTEGER M, N, MAXMN, NDUPLC, NPOWER
+ DOUBLE PRECISION DAMP, ACOND, RNORM
+ DOUBLE PRECISION B(M), X(N), D(N), HY(M), HZ(N), W(M)
+
+* ------------------------------------------------------------------
+* LSTP generates a sparse least-squares test problem of the form
+*
+* ( A )*X = ( B )
+* ( DAMP*I ) ( 0 )
+*
+* having a specified solution X. The matrix A is constructed
+* in the form A = HY*D*HZ, where D is an M by N diagonal matrix,
+* and HY and HZ are Householder transformations.
+*
+* The first 6 parameters are input to LSTP. The remainder are
+* output. LSTP is intended for use with M .GE. N.
+*
+*
+* Functions and subroutines
+*
+* TESTPROB APROD1, HPROD
+* BLAS DNRM2
+* ------------------------------------------------------------------
+
+* Intrinsics and local variables
+
+ INTRINSIC COS, SIN, SQRT
+ INTEGER I, J
+ DOUBLE PRECISION DNRM2
+ DOUBLE PRECISION ALFA, BETA, DAMPSQ, FOURPI, T
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0, ONE = 1.0 )
+
+* ------------------------------------------------------------------
+* Make two vectors of norm 1.0 for the Householder transformations.
+* FOURPI need not be exact.
+* ------------------------------------------------------------------
+ DAMPSQ = DAMP**2
+ FOURPI = 4.0 * 3.141592
+ ALFA = FOURPI / M
+ BETA = FOURPI / N
+
+ DO 100 I = 1, M
+ HY(I) = SIN( I * ALFA )
+ 100 CONTINUE
+
+ DO 200 I = 1, N
+ HZ(I) = COS( I * BETA )
+ 200 CONTINUE
+
+ ALFA = DNRM2 ( M, HY, 1 )
+ BETA = DNRM2 ( N, HZ, 1 )
+ CALL DSCAL ( M, (- ONE / ALFA), HY, 1 )
+ CALL DSCAL ( N, (- ONE / BETA), HZ, 1 )
+*
+* ------------------------------------------------------------------
+* Set the diagonal matrix D. These are the singular values of A.
+* ------------------------------------------------------------------
+ DO 300 I = 1, N
+ J = (I - 1 + NDUPLC) / NDUPLC
+ T = J * NDUPLC
+ T = T / N
+ D(I) = T**NPOWER
+ 300 CONTINUE
+
+ ACOND = SQRT( (D(N)**2 + DAMPSQ) / (D(1)**2 + DAMPSQ) )
+
+* ------------------------------------------------------------------
+* Compute the residual vector, storing it in B.
+* It takes the form HY*( s )
+* ( t )
+* where s is obtained from D*s = DAMP**2 * HZ * X
+* and t can be anything.
+* ------------------------------------------------------------------
+ CALL HPROD ( N, HZ, X, B )
+
+ DO 500 I = 1, N
+ B(I) = DAMPSQ * B(I) / D(I)
+ 500 CONTINUE
+
+ T = ONE
+ DO 600 I = N + 1, M
+ J = I - N
+ B(I) = (T * J) / M
+ T = - T
+ 600 CONTINUE
+
+ CALL HPROD ( M, HY, B, B )
+
+* ------------------------------------------------------------------
+* Now compute the true B = RESIDUAL + A*X.
+* ------------------------------------------------------------------
+ RNORM = SQRT( DNRM2 ( M, B, 1 )**2
+ $ + DAMPSQ * DNRM2 ( N, X, 1 )**2 )
+ CALL APROD1( M, N, X, B, D, HY, HZ, W )
+
+* End of LSTP
+ END
+
+ SUBROUTINE TEST ( M, N, NDUPLC, NPOWER, DAMP )
+ INTEGER M, N, NDUPLC, NPOWER
+ DOUBLE PRECISION DAMP
+
+* ------------------------------------------------------------------
+* This is an example driver routine for running LSQR.
+* It generates a test problem, solves it, and examines the results.
+* Note that subroutine APROD must be declared EXTERNAL
+* if it is used only in the call to LSQR.
+*
+*
+* Functions and subroutines
+*
+* TESTPROB APROD
+* BLAS DCOPY, DNRM2, DSCAL
+* ------------------------------------------------------------------
+
+* Intrinsics and local variables
+
+ INTRINSIC MAX, SQRT
+ EXTERNAL APROD
+ INTEGER ISTOP, ITNLIM, J, NOUT
+ DOUBLE PRECISION DNRM2
+
+ PARAMETER ( MAXM = 200, MAXN = 100 )
+ DOUBLE PRECISION B(MAXM), U(MAXM),
+ $ V(MAXN), W(MAXN), X(MAXN),
+ $ SE(MAXN), XTRUE(MAXN)
+ DOUBLE PRECISION ATOL, BTOL, CONLIM,
+ $ ANORM, ACOND, RNORM, ARNORM,
+ $ DAMPSQ, ENORM, ETOL, XNORM
+
+ PARAMETER ( LENIW = 1, LENRW = 600 )
+ INTEGER IW(LENIW)
+ DOUBLE PRECISION RW(LENRW)
+ INTEGER LOCD, LOCHY, LOCHZ, LOCW, LTOTAL
+
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0 )
+
+ CHARACTER*34 LINE
+ DATA LINE
+ $ /'----------------------------------'/
+
+
+* Set the desired solution XTRUE.
+
+ DO 100 J = 1, N
+ XTRUE(J) = N - J
+ 100 CONTINUE
+
+* Generate the specified test problem.
+* The workspace array IW is not needed in this application.
+* The workspace array RW is used for the following vectors:
+* D(N), HY(M), HZ(N), W(MAX(M,N)).
+* The vectors D, HY, HZ will define the test matrix A.
+* W is needed for workspace in APROD1 and APROD2.
+
+ LOCD = 1
+ LOCHY = LOCD + N
+ LOCHZ = LOCHY + M
+ LOCW = LOCHZ + N
+ LTOTAL = LOCW + MAX(M,N) - 1
+ IF (LTOTAL .GT. LENRW) GO TO 900
+
+ CALL LSTP ( M, N, NDUPLC, NPOWER, DAMP, XTRUE,
+ $ B, RW(LOCD), RW(LOCHY), RW(LOCHZ), RW(LOCW),
+ $ ACOND, RNORM )
+
+* Solve the problem defined by APROD, DAMP and B.
+* Copy the rhs vector B into U (LSQR will overwrite U)
+* and set the other input parameters for LSQR.
+
+ CALL DCOPY ( M, B, 1, U, 1 )
+ ATOL = 1.0E-10
+ BTOL = ATOL
+ CONLIM = 10.0 * ACOND
+ ITNLIM = M + N + 50
+ NOUT = 6
+ WRITE(NOUT, 1000) LINE, LINE,
+ $ M, N, NDUPLC, NPOWER, DAMP, ACOND, RNORM,
+ $ LINE, LINE
+
+ CALL LSQR ( M, N, APROD, DAMP,
+ $ LENIW, LENRW, IW, RW,
+ $ U, V, W, X, SE,
+ $ ATOL, BTOL, CONLIM, ITNLIM, NOUT,
+ $ ISTOP, ITN, ANORM, ACOND, RNORM, ARNORM, XNORM )
+
+* Examine the results.
+* We print the residual norms RNORM and ARNORM given by LSQR,
+* and then compute their true values in terms of the solution X
+* obtained by LSQR. At least one of them should be small.
+
+ DAMPSQ = DAMP**2
+ WRITE(NOUT, 2000)
+ WRITE(NOUT, 2100) RNORM, ARNORM, XNORM
+
+* Compute U = A*X - B.
+* This is the negative of the usual residual vector.
+* It will be close to zero only if B is a compatible rhs
+* and X is close to a solution.
+
+ CALL DCOPY ( M, B, 1, U, 1 )
+ CALL DSCAL ( M, (-ONE), U, 1 )
+ CALL APROD ( 1, M, N, X, U, LENIW, LENRW, IW, RW )
+
+* Compute V = A(transpose)*U + DAMP**2 * X.
+* This will be close to zero in all cases
+* if X is close to a solution.
+
+ CALL DCOPY ( N, X, 1, V, 1 )
+ CALL DSCAL ( N, DAMPSQ, V, 1 )
+ CALL APROD ( 2, M, N, V, U, LENIW, LENRW, IW, RW )
+
+* Compute the norms associated with X, U, V.
+
+ XNORM = DNRM2 ( N, X, 1 )
+ RNORM = SQRT( DNRM2 ( M, U, 1 )**2 + DAMPSQ * XNORM**2 )
+ ARNORM = DNRM2 ( N, V, 1 )
+ WRITE(NOUT, 2200) RNORM, ARNORM, XNORM
+
+* Print the solution and standard error estimates from LSQR.
+
+ WRITE(NOUT, 2500) (J, X(J), J = 1, N)
+ WRITE(NOUT, 2600) (J, SE(J), J = 1, N)
+
+* Print a clue about whether the solution looks OK.
+
+ DO 500 J = 1, N
+ W(J) = X(J) - XTRUE(J)
+ 500 CONTINUE
+ ENORM = DNRM2 ( N, W, 1 ) / (ONE + DNRM2 ( N, XTRUE, 1 ))
+ ETOL = 1.0D-5
+ IF (ENORM .LE. ETOL) WRITE(NOUT, 3000) ENORM
+ IF (ENORM .GT. ETOL) WRITE(NOUT, 3100) ENORM
+ RETURN
+
+* Not enough workspace.
+
+ 900 WRITE(NOUT, 9000) LTOTAL
+ RETURN
+
+ 1000 FORMAT(1P
+ $ // 1X, 2A
+ $ / ' Least-Squares Test Problem P(', 4I5, E12.2, ' )'
+ $ // ' Condition no. =', E12.4, ' Residual function =', E17.9
+ $ / 1X, 2A)
+ 2000 FORMAT(
+ $ // 22X, ' Residual norm Residual norm Solution norm'
+ $ / 22X, '(Abar X - bbar) (Normal eqns) (X)' /)
+ 2100 FORMAT(1P, ' Estimated by LSQR', 3E17.5)
+ 2200 FORMAT(1P, ' Computed from X ', 3E17.5)
+ 2500 FORMAT(//' Solution X' / 4(I6, G14.6))
+ 2600 FORMAT(/ ' Standard errors SE' / 4(I6, G14.6))
+ 3000 FORMAT(1P / ' LSQR appears to be successful.',
+ $ ' Relative error in X =', E10.2)
+ 3100 FORMAT(1P / ' LSQR appears to have failed. ',
+ $ ' Relative error in X =', E10.2)
+ 9000 FORMAT(/ ' XXX Insufficient workspace.',
+ $ ' The length of RW should be at least', I6)
+* End of TEST
+ END
+
+* -------------
+* Main program.
+* -------------
+ DOUBLE PRECISION DAMP1, DAMP2, DAMP3, DAMP4, ZERO
+*
+ ZERO = 0.0
+ DAMP1 = 0.1
+ DAMP2 = 0.01
+ DAMP3 = 0.001
+ DAMP4 = 0.0001
+ CALL TEST ( 1, 1, 1, 1, ZERO )
+ CALL TEST ( 2, 1, 1, 1, ZERO )
+ CALL TEST ( 40, 40, 4, 4, ZERO )
+ CALL TEST ( 40, 40, 4, 4, DAMP2 )
+ CALL TEST ( 80, 40, 4, 4, DAMP2 )
+ STOP
+
+* End of main program for testing LSQR
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..9d0821f584442c132d65e5f458cb8c46d43ea8d4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.c
@@ -0,0 +1,601 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__2 = 2;
+
+/* From arpa!sol-michael.stanford.edu!mike 5 May 89 23:53:00 PDT */
+/* Subroutine */ void lsqr_(m, n, aprod, damp, leniw, lenrw, iw, rw, u, v, w,
+ x, se, atol, btol, conlim, itnlim, nout, istop, itn, anorm, acond,
+ rnorm, arnorm, xnorm)
+integer *m, *n;
+void (*aprod) (integer*,integer*,integer*,doublereal*,doublereal*,integer*,integer*,integer*,doublereal*);
+doublereal *damp;
+integer *leniw, *lenrw, *iw;
+doublereal *rw, *u, *v, *w, *x, *se, *atol, *btol, *conlim;
+integer *itnlim, *nout, *istop, *itn;
+doublereal *anorm, *acond, *rnorm, *arnorm, *xnorm;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal alfa, beta, zbar, ctol, rtol;
+ static doublereal test1, test2, test3;
+ static integer i;
+ static doublereal gamma, delta, t, z;
+ static doublereal theta, bnorm;
+ static integer nconv, nstop;
+ static doublereal t1, t2, t3, rhbar1, rhbar2, cs, gambar, sn, phibar,
+ rhobar, bbnorm, ddnorm, dampsq, cs1, cs2, sn1, sn2, xxnorm, phi,
+ rho, tau, psi, rhs, res1, res2;
+
+/* ----------------------------------------------------------------------- */
+
+/* LSQR finds a solution x to the following problems: */
+
+/* 1. Unsymmetric equations -- solve A*x = b */
+
+/* 2. Linear least squares -- solve A*x = b */
+/* in the least-squares sense */
+
+/* 3. Damped least squares -- solve ( A )*x = ( b ) */
+/* ( damp*I ) ( 0 ) */
+/* in the least-squares sense */
+
+/* where A is a matrix with m rows and n columns, b is an */
+/* m-vector, and damp is a scalar. (All quantities are real.) */
+/* The matrix A is intended to be large and sparse. It is accessed */
+/* by means of subroutine calls of the form */
+
+/* CALL APROD ( mode, m, n, x, y, LENIW, LENRW, IW, RW ) */
+
+/* which must perform the following functions: */
+
+/* If MODE = 1, compute y = y + A*x. */
+/* If MODE = 2, compute x = x + A(transpose)*y. */
+
+/* The vectors x and y are input parameters in both cases. */
+/* If mode = 1, y should be altered without changing x. */
+/* If mode = 2, x should be altered without changing y. */
+/* The parameters LENIW, LENRW, IW, RW may be used for workspace */
+/* as described below. */
+
+/* The rhs vector b is input via U, and subsequently overwritten. */
+
+
+/* Note: LSQR uses an iterative method to approximate the solution. */
+/* The number of iterations required to reach a certain accuracy */
+/* depends strongly on the scaling of the problem. Poor scaling of */
+/* the rows or columns of A should therefore be avoided where */
+/* possible. */
+
+/* For example, in problem 1 the solution is unaltered by */
+/* row-scaling. If a row of A is very small or large compared to */
+/* the other rows of A, the corresponding row of ( A b ) should be */
+/* scaled up or down. */
+
+/* In problems 1 and 2, the solution x is easily recovered */
+/* following column-scaling. Unless better information is known, */
+/* the nonzero columns of A should be scaled so that they all have */
+/* the same Euclidean norm (e.g., 1.0). */
+
+/* In problem 3, there is no freedom to re-scale if damp is */
+/* nonzero. However, the value of damp should be assigned only */
+/* after attention has been paid to the scaling of A. */
+
+/* The parameter damp is intended to help regularize */
+/* ill-conditioned systems, by preventing the true solution from */
+/* being very large. Another aid to regularization is provided by */
+/* the parameter ACOND, which may be used to terminate iterations */
+/* before the computed solution becomes very large. */
+
+
+/* Notation */
+/* -------- */
+
+/* The following quantities are used in discussing the subroutine */
+/* parameters: */
+
+/* Abar = ( A ), bbar = ( b ) */
+/* ( damp*I ) ( 0 ) */
+
+/* r = b - A*x, rbar = bbar - Abar*x */
+
+/* rnorm = sqrt( norm(r)**2 + damp**2 * norm(x)**2 ) */
+/* = norm( rbar ) */
+
+/* RELPR = the relative precision of floating-point arithmetic */
+/* on the machine being used. For example, on the IBM 370, */
+/* RELPR is about 1.0E-6 and 1.0D-16 in single and double */
+/* precision respectively. */
+
+/* LSQR minimizes the function rnorm with respect to x. */
+
+
+/* Parameters */
+/* ---------- */
+
+/* M input m, the number of rows in A. */
+
+/* N input n, the number of columns in A. */
+
+/* APROD external See above. */
+
+/* DAMP input The damping parameter for problem 3 above. */
+/* (DAMP should be 0.0 for problems 1 and 2.) */
+/* If the system A*x = b is incompatible, values */
+/* of DAMP in the range 0 to sqrt(RELPR)*norm(A) */
+/* will probably have a negligible effect. */
+/* Larger values of DAMP will tend to decrease */
+/* the norm of x and reduce the number of */
+/* iterations required by LSQR. */
+
+/* The work per iteration and the storage needed */
+/* by LSQR are the same for all values of DAMP. */
+
+/* LENIW input The length of the workspace array IW. */
+/* LENRW input The length of the workspace array RW. */
+/* IW workspace An integer array of length LENIW. */
+/* RW workspace A real array of length LENRW. */
+
+/* Note: LSQR does not explicitly use the previous four */
+/* parameters, but passes them to subroutine APROD for */
+/* possible use as workspace. If APROD does not need */
+/* IW or RW, the values LENIW = 1 or LENRW = 1 should */
+/* be used, and the actual parameters corresponding to */
+/* IW or RW may be any convenient array of suitable type. */
+
+/* U(M) input The rhs vector b. Beware that U is */
+/* over-written by LSQR. */
+
+/* V(N) workspace */
+/* W(N) workspace */
+
+/* X(N) output Returns the computed solution x. */
+
+/* SE(N) output Returns standard error estimates for the */
+/* components of X. For each i, SE(i) is set */
+/* to the value rnorm * sqrt( sigma(i,i) / T ), */
+/* where sigma(i,i) is an estimate of the i-th */
+/* diagonal of the inverse of Abar(transpose)*Abar */
+/* and T = 1 if m .le. n, */
+/* T = m - n if m .gt. n and damp = 0, */
+/* T = m if damp .ne. 0. */
+
+/* ATOL input An estimate of the relative error in the data */
+/* defining the matrix A. For example, */
+/* if A is accurate to about 6 digits, set */
+/* ATOL = 1.0E-6 . */
+
+/* BTOL input An extimate of the relative error in the data */
+/* defining the rhs vector b. For example, */
+/* if b is accurate to about 6 digits, set */
+/* BTOL = 1.0E-6 . */
+
+/* CONLIM input An upper limit on cond(Abar), the apparent */
+/* condition number of the matrix Abar. */
+/* Iterations will be terminated if a computed */
+/* estimate of cond(Abar) exceeds CONLIM. */
+/* This is intended to prevent certain small or */
+/* zero singular values of A or Abar from */
+/* coming into effect and causing unwanted growth */
+/* in the computed solution. */
+
+/* CONLIM and DAMP may be used separately or */
+/* together to regularize ill-conditioned systems. */
+
+/* Normally, CONLIM should be in the range */
+/* 1000 to 1/RELPR. */
+/* Suggested value: */
+/* CONLIM = 1/(100*RELPR) for compatible systems, */
+/* CONLIM = 1/(10*sqrt(RELPR)) for least squares. */
+
+/* Note: If the user is not concerned about the parameters */
+/* ATOL, BTOL and CONLIM, any or all of them may be set */
+/* to zero. The effect will be the same as the values */
+/* RELPR, RELPR and 1/RELPR respectively. */
+
+/* ITNLIM input An upper limit on the number of iterations. */
+/* Suggested value: */
+/* ITNLIM = n/2 for well-conditioned systems */
+/* with clustered singular values, */
+/* ITNLIM = 4*n otherwise. */
+
+/* NOUT input File number for printed output. If positive, */
+/* a summary will be printed on file NOUT. */
+
+/* ISTOP output An integer giving the reason for termination: */
+
+/* 0 x = 0 is the exact solution. */
+/* No iterations were performed. */
+
+/* 1 The equations A*x = b are probably */
+/* compatible. Norm(A*x - b) is sufficiently */
+/* small, given the values of ATOL and BTOL. */
+
+/* 2 The system A*x = b is probably not */
+/* compatible. A least-squares solution has */
+/* been obtained that is sufficiently accurate, */
+/* given the value of ATOL. */
+
+/* 3 An estimate of cond(Abar) has exceeded */
+/* CONLIM. The system A*x = b appears to be */
+/* ill-conditioned. Otherwise, there could be an */
+/* error in subroutine APROD. */
+
+/* 4 The equations A*x = b are probably */
+/* compatible. Norm(A*x - b) is as small as */
+/* seems reasonable on this machine. */
+
+/* 5 The system A*x = b is probably not */
+/* compatible. A least-squares solution has */
+/* been obtained that is as accurate as seems */
+/* reasonable on this machine. */
+
+/* 6 Cond(Abar) seems to be so large that there is */
+/* no point in doing further iterations, */
+/* given the precision of this machine. */
+/* There could be an error in subroutine APROD. */
+
+/* 7 The iteration limit ITNLIM was reached. */
+
+/* ITN output The number of iterations performed. */
+
+/* ANORM output An estimate of the Frobenius norm of Abar. */
+/* This is the square-root of the sum of squares */
+/* of the elements of Abar. */
+/* If DAMP is small and if the columns of A */
+/* have all been scaled to have length 1.0, */
+/* ANORM should increase to roughly sqrt(n). */
+/* A radically different value for ANORM may */
+/* indicate an error in subroutine APROD (there */
+/* may be an inconsistency between modes 1 and 2). */
+
+/* ACOND output An estimate of cond(Abar), the condition */
+/* number of Abar. A very high value of ACOND */
+/* may again indicate an error in APROD. */
+
+/* RNORM output An estimate of the final value of norm(rbar), */
+/* the function being minimized (see notation */
+/* above). This will be small if A*x = b has */
+/* a solution. */
+
+/* ARNORM output An estimate of the final value of */
+/* norm( Abar(transpose)*rbar ), the norm of */
+/* the residual for the usual normal equations. */
+/* This should be small in all cases. (ARNORM */
+/* will often be smaller than the true value */
+/* computed from the output vector X.) */
+
+/* XNORM output An estimate of the norm of the final */
+/* solution vector X. */
+
+
+/* Subroutines and functions used */
+/* ------------------------------ */
+
+/* USER APROD */
+/* BLAS DCOPY, DNRM2, DSCAL (see Lawson et al. below) */
+
+
+/* Precision */
+/* --------- */
+
+/* The number of iterations required by LSQR will usually decrease */
+/* if the computation is performed in higher precision. To convert */
+/* LSQR between single and double precision, change the words */
+/* DOUBLE PRECISION */
+/* DCOPY, DNRM2, DSCAL */
+/* to the appropriate FORTRAN and BLAS equivalents. */
+/* Also change 'D+' or 'E+' in the PARAMETER statement. */
+
+
+/* References */
+/* ---------- */
+
+/* C.C. Paige and M.A. Saunders, LSQR: An algorithm for sparse */
+/* linear equations and sparse least squares, */
+/* ACM Transactions on Mathematical Software 8, 1 (March 1982), */
+/* pp. 43-71. */
+
+/* C.C. Paige and M.A. Saunders, Algorithm 583, LSQR: Sparse */
+/* linear equations and least-squares problems, */
+/* ACM Transactions on Mathematical Software 8, 2 (June 1982), */
+/* pp. 195-209. */
+
+/* C.L. Lawson, R.J. Hanson, D.R. Kincaid and F.T. Krogh, */
+/* Basic linear algebra subprograms for Fortran usage, */
+/* ACM Transactions on Mathematical Software 5, 3 (Sept 1979), */
+/* pp. 308-323 and 324-325. */
+/* ----------------------------------------------------------------------- */
+
+
+/* LSQR development: */
+/* 22 Feb 1982: LSQR sent to ACM TOMS to become Algorithm 583. */
+/* 15 Sep 1985: Final F66 version. LSQR sent to "misc" in netlib. */
+/* 13 Oct 1987: Bug (Robert Davies, DSIR). Have to delete */
+/* IF ( (ONE + DABS(T)) .LE. ONE ) GO TO 200 */
+/* from loop 200. The test was an attempt to reduce */
+/* underflows, but caused W(I) not to be updated. */
+/* 17 Mar 1989: First F77 version. */
+/* 04 May 1989: Bug (David Gay, AT&T). When the second BETA is zero, */
+/* RNORM = 0 and */
+/* TEST2 = ARNORM / (ANORM * RNORM) overflows. */
+/* Fixed by testing for RNORM = 0. */
+/* 05 May 1989: Sent to "misc" in netlib. */
+
+/* Michael A. Saunders (na.saunders @ NA-net.stanford.edu) */
+/* Department of Operations Research */
+/* Stanford University */
+/* Stanford, CA 94305-4022. */
+/* ----------------------------------------------------------------------- */
+/* Initialize. */
+/* IF (NOUT .GT. 0) */
+/* $ WRITE(NOUT, 1000) ENTER, M, N, DAMP, ATOL, CONLIM, BTOL, ITNLIM */
+ *itn = 0;
+ *istop = 0;
+ nstop = 0;
+ ctol = 0.;
+ if (*conlim > 0.) {
+ ctol = 1. / *conlim;
+ }
+ *anorm = 0.;
+ *acond = 0.;
+ bbnorm = 0.;
+ dampsq = *damp * *damp;
+ ddnorm = 0.;
+ res2 = 0.;
+ *xnorm = 0.;
+ xxnorm = 0.;
+ cs2 = -1.;
+ sn2 = 0.;
+ z = 0.;
+ for (i = 0; i < *n; ++i) {
+ v[i] = 0.;
+ x[i] = 0.;
+ se[i] = 0.;
+ }
+/* Set up the first vectors U and V for the bidiagonalization. */
+/* These satisfy BETA*U = b, ALFA*V = A(transpose)*U. */
+ alfa = 0.;
+ beta = dnrm2_(m, u, &c__1);
+ if (beta > 0.) {
+ d__1 = 1. / beta;
+ dscal_(m, &d__1, u, &c__1);
+ (*aprod)(&c__2, m, n, v, u, leniw, lenrw, iw, rw);
+ alfa = dnrm2_(n, v, &c__1);
+ }
+ if (alfa > 0.) {
+ d__1 = 1. / alfa;
+ dscal_(n, &d__1, v, &c__1);
+ dcopy_(n, v, &c__1, w, &c__1);
+ }
+ *arnorm = alfa * beta;
+ if (*arnorm == 0.) {
+ goto L800;
+ }
+ rhobar = alfa;
+ phibar = beta;
+ bnorm = beta;
+ *rnorm = beta;
+/* IF (NOUT .GT. 0 ) THEN */
+/* IF (DAMPSQ .EQ. ZERO) THEN */
+/* WRITE(NOUT, 1200) */
+/* ELSE */
+/* WRITE(NOUT, 1300) */
+/* END IF */
+/* TEST1 = ONE */
+/* TEST2 = ALFA / BETA */
+/* WRITE(NOUT, 1500) ITN, X(1), RNORM, TEST1, TEST2 */
+/* WRITE(NOUT, 1600) */
+/* END IF */
+/* ------------------------------------------------------------------ */
+/* Main iteration loop. */
+/* ------------------------------------------------------------------ */
+L100:
+ ++(*itn);
+/* Perform the next step of the bidiagonalization to obtain the */
+/* next BETA, U, ALFA, V. These satisfy the relations */
+/* BETA*U = A*V - ALFA*U, */
+/* ALFA*V = A(transpose)*U - BETA*V. */
+ d__1 = -alfa;
+ dscal_(m, &d__1, u, &c__1);
+ (*aprod)(&c__1, m, n, v, u, leniw, lenrw, iw, rw);
+ beta = dnrm2_(m, u, &c__1);
+ bbnorm = bbnorm + alfa * alfa + beta * beta + dampsq;
+ if (beta > 0.) {
+ d__1 = 1. / beta;
+ dscal_(m, &d__1, u, &c__1);
+ d__1 = -beta;
+ dscal_(n, &d__1, v, &c__1);
+ (*aprod)(&c__2, m, n, v, u, leniw, lenrw, iw, rw);
+ alfa = dnrm2_(n, v, &c__1);
+ if (alfa > 0.) {
+ d__1 = 1. / alfa;
+ dscal_(n, &d__1, v, &c__1);
+ }
+ }
+/* Use a plane rotation to eliminate the damping parameter. */
+/* This alters the diagonal (RHOBAR) of the lower-bidiagonal matrix. */
+ rhbar2 = rhobar * rhobar + dampsq;
+ rhbar1 = sqrt(rhbar2);
+ cs1 = rhobar / rhbar1;
+ sn1 = *damp / rhbar1;
+ psi = sn1 * phibar;
+ phibar *= cs1;
+/* Use a plane rotation to eliminate the subdiagonal element (BETA) */
+/* of the lower-bidiagonal matrix, giving an upper-bidiagonal matrix. */
+ rho = sqrt(rhbar2 + beta * beta);
+ cs = rhbar1 / rho;
+ sn = beta / rho;
+ theta = sn * alfa;
+ rhobar = -cs * alfa;
+ phi = cs * phibar;
+ phibar *= sn;
+ tau = sn * phi;
+/* Update X, W and the standard error estimates. */
+ t1 = phi / rho;
+ t2 = -theta / rho;
+ t3 = 1. / rho;
+ for (i = 0; i < *n; ++i) {
+ t = w[i];
+ x[i] += t1 * t;
+ w[i] = t2 * t + v[i];
+ t *= t3; t *= t;
+ se[i] += t;
+ ddnorm += t;
+ }
+/* Use a plane rotation on the right to eliminate the */
+/* super-diagonal element (THETA) of the upper-bidiagonal matrix. */
+/* Then use the result to estimate norm(X). */
+ delta = sn2 * rho;
+ gambar = -cs2 * rho;
+ rhs = phi - delta * z;
+ zbar = rhs / gambar;
+ *xnorm = sqrt(xxnorm + zbar * zbar);
+ gamma = sqrt(gambar * gambar + theta * theta);
+ cs2 = gambar / gamma;
+ sn2 = theta / gamma;
+ z = rhs / gamma;
+ xxnorm += z * z;
+/* Test for convergence. */
+/* First, estimate the norm and condition of the matrix Abar, */
+/* and the norms of rbar and Abar(transpose)*rbar. */
+ *anorm = sqrt(bbnorm);
+ *acond = *anorm * sqrt(ddnorm);
+ res1 = phibar * phibar;
+ res2 += psi * psi;
+ *rnorm = sqrt(res1 + res2);
+ *arnorm = alfa * abs(tau);
+/* Now use these norms to estimate certain other quantities, */
+/* some of which will be small near a solution. */
+ test1 = *rnorm / bnorm;
+ test2 = 0.;
+ if (*rnorm > 0.) {
+ test2 = *arnorm / (*anorm * *rnorm);
+ }
+ test3 = 1. / *acond;
+ t1 = test1 / (*anorm * *xnorm / bnorm + 1.);
+ rtol = *btol + *atol * *anorm * *xnorm / bnorm;
+/* The following tests guard against extremely small values of */
+/* ATOL, BTOL or CTOL. (The user may have set any or all of */
+/* the parameters ATOL, BTOL, CONLIM to zero.) */
+/* The effect is equivalent to the normal tests using */
+/* ATOL = RELPR, BTOL = RELPR, CONLIM = 1/RELPR. */
+ t3 = test3 + 1.;
+ t2 = test2 + 1.;
+ t1 += 1.;
+ if (*itn >= *itnlim) {
+ *istop = 7;
+ }
+ if (t3 <= 1.) {
+ *istop = 6;
+ }
+ if (t2 <= 1.) {
+ *istop = 5;
+ }
+ if (t1 <= 1.) {
+ *istop = 4;
+ }
+/* Allow for tolerances set by the user. */
+ if (test3 <= ctol) {
+ *istop = 3;
+ }
+ if (test2 <= *atol) {
+ *istop = 2;
+ }
+ if (test1 <= rtol) {
+ *istop = 1;
+ }
+/* ================================================================== */
+/* See if it is time to print something. */
+ if (*nout <= 0) {
+ goto L600;
+ }
+ if (*n <= 40) {
+ goto L400;
+ }
+ if (*itn <= 10) {
+ goto L400;
+ }
+ if (*itn >= *itnlim - 10) {
+ goto L400;
+ }
+ if (*itn % 10 == 0) {
+ goto L400;
+ }
+ if (test3 <= ctol * 2.f) {
+ goto L400;
+ }
+ if (test2 <= *atol * 10.f) {
+ goto L400;
+ }
+ if (test1 <= rtol * 10.f) {
+ goto L400;
+ }
+ if (*istop != 0) {
+ goto L400;
+ }
+ goto L600;
+/* Print a line for this iteration. */
+L400:
+ if (TRUE_) {
+ goto L600;
+ }
+/* 400 WRITE(NOUT, 1500) ITN, X(1), RNORM, TEST1, TEST2, ANORM, ACOND */
+/* IF (MOD(ITN,10) .EQ. 0) WRITE(NOUT, 1600) */
+/* ================================================================== */
+/* Stop if appropriate. */
+/* The convergence criteria are required to be met on NCONV */
+/* consecutive iterations, where NCONV is set below. */
+/* Suggested value: NCONV = 1, 2 or 3. */
+L600:
+ if (*istop == 0) {
+ nstop = 0;
+ }
+ if (*istop == 0) {
+ goto L100;
+ }
+ nconv = 1;
+ ++nstop;
+ if (nstop < nconv && *itn < *itnlim) {
+ *istop = 0;
+ }
+ if (*istop == 0) {
+ goto L100;
+ }
+/* ------------------------------------------------------------------ */
+/* End of iteration loop. */
+/* ------------------------------------------------------------------ */
+/* Finish off the standard error estimates. */
+ t = 1.;
+ if (*m > *n) {
+ t = (doublereal) (*m - *n);
+ }
+ if (dampsq > 0.) {
+ t = (doublereal) (*m);
+ }
+ t = *rnorm / sqrt(t);
+ for (i = 0; i < *n; ++i) {
+ se[i] = t * sqrt(se[i]);
+ }
+/* Print the stopping condition. */
+L800:
+ if (TRUE_) {
+ goto L900;
+ }
+/* 800 IF (NOUT .GT. 0) THEN */
+/* WRITE(NOUT, 2000) EXIT, ISTOP, ITN, */
+/* $ EXIT, ANORM, ACOND, */
+/* $ EXIT, RNORM, ARNORM, */
+/* $ EXIT, BNORM, XNORM */
+/* WRITE(NOUT, 3000) EXIT, MSG(ISTOP) */
+/* END IF */
+L900:
+ return;
+/* ------------------------------------------------------------------ */
+/* ------------------------------------------------------------------ */
+} /* lsqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..a965e787fa037e85e5a0b7d19799784bd5c11685
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/lsqr.f
@@ -0,0 +1,611 @@
+* From arpa!sol-michael.stanford.edu!mike 5 May 89 23:53:00 PDT
+ SUBROUTINE LSQR ( M, N, APROD, DAMP,
+ $ LENIW, LENRW, IW, RW,
+ $ U, V, W, X, SE,
+ $ ATOL, BTOL, CONLIM, ITNLIM, NOUT,
+ $ ISTOP, ITN, ANORM, ACOND, RNORM, ARNORM, XNORM)
+
+ EXTERNAL APROD
+ INTEGER M, N, LENIW, LENRW, ITNLIM, NOUT, ISTOP, ITN
+ INTEGER IW(LENIW)
+ DOUBLE PRECISION RW(LENRW), U(M), V(N), W(N), X(N), SE(N),
+ $ ATOL, BTOL, CONLIM, DAMP,
+ $ ANORM, ACOND, RNORM, ARNORM, XNORM
+*-----------------------------------------------------------------------
+*
+* LSQR finds a solution x to the following problems:
+*
+* 1. Unsymmetric equations -- solve A*x = b
+*
+* 2. Linear least squares -- solve A*x = b
+* in the least-squares sense
+*
+* 3. Damped least squares -- solve ( A )*x = ( b )
+* ( damp*I ) ( 0 )
+* in the least-squares sense
+*
+* where A is a matrix with m rows and n columns, b is an
+* m-vector, and damp is a scalar. (All quantities are real.)
+* The matrix A is intended to be large and sparse. It is accessed
+* by means of subroutine calls of the form
+*
+* CALL APROD ( mode, m, n, x, y, LENIW, LENRW, IW, RW )
+*
+* which must perform the following functions:
+*
+* If MODE = 1, compute y = y + A*x.
+* If MODE = 2, compute x = x + A(transpose)*y.
+*
+* The vectors x and y are input parameters in both cases.
+* If mode = 1, y should be altered without changing x.
+* If mode = 2, x should be altered without changing y.
+* The parameters LENIW, LENRW, IW, RW may be used for workspace
+* as described below.
+*
+* The rhs vector b is input via U, and subsequently overwritten.
+*
+*
+* Note: LSQR uses an iterative method to approximate the solution.
+* The number of iterations required to reach a certain accuracy
+* depends strongly on the scaling of the problem. Poor scaling of
+* the rows or columns of A should therefore be avoided where
+* possible.
+*
+* For example, in problem 1 the solution is unaltered by
+* row-scaling. If a row of A is very small or large compared to
+* the other rows of A, the corresponding row of ( A b ) should be
+* scaled up or down.
+*
+* In problems 1 and 2, the solution x is easily recovered
+* following column-scaling. Unless better information is known,
+* the nonzero columns of A should be scaled so that they all have
+* the same Euclidean norm (e.g., 1.0).
+*
+* In problem 3, there is no freedom to re-scale if damp is
+* nonzero. However, the value of damp should be assigned only
+* after attention has been paid to the scaling of A.
+*
+* The parameter damp is intended to help regularize
+* ill-conditioned systems, by preventing the true solution from
+* being very large. Another aid to regularization is provided by
+* the parameter ACOND, which may be used to terminate iterations
+* before the computed solution becomes very large.
+*
+*
+* Notation
+* --------
+*
+* The following quantities are used in discussing the subroutine
+* parameters:
+*
+* Abar = ( A ), bbar = ( b )
+* ( damp*I ) ( 0 )
+*
+* r = b - A*x, rbar = bbar - Abar*x
+*
+* rnorm = sqrt( norm(r)**2 + damp**2 * norm(x)**2 )
+* = norm( rbar )
+*
+* RELPR = the relative precision of floating-point arithmetic
+* on the machine being used. For example, on the IBM 370,
+* RELPR is about 1.0E-6 and 1.0D-16 in single and double
+* precision respectively.
+*
+* LSQR minimizes the function rnorm with respect to x.
+*
+*
+* Parameters
+* ----------
+*
+* M input m, the number of rows in A.
+*
+* N input n, the number of columns in A.
+*
+* APROD external See above.
+*
+* DAMP input The damping parameter for problem 3 above.
+* (DAMP should be 0.0 for problems 1 and 2.)
+* If the system A*x = b is incompatible, values
+* of DAMP in the range 0 to sqrt(RELPR)*norm(A)
+* will probably have a negligible effect.
+* Larger values of DAMP will tend to decrease
+* the norm of x and reduce the number of
+* iterations required by LSQR.
+*
+* The work per iteration and the storage needed
+* by LSQR are the same for all values of DAMP.
+*
+* LENIW input The length of the workspace array IW.
+* LENRW input The length of the workspace array RW.
+* IW workspace An integer array of length LENIW.
+* RW workspace A real array of length LENRW.
+*
+* Note: LSQR does not explicitly use the previous four
+* parameters, but passes them to subroutine APROD for
+* possible use as workspace. If APROD does not need
+* IW or RW, the values LENIW = 1 or LENRW = 1 should
+* be used, and the actual parameters corresponding to
+* IW or RW may be any convenient array of suitable type.
+*
+* U(M) input The rhs vector b. Beware that U is
+* over-written by LSQR.
+*
+* V(N) workspace
+* W(N) workspace
+*
+* X(N) output Returns the computed solution x.
+*
+* SE(N) output Returns standard error estimates for the
+* components of X. For each i, SE(i) is set
+* to the value rnorm * sqrt( sigma(i,i) / T ),
+* where sigma(i,i) is an estimate of the i-th
+* diagonal of the inverse of Abar(transpose)*Abar
+* and T = 1 if m .le. n,
+* T = m - n if m .gt. n and damp = 0,
+* T = m if damp .ne. 0.
+*
+* ATOL input An estimate of the relative error in the data
+* defining the matrix A. For example,
+* if A is accurate to about 6 digits, set
+* ATOL = 1.0E-6 .
+*
+* BTOL input An extimate of the relative error in the data
+* defining the rhs vector b. For example,
+* if b is accurate to about 6 digits, set
+* BTOL = 1.0E-6 .
+*
+* CONLIM input An upper limit on cond(Abar), the apparent
+* condition number of the matrix Abar.
+* Iterations will be terminated if a computed
+* estimate of cond(Abar) exceeds CONLIM.
+* This is intended to prevent certain small or
+* zero singular values of A or Abar from
+* coming into effect and causing unwanted growth
+* in the computed solution.
+*
+* CONLIM and DAMP may be used separately or
+* together to regularize ill-conditioned systems.
+*
+* Normally, CONLIM should be in the range
+* 1000 to 1/RELPR.
+* Suggested value:
+* CONLIM = 1/(100*RELPR) for compatible systems,
+* CONLIM = 1/(10*sqrt(RELPR)) for least squares.
+*
+* Note: If the user is not concerned about the parameters
+* ATOL, BTOL and CONLIM, any or all of them may be set
+* to zero. The effect will be the same as the values
+* RELPR, RELPR and 1/RELPR respectively.
+*
+* ITNLIM input An upper limit on the number of iterations.
+* Suggested value:
+* ITNLIM = n/2 for well-conditioned systems
+* with clustered singular values,
+* ITNLIM = 4*n otherwise.
+*
+* NOUT input File number for printed output. If positive,
+* a summary will be printed on file NOUT.
+*
+* ISTOP output An integer giving the reason for termination:
+*
+* 0 x = 0 is the exact solution.
+* No iterations were performed.
+*
+* 1 The equations A*x = b are probably
+* compatible. Norm(A*x - b) is sufficiently
+* small, given the values of ATOL and BTOL.
+*
+* 2 The system A*x = b is probably not
+* compatible. A least-squares solution has
+* been obtained that is sufficiently accurate,
+* given the value of ATOL.
+*
+* 3 An estimate of cond(Abar) has exceeded
+* CONLIM. The system A*x = b appears to be
+* ill-conditioned. Otherwise, there could be an
+* error in subroutine APROD.
+*
+* 4 The equations A*x = b are probably
+* compatible. Norm(A*x - b) is as small as
+* seems reasonable on this machine.
+*
+* 5 The system A*x = b is probably not
+* compatible. A least-squares solution has
+* been obtained that is as accurate as seems
+* reasonable on this machine.
+*
+* 6 Cond(Abar) seems to be so large that there is
+* no point in doing further iterations,
+* given the precision of this machine.
+* There could be an error in subroutine APROD.
+*
+* 7 The iteration limit ITNLIM was reached.
+*
+* ITN output The number of iterations performed.
+*
+* ANORM output An estimate of the Frobenius norm of Abar.
+* This is the square-root of the sum of squares
+* of the elements of Abar.
+* If DAMP is small and if the columns of A
+* have all been scaled to have length 1.0,
+* ANORM should increase to roughly sqrt(n).
+* A radically different value for ANORM may
+* indicate an error in subroutine APROD (there
+* may be an inconsistency between modes 1 and 2).
+*
+* ACOND output An estimate of cond(Abar), the condition
+* number of Abar. A very high value of ACOND
+* may again indicate an error in APROD.
+*
+* RNORM output An estimate of the final value of norm(rbar),
+* the function being minimized (see notation
+* above). This will be small if A*x = b has
+* a solution.
+*
+* ARNORM output An estimate of the final value of
+* norm( Abar(transpose)*rbar ), the norm of
+* the residual for the usual normal equations.
+* This should be small in all cases. (ARNORM
+* will often be smaller than the true value
+* computed from the output vector X.)
+*
+* XNORM output An estimate of the norm of the final
+* solution vector X.
+*
+*
+* Subroutines and functions used
+* ------------------------------
+*
+* USER APROD
+* BLAS DCOPY, DNRM2, DSCAL (see Lawson et al. below)
+*
+*
+* Precision
+* ---------
+*
+* The number of iterations required by LSQR will usually decrease
+* if the computation is performed in higher precision. To convert
+* LSQR between single and double precision, change the words
+* DOUBLE PRECISION
+* DCOPY, DNRM2, DSCAL
+* to the appropriate FORTRAN and BLAS equivalents.
+* Also change 'D+' or 'E+' in the PARAMETER statement.
+*
+*
+* References
+* ----------
+*
+* C.C. Paige and M.A. Saunders, LSQR: An algorithm for sparse
+* linear equations and sparse least squares,
+* ACM Transactions on Mathematical Software 8, 1 (March 1982),
+* pp. 43-71.
+*
+* C.C. Paige and M.A. Saunders, Algorithm 583, LSQR: Sparse
+* linear equations and least-squares problems,
+* ACM Transactions on Mathematical Software 8, 2 (June 1982),
+* pp. 195-209.
+*
+* C.L. Lawson, R.J. Hanson, D.R. Kincaid and F.T. Krogh,
+* Basic linear algebra subprograms for Fortran usage,
+* ACM Transactions on Mathematical Software 5, 3 (Sept 1979),
+* pp. 308-323 and 324-325.
+*-----------------------------------------------------------------------
+*
+*
+* LSQR development:
+* 22 Feb 1982: LSQR sent to ACM TOMS to become Algorithm 583.
+* 15 Sep 1985: Final F66 version. LSQR sent to "misc" in netlib.
+* 13 Oct 1987: Bug (Robert Davies, DSIR). Have to delete
+* IF ( (ONE + DABS(T)) .LE. ONE ) GO TO 200
+* from loop 200. The test was an attempt to reduce
+* underflows, but caused W(I) not to be updated.
+* 17 Mar 1989: First F77 version.
+* 04 May 1989: Bug (David Gay, AT&T). When the second BETA is zero,
+* RNORM = 0 and
+* TEST2 = ARNORM / (ANORM * RNORM) overflows.
+* Fixed by testing for RNORM = 0.
+* 05 May 1989: Sent to "misc" in netlib.
+*
+* Michael A. Saunders (na.saunders @ NA-net.stanford.edu)
+* Department of Operations Research
+* Stanford University
+* Stanford, CA 94305-4022.
+*-----------------------------------------------------------------------
+
+* Intrinsics and local variables
+
+ INTRINSIC ABS, MOD, SQRT
+ INTEGER I, NCONV, NSTOP
+ DOUBLE PRECISION DNRM2
+ DOUBLE PRECISION ALFA, BBNORM, BETA, BNORM,
+ $ CS, CS1, CS2, CTOL, DAMPSQ, DDNORM, DELTA,
+ $ GAMMA, GAMBAR, PHI, PHIBAR, PSI,
+ $ RES1, RES2, RHO, RHOBAR, RHBAR1, RHBAR2,
+ $ RHS, RTOL, SN, SN1, SN2,
+ $ T, TAU, TEST1, TEST2, TEST3,
+ $ THETA, T1, T2, T3, XXNORM, Z, ZBAR
+
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+
+ CHARACTER*16 ENTER, EXIT
+ CHARACTER*60 MSG(0:7)
+
+ DATA ENTER /' Enter LSQR. '/,
+ $ EXIT /' Exit LSQR. '/
+
+ DATA MSG
+ $ / 'The exact solution is X = 0',
+ $ 'Ax - b is small enough, given ATOL, BTOL',
+ $ 'The least-squares solution is good enough, given ATOL',
+ $ 'The estimate of cond(Abar) has exceeded CONLIM',
+ $ 'Ax - b is small enough for this machine',
+ $ 'The least-squares solution is good enough for this machine',
+ $ 'Cond(Abar) seems to be too large for this machine',
+ $ 'The iteration limit has been reached' /
+*-----------------------------------------------------------------------
+
+
+* Initialize.
+
+C IF (NOUT .GT. 0)
+C $ WRITE(NOUT, 1000) ENTER, M, N, DAMP, ATOL, CONLIM, BTOL, ITNLIM
+ ITN = 0
+ ISTOP = 0
+ NSTOP = 0
+ CTOL = ZERO
+ IF (CONLIM .GT. ZERO) CTOL = ONE / CONLIM
+ ANORM = ZERO
+ ACOND = ZERO
+ BBNORM = ZERO
+ DAMPSQ = DAMP**2
+ DDNORM = ZERO
+ RES2 = ZERO
+ XNORM = ZERO
+ XXNORM = ZERO
+ CS2 = - ONE
+ SN2 = ZERO
+ Z = ZERO
+
+ DO 10 I = 1, N
+ V(I) = ZERO
+ X(I) = ZERO
+ SE(I) = ZERO
+ 10 CONTINUE
+
+* Set up the first vectors U and V for the bidiagonalization.
+* These satisfy BETA*U = b, ALFA*V = A(transpose)*U.
+
+ ALFA = ZERO
+ BETA = DNRM2 ( M, U, 1 )
+
+ IF (BETA .GT. ZERO) THEN
+ CALL DSCAL ( M, (ONE / BETA), U, 1 )
+ CALL APROD ( 2, M, N, V, U, LENIW, LENRW, IW, RW )
+ ALFA = DNRM2 ( N, V, 1 )
+ END IF
+
+ IF (ALFA .GT. ZERO) THEN
+ CALL DSCAL ( N, (ONE / ALFA), V, 1 )
+ CALL DCOPY ( N, V, 1, W, 1 )
+ END IF
+
+ ARNORM = ALFA * BETA
+ IF (ARNORM .EQ. ZERO) GO TO 800
+
+ RHOBAR = ALFA
+ PHIBAR = BETA
+ BNORM = BETA
+ RNORM = BETA
+
+C IF (NOUT .GT. 0 ) THEN
+C IF (DAMPSQ .EQ. ZERO) THEN
+C WRITE(NOUT, 1200)
+C ELSE
+C WRITE(NOUT, 1300)
+C END IF
+C TEST1 = ONE
+C TEST2 = ALFA / BETA
+C WRITE(NOUT, 1500) ITN, X(1), RNORM, TEST1, TEST2
+C WRITE(NOUT, 1600)
+C END IF
+
+* ------------------------------------------------------------------
+* Main iteration loop.
+* ------------------------------------------------------------------
+ 100 ITN = ITN + 1
+
+* Perform the next step of the bidiagonalization to obtain the
+* next BETA, U, ALFA, V. These satisfy the relations
+* BETA*U = A*V - ALFA*U,
+* ALFA*V = A(transpose)*U - BETA*V.
+
+ CALL DSCAL ( M, (- ALFA), U, 1 )
+ CALL APROD ( 1, M, N, V, U, LENIW, LENRW, IW, RW )
+ BETA = DNRM2 ( M, U, 1 )
+ BBNORM = BBNORM + ALFA**2 + BETA**2 + DAMPSQ
+
+ IF (BETA .GT. ZERO) THEN
+ CALL DSCAL ( M, (ONE / BETA), U, 1 )
+ CALL DSCAL ( N, (- BETA), V, 1 )
+ CALL APROD ( 2, M, N, V, U, LENIW, LENRW, IW, RW )
+ ALFA = DNRM2 ( N, V, 1 )
+ IF (ALFA .GT. ZERO) THEN
+ CALL DSCAL ( N, (ONE / ALFA), V, 1 )
+ END IF
+ END IF
+
+* Use a plane rotation to eliminate the damping parameter.
+* This alters the diagonal (RHOBAR) of the lower-bidiagonal matrix.
+
+ RHBAR2 = RHOBAR**2 + DAMPSQ
+ RHBAR1 = SQRT( RHBAR2 )
+ CS1 = RHOBAR / RHBAR1
+ SN1 = DAMP / RHBAR1
+ PSI = SN1 * PHIBAR
+ PHIBAR = CS1 * PHIBAR
+
+* Use a plane rotation to eliminate the subdiagonal element (BETA)
+* of the lower-bidiagonal matrix, giving an upper-bidiagonal matrix.
+
+ RHO = SQRT( RHBAR2 + BETA**2 )
+ CS = RHBAR1 / RHO
+ SN = BETA / RHO
+ THETA = SN * ALFA
+ RHOBAR = - CS * ALFA
+ PHI = CS * PHIBAR
+ PHIBAR = SN * PHIBAR
+ TAU = SN * PHI
+
+* Update X, W and the standard error estimates.
+
+ T1 = PHI / RHO
+ T2 = - THETA / RHO
+ T3 = ONE / RHO
+
+ DO 200 I = 1, N
+ T = W(I)
+ X(I) = T1*T + X(I)
+ W(I) = T2*T + V(I)
+ T = (T3*T)**2
+ SE(I) = T + SE(I)
+ DDNORM = T + DDNORM
+ 200 CONTINUE
+
+* Use a plane rotation on the right to eliminate the
+* super-diagonal element (THETA) of the upper-bidiagonal matrix.
+* Then use the result to estimate norm(X).
+
+ DELTA = SN2 * RHO
+ GAMBAR = - CS2 * RHO
+ RHS = PHI - DELTA * Z
+ ZBAR = RHS / GAMBAR
+ XNORM = SQRT( XXNORM + ZBAR **2 )
+ GAMMA = SQRT( GAMBAR**2 + THETA**2 )
+ CS2 = GAMBAR / GAMMA
+ SN2 = THETA / GAMMA
+ Z = RHS / GAMMA
+ XXNORM = XXNORM + Z**2
+
+* Test for convergence.
+* First, estimate the norm and condition of the matrix Abar,
+* and the norms of rbar and Abar(transpose)*rbar.
+
+ ANORM = SQRT( BBNORM )
+ ACOND = ANORM * SQRT( DDNORM )
+ RES1 = PHIBAR**2
+ RES2 = RES2 + PSI**2
+ RNORM = SQRT( RES1 + RES2 )
+ ARNORM = ALFA * ABS( TAU )
+
+* Now use these norms to estimate certain other quantities,
+* some of which will be small near a solution.
+
+ TEST1 = RNORM / BNORM
+ TEST2 = ZERO
+ IF (RNORM .GT. ZERO) TEST2 = ARNORM / (ANORM * RNORM)
+ TEST3 = ONE / ACOND
+ T1 = TEST1 / (ONE + ANORM * XNORM / BNORM)
+ RTOL = BTOL + ATOL * ANORM * XNORM / BNORM
+
+* The following tests guard against extremely small values of
+* ATOL, BTOL or CTOL. (The user may have set any or all of
+* the parameters ATOL, BTOL, CONLIM to zero.)
+* The effect is equivalent to the normal tests using
+* ATOL = RELPR, BTOL = RELPR, CONLIM = 1/RELPR.
+
+ T3 = ONE + TEST3
+ T2 = ONE + TEST2
+ T1 = ONE + T1
+ IF (ITN .GE. ITNLIM) ISTOP = 7
+ IF (T3 .LE. ONE ) ISTOP = 6
+ IF (T2 .LE. ONE ) ISTOP = 5
+ IF (T1 .LE. ONE ) ISTOP = 4
+
+* Allow for tolerances set by the user.
+
+ IF (TEST3 .LE. CTOL) ISTOP = 3
+ IF (TEST2 .LE. ATOL) ISTOP = 2
+ IF (TEST1 .LE. RTOL) ISTOP = 1
+* ==================================================================
+
+* See if it is time to print something.
+
+ IF (NOUT .LE. 0 ) GO TO 600
+ IF (N .LE. 40 ) GO TO 400
+ IF (ITN .LE. 10 ) GO TO 400
+ IF (ITN .GE. ITNLIM-10) GO TO 400
+ IF (MOD(ITN,10) .EQ. 0 ) GO TO 400
+ IF (TEST3 .LE. 2.0*CTOL) GO TO 400
+ IF (TEST2 .LE. 10.0*ATOL) GO TO 400
+ IF (TEST1 .LE. 10.0*RTOL) GO TO 400
+ IF (ISTOP .NE. 0 ) GO TO 400
+ GO TO 600
+
+* Print a line for this iteration.
+
+ 400 IF (1 .EQ. 1) GO TO 600
+C 400 WRITE(NOUT, 1500) ITN, X(1), RNORM, TEST1, TEST2, ANORM, ACOND
+C IF (MOD(ITN,10) .EQ. 0) WRITE(NOUT, 1600)
+* ==================================================================
+
+* Stop if appropriate.
+* The convergence criteria are required to be met on NCONV
+* consecutive iterations, where NCONV is set below.
+* Suggested value: NCONV = 1, 2 or 3.
+
+ 600 IF (ISTOP .EQ. 0) NSTOP = 0
+ IF (ISTOP .EQ. 0) GO TO 100
+ NCONV = 1
+ NSTOP = NSTOP + 1
+ IF (NSTOP .LT. NCONV .AND. ITN .LT. ITNLIM) ISTOP = 0
+ IF (ISTOP .EQ. 0) GO TO 100
+* ------------------------------------------------------------------
+* End of iteration loop.
+* ------------------------------------------------------------------
+
+
+* Finish off the standard error estimates.
+
+ T = ONE
+ IF (M .GT. N ) T = M - N
+ IF (DAMPSQ .GT. ZERO) T = M
+ T = RNORM / SQRT( T )
+
+ DO 700 I = 1, N
+ SE(I) = T * SQRT( SE(I) )
+ 700 CONTINUE
+
+* Print the stopping condition.
+
+ 800 IF (1 .EQ. 1) GO TO 900
+C 800 IF (NOUT .GT. 0) THEN
+C WRITE(NOUT, 2000) EXIT, ISTOP, ITN,
+C $ EXIT, ANORM, ACOND,
+C $ EXIT, RNORM, ARNORM,
+C $ EXIT, BNORM, XNORM
+C WRITE(NOUT, 3000) EXIT, MSG(ISTOP)
+C END IF
+
+ 900 RETURN
+
+* ------------------------------------------------------------------
+ 1000 FORMAT(// 1P, A, ' Least-squares solution of A*x = b'
+ $ / ' The matrix A has', I7, ' rows and', I7, ' columns'
+ $ / ' The damping parameter is DAMP =', E10.2
+ $ / ' ATOL =', E10.2, 15X, 'CONLIM =', E10.2
+ $ / ' BTOL =', E10.2, 15X, 'ITNLIM =', I10)
+ 1200 FORMAT(// ' Itn x(1) Function',
+ $ ' Compatible LS Norm A Cond A' /)
+ 1300 FORMAT(// ' Itn x(1) Function',
+ $ ' Compatible LS Norm Abar Cond Abar' /)
+ 1500 FORMAT(1P, I6, 2E17.9, 4E10.2)
+ 1600 FORMAT(1X)
+ 2000 FORMAT(/ 1P, A, 6X, 'ISTOP =', I3, 16X, 'ITN =', I9
+ $ / A, 6X, 'ANORM =', E13.5, 6X, 'ACOND =', E13.5
+ $ / A, 6X, 'RNORM =', E13.5, 6X, 'ARNORM =', E13.5,
+ $ / A, 6X, 'BNORM =', E13.5, 6X, 'XNORM =', E13.5)
+ 3000 FORMAT( A, 6X, A )
+* ------------------------------------------------------------------
+* End of LSQR
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/machineparams.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/machineparams.c
new file mode 100644
index 0000000000000000000000000000000000000000..38708eb144a2897a7f8c180163be785b1f3d749d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/machineparams.c
@@ -0,0 +1,44 @@
+#include "f2c.h"
+#include "netlib.h"
+
+doublereal dpmpar_(i)
+const integer *i;
+{
+/* function dpmpar */
+
+/* This function provides double precision machine parameters */
+/* when the appropriate set of data statements is activated (by */
+/* removing the c from column 1) and all other data statements are */
+/* rendered inactive. Most of the parameter values were obtained */
+/* from the corresponding Bell Laboratories Port Library function. */
+
+/* The function statement is */
+
+/* double precision function dpmpar(i) */
+
+/* where */
+
+/* i is an integer input variable set to 1, 2, or 3 which */
+/* selects the desired machine parameter. If the machine has */
+/* t base b digits and its smallest and largest exponents are */
+/* emin and emax, respectively, then these parameters are */
+
+/* dpmpar(1) = b**(1 - t), the machine precision, */
+
+/* dpmpar(2) = b**(emin - 1), the smallest magnitude, */
+
+/* dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. */
+
+/* Argonne National Laboratory. MINPACK Project. June 1983. */
+/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More */
+
+/* Machine constants for IEEE double */
+
+ double dmach[3] = {
+ 2.2204460492503130808472633361816406250000e-16,
+ 1.7976931348623158e+308,
+ 2.2250738585072014e-308
+ };
+
+ return dmach[*i - 1];
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/netlib.h b/Utilities/ITK/Utilities/vxl/v3p/netlib/netlib.h
new file mode 100644
index 0000000000000000000000000000000000000000..450c7a0b772ba73301a7dcdb6e8c9c1e37fc3a2c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/netlib.h
@@ -0,0 +1,680 @@
+#ifndef netlib_h_
+#define netlib_h_
+
+/*
+//:
+// \file
+// \brief Header file for all exported netlib (fortran-originating) functions
+// \author Peter Vanroose, KULeuven
+// \date March 2002
+*/
+
+#ifdef __cplusplus
+#include <vcl_complex.h>
+typedef vcl_complex<float> cmplx;
+typedef vcl_complex<double> dcmplx;
+typedef int logical;
+extern "C" {
+#else
+#define cmplx complex
+#define dcmplx doublecomplex
+#endif
+
+#include <vxl_config.h>
+#ifndef sqrtf // for VS8
+#if VXL_C_MATH_HAS_SQRTF
+float sqrtf(float);
+#else
+# define sqrtf(f) ((float)sqrt((double)(f)))
+#endif
+#endif
+
+ char * F77_aloc(int Len, const char *whence);
+ void sig_die(const char *s, int kill);
+ void exit_(int *rc);
+ void s_cat(char *lp, const char *rpp[], long rnp[], long *np, long ll);
+ int s_cmp(const char *a0, const char *b0, long la, long lb);
+ void s_copy(char *a, const char *b, long la, long lb);
+ double f__cabs(double, double);
+
+ double pow_dd(const double *x, const double *y);
+ double pow_di(const double *ap, const int *bp);
+ int pow_ii(const int *ap, const int *bp);
+ float pow_ri(const float *ap, const int *bp);
+ float c_abs(const cmplx *z);
+ double z_abs(const dcmplx *z);
+ void r_cnjg(cmplx *r, const cmplx *z);
+ void d_cnjg(dcmplx *r, const dcmplx *z);
+ void c_div(cmplx *c, const cmplx *a, const cmplx *b);
+ void z_div(dcmplx *c, const dcmplx *a, const dcmplx *b);
+ int i_dnnt(const double *x);
+ float r_imag(const cmplx *z);
+ double d_imag(const dcmplx *a);
+ double d_lg10(const double *x);
+ float r_sign(const float *a, const float *b);
+ double d_sign(const double *a, const double *b);
+ void z_sqrt(dcmplx *ret_value, const dcmplx *z);
+ double urand_(int *iy);
+ void xerbla_(const char *srname, int *info);
+
+ /*: Computes singular values and vectors of an mxn matrix (double version) */
+ void dsvdc_(double *x, const int* ldx, /*!< (IN) matrix, m rows, n columns, stored row-wise */
+ const int* m, const int* n,
+ double *singular_values, /*!< (OUT) in descending order of magnitude */
+ double *errors, /*!< (OUT) superdiagonal of u^T*x*v (normally 0) */
+ double *u, const int* ldu, /*!< (OUT) left singular vectors */
+ double *v, const int* ldv, /*!< (OUT) right singular vectors */
+ double *work, /*!< (IN/OUT) scratch work area of length m */
+ const int* job, /*!< (IN) 2-digit number. First digit refers to u; 0 = do not compute, 1 = all m; 2 = only min(m,n) */
+ int *info); /*!< (OUT) singular values [info] and up are correct */
+
+ /*: Computes singular values and vectors of an mxn matrix (float version) */
+ void ssvdc_(float* x, const int* ldx, const int* m, const int* n,
+ float* s, float* e, float* u, const int* ldu, float* v, const int* ldv,
+ float* work, const int* job, int* info);
+
+ /*: Computes singular values and vectors of an mxn matrix (double_complex version) */
+ void zsvdc_(dcmplx* x, const int* ldx, const int* m, const int* n,
+ dcmplx* s, dcmplx* e, dcmplx* u, const int* ldu, dcmplx* v, const int* ldv,
+ dcmplx* work, const int* job, int* info);
+
+ /*: Computes singular values and vectors of an mxn matrix (float_complex version) */
+ void csvdc_(cmplx* x, const int* ldx, const int* m, const int* n,
+ cmplx* s, cmplx* e, cmplx* u, const int* ldu, cmplx* v, const int* ldv,
+ cmplx* work, const int* job, int* info);
+
+ void sggsvd_(char *jobu, char *jobv, char *jobq, int *m, int *n, int *p, int *k, int *l, float *a, int *lda,
+ float *b, int *ldb, float *alpha, float *beta, float *u, int * ldu, float *v, int *ldv, float *q, int *ldq,
+ float *work, int *iwork, int *info);
+
+ void dggsvd_(char *jobu, char *jobv, char *jobq, int *m, int *n, int *p, int *k, int *l,
+ double *a, int *lda, double *b, int *ldb, double *alpha, double *beta,
+ double *u, int *ldu, double *v, int *ldv, double *q, int *ldq, double *work, int *iwork, int *info);
+
+ /*: Finds eigenvalues and eigenvectors of a general matrix */
+ void rg_(int* nm, int* n, double* a, double* wr, double* wi, int* matz, double* z, int* iv1, double* fv1, int* ierr);
+
+ /*: Computes eigenvalues and eigenvectors of nxn complex general matrix */
+ void zgeev_(const char* jobvl, const char* jobvr, const int* n, dcmplx* a, const int* lda, dcmplx* w,
+ dcmplx* vl, const int* ldvl, dcmplx* vr, const int* ldvr,
+ dcmplx* work, int* lwork, double* rwork, int* info);
+
+ /*: Computes eigenvalues and eigenvectors of a real symmetric matrix */
+ void rs_(const int* nm, /*!< (IN) leading dimension of matrices */
+ const int* n, /*!< (IN) order of the square matrix a */
+ double *a_matrix, /*!< (IN) real symmetric matrix */
+ double *eigenvalues, /*!< (OUT) eigenvalues in ascending order */
+ const int* want_eigenvectors, /*!< (IN) set nonzero if eigenvectors wanted */
+ double *eigenvectors, /*!< (OUT) eigenvectors */
+ double *workspace_1_size_n, double *workspace_2_size_n, /*!< scratch */
+ int* output_error_code); /*!< (OUT) normal completion code is 0 */
+
+ /*: Computes eigenvalues and eigenvectors of a real symmetric generalized eigenproblem ax = lambda bx. */
+ void rsg_(const int* nm, /*!< (IN) leading dimension of matrices */
+ const int* n, /*!< (IN) order of the square matrices a and b */
+ double *a_matrix, /*!< (IN) real symmetric matrix */
+ double *b_matrix, /*!< (IN) positive definite real symm matrix */
+ double *eigenvalues, /*!< (OUT) eigenvalues in ascending order */
+ const int* want_eigenvectors, /*!< (IN) set nonzero if eigenvectors wanted */
+ double *eigenvectors, /*!< (OUT) eigenvectors */
+ double *workspace_1_size_n, double *workspace_2_size_n, /*!< scratch */
+ int* output_error_code); /*!< (OUT) normal completion code is 0 */
+
+ /*: Computes QR factorisation of an n x p double matrix */
+ void dqrdc_(double *x, const int* ldx, /*!< (IN/OUT) matrix, n rows, p columns, stored row-wise */
+ const int* n, const int* p,
+ double* qraux, /*!< (OUT) further info necessary to recover R part from x */
+ int *jpvt, /*!< (IN/OUT) length p; selection of pivot columns: */
+ /* ==0 ==> any; >0 ==> initial column; <0 ==> final */
+ double *work, /*!< (IN/OUT) scratch work area of length p */
+ const int* job); /*!< (IN) if == 0, no pivoting is done */
+
+ /*: Computes QR factorisation of an n x p float matrix */
+ void sqrdc_(float* x, const int* ldx, const int* n, const int* p,
+ float* qraux, int* jpvt, float* work, const int* job);
+
+ /*: Computes QR factorisation of an n x p double_complex matrix */
+ void zqrdc_(dcmplx* x, const int* ldx, const int* n, const int* p,
+ dcmplx* qraux, int* jpvt, dcmplx* work, const int* job);
+
+ /*: Computes QR factorisation of an n x p float_complex matrix */
+ void cqrdc_(cmplx* x, const int* ldx, const int* n, const int* p,
+ cmplx* qraux, int* jpvt, cmplx* work, const int* job);
+
+ /*: Computes coord transf etc from QR factorisation of double matrix */
+ void dqrsl_(const double* x, const int* ldx, /*!< (IN) output of dqrdc_, n x k matrix */
+ const int* n, const int* k, /*!< (IN) k <= min(n,p) with n,p from dqrdc_ */
+ const double* qraux, /*!< (IN) qraux output of dqrdc_ */
+ const double* y, /*!< (IN) n-vector to operate on */
+ double* qy, /*!< (OUT) q*y */
+ double* qty, /*!< (OUT) q^T*y (conjugate transpose if complex) */
+ double* b, /*!< (OUT) solution b of min norm_2(y - x*b) */
+ double* rsd, /*!< (OUT) least squares residual y - x*b = proj of y on orth complement of columns(x) */
+ double* xb, /*!< (OUT) least squares approx of x*b = proj of y on columns(x) */
+ const int* job, /*!< (IN) decimal acbde: a:compute qy; c:qty; b:qty+b; d:qty+rsd; e:qty+xb */
+ int* info); /*!< non-zero if r is singular and b is set. */
+
+ /*: Computes coord transf etc from QR factorisation of float matrix */
+ void sqrsl_(const float* x, const int* ldx, const int* n, const int* k,
+ const float* qraux, const float* y,
+ float* qy, float* qty, float* b, float* rsd, float* xb,
+ const int* job, int* info);
+
+ /*: Computes coord transf etc from QR factorisation of double_complex matrix */
+ void zqrsl_(const dcmplx* x, const int* ldx, const int* n, const int* k,
+ const dcmplx* qraux, const dcmplx* y,
+ dcmplx* qy, dcmplx* qty, dcmplx* b, dcmplx* rsd, dcmplx* xb,
+ const int* job, int* info);
+
+ /*: Computes coord transf etc from QR factorisation of float_complex matrix */
+ void cqrsl_(const cmplx* x, const int* ldx, const int* n, const int* k,
+ const cmplx* qraux, const cmplx* y,
+ cmplx* qy, cmplx* qty, cmplx* b, cmplx* rsd, cmplx* xb,
+ int* job, int* info);
+
+ /*: Minimizes a function using the conjugate gradient method */
+ void cg_(double* x, /*!< (IN/OUT) minimizer, length n; input = starting guess */
+ double* e, /*!< (OUT) max-norm of gradient */
+ int* it, /*!< (OUT) number of iterations performed */
+ double* step, /*!< (IN/OUT) step size along search direction */
+ const double* tolerance_on_e, const int* max_iterations,
+ const int* n, /*!< (IN) number of unknowns */
+ const int* m, /*!< (IN) # iterations before calc new seach direction */
+ double (*cost_function)(double*),
+ void (*gradient_func)(double*,double*),
+ void (*both)(double*,double*,double*),
+ void (*preconditioning_func)(double*,double*),
+ double *work);
+
+ /*: Computes the float cumulative distribution function value for the chi-squared distribution */
+ void chscdf_(const float* x, /*!< (IN) value where the cumulative distribution must be evaluated */
+ const int* nu, /*!< (IN) # degrees of freedom */
+ float* cdf); /*!< (OUT) the function value */
+
+ /*: Computes the double cumulative distribution function value for the chi-squared distribution */
+ void dchscdf_(double* x, int* nu, double* cdf);
+
+ /*: Self-sorting in-place generalized prime factor (complex) double fft */
+ void dgpfa_(double* a, /*!< (IN/OUT) Real part of input/output vectors */
+ double* b, /*!< (IN/OUT) Imaginary part of input/output vectors */
+ const double* trigs, /*!< (IN) output of dsetgfpa_ (twiddle factors) */
+ const int* inc, /*!< (IN) increment within each data vector (normally 1) */
+ const int* jump, /*!< (IN) increment between data vectors */
+ const int* n, /*!< (IN) length of the transforms; should only have 2,3,5 as prime factors */
+ const int* lot, /*!< (IN) number of transforms */
+ const int* isign, /*!< (IN) forward transform: +1; backward: -1 */
+ const int* npqr, /*!< (IN) 3-array with the number of factors of 2,3,5 */
+ int* info); /*!< (OUT) 0 if no problems */
+
+ /*: Self-sorting in-place generalized prime factor (complex) float fft */
+ void gpfa_(float* a, float* b, const float* trigs, const int* inc, const int* jump,
+ const int* n, const int* lot, const int* isign, const int* nj, int* info);
+
+ /*: Set-up routine for dgpfa_ */
+ void dsetgpfa_(double* trigs, const int* n, int* ires, int* info);
+
+ /*: Set-up routine for gpfa_ */
+ void setgpfa_(float* trigs, const int* n, int* ires, int* info);
+
+ void gpfa2f_(float *a, float *b, const float *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+ void gpfa3f_(float *a, float *b, const float *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+ void gpfa5f_(float *a, float *b, const float *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+ void dgpfa2f_(double *a, double *b, const double *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+ void dgpfa3f_(double *a, double *b, const double *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+ void dgpfa5f_(double *a, double *b, const double *trigs, const int *inc, const int *jump,
+ const int *n, const int *mm, const int *lot, const int *isign);
+
+ /*: Finds a few eigenvalues and eigenvectors at either end of the spectrum of a large sparse symmetric matrix. */
+ void dnlaso_(void (*op)(const int* n,const int* m, const double* p, double* q),
+ void (*iovect)(const int* n,const int* m, double* q, const int* j, const int* k),
+ const int* n, const int* nval, const int* nfig, int* nperm,
+ const int* nmval, double* val,
+ const int* nmvec, double* vec,
+ const int* nblock, const int* maxop, const int* maxj, double* work, int* ind, int* ierr);
+ void snlaso_(void (*op)(const int* n,const int* m, const float* p, float* q),
+ void (*iovect)(const int* n,const int* m, float* q, const int* j, const int* k),
+ const int* n, const int* nval, const int* nfig, int* nperm,
+ const int* nmval, float* val,
+ const int* nmvec, float* vec,
+ const int* nblock, const int* maxop, const int* maxj, float* work, int* ind, int* ierr);
+
+ /*: Factors a symmetric positive definite matrix and estimates the condition of the matrix */
+ void dpoco_(double* a, int* lda, int* n, double* rcond, double* z, int* info);
+
+ /*: Computes determinant and inverse of a certain symmetric positive definite matrix using dpoco_, dposa_ or dqrdc_ output */
+ void dpodi_(double* a, const int* lda, const int* n, double* det, const int* job);
+
+ /*: Factors a double precision symmetric positive definite matrix */
+ void dpofa_(double* a, int* lda, int* n, int* info);
+
+ /*: Solves the symmetric positive definite system a * x = b dpoco or dpofa output */
+ void dposl_(const double* a, const int* lda, const int* n, double* b);
+
+ /*: Solves the unconstrained minimization problem min F(x1..xN) */
+ void lbfgs_(int* n, int* m, double* x, double* f, double* g,
+ logical * diagco, double* diag, int* iprint,
+ double* eps, double* xtol, double* w, int* iflag);
+
+ /*: Minimizes the sum of the squares of m nonlin functions in n variables */
+ void lmder1_(void (*fcn)(int*,int*,double*,double*,double*,int*,int*),
+ int* m, int* n, double* x,
+ double* fvec, double* fjac, int* ldfjac,
+ double* tol, int* info, int* ipvt, double* wa, int* lwa);
+ void lmder_(void (*fcn)(int*,int*,double*,double*,double*,int*,int*),
+ int *m, int *n, double *x, double *fvec, double *fjac, int *ldfjac, double *ftol, double *xtol, double *gtol,
+ int *maxfev, double *diag, int *mode, double *factor, int *nprint, int *info,
+ int *nfev, int *njev, int *ipvt, double *qtf, double *wa1, double *wa2, double *wa3, double *wa4);
+
+ /*: Minimizes the sum of the squares of m nonlin functions in n variables */
+ void lmdif_(void (*fcn)(int*,int*,double*,double*,int*),
+ int* m, int* n, double* x, double* fvec, double* ftol,
+ double* xtol, double* gtol, int* maxfev, double* epsfcn, double* diag,
+ int* mode, double* factor, int* nprint, int* info, int* nfev,
+ double* fjac, int* ldfjac, int* ipvt, double* qtf,
+ double* wa1, double* wa2, double* wa3, double* wa4, double* errors);
+
+ /*: Solves A*x = b */
+ void lsqr_(int* m, int* n,
+ void (*aprod)(int*,int*,int*,double*,double*,int*,int*,int*,double*),
+ double* damp, int* leniw, int* lenrw,
+ int* iw, double* rw, double* u, double* v, double* w, double* x, double* se,
+ double* atol, double* btol, double* conlim, int* itnlim, int* nout, int* istop,
+ int* itn, double* anorm, double* acond, double* rnorm, double* arnorm, double* xnorm);
+
+ /*: Finds the zeros of a real polynomial */
+ void rpoly_(double* op, int* degree, double* zeror, double* zeroi, logical* fail);
+
+ void saxpy_(const int *n, const float *sa, const float *sx, const int *incx, float *sy, const int *incy);
+ void daxpy_(const int *n, const double *da, const double *dx, const int *incx, double *dy, const int *incy);
+ void caxpy_(const int *n, const cmplx *ca, const cmplx *cx, const int *incx, cmplx *cy, const int *incy);
+ void zaxpy_(const int *n, const dcmplx *za, const dcmplx *zx, const int *incx, dcmplx *zy, const int *incy);
+
+ void scopy_(const int *n, const float *sx, const int *incx, float *sy, const int *incy);
+ void dcopy_(const int *n, const double *dx, const int *incx, double *dy, const int *incy);
+ void ccopy_(const int *n, const cmplx *cx, const int *incx, cmplx *cy, const int *incy);
+ void zcopy_(const int *n, const dcmplx *zx, const int *incx, dcmplx *zy, const int *incy);
+
+ float sdot_(const int *n, const float *sx, const int *incx, const float *sy, const int *incy);
+double ddot_(const int *n, const double *dx, const int *incx, const double *dy, const int *incy);
+ void cdotc_(cmplx *ret_val, const int *n, const cmplx *cx, const int *incx, const cmplx *cy, const int *incy);
+ void zdotc_(dcmplx *ret_val, const int *n, const dcmplx *zx, const int *incx, const dcmplx *zy, const int *incy);
+ void zdotu_(dcmplx *ret_val, const int *n, const dcmplx *zx, const int *incx, const dcmplx *zy, const int *incy);
+
+ void sscal_(const int *n, const float *sa, float *sx, const int *incx);
+ void dscal_(const int *n, const double *da, double *dx, const int *incx);
+ void cscal_(const int *n, const cmplx *ca, cmplx *cx, const int *incx);
+ void zscal_(const int *n, const dcmplx *za, dcmplx *zx, const int *incx);
+ void zdscal_(const int *n, const double *da, dcmplx *zx, const int *incx);
+
+ void sswap_(const int *n, float *sx, const int *incx, float *sy, const int *incy);
+ void dswap_(const int *n, double *dx, const int *incx, double *dy, const int *incy);
+ void cswap_(const int *n, cmplx *cx, const int *incx, cmplx *cy, const int *incy);
+ void zswap_(const int *n, dcmplx *zx, const int *incx, dcmplx *zy, const int *incy);
+
+ void dgecon_(char *norm, int *n, double *a, int *lda, double *anorm, double *rcond, double *work, int *iwork, int *info);
+
+ void dgemm_(const char *transa, const char *transb, const int *m, const int *n, const int *k, double *alpha,
+ double *a, const int *lda, double *b, const int *ldb, double *beta, double *c, const int *ldc);
+ void zgemm_(const char *transa, const char *transb, const int *m, const int *n, const int *k, dcmplx *alpha,
+ dcmplx *a, const int *lda, dcmplx *b, const int *ldb, dcmplx *beta, dcmplx *c, const int *ldc);
+
+ void sgemv_(const char *trans, const int *m, const int *n, float *alpha,
+ float *a, const int *lda, float *x, const int *incx, float *beta, float *y, const int *incy);
+ void dgemv_(const char *trans, const int *m, const int *n, double *alpha,
+ double *a, const int *lda, double *x, const int *incx, double *beta, double *y, const int *incy);
+ void zgemv_(const char *trans, const int *m, const int *n, dcmplx *alpha,
+ dcmplx *a, const int *lda, dcmplx *x, const int *incx, dcmplx *beta, dcmplx *y, const int *incy);
+
+ void sgeqpf_(int *m, int *n, float *a, int *lda, int *jpvt, float *tau, float *work, int *info);
+ void dgeqpf_(int *m, int *n, double *a, int *lda, int *jpvt, double *tau, double *work, int *info);
+ void sgeqr2_(int *m, int *n, float *a, int *lda, float *tau, float *work, int *info);
+ void dgeqr2_(int *m, int *n, double *a, int *lda, double *tau, double *work, int *info);
+ void dgeqrf_(int *m, int *n, double *a, int *lda, double *tau, double *work, int *lwork, int *info);
+
+ void sger_(const int *m, const int *n, float *alpha, float *x, const int *incx, float *y, const int *incy,
+ float *a, const int *lda);
+ void dger_(const int *m, const int *n, double *alpha, double *x, const int *incx, double *y, const int *incy,
+ double *a, const int *lda);
+ void zgerc_(const int *m, const int *n, dcmplx *alpha, dcmplx *x, const int *incx, dcmplx *y, const int *incy,
+ dcmplx *a, const int *lda);
+ void sgerq2_(const int *m, const int *n, float *a, const int *lda, float *tau, float *work, int *info);
+ void dgerq2_(const int *m, const int *n, double *a, const int *lda, double *tau, double *work, int *info);
+
+ void dgesc2_(int *n, double *a, int *lda, double *rhs, int *ipiv, int *jpiv, double *scale);
+ void dgetc2_(int *n, double *a, int *lda, int *ipiv, int *jpiv, int *info);
+
+ void dggbak_(const char *job, const char *side, const int *n, int *ilo, int *ihi, double *lscale, double *rscale,
+ const int *m, double *v, const int *ldv, int *info);
+ void zgebak_(const char *job, const char *side, const int *n, int *ilo, int *ihi, double *scale,
+ const int *m, dcmplx *v, const int *ldv, int *info);
+ void dggbal_(const char *job, const int *n, double *a, const int *lda, double *b, const int *ldb, int *ilo, int *ihi,
+ double *lscale, double *rscale, double *work, int *info);
+ void zgebal_(const char *job, const int *n, dcmplx *a, const int *lda, int *ilo, int *ihi, double *scale, int *info);
+
+ void dgges_(const char *jobvsl, const char *jobvsr, const char *sort, logical (*delctg)(double*,double*,double*),
+ int *n, double *a, int *lda, double *b, int *ldb, int *sdim, double *alphar, double *alphai, double *beta,
+ double *vsl, int *ldvsl, double *vsr, int *ldvsr, double *work, int *lwork, logical *bwork, int *info);
+
+ void dgghrd_(const char *compq, const char *compz, const int *n, int *ilo, int *ihi, double *a, const int *lda,
+ double *b, const int *ldb, double *q, const int *ldq, double *z, const int *ldz, int *info);
+ void zgehrd_(const int *n, int *ilo, int *ihi, dcmplx *a, const int *lda, dcmplx *tau, dcmplx *work, int *lwork, int *info);
+ void zgehd2_(const int *n, const int *ilo, const int *ihi, dcmplx *a, const int *lda, dcmplx *tau, dcmplx *work, int *info);
+
+ void sggsvp_(char *jobu, char *jobv, char *jobq, int *m, int *p, int *n, float *a, int *lda, float *b, int *ldb,
+ float *tola, float *tolb, int *k, int *l, float *u, int *ldu, float *v, int *ldv, float *q, int *ldq,
+ int *iwork, float *tau, float *work, int *info);
+ void dggsvp_(char *jobu, char *jobv, char *jobq, int *m, int *p, int *n, double *a, int *lda, double *b, int *ldb,
+ double *tola, double *tolb, int *k, int *l, double *u, int *ldu, double *v, int *ldv, double *q, int *ldq,
+ int *iwork, double *tau, double *work, int *info);
+
+ void dhgeqz_(const char *job, const char *compq, const char *compz, int *n, int *ilo, int *ihi,
+ double *a, int *lda, double *b, int *ldb, double *alphar, double *alphai, double *beta,
+ double *q, int *ldq, double *z, int *ldz, double *work, int *lwork, int *info);
+
+ void dlabad_(double *small, double *large);
+ void dlacon_(int *n, double *v, double *x, int *isgn, double *est, int *kase);
+
+ void dlacpy_(const char *uplo, const int *m, const int *n, double *a, const int *lda, double *b, const int *ldb);
+ void slacpy_(const char *uplo, const int *m, const int *n, float *a, const int *lda, float *b, const int *ldb);
+ void zlacpy_(const char *uplo, const int *m, const int *n, dcmplx *a, const int *lda, dcmplx *b, const int *ldb);
+
+ void dladiv_(const double *a, const double *b, const double *c, const double *d, double *p, double *q);
+ void zladiv_(dcmplx *ret_val, const dcmplx *x, const dcmplx *y);
+
+ void dlag2_(double *a, int *lda, double *b, int *ldb, double *safmin, double *scale1, double *scale2,
+ double *wr1, double *wr2, double *wi);
+ void slags2_(logical *upper, float *a1, float *a2, float *a3, float *b1, float *b2, float *b3,
+ float *csu, float *snu, float *csv, float * snv, float *csq, float *snq);
+ void dlags2_(logical *upper, double *a1, double *a2, double *a3, double *b1, double *b2, double *b3,
+ double *csu, double *snu, double *csv, double *snv, double *csq, double *snq);
+ void dlagv2_(double *a, int *lda, double *b, int *ldb, double *alphar, double *alphai, double *beta,
+ double *csl, double *snl, double *csr, double *snr);
+
+ float slamch_(const char *cmach);
+double dlamch_(const char *cmach);
+
+ float slange_(const char *norm, const int *m, const int *n, float *a, const int *lda, float *work);
+double dlange_(const char *norm, const int *m, const int *n, double *a, const int *lda, double *work);
+double zlange_(const char *norm, const int *m, const int *n, dcmplx *a, const int *lda, double *work);
+
+double dlanhs_(const char *norm, const int *n, double *a, const int *lda, double *work);
+double zlanhs_(const char *norm, const int *n, dcmplx *a, const int *lda, double *work);
+
+ void slapll_(int *n, float *x, int *incx, float *y, int *incy, float *ssmin);
+ void dlapll_(int *n, double *x, int *incx, double *y, int *incy, double *ssmin);
+
+ void slapmt_(logical *forwrd, int *m, int *n, float *x, int *ldx, int *k);
+ void dlapmt_(logical *forwrd, int *m, int *n, double *x, int *ldx, int *k);
+
+ float slapy2_(const float *x, const float *y);
+double dlapy2_(const double *x, const double *y);
+double dlapy3_(const double *x, const double *y, const double *z);
+
+ void slarf_(const char *side, const int *m, const int *n, float *v, const int *incv, const float *tau,
+ float *c, const int *ldc, float *work);
+ void dlarf_(const char *side, const int *m, const int *n, double *v, const int *incv, const double *tau,
+ double *c, const int *ldc, double *work);
+ void zlarf_(const char *side, const int *m, const int *n, dcmplx *v, const int *incv, const dcmplx *tau,
+ dcmplx *c, const int *ldc, dcmplx *work);
+
+ void dlarfb_(const char *side, const char *trans, const char *direct, const char *storev,
+ const int *m, const int *n, const int *k, double *v, const int *ldv, double *t, const int *ldt,
+ double *c, const int *ldc, double *work, const int *ldwork);
+ void zlarfb_(const char *side, const char *trans, const char *direct, const char *storev,
+ const int *m, const int *n, const int *k, dcmplx *v, const int *ldv,
+ dcmplx *t, const int *ldt, dcmplx *c, const int *ldc, dcmplx *work, const int *ldwork);
+
+ void slarfg_(const int *n, float *alpha, float *x, const int *incx, float *tau);
+ void dlarfg_(const int *n, double *alpha, double *x, const int *incx, double *tau);
+ void zlarfg_(const int *n, dcmplx *alpha, dcmplx *x, const int *incx, dcmplx *tau);
+
+ void dlarft_(const char *direct, const char *storev, const int *n, const int *k,
+ double *v, const int *ldv, const double *tau, double *t, const int *ldt);
+ void zlarft_(const char *direct, const char *storev, const int *n, const int *k, dcmplx *v, const int *ldv,
+ const dcmplx *tau, dcmplx *t, int *ldt);
+ void zlarfx_(const char *side, const int *m, const int *n, dcmplx *v, dcmplx *tau, dcmplx *c, const int *ldc, dcmplx *work);
+
+ void slartg_(float *f, float *g, float *cs, float *sn, float *r);
+ void dlartg_(double *f, double *g, double *cs, double *sn, double *r);
+
+ void slas2_(float *f, float *g, float *h, float *ssmin, float * ssmax);
+ void dlas2_(double *f, double *g, double *h, double *ssmin, double *ssmax);
+
+ void dlascl_(const char *type, const int *kl, const int *ku, double *cfrom, double *cto,
+ const int *m, const int *n, double *a, const int *lda, int *info);
+ void zlascl_(const char *type, const int *kl, const int *ku, double *cfrom, double *cto,
+ const int *m, const int *n, dcmplx *a, const int *lda, int *info);
+
+ void slaset_(const char *uplo, const int *m, const int *n, float *alpha, float *beta, float *a, const int *lda);
+ void dlaset_(const char *uplo, const int *m, const int *n, double *alpha, double *beta, double *a, const int *lda);
+ void zlaset_(const char *uplo, const int *m, const int *n, dcmplx *alpha, dcmplx *beta, dcmplx *a, const int *lda);
+
+ void slassq_(const int *n, const float *x, const int *incx, float *scale, float *sumsq);
+ void dlassq_(const int *n, const double *x, const int *incx, double *scale, double *sumsq);
+ void zlassq_(const int *n, const dcmplx *x, const int *incx, double *scale, double *sumsq);
+
+ void slasv2_(float *f, float *g, float *h, float *ssmin, float *ssmax, float *snr, float *csr, float *snl, float *csl);
+ void dlasv2_(double *f, double *g, double *h, double *ssmin, double *ssmax, double *snr, double * csr, double *snl, double *csl);
+
+ void dlaswp_(int *n, double *a, int *lda, int *k1, int *k2, int *ipiv, int *incx);
+
+ void dlatdf_(int *ijob, int *n, double *z, int *ldz, double *rhs, double *rdsum, double *rdscal, int *ipiv, int *jpiv);
+
+ float snrm2_(const int *n, const float *x, const int *incx);
+double dnrm2_(const int* n, const double* x, const int* incx);
+ float scnrm2_(const int *n, const cmplx *x, const int *incx);
+double dznrm2_(const int *n, const dcmplx *x, const int *incx);
+double enorm_(const int *n, const double *x);
+
+ void sorg2r_(int *m, int *n, int *k, float *a, int *lda, float *tau, float *work, int *info);
+ void dorg2r_(int *m, int *n, int *k, double *a, int *lda, double *tau, double *work, int *info);
+ void dorgqr_(int *m, int *n, int *k, double *a, int *lda, double *tau, double *work, int *lwork, int *info);
+ void dorgr2_(int *m, int *n, int *k, double *a, int *lda, double *tau, double *work, int *info);
+
+ void sorm2r_(const char *side, const char *trans, const int *m, const int *n, const int *k,
+ float *a, const int *lda, const float *tau, float *c, const int *ldc, float *work, int *info);
+ void dorm2r_(const char* side, const char* trans, const int *m, const int *n, const int *k,
+ double *a, const int *lda, const double *tau, double *c, const int*ldc, double *work, int *info);
+ void dormqr_(const char *side, const char *trans, const int *m, const int *n, const int *k,
+ double *a, const int *lda, double *tau, double *c, const int *ldc, double *work, int *lwork, int *info);
+ void sormr2_(char *side, char *trans, int *m, int *n, int*k,float*a,int*lda,float*tau,float*c,int*ldc,float*work,int*info);
+ void dormr2_(char*side, char*trans, int*m, int*n, int*k, double*a, int*lda, double*tau, double*c, int*ldc, double*work, int*info);
+
+ void lmpar_(int *n, double *r, int *ldr, int *ipvt, double *diag, double *qtb, double *delta, double *par,
+ double *x, double *sdiag, double *wa1, double *wa2);
+double dpmpar_(const int *i);
+
+ void srot_(const int *n, float *sx, const int *incx, float *sy, const int *incy, const float *c, const float *s);
+ void drot_(const int *n, double *dx, const int *incx, double *dy, const int *incy, const double *c, const double *s);
+ void csrot_(const int *n, cmplx *cx, const int *incx, cmplx *cy, const int *incy, const float *c, const float *s);
+ void zdrot_(const int *n, dcmplx *zx, const int *incx, dcmplx *zy, const int *incy, const double *c, const double *s);
+ void srotg_(float *sa, float *sb, float *c, float *s);
+ void drotg_(double *da, double *db, double *c, double *s);
+
+ void drscl_(int *n, double *sa, double *sx, int *incx);
+
+ void dtgex2_(logical *wantq, logical *wantz, int *n, double *a, int *lda, double *b, int *ldb, double *q, int *ldq,
+ double *z, int *ldz, int *j1, int *n1, int *n2, double *work, int *lwork, int *info);
+ void dtgexc_(logical *wantq, logical *wantz, int *n, double *a, int *lda, double *b, int *ldb, double *q, int *ldq,
+ double *z, int *ldz, int *ifst, int *ilst, double *work, int *lwork, int *info);
+ void dtgsen_(int *ijob, logical *wantq, logical *wantz, logical *select, int *n, double *a, int *lda, double *b, int *ldb,
+ double *alphar, double *alphai, double *beta, double *q, int *ldq, double *z, int *ldz, int *m,
+ double *pl, double *pr, double *dif, double *work, int *lwork, int *iwork, int *liwork, int *info);
+ void stgsja_(char *jobu, char *jobv, char *jobq, int *m, int *p, int *n, int *k, int *l,
+ float *a, int *lda, float *b, int *ldb, float *tola, float *tolb, float *alpha, float * beta,
+ float *u, int *ldu, float *v, int *ldv, float *q, int * ldq, float *work, int *ncycle, int *info);
+ void dtgsja_(char *jobu, char *jobv, char *jobq, int *m, int *p, int *n, int *k, int *l,
+ double *a, int *lda, double *b, int *ldb, double *tola, double *tolb, double *alpha, double *beta,
+ double *u, int *ldu, double *v, int *ldv, double *q, int * ldq, double *work, int *ncycle, int *info);
+ void dtgsy2_(char *trans, int *ijob, int *m, int *n, double *a, int *lda, double *b, int *ldb,
+ double *c, int *ldc, double *d, int *ldd, double *e, int *lde, double *f, int *ldf,
+ double *scale, double *rdsum, double *rdscal, int *iwork, int *pq, int *info);
+ void dtgsyl_(char *trans, int *ijob, int *m, int *n,
+ double *a, int *lda, double *b, int *ldb, double *c, int *ldc, double *d, int *ldd, double *e, int *lde,
+ double *f, int *ldf, double *scale, double *dif, double *work, int *lwork, int *iwork, int *info);
+
+ void trans_(float *a, const int *m, const int *n, const int *mn, int *move, int *iwrk, int *iok);
+ void dtrans_(double *a, const int *m, const int *n, const int *mn, int *move, int *iwrk, int *iok);
+
+ void dtrmm_(const char *side, const char *uplo, const char *transa, const char *diag, const int *m, const int *n,
+ double *alpha, double *a, const int *lda, double *b, const int *ldb);
+ void ztrmm_(const char *side, const char *uplo, const char *transa, const char *diag, const int *m, const int *n,
+ dcmplx *alpha, dcmplx *a, const int *lda, dcmplx *b, const int *ldb);
+ void dtrmv_(const char *uplo, const char *trans, const char *diag, const int *n,
+ double *a, const int *lda, double *x, const int *incx);
+ void ztrmv_(const char *uplo, const char *trans, const char *diag, const int *n,
+ dcmplx *a, const int *lda, dcmplx *x, const int *incx);
+
+ void dtrsv_(const char *uplo, const char *trans, const char *diag, const int *n,
+ const double *a, const int *lda, double *x, const int *incx);
+ void ztrsv_(const char *uplo, const char *trans, const char *diag, const int *n,
+ const dcmplx *a, const int *lda, dcmplx *x, const int *incx);
+ void dlatrs_(const char *uplo, const char *trans, const char *diag, const char *normin, const int *n,
+ const double *a, const int *lda, double *x, double *scale, double *cnorm, int *info);
+ void zlatrs_(const char *uplo, const char *trans, const char *diag, const char *normin, const int *n,
+ const dcmplx *a, const int *lda, dcmplx *x, double *scale, double *cnorm, int *info);
+
+ float sasum_(const int *n, const float *sx, const int *incx);
+double dasum_(const int *n, const double *dx, const int *incx);
+double dzasum_(const int *n, const dcmplx *x, const int *incx);
+
+ void fdjac2_(void (*fcn)(int*,int*,double*,double*,int*),
+ int *m, int *n, double *x, double *fvec, double *fjac, int *ldfjac, int *iflag, double *epsfcn, double *wa);
+
+ int isamax_(const int *n, const float *sx, const int *incx);
+ int idamax_(const int *n, const double *dx, const int *incx);
+ int izamax_(const int *n, const dcmplx *zx, const int *incx);
+ int izmax1_(const int *n, const dcmplx *cx, const int *incx);
+
+ int ilaenv_(const int *ispec, const char *name, const char *opts, const int *n1, const int *n2, const int *n3, const int *n4);
+logical lsame_(const char *ca, const char *cb);
+double pythag_(const double *a, const double *b);
+
+ void qrfac_(int *m, int *n, double *a, int *lda, logical *pivot, int *ipvt, int *lipvt,
+ double *rdiag, double *acnorm, double *wa);
+ void qrsolv_(const int *n, double *r, const int *ldr, const int *ipvt, const double *diag,
+ const double *qtb, double *x, double *sdiag, double *wa);
+
+ void tql1_(const int *n, double *d, double *e, int *ierr);
+ void tql2_(const int *nm, const int *n, double *d, double *e, double *z, int *ierr);
+ void tred1_(const int *nm, const int *n, double *a, double *d, double *e, double *e2);
+ void tred2_(const int *nm, const int *n, const double *a, double *d, double *e, double *z);
+
+ void zhseqr_(const char *job, const char *compz, const int *n, int *ilo, int *ihi, dcmplx *h, const int *ldh,
+ dcmplx *w, dcmplx *z, const int *ldz, dcmplx *work, int *lwork, int *info);
+ void zlacgv_(const int *n, dcmplx *x, const int *incx);
+ void zlahqr_(const logical *wantt, const logical *wantz, const int *n, const int *ilo, const int *ihi,
+ dcmplx *h, const int *ldh, dcmplx *w, int *iloz, int *ihiz, dcmplx *z, const int *ldz, int *info);
+ void zlahrd_(const int *n, const int *k, const int *nb, dcmplx *a, const int *lda, dcmplx *tau,
+ dcmplx *t, const int *ldt, dcmplx *y, const int *ldy);
+ void ztrevc_(const char *side, const char *howmny, logical *select, const int *n, dcmplx *t, const int *ldt,
+ dcmplx *vl, const int *ldvl, dcmplx *vr, const int *ldvr, const int *mm, int *m,
+ dcmplx *work, double *rwork, int *info);
+
+ void zung2r_(const int *m, const int *n, const int *k, dcmplx *a, const int *lda, const dcmplx *tau,
+ dcmplx *work, int *info);
+ void zungqr_(const int *m, const int *n, const int *k, dcmplx *a, const int *lda, const dcmplx *tau,
+ dcmplx *work, const int *lwork, int *info);
+ void zunghr_(const int *n, int *ilo, int *ihi, dcmplx *a, const int *lda, const dcmplx *tau,
+ dcmplx *work, const int *lwork, int *info);
+
+ /* ITPACK functions from dsrc2c.f. */
+ int jcg_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int jsi_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int sor_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int ssorcg_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int ssorsi_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int rscg_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int rssi_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u,
+ int *iwksp, int *nw, double *wksp, int *iparm, double *rparm, int *ierr);
+ int itjcg_(int *nn, int *ia, int *ja, double *a, double *u, double *u1,
+ double *d__, double *d1, double *dtwd, double *tri);
+ int itjsi_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *u1, double *d__, int *icnt);
+ int itsor_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *wk);
+ int itsrcg_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *u1,
+ double *c__, double *c1, double *d__, double *dl, double *wk, double *tri);
+ int itsrsi_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *u1,
+ double *c__, double *d__, double *ctwd, double *wk);
+ int itrscg_(int *n, int *nnb, int *ia, int *ja, double *a, double *ub, double *ub1,
+ double *db, double *db1, double *wb, double *tri);
+ int itrssi_(int *n, int *nnb, int *ia, int *ja, double *a, double *rhs, double *ub, double *ub1, double *db);
+ int bisrch_(int *n, int *k, int *l);
+ double cheby_(double *qa, double *qt, double *rrr, int *ip, double *cme, double *sme);
+ int chgcon_(double *tri, double *gamold, double *rhoold, int *ibmth);
+ int chgsi_(double *dtnrm, int *ibmth);
+ logical chgsme_(double *oldnrm, int *icnt);
+ int itpackdaxpy_(int *n, double *da, double *dx, int *incx, double *dy, int *incy);
+ int itpackdcopy_(int *n, double *dx, int *incx, double *dy, int *incy);
+ double itpackddot_(int *n, double *dx, int *incx, double *dy, int *incy);
+ double determ_(int *n, double *tri, double *xlmda);
+ int dfault_(int *iparm, double *rparm);
+ int echall_(int *nn, int *ia, int *ja, double *a, double *rhs, int *iparm, double *rparm, int *icall);
+ int echout_(int *iparm, double *rparm, int *imthd);
+ double eigvns_(int *n, double *tri, double *d__, double *e2, int *ier);
+ double eigvss_(int *n, double *tri, double *start, double *zeta, int *itmax, int *ier);
+ int eqrt1s_(double *d__, double *e2, int *nn, int *m, int *isw, int *ierr);
+ int ipstr_(double *omega);
+ int iterm_(int *nn, double *a, double *u, double *wk, int *imthdd);
+ int ivfill_(int *n, int *iv, int *ival);
+ int omeg_(double *dnrm, int *iflag);
+ logical omgchg_(int *ndummy);
+ logical omgstr_(int *ndummy);
+ int parcon_(double *dtnrm, double *c1, double *c2, double *c3, double *c4, double *gamold, double *rhotmp, int *ibmth);
+ int parsi_(double *c1, double *c2, double *c3, int *ibmth);
+ double pbeta_(int *nn, int *ia, int *ja, double *a, double *v, double *w1, double *w2);
+ int pbsor_(int *nn, int *ia, int *ja, double *a, double *u, double *rhs);
+ int permat_(int *nn, int *ia, int *ja, double *a, int *p, int *newia, int *isym, int *level, int *nout, int *ierr);
+ int perror_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *w, double *digtt1, double *digtt2, int *idgtts);
+ int pervec_(int *n, double *v, int *p);
+ int pfsor_(int *nn, int *ia, int *ja, double *a, double *u, double *rhs);
+ int pfsor1_(int *nn, int *ia, int *ja, double *a, double *u, double *rhs);
+ int pjac_(int *nn, int *ia, int *ja, double *a, double *u, double *rhs);
+ int pmult_(int *nn, int *ia, int *ja, double *a, double *u, double *w);
+ int prbndx_(int *nn, int *nblack, int *ia, int *ja, int *p, int *ip, int *level, int *nout, int *ier);
+ int prsblk_(int *nnb, int *nnr, int *ia, int *ja, double *a, double *ur, double *vb);
+ int prsred_(int *nnb, int *nnr, int *ia, int *ja, double *a, double *ub, double *vr);
+ int pssor1_(int *nn, int *ia, int *ja, double *a, double *u, double *rhs, double *fr, double *br);
+ int pstop_(int *n, double *u, double *dnrm, double *ccon, int *iflag, logical *q1);
+ double pvtbv_(int *n, int *ia, int *ja, double *a, double *v);
+ int qsort_(int *nn, int *key, double *data, int *error);
+ int sbagn_(int *n, int *nz, int *ia, int *ja, double *a, int *iwork, int *levell, int *noutt, int *ierr);
+ int sbelm_(int *nn, int *ia, int *ja, double *a, double *rhs, int *iw, double *rw,
+ double *tol, int *isym, int *level, int *nout, int *ier);
+ int sbend_(int *n, int *nz, int *ia, int *ja, double *a, int *iwork);
+ int sbini_(int *n, int *nz, int *ia, int *ja, double *a, int *iwork);
+ int sbsij_(int *n, int *nz, int *ia, int *ja, double *a, int *iwork, int *ii, int *jj,
+ double *vall, int *mode, int *levell, int *noutt, int *ierr);
+ int scal_(int *nn, int *ia, int *ja, double *a, double *rhs, double *u, double *d__, int *level, int *nout, int *ier);
+ int sum3_(int *n, double *c1, double *x1, double *c2, double *x2, double *c3, double *x3);
+ double tau_(int *ii);
+ double timer_(float *timdmy);
+ logical tstchg_(int *ibmth);
+ int unscal_(int *n, int *ia, int *ja, double *a, double *rhs, double *u, double *d__);
+ int vevmw_(int *n, double *v, double *w);
+ int vevpw_(int *n, double *v, double *w);
+ int vfill_(int *n, double *v, double *val);
+ int vout_(int *n, double *v, int *iswt, int *noutt);
+ int wevmw_(int *n, double *v, double *w);
+ int zbrent_(int *n, double *tri, double *eps, int *nsig, double *aa, double *bb, int *maxfnn, int *ier);
+
+ int trapru_(double f(double*), double *a, double *b, int *m, double *trule);
+ int simpru_(double f(double*), double *a, double *b, int *m, double *srule);
+ /*: computes integral; input: f=integrand a,b=endpoints tol=tolerance; output: errbdd=error_estimation m=substates */
+ int adaptquad_(double f(double*), double*a, double*b, double*tol, double*srmat, double*integral, double*errbdd, int*m, int*state);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* netlib_h_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_dd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_dd.c
new file mode 100644
index 0000000000000000000000000000000000000000..e00192d0f2a3a0229f2af91b33aae202a8cc94ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_dd.c
@@ -0,0 +1,8 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double pow(double,double); /* #include <math.h> */
+
+/* extern "C" */
+double pow_dd(const double *x, const double *y) {
+ return pow(*x, *y);
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_di.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_di.c
new file mode 100644
index 0000000000000000000000000000000000000000..d3e26d45e7e198f4f20bf9ee406762814181f7be
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_di.c
@@ -0,0 +1,36 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+double pow_di(ap, bp) const doublereal *ap; const integer *bp;
+#else
+double pow_di(const doublereal *ap, const integer *bp)
+#endif
+{
+double pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+ {
+ if(n < 0)
+ {
+ n = -n;
+ x = 1/x;
+ }
+ for(u = n; ; )
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ }
+return pow;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ii.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ii.c
new file mode 100644
index 0000000000000000000000000000000000000000..1f8567870b3d407b23ceb4cb3883717a2ec69f90
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ii.c
@@ -0,0 +1,38 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef _MSC_VER
+# pragma warning(disable:4723)
+#endif
+
+#ifdef KR_headers
+integer pow_ii(ap, bp) integer *ap, *bp;
+#else
+integer pow_ii(const integer *ap, const integer *bp)
+#endif
+{
+ integer pow = 1, x = *ap, n = *bp;
+ unsigned long u;
+
+ if (n <= 0)
+ {
+ if (n == 0 || x == 1)
+ return 1;
+ if (x != -1)
+ /* Warning about division by 0 on next line in windows is expected */
+ /* Warning disabled above */
+ return x == 0 ? 1/x : 0;
+ n = -n;
+ }
+ u = n;
+ while(1)
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ return pow;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ri.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ri.c
new file mode 100644
index 0000000000000000000000000000000000000000..161cd14a5ac1147418e4121956eb6bdbe517714b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/pow_ri.c
@@ -0,0 +1,36 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+real pow_ri(ap, bp) const real *ap; const integer *bp;
+#else
+real pow_ri(const real *ap, const integer *bp)
+#endif
+{
+real pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+ {
+ if(n < 0)
+ {
+ n = -n;
+ x = 1/x;
+ }
+ for(u = n; ; )
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ }
+return pow;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/pythag.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/pythag.c
new file mode 100644
index 0000000000000000000000000000000000000000..ab88ec12ebf6a3a3bff01e7cb63379a76eac9a37
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/pythag.c
@@ -0,0 +1,28 @@
+#include "f2c.h"
+#include "netlib.h"
+
+doublereal pythag_(a, b)
+const doublereal *a, *b;
+{
+ /* Local variables */
+ static doublereal p, r, s, t, u;
+
+/* ********************************************************************** */
+/* finds sqrt(a**2+b**2) without overflow or destructive underflow */
+/* ********************************************************************** */
+
+ p = max(abs(*a),abs(*b));
+ if (p == 0.) {
+ return p;
+ }
+ r = min(abs(*a),abs(*b)) / p;
+ r *= r;
+ while ((t = r+4.) != 4.) {
+ s = r / t;
+ u = s * 2. + 1.;
+ p *= u;
+ u = s / u;
+ r *= u * u;
+ }
+ return p;
+} /* pythag_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/qrfac.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/qrfac.c
new file mode 100644
index 0000000000000000000000000000000000000000..16b9ed7701564ebc0d9bcbe91881b0a8bf6ac0e5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/qrfac.c
@@ -0,0 +1,195 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2003: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void qrfac_(m, n, a, lda, pivot, ipvt, lipvt, rdiag, acnorm, wa)
+integer *m, *n;
+doublereal *a;
+integer *lda;
+logical *pivot;
+integer *ipvt, *lipvt;
+doublereal *rdiag, *acnorm, *wa;
+{
+ /* Initialized data */
+ static doublereal one = 1.;
+ static doublereal zero = 0.;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer kmax;
+ static doublereal temp;
+ static integer i, j, k, minmn;
+ static doublereal epsmch;
+ static doublereal ajnorm;
+ static integer jp1;
+ static doublereal sum;
+ static integer failure = 44;
+
+/* ********** */
+/* */
+/* subroutine qrfac */
+/* */
+/* this subroutine uses householder transformations with column */
+/* pivoting (optional) to compute a qr factorization of the */
+/* m by n matrix a. that is, qrfac determines an orthogonal */
+/* matrix q, a permutation matrix p, and an upper trapezoidal */
+/* matrix r with diagonal elements of nonincreasing magnitude, */
+/* such that a*p = q*r. the householder transformation for */
+/* column k, k = 1,2,...,min(m,n), is of the form */
+/* */
+/* t */
+/* i - (1/u(k))*u*u */
+/* */
+/* where u has zeros in the first k-1 positions. the form of */
+/* this transformation and the method of pivoting first */
+/* appeared in the corresponding linpack subroutine. */
+/* */
+/* the subroutine statement is */
+/* */
+/* subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) */
+/* */
+/* where */
+/* */
+/* m is a positive integer input variable set to the number */
+/* of rows of a. */
+/* */
+/* n is a positive integer input variable set to the number */
+/* of columns of a. */
+/* */
+/* a is an m by n array. on input a contains the matrix for */
+/* which the qr factorization is to be computed. on output */
+/* the strict upper trapezoidal part of a contains the strict */
+/* upper trapezoidal part of r, and the lower trapezoidal */
+/* part of a contains a factored form of q (the non-trivial */
+/* elements of the u vectors described above). */
+/* */
+/* lda is a positive integer input variable not less than m */
+/* which specifies the leading dimension of the array a. */
+/* */
+/* pivot is a logical input variable. if pivot is set true, */
+/* then column pivoting is enforced. if pivot is set false, */
+/* then no column pivoting is done. */
+/* */
+/* ipvt is an integer output array of length lipvt. ipvt */
+/* defines the permutation matrix p such that a*p = q*r. */
+/* column j of p is column ipvt(j) of the identity matrix. */
+/* if pivot is false, ipvt is not referenced. */
+/* */
+/* lipvt is a positive integer input variable. if pivot is false, */
+/* then lipvt may be as small as 1. if pivot is true, then */
+/* lipvt must be at least n. */
+/* */
+/* rdiag is an output array of length n which contains the */
+/* diagonal elements of r. */
+/* */
+/* acnorm is an output array of length n which contains the */
+/* norms of the corresponding columns of the input matrix a. */
+/* if this information is not needed, then acnorm can coincide */
+/* with rdiag. */
+/* */
+/* wa is a work array of length n. if pivot is false, then wa */
+/* can coincide with rdiag. */
+
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+/* */
+/* ********** */
+
+ /* epsmch is the machine precision. */
+ epsmch = dpmpar_(&c__1);
+
+ /* verify that the size of ipvt is at least n */
+ if (lipvt < n)
+ exit_(&failure);
+
+ /* compute the initial column norms and initialize several arrays. */
+ for (j = 0; j < *n; ++j) {
+ acnorm[j] = enorm_(m, &a[j* *lda]);
+ rdiag[j] = acnorm[j];
+ wa[j] = rdiag[j];
+ if (*pivot) {
+ ipvt[j] = j+1;
+ }
+ }
+
+ /* reduce a to r with householder transformations. */
+ minmn = min(*m,*n);
+ for (j = 0; j < minmn; ++j) {
+ if (! (*pivot)) {
+ goto L40;
+ }
+
+ /* bring the column of largest norm into the pivot position. */
+ kmax = j;
+ for (k = j; k < *n; ++k) {
+ if (rdiag[k] > rdiag[kmax]) {
+ kmax = k;
+ }
+ }
+ if (kmax == j) {
+ goto L40;
+ }
+ for (i = 0; i < *m; ++i) {
+ temp = a[i + j* *lda];
+ a[i + j* *lda] = a[i + kmax* *lda];
+ a[i + kmax* *lda] = temp;
+ }
+ rdiag[kmax] = rdiag[j];
+ wa[kmax] = wa[j];
+ k = ipvt[j];
+ ipvt[j] = ipvt[kmax];
+ ipvt[kmax] = k;
+L40:
+
+ /* compute the householder transformation to reduce the */
+ /* j-th column of a to a multiple of the j-th unit vector. */
+ i__1 = *m - j;
+ ajnorm = enorm_(&i__1, &a[j + j* *lda]);
+ if (ajnorm == zero) {
+ goto L100;
+ }
+ if (a[j + j* *lda] < zero) {
+ ajnorm = -ajnorm;
+ }
+ for (i = j; i < *m; ++i) {
+ a[i + j* *lda] /= ajnorm;
+ }
+ a[j + j* *lda] += one;
+
+ /* apply the transformation to the remaining columns */
+ /* and update the norms. */
+ jp1 = j+1;
+ for (k = jp1; k < *n; ++k) {
+ sum = zero;
+ for (i = j; i < *m; ++i) {
+ sum += a[i + j* *lda] * a[i + k* *lda];
+ }
+ temp = sum / a[j + j* *lda];
+ for (i = j; i < *m; ++i) {
+ a[i + k* *lda] -= temp * a[i + j* *lda];
+ }
+ if (! (*pivot) || rdiag[k] == zero) {
+ continue;
+ }
+ temp = a[j + k* *lda] / rdiag[k];
+ rdiag[k] *= sqrt((max(zero, one - temp * temp)));
+ d__1 = rdiag[k] / wa[k];
+ if (d__1 * d__1 > 20*epsmch) {
+ continue;
+ }
+ i__1 = *m - jp1;
+ rdiag[k] = enorm_(&i__1, &a[jp1 + k* *lda]);
+ wa[k] = rdiag[k];
+ }
+L100:
+ rdiag[j] = -ajnorm;
+ }
+} /* qrfac_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/qrsolv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/qrsolv.c
new file mode 100644
index 0000000000000000000000000000000000000000..f746c29dc3d4a772aa764191a2357d065d327b20
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/qrsolv.c
@@ -0,0 +1,196 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void qrsolv_(n, r, ldr, ipvt, diag, qtb, x, sdiag, wa)
+const integer *n;
+doublereal *r;
+const integer *ldr, *ipvt;
+const doublereal *diag, *qtb;
+doublereal *x, *sdiag, *wa;
+{
+ /* Local variables */
+ static doublereal temp;
+ static integer i, j, k, l;
+ static doublereal cotan;
+ static integer nsing;
+ static doublereal qtbpj;
+ static doublereal tan_, cos_, sin_, sum;
+
+/* ********** */
+/* */
+/* subroutine qrsolv */
+/* */
+/* given an m by n matrix a, an n by n diagonal matrix d, */
+/* and an m-vector b, the problem is to determine an x which */
+/* solves the system */
+/* */
+/* a*x = b , d*x = 0 , */
+/* */
+/* in the least squares sense. */
+/* */
+/* this subroutine completes the solution of the problem */
+/* if it is provided with the necessary information from the */
+/* qr factorization, with column pivoting, of a. that is, if */
+/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
+/* columns, and r is an upper triangular matrix with diagonal */
+/* elements of nonincreasing magnitude, then qrsolv expects */
+/* the full upper triangle of r, the permutation matrix p, */
+/* and the first n components of (q transpose)*b. the system */
+/* a*x = b, d*x = 0, is then equivalent to */
+/* */
+/* t t */
+/* r*z = q *b , p *d*p*z = 0 , */
+/* */
+/* where x = p*z. if this system does not have full rank, */
+/* then a least squares solution is obtained. on output qrsolv */
+/* also provides an upper triangular matrix s such that */
+/* */
+/* t t t */
+/* p *(a *a + d*d)*p = s *s . */
+/* */
+/* s is computed within qrsolv and may be of separate interest. */
+/* */
+/* the subroutine statement is */
+/* */
+/* subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) */
+/* */
+/* where */
+/* */
+/* n is a positive integer input variable set to the order of r.*/
+/* */
+/* r is an n by n array. on input the full upper triangle */
+/* must contain the full upper triangle of the matrix r. */
+/* on output the full upper triangle is unaltered, and the */
+/* strict lower triangle contains the strict upper triangle */
+/* (transposed) of the upper triangular matrix s. */
+/* */
+/* ldr is a positive integer input variable not less than n */
+/* which specifies the leading dimension of the array r. */
+/* */
+/* ipvt is an integer input array of length n which defines the */
+/* permutation matrix p such that a*p = q*r. column j of p */
+/* is column ipvt(j) of the identity matrix. */
+/* */
+/* diag is an input array of length n which must contain the */
+/* diagonal elements of the matrix d. */
+/* */
+/* qtb is an input array of length n which must contain the first */
+/* n elements of the vector (q transpose)*b. */
+/* */
+/* x is an output array of length n which contains the least */
+/* squares solution of the system a*x = b, d*x = 0. */
+/* */
+/* sdiag is an output array of length n which contains the */
+/* diagonal elements of the upper triangular matrix s. */
+/* */
+/* wa is a work array of length n. */
+/* */
+/* argonne national laboratory. minpack project. march 1980. */
+/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
+/* */
+/* ********** */
+/* */
+/* copy r and (q transpose)*b to preserve input and initialize s. */
+/* in particular, save the diagonal elements of r in x. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *n; ++i) {
+ r[i + j * *ldr] = r[j + i * *ldr];
+ }
+ x[j] = r[j + j * *ldr];
+ wa[j] = qtb[j];
+ }
+
+/* eliminate the diagonal matrix d using a givens rotation. */
+
+ for (j = 0; j < *n; ++j) {
+
+/* prepare the row of d to be eliminated, locating the */
+/* diagonal element using p from the qr factorization. */
+
+ l = ipvt[j] - 1;
+ if (diag[l] == 0.) {
+ goto L90;
+ }
+ for (k = j; k < *n; ++k) {
+ sdiag[k] = 0.;
+ }
+ sdiag[j] = diag[l];
+
+/* the transformations to eliminate the row of d */
+/* modify only a single element of (q transpose)*b */
+/* beyond the first n, which is initially zero. */
+
+ qtbpj = 0.;
+ for (k = j; k < *n; ++k) {
+
+/* determine a givens rotation which eliminates the */
+/* appropriate element in the current row of d. */
+
+ if (sdiag[k] == 0.)
+ continue;
+
+ if (abs(r[k + k * *ldr]) < abs(sdiag[k])) {
+ cotan = r[k + k * *ldr] / sdiag[k];
+ sin_ = .5 / sqrt(.25 + .25 * (cotan * cotan));
+ cos_ = sin_ * cotan;
+ } else {
+ tan_ = sdiag[k] / r[k + k * *ldr];
+ cos_ = .5 / sqrt(.25 + .25 * (tan_ * tan_));
+ sin_ = cos_ * tan_;
+ }
+
+/* compute the modified diagonal element of r and */
+/* the modified element of ((q transpose)*b,0). */
+
+ r[k + k * *ldr] = cos_ * r[k + k * *ldr] + sin_ * sdiag[k];
+ temp = cos_ * wa[k] + sin_ * qtbpj;
+ qtbpj = -sin_ * wa[k] + cos_ * qtbpj;
+ wa[k] = temp;
+
+/* accumulate the transformation in the row of s. */
+
+ for (i = k+1; i < *n; ++i) {
+ temp = cos_ * r[i + k * *ldr] + sin_ * sdiag[i];
+ sdiag[i] = -sin_ * r[i + k * *ldr] + cos_ * sdiag[i];
+ r[i + k * *ldr] = temp;
+ }
+ }
+L90:
+
+/* store the diagonal element of s and restore */
+/* the corresponding diagonal element of r. */
+
+ sdiag[j] = r[j + j * *ldr];
+ r[j + j * *ldr] = x[j];
+ }
+
+/* solve the triangular system for z. if the system is */
+/* singular, then obtain a least squares solution. */
+
+ nsing = *n;
+ for (j = 0; j < *n; ++j) {
+ if (sdiag[j] == 0. && nsing == *n) {
+ nsing = j;
+ }
+ if (nsing < *n) {
+ wa[j] = 0.;
+ }
+ }
+ for (k = 0; k < nsing; ++k) {
+ j = nsing - k - 1;
+ sum = 0.;
+ for (i = j+1; i < nsing; ++i) {
+ sum += r[i + j * *ldr] * wa[i];
+ }
+ wa[j] = (wa[j] - sum) / sdiag[j];
+ }
+
+/* permute the components of z back to components of x. */
+
+ for (j = 0; j < *n; ++j) {
+ l = ipvt[j] - 1;
+ x[l] = wa[j];
+ }
+} /* qrsolv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/r_cnjg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_cnjg.c
new file mode 100644
index 0000000000000000000000000000000000000000..9f4cf5aad4d85808c543c46f3994533afddc4db1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_cnjg.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+VOID r_cnjg(r, z) complex *r, const complex *z;
+#else
+VOID r_cnjg(complex *r, const complex *z)
+#endif
+{
+ r->r = z->r;
+ r->i = - z->i;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/r_imag.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_imag.c
new file mode 100644
index 0000000000000000000000000000000000000000..7a97197f93410d7946425aa4e6ee6aa75b0a7ec2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_imag.c
@@ -0,0 +1,11 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+real r_imag(z) const complex *z;
+#else
+real r_imag(const complex *z)
+#endif
+{
+ return z->i;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/r_sign.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_sign.c
new file mode 100644
index 0000000000000000000000000000000000000000..4b6f331666f866f8875c1c8e5086c1fe520fba9b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/r_sign.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+real r_sign(a,b) const real *a, *b;
+#else
+real r_sign(const real *a, const real *b)
+#endif
+{
+ real x = (*a >= 0 ? *a : - *a);
+ return *b >= 0 ? x : -x;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.c
new file mode 100644
index 0000000000000000000000000000000000000000..4e7ee69821992e36b7a35f19e77def3eca4cd5ad
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.c
@@ -0,0 +1,1463 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+static void balanc_(integer *nm, integer *n, doublereal *a, integer *low, integer *igh, doublereal *scale);
+static void balbak_(integer *nm, integer *n, integer *low, integer *igh, doublereal *scale, integer *m, doublereal *z);
+static void cdiv_(doublereal *ar, doublereal *ai, doublereal *br, doublereal *bi, doublereal *cr, doublereal *ci);
+static void elmhes_(integer *nm, integer *n, integer *low, integer *igh, doublereal *a, integer *int_);
+static void eltran_(integer *nm, integer *n, integer *low, integer *igh, doublereal *a, integer *int_, doublereal *z);
+static void hqr_(integer *nm, integer *n, integer *low, integer *igh, doublereal *h,
+ doublereal *wr, doublereal *wi, integer *ierr);
+static void hqr2_(integer *nm, integer *n, integer *low, integer *igh, doublereal *h,
+ doublereal *wr, doublereal *wi, doublereal *z, integer *ierr);
+
+/* Modified by Peter Vanroose, Sept 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublereal c_b130 = 0.;
+
+/* ====================================================================== */
+/* NIST Guide to Available Math Software. */
+/* Fullsource for module RG from package EISPACK. */
+/* Retrieved from NETLIB on Thu Jan 23 06:12:53 1997. */
+/* ====================================================================== */
+/* Subroutine */ void rg_(nm, n, a, wr, wi, matz, z, iv1, fv1, ierr)
+integer *nm, *n;
+doublereal *a, *wr, *wi;
+integer *matz;
+doublereal *z;
+integer *iv1;
+doublereal *fv1;
+integer *ierr;
+{
+ /* Local variables */
+ static integer is1, is2;
+
+/* this subroutine calls the recommended sequence of */
+/* subroutines from the eigensystem subroutine package (eispack) */
+/* to find the eigenvalues and eigenvectors (if desired) */
+/* of a real general matrix. */
+
+/* on input */
+
+/* nm must be set to the row dimension of the two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix a. */
+
+/* a contains the real general matrix. */
+
+/* matz is an integer variable set equal to zero if */
+/* only eigenvalues are desired. otherwise it is set to */
+/* any non-zero integer for both eigenvalues and eigenvectors. */
+
+/* on output */
+
+/* wr and wi contain the real and imaginary parts, */
+/* respectively, of the eigenvalues. complex conjugate */
+/* pairs of eigenvalues appear consecutively with the */
+/* eigenvalue having the positive imaginary part first. */
+
+/* z contains the real and imaginary parts of the eigenvectors */
+/* if matz is not zero. if the j-th eigenvalue is real, the */
+/* j-th column of z contains its eigenvector. if the j-th */
+/* eigenvalue is complex with positive imaginary part, the */
+/* j-th and (j+1)-th columns of z contain the real and */
+/* imaginary parts of its eigenvector. the conjugate of this */
+/* vector is the eigenvector for the conjugate eigenvalue. */
+
+/* ierr is an integer output variable set equal to an error */
+/* completion code described in the documentation for hqr */
+/* and hqr2. the normal completion code is zero. */
+
+/* iv1 and fv1 are temporary storage arrays. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ if (*n <= *nm) {
+ goto L10;
+ }
+ *ierr = *n * 10;
+ goto L50;
+
+L10:
+ balanc_(nm, n, a, &is1, &is2, fv1);
+ elmhes_(nm, n, &is1, &is2, a, iv1);
+ if (*matz != 0) {
+ goto L20;
+ }
+/* .......... find eigenvalues only .......... */
+ hqr_(nm, n, &is1, &is2, a, wr, wi, ierr);
+ goto L50;
+/* .......... find both eigenvalues and eigenvectors .......... */
+L20:
+ eltran_(nm, n, &is1, &is2, a, iv1, z);
+ hqr2_(nm, n, &is1, &is2, a, wr, wi, z, ierr);
+ if (*ierr != 0) {
+ goto L50;
+ }
+ balbak_(nm, n, &is1, &is2, fv1, n, z);
+L50:
+ return;
+} /* rg_ */
+
+/* Subroutine */
+static void balanc_(nm, n, a, low, igh, scale)
+integer *nm, *n;
+doublereal *a;
+integer *low, *igh;
+doublereal *scale;
+{
+ /* Local variables */
+ static integer iexc;
+ static doublereal c, f, g;
+ static integer i, j, k, l, m;
+ static doublereal r, s, radix, b2;
+ static logical noconv;
+
+
+/* this subroutine is a translation of the algol procedure balance, */
+/* num. math. 13, 293-304(1969) by parlett and reinsch. */
+/* handbook for auto. comp., vol.ii-linear algebra, 315-326(1971). */
+
+/* this subroutine balances a real matrix and isolates */
+/* eigenvalues whenever possible. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* a contains the input matrix to be balanced. */
+
+/* on output */
+
+/* a contains the balanced matrix. */
+
+/* low and igh are two integers such that a(i,j) */
+/* is equal to zero if */
+/* (1) i is greater than j and */
+/* (2) j=1,...,low-1 or i=igh+1,...,n. */
+
+/* scale contains information determining the */
+/* permutations and scaling factors used. */
+
+/* suppose that the principal submatrix in rows low through igh */
+/* has been balanced, that p(j) denotes the index interchanged */
+/* with j during the permutation step, and that the elements */
+/* of the diagonal matrix used are denoted by d(i,j). then */
+/* scale(j) = p(j), for j = 1,...,low-1 */
+/* = d(j,j), j = low,...,igh */
+/* = p(j) j = igh+1,...,n. */
+/* the order in which the interchanges are made is n to igh+1, */
+/* then 1 to low-1. */
+
+/* note that 1 is returned for igh if igh is zero formally. */
+
+/* the algol procedure exc contained in balance appears in */
+/* balanc in line. (note that the algol roles of identifiers */
+/* k,l have been reversed.) */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ radix = 16.;
+
+ b2 = radix * radix;
+ k = 0;
+ l = *n;
+ goto L100;
+/* .......... in-line procedure for row and column exchange .......... */
+L20:
+ scale[m] = (doublereal) j+1;
+ if (j == m) {
+ goto L50;
+ }
+
+ for (i = 0; i < l; ++i) {
+ f = a[i + j * *nm];
+ a[i + j * *nm] = a[i + m * *nm];
+ a[i + m * *nm] = f;
+ }
+
+ for (i = k; i < *n; ++i) {
+ f = a[j + i * *nm];
+ a[j + i * *nm] = a[m + i * *nm];
+ a[m + i * *nm] = f;
+ }
+
+L50:
+ switch ((int)iexc) {
+ case 1: goto L80;
+ case 2: goto L130;
+ }
+/* .......... search for rows isolating an eigenvalue and push them down .......... */
+L80:
+ if (l == 1) {
+ goto L280;
+ }
+ --l;
+/* .......... for j=l step -1 until 1 do -- .......... */
+L100:
+ for (j = l-1; j >= 0; --j) {
+ for (i = 0; i < l; ++i) {
+ if (i != j && a[j + i * *nm] != 0.) {
+ goto L120; /* continue outer loop */
+ }
+ }
+
+ m = l-1;
+ iexc = 1;
+ goto L20;
+L120:
+ ;
+ }
+
+ goto L140;
+/* .......... search for columns isolating an eigenvalue and push them left .......... */
+L130:
+ ++k;
+
+L140:
+ for (j = k; j < l; ++j) {
+ for (i = k; i < l; ++i) {
+ if (i != j && a[i + j * *nm] != 0.) {
+ goto L170; /* continue outer loop */
+ }
+ }
+
+ m = k;
+ iexc = 2;
+ goto L20;
+L170:
+ ;
+ }
+/* .......... now balance the submatrix in rows k to l .......... */
+ for (i = k; i < l; ++i) {
+ scale[i] = 1.;
+ }
+/* .......... iterative loop for norm reduction .......... */
+L190:
+ noconv = FALSE_;
+
+ for (i = k; i < l; ++i) {
+ c = 0.;
+ r = 0.;
+
+ for (j = k; j < l; ++j) {
+ if (j != i) {
+ c += abs(a[j + i * *nm]);
+ r += abs(a[i + j * *nm]);
+ }
+ }
+/* .......... guard against zero c or r due to underflow .......... */
+ if (c == 0. || r == 0.) {
+ continue;
+ }
+ g = r / radix;
+ f = 1.;
+ s = c + r;
+L210:
+ if (c >= g) {
+ goto L220;
+ }
+ f *= radix;
+ c *= b2;
+ goto L210;
+L220:
+ g = r * radix;
+L230:
+ if (c < g) {
+ goto L240;
+ }
+ f /= radix;
+ c /= b2;
+ goto L230;
+/* .......... now balance .......... */
+L240:
+ if ((c + r) / f >= s * .95) {
+ continue;
+ }
+ g = 1. / f;
+ scale[i] *= f;
+ noconv = TRUE_;
+
+ for (j = k; j < *n; ++j) {
+ a[i + j * *nm] *= g;
+ }
+
+ for (j = 0; j < l; ++j) {
+ a[j + i * *nm] *= f;
+ }
+ }
+
+ if (noconv) {
+ goto L190;
+ }
+
+L280:
+ *low = k+1;
+ *igh = l;
+ return;
+} /* balanc_ */
+
+/* Subroutine */
+static void balbak_(nm, n, low, igh, scale, m, z)
+integer *nm, *n, *low, *igh;
+doublereal *scale;
+integer *m;
+doublereal *z;
+{
+ /* Local variables */
+ static integer i, j, k;
+ static doublereal s;
+ static integer ii;
+
+
+/* this subroutine is a translation of the algol procedure balbak, */
+/* num. math. 13, 293-304(1969) by parlett and reinsch. */
+/* handbook for auto. comp., vol.ii-linear algebra, 315-326(1971). */
+
+/* this subroutine forms the eigenvectors of a real general */
+/* matrix by back transforming those of the corresponding */
+/* balanced matrix determined by balanc. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* low and igh are integers determined by balanc. */
+
+/* scale contains information determining the permutations */
+/* and scaling factors used by balanc. */
+
+/* m is the number of columns of z to be back transformed. */
+
+/* z contains the real and imaginary parts of the eigen- */
+/* vectors to be back transformed in its first m columns. */
+
+/* on output */
+
+/* z contains the real and imaginary parts of the */
+/* transformed eigenvectors in its first m columns. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ if (*m == 0) {
+ return; /* exit from balbak_ */
+ }
+ if (*igh == *low) {
+ goto L120;
+ }
+
+ for (i = *low-1; i < *igh; ++i) {
+ s = scale[i];
+/* .......... left hand eigenvectors are back transformed */
+/* if the foregoing statement is replaced by s=1.0d0/scale(i). .......... */
+ for (j = 0; j < *m; ++j) {
+ z[i + j * *nm] *= s;
+ }
+ }
+/* ......... for i=low-1 step -1 until 1, */
+/* igh+1 step 1 until n do -- .......... */
+L120:
+ for (ii = 0; ii < *n; ++ii) {
+ i = ii;
+ if (i+1 >= *low && i < *igh) {
+ continue;
+ }
+ if (i+1 < *low) {
+ i = *low - ii - 2;
+ }
+ k = (integer) scale[i] - 1;
+ if (k != i)
+ for (j = 0; j < *m; ++j) {
+ s = z[i + j * *nm];
+ z[i + j * *nm] = z[k + j * *nm];
+ z[k + j * *nm] = s;
+ }
+ }
+} /* balbak_ */
+
+/* Subroutine */
+static void cdiv_(ar, ai, br, bi, cr, ci)
+doublereal *ar, *ai, *br, *bi, *cr, *ci;
+{
+ /* Local variables */
+ static doublereal s, ais, bis, ars, brs;
+
+/* complex division, (cr,ci) = (ar,ai)/(br,bi) */
+
+ s = abs(*br) + abs(*bi);
+ ars = *ar / s;
+ ais = *ai / s;
+ brs = *br / s;
+ bis = *bi / s;
+ s = brs * brs + bis * bis;
+ *cr = (ars * brs + ais * bis) / s;
+ *ci = (ais * brs - ars * bis) / s;
+} /* cdiv_ */
+
+/* Subroutine */
+static void elmhes_(nm, n, low, igh, a, int_)
+integer *nm, *n, *low, *igh;
+doublereal *a;
+integer *int_;
+{
+ /* Local variables */
+ static integer i, j, m;
+ static doublereal x, y;
+ static integer la, mm1;
+
+
+/* this subroutine is a translation of the algol procedure elmhes, */
+/* num. math. 12, 349-368(1968) by martin and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 339-358(1971). */
+
+/* given a real general matrix, this subroutine */
+/* reduces a submatrix situated in rows and columns */
+/* low through igh to upper hessenberg form by */
+/* stabilized elementary similarity transformations. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* low and igh are integers determined by the balancing */
+/* subroutine balanc. if balanc has not been used, */
+/* set low=1, igh=n. */
+
+/* a contains the input matrix. */
+
+/* on output */
+
+/* a contains the hessenberg matrix. the multipliers */
+/* which were used in the reduction are stored in the */
+/* remaining triangle under the hessenberg matrix. */
+
+/* int contains information on the rows and columns */
+/* interchanged in the reduction. */
+/* only elements low through igh are used. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ la = *igh - 1;
+ if (la < *low + 1) {
+ return; /* exit from elmhes_ */
+ }
+
+ for (m = *low; m < la; ++m) {
+ mm1 = m-1;
+ x = 0.;
+ i = m;
+ for (j = m; j < *igh; ++j) {
+ if (abs(a[j + mm1 * *nm]) > abs(x)) {
+ x = a[j + mm1 * *nm];
+ i = j;
+ }
+ }
+
+ int_[m] = i+1;
+ if (i == m) {
+ goto L130;
+ }
+/* .......... interchange rows and columns of a .......... */
+ for (j = mm1; j < *n; ++j) {
+ y = a[i + j * *nm];
+ a[i + j * *nm] = a[m + j * *nm];
+ a[m + j * *nm] = y;
+ }
+
+ for (j = 0; j < *igh; ++j) {
+ y = a[j + i * *nm];
+ a[j + i * *nm] = a[j + m * *nm];
+ a[j + m * *nm] = y;
+ }
+/* .......... end interchange .......... */
+L130:
+ if (x != 0.)
+ for (i = m+1; i < *igh; ++i) {
+ y = a[i + mm1 * *nm];
+ if (y == 0.) {
+ continue;
+ }
+ y /= x;
+ a[i + mm1 * *nm] = y;
+
+ for (j = m; j < *n; ++j) {
+ a[i + j * *nm] -= y * a[m + j * *nm];
+ }
+
+ for (j = 0; j < *igh; ++j) {
+ a[j + m * *nm] += y * a[j + i * *nm];
+ }
+ }
+ }
+} /* elmhes_ */
+
+/* Subroutine */
+static void eltran_(nm, n, low, igh, a, int_, z)
+integer *nm, *n, *low, *igh;
+doublereal *a;
+integer *int_;
+doublereal *z;
+{
+ /* Local variables */
+ static integer i, j, kl, mp;
+
+/* this subroutine is a translation of the algol procedure elmtrans, */
+/* num. math. 16, 181-204(1970) by peters and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 372-395(1971). */
+
+/* this subroutine accumulates the stabilized elementary */
+/* similarity transformations used in the reduction of a */
+/* real general matrix to upper hessenberg form by elmhes. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* low and igh are integers determined by the balancing */
+/* subroutine balanc. if balanc has not been used, */
+/* set low=1, igh=n. */
+
+/* a contains the multipliers which were used in the */
+/* reduction by elmhes in its lower triangle */
+/* below the subdiagonal. */
+
+/* int contains information on the rows and columns */
+/* interchanged in the reduction by elmhes. */
+/* only elements low through igh are used. */
+
+/* on output */
+
+/* z contains the transformation matrix produced in the */
+/* reduction by elmhes. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+/* .......... initialize z to identity matrix .......... */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *n; ++i) {
+ z[i + j * *nm] = 0.;
+ }
+
+ z[j + j * *nm] = 1.;
+ }
+
+ kl = *igh - *low - 1;
+ if (kl < 1) {
+ return;
+ }
+/* .......... for mp=igh-1 step -1 until low+1 do -- .......... */
+ for (mp = *igh - 2; mp > *igh -kl-2; --mp) {
+ for (i = mp+1; i < *igh; ++i) {
+ z[i + mp * *nm] = a[i + (mp - 1) * *nm];
+ }
+
+ i = int_[mp] - 1;
+ if (i == mp) {
+ continue;
+ }
+
+ for (j = mp; j < *igh; ++j) {
+ z[mp + j * *nm] = z[i + j * *nm];
+ z[i + j * *nm] = 0.;
+ }
+
+ z[i + mp * *nm] = 1.;
+ }
+} /* eltran_ */
+
+/* Subroutine */
+static void hqr_(nm, n, low, igh, h, wr, wi, ierr)
+integer *nm, *n, *low, *igh;
+doublereal *h, *wr, *wi;
+integer *ierr;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal norm;
+ static integer i, j, k, l, m;
+ static doublereal p, q, r, s, t, w, x, y;
+ static integer na, en;
+ static doublereal zz;
+ static logical notlas;
+ static integer itn, its, enm2;
+ static doublereal tst1, tst2;
+
+/* RESTORED CORRECT INDICES OF LOOPS (200,210,230,240). (9/29/89 BSG) */
+
+/* this subroutine is a translation of the algol procedure hqr, */
+/* num. math. 14, 219-231(1970) by martin, peters, and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 359-371(1971). */
+
+/* this subroutine finds the eigenvalues of a real */
+/* upper hessenberg matrix by the qr method. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* low and igh are integers determined by the balancing */
+/* subroutine balanc. if balanc has not been used, */
+/* set low=1, igh=n. */
+
+/* h contains the upper hessenberg matrix. information about */
+/* the transformations used in the reduction to hessenberg */
+/* form by elmhes or orthes, if performed, is stored */
+/* in the remaining triangle under the hessenberg matrix. */
+
+/* on output */
+
+/* h has been destroyed. therefore, it must be saved */
+/* before calling hqr if subsequent calculation and */
+/* back transformation of eigenvectors is to be performed. */
+
+/* wr and wi contain the real and imaginary parts, */
+/* respectively, of the eigenvalues. the eigenvalues */
+/* are unordered except that complex conjugate pairs */
+/* of values appear consecutively with the eigenvalue */
+/* having the positive imaginary part first. if an */
+/* error exit is made, the eigenvalues should be correct */
+/* for indices ierr+1,...,n. */
+
+/* ierr is set to */
+/* zero for normal return, */
+/* j if the limit of 30*n iterations is exhausted */
+/* while the j-th eigenvalue is being sought. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated september 1989. */
+
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ norm = 0.;
+ k = 0;
+/* .......... store roots isolated by balanc */
+/* and compute matrix norm .......... */
+ for (i = 0; i < *n; ++i) {
+ for (j = k; j < *n; ++j) {
+ norm += abs(h[i + j * *nm]);
+ }
+ k = i;
+ if (i+1 < *low || i >= *igh) {
+ wr[i] = h[i + i * *nm];
+ wi[i] = 0.;
+ }
+ }
+
+ en = *igh - 1;
+ t = 0.;
+ itn = *n * 30;
+/* .......... search for next eigenvalues .......... */
+L60:
+ if (en+1 < *low) {
+ goto L1001;
+ }
+ its = 0;
+ na = en - 1;
+ enm2 = na - 1;
+/* .......... look for single small sub-diagonal element */
+/* for l=en step -1 until low do -- .......... */
+L70:
+ for (l = en; l+1 >= *low; --l) {
+ s = abs(h[l-1 + (l-1) * *nm]) + abs(h[l + l * *nm]);
+ if (s == 0.) {
+ s = norm;
+ }
+ tst1 = s;
+ tst2 = tst1 + abs(h[l + (l-1) * *nm]);
+ if (tst2 == tst1) {
+ break;
+ }
+ }
+/* .......... form shift .......... */
+ x = h[en + en * *nm];
+ if (l == en) {
+ goto L270;
+ }
+ y = h[na + na * *nm];
+ w = h[en + na * *nm] * h[na + en * *nm];
+ if (l == na) {
+ goto L280;
+ }
+ if (itn == 0) {
+ goto L1000;
+ }
+ if (its != 10 && its != 20) {
+ goto L130;
+ }
+/* .......... form exceptional shift .......... */
+ t += x;
+
+ for (i = *low - 1; i <= en; ++i) {
+ h[i + i * *nm] -= x;
+ }
+
+ s = abs(h[en + na * *nm]) + abs(h[na + enm2 * *nm]);
+ x = s * .75;
+ y = x;
+ w = s * -.4375 * s;
+L130:
+ ++its;
+ --itn;
+/* .......... look for two consecutive small */
+/* sub-diagonal elements. */
+/* for m=en-2 step -1 until l do -- .......... */
+ for (m = enm2; m >= l; --m) {
+ zz = h[m + m * *nm];
+ r = x - zz;
+ s = y - zz;
+ p = (r * s - w) / h[m+1 + m * *nm] + h[m + (m+1) * *nm];
+ q = h[m+1 + (m+1) * *nm] - zz - r - s;
+ r = h[m+2 + (m+1) * *nm];
+ s = abs(p) + abs(q) + abs(r);
+ p /= s;
+ q /= s;
+ r /= s;
+ if (m == l) {
+ goto L150;
+ }
+ tst1 = abs(p) * (abs(h[m-1 + (m-1) * *nm]) + abs(zz) + abs(h[m+1 + (m+1) * *nm]));
+ tst2 = tst1 + abs(h[m + (m-1) * *nm]) * (abs(q) + abs(r));
+ if (tst2 == tst1) {
+ goto L150;
+ }
+ }
+
+L150:
+ for (i = m+2; i <= en; ++i) {
+ h[i + (i-2) * *nm] = 0.;
+ if (i != m+2) {
+ h[i + (i-3) * *nm] = 0.;
+ }
+ }
+/* .......... double qr step involving rows l to en and */
+/* columns m to en .......... */
+ for (k = m; k <= na; ++k) {
+ notlas = k != na;
+ if (k == m) {
+ goto L170;
+ }
+ p = h[k + (k-1) * *nm];
+ q = h[k+1 + (k-1) * *nm];
+ r = 0.;
+ if (notlas) {
+ r = h[k+2 + (k-1) * *nm];
+ }
+ x = abs(p) + abs(q) + abs(r);
+ if (x == 0.) {
+ continue;
+ }
+ p /= x;
+ q /= x;
+ r /= x;
+L170:
+ d__1 = sqrt(p * p + q * q + r * r);
+ s = d_sign(&d__1, &p);
+ if (k == m) {
+ goto L180;
+ }
+ h[k + (k-1) * *nm] = -s * x;
+ goto L190;
+L180:
+ if (l != m) {
+ h[k + (k-1) * *nm] = -h[k + (k-1) * *nm];
+ }
+L190:
+ p += s;
+ x = p / s;
+ y = q / s;
+ zz = r / s;
+ q /= p;
+ r /= p;
+ if (notlas) {
+ goto L225;
+ }
+/* .......... row modification .......... */
+ for (j = k; j <= en; ++j) {
+ p = h[k + j * *nm] + q * h[k+1 + j * *nm];
+ h[k + j * *nm] -= p * x;
+ h[k+1 + j * *nm] -= p * y;
+ }
+
+ j = min(en,k+3);
+/* .......... column modification .......... */
+ for (i = l; i <= j; ++i) {
+ p = x * h[i + k * *nm] + y * h[i + (k+1) * *nm];
+ h[i + k * *nm] -= p;
+ h[i + (k+1) * *nm] -= p * q;
+ }
+ continue;
+L225:
+/* .......... row modification .......... */
+ for (j = k; j <= en; ++j) {
+ p = h[k + j * *nm] + q * h[k+1 + j * *nm] + r * h[k+2 + j * *nm];
+ h[k + j * *nm] -= p * x;
+ h[k+1 + j * *nm] -= p * y;
+ h[k+2 + j * *nm] -= p * zz;
+ }
+
+ j = min(en,k+3);
+/* .......... column modification .......... */
+ for (i = l; i <= j; ++i) {
+ p = x * h[i + k * *nm] + y * h[i + (k+1) * *nm] + zz * h[i + (k+2) * *nm];
+ h[i + k * *nm] -= p;
+ h[i + (k+1) * *nm] -= p * q;
+ h[i + (k+2) * *nm] -= p * r;
+ }
+ }
+
+ goto L70;
+/* .......... one root found .......... */
+L270:
+ wr[en] = x + t;
+ wi[en] = 0.;
+ en = na;
+ goto L60;
+/* .......... two roots found .......... */
+L280:
+ p = (y - x) / 2.;
+ q = p * p + w;
+ zz = sqrt(abs(q));
+ x += t;
+ if (q < 0.) {
+ goto L320;
+ }
+/* .......... real pair .......... */
+ zz = p + d_sign(&zz, &p);
+ wr[na] = x + zz;
+ wr[en] = wr[na];
+ if (zz != 0.) {
+ wr[en] = x - w / zz;
+ }
+ wi[na] = 0.;
+ wi[en] = 0.;
+ goto L330;
+/* .......... complex pair .......... */
+L320:
+ wr[na] = x + p;
+ wr[en] = x + p;
+ wi[na] = zz;
+ wi[en] = -zz;
+L330:
+ en = enm2;
+ goto L60;
+/* .......... set error -- all eigenvalues have not */
+/* converged after 30*n iterations .......... */
+L1000:
+ *ierr = en-1;
+L1001:
+ return;
+} /* hqr_ */
+
+/* Subroutine */
+static void hqr2_(nm, n, low, igh, h, wr, wi, z, ierr)
+integer *nm, *n, *low, *igh;
+doublereal *h, *wr, *wi, *z;
+integer *ierr;
+{
+ /* System generated locals */
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal norm;
+ static integer i, j, k, l, m;
+ static doublereal p, q, r, s, t, w, x, y;
+ static integer na, en;
+ static doublereal ra, sa;
+ static doublereal vi, vr, zz;
+ static logical notlas;
+ static integer itn, its, enm2;
+ static doublereal tst1, tst2;
+
+
+/* this subroutine is a translation of the algol procedure hqr2, */
+/* num. math. 16, 181-204(1970) by peters and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 372-395(1971). */
+
+/* this subroutine finds the eigenvalues and eigenvectors */
+/* of a real upper hessenberg matrix by the qr method. the */
+/* eigenvectors of a real general matrix can also be found */
+/* if elmhes and eltran or orthes and ortran have */
+/* been used to reduce this general matrix to hessenberg form */
+/* and to accumulate the similarity transformations. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* low and igh are integers determined by the balancing */
+/* subroutine balanc. if balanc has not been used, */
+/* set low=1, igh=n. */
+
+/* h contains the upper hessenberg matrix. */
+
+/* z contains the transformation matrix produced by eltran */
+/* after the reduction by elmhes, or by ortran after the */
+/* reduction by orthes, if performed. if the eigenvectors */
+/* of the hessenberg matrix are desired, z must contain the */
+/* identity matrix. */
+
+/* on output */
+
+/* h has been destroyed. */
+
+/* wr and wi contain the real and imaginary parts, */
+/* respectively, of the eigenvalues. the eigenvalues */
+/* are unordered except that complex conjugate pairs */
+/* of values appear consecutively with the eigenvalue */
+/* having the positive imaginary part first. if an */
+/* error exit is made, the eigenvalues should be correct */
+/* for indices ierr+1,...,n. */
+
+/* z contains the real and imaginary parts of the eigenvectors. */
+/* if the i-th eigenvalue is real, the i-th column of z */
+/* contains its eigenvector. if the i-th eigenvalue is complex */
+/* with positive imaginary part, the i-th and (i+1)-th */
+/* columns of z contain the real and imaginary parts of its */
+/* eigenvector. the eigenvectors are unnormalized. if an */
+/* error exit is made, none of the eigenvectors has been found. */
+
+/* ierr is set to */
+/* zero for normal return, */
+/* j if the limit of 30*n iterations is exhausted */
+/* while the j-th eigenvalue is being sought. */
+
+/* calls cdiv for complex division. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ norm = 0.;
+ k = 0;
+/* .......... store roots isolated by balanc */
+/* and compute matrix norm .......... */
+ for (i = 0; i < *n; ++i) {
+ for (j = k; j < *n; ++j) {
+ norm += abs(h[i + j * *nm]);
+ }
+ k = i;
+ if (i+1 < *low || i >= *igh) {
+ wr[i] = h[i + i * *nm];
+ wi[i] = 0.;
+ }
+ }
+
+ en = *igh - 1;
+ t = 0.;
+ itn = *n * 30;
+/* .......... search for next eigenvalues .......... */
+L60:
+ if (en+1 < *low) {
+ goto L340;
+ }
+ its = 0;
+ na = en - 1;
+ enm2 = na - 1;
+/* .......... look for single small sub-diagonal element */
+/* for l=en step -1 until low do -- .......... */
+L70:
+ for (l = en; l+1 > *low; --l) {
+ s = abs(h[l-1 + (l-1) * *nm]) + abs(h[l + l * *nm]);
+ if (s == 0.) {
+ s = norm;
+ }
+ tst1 = s;
+ tst2 = tst1 + abs(h[l + (l-1) * *nm]);
+ if (tst2 == tst1) {
+ break;
+ }
+ }
+/* .......... form shift .......... */
+ x = h[en + en * *nm];
+ if (l == en) {
+ goto L270;
+ }
+ y = h[na + na * *nm];
+ w = h[en + na * *nm] * h[na + en * *nm];
+ if (l == na) {
+ goto L280;
+ }
+ if (itn == 0) {
+ goto L1000;
+ }
+ if (its != 10 && its != 20) {
+ goto L130;
+ }
+/* .......... form exceptional shift .......... */
+ t += x;
+
+ for (i = *low - 1; i <= en; ++i) {
+ h[i + i * *nm] -= x;
+ }
+
+ s = abs(h[en + na * *nm]) + abs(h[na + enm2 * *nm]);
+ x = s * .75;
+ y = x;
+ w = s * -.4375 * s;
+L130:
+ ++its;
+ --itn;
+/* .......... look for two consecutive small */
+/* sub-diagonal elements. */
+/* for m=en-2 step -1 until l do -- .......... */
+ for (m = enm2; m >= l; --m) {
+ zz = h[m + m * *nm];
+ r = x - zz;
+ s = y - zz;
+ p = (r * s - w) / h[m+1 + m * *nm] + h[m + (m+1) * *nm];
+ q = h[m+1 + (m+1) * *nm] - zz - r - s;
+ r = h[m+2 + (m+1) * *nm];
+ s = abs(p) + abs(q) + abs(r);
+ p /= s;
+ q /= s;
+ r /= s;
+ if (m == l) {
+ goto L150;
+ }
+ tst1 = abs(p) * (abs(h[m-1 + (m-1) * *nm]) + abs(zz) + abs(h[m+1 + (m+1) * *nm]));
+ tst2 = tst1 + abs(h[m + (m-1) * *nm]) * (abs(q) + abs(r));
+ if (tst2 == tst1) {
+ goto L150;
+ }
+ }
+
+L150:
+ for (i = m+2; i <= en; ++i) {
+ h[i + (i-2) * *nm] = 0.;
+ if (i != m+2) {
+ h[i + (i-3) * *nm] = 0.;
+ }
+ }
+/* .......... double qr step involving rows l to en and */
+/* columns m to en .......... */
+ for (k = m; k <= na; ++k) {
+ notlas = k != na;
+ if (k == m) {
+ goto L170;
+ }
+ p = h[k + (k-1) * *nm];
+ q = h[k+1 + (k-1) * *nm];
+ r = 0.;
+ if (notlas) {
+ r = h[k+2 + (k-1) * *nm];
+ }
+ x = abs(p) + abs(q) + abs(r);
+ if (x == 0.) {
+ continue;
+ }
+ p /= x;
+ q /= x;
+ r /= x;
+L170:
+ d__1 = sqrt(p * p + q * q + r * r);
+ s = d_sign(&d__1, &p);
+ if (k == m) {
+ goto L180;
+ }
+ h[k + (k-1) * *nm] = -s * x;
+ goto L190;
+L180:
+ if (l != m) {
+ h[k + (k-1) * *nm] = -h[k + (k-1) * *nm];
+ }
+L190:
+ p += s;
+ x = p / s;
+ y = q / s;
+ zz = r / s;
+ q /= p;
+ r /= p;
+ if (notlas) {
+ goto L225;
+ }
+/* .......... row modification .......... */
+ for (j = k; j < *n; ++j) {
+ p = h[k + j * *nm] + q * h[k+1 + j * *nm];
+ h[k + j * *nm] -= p * x;
+ h[k+1 + j * *nm] -= p * y;
+ }
+
+ j = min(en,k+3);
+/* .......... column modification .......... */
+ for (i = 0; i <= j; ++i) {
+ p = x * h[i + k * *nm] + y * h[i + (k+1) * *nm];
+ h[i + k * *nm] -= p;
+ h[i + (k+1) * *nm] -= p * q;
+ }
+/* .......... accumulate transformations .......... */
+ for (i = *low - 1; i < *igh; ++i) {
+ p = x * z[i + k * *nm] + y * z[i + (k+1) * *nm];
+ z[i + k * *nm] -= p;
+ z[i + (k+1) * *nm] -= p * q;
+ }
+ continue;
+L225:
+/* .......... row modification .......... */
+ for (j = k; j < *n; ++j) {
+ p = h[k + j * *nm] + q * h[k+1 + j * *nm] + r * h[k+2 + j * *nm];
+ h[k + j * *nm] -= p * x;
+ h[k+1 + j * *nm] -= p * y;
+ h[k+2 + j * *nm] -= p * zz;
+ }
+
+ j = min(en,k+3);
+/* .......... column modification .......... */
+ for (i = 0; i <= j; ++i) {
+ p = x * h[i + k * *nm] + y * h[i + (k+1) * *nm] + zz * h[i + (k+2) * *nm];
+ h[i + k * *nm] -= p;
+ h[i + (k+1) * *nm] -= p * q;
+ h[i + (k+2) * *nm] -= p * r;
+ }
+/* .......... accumulate transformations .......... */
+ for (i = *low - 1; i < *igh; ++i) {
+ p = x * z[i + k * *nm] + y * z[i + (k+1) * *nm] + zz * z[i + (k+2) * *nm];
+ z[i + k * *nm] -= p;
+ z[i + (k+1) * *nm] -= p * q;
+ z[i + (k+2) * *nm] -= p * r;
+ }
+ }
+
+ goto L70;
+/* .......... one root found .......... */
+L270:
+ h[en + en * *nm] = x + t;
+ wr[en] = h[en + en * *nm];
+ wi[en] = 0.;
+ en = na;
+ goto L60;
+/* .......... two roots found .......... */
+L280:
+ p = (y - x) / 2.;
+ q = p * p + w;
+ zz = sqrt(abs(q));
+ h[en + en * *nm] = x + t;
+ x = h[en + en * *nm];
+ h[na + na * *nm] = y + t;
+ if (q < 0.) {
+ goto L320;
+ }
+/* .......... real pair .......... */
+ zz = p + d_sign(&zz, &p);
+ wr[na] = x + zz;
+ wr[en] = wr[na];
+ if (zz != 0.) {
+ wr[en] = x - w / zz;
+ }
+ wi[na] = 0.;
+ wi[en] = 0.;
+ x = h[en + na * *nm];
+ s = abs(x) + abs(zz);
+ p = x / s;
+ q = zz / s;
+ r = sqrt(p * p + q * q);
+ p /= r;
+ q /= r;
+/* .......... row modification .......... */
+ for (j = na; j < *n; ++j) {
+ zz = h[na + j * *nm];
+ h[na + j * *nm] = q * zz + p * h[en + j * *nm];
+ h[en + j * *nm] = q * h[en + j * *nm] - p * zz;
+ }
+/* .......... column modification .......... */
+ for (i = 0; i <= en; ++i) {
+ zz = h[i + na * *nm];
+ h[i + na * *nm] = q * zz + p * h[i + en * *nm];
+ h[i + en * *nm] = q * h[i + en * *nm] - p * zz;
+ }
+/* .......... accumulate transformations .......... */
+ for (i = *low - 1; i < *igh; ++i) {
+ zz = z[i + na * *nm];
+ z[i + na * *nm] = q * zz + p * z[i + en * *nm];
+ z[i + en * *nm] = q * z[i + en * *nm] - p * zz;
+ }
+
+ goto L330;
+/* .......... complex pair .......... */
+L320:
+ wr[na] = x + p;
+ wr[en] = x + p;
+ wi[na] = zz;
+ wi[en] = -zz;
+L330:
+ en = enm2;
+ goto L60;
+/* .......... all roots found. backsubstitute to find */
+/* vectors of upper triangular form .......... */
+L340:
+ if (norm == 0.) {
+ goto L1001;
+ }
+/* .......... for en=n step -1 until 1 do -- .......... */
+ for (en = *n - 1; en >= 0; --en) {
+ p = wr[en]; q = wi[en];
+ na = en - 1;
+ if (q < 0.) {
+ goto L710;
+ } else if (q != 0) {
+ continue ;
+ }
+/* .......... real vector .......... */
+ m = en;
+ h[en + en * *nm] = 1.;
+ if (en == 0) {
+ continue ;
+ }
+/* .......... for i=en-1 step -1 until 1 do -- .......... */
+ for (i = na; i >= 0; --i) {
+ w = h[i + i * *nm] - p;
+ r = 0.;
+
+ for (j = m; j <= en; ++j) {
+ r += h[i + j * *nm] * h[j + en * *nm];
+ }
+
+ if (wi[i] >= 0.) {
+ goto L630;
+ }
+ zz = w;
+ s = r;
+ continue;
+L630:
+ m = i;
+ if (wi[i] != 0.) {
+ goto L640;
+ }
+ t = w;
+ if (t != 0.) {
+ goto L635;
+ }
+ tst1 = norm;
+ t = tst1;
+L632:
+ t *= .01;
+ tst2 = norm + t;
+ if (tst2 > tst1) {
+ goto L632;
+ }
+L635:
+ h[i + en * *nm] = -r / t;
+ goto L680;
+/* .......... solve real equations .......... */
+L640:
+ x = h[i + (i+1) * *nm];
+ y = h[i+1 + i * *nm];
+ q = (wr[i] - p) * (wr[i] - p) + wi[i] * wi[i];
+ t = (x * s - zz * r) / q;
+ h[i + en * *nm] = t;
+ if (abs(x) <= abs(zz)) {
+ goto L650;
+ }
+ h[i+1 + en * *nm] = (-r - w * t) / x;
+ goto L680;
+L650:
+ h[i+1 + en * *nm] = (-s - y * t) / zz;
+
+/* .......... overflow control .......... */
+L680:
+ t = abs(h[i + en * *nm]);
+ if (t == 0.) {
+ continue;
+ }
+ tst1 = t;
+ tst2 = tst1 + 1. / tst1;
+ if (tst2 > tst1) {
+ continue;
+ }
+ for (j = i; j <= en; ++j) {
+ h[j + en * *nm] /= t;
+ }
+ }
+/* .......... end real vector .......... */
+ continue;
+/* .......... complex vector .......... */
+L710:
+ m = na;
+/* .......... last vector component chosen imaginary so that */
+/* eigenvector matrix is triangular .......... */
+ if (abs(h[en + na * *nm]) <= abs(h[na + en * *nm])) {
+ goto L720;
+ }
+ h[na + na * *nm] = q / h[en + na * *nm];
+ h[na + en * *nm] = -(h[en + en * *nm] - p) / h[en + na * *nm];
+ goto L730;
+L720:
+ d__1 = -h[na + en * *nm];
+ d__2 = h[na + na * *nm] - p;
+ cdiv_(&c_b130, &d__1, &d__2, &q, &h[na + na * *nm], &h[na + en * *nm]);
+L730:
+ h[en + na * *nm] = 0.;
+ h[en + en * *nm] = 1.;
+ enm2 = na - 1;
+/* .......... for i=en-2 step -1 until 1 do -- .......... */
+ if (na != 0)
+ for (i = enm2; i >= 0; --i) {
+ w = h[i + i * *nm] - p;
+ ra = 0.;
+ sa = 0.;
+
+ for (j = m; j <= en; ++j) {
+ ra += h[i + j * *nm] * h[j + na * *nm];
+ sa += h[i + j * *nm] * h[j + en * *nm];
+ }
+
+ if (wi[i] >= 0.) {
+ goto L770;
+ }
+ zz = w;
+ r = ra;
+ s = sa;
+ continue;
+L770:
+ m = i;
+ if (wi[i] != 0.) {
+ goto L780;
+ }
+ d__1 = -ra;
+ d__2 = -sa;
+ cdiv_(&d__1, &d__2, &w, &q, &h[i + na * *nm], &h[i + en * *nm]);
+ goto L790;
+/* .......... solve complex equations .......... */
+L780:
+ x = h[i + (i+1) * *nm];
+ y = h[i+1 + i * *nm];
+ vr = (wr[i] - p) * (wr[i] - p) + wi[i] * wi[i] - q * q;
+ vi = (wr[i] - p) * 2. * q;
+ if (vr != 0. || vi != 0.) {
+ goto L784;
+ }
+ tst1 = norm * (abs(w) + abs(q) + abs(x) + abs(y) + abs(zz));
+ vr = tst1;
+L783:
+ vr *= .01;
+ tst2 = tst1 + vr;
+ if (tst2 > tst1) {
+ goto L783;
+ }
+L784:
+ d__1 = x * r - zz * ra + q * sa;
+ d__2 = x * s - zz * sa - q * ra;
+ cdiv_(&d__1, &d__2, &vr, &vi, &h[i + na * *nm], &h[i + en * *nm]);
+ if (abs(x) <= abs(zz) + abs(q)) {
+ goto L785;
+ }
+ h[i+1 + na * *nm] = (-ra - w * h[i + na * *nm] + q * h[i + en * *nm]) / x;
+ h[i+1 + en * *nm] = (-sa - w * h[i + en * *nm] - q * h[i + na * *nm]) / x;
+ goto L790;
+L785:
+ d__1 = -r - y * h[i + na * *nm];
+ d__2 = -s - y * h[i + en * *nm];
+ cdiv_(&d__1, &d__2, &zz, &q, &h[i+1 + na * *nm], &h[i+1 + en * *nm]);
+
+/* .......... overflow control .......... */
+L790:
+ d__1 = abs(h[i + na * *nm]), d__2 = abs(h[i + en * *nm]);
+ t = max(d__1,d__2);
+ if (t == 0.) {
+ continue;
+ }
+ tst1 = t;
+ tst2 = tst1 + 1. / tst1;
+ if (tst2 <= tst1)
+ for (j = i; j <= en; ++j) {
+ h[j + na * *nm] /= t;
+ h[j + en * *nm] /= t;
+ }
+ }
+/* .......... end complex vector .......... */
+ }
+/* .......... end back substitution. */
+/* vectors of isolated roots .......... */
+ for (i = 0; i < *n; ++i) {
+ if (i+1 < *low || i >= *igh)
+ for (j = i; j < *n; ++j) {
+ z[i + j * *nm] = h[i + j * *nm];
+ }
+ }
+/* .......... multiply by transformation matrix to give */
+/* vectors of original full matrix. */
+/* for j=n step -1 until low do -- .......... */
+ for (j = *n - 1; j+1 >= *low; --j) {
+ m = min(j,*igh-1);
+
+ for (i = *low - 1; i < *igh; ++i) {
+ zz = 0.;
+
+ for (k = *low - 1; k <= m; ++k) {
+ zz += z[i + k * *nm] * h[k + j * *nm];
+ }
+
+ z[i + j * *nm] = zz;
+ }
+ }
+
+ goto L1001;
+/* .......... set error -- all eigenvalues have not */
+/* converged after 30*n iterations .......... */
+L1000:
+ *ierr = en-1;
+L1001:
+ return;
+} /* hqr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.f
new file mode 100644
index 0000000000000000000000000000000000000000..28b9d5a209b63ffb54123c39238687c7f6748d6d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/rg.f
@@ -0,0 +1,1177 @@
+
+* ======================================================================
+* NIST Guide to Available Math Software.
+* Fullsource for module RG from package EISPACK.
+* Retrieved from NETLIB on Thu Jan 23 06:12:53 1997.
+* ======================================================================
+ subroutine rg(nm,n,a,wr,wi,matz,z,iv1,fv1,ierr)
+c
+ integer n,nm,is1,is2,ierr,matz
+ double precision a(nm,n),wr(n),wi(n),z(nm,n),fv1(n)
+ integer iv1(n)
+c
+c this subroutine calls the recommended sequence of
+c subroutines from the eigensystem subroutine package (eispack)
+c to find the eigenvalues and eigenvectors (if desired)
+c of a real general matrix.
+c
+c on input
+c
+c nm must be set to the row dimension of the two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix a.
+c
+c a contains the real general matrix.
+c
+c matz is an integer variable set equal to zero if
+c only eigenvalues are desired. otherwise it is set to
+c any non-zero integer for both eigenvalues and eigenvectors.
+c
+c on output
+c
+c wr and wi contain the real and imaginary parts,
+c respectively, of the eigenvalues. complex conjugate
+c pairs of eigenvalues appear consecutively with the
+c eigenvalue having the positive imaginary part first.
+c
+c z contains the real and imaginary parts of the eigenvectors
+c if matz is not zero. if the j-th eigenvalue is real, the
+c j-th column of z contains its eigenvector. if the j-th
+c eigenvalue is complex with positive imaginary part, the
+c j-th and (j+1)-th columns of z contain the real and
+c imaginary parts of its eigenvector. the conjugate of this
+c vector is the eigenvector for the conjugate eigenvalue.
+c
+c ierr is an integer output variable set equal to an error
+c completion code described in the documentation for hqr
+c and hqr2. the normal completion code is zero.
+c
+c iv1 and fv1 are temporary storage arrays.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+ if (n .le. nm) go to 10
+ ierr = 10 * n
+ go to 50
+c
+ 10 call balanc(nm,n,a,is1,is2,fv1)
+ call elmhes(nm,n,is1,is2,a,iv1)
+ if (matz .ne. 0) go to 20
+c .......... find eigenvalues only ..........
+ call hqr(nm,n,is1,is2,a,wr,wi,ierr)
+ go to 50
+c .......... find both eigenvalues and eigenvectors ..........
+ 20 call eltran(nm,n,is1,is2,a,iv1,z)
+ call hqr2(nm,n,is1,is2,a,wr,wi,z,ierr)
+ if (ierr .ne. 0) go to 50
+ call balbak(nm,n,is1,is2,fv1,n,z)
+ 50 return
+ end
+ subroutine balanc(nm,n,a,low,igh,scale)
+c
+ integer i,j,k,l,m,n,jj,nm,igh,low,iexc
+ double precision a(nm,n),scale(n)
+ double precision c,f,g,r,s,b2,radix
+ logical noconv
+c
+c this subroutine is a translation of the algol procedure balance,
+c num. math. 13, 293-304(1969) by parlett and reinsch.
+c handbook for auto. comp., vol.ii-linear algebra, 315-326(1971).
+c
+c this subroutine balances a real matrix and isolates
+c eigenvalues whenever possible.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c a contains the input matrix to be balanced.
+c
+c on output
+c
+c a contains the balanced matrix.
+c
+c low and igh are two integers such that a(i,j)
+c is equal to zero if
+c (1) i is greater than j and
+c (2) j=1,...,low-1 or i=igh+1,...,n.
+c
+c scale contains information determining the
+c permutations and scaling factors used.
+c
+c suppose that the principal submatrix in rows low through igh
+c has been balanced, that p(j) denotes the index interchanged
+c with j during the permutation step, and that the elements
+c of the diagonal matrix used are denoted by d(i,j). then
+c scale(j) = p(j), for j = 1,...,low-1
+c = d(j,j), j = low,...,igh
+c = p(j) j = igh+1,...,n.
+c the order in which the interchanges are made is n to igh+1,
+c then 1 to low-1.
+c
+c note that 1 is returned for igh if igh is zero formally.
+c
+c the algol procedure exc contained in balance appears in
+c balanc in line. (note that the algol roles of identifiers
+c k,l have been reversed.)
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+ radix = 16.0d0
+c
+ b2 = radix * radix
+ k = 1
+ l = n
+ go to 100
+c .......... in-line procedure for row and
+c column exchange ..........
+ 20 scale(m) = j
+ if (j .eq. m) go to 50
+c
+ do 30 i = 1, l
+ f = a(i,j)
+ a(i,j) = a(i,m)
+ a(i,m) = f
+ 30 continue
+c
+ do 40 i = k, n
+ f = a(j,i)
+ a(j,i) = a(m,i)
+ a(m,i) = f
+ 40 continue
+c
+ 50 go to (80,130), iexc
+c .......... search for rows isolating an eigenvalue
+c and push them down ..........
+ 80 if (l .eq. 1) go to 280
+ l = l - 1
+c .......... for j=l step -1 until 1 do -- ..........
+ 100 do 120 jj = 1, l
+ j = l + 1 - jj
+c
+ do 110 i = 1, l
+ if (i .eq. j) go to 110
+ if (a(j,i) .ne. 0.0d0) go to 120
+ 110 continue
+c
+ m = l
+ iexc = 1
+ go to 20
+ 120 continue
+c
+ go to 140
+c .......... search for columns isolating an eigenvalue
+c and push them left ..........
+ 130 k = k + 1
+c
+ 140 do 170 j = k, l
+c
+ do 150 i = k, l
+ if (i .eq. j) go to 150
+ if (a(i,j) .ne. 0.0d0) go to 170
+ 150 continue
+c
+ m = k
+ iexc = 2
+ go to 20
+ 170 continue
+c .......... now balance the submatrix in rows k to l ..........
+ do 180 i = k, l
+ 180 scale(i) = 1.0d0
+c .......... iterative loop for norm reduction ..........
+ 190 noconv = .false.
+c
+ do 270 i = k, l
+ c = 0.0d0
+ r = 0.0d0
+c
+ do 200 j = k, l
+ if (j .eq. i) go to 200
+ c = c + dabs(a(j,i))
+ r = r + dabs(a(i,j))
+ 200 continue
+c .......... guard against zero c or r due to underflow ..........
+ if (c .eq. 0.0d0 .or. r .eq. 0.0d0) go to 270
+ g = r / radix
+ f = 1.0d0
+ s = c + r
+ 210 if (c .ge. g) go to 220
+ f = f * radix
+ c = c * b2
+ go to 210
+ 220 g = r * radix
+ 230 if (c .lt. g) go to 240
+ f = f / radix
+ c = c / b2
+ go to 230
+c .......... now balance ..........
+ 240 if ((c + r) / f .ge. 0.95d0 * s) go to 270
+ g = 1.0d0 / f
+ scale(i) = scale(i) * f
+ noconv = .true.
+c
+ do 250 j = k, n
+ 250 a(i,j) = a(i,j) * g
+c
+ do 260 j = 1, l
+ 260 a(j,i) = a(j,i) * f
+c
+ 270 continue
+c
+ if (noconv) go to 190
+c
+ 280 low = k
+ igh = l
+ return
+ end
+ subroutine balbak(nm,n,low,igh,scale,m,z)
+c
+ integer i,j,k,m,n,ii,nm,igh,low
+ double precision scale(n),z(nm,m)
+ double precision s
+c
+c this subroutine is a translation of the algol procedure balbak,
+c num. math. 13, 293-304(1969) by parlett and reinsch.
+c handbook for auto. comp., vol.ii-linear algebra, 315-326(1971).
+c
+c this subroutine forms the eigenvectors of a real general
+c matrix by back transforming those of the corresponding
+c balanced matrix determined by balanc.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c low and igh are integers determined by balanc.
+c
+c scale contains information determining the permutations
+c and scaling factors used by balanc.
+c
+c m is the number of columns of z to be back transformed.
+c
+c z contains the real and imaginary parts of the eigen-
+c vectors to be back transformed in its first m columns.
+c
+c on output
+c
+c z contains the real and imaginary parts of the
+c transformed eigenvectors in its first m columns.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+ if (m .eq. 0) go to 200
+ if (igh .eq. low) go to 120
+c
+ do 110 i = low, igh
+ s = scale(i)
+c .......... left hand eigenvectors are back transformed
+c if the foregoing statement is replaced by
+c s=1.0d0/scale(i). ..........
+ do 100 j = 1, m
+ 100 z(i,j) = z(i,j) * s
+c
+ 110 continue
+c ......... for i=low-1 step -1 until 1,
+c igh+1 step 1 until n do -- ..........
+ 120 do 140 ii = 1, n
+ i = ii
+ if (i .ge. low .and. i .le. igh) go to 140
+ if (i .lt. low) i = low - ii
+ k = scale(i)
+ if (k .eq. i) go to 140
+c
+ do 130 j = 1, m
+ s = z(i,j)
+ z(i,j) = z(k,j)
+ z(k,j) = s
+ 130 continue
+c
+ 140 continue
+c
+ 200 return
+ end
+ subroutine elmhes(nm,n,low,igh,a,int)
+c
+ integer i,j,m,n,la,nm,igh,kp1,low,mm1,mp1
+ double precision a(nm,n)
+ double precision x,y
+ integer int(igh)
+c
+c this subroutine is a translation of the algol procedure elmhes,
+c num. math. 12, 349-368(1968) by martin and wilkinson.
+c handbook for auto. comp., vol.ii-linear algebra, 339-358(1971).
+c
+c given a real general matrix, this subroutine
+c reduces a submatrix situated in rows and columns
+c low through igh to upper hessenberg form by
+c stabilized elementary similarity transformations.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c low and igh are integers determined by the balancing
+c subroutine balanc. if balanc has not been used,
+c set low=1, igh=n.
+c
+c a contains the input matrix.
+c
+c on output
+c
+c a contains the hessenberg matrix. the multipliers
+c which were used in the reduction are stored in the
+c remaining triangle under the hessenberg matrix.
+c
+c int contains information on the rows and columns
+c interchanged in the reduction.
+c only elements low through igh are used.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+ la = igh - 1
+ kp1 = low + 1
+ if (la .lt. kp1) go to 200
+c
+ do 180 m = kp1, la
+ mm1 = m - 1
+ x = 0.0d0
+ i = m
+c
+ do 100 j = m, igh
+ if (dabs(a(j,mm1)) .le. dabs(x)) go to 100
+ x = a(j,mm1)
+ i = j
+ 100 continue
+c
+ int(m) = i
+ if (i .eq. m) go to 130
+c .......... interchange rows and columns of a ..........
+ do 110 j = mm1, n
+ y = a(i,j)
+ a(i,j) = a(m,j)
+ a(m,j) = y
+ 110 continue
+c
+ do 120 j = 1, igh
+ y = a(j,i)
+ a(j,i) = a(j,m)
+ a(j,m) = y
+ 120 continue
+c .......... end interchange ..........
+ 130 if (x .eq. 0.0d0) go to 180
+ mp1 = m + 1
+c
+ do 160 i = mp1, igh
+ y = a(i,mm1)
+ if (y .eq. 0.0d0) go to 160
+ y = y / x
+ a(i,mm1) = y
+c
+ do 140 j = m, n
+ 140 a(i,j) = a(i,j) - y * a(m,j)
+c
+ do 150 j = 1, igh
+ 150 a(j,m) = a(j,m) + y * a(j,i)
+c
+ 160 continue
+c
+ 180 continue
+c
+ 200 return
+ end
+ subroutine eltran(nm,n,low,igh,a,int,z)
+c
+ integer i,j,n,kl,mm,mp,nm,igh,low,mp1
+ double precision a(nm,igh),z(nm,n)
+ integer int(igh)
+c
+c this subroutine is a translation of the algol procedure elmtrans,
+c num. math. 16, 181-204(1970) by peters and wilkinson.
+c handbook for auto. comp., vol.ii-linear algebra, 372-395(1971).
+c
+c this subroutine accumulates the stabilized elementary
+c similarity transformations used in the reduction of a
+c real general matrix to upper hessenberg form by elmhes.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c low and igh are integers determined by the balancing
+c subroutine balanc. if balanc has not been used,
+c set low=1, igh=n.
+c
+c a contains the multipliers which were used in the
+c reduction by elmhes in its lower triangle
+c below the subdiagonal.
+c
+c int contains information on the rows and columns
+c interchanged in the reduction by elmhes.
+c only elements low through igh are used.
+c
+c on output
+c
+c z contains the transformation matrix produced in the
+c reduction by elmhes.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+c .......... initialize z to identity matrix ..........
+ do 80 j = 1, n
+c
+ do 60 i = 1, n
+ 60 z(i,j) = 0.0d0
+c
+ z(j,j) = 1.0d0
+ 80 continue
+c
+ kl = igh - low - 1
+ if (kl .lt. 1) go to 200
+c .......... for mp=igh-1 step -1 until low+1 do -- ..........
+ do 140 mm = 1, kl
+ mp = igh - mm
+ mp1 = mp + 1
+c
+ do 100 i = mp1, igh
+ 100 z(i,mp) = a(i,mp-1)
+c
+ i = int(mp)
+ if (i .eq. mp) go to 140
+c
+ do 130 j = mp, igh
+ z(mp,j) = z(i,j)
+ z(i,j) = 0.0d0
+ 130 continue
+c
+ z(i,mp) = 1.0d0
+ 140 continue
+c
+ 200 return
+ end
+ subroutine hqr(nm,n,low,igh,h,wr,wi,ierr)
+C RESTORED CORRECT INDICES OF LOOPS (200,210,230,240). (9/29/89 BSG)
+c
+ integer i,j,k,l,m,n,en,ll,mm,na,nm,igh,itn,its,low,mp2,enm2,ierr
+ double precision h(nm,n),wr(n),wi(n)
+ double precision p,q,r,s,t,w,x,y,zz,norm,tst1,tst2
+ logical notlas
+c
+c this subroutine is a translation of the algol procedure hqr,
+c num. math. 14, 219-231(1970) by martin, peters, and wilkinson.
+c handbook for auto. comp., vol.ii-linear algebra, 359-371(1971).
+c
+c this subroutine finds the eigenvalues of a real
+c upper hessenberg matrix by the qr method.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c low and igh are integers determined by the balancing
+c subroutine balanc. if balanc has not been used,
+c set low=1, igh=n.
+c
+c h contains the upper hessenberg matrix. information about
+c the transformations used in the reduction to hessenberg
+c form by elmhes or orthes, if performed, is stored
+c in the remaining triangle under the hessenberg matrix.
+c
+c on output
+c
+c h has been destroyed. therefore, it must be saved
+c before calling hqr if subsequent calculation and
+c back transformation of eigenvectors is to be performed.
+c
+c wr and wi contain the real and imaginary parts,
+c respectively, of the eigenvalues. the eigenvalues
+c are unordered except that complex conjugate pairs
+c of values appear consecutively with the eigenvalue
+c having the positive imaginary part first. if an
+c error exit is made, the eigenvalues should be correct
+c for indices ierr+1,...,n.
+c
+c ierr is set to
+c zero for normal return,
+c j if the limit of 30*n iterations is exhausted
+c while the j-th eigenvalue is being sought.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated september 1989.
+c
+c ------------------------------------------------------------------
+c
+ ierr = 0
+ norm = 0.0d0
+ k = 1
+c .......... store roots isolated by balanc
+c and compute matrix norm ..........
+ do 50 i = 1, n
+c
+ do 40 j = k, n
+ 40 norm = norm + dabs(h(i,j))
+c
+ k = i
+ if (i .ge. low .and. i .le. igh) go to 50
+ wr(i) = h(i,i)
+ wi(i) = 0.0d0
+ 50 continue
+c
+ en = igh
+ t = 0.0d0
+ itn = 30*n
+c .......... search for next eigenvalues ..........
+ 60 if (en .lt. low) go to 1001
+ its = 0
+ na = en - 1
+ enm2 = na - 1
+c .......... look for single small sub-diagonal element
+c for l=en step -1 until low do -- ..........
+ 70 do 80 ll = low, en
+ l = en + low - ll
+ if (l .eq. low) go to 100
+ s = dabs(h(l-1,l-1)) + dabs(h(l,l))
+ if (s .eq. 0.0d0) s = norm
+ tst1 = s
+ tst2 = tst1 + dabs(h(l,l-1))
+ if (tst2 .eq. tst1) go to 100
+ 80 continue
+c .......... form shift ..........
+ 100 x = h(en,en)
+ if (l .eq. en) go to 270
+ y = h(na,na)
+ w = h(en,na) * h(na,en)
+ if (l .eq. na) go to 280
+ if (itn .eq. 0) go to 1000
+ if (its .ne. 10 .and. its .ne. 20) go to 130
+c .......... form exceptional shift ..........
+ t = t + x
+c
+ do 120 i = low, en
+ 120 h(i,i) = h(i,i) - x
+c
+ s = dabs(h(en,na)) + dabs(h(na,enm2))
+ x = 0.75d0 * s
+ y = x
+ w = -0.4375d0 * s * s
+ 130 its = its + 1
+ itn = itn - 1
+c .......... look for two consecutive small
+c sub-diagonal elements.
+c for m=en-2 step -1 until l do -- ..........
+ do 140 mm = l, enm2
+ m = enm2 + l - mm
+ zz = h(m,m)
+ r = x - zz
+ s = y - zz
+ p = (r * s - w) / h(m+1,m) + h(m,m+1)
+ q = h(m+1,m+1) - zz - r - s
+ r = h(m+2,m+1)
+ s = dabs(p) + dabs(q) + dabs(r)
+ p = p / s
+ q = q / s
+ r = r / s
+ if (m .eq. l) go to 150
+ tst1 = dabs(p)*(dabs(h(m-1,m-1)) + dabs(zz) + dabs(h(m+1,m+1)))
+ tst2 = tst1 + dabs(h(m,m-1))*(dabs(q) + dabs(r))
+ if (tst2 .eq. tst1) go to 150
+ 140 continue
+c
+ 150 mp2 = m + 2
+c
+ do 160 i = mp2, en
+ h(i,i-2) = 0.0d0
+ if (i .eq. mp2) go to 160
+ h(i,i-3) = 0.0d0
+ 160 continue
+c .......... double qr step involving rows l to en and
+c columns m to en ..........
+ do 260 k = m, na
+ notlas = k .ne. na
+ if (k .eq. m) go to 170
+ p = h(k,k-1)
+ q = h(k+1,k-1)
+ r = 0.0d0
+ if (notlas) r = h(k+2,k-1)
+ x = dabs(p) + dabs(q) + dabs(r)
+ if (x .eq. 0.0d0) go to 260
+ p = p / x
+ q = q / x
+ r = r / x
+ 170 s = dsign(dsqrt(p*p+q*q+r*r),p)
+ if (k .eq. m) go to 180
+ h(k,k-1) = -s * x
+ go to 190
+ 180 if (l .ne. m) h(k,k-1) = -h(k,k-1)
+ 190 p = p + s
+ x = p / s
+ y = q / s
+ zz = r / s
+ q = q / p
+ r = r / p
+ if (notlas) go to 225
+c .......... row modification ..........
+ do 200 j = k, EN
+ p = h(k,j) + q * h(k+1,j)
+ h(k,j) = h(k,j) - p * x
+ h(k+1,j) = h(k+1,j) - p * y
+ 200 continue
+c
+ j = min0(en,k+3)
+c .......... column modification ..........
+ do 210 i = L, j
+ p = x * h(i,k) + y * h(i,k+1)
+ h(i,k) = h(i,k) - p
+ h(i,k+1) = h(i,k+1) - p * q
+ 210 continue
+ go to 255
+ 225 continue
+c .......... row modification ..........
+ do 230 j = k, EN
+ p = h(k,j) + q * h(k+1,j) + r * h(k+2,j)
+ h(k,j) = h(k,j) - p * x
+ h(k+1,j) = h(k+1,j) - p * y
+ h(k+2,j) = h(k+2,j) - p * zz
+ 230 continue
+c
+ j = min0(en,k+3)
+c .......... column modification ..........
+ do 240 i = L, j
+ p = x * h(i,k) + y * h(i,k+1) + zz * h(i,k+2)
+ h(i,k) = h(i,k) - p
+ h(i,k+1) = h(i,k+1) - p * q
+ h(i,k+2) = h(i,k+2) - p * r
+ 240 continue
+ 255 continue
+c
+ 260 continue
+c
+ go to 70
+c .......... one root found ..........
+ 270 wr(en) = x + t
+ wi(en) = 0.0d0
+ en = na
+ go to 60
+c .......... two roots found ..........
+ 280 p = (y - x) / 2.0d0
+ q = p * p + w
+ zz = dsqrt(dabs(q))
+ x = x + t
+ if (q .lt. 0.0d0) go to 320
+c .......... real pair ..........
+ zz = p + dsign(zz,p)
+ wr(na) = x + zz
+ wr(en) = wr(na)
+ if (zz .ne. 0.0d0) wr(en) = x - w / zz
+ wi(na) = 0.0d0
+ wi(en) = 0.0d0
+ go to 330
+c .......... complex pair ..........
+ 320 wr(na) = x + p
+ wr(en) = x + p
+ wi(na) = zz
+ wi(en) = -zz
+ 330 en = enm2
+ go to 60
+c .......... set error -- all eigenvalues have not
+c converged after 30*n iterations ..........
+ 1000 ierr = en
+ 1001 return
+ end
+ subroutine hqr2(nm,n,low,igh,h,wr,wi,z,ierr)
+c
+ integer i,j,k,l,m,n,en,ii,jj,ll,mm,na,nm,nn,
+ x igh,itn,its,low,mp2,enm2,ierr
+ double precision h(nm,n),wr(n),wi(n),z(nm,n)
+ double precision p,q,r,s,t,w,x,y,ra,sa,vi,vr,zz,norm,tst1,tst2
+ logical notlas
+c
+c this subroutine is a translation of the algol procedure hqr2,
+c num. math. 16, 181-204(1970) by peters and wilkinson.
+c handbook for auto. comp., vol.ii-linear algebra, 372-395(1971).
+c
+c this subroutine finds the eigenvalues and eigenvectors
+c of a real upper hessenberg matrix by the qr method. the
+c eigenvectors of a real general matrix can also be found
+c if elmhes and eltran or orthes and ortran have
+c been used to reduce this general matrix to hessenberg form
+c and to accumulate the similarity transformations.
+c
+c on input
+c
+c nm must be set to the row dimension of two-dimensional
+c array parameters as declared in the calling program
+c dimension statement.
+c
+c n is the order of the matrix.
+c
+c low and igh are integers determined by the balancing
+c subroutine balanc. if balanc has not been used,
+c set low=1, igh=n.
+c
+c h contains the upper hessenberg matrix.
+c
+c z contains the transformation matrix produced by eltran
+c after the reduction by elmhes, or by ortran after the
+c reduction by orthes, if performed. if the eigenvectors
+c of the hessenberg matrix are desired, z must contain the
+c identity matrix.
+c
+c on output
+c
+c h has been destroyed.
+c
+c wr and wi contain the real and imaginary parts,
+c respectively, of the eigenvalues. the eigenvalues
+c are unordered except that complex conjugate pairs
+c of values appear consecutively with the eigenvalue
+c having the positive imaginary part first. if an
+c error exit is made, the eigenvalues should be correct
+c for indices ierr+1,...,n.
+c
+c z contains the real and imaginary parts of the eigenvectors.
+c if the i-th eigenvalue is real, the i-th column of z
+c contains its eigenvector. if the i-th eigenvalue is complex
+c with positive imaginary part, the i-th and (i+1)-th
+c columns of z contain the real and imaginary parts of its
+c eigenvector. the eigenvectors are unnormalized. if an
+c error exit is made, none of the eigenvectors has been found.
+c
+c ierr is set to
+c zero for normal return,
+c j if the limit of 30*n iterations is exhausted
+c while the j-th eigenvalue is being sought.
+c
+c calls cdiv for complex division.
+c
+c questions and comments should be directed to burton s. garbow,
+c mathematics and computer science div, argonne national laboratory
+c
+c this version dated august 1983.
+c
+c ------------------------------------------------------------------
+c
+ ierr = 0
+ norm = 0.0d0
+ k = 1
+c .......... store roots isolated by balanc
+c and compute matrix norm ..........
+ do 50 i = 1, n
+c
+ do 40 j = k, n
+ 40 norm = norm + dabs(h(i,j))
+c
+ k = i
+ if (i .ge. low .and. i .le. igh) go to 50
+ wr(i) = h(i,i)
+ wi(i) = 0.0d0
+ 50 continue
+c
+ en = igh
+ t = 0.0d0
+ itn = 30*n
+c .......... search for next eigenvalues ..........
+ 60 if (en .lt. low) go to 340
+ its = 0
+ na = en - 1
+ enm2 = na - 1
+c .......... look for single small sub-diagonal element
+c for l=en step -1 until low do -- ..........
+ 70 do 80 ll = low, en
+ l = en + low - ll
+ if (l .eq. low) go to 100
+ s = dabs(h(l-1,l-1)) + dabs(h(l,l))
+ if (s .eq. 0.0d0) s = norm
+ tst1 = s
+ tst2 = tst1 + dabs(h(l,l-1))
+ if (tst2 .eq. tst1) go to 100
+ 80 continue
+c .......... form shift ..........
+ 100 x = h(en,en)
+ if (l .eq. en) go to 270
+ y = h(na,na)
+ w = h(en,na) * h(na,en)
+ if (l .eq. na) go to 280
+ if (itn .eq. 0) go to 1000
+ if (its .ne. 10 .and. its .ne. 20) go to 130
+c .......... form exceptional shift ..........
+ t = t + x
+c
+ do 120 i = low, en
+ 120 h(i,i) = h(i,i) - x
+c
+ s = dabs(h(en,na)) + dabs(h(na,enm2))
+ x = 0.75d0 * s
+ y = x
+ w = -0.4375d0 * s * s
+ 130 its = its + 1
+ itn = itn - 1
+c .......... look for two consecutive small
+c sub-diagonal elements.
+c for m=en-2 step -1 until l do -- ..........
+ do 140 mm = l, enm2
+ m = enm2 + l - mm
+ zz = h(m,m)
+ r = x - zz
+ s = y - zz
+ p = (r * s - w) / h(m+1,m) + h(m,m+1)
+ q = h(m+1,m+1) - zz - r - s
+ r = h(m+2,m+1)
+ s = dabs(p) + dabs(q) + dabs(r)
+ p = p / s
+ q = q / s
+ r = r / s
+ if (m .eq. l) go to 150
+ tst1 = dabs(p)*(dabs(h(m-1,m-1)) + dabs(zz) + dabs(h(m+1,m+1)))
+ tst2 = tst1 + dabs(h(m,m-1))*(dabs(q) + dabs(r))
+ if (tst2 .eq. tst1) go to 150
+ 140 continue
+c
+ 150 mp2 = m + 2
+c
+ do 160 i = mp2, en
+ h(i,i-2) = 0.0d0
+ if (i .eq. mp2) go to 160
+ h(i,i-3) = 0.0d0
+ 160 continue
+c .......... double qr step involving rows l to en and
+c columns m to en ..........
+ do 260 k = m, na
+ notlas = k .ne. na
+ if (k .eq. m) go to 170
+ p = h(k,k-1)
+ q = h(k+1,k-1)
+ r = 0.0d0
+ if (notlas) r = h(k+2,k-1)
+ x = dabs(p) + dabs(q) + dabs(r)
+ if (x .eq. 0.0d0) go to 260
+ p = p / x
+ q = q / x
+ r = r / x
+ 170 s = dsign(dsqrt(p*p+q*q+r*r),p)
+ if (k .eq. m) go to 180
+ h(k,k-1) = -s * x
+ go to 190
+ 180 if (l .ne. m) h(k,k-1) = -h(k,k-1)
+ 190 p = p + s
+ x = p / s
+ y = q / s
+ zz = r / s
+ q = q / p
+ r = r / p
+ if (notlas) go to 225
+c .......... row modification ..........
+ do 200 j = k, n
+ p = h(k,j) + q * h(k+1,j)
+ h(k,j) = h(k,j) - p * x
+ h(k+1,j) = h(k+1,j) - p * y
+ 200 continue
+c
+ j = min0(en,k+3)
+c .......... column modification ..........
+ do 210 i = 1, j
+ p = x * h(i,k) + y * h(i,k+1)
+ h(i,k) = h(i,k) - p
+ h(i,k+1) = h(i,k+1) - p * q
+ 210 continue
+c .......... accumulate transformations ..........
+ do 220 i = low, igh
+ p = x * z(i,k) + y * z(i,k+1)
+ z(i,k) = z(i,k) - p
+ z(i,k+1) = z(i,k+1) - p * q
+ 220 continue
+ go to 255
+ 225 continue
+c .......... row modification ..........
+ do 230 j = k, n
+ p = h(k,j) + q * h(k+1,j) + r * h(k+2,j)
+ h(k,j) = h(k,j) - p * x
+ h(k+1,j) = h(k+1,j) - p * y
+ h(k+2,j) = h(k+2,j) - p * zz
+ 230 continue
+c
+ j = min0(en,k+3)
+c .......... column modification ..........
+ do 240 i = 1, j
+ p = x * h(i,k) + y * h(i,k+1) + zz * h(i,k+2)
+ h(i,k) = h(i,k) - p
+ h(i,k+1) = h(i,k+1) - p * q
+ h(i,k+2) = h(i,k+2) - p * r
+ 240 continue
+c .......... accumulate transformations ..........
+ do 250 i = low, igh
+ p = x * z(i,k) + y * z(i,k+1) + zz * z(i,k+2)
+ z(i,k) = z(i,k) - p
+ z(i,k+1) = z(i,k+1) - p * q
+ z(i,k+2) = z(i,k+2) - p * r
+ 250 continue
+ 255 continue
+c
+ 260 continue
+c
+ go to 70
+c .......... one root found ..........
+ 270 h(en,en) = x + t
+ wr(en) = h(en,en)
+ wi(en) = 0.0d0
+ en = na
+ go to 60
+c .......... two roots found ..........
+ 280 p = (y - x) / 2.0d0
+ q = p * p + w
+ zz = dsqrt(dabs(q))
+ h(en,en) = x + t
+ x = h(en,en)
+ h(na,na) = y + t
+ if (q .lt. 0.0d0) go to 320
+c .......... real pair ..........
+ zz = p + dsign(zz,p)
+ wr(na) = x + zz
+ wr(en) = wr(na)
+ if (zz .ne. 0.0d0) wr(en) = x - w / zz
+ wi(na) = 0.0d0
+ wi(en) = 0.0d0
+ x = h(en,na)
+ s = dabs(x) + dabs(zz)
+ p = x / s
+ q = zz / s
+ r = dsqrt(p*p+q*q)
+ p = p / r
+ q = q / r
+c .......... row modification ..........
+ do 290 j = na, n
+ zz = h(na,j)
+ h(na,j) = q * zz + p * h(en,j)
+ h(en,j) = q * h(en,j) - p * zz
+ 290 continue
+c .......... column modification ..........
+ do 300 i = 1, en
+ zz = h(i,na)
+ h(i,na) = q * zz + p * h(i,en)
+ h(i,en) = q * h(i,en) - p * zz
+ 300 continue
+c .......... accumulate transformations ..........
+ do 310 i = low, igh
+ zz = z(i,na)
+ z(i,na) = q * zz + p * z(i,en)
+ z(i,en) = q * z(i,en) - p * zz
+ 310 continue
+c
+ go to 330
+c .......... complex pair ..........
+ 320 wr(na) = x + p
+ wr(en) = x + p
+ wi(na) = zz
+ wi(en) = -zz
+ 330 en = enm2
+ go to 60
+c .......... all roots found. backsubstitute to find
+c vectors of upper triangular form ..........
+ 340 if (norm .eq. 0.0d0) go to 1001
+c .......... for en=n step -1 until 1 do -- ..........
+ do 800 nn = 1, n
+ en = n + 1 - nn
+ p = wr(en)
+ q = wi(en)
+ na = en - 1
+ if (q) 710, 600, 800
+c .......... real vector ..........
+ 600 m = en
+ h(en,en) = 1.0d0
+ if (na .eq. 0) go to 800
+c .......... for i=en-1 step -1 until 1 do -- ..........
+ do 700 ii = 1, na
+ i = en - ii
+ w = h(i,i) - p
+ r = 0.0d0
+c
+ do 610 j = m, en
+ 610 r = r + h(i,j) * h(j,en)
+c
+ if (wi(i) .ge. 0.0d0) go to 630
+ zz = w
+ s = r
+ go to 700
+ 630 m = i
+ if (wi(i) .ne. 0.0d0) go to 640
+ t = w
+ if (t .ne. 0.0d0) go to 635
+ tst1 = norm
+ t = tst1
+ 632 t = 0.01d0 * t
+ tst2 = norm + t
+ if (tst2 .gt. tst1) go to 632
+ 635 h(i,en) = -r / t
+ go to 680
+c .......... solve real equations ..........
+ 640 x = h(i,i+1)
+ y = h(i+1,i)
+ q = (wr(i) - p) * (wr(i) - p) + wi(i) * wi(i)
+ t = (x * s - zz * r) / q
+ h(i,en) = t
+ if (dabs(x) .le. dabs(zz)) go to 650
+ h(i+1,en) = (-r - w * t) / x
+ go to 680
+ 650 h(i+1,en) = (-s - y * t) / zz
+c
+c .......... overflow control ..........
+ 680 t = dabs(h(i,en))
+ if (t .eq. 0.0d0) go to 700
+ tst1 = t
+ tst2 = tst1 + 1.0d0/tst1
+ if (tst2 .gt. tst1) go to 700
+ do 690 j = i, en
+ h(j,en) = h(j,en)/t
+ 690 continue
+c
+ 700 continue
+c .......... end real vector ..........
+ go to 800
+c .......... complex vector ..........
+ 710 m = na
+c .......... last vector component chosen imaginary so that
+c eigenvector matrix is triangular ..........
+ if (dabs(h(en,na)) .le. dabs(h(na,en))) go to 720
+ h(na,na) = q / h(en,na)
+ h(na,en) = -(h(en,en) - p) / h(en,na)
+ go to 730
+ 720 call cdiv(0.0d0,-h(na,en),h(na,na)-p,q,h(na,na),h(na,en))
+ 730 h(en,na) = 0.0d0
+ h(en,en) = 1.0d0
+ enm2 = na - 1
+ if (enm2 .eq. 0) go to 800
+c .......... for i=en-2 step -1 until 1 do -- ..........
+ do 795 ii = 1, enm2
+ i = na - ii
+ w = h(i,i) - p
+ ra = 0.0d0
+ sa = 0.0d0
+c
+ do 760 j = m, en
+ ra = ra + h(i,j) * h(j,na)
+ sa = sa + h(i,j) * h(j,en)
+ 760 continue
+c
+ if (wi(i) .ge. 0.0d0) go to 770
+ zz = w
+ r = ra
+ s = sa
+ go to 795
+ 770 m = i
+ if (wi(i) .ne. 0.0d0) go to 780
+ call cdiv(-ra,-sa,w,q,h(i,na),h(i,en))
+ go to 790
+c .......... solve complex equations ..........
+ 780 x = h(i,i+1)
+ y = h(i+1,i)
+ vr = (wr(i) - p) * (wr(i) - p) + wi(i) * wi(i) - q * q
+ vi = (wr(i) - p) * 2.0d0 * q
+ if (vr .ne. 0.0d0 .or. vi .ne. 0.0d0) go to 784
+ tst1 = norm * (dabs(w) + dabs(q) + dabs(x)
+ x + dabs(y) + dabs(zz))
+ vr = tst1
+ 783 vr = 0.01d0 * vr
+ tst2 = tst1 + vr
+ if (tst2 .gt. tst1) go to 783
+ 784 call cdiv(x*r-zz*ra+q*sa,x*s-zz*sa-q*ra,vr,vi,
+ x h(i,na),h(i,en))
+ if (dabs(x) .le. dabs(zz) + dabs(q)) go to 785
+ h(i+1,na) = (-ra - w * h(i,na) + q * h(i,en)) / x
+ h(i+1,en) = (-sa - w * h(i,en) - q * h(i,na)) / x
+ go to 790
+ 785 call cdiv(-r-y*h(i,na),-s-y*h(i,en),zz,q,
+ x h(i+1,na),h(i+1,en))
+c
+c .......... overflow control ..........
+ 790 t = dmax1(dabs(h(i,na)), dabs(h(i,en)))
+ if (t .eq. 0.0d0) go to 795
+ tst1 = t
+ tst2 = tst1 + 1.0d0/tst1
+ if (tst2 .gt. tst1) go to 795
+ do 792 j = i, en
+ h(j,na) = h(j,na)/t
+ h(j,en) = h(j,en)/t
+ 792 continue
+c
+ 795 continue
+c .......... end complex vector ..........
+ 800 continue
+c .......... end back substitution.
+c vectors of isolated roots ..........
+ do 840 i = 1, n
+ if (i .ge. low .and. i .le. igh) go to 840
+c
+ do 820 j = i, n
+ 820 z(i,j) = h(i,j)
+c
+ 840 continue
+c .......... multiply by transformation matrix to give
+c vectors of original full matrix.
+c for j=n step -1 until low do -- ..........
+ do 880 jj = low, n
+ j = n + low - jj
+ m = min0(j,igh)
+c
+ do 880 i = low, igh
+ zz = 0.0d0
+c
+ do 860 k = low, m
+ 860 zz = zz + z(i,k) * h(k,j)
+c
+ z(i,j) = zz
+ 880 continue
+c
+ go to 1001
+c .......... set error -- all eigenvalues have not
+c converged after 30*n iterations ..........
+ 1000 ierr = en
+ 1001 return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/rpoly.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/rpoly.c
new file mode 100644
index 0000000000000000000000000000000000000000..7124b854600c612ad5ca7d9a720c2daa08083c79
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/rpoly.c
@@ -0,0 +1,903 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double log(double), exp(double), sqrt(double); /* #include <math.h> */
+
+static void calcsc_(integer *type);
+static void fxshfr_(integer *l2, integer *nz);
+static void newest_(integer *type, doublereal *uu, doublereal *vv);
+static void nextk_(integer *type);
+static void quad_(doublereal *a, doublereal *b1, doublereal *c, doublereal *sr, doublereal *si, doublereal *lr, doublereal *li);
+static void quadit_(doublereal *uu, doublereal *vv, integer *nz);
+static void quadsd_(integer *nn, doublereal *u, doublereal *v, doublereal *p, doublereal *q, doublereal *a, doublereal *b);
+static void realit_(doublereal *sss, integer *nz, integer *iflag);
+
+/* Common Block Declarations */
+
+static struct {
+ doublereal p[101], qp[101], k[101], qk[101], svk[101], sr, si, u, v, a, b,
+ c, d, a1, a2, a3, a6, a7, e, f, g, h, szr, szi, lzr, lzi;
+ real eta, are, mre;
+ integer n, nn;
+} global_;
+
+#define global_1 global_
+
+/* Table of constant values */
+static doublereal c_b41 = 1.;
+
+#ifdef _MSC_VER
+// This needs to be before the start of the function that contains the offending code
+# pragma warning ( disable : 4756)
+#endif
+
+/* ====================================================================== */
+/* NIST Guide to Available Math Software. */
+/* Fullsource for module 493 from package TOMS. */
+/* Retrieved from NETLIB on Wed Jul 3 11:47:53 1996. */
+/* ====================================================================== */
+
+/* Subroutine */ void rpoly_(op, degree, zeror, zeroi, fail)
+doublereal *op;
+integer *degree;
+doublereal *zeror, *zeroi;
+logical *fail;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static doublereal base;
+ static doublereal temp[101];
+ static real cosr, sinr;
+ static integer i, j, l;
+ static doublereal t;
+ static real x, infin;
+ static logical zerok;
+ static doublereal aa, bb, cc;
+ static real df, ff;
+ static integer jj;
+ static real sc, lo, dx, pt[101], xm;
+ static integer nz;
+ static doublereal factor;
+ static real xx, yy, smalno;
+ static integer nm1;
+ static real bnd, min_, max_;
+ static integer cnt;
+ static real xxx;
+
+/* FINDS THE ZEROS OF A REAL POLYNOMIAL */
+/* OP - DOUBLE PRECISION VECTOR OF COEFFICIENTS IN */
+/* ORDER OF DECREASING POWERS. */
+/* DEGREE - INTEGER DEGREE OF POLYNOMIAL. */
+/* ZEROR, ZEROI - OUTPUT DOUBLE PRECISION VECTORS OF */
+/* REAL AND IMAGINARY PARTS OF THE */
+/* ZEROS. */
+/* FAIL - OUTPUT LOGICAL PARAMETER, TRUE ONLY IF */
+/* LEADING COEFFICIENT IS ZERO OR IF RPOLY */
+/* HAS FOUND FEWER THAN DEGREE ZEROS. */
+/* IN THE LATTER CASE DEGREE IS RESET TO */
+/* THE NUMBER OF ZEROS FOUND. */
+/* TO CHANGE THE SIZE OF POLYNOMIALS WHICH CAN BE */
+/* SOLVED, RESET THE DIMENSIONS OF THE ARRAYS IN THE */
+/* COMMON AREA AND IN THE FOLLOWING DECLARATIONS. */
+/* THE SUBROUTINE USES SINGLE PRECISION CALCULATIONS */
+/* FOR SCALING, BOUNDS AND ERROR CALCULATIONS. ALL */
+/* CALCULATIONS FOR THE ITERATIONS ARE DONE IN DOUBLE */
+/* PRECISION. */
+/* THE FOLLOWING STATEMENTS SET MACHINE CONSTANTS USED */
+/* IN VARIOUS PARTS OF THE PROGRAM. THE MEANING OF THE */
+/* FOUR CONSTANTS ARE... */
+/* ETA THE MAXIMUM RELATIVE REPRESENTATION ERROR */
+/* WHICH CAN BE DESCRIBED AS THE SMALLEST */
+/* POSITIVE FLOATING POINT NUMBER SUCH THAT */
+/* 1.D0+ETA IS GREATER THAN 1. */
+/* INFIN THE LARGEST FLOATING-POINT NUMBER. */
+/* SMALNO THE SMALLEST POSITIVE FLOATING-POINT NUMBER */
+/* IF THE EXPONENT RANGE DIFFERS IN SINGLE AND */
+/* DOUBLE PRECISION THEN SMALNO AND INFIN */
+/* SHOULD INDICATE THE SMALLER RANGE. */
+/* BASE THE BASE OF THE FLOATING-POINT NUMBER */
+/* SYSTEM USED. */
+/* THE VALUES BELOW CORRESPOND TO THE BURROUGHS B6700 */
+/* changed for sparc, but these seem better -- awf */
+
+ base = 2.0;
+ global_1.eta = 2.23e-16f;
+ infin = 3.40282346638528860e+38f;
+ smalno = 1e-33f;
+/* ARE AND MRE REFER TO THE UNIT ERROR IN + AND * */
+/* RESPECTIVELY. THEY ARE ASSUMED TO BE THE SAME AS */
+/* ETA. */
+ global_1.are = global_1.eta;
+ global_1.mre = global_1.eta;
+ lo = smalno / global_1.eta;
+/* INITIALIZATION OF CONSTANTS FOR SHIFT ROTATION */
+ xx = 0.70710678f;
+ yy = -xx;
+ cosr = -0.069756474f;
+ sinr = 0.99756405f;
+ *fail = FALSE_;
+ global_1.n = *degree;
+ global_1.nn = global_1.n + 1;
+/* ALGORITHM FAILS IF THE LEADING COEFFICIENT IS ZERO. */
+ if (op[0] == 0.) {
+ *fail = TRUE_;
+ *degree = 0;
+ return;
+ }
+/* REMOVE THE ZEROS AT THE ORIGIN IF ANY */
+ while (op[global_1.nn - 1] == 0.) {
+ j = *degree - global_1.n;
+ zeror[j] = 0.;
+ zeroi[j] = 0.;
+ --global_1.nn;
+ --global_1.n;
+ }
+/* MAKE A COPY OF THE COEFFICIENTS */
+ for (i = 0; i < global_1.nn; ++i) {
+ global_1.p[i] = op[i];
+ }
+/* START THE ALGORITHM FOR ONE ZERO */
+L40:
+ if (global_1.n > 2) {
+ goto L60;
+ }
+ if (global_1.n < 1) {
+ return;
+ }
+/* CALCULATE THE FINAL ZERO OR PAIR OF ZEROS */
+ if (global_1.n != 2) {
+ zeror[*degree-1] = -global_1.p[1] / global_1.p[0];
+ zeroi[*degree-1] = 0.;
+ return;
+ }
+ quad_(global_1.p, &global_1.p[1], &global_1.p[2],
+ &zeror[*degree-2], &zeroi[*degree-2], &zeror[*degree-1], &zeroi[*degree-1]);
+ return;
+/* FIND LARGEST AND SMALLEST MODULI OF COEFFICIENTS. */
+L60:
+ max_ = 0.0f;
+ min_ = infin;
+ for (i = 0; i < global_1.nn; ++i) {
+ x = (real)abs(global_1.p[i]);
+ if (x > max_) {
+ max_ = x;
+ }
+ if (x != 0.0f && x < min_) {
+ min_ = x;
+ }
+ }
+/* SCALE IF THERE ARE LARGE OR VERY SMALL COEFFICIENTS */
+/* COMPUTES A SCALE FACTOR TO MULTIPLY THE */
+/* COEFFICIENTS OF THE POLYNOMIAL. THE SCALING IS DONE */
+/* TO AVOID OVERFLOW AND TO AVOID UNDETECTED UNDERFLOW */
+/* INTERFERING WITH THE CONVERGENCE CRITERION. */
+/* THE FACTOR IS A POWER OF THE BASE */
+ sc = lo / min_;
+ if (sc > 1.0f) {
+ goto L80;
+ }
+ if (max_ < 10.0f) {
+ goto L110;
+ }
+ if (sc == 0.0f) {
+ sc = smalno;
+ }
+ goto L90;
+L80:
+ if (infin / sc < max_) {
+ goto L110;
+ }
+L90:
+ l = (int)(log((doublereal)sc) / log(base) + 0.5);
+ factor = base;
+ factor = pow_di(&factor, &l);
+ if (factor == 1.) {
+ goto L110;
+ }
+ for (i = 0; i < global_1.nn; ++i) {
+ global_1.p[i] *= factor;
+ }
+/* COMPUTE LOWER BOUND ON MODULI OF ZEROS. */
+L110:
+ for (i = 0; i < global_1.nn; ++i) {
+ pt[i] = (real)abs(global_1.p[i]);
+ }
+ pt[global_1.nn - 1] = -pt[global_1.nn - 1];
+/* COMPUTE UPPER ESTIMATE OF BOUND */
+ x = (real)exp((log(-pt[global_1.nn - 1]) - log(pt[0])) / global_1.n);
+ if (pt[global_1.n - 1] == 0.0f) {
+ goto L130;
+ }
+/* IF NEWTON STEP AT THE ORIGIN IS BETTER, USE IT. */
+ xm = -pt[global_1.nn - 1] / pt[global_1.n - 1];
+ if (xm < x) {
+ x = xm;
+ }
+/* CHOP THE INTERVAL (0,X) UNTIL FF .LE. 0 */
+L130:
+ xm = x * 0.1f;
+ ff = pt[0];
+ for (i = 1; i < global_1.nn; ++i) {
+ ff = ff * xm + pt[i];
+ }
+ if (ff > 0.0f) {
+ x = xm;
+ goto L130;
+ }
+ dx = x;
+/* DO NEWTON ITERATION UNTIL X CONVERGES TO TWO */
+/* DECIMAL PLACES */
+ while (abs(dx/x) > 0.005f) {
+ ff = pt[0];
+ df = ff;
+ for (i = 1; i < global_1.n; ++i) {
+ ff = ff * x + pt[i];
+ df = df * x + ff;
+ }
+ ff = ff * x + pt[global_1.nn - 1];
+ dx = ff / df;
+ x -= dx;
+ }
+ bnd = x;
+/* COMPUTE THE DERIVATIVE AS THE INITIAL K POLYNOMIAL */
+/* AND DO 5 STEPS WITH NO SHIFT */
+ nm1 = global_1.n - 1;
+ for (i = 1; i < global_1.n; ++i) {
+ global_1.k[i] = (global_1.nn - i - 1) * global_1.p[i] / global_1.n;
+ }
+ global_1.k[0] = global_1.p[0];
+ aa = global_1.p[global_1.nn - 1];
+ bb = global_1.p[global_1.n - 1];
+ zerok = global_1.k[global_1.n - 1] == 0.;
+ for (jj = 1; jj <= 5; ++jj) {
+ cc = global_1.k[global_1.n - 1];
+ if (zerok) { /* USE UNSCALED FORM OF RECURRENCE */
+ for (i = 0; i < nm1; ++i) {
+ j = global_1.nn - i - 2;
+ global_1.k[j] = global_1.k[j - 1];
+ }
+ global_1.k[0] = 0.;
+ zerok = global_1.k[global_1.n - 1] == 0.;
+ }
+ else { /* USE SCALED FORM OF RECURRENCE */
+ t = -aa / cc;
+ for (i = 0; i < nm1; ++i) {
+ j = global_1.nn - i - 2;
+ global_1.k[j] = t * global_1.k[j - 1] + global_1.p[j];
+ }
+ global_1.k[0] = global_1.p[0];
+ zerok = abs(global_1.k[global_1.n - 1]) <= abs(bb) * global_1.eta * 10.0;
+ }
+ }
+/* SAVE K FOR RESTARTS WITH NEW SHIFTS */
+ for (i = 0; i < global_1.n; ++i) {
+ temp[i] = global_1.k[i];
+ }
+/* LOOP TO SELECT THE QUADRATIC CORRESPONDING TO EACH */
+/* NEW SHIFT */
+ for (cnt = 1; cnt <= 20; ++cnt) {
+/* QUADRATIC CORRESPONDS TO A DOUBLE SHIFT TO A */
+/* NON-REAL POINT AND ITS COMPLEX CONJUGATE. THE POINT */
+/* HAS MODULUS BND AND AMPLITUDE ROTATED BY 94 DEGREES */
+/* FROM THE PREVIOUS SHIFT */
+ xxx = cosr * xx - sinr * yy;
+ yy = sinr * xx + cosr * yy;
+ xx = xxx;
+ global_1.sr = bnd * xx;
+ global_1.si = bnd * yy;
+ global_1.u = global_1.sr * -2.;
+ global_1.v = bnd;
+/* SECOND STAGE CALCULATION, FIXED QUADRATIC */
+ i__1 = cnt * 20;
+ fxshfr_(&i__1, &nz);
+ if (nz == 0) {
+ goto L260;
+ }
+/* THE SECOND STAGE JUMPS DIRECTLY TO ONE OF THE THIRD */
+/* STAGE ITERATIONS AND RETURNS HERE IF SUCCESSFUL. */
+/* DEFLATE THE POLYNOMIAL, STORE THE ZERO OR ZEROS AND */
+/* RETURN TO THE MAIN ALGORITHM. */
+ j = *degree - global_1.n;
+ zeror[j] = global_1.szr;
+ zeroi[j] = global_1.szi;
+ global_1.nn -= nz;
+ global_1.n = global_1.nn - 1;
+ for (i = 0; i < global_1.nn; ++i) {
+ global_1.p[i] = global_1.qp[i];
+ }
+ if (nz == 1) {
+ goto L40;
+ }
+ zeror[j + 1] = global_1.lzr;
+ zeroi[j + 1] = global_1.lzi;
+ goto L40;
+/* IF THE ITERATION IS UNSUCCESSFUL ANOTHER QUADRATIC */
+/* IS CHOSEN AFTER RESTORING K */
+L260:
+ for (i = 0; i < global_1.n; ++i) {
+ global_1.k[i] = temp[i];
+ }
+ }
+/* RETURN WITH FAILURE IF NO CONVERGENCE WITH 20 */
+/* SHIFTS */
+ *fail = TRUE_;
+ *degree -= global_1.n;
+} /* rpoly_ */
+
+/* Subroutine */
+static void fxshfr_(l2, nz)
+integer *l2, *nz;
+{
+ /* Local variables */
+ static integer type;
+ static logical stry, vtry;
+ static integer i, j, iflag;
+ static doublereal s;
+ static real betas, betav;
+ static logical spass;
+ static logical vpass;
+ static doublereal ui, vi;
+ static real ts, tv, vv;
+ static real ots, otv, tss;
+ static doublereal ss, oss, ovv, svu, svv;
+ static real tvv;
+
+/* COMPUTES UP TO L2 FIXED SHIFT K-POLYNOMIALS, */
+/* TESTING FOR CONVERGENCE IN THE LINEAR OR QUADRATIC */
+/* CASE. INITIATES ONE OF THE VARIABLE SHIFT */
+/* ITERATIONS AND RETURNS WITH THE NUMBER OF ZEROS */
+/* FOUND. */
+/* L2 - LIMIT OF FIXED SHIFT STEPS */
+/* NZ - NUMBER OF ZEROS FOUND */
+ *nz = 0;
+ betav = .25f;
+ betas = .25f;
+ oss = global_1.sr;
+ ovv = global_1.v;
+/* EVALUATE POLYNOMIAL BY SYNTHETIC DIVISION */
+ quadsd_(&global_1.nn, &global_1.u, &global_1.v, global_1.p, global_1.qp, &global_1.a, &global_1.b);
+ calcsc_(&type);
+ for (j = 1; j <= *l2; ++j) {
+/* CALCULATE NEXT K POLYNOMIAL AND ESTIMATE V */
+ nextk_(&type);
+ calcsc_(&type);
+ newest_(&type, &ui, &vi);
+ vv = (real)vi;
+/* ESTIMATE S */
+ ss = 0.0;
+ if (global_1.k[global_1.n - 1] != 0.) {
+ ss = -global_1.p[global_1.nn - 1] / global_1.k[global_1.n - 1];
+ }
+ tv = 1.0f;
+ ts = 1.0f;
+ if (j == 1 || type == 3) {
+ goto L70;
+ }
+/* COMPUTE RELATIVE MEASURES OF CONVERGENCE OF S AND V */
+/* SEQUENCES */
+ if (vv != 0.0f) {
+ tv = (real)abs((vv - ovv) / vv);
+ }
+ if (ss != 0.0) {
+ ts = (real)abs((ss - oss) / ss);
+ }
+/* IF DECREASING, MULTIPLY TWO MOST RECENT */
+/* CONVERGENCE MEASURES */
+ tvv = 1.0f;
+ if (tv < otv) {
+ tvv = tv * otv;
+ }
+ tss = 1.0f;
+ if (ts < ots) {
+ tss = ts * ots;
+ }
+/* COMPARE WITH CONVERGENCE CRITERIA */
+ vpass = tvv < betav;
+ spass = tss < betas;
+ if (! (spass || vpass)) {
+ goto L70;
+ }
+/* AT LEAST ONE SEQUENCE HAS PASSED THE CONVERGENCE */
+/* TEST. STORE VARIABLES BEFORE ITERATING */
+ svu = global_1.u;
+ svv = global_1.v;
+ for (i = 1; i <= global_1.n; ++i) {
+ global_1.svk[i - 1] = global_1.k[i - 1];
+ }
+ s = ss;
+/* CHOOSE ITERATION ACCORDING TO THE FASTEST */
+/* CONVERGING SEQUENCE */
+ vtry = FALSE_;
+ stry = FALSE_;
+ if (spass && (! vpass || tss < tvv)) {
+ goto L40;
+ }
+L20:
+ quadit_(&ui, &vi, nz);
+ if (*nz > 0) {
+ return;
+ }
+/* QUADRATIC ITERATION HAS FAILED. FLAG THAT IT HAS */
+/* BEEN TRIED AND DECREASE THE CONVERGENCE CRITERION. */
+ vtry = TRUE_;
+ betav *= 0.25f;
+/* TRY LINEAR ITERATION IF IT HAS NOT BEEN TRIED AND */
+/* THE S SEQUENCE IS CONVERGING */
+ if (stry || ! spass) {
+ goto L50;
+ }
+ for (i = 1; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.svk[i - 1];
+ }
+L40:
+ realit_(&s, nz, &iflag);
+ if (*nz > 0) {
+ return;
+ }
+/* LINEAR ITERATION HAS FAILED. FLAG THAT IT HAS BEEN */
+/* TRIED AND DECREASE THE CONVERGENCE CRITERION */
+ stry = TRUE_;
+ betas *= 0.25f;
+/* IF LINEAR ITERATION SIGNALS AN ALMOST DOUBLE REAL */
+/* ZERO ATTEMPT QUADRATIC ITERATION */
+ if (iflag != 0) {
+ ui = -(s + s);
+ vi = s * s;
+ goto L20;
+ }
+/* RESTORE VARIABLES */
+L50:
+ global_1.u = svu;
+ global_1.v = svv;
+ for (i = 1; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.svk[i - 1];
+ }
+/* TRY QUADRATIC ITERATION IF IT HAS NOT BEEN TRIED */
+/* AND THE V SEQUENCE IS CONVERGING */
+ if (vpass && ! vtry) {
+ goto L20;
+ }
+/* RECOMPUTE QP AND SCALAR VALUES TO CONTINUE THE */
+/* SECOND STAGE */
+ quadsd_(&global_1.nn, &global_1.u, &global_1.v, global_1.p, global_1.qp, &global_1.a, &global_1.b);
+ calcsc_(&type);
+L70:
+ ovv = vv;
+ oss = ss;
+ otv = tv;
+ ots = ts;
+ }
+} /* fxshfr_ */
+
+/* Subroutine */
+static void quadit_(uu, vv, nz)
+doublereal *uu, *vv;
+integer *nz;
+{
+ /* Local variables */
+ static integer type, i, j;
+ static doublereal t;
+ static logical tried;
+ static real ee;
+ static doublereal ui, vi;
+ static real mp, zm;
+ static real relstp, omp;
+
+/* VARIABLE-SHIFT K-POLYNOMIAL ITERATION FOR A */
+/* QUADRATIC FACTOR CONVERGES ONLY IF THE ZEROS ARE */
+/* EQUIMODULAR OR NEARLY SO. */
+/* UU,VV - COEFFICIENTS OF STARTING QUADRATIC */
+/* NZ - NUMBER OF ZERO FOUND */
+ *nz = 0;
+ tried = FALSE_;
+ global_1.u = *uu;
+ global_1.v = *vv;
+ j = 0;
+/* MAIN LOOP */
+L10:
+ quad_(&c_b41, &global_1.u, &global_1.v, &global_1.szr, &global_1.szi, &global_1.lzr, &global_1.lzi);
+/* RETURN IF ROOTS OF THE QUADRATIC ARE REAL AND NOT */
+/* CLOSE TO MULTIPLE OR NEARLY EQUAL AND OF OPPOSITE */
+/* SIGN */
+ if (abs(abs(global_1.szr) - abs(global_1.lzr)) > abs(global_1.lzr) * .01) {
+ return;
+ }
+/* EVALUATE POLYNOMIAL BY QUADRATIC SYNTHETIC DIVISION */
+ quadsd_(&global_1.nn, &global_1.u, &global_1.v, global_1.p, global_1.qp, &global_1.a, &global_1.b);
+ mp = (real)abs(global_1.a - global_1.szr * global_1.b)
+ + (real)abs(global_1.szi * global_1.b);
+/* COMPUTE A RIGOROUS BOUND ON THE ROUNDING ERROR IN */
+/* EVALUTING P */
+ zm = (real)sqrt(abs(global_1.v));
+ ee = (real)abs(global_1.qp[0]) * 2.0f;
+ t = -global_1.szr * global_1.b;
+ for (i = 2; i <= global_1.n; ++i) {
+ ee = ee * zm + (real)abs(global_1.qp[i - 1]);
+ }
+ ee = ee * zm + (real)abs(global_1.a + t);
+ ee = (real)((global_1.mre * 5.0 + global_1.are * 4.0) * ee
+ - (global_1.mre * 5.0 + global_1.are * 2.0) * (abs(global_1.a + t) + abs(global_1.b) * zm)
+ + global_1.are * 2.0 * abs(t));
+/* ITERATION HAS CONVERGED SUFFICIENTLY IF THE */
+/* POLYNOMIAL VALUE IS LESS THAN 20 TIMES THIS BOUND */
+ if (mp <= ee * 20.0f) {
+ *nz = 2;
+ return;
+ }
+/* STOP ITERATION AFTER 20 STEPS */
+ if (++j > 20) {
+ return;
+ }
+ if (j < 2) {
+ goto L50;
+ }
+ if (relstp > 0.01f || mp < omp || tried) {
+ goto L50;
+ }
+/* A CLUSTER APPEARS TO BE STALLING THE CONVERGENCE. */
+/* FIVE FIXED SHIFT STEPS ARE TAKEN WITH A U,V CLOSE */
+/* TO THE CLUSTER */
+ if (relstp < global_1.eta) {
+ relstp = global_1.eta;
+ }
+ relstp = sqrtf(relstp);
+ global_1.u -= global_1.u * relstp;
+ global_1.v += global_1.v * relstp;
+ quadsd_(&global_1.nn, &global_1.u, &global_1.v, global_1.p, global_1.qp, &global_1.a, &global_1.b);
+ for (i = 1; i <= 5; ++i) {
+ calcsc_(&type);
+ nextk_(&type);
+ }
+ tried = TRUE_;
+ j = 0;
+L50:
+ omp = mp;
+/* CALCULATE NEXT K POLYNOMIAL AND NEW U AND V */
+ calcsc_(&type);
+ nextk_(&type);
+ calcsc_(&type);
+ newest_(&type, &ui, &vi);
+/* IF VI IS ZERO THE ITERATION IS NOT CONVERGING */
+ if (vi == 0.) {
+ return;
+ }
+ relstp = (real)abs((vi - global_1.v) / vi);
+ global_1.u = ui;
+ global_1.v = vi;
+ goto L10;
+} /* quadit_ */
+
+/* Subroutine */
+static void realit_(sss, nz, iflag)
+doublereal *sss;
+integer *nz, *iflag;
+{
+ /* Local variables */
+ static integer i, j;
+ static doublereal s, t;
+ static real ee, mp, ms;
+ static doublereal kv, pv;
+ static real omp;
+
+/* VARIABLE-SHIFT H POLYNOMIAL ITERATION FOR A REAL */
+/* ZERO. */
+/* SSS - STARTING ITERATE */
+/* NZ - NUMBER OF ZERO FOUND */
+/* IFLAG - FLAG TO INDICATE A PAIR OF ZEROS NEAR REAL */
+/* AXIS. */
+ *nz = 0;
+ s = *sss;
+ *iflag = 0;
+ j = 0;
+/* MAIN LOOP */
+L10:
+ pv = global_1.p[0];
+/* EVALUATE P AT S */
+ global_1.qp[0] = pv;
+ for (i = 2; i <= global_1.nn; ++i) {
+ pv = pv * s + global_1.p[i - 1];
+ global_1.qp[i - 1] = pv;
+ }
+ mp = (real)abs(pv);
+/* COMPUTE A RIGOROUS BOUND ON THE ERROR IN EVALUATING */
+/* P */
+ ms = (real)abs(s);
+ ee = (real)(global_1.mre / (global_1.are + global_1.mre) * abs(global_1.qp[0]));
+ for (i = 2; i <= global_1.nn; ++i) {
+ ee = ee * ms + (real)abs(global_1.qp[i - 1]);
+ }
+/* ITERATION HAS CONVERGED SUFFICIENTLY IF THE */
+/* POLYNOMIAL VALUE IS LESS THAN 20 TIMES THIS BOUND */
+ if (mp <= ((global_1.are + global_1.mre) * ee - global_1.mre * mp) * 20.0f) {
+ *nz = 1;
+ global_1.szr = s;
+ global_1.szi = 0.;
+ return;
+ }
+/* STOP ITERATION AFTER 10 STEPS */
+ if (++j > 10) {
+ return;
+ }
+ if (j < 2) {
+ goto L50;
+ }
+ if (abs(t) > abs(s - t) * 0.001 || mp <= omp) {
+ goto L50;
+ }
+/* A CLUSTER OF ZEROS NEAR THE REAL AXIS HAS BEEN */
+/* ENCOUNTERED RETURN WITH IFLAG SET TO INITIATE A */
+/* QUADRATIC ITERATION */
+ *iflag = 1;
+ *sss = s;
+ return;
+/* RETURN IF THE POLYNOMIAL VALUE HAS INCREASED */
+/* SIGNIFICANTLY */
+L50:
+ omp = mp;
+/* COMPUTE T, THE NEXT POLYNOMIAL, AND THE NEW ITERATE */
+ kv = global_1.k[0];
+ global_1.qk[0] = kv;
+ for (i = 2; i <= global_1.n; ++i) {
+ kv = kv * s + global_1.k[i - 1];
+ global_1.qk[i - 1] = kv;
+ }
+ if (abs(kv) <= abs(global_1.k[global_1.n - 1]) * 10.0 * global_1.eta) {
+ goto L80;
+ }
+/* USE THE SCALED FORM OF THE RECURRENCE IF THE VALUE */
+/* OF K AT S IS NONZERO */
+ t = -pv / kv;
+ global_1.k[0] = global_1.qp[0];
+ for (i = 2; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = t * global_1.qk[i - 2] + global_1.qp[i - 1];
+ }
+ goto L100;
+/* USE UNSCALED FORM */
+L80:
+ global_1.k[0] = 0.;
+ for (i = 2; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.qk[i - 2];
+ }
+L100:
+ kv = global_1.k[0];
+ for (i = 2; i <= global_1.n; ++i) {
+ kv = kv * s + global_1.k[i - 1];
+ }
+ t = 0.;
+ if (abs(kv) > abs(global_1.k[global_1.n - 1]) * 10.0 * global_1.eta) {
+ t = -pv / kv;
+ }
+ s += t;
+ goto L10;
+} /* realit_ */
+
+/* Subroutine */
+static void calcsc_(type)
+integer *type;
+{
+/* THIS ROUTINE CALCULATES SCALAR QUANTITIES USED TO */
+/* COMPUTE THE NEXT K POLYNOMIAL AND NEW ESTIMATES OF */
+/* THE QUADRATIC COEFFICIENTS. */
+/* TYPE - INTEGER VARIABLE SET HERE INDICATING HOW THE */
+/* CALCULATIONS ARE NORMALIZED TO AVOID OVERFLOW */
+/* SYNTHETIC DIVISION OF K BY THE QUADRATIC 1,U,V */
+ quadsd_(&global_1.n, &global_1.u, &global_1.v, global_1.k, global_1.qk, &global_1.c, &global_1.d);
+ if (abs(global_1.c) > abs(global_1.k[global_1.n - 1]) * 100.0 * global_1.eta) {
+ goto L10;
+ }
+ if (abs(global_1.d) > abs(global_1.k[global_1.n - 2]) * 100.0 * global_1.eta) {
+ goto L10;
+ }
+ *type = 3;
+/* TYPE=3 INDICATES THE QUADRATIC IS ALMOST A FACTOR */
+/* OF K */
+ return;
+L10:
+ if (abs(global_1.d) < abs(global_1.c)) {
+ goto L20;
+ }
+ *type = 2;
+/* TYPE=2 INDICATES THAT ALL FORMULAS ARE DIVIDED BY D */
+ global_1.e = global_1.a / global_1.d;
+ global_1.f = global_1.c / global_1.d;
+ global_1.g = global_1.u * global_1.b;
+ global_1.h = global_1.v * global_1.b;
+ global_1.a3 = (global_1.a + global_1.g) * global_1.e + global_1.h * (global_1.b / global_1.d);
+ global_1.a1 = global_1.b * global_1.f - global_1.a;
+ global_1.a7 = (global_1.f + global_1.u) * global_1.a + global_1.h;
+ return;
+L20:
+ *type = 1;
+/* TYPE=1 INDICATES THAT ALL FORMULAS ARE DIVIDED BY C */
+ global_1.e = global_1.a / global_1.c;
+ global_1.f = global_1.d / global_1.c;
+ global_1.g = global_1.u * global_1.e;
+ global_1.h = global_1.v * global_1.b;
+ global_1.a3 = global_1.a * global_1.e + (global_1.h / global_1.c + global_1.g) * global_1.b;
+ global_1.a1 = global_1.b - global_1.a * (global_1.d / global_1.c);
+ global_1.a7 = global_1.a + global_1.g * global_1.d + global_1.h * global_1.f;
+ return;
+} /* calcsc_ */
+
+/* Subroutine */
+static void nextk_(type)
+integer *type;
+{
+ /* Local variables */
+ static doublereal temp;
+ static integer i;
+
+/* COMPUTES THE NEXT K POLYNOMIALS USING SCALARS */
+/* COMPUTED IN CALCSC */
+ if (*type == 3) {
+ goto L40;
+ }
+ temp = global_1.a;
+ if (*type == 1) {
+ temp = global_1.b;
+ }
+ if (abs(global_1.a1) > abs(temp) * global_1.eta * 10.0) {
+ goto L20;
+ }
+/* IF A1 IS NEARLY ZERO THEN USE A SPECIAL FORM OF THE */
+/* RECURRENCE */
+ global_1.k[0] = 0.;
+ global_1.k[1] = -global_1.a7 * global_1.qp[0];
+ for (i = 3; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.a3 * global_1.qk[i - 3] - global_1.a7 * global_1.qp[i - 2];
+ }
+ return;
+/* USE SCALED FORM OF THE RECURRENCE */
+L20:
+ global_1.a7 /= global_1.a1;
+ global_1.a3 /= global_1.a1;
+ global_1.k[0] = global_1.qp[0];
+ global_1.k[1] = global_1.qp[1] - global_1.a7 * global_1.qp[0];
+ for (i = 3; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.a3 * global_1.qk[i - 3] - global_1.a7 * global_1.qp[i - 2] + global_1.qp[i - 1];
+ }
+ return;
+/* USE UNSCALED FORM OF THE RECURRENCE IF TYPE IS 3 */
+L40:
+ global_1.k[0] = 0.;
+ global_1.k[1] = 0.;
+ for (i = 3; i <= global_1.n; ++i) {
+ global_1.k[i - 1] = global_1.qk[i - 3];
+ }
+} /* nextk_ */
+
+/* Subroutine */
+static void newest_(type, uu, vv)
+integer *type;
+doublereal *uu, *vv;
+{
+ static doublereal temp, a4, a5, b1, b2, c1, c2, c3, c4;
+
+/* COMPUTE NEW ESTIMATES OF THE QUADRATIC COEFFICIENTS */
+/* USING THE SCALARS COMPUTED IN CALCSC. */
+/* USE FORMULAS APPROPRIATE TO SETTING OF TYPE. */
+ if (*type == 3) {
+ goto L30;
+ }
+ if (*type == 2) {
+ goto L10;
+ }
+ a4 = global_1.a + global_1.u * global_1.b + global_1.h * global_1.f;
+ a5 = global_1.c + (global_1.u + global_1.v * global_1.f) * global_1.d;
+ goto L20;
+L10:
+ a4 = (global_1.a + global_1.g) * global_1.f + global_1.h;
+ a5 = (global_1.f + global_1.u) * global_1.c + global_1.v * global_1.d;
+/* EVALUATE NEW QUADRATIC COEFFICIENTS. */
+L20:
+ b1 = -global_1.k[global_1.n - 1] / global_1.p[global_1.nn - 1];
+ b2 = -(global_1.k[global_1.n - 2] + b1 * global_1.p[global_1.n - 1]) / global_1.p[global_1.nn - 1];
+ c1 = global_1.v * b2 * global_1.a1;
+ c2 = b1 * global_1.a7;
+ c3 = b1 * b1 * global_1.a3;
+ c4 = c1 - c2 - c3;
+ temp = a5 + b1 * a4 - c4;
+ if (temp == 0.) {
+ goto L30;
+ }
+ *uu = global_1.u - (global_1.u * (c3 + c2) + global_1.v * (b1 * global_1.a1 + b2 * global_1.a7)) / temp;
+ *vv = global_1.v * (c4 / temp + 1.0);
+ return;
+/* IF TYPE=3 THE QUADRATIC IS ZEROED */
+L30:
+ *uu = 0.;
+ *vv = 0.;
+ return;
+} /* newest_ */
+
+/* Subroutine */
+static void quadsd_(nn, u, v, p, q, a, b)
+integer *nn;
+doublereal *u, *v, *p, *q, *a, *b;
+{
+ /* Local variables */
+ static doublereal c;
+ static integer i;
+
+/* DIVIDES P BY THE QUADRATIC 1,U,V PLACING THE */
+/* QUOTIENT IN Q AND THE REMAINDER IN A,B */
+
+ *b = p[0];
+ q[0] = *b;
+ *a = p[1] - *u * *b;
+ q[1] = *a;
+ for (i = 2; i < *nn; ++i) {
+ c = p[i] - *u * *a - *v * *b;
+ q[i] = c;
+ *b = *a;
+ *a = c;
+ }
+ return;
+} /* quadsd_ */
+
+/* Subroutine */
+static void quad_(a, b1, c, sr, si, lr, li)
+doublereal *a, *b1, *c, *sr, *si, *lr, *li;
+{
+ /* Local variables */
+ static doublereal b, d, e;
+
+/* CALCULATE THE ZEROS OF THE QUADRATIC A*Z**2+B1*Z+C. */
+/* THE QUADRATIC FORMULA, MODIFIED TO AVOID */
+/* OVERFLOW, IS USED TO FIND THE LARGER ZERO IF THE */
+/* ZEROS ARE REAL AND BOTH ZEROS ARE COMPLEX. */
+/* THE SMALLER REAL ZERO IS FOUND DIRECTLY FROM THE */
+/* PRODUCT OF THE ZEROS C/A. */
+ if (*a != 0.) {
+ goto L20;
+ }
+ *sr = 0.;
+ if (*b1 != 0.) {
+ *sr = -(*c) / *b1;
+ }
+ *lr = 0.;
+L10:
+ *si = 0.;
+ *li = 0.;
+ return;
+L20:
+ if (*c == 0.) {
+ *sr = 0.;
+ *lr = -(*b1) / *a;
+ goto L10;
+ }
+/* COMPUTE DISCRIMINANT AVOIDING OVERFLOW */
+ b = *b1 / 2.;
+ if (abs(b) >= abs(*c)) {
+ e = 1. - *a / b * (*c / b);
+ d = sqrt(abs(e)) * abs(b);
+ }
+ else {
+ e = *a;
+ if (*c < 0.) {
+ e = -(*a);
+ }
+ e = b * (b / abs(*c)) - e;
+ d = sqrt(abs(e)) * sqrt(abs(*c));
+ }
+ if (e < 0.) {
+ goto L60;
+ }
+/* REAL ZEROS */
+ if (b >= 0.) {
+ d = -d;
+ }
+ *lr = (-b + d) / *a;
+ *sr = 0.;
+ if (*lr != 0.) {
+ *sr = *c / *lr / *a;
+ }
+ goto L10;
+/* COMPLEX CONJUGATE ZEROS */
+L60:
+ *sr = -b / *a;
+ *lr = *sr;
+ *si = abs(d / *a);
+ *li = -(*si);
+} /* quad_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/rs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/rs.c
new file mode 100644
index 0000000000000000000000000000000000000000..5edb627ef1fe056015e7d5b65f928277c1cd58d7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/rs.c
@@ -0,0 +1,65 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void rs_(nm, n, a, w, matz, z, fv1, fv2, ierr)
+const integer *nm, *n;
+doublereal *a, *w;
+const integer *matz;
+doublereal *z, *fv1, *fv2;
+integer *ierr;
+{
+/* this subroutine calls the recommended sequence of */
+/* subroutines from the eigensystem subroutine package (eispack) */
+/* to find the eigenvalues and eigenvectors (if desired) */
+/* of a real symmetric matrix. */
+/* */
+/* on input */
+/* */
+/* nm must be set to the row dimension of the two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+/* */
+/* n is the order of the matrix a. */
+/* */
+/* a contains the real symmetric matrix. */
+/* */
+/* matz is an integer variable set equal to zero if */
+/* only eigenvalues are desired. otherwise it is set to */
+/* any non-zero integer for both eigenvalues and eigenvectors. */
+/* */
+/* on output */
+/* */
+/* w contains the eigenvalues in ascending order. */
+/* */
+/* z contains the eigenvectors if matz is not zero. */
+/* */
+/* ierr is an integer output variable set equal to an error */
+/* completion code described in the documentation for tqlrat */
+/* and tql2. the normal completion code is zero. */
+/* */
+/* fv1 and fv2 are temporary storage arrays. */
+/* */
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory*/
+/* */
+/* this version dated august 1983. */
+/* */
+/* ------------------------------------------------------------------ */
+
+ if (*n > *nm) {
+ *ierr = *n * 10;
+ return;
+ }
+ if (*matz == 0) {
+/* .......... find eigenvalues only .......... */
+ tred1_(nm, n, a, w, fv1, fv2);
+/* tqlrat encounters catastrophic underflow on the Vax */
+ tql1_(n, w, fv1, ierr);
+ return;
+ }
+/* .......... find both eigenvalues and eigenvectors .......... */
+ tred2_(nm, n, a, w, fv1, z);
+ tql2_(nm, n, w, fv1, z, ierr);
+ return;
+} /* rs_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/rsg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/rsg.c
new file mode 100644
index 0000000000000000000000000000000000000000..4b9ac2234c1fc7fc4f2da8571568d559dc826344
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/rsg.c
@@ -0,0 +1,443 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+static void rebak_(const integer *nm, const integer *n, const doublereal *b, const doublereal *dl, const integer *m, doublereal *z);
+static void reduc_(const integer *nm, const integer *n, doublereal *a, doublereal *b, doublereal *dl, integer *ierr);
+static void tqlrat_(const integer *n, doublereal *d, doublereal *e2, integer *ierr);
+static doublereal epslon_(doublereal *x);
+
+/* Table of constant values */
+static doublereal c_b17 = 1.;
+
+/* ====================================================================== */
+/* NIST Guide to Available Math Software. */
+/* Fullsource for module RSG from package EISPACK. */
+/* Retrieved from NETLIB on Thu Aug 29 08:25:55 1996. */
+/* ====================================================================== */
+/* Subroutine */ void rsg_(nm, n, a, b, w, matz, z, fv1, fv2, ierr)
+const integer *nm, *n;
+doublereal *a, *b;
+doublereal *w;
+const integer *matz;
+doublereal *z, *fv1, *fv2;
+integer *ierr;
+{
+/* this subroutine calls the recommended sequence of */
+/* subroutines from the eigensystem subroutine package (eispack) */
+/* to find the eigenvalues and eigenvectors (if desired) */
+/* for the real symmetric generalized eigenproblem ax = (lambda)bx. */
+
+/* on input */
+
+/* nm must be set to the row dimension of the two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrices a and b. */
+
+/* a contains a real symmetric matrix. */
+
+/* b contains a positive definite real symmetric matrix. */
+
+/* matz is an integer variable set equal to zero if */
+/* only eigenvalues are desired. otherwise it is set to */
+/* any non-zero integer for both eigenvalues and eigenvectors. */
+
+/* on output */
+
+/* w contains the eigenvalues in ascending order. */
+
+/* z contains the eigenvectors if matz is not zero. */
+
+/* ierr is an integer output variable set equal to an error */
+/* completion code described in the documentation for tqlrat */
+/* and tql2. the normal completion code is zero. */
+
+/* fv1 and fv2 are temporary storage arrays. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ if (*n > *nm) {
+ *ierr = *n * 10;
+ return;
+ }
+ reduc_(nm, n, a, b, fv2, ierr);
+ if (*ierr != 0) {
+ return;
+ }
+ if (*matz == 0) {
+/* .......... find eigenvalues only .......... */
+ tred1_(nm, n, a, w, fv1, fv2);
+ tqlrat_(n, w, fv2, ierr);
+ return;
+ }
+/* .......... find both eigenvalues and eigenvectors .......... */
+ tred2_(nm, n, a, w, fv1, z);
+ tql2_(nm, n, w, fv1, z, ierr);
+ if (*ierr == 0)
+ rebak_(nm, n, b, fv2, n, z);
+} /* rsg_ */
+
+static doublereal epslon_(x)
+doublereal *x;
+{
+ /* Local variables */
+ static doublereal a, b, c, eps;
+
+/* estimate unit roundoff in quantities of size x. */
+
+/* this program should function properly on all systems */
+/* satisfying the following two assumptions, */
+/* 1. the base used in representing floating point */
+/* numbers is not a power of three. */
+/* 2. the quantity a in statement 10 is represented to */
+/* the accuracy used in floating point variables */
+/* that are stored in memory. */
+/* the statement number 10 and the go to 10 are intended to */
+/* force optimizing compilers to generate code satisfying */
+/* assumption 2. */
+/* under these assumptions, it should be true that, */
+/* a is not exactly equal to four-thirds, */
+/* b has a zero for its last bit or digit, */
+/* c is not exactly equal to one, */
+/* eps measures the separation of 1.0 from */
+/* the next larger floating point number. */
+/* the developers of eispack would appreciate being informed */
+/* about any systems where these assumptions do not hold. */
+
+/* this version dated 4/6/83. */
+
+ a = 1.3333333333333333;
+ do {
+ b = a - 1.;
+ c = b + b + b;
+ eps = abs(c - 1.);
+ } while (eps == 0.);
+ return eps * abs(*x);
+} /* epslon_ */
+
+/* Subroutine */
+static void tqlrat_(n, d, e2, ierr)
+const integer *n;
+doublereal *d, *e2;
+integer *ierr;
+{
+ /* Local variables */
+ static doublereal b, c, f, g, h;
+ static integer i, j, l, m;
+ static doublereal p, r, s, t;
+
+/* this subroutine is a translation of the algol procedure tqlrat, */
+/* algorithm 464, comm. acm 16, 689(1973) by reinsch. */
+
+/* this subroutine finds the eigenvalues of a symmetric */
+/* tridiagonal matrix by the rational ql method. */
+
+/* on input */
+
+/* n is the order of the matrix. */
+
+/* d contains the diagonal elements of the input matrix. */
+
+/* e2 contains the squares of the subdiagonal elements of the */
+/* input matrix in its last n-1 positions. e2(1) is arbitrary. */
+
+/* on output */
+
+/* d contains the eigenvalues in ascending order. if an */
+/* error exit is made, the eigenvalues are correct and */
+/* ordered for indices 1,2,...ierr-1, but may not be */
+/* the smallest eigenvalues. */
+
+/* e2 has been destroyed. */
+
+/* ierr is set to */
+/* zero for normal return, */
+/* j if the j-th eigenvalue has not been */
+/* determined after 30 iterations. */
+
+/* calls pythag for sqrt(a*a + b*b) . */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ if (*n == 1) {
+ return;
+ }
+
+ for (i = 1; i < *n; ++i) {
+ e2[i-1] = e2[i];
+ }
+
+ f = 0.;
+ t = 0.;
+ e2[*n-1] = 0.;
+
+ for (l = 0; l < *n; ++l) {
+ j = 0;
+ h = abs(d[l]) + sqrt(e2[l]);
+ if (t <= h) {
+ t = h;
+ b = epslon_(&t);
+ c = b * b;
+ }
+/* .......... look for small squared sub-diagonal element .......... */
+ for (m = l; m < *n; ++m) {
+ if (e2[m] <= c) {
+ break;
+ }
+/* .......... e2(n) is always zero, so there is no exit */
+/* through the bottom of the loop .......... */
+ }
+
+ if (m == l) {
+ goto L210;
+ }
+L130:
+ if (j == 30) {
+/* .......... set error -- no convergence to an */
+/* eigenvalue after 30 iterations .......... */
+ *ierr = l+1;
+ return;
+ }
+ ++j;
+/* .......... form shift .......... */
+ s = sqrt(e2[l]);
+ g = d[l];
+ p = (d[l+1] - g) / (s * 2.);
+ r = pythag_(&p, &c_b17);
+ d[l] = s / (p + d_sign(&r, &p));
+ h = g - d[l];
+
+ for (i = l+1; i < *n; ++i) {
+ d[i] -= h;
+ }
+
+ f += h;
+/* .......... rational ql transformation .......... */
+ g = d[m];
+ if (g == 0.) {
+ g = b;
+ }
+ h = g;
+ s = 0.;
+ for (i = m-1; i >= l; --i) {
+ p = g * h;
+ r = p + e2[i];
+ e2[i+1] = s * r;
+ s = e2[i] / r;
+ d[i+1] = h + s * (h + d[i]);
+ g = d[i] - e2[i] / g;
+ if (g == 0.) {
+ g = b;
+ }
+ h = g * p / r;
+ }
+
+ e2[l] = s * g;
+ d[l] = h;
+/* .......... guard against underflow in convergence test ........ .. */
+ if (h == 0.) {
+ goto L210;
+ }
+ if (abs(e2[l]) <= abs(c / h)) {
+ goto L210;
+ }
+ e2[l] *= h;
+ if (e2[l] != 0.) {
+ goto L130;
+ }
+L210:
+ p = d[l] + f;
+/* .......... order eigenvalues .......... */
+ for (i = l; i > 0; --i) {
+ if (p >= d[i-1]) {
+ break;
+ }
+ d[i] = d[i-1];
+ }
+ d[i] = p;
+ }
+} /* tqlrat_ */
+
+/* Subroutine */
+static void rebak_(nm, n, b, dl, m, z)
+const integer *nm, *n;
+const doublereal *b, *dl;
+const integer *m;
+doublereal *z;
+{
+ /* Local variables */
+ static integer i, j, k;
+ static doublereal x;
+
+/* this subroutine is a translation of the algol procedure rebaka, */
+/* num. math. 11, 99-110(1968) by martin and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 303-314(1971). */
+
+/* this subroutine forms the eigenvectors of a generalized */
+/* symmetric eigensystem by back transforming those of the */
+/* derived symmetric matrix determined by reduc. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix system. */
+
+/* b contains information about the similarity transformation */
+/* (cholesky decomposition) used in the reduction by reduc */
+/* in its strict lower triangle. */
+
+/* dl contains further information about the transformation. */
+
+/* m is the number of eigenvectors to be back transformed. */
+
+/* z contains the eigenvectors to be back transformed */
+/* in its first m columns. */
+
+/* on output */
+
+/* z contains the transformed eigenvectors */
+/* in its first m columns. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ for (j = 0; j < *m; ++j) {
+ for (i = *n-1; i >= 0; --i) {
+ x = z[i + j * *nm];
+ for (k = i+1; k < *n; ++k) {
+ x -= b[k + i * *nm] * z[k + j * *nm];
+ }
+ z[i + j * *nm] = x / dl[i];
+ }
+ }
+} /* rebak_ */
+
+/* Subroutine */
+static void reduc_(nm, n, a, b, dl, ierr)
+const integer *nm, *n;
+doublereal *a, *b;
+doublereal *dl;
+integer *ierr;
+{
+ /* Local variables */
+ static integer i, j, k;
+ static doublereal x, y;
+ static integer nn;
+
+/* this subroutine is a translation of the algol procedure reduc1, */
+/* num. math. 11, 99-110(1968) by martin and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 303-314(1971). */
+
+/* this subroutine reduces the generalized symmetric eigenproblem */
+/* ax=(lambda)bx, where b is positive definite, to the standard */
+/* symmetric eigenproblem using the cholesky factorization of b. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrices a and b. if the cholesky */
+/* factor l of b is already available, n should be prefixed */
+/* with a minus sign. */
+
+/* a and b contain the real symmetric input matrices. only the */
+/* full upper triangles of the matrices need be supplied. if */
+/* n is negative, the strict lower triangle of b contains, */
+/* instead, the strict lower triangle of its cholesky factor l. */
+
+/* dl contains, if n is negative, the diagonal elements of l. */
+
+/* on output */
+
+/* a contains in its full lower triangle the full lower triangle */
+/* of the symmetric matrix derived from the reduction to the */
+/* standard form. the strict upper triangle of a is unaltered. */
+
+/* b contains in its strict lower triangle the strict lower */
+/* triangle of its cholesky factor l. the full upper */
+/* triangle of b is unaltered. */
+
+/* dl contains the diagonal elements of l. */
+
+/* ierr is set to */
+/* zero for normal return, */
+/* 7*n+1 if b is not positive definite. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ nn = abs(*n);
+/* .......... form l in the arrays b and dl .......... */
+ for (i = 0; i < *n; ++i) {
+ for (j = i; j < *n; ++j) {
+ x = b[i + j * *nm];
+ for (k = 0; k < i; ++k) {
+ x -= b[i + k * *nm] * b[j + k * *nm];
+ }
+ if (j != i) {
+ b[j + i * *nm] = x / y;
+ continue;
+ }
+ if (x <= 0.) {
+/* .......... set error -- b is not positive definite .......... */
+ *ierr = *n * 7 + 1;
+ return;
+ }
+ y = sqrt(x);
+ dl[i] = y;
+ }
+ }
+/* .......... form the transpose of the upper triangle of inv(l)*a */
+/* in the lower triangle of the array a .......... */
+ for (i = 0; i < nn; ++i) {
+ y = dl[i];
+
+ for (j = i; j < nn; ++j) {
+ x = a[i + j * *nm];
+ for (k = 0; k < i; ++k) {
+ x -= b[i + k * *nm] * a[j + k * *nm];
+ }
+ a[j + i * *nm] = x / y;
+ }
+ }
+/* .......... pre-multiply by inv(l) and overwrite .......... */
+ for (j = 0; j < nn; ++j) {
+ for (i = j; i < nn; ++i) {
+ x = a[i + j * *nm];
+ for (k = j; k < i; ++k) {
+ x -= a[k + j * *nm] * b[i + k * *nm];
+ }
+ for (k = 0; k < j; ++k) {
+ x -= a[j + k * *nm] * b[i + k * *nm];
+ }
+ a[i + j * *nm] = x / dl[i];
+ }
+ }
+} /* reduc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cat.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cat.c
new file mode 100644
index 0000000000000000000000000000000000000000..8f85b43a67a7ad473e04dd3438cb0557ce074ddd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cat.c
@@ -0,0 +1,75 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
+ * target of a concatenation to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90).
+ */
+
+#include "f2c.h"
+#include "netlib.h"
+#ifndef NO_OVERWRITE
+#include <stdio.h>
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void exit_();
+#else
+#undef min
+#undef max
+#include <stdlib.h>
+#endif
+#include <string.h>
+#endif /* NO_OVERWRITE */
+
+ VOID
+#ifdef KR_headers
+s_cat(lp, rpp, rnp, np, ll) char *lp; const char *rpp[]; ftnlen rnp[], *np, ll;
+#else
+s_cat(char *lp, const char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
+#endif
+{
+ ftnlen i, nc;
+ const char *rp;
+ ftnlen n = *np;
+#ifndef NO_OVERWRITE
+ ftnlen L, m;
+ char *lp0, *lp1;
+
+ lp0 = 0;
+ lp1 = lp;
+ L = ll;
+ i = 0;
+ while(i < n) {
+ rp = rpp[i];
+ m = rnp[i++];
+ if (rp >= lp1 || rp + m <= lp) {
+ if ((L -= m) <= 0) {
+ n = i;
+ break;
+ }
+ lp1 += m;
+ continue;
+ }
+ lp0 = lp;
+ lp = lp1 = F77_aloc(L = ll, "s_cat");
+ break;
+ }
+ lp1 = lp;
+#endif /* NO_OVERWRITE */
+ for(i = 0 ; i < n ; ++i) {
+ nc = ll;
+ if(rnp[i] < nc)
+ nc = rnp[i];
+ ll -= nc;
+ rp = rpp[i];
+ while(--nc >= 0)
+ *lp++ = *rp++;
+ }
+ while(--ll >= 0)
+ *lp++ = ' ';
+#ifndef NO_OVERWRITE
+ if (lp0) {
+ memcpy(lp0, lp1, L);
+ free(lp1);
+ }
+#endif
+ }
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cmp.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cmp.c
new file mode 100644
index 0000000000000000000000000000000000000000..8bbebdb008cbe0d516eaaa8a3533ab4728293152
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_cmp.c
@@ -0,0 +1,48 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* compare two strings */
+
+#ifdef KR_headers
+integer s_cmp(a0, b0, la, lb) const char *a0, *b0; ftnlen la, lb;
+#else
+integer s_cmp(const char *a0, const char *b0, ftnlen la, ftnlen lb)
+#endif
+{
+ register const unsigned char *a, *aend, *b, *bend;
+ a = (const unsigned char *)a0;
+ b = (const unsigned char *)b0;
+ aend = a + la;
+ bend = b + lb;
+
+ if (la <= lb)
+ {
+ while (a < aend)
+ if (*a != *b)
+ return *a - *b;
+ else
+ ++a, ++b;
+
+ while (b < bend)
+ if (*b != ' ')
+ return ' ' - *b;
+ else
+ ++b;
+ }
+
+ else
+ {
+ while (b < bend)
+ if (*a == *b)
+ ++a, ++b;
+ else
+ return *a - *b;
+
+ while (a < aend)
+ if (*a != ' ')
+ return *a - ' ';
+ else
+ ++a;
+ }
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/s_copy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_copy.c
new file mode 100644
index 0000000000000000000000000000000000000000..3b1d024b32c4ebb9f6d5f3551d3fad0d0b8e0cb7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/s_copy.c
@@ -0,0 +1,53 @@
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
+ * target of an assignment to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90),
+ * as in a(2:5) = a(4:7) .
+ */
+
+#include "f2c.h"
+#include "netlib.h"
+
+/* assign strings: a = b */
+
+#ifdef KR_headers
+VOID s_copy(a, b, la, lb) register char *a; register const char *b; ftnlen la, lb;
+#else
+void s_copy(register char *a, register const char *b, ftnlen la, ftnlen lb)
+#endif
+{
+ register char *aend;
+ register const char *bend;
+
+ aend = a + la;
+
+ if(la <= lb)
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= b + la)
+#endif
+ while(a < aend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else
+ for(b += la; a < aend; )
+ *--aend = *--b;
+#endif
+
+ else {
+ bend = b + lb;
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= bend)
+#endif
+ while(b < bend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else {
+ a += lb;
+ while(b < bend)
+ *--a = *--bend;
+ a += lb;
+ }
+#endif
+ while(a < aend)
+ *a++ = ' ';
+ }
+ }
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.c
new file mode 100644
index 0000000000000000000000000000000000000000..7c13cbbd305f343d6ae5335e06c4c097c53107c5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.c
@@ -0,0 +1,41 @@
+#include "f2c.h"
+#include "netlib.h"
+
+real sasum_(n, sx, incx)
+const integer *n;
+const real *sx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i, m, nincx;
+ static real stemp;
+
+/* takes the sum of the absolute values. */
+/* uses unrolled loops for increment equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ stemp = 0.f;
+ if (*n <= 0 || *incx <= 0) {
+ return stemp;
+ }
+/* code for increment equal to 1 */
+ if (*incx == 1) {
+ m = *n % 6;
+ for (i = 0; i < m; ++i) {
+ stemp += abs(sx[i]);
+ }
+ for (i = m; i < *n; i += 6) {
+ stemp += abs(sx[i]) + abs(sx[i+1]) + abs(sx[i+2]) + abs(sx[i+3]) + abs(sx[i+4]) + abs(sx[i+5]);
+ }
+ }
+/* code for increment not equal to 1 */
+ else {
+ nincx = *n * *incx;
+ for (i = 0; i < nincx; i += *incx) {
+ stemp += abs(sx[i]);
+ }
+ }
+ return stemp;
+} /* sasum_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.f
new file mode 100644
index 0000000000000000000000000000000000000000..8697579d4bfdeb60a693fe2f618eb16e1b0460ef
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sasum.f
@@ -0,0 +1,44 @@
+ real function sasum(n,sx,incx)
+c
+c takes the sum of the absolute values.
+c uses unrolled loops for increment equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),stemp
+ integer i,incx,m,mp1,n,nincx
+c
+ sasum = 0.0e0
+ stemp = 0.0e0
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ stemp = stemp + abs(sx(i))
+ 10 continue
+ sasum = stemp
+ return
+c
+c code for increment equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,6)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ stemp = stemp + abs(sx(i))
+ 30 continue
+ if( n .lt. 6 ) go to 60
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,6
+ stemp = stemp + abs(sx(i)) + abs(sx(i + 1)) + abs(sx(i + 2))
+ * + abs(sx(i + 3)) + abs(sx(i + 4)) + abs(sx(i + 5))
+ 50 continue
+ 60 sasum = stemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..cb6d55ec34f00e159c7fc40a90859c22e31daffc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.c
@@ -0,0 +1,50 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void saxpy_(n, sa, sx, incx, sy, incy)
+const integer *n;
+const real *sa, *sx;
+const integer *incx;
+real *sy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, m, ix, iy;
+
+/* constant times a vector plus a vector. */
+/* uses unrolled loop for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*sa == 0.f) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 4;
+ for (i = 0; i < m; ++i) {
+ sy[i] += *sa * sx[i];
+ }
+ for (i = m; i < *n; i += 4) {
+ sy[i] += *sa * sx[i];
+ sy[i + 1] += *sa * sx[i + 1];
+ sy[i + 2] += *sa * sx[i + 2];
+ sy[i + 3] += *sa * sx[i + 3];
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ sy[iy] += *sa * sx[ix];
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* saxpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..4b1c703872ab073d759b94256005541623b86d82
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/saxpy.f
@@ -0,0 +1,48 @@
+ subroutine saxpy(n,sa,sx,incx,sy,incy)
+c
+c constant times a vector plus a vector.
+c uses unrolled loop for increments equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),sy(*),sa
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if (sa .eq. 0.0) return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ sy(iy) = sy(iy) + sa*sx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,4)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ sy(i) = sy(i) + sa*sx(i)
+ 30 continue
+ if( n .lt. 4 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,4
+ sy(i) = sy(i) + sa*sx(i)
+ sy(i + 1) = sy(i + 1) + sa*sx(i + 1)
+ sy(i + 2) = sy(i + 2) + sa*sx(i + 2)
+ sy(i + 3) = sy(i + 3) + sa*sx(i + 3)
+ 50 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.c
new file mode 100644
index 0000000000000000000000000000000000000000..9e0f910c17f46625c5d6227c14237e98b51f2ddc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.c
@@ -0,0 +1,64 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+real scnrm2_(n, x, incx)
+const integer *n;
+const complex *x;
+const integer *incx;
+{
+ /* Local variables */
+ static real temp, norm, scale;
+ static integer ix;
+ static real ssq;
+
+/* SCNRM2 returns the euclidean norm of a vector via the function */
+/* name, so that */
+/* */
+/* SCNRM2 := sqrt( conjg( x' )*x ) */
+
+
+/* -- This version written on 25-October-1982. */
+/* Modified on 14-October-1993 to inline the call to CLASSQ. */
+/* Sven Hammarling, Nag Ltd. */
+
+ if (*n < 1 || *incx < 1) {
+ norm = 0.f;
+ } else {
+ scale = 0.f;
+ ssq = 1.f;
+/* The following loop is equivalent to this call to the LAPACK */
+/* auxiliary routine: */
+/* CALL CLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+ for (ix = 0; ix < *n * *incx; ix += *incx) {
+ if (x[ix].r != 0.f) {
+ temp = abs(x[ix].r);
+ if (scale < temp) {
+ scale /= temp;
+ ssq = ssq * (scale * scale) + 1.f;
+ scale = temp;
+ } else {
+ temp /= scale;
+ ssq += temp * temp;
+ }
+ }
+ if (x[ix].i != 0.f) {
+ temp = abs(x[ix].i);
+ if (scale < temp) {
+ scale /= temp;
+ ssq = ssq * (scale * scale) + 1.f;
+ scale = temp;
+ } else {
+ temp /= scale;
+ ssq += temp * temp;
+ }
+ }
+ }
+ norm = scale * sqrtf(ssq);
+ }
+
+ return norm;
+} /* scnrm2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.f
new file mode 100644
index 0000000000000000000000000000000000000000..8bfe9ae7f0f75a7a01841b4f65b5d5976bf539e8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/scnrm2.f
@@ -0,0 +1,67 @@
+ REAL FUNCTION SCNRM2( N, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* .. Array Arguments ..
+ COMPLEX X( * )
+* ..
+*
+* SCNRM2 returns the euclidean norm of a vector via the function
+* name, so that
+*
+* SCNRM2 := sqrt( conjg( x' )*x )
+*
+*
+*
+* -- This version written on 25-October-1982.
+* Modified on 14-October-1993 to inline the call to CLASSQ.
+* Sven Hammarling, Nag Ltd.
+*
+*
+* .. Parameters ..
+ REAL ONE , ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* .. Local Scalars ..
+ INTEGER IX
+ REAL NORM, SCALE, SSQ, TEMP
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, AIMAG, REAL, SQRT
+* ..
+* .. Executable Statements ..
+ IF( N.LT.1 .OR. INCX.LT.1 )THEN
+ NORM = ZERO
+ ELSE
+ SCALE = ZERO
+ SSQ = ONE
+* The following loop is equivalent to this call to the LAPACK
+* auxiliary routine:
+* CALL CLASSQ( N, X, INCX, SCALE, SSQ )
+*
+ DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
+ IF( REAL( X( IX ) ).NE.ZERO )THEN
+ TEMP = ABS( REAL( X( IX ) ) )
+ IF( SCALE.LT.TEMP )THEN
+ SSQ = ONE + SSQ*( SCALE/TEMP )**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + ( TEMP/SCALE )**2
+ END IF
+ END IF
+ IF( AIMAG( X( IX ) ).NE.ZERO )THEN
+ TEMP = ABS( AIMAG( X( IX ) ) )
+ IF( SCALE.LT.TEMP )THEN
+ SSQ = ONE + SSQ*( SCALE/TEMP )**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + ( TEMP/SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ NORM = SCALE * SQRT( SSQ )
+ END IF
+*
+ SCNRM2 = NORM
+ RETURN
+*
+* End of SCNRM2.
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.c
new file mode 100644
index 0000000000000000000000000000000000000000..c99bd7af0f044e244f5c6d6655b4d9b32c3225f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.c
@@ -0,0 +1,50 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void scopy_(n, sx, incx, sy, incy)
+const integer *n;
+const real *sx;
+const integer *incx;
+real *sy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, m, ix, iy;
+
+/* copies a vector, x, to a vector, y. */
+/* uses unrolled loops for increments equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 7;
+ for (i = 0; i < m; ++i) {
+ sy[i] = sx[i];
+ }
+ for (i = m; i < *n; i += 7) {
+ sy[i] = sx[i];
+ sy[i + 1] = sx[i + 1];
+ sy[i + 2] = sx[i + 2];
+ sy[i + 3] = sx[i + 3];
+ sy[i + 4] = sx[i + 4];
+ sy[i + 5] = sx[i + 5];
+ sy[i + 6] = sx[i + 6];
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ sy[iy] = sx[ix];
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* scopy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.f
new file mode 100644
index 0000000000000000000000000000000000000000..0202778ca8000d6830411ec379dc7a862d5e512e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/scopy.f
@@ -0,0 +1,50 @@
+ subroutine scopy(n,sx,incx,sy,incy)
+c
+c copies a vector, x, to a vector, y.
+c uses unrolled loops for increments equal to 1.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),sy(*)
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ sy(iy) = sx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,7)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ sy(i) = sx(i)
+ 30 continue
+ if( n .lt. 7 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,7
+ sy(i) = sx(i)
+ sy(i + 1) = sx(i + 1)
+ sy(i + 2) = sx(i + 2)
+ sy(i + 3) = sx(i + 3)
+ sy(i + 4) = sx(i + 4)
+ sy(i + 5) = sx(i + 5)
+ sy(i + 6) = sx(i + 6)
+ 50 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.c
new file mode 100644
index 0000000000000000000000000000000000000000..82c293054fa3e68ef5e946366c05cf05370f684a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.c
@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "netlib.h"
+
+real sdot_(n, sx, incx, sy, incy)
+const integer *n;
+const real *sx;
+const integer *incx;
+const real *sy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, m;
+ static real stemp;
+ static integer ix, iy;
+
+/* forms the dot product of two vectors. */
+/* uses unrolled loops for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ stemp = 0.f;
+ if (*n <= 0) {
+ return stemp;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 5;
+ for (i = 0; i < m; ++i) {
+ stemp += sx[i] * sy[i];
+ }
+ for (i = m; i < *n; i += 5) {
+ stemp += sx[i] * sy[i] +
+ sx[i + 1] * sy[i + 1] +
+ sx[i + 2] * sy[i + 2] +
+ sx[i + 3] * sy[i + 3] +
+ sx[i + 4] * sy[i + 4];
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ stemp += sx[ix] * sy[iy];
+ ix += *incx; iy += *incy;
+ }
+ }
+ return stemp;
+} /* sdot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.f
new file mode 100644
index 0000000000000000000000000000000000000000..416d90a59da222a390dfdc943b3342ad98589e27
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sdot.f
@@ -0,0 +1,49 @@
+ real function sdot(n,sx,incx,sy,incy)
+c
+c forms the dot product of two vectors.
+c uses unrolled loops for increments equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),sy(*),stemp
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ stemp = 0.0e0
+ sdot = 0.0e0
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ stemp = stemp + sx(ix)*sy(iy)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ sdot = stemp
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,5)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ stemp = stemp + sx(i)*sy(i)
+ 30 continue
+ if( n .lt. 5 ) go to 60
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,5
+ stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) +
+ * sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4)
+ 50 continue
+ 60 sdot = stemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/setgpfa.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/setgpfa.c
new file mode 100644
index 0000000000000000000000000000000000000000..5e129ec6bde6f6aba5c27de0711aff8e564a20a8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/setgpfa.c
@@ -0,0 +1,96 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double asin(double), cos(double), sin(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c__3 = 3;
+static integer c__5 = 5;
+
+/* SUBROUTINE 'SETGPFA' */
+/* SETUP ROUTINE FOR SELF-SORTING IN-PLACE */
+/* GENERALIZED PRIME FACTOR (COMPLEX) FFT [GPFA] */
+/* */
+/* CALL SETGPFA(TRIGS,N) */
+/* */
+/* INPUT : */
+/* ----- */
+/* N IS THE LENGTH OF THE TRANSFORMS. N MUST BE OF THE FORM: */
+/* ----------------------------------- */
+/* N = (2**IP) * (3**IQ) * (5**IR) */
+/* ----------------------------------- */
+/* */
+/* OUTPUT: */
+/* ------ */
+/* TRIGS IS A TABLE OF TWIDDLE FACTORS, */
+/* OF LENGTH 2*IPQR (REAL) WORDS, WHERE: */
+/* -------------------------------------- */
+/* IPQR = (2**IP) + (3**IQ) + (5**IR) */
+/* -------------------------------------- */
+/* */
+/* WRITTEN BY CLIVE TEMPERTON 1990 */
+/* */
+/* ---------------------------------------------------------------------- */
+
+/* Subroutine */
+void setgpfa_(real *trigs, const integer *n, integer *ires, integer *info)
+{
+ /* Local variables */
+ static integer ifac, kink, irot, i, k;
+ static real angle, twopi;
+ static integer kk, ni, nj[3], ll, nn;
+ static real del;
+
+/* DECOMPOSE N INTO FACTORS 2,3,5 */
+/* ------------------------------ */
+ nn = *n;
+ ifac = 2;
+
+ for (ll = 0; ll < 3; ++ll) {
+ kk = 0;
+ while (nn % ifac == 0) {
+ ++kk;
+ nn /= ifac;
+ }
+ ires[ll] = kk;
+ ifac += ll+1; /* which makes ifac 3 and 5 in the next 2 runs */
+ }
+
+ if (nn != 1) {
+ *info = -1;
+ return;
+ }
+
+/* COMPUTE LIST OF ROTATED TWIDDLE FACTORS */
+/* --------------------------------------- */
+ nj[0] = pow_ii(&c__2, ires);
+ nj[1] = pow_ii(&c__3, ires+1);
+ nj[2] = pow_ii(&c__5, ires+2);
+
+ twopi = (real)asin(1.) * 4.f;
+ i = 0;
+
+ for (ll = 0; ll < 3; ++ll) {
+ ni = nj[ll];
+ if (ni == 1) {
+ continue; /* next ll */
+ }
+ del = twopi / (real) ni;
+ irot = *n / ni;
+ kink = irot % ni;
+ kk = 0;
+
+ for (k = 1; k <= ni; ++k) {
+ angle = (real) kk * del;
+ trigs[i] = (float)cos(angle);
+ trigs[i+1] = (float)sin(angle);
+
+ i += 2;
+ kk += kink;
+ if (kk > ni) {
+ kk -= ni;
+ }
+ }
+ }
+ *info = 0;
+} /* setgpfa_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.c
new file mode 100644
index 0000000000000000000000000000000000000000..450de655906a5eee895493b25630ef3c21b70b48
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.c
@@ -0,0 +1,245 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sgemv_(const char *trans, const integer *m, const integer *n, real *alpha,
+ real *a, const integer *lda, real *x, const integer *incx,
+ real *beta, real *y, const integer *incy)
+{
+ /* Local variables */
+ static integer info;
+ static real temp;
+ static integer lenx, leny, i, j;
+ static integer ix, iy, jx, jy, kx, ky;
+
+/*
+ Purpose
+ =======
+
+ SGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - SINGLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - SINGLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - SINGLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - SINGLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - SINGLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+*/
+
+/* Test the input parameters. */
+ info = 0;
+ if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("SGEMV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return;
+ }
+
+/* Set LENX and LENY, the lengths of the vectors x and y, and set
+ up the start points in X and Y. */
+
+ if (lsame_(trans, "N")) { /* no transpose */
+ lenx = *n;
+ leny = *m;
+ } else { /* transpose */
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = - (lenx - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 0;
+ } else {
+ ky = - (leny - 1) * *incy;
+ }
+
+/* Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+
+ First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[i] = 0.;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ y[i] *= *beta;
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[iy] = 0.;
+ iy += *incy;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ y[iy] *= *beta;
+ iy += *incy;
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return;
+ }
+ if (lsame_(trans, "N")) { /* no transpose */
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ for (i = 0; i < *m; ++i) {
+ y[i] += temp * a[i + j* *lda];
+ }
+ }
+ jx += *incx;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ iy = ky;
+ for (i = 0; i < *m; ++i) {
+ y[iy] += temp * a[i + j* *lda];
+ iy += *incy;
+ }
+ }
+ jx += *incx;
+ }
+ }
+ } else { /* transpose */
+
+/* Form y := alpha*A'*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ temp = 0.;
+ for (i = 0; i < *m; ++i) {
+ temp += a[i + j* *lda] * x[i];
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ temp = 0.;
+ ix = kx;
+ for (i = 0; i < *m; ++i) {
+ temp += a[i + j* *lda] * x[ix];
+ ix += *incx;
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+ }
+ }
+ }
+} /* sgemv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.f
new file mode 100644
index 0000000000000000000000000000000000000000..4b47f0470272762dc7b7c5935f7ffaed7553a803
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgemv.f
@@ -0,0 +1,261 @@
+ SUBROUTINE SGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
+ $ BETA, Y, INCY )
+* .. Scalar Arguments ..
+ REAL ALPHA, BETA
+ INTEGER INCX, INCY, LDA, M, N
+ CHARACTER*1 TRANS
+* .. Array Arguments ..
+ REAL A( LDA, * ), X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGEMV performs one of the matrix-vector operations
+*
+* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+*
+* where alpha and beta are scalars, x and y are vectors and A is an
+* m by n matrix.
+*
+* Parameters
+* ==========
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the operation to be performed as
+* follows:
+*
+* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+*
+* TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+*
+* TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix A.
+* M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - REAL .
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* A - REAL array of DIMENSION ( LDA, n ).
+* Before entry, the leading m by n part of the array A must
+* contain the matrix of coefficients.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+* X - REAL array of DIMENSION at least
+* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+* and at least
+* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+* Before entry, the incremented array X must contain the
+* vector x.
+* Unchanged on exit.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+* BETA - REAL .
+* On entry, BETA specifies the scalar beta. When BETA is
+* supplied as zero then Y need not be set on input.
+* Unchanged on exit.
+*
+* Y - REAL array of DIMENSION at least
+* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+* and at least
+* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+* Before entry with BETA non-zero, the incremented array Y
+* must contain the vector y. On exit, Y is overwritten by the
+* updated vector y.
+*
+* INCY - INTEGER.
+* On entry, INCY specifies the increment for the elements of
+* Y. INCY must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ REAL ONE , ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* .. Local Scalars ..
+ REAL TEMP
+ INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 1
+ ELSE IF( M.LT.0 )THEN
+ INFO = 2
+ ELSE IF( N.LT.0 )THEN
+ INFO = 3
+ ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ ELSE IF( INCY.EQ.0 )THEN
+ INFO = 11
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'SGEMV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+ $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+ $ RETURN
+*
+* Set LENX and LENY, the lengths of the vectors x and y, and set
+* up the start points in X and Y.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+ LENX = N
+ LENY = M
+ ELSE
+ LENX = M
+ LENY = N
+ END IF
+ IF( INCX.GT.0 )THEN
+ KX = 1
+ ELSE
+ KX = 1 - ( LENX - 1 )*INCX
+ END IF
+ IF( INCY.GT.0 )THEN
+ KY = 1
+ ELSE
+ KY = 1 - ( LENY - 1 )*INCY
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+* First form y := beta*y.
+*
+ IF( BETA.NE.ONE )THEN
+ IF( INCY.EQ.1 )THEN
+ IF( BETA.EQ.ZERO )THEN
+ DO 10, I = 1, LENY
+ Y( I ) = ZERO
+ 10 CONTINUE
+ ELSE
+ DO 20, I = 1, LENY
+ Y( I ) = BETA*Y( I )
+ 20 CONTINUE
+ END IF
+ ELSE
+ IY = KY
+ IF( BETA.EQ.ZERO )THEN
+ DO 30, I = 1, LENY
+ Y( IY ) = ZERO
+ IY = IY + INCY
+ 30 CONTINUE
+ ELSE
+ DO 40, I = 1, LENY
+ Y( IY ) = BETA*Y( IY )
+ IY = IY + INCY
+ 40 CONTINUE
+ END IF
+ END IF
+ END IF
+ IF( ALPHA.EQ.ZERO )
+ $ RETURN
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form y := alpha*A*x + y.
+*
+ JX = KX
+ IF( INCY.EQ.1 )THEN
+ DO 60, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = ALPHA*X( JX )
+ DO 50, I = 1, M
+ Y( I ) = Y( I ) + TEMP*A( I, J )
+ 50 CONTINUE
+ END IF
+ JX = JX + INCX
+ 60 CONTINUE
+ ELSE
+ DO 80, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = ALPHA*X( JX )
+ IY = KY
+ DO 70, I = 1, M
+ Y( IY ) = Y( IY ) + TEMP*A( I, J )
+ IY = IY + INCY
+ 70 CONTINUE
+ END IF
+ JX = JX + INCX
+ 80 CONTINUE
+ END IF
+ ELSE
+*
+* Form y := alpha*A'*x + y.
+*
+ JY = KY
+ IF( INCX.EQ.1 )THEN
+ DO 100, J = 1, N
+ TEMP = ZERO
+ DO 90, I = 1, M
+ TEMP = TEMP + A( I, J )*X( I )
+ 90 CONTINUE
+ Y( JY ) = Y( JY ) + ALPHA*TEMP
+ JY = JY + INCY
+ 100 CONTINUE
+ ELSE
+ DO 120, J = 1, N
+ TEMP = ZERO
+ IX = KX
+ DO 110, I = 1, M
+ TEMP = TEMP + A( I, J )*X( IX )
+ IX = IX + INCX
+ 110 CONTINUE
+ Y( JY ) = Y( JY ) + ALPHA*TEMP
+ JY = JY + INCY
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of SGEMV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.c
new file mode 100644
index 0000000000000000000000000000000000000000..b025f5d80a04109c0d9762996c00a88fdbb92219
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.c
@@ -0,0 +1,214 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sgeqpf_(integer *m, integer *n, real *a, integer *lda,
+ integer *jpvt, real *tau, real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static real temp, temp2;
+ static integer i, j;
+ static integer itemp;
+ static integer ma, mn;
+ static real aii;
+ static integer pvt;
+
+/* -- LAPACK test routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SGEQPF computes a QR factorization with column pivoting of a */
+/* real M-by-N matrix A: A*P = Q*R. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0 */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, the upper triangle of the array contains the */
+/* min(M,N)-by-N upper triangular matrix R; the elements */
+/* below the diagonal, together with the array TAU, */
+/* represent the orthogonal matrix Q as a product of */
+/* min(m,n) elementary reflectors. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* JPVT (input/output) INTEGER array, dimension (N) */
+/* On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted */
+/* to the front of A*P (a leading column); if JPVT(i) = 0, */
+/* the i-th column of A is a free column. */
+/* On exit, if JPVT(i) = k, then the i-th column of A*P */
+/* was the k-th column of A. */
+/* */
+/* TAU (output) REAL array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors. */
+/* */
+/* WORK (workspace) REAL array, dimension (3*N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(n) */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i). */
+/* */
+/* The matrix P is represented in jpvt as follows: If */
+/* jpvt(j) = i */
+/* then the jth column of P is the ith canonical unit vector. */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SGEQPF", &i__1);
+ return;
+ }
+
+ mn = min(*m,*n);
+
+/* Move initial columns up front */
+
+ itemp = 0;
+ for (i = 0; i < *n; ++i) {
+ if (jpvt[i] != 0) {
+ if (i != itemp) {
+ sswap_(m, &a[i * *lda], &c__1, &a[itemp * *lda], &c__1);
+ jpvt[i] = jpvt[itemp];
+ jpvt[itemp] = i+1;
+ } else {
+ jpvt[i] = i+1;
+ }
+ ++itemp;
+ } else {
+ jpvt[i] = i+1;
+ }
+ }
+ --itemp;
+
+/* Compute the QR factorization and update remaining columns */
+
+ if (itemp >= 0) {
+ ma = min(itemp+1,*m);
+ sgeqr2_(m, &ma, a, lda, tau, work, info);
+ if (ma < *n) {
+ i__1 = *n - ma;
+ sorm2r_("Left", "Transpose", m, &i__1, &ma, a, lda, tau, &a[ma * *lda], lda, work, info);
+ }
+ }
+
+ if (itemp < mn-1) {
+
+/* Initialize partial column norms. The first n elements of */
+/* work store the exact column norms. */
+
+ for (i = itemp + 1; i < *n; ++i) {
+ i__1 = *m - itemp - 1;
+ work[i] = snrm2_(&i__1, &a[itemp + 1 + i * *lda], &c__1);
+ work[*n + i] = work[i];
+ }
+
+/* Compute factorization */
+
+ for (i = itemp + 1; i < mn; ++i) {
+
+/* Determine ith pivot column and swap if necessary */
+
+ i__1 = *n - i;
+ pvt = i - 1 + isamax_(&i__1, &work[i], &c__1);
+
+ if (pvt != i) {
+ sswap_(m, &a[pvt * *lda], &c__1, &a[i * *lda], &c__1);
+ itemp = jpvt[pvt];
+ jpvt[pvt] = jpvt[i];
+ jpvt[i] = itemp;
+ work[pvt] = work[i];
+ work[*n + pvt] = work[*n + i];
+ }
+
+/* Generate elementary reflector H(i) */
+
+ if (i < *m - 1) {
+ i__1 = *m - i;
+ slarfg_(&i__1, &a[i + i * *lda], &a[i + 1 + i * *lda], &c__1, &tau[i]);
+ } else {
+ i__1 = *m - 1;
+ slarfg_(&c__1, &a[i__1 + i__1 * *lda], &a[i__1 + i__1 * *lda], &c__1, &tau[i__1]);
+ }
+
+ if (i < *n - 1) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.f;
+ i__1 = *m - i;
+ i__2 = *n - i - 1;
+ slarf_("LEFT", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i],
+ &a[i + (i + 1) * *lda], lda, &work[*n << 1]);
+ a[i + i * *lda] = aii;
+ }
+
+/* Update partial column norms */
+
+ for (j = i + 1; j < *n; ++j) {
+ if (work[j] != 0.f) {
+ temp = abs(a[i + j * *lda]) / work[j];
+ temp = 1.f - temp * temp;
+ temp = max(temp,0.f);
+ temp2 = work[j] / work[*n + j];
+ temp2 = temp * .05f * (temp2 * temp2) + 1.f;
+ if (temp2 == 1.f) {
+ if (*m - i > 1) {
+ i__2 = *m - i - 1;
+ work[j] = snrm2_(&i__2, &a[i + 1 + j * *lda], &c__1);
+ work[*n + j] = work[j];
+ } else {
+ work[j] = 0.f;
+ work[*n + j] = 0.f;
+ }
+ } else {
+ work[j] *= sqrtf(temp);
+ }
+ }
+ }
+ }
+ }
+} /* sgeqpf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.f
new file mode 100644
index 0000000000000000000000000000000000000000..0f4eb0ecf7b7d748eb1783542ede31dfaae29219
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqpf.f
@@ -0,0 +1,219 @@
+ SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO )
+*
+* -- LAPACK test routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ INTEGER JPVT( * )
+ REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGEQPF computes a QR factorization with column pivoting of a
+* real M-by-N matrix A: A*P = Q*R.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, the upper triangle of the array contains the
+* min(M,N)-by-N upper triangular matrix R; the elements
+* below the diagonal, together with the array TAU,
+* represent the orthogonal matrix Q as a product of
+* min(m,n) elementary reflectors.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* JPVT (input/output) INTEGER array, dimension (N)
+* On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+* to the front of A*P (a leading column); if JPVT(i) = 0,
+* the i-th column of A is a free column.
+* On exit, if JPVT(i) = k, then the i-th column of A*P
+* was the k-th column of A.
+*
+* TAU (output) REAL array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors.
+*
+* WORK (workspace) REAL array, dimension (3*N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(n)
+*
+* Each H(i) has the form
+*
+* H = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).
+*
+* The matrix P is represented in jpvt as follows: If
+* jpvt(j) = i
+* then the jth column of P is the ith canonical unit vector.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, MA, MN, PVT
+ REAL AII, TEMP, TEMP2
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEQR2, SLARF, SLARFG, SORM2R, SSWAP, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ INTEGER ISAMAX
+ REAL SNRM2
+ EXTERNAL ISAMAX, SNRM2
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGEQPF', -INFO )
+ RETURN
+ END IF
+*
+ MN = MIN( M, N )
+*
+* Move initial columns up front
+*
+ ITEMP = 1
+ DO 10 I = 1, N
+ IF( JPVT( I ).NE.0 ) THEN
+ IF( I.NE.ITEMP ) THEN
+ CALL SSWAP( M, A( 1, I ), 1, A( 1, ITEMP ), 1 )
+ JPVT( I ) = JPVT( ITEMP )
+ JPVT( ITEMP ) = I
+ ELSE
+ JPVT( I ) = I
+ END IF
+ ITEMP = ITEMP + 1
+ ELSE
+ JPVT( I ) = I
+ END IF
+ 10 CONTINUE
+ ITEMP = ITEMP - 1
+*
+* Compute the QR factorization and update remaining columns
+*
+ IF( ITEMP.GT.0 ) THEN
+ MA = MIN( ITEMP, M )
+ CALL SGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
+ IF( MA.LT.N ) THEN
+ CALL SORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
+ $ A( 1, MA+1 ), LDA, WORK, INFO )
+ END IF
+ END IF
+*
+ IF( ITEMP.LT.MN ) THEN
+*
+* Initialize partial column norms. The first n elements of
+* work store the exact column norms.
+*
+ DO 20 I = ITEMP + 1, N
+ WORK( I ) = SNRM2( M-ITEMP, A( ITEMP+1, I ), 1 )
+ WORK( N+I ) = WORK( I )
+ 20 CONTINUE
+*
+* Compute factorization
+*
+ DO 40 I = ITEMP + 1, MN
+*
+* Determine ith pivot column and swap if necessary
+*
+ PVT = ( I-1 ) + ISAMAX( N-I+1, WORK( I ), 1 )
+*
+ IF( PVT.NE.I ) THEN
+ CALL SSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
+ ITEMP = JPVT( PVT )
+ JPVT( PVT ) = JPVT( I )
+ JPVT( I ) = ITEMP
+ WORK( PVT ) = WORK( I )
+ WORK( N+PVT ) = WORK( N+I )
+ END IF
+*
+* Generate elementary reflector H(i)
+*
+ IF( I.LT.M ) THEN
+ CALL SLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) )
+ ELSE
+ CALL SLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
+ END IF
+*
+ IF( I.LT.N ) THEN
+*
+* Apply H(i) to A(i:m,i+1:n) from the left
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK( 2*N+1 ) )
+ A( I, I ) = AII
+ END IF
+*
+* Update partial column norms
+*
+ DO 30 J = I + 1, N
+ IF( WORK( J ).NE.ZERO ) THEN
+ TEMP = ONE - ( ABS( A( I, J ) ) / WORK( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = ONE + 0.05*TEMP*( WORK( J ) / WORK( N+J ) )**2
+ IF( TEMP2.EQ.ONE ) THEN
+ IF( M-I.GT.0 ) THEN
+ WORK( J ) = SNRM2( M-I, A( I+1, J ), 1 )
+ WORK( N+J ) = WORK( J )
+ ELSE
+ WORK( J ) = ZERO
+ WORK( N+J ) = ZERO
+ END IF
+ ELSE
+ WORK( J ) = WORK( J )*SQRT( TEMP )
+ END IF
+ END IF
+ 30 CONTINUE
+*
+ 40 CONTINUE
+ END IF
+ RETURN
+*
+* End of SGEQPF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.c
new file mode 100644
index 0000000000000000000000000000000000000000..f95bbe473e387fee7bfa2d2727555d44724bc4b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.c
@@ -0,0 +1,110 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sgeqr2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, ip1;
+ static real aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SGEQR2 computes a QR factorization of a real m by n matrix A: */
+/* A = Q * R. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, the elements on and above the diagonal of the array */
+/* contain the min(m,n) by n upper trapezoidal matrix R (R is */
+/* upper triangular if m >= n); the elements below the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of elementary reflectors (see Further Details). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (output) REAL array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace) REAL array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
+/* and tau in TAU(i). */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SGEQR2", &i__1);
+ return;
+ }
+
+ for (i = 0; i < *m && i < *n; ++i) {
+ ip1 = i + 1;
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__1 = *m - i;
+ slarfg_(&i__1, &a[i + i * *lda], &a[min(ip1,*m-1) + i * *lda], &c__1, &tau[i]);
+ if (ip1 < *n) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.f;
+ i__1 = *m - i;
+ i__2 = *n - ip1;
+ slarf_("Left", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i], &a[i + ip1 * *lda], lda, work);
+ a[i + i * *lda] = aii;
+ }
+ }
+} /* sgeqr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.f
new file mode 100644
index 0000000000000000000000000000000000000000..346cc27ff7621760413f18ab0ed5d801713b213a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgeqr2.f
@@ -0,0 +1,122 @@
+ SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGEQR2 computes a QR factorization of a real m by n matrix A:
+* A = Q * R.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the m by n matrix A.
+* On exit, the elements on and above the diagonal of the array
+* contain the min(m,n) by n upper trapezoidal matrix R (R is
+* upper triangular if m >= n); the elements below the diagonal,
+* with the array TAU, represent the orthogonal matrix Q as a
+* product of elementary reflectors (see Further Details).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* TAU (output) REAL array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace) REAL array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+* and tau in TAU(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, K
+ REAL AII
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, SLARFG, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGEQR2', -INFO )
+ RETURN
+ END IF
+*
+ K = MIN( M, N )
+*
+ DO 10 I = 1, K
+*
+* Generate elementary reflector H(i) to annihilate A(i+1:m,i)
+*
+ CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
+ $ TAU( I ) )
+ IF( I.LT.N ) THEN
+*
+* Apply H(i) to A(i:m,i+1:n) from the left
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK )
+ A( I, I ) = AII
+ END IF
+ 10 CONTINUE
+ RETURN
+*
+* End of SGEQR2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.c
new file mode 100644
index 0000000000000000000000000000000000000000..9c80cec58b31813ef2d089271d1f1d3e89f205a4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.c
@@ -0,0 +1,148 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sger_(const integer *m, const integer *n, real *alpha,
+ real *x, const integer *incx, real *y, const integer *incy,
+ real *a, const integer *lda)
+{
+ /* Local variables */
+ static integer info;
+ static real temp;
+ static integer i, j, ix, jy, kx;
+
+/*
+ Purpose
+ =======
+
+ SGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+
+ vector and A is an m by n matrix.
+
+ Parameters
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - SINGLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - SINGLE PRECISION array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - SINGLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - SINGLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+*/
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("SGER ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || *alpha == 0.) {
+ return;
+ }
+
+/* Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A. */
+
+ if (*incy > 0) {
+ jy = 0;
+ } else {
+ jy = (1 - *n) * *incy;
+ }
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ for (i = 0; i < *m; ++i) {
+ a[i + j* *lda] += x[i] * temp;
+ }
+ }
+ jy += *incy;
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = (1 - *m) * *incx;
+ }
+ for (j = 0; j < *n; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ ix = kx;
+ for (i = 0; i < *m; ++i) {
+ a[i + j* *lda] += x[ix] * temp;
+ ix += *incx;
+ }
+ }
+ jy += *incy;
+ }
+ }
+} /* sger_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.f
new file mode 100644
index 0000000000000000000000000000000000000000..f336b417dfa845c1a2080face8fd780f06b0eb02
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sger.f
@@ -0,0 +1,157 @@
+ SUBROUTINE SGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+* .. Scalar Arguments ..
+ REAL ALPHA
+ INTEGER INCX, INCY, LDA, M, N
+* .. Array Arguments ..
+ REAL A( LDA, * ), X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGER performs the rank 1 operation
+*
+* A := alpha*x*y' + A,
+*
+* where alpha is a scalar, x is an m element vector, y is an n element
+* vector and A is an m by n matrix.
+*
+* Parameters
+* ==========
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix A.
+* M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - REAL .
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* X - REAL array of dimension at least
+* ( 1 + ( m - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the m
+* element vector x.
+* Unchanged on exit.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+* Y - REAL array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCY ) ).
+* Before entry, the incremented array Y must contain the n
+* element vector y.
+* Unchanged on exit.
+*
+* INCY - INTEGER.
+* On entry, INCY specifies the increment for the elements of
+* Y. INCY must not be zero.
+* Unchanged on exit.
+*
+* A - REAL array of DIMENSION ( LDA, n ).
+* Before entry, the leading m by n part of the array A must
+* contain the matrix of coefficients. On exit, A is
+* overwritten by the updated matrix.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+* .. Local Scalars ..
+ REAL TEMP
+ INTEGER I, INFO, IX, J, JY, KX
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( M.LT.0 )THEN
+ INFO = 1
+ ELSE IF( N.LT.0 )THEN
+ INFO = 2
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 5
+ ELSE IF( INCY.EQ.0 )THEN
+ INFO = 7
+ ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+ INFO = 9
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'SGER ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+ $ RETURN
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( INCY.GT.0 )THEN
+ JY = 1
+ ELSE
+ JY = 1 - ( N - 1 )*INCY
+ END IF
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = 1, N
+ IF( Y( JY ).NE.ZERO )THEN
+ TEMP = ALPHA*Y( JY )
+ DO 10, I = 1, M
+ A( I, J ) = A( I, J ) + X( I )*TEMP
+ 10 CONTINUE
+ END IF
+ JY = JY + INCY
+ 20 CONTINUE
+ ELSE
+ IF( INCX.GT.0 )THEN
+ KX = 1
+ ELSE
+ KX = 1 - ( M - 1 )*INCX
+ END IF
+ DO 40, J = 1, N
+ IF( Y( JY ).NE.ZERO )THEN
+ TEMP = ALPHA*Y( JY )
+ IX = KX
+ DO 30, I = 1, M
+ A( I, J ) = A( I, J ) + X( IX )*TEMP
+ IX = IX + INCX
+ 30 CONTINUE
+ END IF
+ JY = JY + INCY
+ 40 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of SGER .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.c
new file mode 100644
index 0000000000000000000000000000000000000000..0ee408932948d3ecb4a355746c582816f7b7ea0f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.c
@@ -0,0 +1,116 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sgerq2_(const integer *m, const integer *n, real *a, const integer *lda,
+ real *tau, real *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i, k;
+ static real aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SGERQ2 computes an RQ factorization of a real m by n matrix A: */
+/* A = R * Q. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, if m <= n, the upper triangle of the subarray */
+/* A(1:m,n-m+1:n) contains the m by m upper triangular matrix R; */
+/* if m >= n, the elements on and above the (m-n)-th subdiagonal */
+/* contain the m by n upper trapezoidal matrix R; the remaining */
+/* elements, with the array TAU, represent the orthogonal matrix */
+/* Q as a product of elementary reflectors (see Further */
+/* Details). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (output) REAL array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace) REAL array, dimension (M) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a real scalar, and v is a real vector with */
+/* v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in */
+/* A(m-k+i,1:n-k+i-1), and tau in TAU(i). */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ --work;
+ --tau;
+ a_dim1 = *lda;
+ a_offset = a_dim1 + 1;
+ a -= a_offset;
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SGERQ2", &i__1);
+ return;
+ }
+
+ k = min(*m,*n);
+
+ for (i = k; i >= 1; --i) {
+
+/* Generate elementary reflector H(i) to annihilate */
+/* A(m-k+i,1:n-k+i-1) */
+
+ i__1 = *n - k + i;
+ slarfg_(&i__1, &a[*m - k + i + (*n - k + i) * a_dim1], &a[*m - k + i + a_dim1], lda, &tau[i]);
+
+/* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right */
+
+ aii = a[*m - k + i + (*n - k + i) * a_dim1];
+ a[*m - k + i + (*n - k + i) * a_dim1] = 1.f;
+ i__1 = *m - k + i - 1;
+ i__2 = *n - k + i;
+ slarf_("Right", &i__1, &i__2, &a[*m - k + i + a_dim1], lda, &tau[i], &a[a_offset], lda, &work[1]);
+ a[*m - k + i + (*n - k + i) * a_dim1] = aii;
+ }
+} /* sgerq2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.f
new file mode 100644
index 0000000000000000000000000000000000000000..29abd79b736acea46f8883f23c04b854c14fbad2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sgerq2.f
@@ -0,0 +1,123 @@
+ SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGERQ2 computes an RQ factorization of a real m by n matrix A:
+* A = R * Q.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the m by n matrix A.
+* On exit, if m <= n, the upper triangle of the subarray
+* A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
+* if m >= n, the elements on and above the (m-n)-th subdiagonal
+* contain the m by n upper trapezoidal matrix R; the remaining
+* elements, with the array TAU, represent the orthogonal matrix
+* Q as a product of elementary reflectors (see Further
+* Details).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* TAU (output) REAL array, dimension (min(M,N))
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace) REAL array, dimension (M)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a real scalar, and v is a real vector with
+* v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
+* A(m-k+i,1:n-k+i-1), and tau in TAU(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, K
+ REAL AII
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, SLARFG, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGERQ2', -INFO )
+ RETURN
+ END IF
+*
+ K = MIN( M, N )
+*
+ DO 10 I = K, 1, -1
+*
+* Generate elementary reflector H(i) to annihilate
+* A(m-k+i,1:n-k+i-1)
+*
+ CALL SLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA,
+ $ TAU( I ) )
+*
+* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
+*
+ AII = A( M-K+I, N-K+I )
+ A( M-K+I, N-K+I ) = ONE
+ CALL SLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
+ $ TAU( I ), A, LDA, WORK )
+ A( M-K+I, N-K+I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of SGERQ2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.c
new file mode 100644
index 0000000000000000000000000000000000000000..4287f38d1bac9b571558bc3d4fcb39ecb0c4ea17
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.c
@@ -0,0 +1,277 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *alpha, real *beta, real *u, integer *ldu,
+ real *v, integer *ldv, real *q, integer *ldq,
+ real *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static real tola, tolb, unfl;
+ static real anorm, bnorm;
+ static logical wantq, wantu, wantv;
+ static integer ncycle;
+ static real ulp;
+
+/* -- LAPACK driver routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SGGSVD computes the generalized singular value decomposition (GSVD) */
+/* of an M-by-N real matrix A and P-by-N real matrix B: */
+/* */
+/* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ) */
+/* */
+/* where U, V and Q are orthogonal matrices, and Z' is the transpose */
+/* of Z. Let K+L = the effective numerical rank of the matrix (A',B')', */
+/* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and */
+/* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the */
+/* following structures, respectively: */
+/* */
+/* If M-K-L >= 0, */
+/* */
+/* K L */
+/* D1 = K ( I 0 ) */
+/* L ( 0 C ) */
+/* M-K-L ( 0 0 ) */
+/* */
+/* K L */
+/* D2 = L ( 0 S ) */
+/* P-L ( 0 0 ) */
+/* */
+/* N-K-L K L */
+/* ( 0 R ) = K ( 0 R11 R12 ) */
+/* L ( 0 0 R22 ) */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */
+/* S = diag( BETA(K+1), ... , BETA(K+L) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R is stored in A(1:K+L,N-K-L+1:N) on exit. */
+/* */
+/* If M-K-L < 0, */
+/* */
+/* K M-K K+L-M */
+/* D1 = K ( I 0 0 ) */
+/* M-K ( 0 C 0 ) */
+/* */
+/* K M-K K+L-M */
+/* D2 = M-K ( 0 S 0 ) */
+/* K+L-M ( 0 0 I ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* N-K-L K M-K K+L-M */
+/* ( 0 R ) = K ( 0 R11 R12 R13 ) */
+/* M-K ( 0 0 R22 R23 ) */
+/* K+L-M ( 0 0 0 R33 ) */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */
+/* S = diag( BETA(K+1), ... , BETA(M) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored */
+/* ( 0 R22 R23 ) */
+/* in B(M-K+1:L,N+M-K-L+1:N) on exit. */
+/* */
+/* The routine computes C, S, R, and optionally the orthogonal */
+/* transformation matrices U, V and Q. */
+/* */
+/* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of */
+/* A and B implicitly gives the SVD of A*inv(B): */
+/* A*inv(B) = U*(D1*inv(D2))*V'. */
+/* If ( A',B')' has orthonormal columns, then the GSVD of A and B is */
+/* also equal to the CS decomposition of A and B. Furthermore, the GSVD */
+/* can be used to derive the solution of the eigenvalue problem: */
+/* A'*A x = lambda* B'*B x. */
+/* In some literature, the GSVD of A and B is presented in the form */
+/* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 ) */
+/* where U and V are orthogonal and X is nonsingular, D1 and D2 are */
+/* ``diagonal''. The former GSVD form can be converted to the latter */
+/* form by taking the nonsingular matrix X as */
+/* */
+/* X = Q*( I 0 ) */
+/* ( 0 inv(R) ). */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': Orthogonal matrix U is computed; */
+/* = 'N': U is not computed. */
+/* */
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': Orthogonal matrix V is computed; */
+/* = 'N': V is not computed. */
+/* */
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Orthogonal matrix Q is computed; */
+/* = 'N': Q is not computed. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+/* */
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+/* */
+/* K (output) INTEGER */
+/* L (output) INTEGER */
+/* On exit, K and L specify the dimension of the subblocks */
+/* described in the Purpose section. */
+/* K + L = effective numerical rank of (A',B')'. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A contains the triangular matrix R, or part of R. */
+/* See Purpose for details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (input/output) REAL array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, B contains the triangular matrix R if M-K-L < 0. */
+/* See Purpose for details. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDA >= max(1,P). */
+/* */
+/* ALPHA (output) REAL array, dimension (N) */
+/* BETA (output) REAL array, dimension (N) */
+/* On exit, ALPHA and BETA contain the generalized singular */
+/* value pairs of A and B; */
+/* ALPHA(1:K) = 1, */
+/* BETA(1:K) = 0, */
+/* and if M-K-L >= 0, */
+/* ALPHA(K+1:K+L) = C, */
+/* BETA(K+1:K+L) = S, */
+/* or if M-K-L < 0, */
+/* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0 */
+/* BETA(K+1:M) =S, BETA(M+1:K+L) =1 */
+/* and */
+/* ALPHA(K+L+1:N) = 0 */
+/* BETA(K+L+1:N) = 0 */
+/* */
+/* U (output) REAL array, dimension (LDU,M) */
+/* If JOBU = 'U', U contains the M-by-M orthogonal matrix U. */
+/* If JOBU = 'N', U is not referenced. */
+/* */
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+/* */
+/* V (output) REAL array, dimension (LDV,P) */
+/* If JOBV = 'V', V contains the P-by-P orthogonal matrix V. */
+/* If JOBV = 'N', V is not referenced. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+/* */
+/* Q (output) REAL array, dimension (LDQ,N) */
+/* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+/* */
+/* WORK (workspace) REAL array, */
+/* dimension (max(3*N,M,P)+N) */
+/* */
+/* IWORK (workspace) INTEGER array, dimension (N) */
+/* */
+/* INFO (output)INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* > 0: if INFO = 1, the Jacobi-type procedure failed to */
+/* converge. For further details, see subroutine STGSJA. */
+/* */
+/* Internal Parameters */
+/* =================== */
+/* */
+/* TOLA REAL */
+/* TOLB REAL */
+/* TOLA and TOLB are the thresholds to determine the effective */
+/* rank of (A',B')'. Generally, they are set to */
+/* TOLA = MAX(M,N)*norm(A)*MACHEPS, */
+/* TOLB = MAX(P,N)*norm(B)*MACHEPS. */
+/* The size of TOLA and TOLB may affect the size of backward */
+/* errors of the decomposition. */
+/* */
+/* ===================================================================== */
+
+/* Test the input parameters */
+
+ wantu = lsame_(jobu, "U");
+ wantv = lsame_(jobv, "V");
+ wantq = lsame_(jobq, "Q");
+
+ *info = 0;
+ if (! (wantu || lsame_(jobu, "N"))) {
+ *info = -1;
+ } else if (! (wantv || lsame_(jobv, "N"))) {
+ *info = -2;
+ } else if (! (wantq || lsame_(jobq, "N"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*p < 0) {
+ *info = -6;
+ } else if (*lda < max(1,*m)) {
+ *info = -10;
+ } else if (*ldb < max(1,*p)) {
+ *info = -12;
+ } else if (*ldu < 1 || (wantu && *ldu < *m)) {
+ *info = -16;
+ } else if (*ldv < 1 || (wantv && *ldv < *p)) {
+ *info = -18;
+ } else if (*ldq < 1 || (wantq && *ldq < *n)) {
+ *info = -20;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SGGSVD", &i__1);
+ return;
+ }
+
+/* Compute the Frobenius norm of matrices A and B */
+
+ anorm = slange_("1", m, n, a, lda, work);
+ bnorm = slange_("1", p, n, b, ldb, work);
+
+/* Get machine precision and set up threshold for determining */
+/* the effective numerical rank of the matrices A and B. */
+
+ ulp = slamch_("Precision");
+ unfl = slamch_("Safe Minimum");
+ tola = max(*m,*n) * max(anorm,unfl) * ulp;
+ tolb = max(*p,*n) * max(bnorm,unfl) * ulp;
+
+/* Preprocessing */
+
+ sggsvp_(jobu, jobv, jobq, m, p, n, a, lda, b, ldb, &tola, &tolb, k, l,
+ u, ldu, v, ldv, q, ldq, iwork, work, &work[*n], info);
+
+/* Compute the GSVD of two upper "triangular" matrices */
+
+ stgsja_(jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, &tola, &tolb,
+ alpha, beta, u, ldu, v, ldv, q, ldq, work, &ncycle, info);
+
+} /* sggsvd_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.f
new file mode 100644
index 0000000000000000000000000000000000000000..a5df19d6f81fe31486dd1d9e376d866c0459c376
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvd.f
@@ -0,0 +1,296 @@
+ SUBROUTINE SGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
+ $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
+ $ WORK, IWORK, INFO )
+*
+* -- LAPACK driver routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ REAL A( LDA, * ), ALPHA( * ), B( LDB, * ),
+ $ BETA( * ), Q( LDQ, * ), U( LDU, * ),
+ $ V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGGSVD computes the generalized singular value decomposition (GSVD)
+* of an M-by-N real matrix A and P-by-N real matrix B:
+*
+* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R )
+*
+* where U, V and Q are orthogonal matrices, and Z' is the transpose
+* of Z. Let K+L = the effective numerical rank of the matrix (A',B')',
+* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and
+* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the
+* following structures, respectively:
+*
+* If M-K-L >= 0,
+*
+* K L
+* D1 = K ( I 0 )
+* L ( 0 C )
+* M-K-L ( 0 0 )
+*
+* K L
+* D2 = L ( 0 S )
+* P-L ( 0 0 )
+*
+* N-K-L K L
+* ( 0 R ) = K ( 0 R11 R12 )
+* L ( 0 0 R22 )
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+* S = diag( BETA(K+1), ... , BETA(K+L) ),
+* C**2 + S**2 = I.
+*
+* R is stored in A(1:K+L,N-K-L+1:N) on exit.
+*
+* If M-K-L < 0,
+*
+* K M-K K+L-M
+* D1 = K ( I 0 0 )
+* M-K ( 0 C 0 )
+*
+* K M-K K+L-M
+* D2 = M-K ( 0 S 0 )
+* K+L-M ( 0 0 I )
+* P-L ( 0 0 0 )
+*
+* N-K-L K M-K K+L-M
+* ( 0 R ) = K ( 0 R11 R12 R13 )
+* M-K ( 0 0 R22 R23 )
+* K+L-M ( 0 0 0 R33 )
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+* S = diag( BETA(K+1), ... , BETA(M) ),
+* C**2 + S**2 = I.
+*
+* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored
+* ( 0 R22 R23 )
+* in B(M-K+1:L,N+M-K-L+1:N) on exit.
+*
+* The routine computes C, S, R, and optionally the orthogonal
+* transformation matrices U, V and Q.
+*
+* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of
+* A and B implicitly gives the SVD of A*inv(B):
+* A*inv(B) = U*(D1*inv(D2))*V'.
+* If ( A',B')' has orthonormal columns, then the GSVD of A and B is
+* also equal to the CS decomposition of A and B. Furthermore, the GSVD
+* can be used to derive the solution of the eigenvalue problem:
+* A'*A x = lambda* B'*B x.
+* In some literature, the GSVD of A and B is presented in the form
+* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 )
+* where U and V are orthogonal and X is nonsingular, D1 and D2 are
+* ``diagonal''. The former GSVD form can be converted to the latter
+* form by taking the nonsingular matrix X as
+*
+* X = Q*( I 0 )
+* ( 0 inv(R) ).
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': Orthogonal matrix U is computed;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': Orthogonal matrix V is computed;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Orthogonal matrix Q is computed;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* K (output) INTEGER
+* L (output) INTEGER
+* On exit, K and L specify the dimension of the subblocks
+* described in the Purpose section.
+* K + L = effective numerical rank of (A',B')'.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A contains the triangular matrix R, or part of R.
+* See Purpose for details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) REAL array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, B contains the triangular matrix R if M-K-L < 0.
+* See Purpose for details.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDA >= max(1,P).
+*
+* ALPHA (output) REAL array, dimension (N)
+* BETA (output) REAL array, dimension (N)
+* On exit, ALPHA and BETA contain the generalized singular
+* value pairs of A and B;
+* ALPHA(1:K) = 1,
+* BETA(1:K) = 0,
+* and if M-K-L >= 0,
+* ALPHA(K+1:K+L) = C,
+* BETA(K+1:K+L) = S,
+* or if M-K-L < 0,
+* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0
+* BETA(K+1:M) =S, BETA(M+1:K+L) =1
+* and
+* ALPHA(K+L+1:N) = 0
+* BETA(K+L+1:N) = 0
+*
+* U (output) REAL array, dimension (LDU,M)
+* If JOBU = 'U', U contains the M-by-M orthogonal matrix U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (output) REAL array, dimension (LDV,P)
+* If JOBV = 'V', V contains the P-by-P orthogonal matrix V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (output) REAL array, dimension (LDQ,N)
+* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* WORK (workspace) REAL array,
+* dimension (max(3*N,M,P)+N)
+*
+* IWORK (workspace) INTEGER array, dimension (N)
+*
+* INFO (output)INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* > 0: if INFO = 1, the Jacobi-type procedure failed to
+* converge. For further details, see subroutine STGSJA.
+*
+* Internal Parameters
+* ===================
+*
+* TOLA REAL
+* TOLB REAL
+* TOLA and TOLB are the thresholds to determine the effective
+* rank of (A',B')'. Generally, they are set to
+* TOLA = MAX(M,N)*norm(A)*MACHEPS,
+* TOLB = MAX(P,N)*norm(B)*MACHEPS.
+* The size of TOLA and TOLB may affect the size of backward
+* errors of the decomposition.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL WANTQ, WANTU, WANTV
+ INTEGER NCYCLE
+ REAL ANORM, BNORM, TOLA, TOLB, ULP, UNFL
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ REAL SLAMCH, SLANGE
+ EXTERNAL LSAME, SLAMCH, SLANGE
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGGSVP, STGSJA, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ WANTU = LSAME( JOBU, 'U' )
+ WANTV = LSAME( JOBV, 'V' )
+ WANTQ = LSAME( JOBQ, 'Q' )
+*
+ INFO = 0
+ IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -12
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -16
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -18
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -20
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGGSVD', -INFO )
+ RETURN
+ END IF
+*
+* Compute the Frobenius norm of matrices A and B
+*
+ ANORM = SLANGE( '1', M, N, A, LDA, WORK )
+ BNORM = SLANGE( '1', P, N, B, LDB, WORK )
+*
+* Get machine precision and set up threshold for determining
+* the effective numerical rank of the matrices A and B.
+*
+ ULP = SLAMCH( 'Precision' )
+ UNFL = SLAMCH( 'Safe Minimum' )
+ TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP
+ TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP
+*
+* Preprocessing
+*
+ CALL SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA,
+ $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK,
+ $ WORK( N+1 ), INFO )
+*
+* Compute the GSVD of two upper "triangular" matrices
+*
+ CALL STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB,
+ $ TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
+ $ WORK, NCYCLE, INFO )
+*
+ RETURN
+*
+* End of SGGSVD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.c
new file mode 100644
index 0000000000000000000000000000000000000000..370a7169829074d41c8f95b428623d878ceec258
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.c
@@ -0,0 +1,391 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+
+static real c_b12 = 0.f;
+static real c_b22 = 1.f;
+
+/* Subroutine */ void sggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, real *a, integer *lda, real *b, integer *ldb,
+ real *tola, real *tolb, integer *k, integer *l, real *u, integer *ldu,
+ real *v, integer *ldv, real *q, integer *ldq, integer *iwork, real *tau,
+ real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, j;
+ static logical wantq, wantu, wantv;
+ static logical forwrd;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+
+/* SGGSVP computes orthogonal matrices U, V and Q such that */
+
+/* N-K-L K L */
+/* U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0; */
+/* L ( 0 0 A23 ) */
+/* M-K-L ( 0 0 0 ) */
+
+/* N-K-L K L */
+/* = K ( 0 A12 A13 ) if M-K-L < 0; */
+/* M-K ( 0 0 A23 ) */
+
+/* N-K-L K L */
+/* V'*B*Q = L ( 0 0 B13 ) */
+/* P-L ( 0 0 0 ) */
+
+/* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular */
+/* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, */
+/* otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective */
+/* numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the */
+/* transpose of Z. */
+
+/* This decomposition is the preprocessing step for computing the */
+/* Generalized Singular Value Decomposition (GSVD), see subroutine */
+/* SGGSVD. */
+
+/* Arguments */
+/* ========= */
+
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': Orthogonal matrix U is computed; */
+/* = 'N': U is not computed. */
+
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': Orthogonal matrix V is computed; */
+/* = 'N': V is not computed. */
+
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Orthogonal matrix Q is computed; */
+/* = 'N': Q is not computed. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A contains the triangular (or trapezoidal) matrix */
+/* described in the Purpose section. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* B (input/output) REAL array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, B contains the triangular matrix described in */
+/* the Purpose section. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,P). */
+
+/* TOLA (input) REAL */
+/* TOLB (input) REAL */
+/* TOLA and TOLB are the thresholds to determine the effective */
+/* numerical rank of matrix B and a subblock of A. Generally, */
+/* they are set to */
+/* TOLA = MAX(M,N)*norm(A)*MACHEPS, */
+/* TOLB = MAX(P,N)*norm(B)*MACHEPS. */
+/* The size of TOLA and TOLB may affect the size of backward */
+/* errors of the decomposition. */
+
+/* K (output) INTEGER */
+/* L (output) INTEGER */
+/* On exit, K and L specify the dimension of the subblocks */
+/* described in Purpose. */
+/* K + L = effective numerical rank of (A',B')'. */
+
+/* U (output) REAL array, dimension (LDU,M) */
+/* If JOBU = 'U', U contains the orthogonal matrix U. */
+/* If JOBU = 'N', U is not referenced. */
+
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+
+/* V (output) REAL array, dimension (LDV,M) */
+/* If JOBV = 'V', V contains the orthogonal matrix V. */
+/* If JOBV = 'N', V is not referenced. */
+
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+
+/* Q (output) REAL array, dimension (LDQ,N) */
+/* If JOBQ = 'Q', Q contains the orthogonal matrix Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+
+/* IWORK (workspace) INTEGER array, dimension (N) */
+
+/* TAU (workspace) REAL array, dimension (N) */
+
+/* WORK (workspace) REAL array, dimension (max(3*N,M,P)) */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+
+
+/* Further Details */
+/* =============== */
+
+/* The subroutine uses LAPACK subroutine SGEQPF for the QR factorization */
+/* with column pivoting to detect the effective numerical rank of the */
+/* a matrix. It may be replaced by a better rank determination strategy. */
+
+/* ===================================================================== */
+
+/* Test the input parameters */
+
+ wantu = lsame_(jobu, "U");
+ wantv = lsame_(jobv, "V");
+ wantq = lsame_(jobq, "Q");
+ forwrd = TRUE_;
+
+ *info = 0;
+ if (! (wantu || lsame_(jobu, "N"))) {
+ *info = -1;
+ } else if (! (wantv || lsame_(jobv, "N"))) {
+ *info = -2;
+ } else if (! (wantq || lsame_(jobq, "N"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*p < 0) {
+ *info = -5;
+ } else if (*n < 0) {
+ *info = -6;
+ } else if (*lda < max(1,*m)) {
+ *info = -8;
+ } else if (*ldb < max(1,*p)) {
+ *info = -10;
+ } else if (*ldu < 1 || (wantu && *ldu < *m) ) {
+ *info = -16;
+ } else if (*ldv < 1 || (wantv && *ldv < *p) ) {
+ *info = -18;
+ } else if (*ldq < 1 || (wantq && *ldq < *n) ) {
+ *info = -20;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SGGSVP", &i__1);
+ return;
+ }
+
+/* QR with column pivoting of B: B*P = V*( S11 S12 ) */
+/* ( 0 0 ) */
+
+ for (i = 0; i < *n; ++i) {
+ iwork[i] = 0;
+ }
+ sgeqpf_(p, n, b, ldb, iwork, tau, work, info);
+
+/* Update A := A*P */
+
+ slapmt_(&forwrd, m, n, a, lda, iwork);
+
+/* Determine the effective rank of matrix B. */
+
+ *l = 0;
+ for (i = 0; i < *p && i < *n; ++i) {
+ if (abs(b[i + i * *ldb]) > *tolb) {
+ ++(*l);
+ }
+ }
+
+ if (wantv) {
+
+/* Copy the details of V, and form V. */
+
+ slaset_("Full", p, p, &c_b12, &c_b12, v, ldv);
+ if (*p > 1) {
+ i__1 = *p - 1;
+ slacpy_("Lower", &i__1, n, &b[1], ldb, &v[1], ldv);
+ }
+ i__1 = min(*p,*n);
+ sorg2r_(p, p, &i__1, v, ldv, tau, work, info);
+ }
+
+/* Clean up B */
+
+ for (j = 0; j < *l; ++j) {
+ for (i = j + 1; i < *l; ++i) {
+ b[i + j * *ldb] = 0.f;
+ }
+ }
+ if (*p > *l) {
+ i__1 = *p - *l;
+ slaset_("Full", &i__1, n, &c_b12, &c_b12, &b[*l], ldb);
+ }
+
+ if (wantq) {
+
+/* Set Q = I and Update Q := Q*P */
+
+ slaset_("Full", n, n, &c_b12, &c_b22, q, ldq);
+ slapmt_(&forwrd, n, n, q, ldq, iwork);
+ }
+
+ if (*p >= *l && *n != *l) {
+
+/* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z */
+
+ sgerq2_(l, n, b, ldb, tau, work, info);
+
+/* Update A := A*Z' */
+
+ sormr2_("Right", "Transpose", m, n, l, b, ldb, tau, a, lda, work, info);
+
+ if (wantq) {
+
+/* Update Q := Q*Z' */
+
+ sormr2_("Right", "Transpose", n, n, l, b, ldb, tau, q, ldq, work, info);
+ }
+
+/* Clean up B */
+
+ i__1 = *n - *l;
+ slaset_("Full", l, &i__1, &c_b12, &c_b12, b, ldb);
+ for (j = *n - *l; j < *n; ++j) {
+ for (i = j - *n + *l + 1; i < *l; ++i) {
+ b[i + j * *ldb] = 0.f;
+ }
+ }
+ }
+
+/* Let N-L L */
+/* A = ( A11 A12 ) M, */
+
+/* then the following does the complete QR decomposition of A11: */
+
+/* A11 = U*( 0 T12 )*P1' */
+/* ( 0 0 ) */
+
+ for (i = 0; i < *n - *l; ++i) {
+ iwork[i] = 0;
+ }
+ i__1 = *n - *l;
+ sgeqpf_(m, &i__1, a, lda, iwork, tau, work, info);
+
+/* Determine the effective rank of A11 */
+
+ *k = 0;
+ for (i = 0; i < *m && i < *n - *l; ++i) {
+ if (abs(a[i + i * *lda]) > *tola) {
+ ++(*k);
+ }
+ }
+
+/* Update A12 := U'*A12, where A12 = A( 1:M, N-L+1:N ) */
+
+ i__1 = min(*m,*n - *l);
+ sorm2r_("Left", "Transpose", m, l, &i__1, a, lda, tau, &a[(*n - *l) * *lda], lda, work, info);
+
+ if (wantu) {
+
+/* Copy the details of U, and form U */
+
+ slaset_("Full", m, m, &c_b12, &c_b12, u, ldu);
+ if (*m > 1) {
+ i__1 = *m - 1;
+ i__2 = *n - *l;
+ slacpy_("Lower", &i__1, &i__2, &a[1], lda, &u[1], ldu);
+ }
+ i__1 = min(*m,*n - *l);
+ sorg2r_(m, m, &i__1, u, ldu, tau, work, info);
+ }
+
+ if (wantq) {
+
+/* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1 */
+
+ i__1 = *n - *l;
+ slapmt_(&forwrd, n, &i__1, q, ldq, iwork);
+ }
+
+/* Clean up A: set the strictly lower triangular part of */
+/* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0. */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = j + 1; i < *k; ++i) {
+ a[i + j * *lda] = 0.f;
+ }
+ }
+ if (*m > *k) {
+ i__1 = *m - *k;
+ i__2 = *n - *l;
+ slaset_("Full", &i__1, &i__2, &c_b12, &c_b12, &a[*k], lda);
+ }
+
+ if (*n - *l > *k) {
+
+/* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1 */
+
+ i__1 = *n - *l;
+ sgerq2_(k, &i__1, a, lda, tau, work, info);
+
+ if (wantq) {
+
+/* Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1' */
+
+ i__1 = *n - *l;
+ sormr2_("Right", "Transpose", n, &i__1, k, a, lda, tau, q, ldq, work, info);
+ }
+
+/* Clean up A */
+
+ i__1 = *n - *l - *k;
+ slaset_("Full", k, &i__1, &c_b12, &c_b12, a, lda);
+ for (j = *n - *l - *k; j < *n - *l; ++j) {
+ for (i = j - *n + *l + *k + 1; i < *k; ++i) {
+ a[i + j * *lda] = 0.f;
+ }
+ }
+ }
+
+ if (*m > *k) {
+
+/* QR factorization of A( K+1:M,N-L+1:N ) */
+
+ i__1 = *m - *k;
+ sgeqr2_(&i__1, l, &a[*k + (*n - *l) * *lda], lda, tau, work, info);
+
+ if (wantu) {
+
+/* Update U(:,K+1:M) := U(:,K+1:M)*U1 */
+
+ i__1 = *m - *k;
+ i__2 = min(i__1,*l);
+ sorm2r_("Right", "No transpose", m, &i__1, &i__2,
+ &a[*k + (*n - *l) * *lda], lda, tau,
+ &u[*k * *ldu], ldu, work, info);
+ }
+
+/* Clean up */
+
+ for (j = *n - *l; j < *n; ++j) {
+ for (i = j - *n + *k + *l + 1; i < *m; ++i) {
+ a[i + j * *lda] = 0.f;
+ }
+ }
+ }
+} /* sggsvp_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.f
new file mode 100644
index 0000000000000000000000000000000000000000..123179a7c1117f56d2d4ebe17e987bfb9f3e466c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sggsvp.f
@@ -0,0 +1,394 @@
+ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
+ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
+ $ IWORK, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
+ REAL TOLA, TOLB
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * )
+ REAL A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
+ $ TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SGGSVP computes orthogonal matrices U, V and Q such that
+*
+* N-K-L K L
+* U'*A*Q = K ( 0 A12 A13 ) if M-K-L >= 0;
+* L ( 0 0 A23 )
+* M-K-L ( 0 0 0 )
+*
+* N-K-L K L
+* = K ( 0 A12 A13 ) if M-K-L < 0;
+* M-K ( 0 0 A23 )
+*
+* N-K-L K L
+* V'*B*Q = L ( 0 0 B13 )
+* P-L ( 0 0 0 )
+*
+* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+* otherwise A23 is (M-K)-by-L upper trapezoidal. K+L = the effective
+* numerical rank of the (M+P)-by-N matrix (A',B')'. Z' denotes the
+* transpose of Z.
+*
+* This decomposition is the preprocessing step for computing the
+* Generalized Singular Value Decomposition (GSVD), see subroutine
+* SGGSVD.
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': Orthogonal matrix U is computed;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': Orthogonal matrix V is computed;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Orthogonal matrix Q is computed;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A contains the triangular (or trapezoidal) matrix
+* described in the Purpose section.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) REAL array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, B contains the triangular matrix described in
+* the Purpose section.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,P).
+*
+* TOLA (input) REAL
+* TOLB (input) REAL
+* TOLA and TOLB are the thresholds to determine the effective
+* numerical rank of matrix B and a subblock of A. Generally,
+* they are set to
+* TOLA = MAX(M,N)*norm(A)*MACHEPS,
+* TOLB = MAX(P,N)*norm(B)*MACHEPS.
+* The size of TOLA and TOLB may affect the size of backward
+* errors of the decomposition.
+*
+* K (output) INTEGER
+* L (output) INTEGER
+* On exit, K and L specify the dimension of the subblocks
+* described in Purpose.
+* K + L = effective numerical rank of (A',B')'.
+*
+* U (output) REAL array, dimension (LDU,M)
+* If JOBU = 'U', U contains the orthogonal matrix U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (output) REAL array, dimension (LDV,M)
+* If JOBV = 'V', V contains the orthogonal matrix V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (output) REAL array, dimension (LDQ,N)
+* If JOBQ = 'Q', Q contains the orthogonal matrix Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* IWORK (workspace) INTEGER array, dimension (N)
+*
+* TAU (workspace) REAL array, dimension (N)
+*
+* WORK (workspace) REAL array, dimension (max(3*N,M,P))
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+*
+* Further Details
+* ===============
+*
+* The subroutine uses LAPACK subroutine SGEQPF for the QR factorization
+* with column pivoting to detect the effective numerical rank of the
+* a matrix. It may be replaced by a better rank determination strategy.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FORWRD, WANTQ, WANTU, WANTV
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEQPF, SGEQR2, SGERQ2, SLACPY, SLAPMT, SLASET,
+ $ SORG2R, SORM2R, SORMR2, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ WANTU = LSAME( JOBU, 'U' )
+ WANTV = LSAME( JOBV, 'V' )
+ WANTQ = LSAME( JOBQ, 'Q' )
+ FORWRD = .TRUE.
+*
+ INFO = 0
+ IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -10
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -16
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -18
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -20
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGGSVP', -INFO )
+ RETURN
+ END IF
+*
+* QR with column pivoting of B: B*P = V*( S11 S12 )
+* ( 0 0 )
+*
+ DO 10 I = 1, N
+ IWORK( I ) = 0
+ 10 CONTINUE
+ CALL SGEQPF( P, N, B, LDB, IWORK, TAU, WORK, INFO )
+*
+* Update A := A*P
+*
+ CALL SLAPMT( FORWRD, M, N, A, LDA, IWORK )
+*
+* Determine the effective rank of matrix B.
+*
+ L = 0
+ DO 20 I = 1, MIN( P, N )
+ IF( ABS( B( I, I ) ).GT.TOLB )
+ $ L = L + 1
+ 20 CONTINUE
+*
+ IF( WANTV ) THEN
+*
+* Copy the details of V, and form V.
+*
+ CALL SLASET( 'Full', P, P, ZERO, ZERO, V, LDV )
+ IF( P.GT.1 )
+ $ CALL SLACPY( 'Lower', P-1, N, B( 2, 1 ), LDB, V( 2, 1 ),
+ $ LDV )
+ CALL SORG2R( P, P, MIN( P, N ), V, LDV, TAU, WORK, INFO )
+ END IF
+*
+* Clean up B
+*
+ DO 40 J = 1, L - 1
+ DO 30 I = J + 1, L
+ B( I, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ IF( P.GT.L )
+ $ CALL SLASET( 'Full', P-L, N, ZERO, ZERO, B( L+1, 1 ), LDB )
+*
+ IF( WANTQ ) THEN
+*
+* Set Q = I and Update Q := Q*P
+*
+ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+ CALL SLAPMT( FORWRD, N, N, Q, LDQ, IWORK )
+ END IF
+*
+ IF( P.GE.L .AND. N.NE.L ) THEN
+*
+* RQ factorization of (S11 S12): ( S11 S12 ) = ( 0 S12 )*Z
+*
+ CALL SGERQ2( L, N, B, LDB, TAU, WORK, INFO )
+*
+* Update A := A*Z'
+*
+ CALL SORMR2( 'Right', 'Transpose', M, N, L, B, LDB, TAU, A,
+ $ LDA, WORK, INFO )
+*
+ IF( WANTQ ) THEN
+*
+* Update Q := Q*Z'
+*
+ CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q,
+ $ LDQ, WORK, INFO )
+ END IF
+*
+* Clean up B
+*
+ CALL SLASET( 'Full', L, N-L, ZERO, ZERO, B, LDB )
+ DO 60 J = N - L + 1, N
+ DO 50 I = J - N + L + 1, L
+ B( I, J ) = ZERO
+ 50 CONTINUE
+ 60 CONTINUE
+*
+ END IF
+*
+* Let N-L L
+* A = ( A11 A12 ) M,
+*
+* then the following does the complete QR decomposition of A11:
+*
+* A11 = U*( 0 T12 )*P1'
+* ( 0 0 )
+*
+ DO 70 I = 1, N - L
+ IWORK( I ) = 0
+ 70 CONTINUE
+ CALL SGEQPF( M, N-L, A, LDA, IWORK, TAU, WORK, INFO )
+*
+* Determine the effective rank of A11
+*
+ K = 0
+ DO 80 I = 1, MIN( M, N-L )
+ IF( ABS( A( I, I ) ).GT.TOLA )
+ $ K = K + 1
+ 80 CONTINUE
+*
+* Update A12 := U'*A12, where A12 = A( 1:M, N-L+1:N )
+*
+ CALL SORM2R( 'Left', 'Transpose', M, L, MIN( M, N-L ), A, LDA,
+ $ TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
+*
+ IF( WANTU ) THEN
+*
+* Copy the details of U, and form U
+*
+ CALL SLASET( 'Full', M, M, ZERO, ZERO, U, LDU )
+ IF( M.GT.1 )
+ $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ),
+ $ LDU )
+ CALL SORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
+ END IF
+*
+ IF( WANTQ ) THEN
+*
+* Update Q( 1:N, 1:N-L ) = Q( 1:N, 1:N-L )*P1
+*
+ CALL SLAPMT( FORWRD, N, N-L, Q, LDQ, IWORK )
+ END IF
+*
+* Clean up A: set the strictly lower triangular part of
+* A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0.
+*
+ DO 100 J = 1, K - 1
+ DO 90 I = J + 1, K
+ A( I, J ) = ZERO
+ 90 CONTINUE
+ 100 CONTINUE
+ IF( M.GT.K )
+ $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA )
+*
+ IF( N-L.GT.K ) THEN
+*
+* RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1
+*
+ CALL SGERQ2( K, N-L, A, LDA, TAU, WORK, INFO )
+*
+ IF( WANTQ ) THEN
+*
+* Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1'
+*
+ CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU,
+ $ Q, LDQ, WORK, INFO )
+ END IF
+*
+* Clean up A
+*
+ CALL SLASET( 'Full', K, N-L-K, ZERO, ZERO, A, LDA )
+ DO 120 J = N - L - K + 1, N - L
+ DO 110 I = J - N + L + K + 1, K
+ A( I, J ) = ZERO
+ 110 CONTINUE
+ 120 CONTINUE
+*
+ END IF
+*
+ IF( M.GT.K ) THEN
+*
+* QR factorization of A( K+1:M,N-L+1:N )
+*
+ CALL SGEQR2( M-K, L, A( K+1, N-L+1 ), LDA, TAU, WORK, INFO )
+*
+ IF( WANTU ) THEN
+*
+* Update U(:,K+1:M) := U(:,K+1:M)*U1
+*
+ CALL SORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ),
+ $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU,
+ $ WORK, INFO )
+ END IF
+*
+* Clean up
+*
+ DO 140 J = N - L + 1, N
+ DO 130 I = J - N + K + L + 1, M
+ A( I, J ) = ZERO
+ 130 CONTINUE
+ 140 CONTINUE
+*
+ END IF
+*
+ RETURN
+*
+* End of SGGSVP
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sig_die.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sig_die.c
new file mode 100644
index 0000000000000000000000000000000000000000..c257eff837f7d3c44383ee2dc6e13a350d219dd9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sig_die.c
@@ -0,0 +1,17 @@
+#include "f2c.h"
+#include "netlib.h"
+#undef abs
+#undef min
+#undef max
+#include <stdio.h>
+#include <stdlib.h> /* for abort() */
+
+void sig_die(register const char *s, int kill)
+{
+ /* print error message, then clear buffers */
+ fprintf(stderr, "%s\n", s);
+
+ if (kill) {
+ abort();
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.c
new file mode 100644
index 0000000000000000000000000000000000000000..20a53823473bc2d5e63eab27bf37ddeb85c730c9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.c
@@ -0,0 +1,66 @@
+/* simpson.f -- translated by f2c (version 20020621). */
+#include "f2c.h"
+
+/* NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994 */
+/* To accompany the text: */
+/* NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992 */
+/* Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A. */
+/* This free software is complements of the author. */
+
+/* Algorithm 7.2 (Composite Simpson Rule). */
+/* Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365 */
+
+/* comment added by Kongbin Kang */
+/* F: integrand function */
+/* A: lower integration limit */
+/* B: higher integration limit */
+/* M: number of intervals. Notice, the subintervals used is 2M */
+/* Srule: output parameter to store simpson rule result */
+/* Subroutine */
+int simpru_(E_fp f, doublereal *a, doublereal *b, integer *m, doublereal *srule)
+{
+ /* Local variables */
+ static doublereal h__;
+ static integer k;
+ static doublereal x, sum, sumodd, sumeven;
+
+ h__ = (*b - *a) / (*m << 1);
+ sumeven = 0.f;
+ for (k = 1; k < *m; ++k) {
+ x = *a + h__ * (k << 1);
+ sumeven += (*f)(&x);
+ }
+ sumodd = 0.f;
+ for (k = 0; k < *m; ++k) {
+ x = *a + h__ * ((k << 1) + 1);
+ sumodd += (*f)(&x);
+ }
+ sum = h__ * ((*f)(a) + (*f)(b) + sumeven * 2 + sumodd * 4) / 3;
+ *srule = sum;
+ return 0;
+} /* simpru_ */
+
+/* Subroutine */
+int xsimpru_(E_fp f, doublereal *a, doublereal *b, integer *m, doublereal *srule)
+{
+ /* Local variables */
+ static doublereal h__;
+ static integer k;
+ static doublereal x, sum, sumodd, sumeven;
+
+/* This subroutine uses labeled DO loop(s). */
+ h__ = (*b - *a) / (*m << 1);
+ sumeven = 0.f;
+ for (k = 1; k < *m; ++k) {
+ x = *a + h__ * (k << 1);
+ sumeven += (*f)(&x);
+ }
+ sumodd = 0.f;
+ for (k = 0; k < *m; ++k) {
+ x = *a + h__ * ((k << 1) + 1);
+ sumodd += (*f)(&x);
+ }
+ sum = h__ * ((*f)(a) + (*f)(b) + sumeven * 2 + sumodd * 4) / 3;
+ *srule = sum;
+ return 0;
+} /* xsimpru_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.f
new file mode 100644
index 0000000000000000000000000000000000000000..b3fcb0ab0f1f82085ca64d923b654b7183110412
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/simpson.f
@@ -0,0 +1,59 @@
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.2 (Composite Simpson Rule).
+C Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365
+C
+
+C comment added by Kongbin Kang
+C F: integrand function
+C A: lower integration limit
+C B: higher integration limit
+C M: number of intervals. Notice, the subintervals used is 2M
+C Srule: output parameter to store simpson rule result
+
+ SUBROUTINE SIMPRU(F,A,B,M,Srule)
+ INTEGER K,M
+ REAL A,B,H,Sum,SumEven,SumOdd,Srule,X
+ EXTERNAL F
+ H=(B-A)/(2*M)
+ SumEven=0
+ DO K=1,(M-1)
+ X=A+H*2*K
+ SumEven=SumEven+F(X)
+ ENDDO
+ SumOdd=0
+ DO K=1,M
+ X=A+H*(2*K-1)
+ SumOdd=SumOdd+F(X)
+ ENDDO
+ Sum=H*(F(A)+F(B)+2*SumEven+4*SumOdd)/3
+ Srule=Sum
+ RETURN
+ END
+
+ SUBROUTINE XSIMPRU(F,A,B,M,Srule)
+C This subroutine uses labeled DO loop(s).
+ INTEGER K,M
+ REAL A,B,H,Sum,SumEven,SumOdd,Srule,X
+ EXTERNAL F
+ H=(B-A)/(2*M)
+ SumEven=0
+ DO 10 K=1,(M-1)
+ X=A+H*2*K
+ SumEven=SumEven+F(X)
+10 CONTINUE
+ SumOdd=0
+ DO 20 K=1,M
+ X=A+H*(2*K-1)
+ SumOdd=SumOdd+F(X)
+20 CONTINUE
+ Sum=H*(F(A)+F(B)+2*SumEven+4*SumOdd)/3
+ Srule=Sum
+ RETURN
+ END
+
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slabax.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabax.f
new file mode 100644
index 0000000000000000000000000000000000000000..6d7aeeeece410c74fe0b6b27dfa93b421def727c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabax.f
@@ -0,0 +1,41 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABAX(N, NBAND, A, X, Y)
+C
+C THIS SUBROUTINE SETS Y = A*X
+C WHERE X AND Y ARE VECTORS OF LENGTH N
+C AND A IS AN N X NBAND SYMMETRIC BAND MATRIX
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND
+ REAL A(NBAND,1), X(1), Y(1)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ REAL ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+C
+C SUBROUTINES CALLED
+C
+C SCOPY
+C
+ ZERO(1) = 0.0
+ CALL SCOPY(N, ZERO, 0, Y, 1)
+ DO 20 K = 1, N
+ Y(K) = Y(K) + A(1,K)*X(K)
+ M = MIN0(N-K+1, NBAND)
+ IF(M .LT. 2) GO TO 20
+ DO 10 I = 2, M
+ L = K + I - 1
+ Y(L) = Y(L) + A(I,K)*X(K)
+ Y(K) = Y(K) + A(I,K)*X(L)
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slabcm.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabcm.f
new file mode 100644
index 0000000000000000000000000000000000000000..826f65e891df8702804285e2a5ed384f56d3066e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabcm.f
@@ -0,0 +1,201 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABCM(N, NBAND, NL, NR, A, EIGVAL,
+ 1 LDE, EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+C
+C THIS SUBROUTINE ORGANIZES THE CALCULATION OF THE EIGENVALUES
+C FOR THE BNDEIG PACKAGE. EIGENVALUES ARE COMPUTED BY
+C A MODIFIED RAYLEIGH QUOTIENT ITERATION. THE EIGENVALUE COUNT
+C OBTAINED BY EACH FACTORIZATION IS USED TO OCCASIONALLY OVERRIDE
+C THE COMPUTED RAYLEIGH QUOTIENT WITH A DIFFERENT SHIFT TO
+C INSURE CONVERGENCE TO THE DESIRED EIGENVALUES.
+C
+C FORMAL PARAMETERS.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ REAL A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), ATOL, ARTOL, BOUND(2,1), ATEMP(1),
+ 2 D(1), VTEMP(1)
+C
+C
+C LOCAL VARIABLES
+C
+ LOGICAL FLAG
+ INTEGER I, J, L, M, NUML, NUMVEC, NVAL
+ REAL ERRB, GAP, RESID, RQ, SIGMA, VNORM
+C
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL AMAX1, AMIN1, SDOT, SNRM2
+C
+C SUBROUTINES CALLED
+C
+C SLABAX, SLABFC, SLARAN, SAXPY, SCOPY, SSCAL
+C
+C REPLACE ZERO VECTORS BY RANDOM
+C
+ NVAL = NR - NL + 1
+ FLAG = .FALSE.
+ DO 5 I = 1, NVAL
+ IF(SDOT(N, EIGVEC(1,I), 1, EIGVEC(1,I), 1) .EQ. 0.0 )
+ 1 CALL SLARAN(N,EIGVEC(1,I))
+ 5 CONTINUE
+C
+C LOOP OVER EIGENVALUES
+C
+ SIGMA = BOUND(2,NVAL+1)
+ DO 400 J = 1, NVAL
+ NUML = J
+C
+C PREPARE TO COMPUTE FIRST RAYLEIGH QUOTIENT
+C
+ 10 CALL SLABAX(N, NBAND, A, EIGVEC(1,J), VTEMP)
+ VNORM = SNRM2(N, VTEMP, 1)
+ IF(VNORM .EQ. 0.0 ) GO TO 20
+ CALL SSCAL(N, 1.0 /VNORM, VTEMP, 1)
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+ CALL SAXPY(N, -SIGMA, EIGVEC(1,J), 1, VTEMP, 1)
+C
+C LOOP OVER SHIFTS
+C
+C COMPUTE RAYLEIGH QUOTIENT, RESIDUAL NORM, AND CURRENT TOLERANCE
+C
+ 20 VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0 ) GO TO 30
+ CALL SLARAN(N, EIGVEC(1,J))
+ GO TO 10
+C
+ 30 RQ = SIGMA + SDOT(N, EIGVEC(1,J), 1, VTEMP, 1)
+ 1 /VNORM/VNORM
+ CALL SAXPY(N, SIGMA-RQ, EIGVEC(1,J), 1, VTEMP, 1)
+ RESID = AMAX1(ATOL, SNRM2(N, VTEMP, 1)/VNORM)
+ CALL SSCAL(N, 1.0/VNORM, EIGVEC(1,J), 1)
+C
+C ACCEPT EIGENVALUE IF THE INTERVAL IS SMALL ENOUGH
+C
+ IF(BOUND(2,J+1) - BOUND(1,J+1) .LT. 3.0 *ATOL) GO TO 300
+C
+C COMPUTE MINIMAL ERROR BOUND
+C
+ ERRB = RESID
+ GAP = AMIN1(BOUND(1,J+2) - RQ, RQ - BOUND(2,J))
+ IF(GAP .GT. RESID) ERRB = AMAX1(ATOL, RESID*RESID/GAP)
+C
+C TENTATIVE NEW SHIFT
+C
+ SIGMA = 0.5 *(BOUND(1,J+1) + BOUND(2,J+1))
+C
+C CHECK FOR TERMINALTION
+C
+ IF(RESID .GT. 2.0 *ATOL) GO TO 40
+ IF(RQ - ERRB .GT. BOUND(2,J) .AND.
+ 1 RQ + ERRB .LT. BOUND(1,J+2)) GO TO 310
+C
+C RQ IS TO THE LEFT OF THE INTERVAL
+C
+ 40 IF(RQ .GE. BOUND(1,J+1)) GO TO 50
+ IF(RQ - ERRB .GT. BOUND(2,J)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+1)) CALL SLARAN(N,EIGVEC(1,J))
+ GO TO 200
+C
+C RQ IS TO THE RIGHT OF THE INTERVAL
+C
+ 50 IF(RQ .LE. BOUND(2,J+1)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+2)) GO TO 100
+C
+C SAVE THE REJECTED VECTOR IF INDICATED
+C
+ IF(RQ - ERRB .LE. BOUND(2,J+1)) GO TO 200
+ DO 60 I = J, NVAL
+ IF(BOUND(2,I+1) .GT. RQ) GO TO 70
+ 60 CONTINUE
+ GO TO 80
+C
+ 70 CALL SCOPY(N, EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+C
+ 80 CALL SLARAN(N, EIGVEC(1,J))
+ GO TO 200
+C
+C PERTURB RQ TOWARD THE MIDDLE
+C
+ 100 IF(SIGMA .LT. RQ) SIGMA = AMAX1(SIGMA, RQ-ERRB)
+ IF(SIGMA .GT. RQ) SIGMA = AMIN1(SIGMA, RQ+ERRB)
+C
+C FACTOR AND SOLVE
+C
+ 200 DO 210 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 220
+ 210 CONTINUE
+ I = NVAL + 1
+ 220 NUMVEC = I - J
+ NUMVEC = MIN0(NUMVEC, NBAND + 2)
+ IF(RESID .LT. ARTOL) NUMVEC = MIN0(1,NUMVEC)
+ CALL SCOPY(N, EIGVEC(1,J), 1, VTEMP, 1)
+ CALL SLABFC(N, NBAND, A, SIGMA, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+C
+C PARTIALLY SCALE EXTRA VECTORS TO PREVENT UNDERFLOW OR OVERFLOW
+C
+ IF(NUMVEC .EQ. 1) GO TO 227
+ L = NUMVEC - 1
+ DO 225 I = 1,L
+ M = J + I
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,M), 1)
+ 225 CONTINUE
+C
+C UPDATE INTERVALS
+C
+ 227 NUML = NUML - NL + 1
+ IF(NUML .GE. 0) BOUND(2,1) = AMIN1(BOUND(2,1), SIGMA)
+ DO 230 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 20
+ IF(NUML .LT. I) BOUND(1,I+1) = SIGMA
+ IF(NUML .GE. I) BOUND(2,I+1) = SIGMA
+ 230 CONTINUE
+ IF(NUML .LT. NVAL + 1) BOUND(1,NVAL+2) = AMAX1(SIGMA,
+ 1 BOUND(1,NVAL+2))
+ GO TO 20
+C
+C ACCEPT AN EIGENPAIR
+C
+ 300 CALL SLARAN(N, EIGVEC(1,J))
+ FLAG = .TRUE.
+ GO TO 310
+C
+ 305 FLAG = .FALSE.
+ RQ = 0.5 *(BOUND(1,J+1) + BOUND(2,J+1))
+ CALL SLABFC(N, NBAND, A, RQ, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+ VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0) CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE THE NEW EIGENVECTOR AGAINST THE OLD ONES
+C
+ 310 EIGVAL(J) = RQ
+ IF(J .EQ. 1) GO TO 330
+ M = J - 1
+ DO 320 I = 1, M
+ CALL SAXPY(N, -SDOT(N,EIGVEC(1,I),1,EIGVEC(1,J),1),
+ 1 EIGVEC(1,I), 1, EIGVEC(1,J), 1)
+ 320 CONTINUE
+ 330 VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .EQ. 0.0 ) GO TO 305
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE LATER VECTORS AGAINST THE CONVERGED ONE
+C
+ IF(FLAG) GO TO 305
+ IF(J .EQ. NVAL) RETURN
+ M = J + 1
+ DO 340 I = M, NVAL
+ CALL SAXPY(N, -SDOT(N,EIGVEC(1,J),1,EIGVEC(1,I),1),
+ 1 EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+ 340 CONTINUE
+ 400 CONTINUE
+ RETURN
+C
+ 500 CONTINUE
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slabfc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabfc.f
new file mode 100644
index 0000000000000000000000000000000000000000..a61d95c5d8fb2709f08e770b448ffa42291e4b2f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slabfc.f
@@ -0,0 +1,131 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABFC(N, NBAND, A, SIGMA, NUMBER, LDE,
+ 1 EIGVEC, NUML, LDAD, ATEMP, D, ATOL)
+C
+C THIS SUBROUTINE FACTORS (A-SIGMA*I) WHERE A IS A GIVEN BAND
+C MATRIX AND SIGMA IS AN INPUT PARAMETER. IT ALSO SOLVES ZERO
+C OR MORE SYSTEMS OF LINEAR EQUATIONS. IT RETURNS THE NUMBER
+C OF EIGENVALUES OF A LESS THAN SIGMA BY COUNTING THE STURM
+C SEQUENCE DURING THE FACTORIZATION. TO OBTAIN THE STURM
+C SEQUENCE COUNT WHILE ALLOWING NON-SYMMETRIC PIVOTING FOR
+C STABILITY, THE CODE USES A GUPTA'S MULTIPLE PIVOTING
+C ALGORITHM.
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NUMBER, LDE, NUML, LDAD
+ REAL A(NBAND,1), SIGMA, EIGVEC(LDE,1),
+ 1 ATEMP(LDAD,1), D(LDAD,1), ATOL
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, J, K, KK, L, LA, LD, LPM, M, NB1
+ REAL ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL ABS
+C
+C SUBROUTINES CALLED
+C
+C SAXPY, SCOPY, SSWAP
+C
+C
+C INITIALIZE
+C
+ ZERO(1) = 0.0
+ NB1 = NBAND - 1
+ NUML = 0
+ CALL SCOPY(LDAD*NBAND, ZERO, 0, D, 1)
+C
+C LOOP OVER COLUMNS OF A
+C
+ DO 100 K = 1, N
+C
+C ADD A COLUMN OF A TO D
+C
+ D(NBAND, NBAND) = A(1,K) - SIGMA
+ M = MIN0(K, NBAND) - 1
+ IF(M .EQ. 0) GO TO 20
+ DO 10 I = 1, M
+ LA = K - I
+ LD = NBAND - I
+ D(LD,NBAND) = A(I+1, LA)
+ 10 CONTINUE
+C
+ 20 M = MIN0(N-K, NB1)
+ IF(M .EQ. 0) GO TO 40
+ DO 30 I = 1, M
+ LD = NBAND + I
+ D(LD, NBAND) = A(I+1, K)
+ 30 CONTINUE
+C
+C TERMINATE
+C
+ 40 LPM = 1
+ IF(NB1 .EQ. 0) GO TO 70
+ DO 60 I = 1, NB1
+ L = K - NBAND + I
+ IF(D(I,NBAND) .EQ. 0.0 ) GO TO 60
+ IF(ABS(D(I,I)) .GE. ABS(D(I,NBAND))) GO TO 50
+ IF((D(I,NBAND) .LT. 0.0 .AND. D(I,I) .LT. 0.0 )
+ 1 .OR. (D(I,NBAND) .GT. 0.0 .AND. D(I,I) .GE. 0.0 ))
+ 2 LPM = -LPM
+ CALL SSWAP(LDAD-I+1, D(I,I), 1, D(I,NBAND), 1)
+ CALL SSWAP(NUMBER, EIGVEC(L,1), LDE, EIGVEC(K,1), LDE)
+ 50 CALL SAXPY(LDAD-I, -D(I,NBAND)/D(I,I), D(I+1,I), 1,
+ 1 D(I+1,NBAND), 1)
+ CALL SAXPY(NUMBER, -D(I,NBAND)/D(I,I), EIGVEC(L,1),
+ 1 LDE, EIGVEC(K,1), LDE)
+ 60 CONTINUE
+C
+C UPDATE STURM SEQUENCE COUNT
+C
+ 70 IF(D(NBAND,NBAND) .LT. 0.0 ) LPM = -LPM
+ IF(LPM .LT. 0) NUML = NUML + 1
+ IF(K .EQ. N) GO TO 110
+C
+C COPY FIRST COLUMN OF D INTO ATEMP
+ IF(K .LT. NBAND) GO TO 80
+ L = K - NB1
+ CALL SCOPY(LDAD, D, 1, ATEMP(1,L), 1)
+C
+C SHIFT THE COLUMNS OF D OVER AND UP
+C
+ IF(NB1 .EQ. 0) GO TO 100
+ 80 DO 90 I = 1, NB1
+ CALL SCOPY(LDAD-I, D(I+1,I+1), 1, D(I,I), 1)
+ D(LDAD,I) = 0.0
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C TRANSFER D TO ATEMP
+C
+ 110 DO 120 I = 1, NBAND
+ L = N - NBAND + I
+ CALL SCOPY(NBAND-I+1, D(I,I), 1, ATEMP(1,L), 1)
+ 120 CONTINUE
+C
+C BACK SUBSTITUTION
+C
+ IF(NUMBER .EQ. 0) RETURN
+ DO 160 KK = 1, N
+ K = N - KK + 1
+ IF(ABS(ATEMP(1,K)) .LE. ATOL)
+ 1 ATEMP(1,K) = SIGN(ATOL,ATEMP(1,K))
+C
+ 130 DO 150 I = 1, NUMBER
+ EIGVEC(K,I) = EIGVEC(K,I)/ATEMP(1,K)
+ M = MIN0(LDAD, K) - 1
+ IF(M .EQ. 0) GO TO 150
+ DO 140 J = 1, M
+ L = K - J
+ EIGVEC(L,I) = EIGVEC(L,I) - ATEMP(J+1,L)*EIGVEC(K,I)
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..0c012c5d4b8db93d35891df4213e08baabdbb8e0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.c
@@ -0,0 +1,71 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slacpy_(const char *uplo, const integer *m, const integer *n,
+ real *a, const integer *lda, real *b, const integer *ldb)
+{
+ /* Local variables */
+ static integer i, j;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLACPY copies all or part of a two-dimensional matrix A to another */
+/* matrix B. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be copied to B. */
+/* = 'U': Upper triangular part */
+/* = 'L': Lower triangular part */
+/* Otherwise: All of the matrix A */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input) REAL array, dimension (LDA,N) */
+/* The m by n matrix A. If UPLO = 'U', only the upper triangle */
+/* or trapezoid is accessed; if UPLO = 'L', only the lower */
+/* triangle or trapezoid is accessed. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (output) REAL array, dimension (LDB,N) */
+/* On exit, B = A in the locations specified by UPLO. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j && i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ } else if (lsame_(uplo, "L")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ b[i + j * *ldb] = a[i + j * *lda];
+ }
+ }
+ }
+} /* slacpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..ac8ba3f9f7537407df1c88d6e939bb52b1194b40
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slacpy.f
@@ -0,0 +1,88 @@
+ SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDB, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLACPY copies all or part of a two-dimensional matrix A to another
+* matrix B.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be copied to B.
+* = 'U': Upper triangular part
+* = 'L': Lower triangular part
+* Otherwise: All of the matrix A
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input) REAL array, dimension (LDA,N)
+* The m by n matrix A. If UPLO = 'U', only the upper triangle
+* or trapezoid is accessed; if UPLO = 'L', only the lower
+* triangle or trapezoid is accessed.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (output) REAL array, dimension (LDB,N)
+* On exit, B = A in the locations specified by UPLO.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 20 J = 1, N
+ DO 10 I = 1, MIN( J, M )
+ B( I, J ) = A( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+ DO 40 J = 1, N
+ DO 30 I = J, M
+ B( I, J ) = A( I, J )
+ 30 CONTINUE
+ 40 CONTINUE
+ ELSE
+ DO 60 J = 1, N
+ DO 50 I = 1, M
+ B( I, J ) = A( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+ RETURN
+*
+* End of SLACPY
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slaeig.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaeig.f
new file mode 100644
index 0000000000000000000000000000000000000000..25b3ef02acbc0b85b0551b6d50bf82bf96434e64
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaeig.f
@@ -0,0 +1,53 @@
+ SUBROUTINE SLAEIG(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+C
+C THIS IS A SPECIALIZED VERSION OF THE SUBROUTINE BNDEIG TAILORED
+C SPECIFICALLY FOR USE BY THE LASO PACKAGE.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ REAL A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), BOUND(2,1), ATEMP(1), D(1), VTEMP(1),
+ 2 EPS, TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, M, NVAL
+ REAL ARTOL, ATOL
+C
+C FUNCTIONS CALLED
+C
+ REAL AMAX1
+C
+C SUBROUTINES CALLED
+C
+C SLABCM, SLABFC, SLAGER, SCOPY
+C
+C SET PARAMETERS
+C
+ ATOL = FLOAT(N)*EPS*AMAX1(TMAX,-TMIN)
+ ARTOL = ATOL/SQRT(EPS)
+ NVAL = NR - NL + 1
+C
+C CHECK FOR SPECIAL CASE OF N = 1
+C
+ IF(N .NE. 1) GO TO 30
+ EIGVAL(1) = A(1,1)
+ EIGVEC(1,1) = 1.0
+ RETURN
+C
+C SET UP INITIAL EIGENVALUE BOUNDS
+C
+ 30 M = NVAL + 1
+ DO 50 I = 2, M
+ BOUND(1,I) = TMIN
+ BOUND(2,I) = TMAX
+ 50 CONTINUE
+ BOUND(2,1) = TMAX
+ BOUND(1,NVAL + 2) = TMIN
+ IF(NL .EQ. 1) BOUND(2,1) = TMIN
+ IF(NR .EQ. N) BOUND(1,NVAL + 2) = TMAX
+C
+ 60 CALL SLABCM(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slager.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slager.f
new file mode 100644
index 0000000000000000000000000000000000000000..039f48b5d237c5feca6dca2b922ed63b2ab2f90d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slager.f
@@ -0,0 +1,40 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLAGER(N, NBAND, NSTART, A, TMIN, TMAX)
+C
+C THIS SUBROUTINE COMPUTES BOUNDS ON THE SPECTRUM OF A BY
+C EXAMINING THE GERSCHGORIN CIRCLES. ONLY THE NEWLY CREATED
+C CIRCLES ARE EXAMINED
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NSTART
+ REAL A(NBAND,1), TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ REAL TEMP
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL AMIN1, AMAX1
+C
+ DO 50 K = NSTART, N
+ TEMP = 0.0
+ DO 10 I = 2, NBAND
+ TEMP = TEMP + ABS(A(I,K))
+ 10 CONTINUE
+ 20 L = MIN0(K,NBAND)
+ IF(L .EQ. 1) GO TO 40
+ DO 30 I = 2, L
+ M = K - I + 1
+ TEMP = TEMP + ABS(A(I,M))
+ 30 CONTINUE
+ 40 TMIN = AMIN1(TMIN, A(1,K)-TEMP)
+ TMAX = AMAX1(TMAX, A(1,K)+TEMP)
+ 50 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.c
new file mode 100644
index 0000000000000000000000000000000000000000..2bad60e06c9afef33926ca7b3d4bee901ea3a7f2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.c
@@ -0,0 +1,250 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slags2_(logical *upper, real *a1, real *a2, real *a3,
+ real *b1, real *b2, real *b3, real *csu, real *snu,
+ real *csv, real *snv, real *csq, real *snq)
+{
+ /* System generated locals */
+ real r__1;
+
+ /* Local variables */
+ static real aua11, aua12, aua21, aua22, avb11, avb12, avb21, avb22,
+ ua11r, ua22r, vb11r, vb22r, a, b, c, d, r, s1, s2;
+ static real ua11, ua12, ua21, ua22, vb11, vb12, vb21, vb22, csl, csr, snl, snr;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such */
+/* that if ( UPPER ) then */
+/* */
+/* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 ) */
+/* ( 0 A3 ) ( x x ) */
+/* and */
+/* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 ) */
+/* ( 0 B3 ) ( x x ) */
+/* */
+/* or if ( .NOT.UPPER ) then */
+/* */
+/* U'*A*Q = U'*( A1 0 )*Q = ( x x ) */
+/* ( A2 A3 ) ( 0 x ) */
+/* and */
+/* V'*B*Q = V'*( B1 0 )*Q = ( x x ) */
+/* ( B2 B3 ) ( 0 x ) */
+/* */
+/* The rows of the transformed A and B are parallel, where */
+/* */
+/* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ ) */
+/* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ ) */
+/* */
+/* Z' denotes the transpose of Z. */
+/* */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPPER (input) LOGICAL */
+/* = .TRUE.: the input matrices A and B are upper triangular. */
+/* = .FALSE.: the input matrices A and B are lower triangular. */
+/* */
+/* A1 (input) REAL */
+/* A2 (input) REAL */
+/* A3 (input) REAL */
+/* On entry, A1, A2 and A3 are elements of the input 2-by-2 */
+/* upper (lower) triangular matrix A. */
+/* */
+/* B1 (input) REAL */
+/* B2 (input) REAL */
+/* B3 (input) REAL */
+/* On entry, B1, B2 and B3 are elements of the input 2-by-2 */
+/* upper (lower) triangular matrix B. */
+/* */
+/* CSU (output) REAL */
+/* SNU (output) REAL */
+/* The desired orthogonal matrix U. */
+/* */
+/* CSV (output) REAL */
+/* SNV (output) REAL */
+/* The desired orthogonal matrix V. */
+/* */
+/* CSQ (output) REAL */
+/* SNQ (output) REAL */
+/* The desired orthogonal matrix Q. */
+/* */
+/* ===================================================================== */
+
+ if (*upper) {
+
+/* Input matrices A and B are upper triangular matrices */
+
+/* Form matrix C = A*adj(B) = ( a b ) */
+/* ( 0 d ) */
+
+ a = *a1 * *b3;
+ d = *a3 * *b1;
+ b = *a2 * *b1 - *a1 * *b2;
+
+/* The SVD of real 2-by-2 triangular C */
+
+/* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 ) */
+/* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T ) */
+
+ slasv2_(&a, &b, &d, &s1, &s2, &snr, &csr, &snl, &csl);
+
+ if (abs(csl) >= abs(snl) || abs(csr) >= abs(snr)) {
+
+/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, */
+/* and (1,2) element of |U|'*|A| and |V|'*|B|. */
+
+ ua11r = csl * *a1;
+ ua12 = csl * *a2 + snl * *a3;
+
+ vb11r = csr * *b1;
+ vb12 = csr * *b2 + snr * *b3;
+
+ aua12 = abs(csl) * abs(*a2) + abs(snl) * abs(*a3);
+ avb12 = abs(csr) * abs(*b2) + abs(snr) * abs(*b3);
+
+/* zero (1,2) elements of U'*A and V'*B */
+
+ if (abs(ua11r) + abs(ua12) != 0.f) {
+ if (aua12 / (abs(ua11r) + abs(ua12)) <= avb12 / (abs(vb11r) + abs(vb12))) {
+ r__1 = -ua11r;
+ slartg_(&r__1, &ua12, csq, snq, &r);
+ } else {
+ r__1 = -vb11r;
+ slartg_(&r__1, &vb12, csq, snq, &r);
+ }
+ } else {
+ r__1 = -vb11r;
+ slartg_(&r__1, &vb12, csq, snq, &r);
+ }
+
+ *csu = csl;
+ *snu = -snl;
+ *csv = csr;
+ *snv = -snr;
+
+ } else {
+
+/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, */
+/* and (2,2) element of |U|'*|A| and |V|'*|B|. */
+
+ ua21 = -snl * *a1;
+ ua22 = -snl * *a2 + csl * *a3;
+
+ vb21 = -snr * *b1;
+ vb22 = -snr * *b2 + csr * *b3;
+
+ aua22 = abs(snl) * abs(*a2) + abs(csl) * abs(*a3);
+ avb22 = abs(snr) * abs(*b2) + abs(csr) * abs(*b3);
+
+/* zero (2,2) elements of U'*A and V'*B, and then swap. */
+
+ if (abs(ua21) + abs(ua22) != 0.f) {
+ if (aua22 / (abs(ua21) + abs(ua22)) <= avb22 / (abs(vb21) + abs(vb22))) {
+ r__1 = -ua21;
+ slartg_(&r__1, &ua22, csq, snq, &r);
+ } else {
+ r__1 = -vb21;
+ slartg_(&r__1, &vb22, csq, snq, &r);
+ }
+ } else {
+ r__1 = -vb21;
+ slartg_(&r__1, &vb22, csq, snq, &r);
+ }
+
+ *csu = snl;
+ *snu = csl;
+ *csv = snr;
+ *snv = csr;
+ }
+
+ } else {
+
+/* Input matrices A and B are lower triangular matrices */
+
+/* Form matrix C = A*adj(B) = ( a 0 ) */
+/* ( c d ) */
+
+ a = *a1 * *b3;
+ d = *a3 * *b1;
+ c = *a2 * *b3 - *a3 * *b2;
+
+/* The SVD of real 2-by-2 triangular C */
+
+/* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 ) */
+/* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T ) */
+
+ slasv2_(&a, &c, &d, &s1, &s2, &snr, &csr, &snl, &csl);
+
+ if (abs(csr) >= abs(snr) || abs(csl) >= abs(snl)) {
+
+/* Compute the (2,1) and (2,2) elements of U'*A and V'*B, */
+/* and (2,1) element of |U|'*|A| and |V|'*|B|. */
+
+ ua21 = -snr * *a1 + csr * *a2;
+ ua22r = csr * *a3;
+
+ vb21 = -snl * *b1 + csl * *b2;
+ vb22r = csl * *b3;
+
+ aua21 = abs(snr) * abs(*a1) + abs(csr) * abs(*a2);
+ avb21 = abs(snl) * abs(*b1) + abs(csl) * abs(*b2);
+
+/* zero (2,1) elements of U'*A and V'*B. */
+
+ if (abs(ua21) + abs(ua22r) != 0.f) {
+ if (aua21 / (abs(ua21) + abs(ua22r)) <= avb21 / (abs(vb21) + abs(vb22r))) {
+ slartg_(&ua22r, &ua21, csq, snq, &r);
+ } else {
+ slartg_(&vb22r, &vb21, csq, snq, &r);
+ }
+ } else {
+ slartg_(&vb22r, &vb21, csq, snq, &r);
+ }
+
+ *csu = csr;
+ *snu = -snr;
+ *csv = csl;
+ *snv = -snl;
+
+ } else {
+
+/* Compute the (1,1) and (1,2) elements of U'*A and V'*B, */
+/* and (1,1) element of |U|'*|A| and |V|'*|B|. */
+
+ ua11 = csr * *a1 + snr * *a2;
+ ua12 = snr * *a3;
+
+ vb11 = csl * *b1 + snl * *b2;
+ vb12 = snl * *b3;
+
+ aua11 = abs(csr) * abs(*a1) + abs(snr) * abs(*a2);
+ avb11 = abs(csl) * abs(*b1) + abs(snl) * abs(*b2);
+
+/* zero (1,1) elements of U'*A and V'*B, and then swap. */
+
+ if (abs(ua11) + abs(ua12) != 0.f) {
+ if (aua11 / (abs(ua11) + abs(ua12)) <= avb11 / (abs(vb11) + abs(vb12))) {
+ slartg_(&ua12, &ua11, csq, snq, &r);
+ } else {
+ slartg_(&vb12, &vb11, csq, snq, &r);
+ }
+ } else {
+ slartg_(&vb12, &vb11, csq, snq, &r);
+ }
+
+ *csu = snr;
+ *snu = csr;
+ *csv = snl;
+ *snv = csl;
+ }
+ }
+} /* slags2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.f
new file mode 100644
index 0000000000000000000000000000000000000000..e6f0e6bd799cb9d1c28d160dcda332ac5f2d6cdf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slags2.f
@@ -0,0 +1,270 @@
+ SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV,
+ $ SNV, CSQ, SNQ )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ LOGICAL UPPER
+ REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, SNQ,
+ $ SNU, SNV
+* ..
+*
+* Purpose
+* =======
+*
+* SLAGS2 computes 2-by-2 orthogonal matrices U, V and Q, such
+* that if ( UPPER ) then
+*
+* U'*A*Q = U'*( A1 A2 )*Q = ( x 0 )
+* ( 0 A3 ) ( x x )
+* and
+* V'*B*Q = V'*( B1 B2 )*Q = ( x 0 )
+* ( 0 B3 ) ( x x )
+*
+* or if ( .NOT.UPPER ) then
+*
+* U'*A*Q = U'*( A1 0 )*Q = ( x x )
+* ( A2 A3 ) ( 0 x )
+* and
+* V'*B*Q = V'*( B1 0 )*Q = ( x x )
+* ( B2 B3 ) ( 0 x )
+*
+* The rows of the transformed A and B are parallel, where
+*
+* U = ( CSU SNU ), V = ( CSV SNV ), Q = ( CSQ SNQ )
+* ( -SNU CSU ) ( -SNV CSV ) ( -SNQ CSQ )
+*
+* Z' denotes the transpose of Z.
+*
+*
+* Arguments
+* =========
+*
+* UPPER (input) LOGICAL
+* = .TRUE.: the input matrices A and B are upper triangular.
+* = .FALSE.: the input matrices A and B are lower triangular.
+*
+* A1 (input) REAL
+* A2 (input) REAL
+* A3 (input) REAL
+* On entry, A1, A2 and A3 are elements of the input 2-by-2
+* upper (lower) triangular matrix A.
+*
+* B1 (input) REAL
+* B2 (input) REAL
+* B3 (input) REAL
+* On entry, B1, B2 and B3 are elements of the input 2-by-2
+* upper (lower) triangular matrix B.
+*
+* CSU (output) REAL
+* SNU (output) REAL
+* The desired orthogonal matrix U.
+*
+* CSV (output) REAL
+* SNV (output) REAL
+* The desired orthogonal matrix V.
+*
+* CSQ (output) REAL
+* SNQ (output) REAL
+* The desired orthogonal matrix Q.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ REAL A, AUA11, AUA12, AUA21, AUA22, AVB11, AVB12,
+ $ AVB21, AVB22, CSL, CSR, D, S1, S2, SNL,
+ $ SNR, UA11R, UA22R, VB11R, VB22R, B, C, R, UA11,
+ $ UA12, UA21, UA22, VB11, VB12, VB21, VB22
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARTG, SLASV2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( UPPER ) THEN
+*
+* Input matrices A and B are upper triangular matrices
+*
+* Form matrix C = A*adj(B) = ( a b )
+* ( 0 d )
+*
+ A = A1*B3
+ D = A3*B1
+ B = A2*B1 - A1*B2
+*
+* The SVD of real 2-by-2 triangular C
+*
+* ( CSL -SNL )*( A B )*( CSR SNR ) = ( R 0 )
+* ( SNL CSL ) ( 0 D ) ( -SNR CSR ) ( 0 T )
+*
+ CALL SLASV2( A, B, D, S1, S2, SNR, CSR, SNL, CSL )
+*
+ IF( ABS( CSL ).GE.ABS( SNL ) .OR. ABS( CSR ).GE.ABS( SNR ) )
+ $ THEN
+*
+* Compute the (1,1) and (1,2) elements of U'*A and V'*B,
+* and (1,2) element of |U|'*|A| and |V|'*|B|.
+*
+ UA11R = CSL*A1
+ UA12 = CSL*A2 + SNL*A3
+*
+ VB11R = CSR*B1
+ VB12 = CSR*B2 + SNR*B3
+*
+ AUA12 = ABS( CSL )*ABS( A2 ) + ABS( SNL )*ABS( A3 )
+ AVB12 = ABS( CSR )*ABS( B2 ) + ABS( SNR )*ABS( B3 )
+*
+* zero (1,2) elements of U'*A and V'*B
+*
+ IF( ( ABS( UA11R )+ABS( UA12 ) ).NE.ZERO ) THEN
+ IF( AUA12 / ( ABS( UA11R )+ABS( UA12 ) ).LE.AVB12 /
+ $ ( ABS( VB11R )+ABS( VB12 ) ) ) THEN
+ CALL SLARTG( -UA11R, UA12, CSQ, SNQ, R )
+ ELSE
+ CALL SLARTG( -VB11R, VB12, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL SLARTG( -VB11R, VB12, CSQ, SNQ, R )
+ END IF
+*
+ CSU = CSL
+ SNU = -SNL
+ CSV = CSR
+ SNV = -SNR
+*
+ ELSE
+*
+* Compute the (2,1) and (2,2) elements of U'*A and V'*B,
+* and (2,2) element of |U|'*|A| and |V|'*|B|.
+*
+ UA21 = -SNL*A1
+ UA22 = -SNL*A2 + CSL*A3
+*
+ VB21 = -SNR*B1
+ VB22 = -SNR*B2 + CSR*B3
+*
+ AUA22 = ABS( SNL )*ABS( A2 ) + ABS( CSL )*ABS( A3 )
+ AVB22 = ABS( SNR )*ABS( B2 ) + ABS( CSR )*ABS( B3 )
+*
+* zero (2,2) elements of U'*A and V'*B, and then swap.
+*
+ IF( ( ABS( UA21 )+ABS( UA22 ) ).NE.ZERO ) THEN
+ IF( AUA22 / ( ABS( UA21 )+ABS( UA22 ) ).LE.AVB22 /
+ $ ( ABS( VB21 )+ABS( VB22 ) ) ) THEN
+ CALL SLARTG( -UA21, UA22, CSQ, SNQ, R )
+ ELSE
+ CALL SLARTG( -VB21, VB22, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL SLARTG( -VB21, VB22, CSQ, SNQ, R )
+ END IF
+*
+ CSU = SNL
+ SNU = CSL
+ CSV = SNR
+ SNV = CSR
+*
+ END IF
+*
+ ELSE
+*
+* Input matrices A and B are lower triangular matrices
+*
+* Form matrix C = A*adj(B) = ( a 0 )
+* ( c d )
+*
+ A = A1*B3
+ D = A3*B1
+ C = A2*B3 - A3*B2
+*
+* The SVD of real 2-by-2 triangular C
+*
+* ( CSL -SNL )*( A 0 )*( CSR SNR ) = ( R 0 )
+* ( SNL CSL ) ( C D ) ( -SNR CSR ) ( 0 T )
+*
+ CALL SLASV2( A, C, D, S1, S2, SNR, CSR, SNL, CSL )
+*
+ IF( ABS( CSR ).GE.ABS( SNR ) .OR. ABS( CSL ).GE.ABS( SNL ) )
+ $ THEN
+*
+* Compute the (2,1) and (2,2) elements of U'*A and V'*B,
+* and (2,1) element of |U|'*|A| and |V|'*|B|.
+*
+ UA21 = -SNR*A1 + CSR*A2
+ UA22R = CSR*A3
+*
+ VB21 = -SNL*B1 + CSL*B2
+ VB22R = CSL*B3
+*
+ AUA21 = ABS( SNR )*ABS( A1 ) + ABS( CSR )*ABS( A2 )
+ AVB21 = ABS( SNL )*ABS( B1 ) + ABS( CSL )*ABS( B2 )
+*
+* zero (2,1) elements of U'*A and V'*B.
+*
+ IF( ( ABS( UA21 )+ABS( UA22R ) ).NE.ZERO ) THEN
+ IF( AUA21 / ( ABS( UA21 )+ABS( UA22R ) ).LE.AVB21 /
+ $ ( ABS( VB21 )+ABS( VB22R ) ) ) THEN
+ CALL SLARTG( UA22R, UA21, CSQ, SNQ, R )
+ ELSE
+ CALL SLARTG( VB22R, VB21, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL SLARTG( VB22R, VB21, CSQ, SNQ, R )
+ END IF
+*
+ CSU = CSR
+ SNU = -SNR
+ CSV = CSL
+ SNV = -SNL
+*
+ ELSE
+*
+* Compute the (1,1) and (1,2) elements of U'*A and V'*B,
+* and (1,1) element of |U|'*|A| and |V|'*|B|.
+*
+ UA11 = CSR*A1 + SNR*A2
+ UA12 = SNR*A3
+*
+ VB11 = CSL*B1 + SNL*B2
+ VB12 = SNL*B3
+*
+ AUA11 = ABS( CSR )*ABS( A1 ) + ABS( SNR )*ABS( A2 )
+ AVB11 = ABS( CSL )*ABS( B1 ) + ABS( SNL )*ABS( B2 )
+*
+* zero (1,1) elements of U'*A and V'*B, and then swap.
+*
+ IF( ( ABS( UA11 )+ABS( UA12 ) ).NE.ZERO ) THEN
+ IF( AUA11 / ( ABS( UA11 )+ABS( UA12 ) ).LE.AVB11 /
+ $ ( ABS( VB11 )+ABS( VB12 ) ) ) THEN
+ CALL SLARTG( UA12, UA11, CSQ, SNQ, R )
+ ELSE
+ CALL SLARTG( VB12, VB11, CSQ, SNQ, R )
+ END IF
+ ELSE
+ CALL SLARTG( VB12, VB11, CSQ, SNQ, R )
+ END IF
+*
+ CSU = SNR
+ SNU = CSR
+ CSV = SNL
+ SNV = CSL
+*
+ END IF
+*
+ END IF
+*
+ RETURN
+*
+* End of SLAGS2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.c
new file mode 100644
index 0000000000000000000000000000000000000000..ca3532209dca145eaf0dda65a030ed7e10fb040e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.c
@@ -0,0 +1,789 @@
+#include "f2c.h"
+#include "netlib.h"
+#include <stdio.h>
+
+/* There are too many problems in this file created by the MSVC
+ optimizer. Just disable it. */
+#if defined(_MSC_VER)
+# pragma optimize("", off)
+#endif
+
+/* The same optimization issues hold for the intel compiler */
+#if defined(__INTEL_COMPILER)
+# pragma optimize("", off)
+#endif
+
+
+
+void slamc1_(integer *beta, integer *t, logical *rnd, logical *ieee1);
+void slamc2_(integer *beta, integer *t, logical *rnd, real *eps,
+ integer *emin, real *rmin, integer *emax, real *rmax);
+real slamc3_(real *a, real *b);
+void slamc4_(integer *emin, real *start, integer *base);
+void slamc5_(integer *beta, integer *p, integer *emin, logical *ieee, integer *emax, real *rmax);
+
+real slamch_(const char *cmach)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ SLAMCH determines single precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by SLAMCH:
+ = 'E' or 'e', SLAMCH := eps
+ = 'S' or 's , SLAMCH := sfmin
+ = 'B' or 'b', SLAMCH := base
+ = 'P' or 'p', SLAMCH := eps*base
+ = 'N' or 'n', SLAMCH := t
+ = 'R' or 'r', SLAMCH := rnd
+ = 'M' or 'm', SLAMCH := emin
+ = 'U' or 'u', SLAMCH := rmin
+ = 'L' or 'l', SLAMCH := emax
+ = 'O' or 'o', SLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+*/
+
+ /* Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ integer i__1;
+ /* Local variables */
+ static real base;
+ static integer beta;
+ static real emin, prec, emax;
+ static integer imin, imax;
+ static logical lrnd;
+ static real rmin, rmax, t;
+ static real small, sfmin;
+ static integer it;
+ static real rnd, eps;
+
+ if (first) {
+ first = FALSE_;
+ slamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);
+ base = (real) beta;
+ t = (real) it;
+ if (lrnd) {
+ rnd = 1.f;
+ i__1 = 1 - it;
+ eps = pow_ri(&base, &i__1) / 2;
+ } else {
+ rnd = 0.f;
+ i__1 = 1 - it;
+ eps = pow_ri(&base, &i__1);
+ }
+ prec = eps * base;
+ emin = (real) imin;
+ emax = (real) imax;
+ sfmin = rmin;
+ small = 1.f / rmax;
+ if (small >= sfmin) {
+ /* Use SMALL plus a bit, to avoid the possibility of rounding */
+ /* causing overflow when computing 1/sfmin. */
+ sfmin = small * (eps + 1.f);
+ }
+ }
+
+ if (*cmach=='E' || *cmach=='e') return eps; /* 1.19209e-7f */
+ else if (*cmach=='S' || *cmach=='s') return sfmin; /* 1.17549e-38f */
+ else if (*cmach=='B' || *cmach=='b') return base; /* 2.f */
+ else if (*cmach=='P' || *cmach=='p') return prec; /* 2.38419e-7.f */
+ else if (*cmach=='N' || *cmach=='n') return t; /* 24.f */
+ else if (*cmach=='R' || *cmach=='r') return rnd; /* 0.f */
+ else if (*cmach=='M' || *cmach=='m') return emin; /* -125.f */
+ else if (*cmach=='U' || *cmach=='u') return rmin; /* 1.17549e-38f */
+ else if (*cmach=='L' || *cmach=='l') return emax; /* 128.f */
+ else if (*cmach=='O' || *cmach=='o') return rmax; /* 3.40282e38f */
+ else return 0.f; /* in case a non-documented argument was passed */
+} /* slamch_ */
+
+/* Subroutine */
+void slamc1_(integer *beta, integer *t, logical *rnd, logical *ieee1)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ SLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+*/
+
+ /* Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ real r__1, r__2;
+ /* Local variables */
+ static logical lrnd;
+ static real a, b, c, f;
+ static integer lbeta;
+ static real savec;
+ static logical lieee1;
+ static real t1, t2;
+ static integer lt;
+ static real one = 1.f;
+
+ if (first) {
+ first = FALSE_;
+
+ /* LBETA, LIEEE1, LT and LRND are the local values of BETA, IEEE1, T and RND. */
+
+ /* Throughout this routine we use the function SLAMC3 to ensure */
+ /* that relevant values are stored and not held in registers, or */
+ /* are not affected by optimizers. */
+
+ /* Compute a = 2.0**m with the smallest positive integer m such that */
+ /* fl( a + 1.0 ) = a. */
+
+ a = c = one;
+
+ while (c == one) {
+ a *= 2;
+ c = slamc3_(&a, &one);
+ r__1 = -a;
+ c = slamc3_(&c, &r__1);
+ }
+
+ /* Now compute b = 2.0**m with the smallest positive integer m such that */
+ /* fl( a + b ) .gt. a. */
+
+ b = one;
+ c = slamc3_(&a, &b);
+
+ /* The next two lines of code were replaced by Ian Scott from the original line
+ while (c==a) {
+ During a optimised build under MSVC, the compiler was using the value of
+ C still in a register in while loop test. This is an 80-bit value rather than
+ the 64 bit value it uses after saving and loading from memory.
+ So the 80 bit precision value was having 1 added, making it a different number
+ and so not executing the loop.
+ The call to slamc3_ in the loop condition forces the value to 64-bit precision
+ as during the previous calculation.
+ */
+ r__1 = -a;
+ while (slamc3_(&c, &r__1) == 0.f) {
+ b *= 2;
+ c = slamc3_(&a, &b);
+ }
+
+ /* Now compute the base. a and c are neighbouring floating point */
+ /* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so */
+ /* their difference is beta. Adding 0.25 to c is to ensure that it */
+ /* is truncated to beta and not ( beta - 1 ). */
+
+ savec = c;
+ r__1 = -a;
+ c = slamc3_(&c, &r__1);
+ lbeta = (integer)(c + 0.25f);
+
+ /* Now determine whether rounding or chopping occurs, by adding a */
+ /* bit less than beta/2 and a bit more than beta/2 to a. */
+
+ b = (real) lbeta;
+ r__1 = b / 2;
+ r__2 = -b / 100;
+ f = slamc3_(&r__1, &r__2);
+ c = slamc3_(&f, &a);
+ if (c == a) {
+ lrnd = TRUE_;
+ } else {
+ lrnd = FALSE_;
+ }
+ r__1 = b / 2;
+ r__2 = b / 100;
+ f = slamc3_(&r__1, &r__2);
+ c = slamc3_(&f, &a);
+ if (lrnd && c == a) {
+ lrnd = FALSE_;
+ }
+
+ /* Try and decide whether rounding is done in the IEEE 'round to */
+ /* nearest' style. B/2 is half a unit in the last place of the two */
+ /* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit */
+ /* zero, and SAVEC is odd. Thus adding B/2 to A should not change */
+ /* A, but adding B/2 to SAVEC should change SAVEC. */
+
+ r__1 = b / 2;
+ t1 = slamc3_(&r__1, &a);
+ r__1 = b / 2;
+ t2 = slamc3_(&r__1, &savec);
+ lieee1 = t1 == a && t2 > savec && lrnd;
+
+ /* Now find the mantissa, t. It should be the integer part of */
+ /* log to the base beta of a, however it is safer to determine t */
+ /* by powering. So we find t as the smallest positive integer for */
+ /* which */
+ /* fl( beta**t + 1.0 ) = 1.0. */
+
+ lt = 0;
+ a = c = one;
+
+ while (c == one) {
+ ++lt;
+ a *= lbeta;
+ c = slamc3_(&a, &one);
+ r__1 = -a;
+ c = slamc3_(&c, &r__1);
+ }
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *ieee1 = lieee1;
+} /* slamc1_ */
+
+/* Subroutine */
+void slamc2_(integer *beta, integer *t, logical *rnd,
+ real *eps, integer *emin, real *rmin,
+ integer *emax, real *rmax)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ SLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) REAL
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) REAL
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) REAL
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+*/
+
+ /* Initialized data */
+ static logical first = TRUE_;
+ static logical iwarn = FALSE_;
+ /* System generated locals */
+ integer i__1;
+ real r__1, r__2;
+ /* Local variables */
+ static logical ieee;
+ static real half = 0.5f;
+ static logical lrnd;
+ static real leps, zero = 0.f, a, b, c;
+ static integer i, lbeta;
+ static real rbase;
+ static integer lemin, lemax, gnmin;
+ static real small;
+ static integer gpmin;
+ static real third, lrmin, lrmax, sixth;
+ static logical lieee1;
+ static integer lt, ngnmin, ngpmin;
+ static real one = 1.f;
+
+ if (first) {
+ first = FALSE_;
+
+/* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
+ BETA, T, RND, EPS, EMIN and RMIN.
+
+ Throughout this routine we use the function SLAMC3 to ensure
+ that relevant values are stored and not held in registers, or
+ are not affected by optimizers.
+
+ SLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
+*/
+
+ slamc1_(&lbeta, <, &lrnd, &lieee1);
+
+ /* Start to find EPS. */
+
+ b = (real) lbeta;
+ i__1 = -lt;
+ a = pow_ri(&b, &i__1);
+ leps = a;
+
+ /* Try some tricks to see whether or not this is the correct EPS. */
+
+ b = 2.f / 3;
+ r__1 = -half;
+ sixth = slamc3_(&b, &r__1);
+ third = slamc3_(&sixth, &sixth);
+ b = slamc3_(&third, &r__1);
+ b = slamc3_(&b, &sixth);
+ b = abs(b);
+ if (b < leps) {
+ b = leps;
+ }
+
+ leps = one;
+
+ while (leps > b && b > zero) {
+ leps = b;
+ r__1 = half * leps;
+ r__2 = 32.0f * leps * leps;
+ c = slamc3_(&r__1, &r__2);
+ r__1 = -c;
+ c = slamc3_(&half, &r__1);
+ b = slamc3_(&half, &c);
+ r__1 = -b;
+ c = slamc3_(&half, &r__1);
+ b = slamc3_(&half, &c);
+ }
+
+ if (a < leps) {
+ leps = a;
+ }
+
+/* Computation of EPS complete.
+
+ Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
+ Keep dividing A by BETA until (gradual) underflow occurs. This
+ is detected when we cannot recover the previous A.
+*/
+
+ rbase = one / lbeta;
+ small = one;
+ for (i = 1; i <= 3; ++i) {
+ r__1 = small * rbase;
+ small = slamc3_(&r__1, &zero);
+ }
+ a = slamc3_(&one, &small);
+ slamc4_(&ngpmin, &one, &lbeta);
+ r__1 = -one;
+ slamc4_(&ngnmin, &r__1, &lbeta);
+ slamc4_(&gpmin, &a, &lbeta);
+ r__1 = -a;
+ slamc4_(&gnmin, &r__1, &lbeta);
+ ieee = FALSE_;
+
+ if (ngpmin == ngnmin && gpmin == gnmin) {
+ if (ngpmin == gpmin) {
+ lemin = ngpmin;
+ /* ( Non twos-complement machines, no gradual underflow; e.g., VAX ) */
+ } else if (gpmin - ngpmin == 3) {
+ lemin = ngpmin - 1 + lt;
+ ieee = TRUE_;
+ /* ( Non twos-complement machines, with gradual underflow; e.g., IEEE standard followers ) */
+ } else {
+ lemin = min(ngpmin,gpmin);
+ /* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ } else if (ngpmin == gpmin && ngnmin == gnmin) {
+ if (abs(ngpmin - ngnmin) == 1) {
+ lemin = max(ngpmin,ngnmin);
+ /* ( Twos-complement machines, no gradual underflow; e.g., CYBER 205 ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+ /* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ } else if (abs(ngpmin - ngnmin) == 1 && gpmin == gnmin) {
+ if (gpmin - min(ngpmin,ngnmin) == 3) {
+ lemin = max(ngpmin,ngnmin) - 1 + lt;
+ /* ( Twos-complement machines with gradual underflow; no known machine ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+ /* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ } else {
+ lemin = min(min(min(ngpmin,ngnmin),gpmin),gnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ /* ** Comment out this if block if EMIN is ok */
+ if (iwarn) {
+ first = TRUE_;
+ printf("\n\n WARNING. The value EMIN may be incorrect: - ");
+ printf("EMIN = %8i\n",lemin);
+ printf("If, after inspection, the value EMIN looks acceptable");
+ printf(" please comment out\n the IF block as marked within the");
+ printf(" code of routine SLAMC2,\n otherwise supply EMIN");
+ printf(" explicitly.\n");
+ }
+/* ** Assume IEEE arithmetic if we found denormalised numbers above,
+ or if arithmetic seems to round in the IEEE style, determined
+ in routine SLAMC1. A true IEEE machine should have both things
+ true; however, faulty machines may have one or the other.
+*/
+
+ ieee = ieee || lieee1;
+
+/* Compute RMIN by successive division by BETA. We could compute
+ RMIN as BASE**( EMIN - 1 ), but some machines underflow during
+ this computation.
+*/
+
+ lrmin = one;
+ for (i = 1; i <= 1-lemin; ++i) {
+ r__1 = lrmin * rbase;
+ lrmin = slamc3_(&r__1, &zero);
+ }
+
+/* Finally, call SLAMC5 to compute EMAX and RMAX. */
+
+ slamc5_(&lbeta, <, &lemin, &ieee, &lemax, &lrmax);
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *eps = leps;
+ *emin = lemin;
+ *rmin = lrmin;
+ *emax = lemax;
+ *rmax = lrmax;
+} /* slamc2_ */
+
+
+/* Microsoft Visual C++ 2003 produces bad code when the following */
+/* routine is optimized. Turn off the optimization for this one */
+/* routine and turn back on any optimizations after this routine. */
+#if defined(_WIN32) || defined(WIN32)
+#if (_MSC_VER >= 1310)
+# pragma optimize("", off)
+#endif
+#endif
+
+real slamc3_(real *a, real *b)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ SLAMC3 is intended to force A and B to be stored prior to doing
+ the addition of A and B , for use in situations where optimizers
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A, B (input) REAL
+ The values A and B.
+
+ =====================================================================
+*/
+
+ return *a + *b;
+} /* slamc3_ */
+
+/* Turn the optimizations back on for Visual Studio .NET 2003 */
+#if defined(_WIN32) || defined(WIN32)
+#if (_MSC_VER >= 1310)
+# pragma optimize("", on)
+#endif
+#endif
+
+/* Subroutine */
+void slamc4_(integer *emin, real *start, integer *base)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ SLAMC4 is a service routine for SLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) EMIN
+ The minimum exponent before (gradual) underflow, computed by
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) REAL
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+*/
+
+ /* System generated locals */
+ real r__1;
+ /* Local variables */
+ static real zero = 0.f, a;
+ static integer i;
+ static real rbase, b1, b2, c1, c2, d1, d2;
+ static real one = 1.f;
+
+ a = *start;
+ rbase = one / *base;
+ *emin = 1;
+ r__1 = a * rbase;
+ b1 = slamc3_(&r__1, &zero);
+ c1 = c2 = d1 = d2 = a;
+ while (c1 == a && c2 == a && d1 == a && d2 == a) {
+ --(*emin);
+ a = b1;
+ r__1 = a / *base;
+ b1 = slamc3_(&r__1, &zero);
+ r__1 = b1 * *base;
+ c1 = slamc3_(&r__1, &zero);
+ d1 = zero;
+ for (i = 1; i <= *base; ++i) {
+ d1 += b1;
+ }
+ r__1 = a * rbase;
+ b2 = slamc3_(&r__1, &zero);
+ r__1 = b2 / rbase;
+ c2 = slamc3_(&r__1, &zero);
+ d2 = zero;
+ for (i = 1; i <= *base; ++i) {
+ d2 += b2;
+ }
+ }
+} /* slamc4_ */
+
+/* Subroutine */
+void slamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, real *rmax)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+ Purpose
+ =======
+
+ SLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) REAL
+ The largest machine floating-point number.
+
+ =====================================================================
+*/
+
+ /* Table of constant values */
+ static real c_b5 = 0.f;
+ /* System generated locals */
+ real r__1;
+ /* Local variables */
+ static integer lexp;
+ static real oldy;
+ static integer uexp, i;
+ static real y, z;
+ static integer nbits;
+ static real recbas;
+ static integer exbits, expsum, try;
+
+/* First compute LEXP and UEXP, two powers of 2 that bound
+ abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+ approximately to the bound that is closest to abs(EMIN).
+ (EMAX is the exponent of the required number RMAX).
+*/
+
+ lexp = 1;
+ exbits = 1;
+ while ((try = lexp << 1) <= -(*emin)) {
+ lexp = try;
+ ++exbits;
+ }
+ if (lexp == -(*emin)) {
+ uexp = lexp;
+ } else {
+ uexp = try;
+ ++exbits;
+ }
+
+/* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+ than or equal to EMIN. EXBITS is the number of bits needed to
+ store the exponent.
+*/
+
+ if (uexp + *emin > -lexp - *emin) {
+ expsum = lexp << 1;
+ } else {
+ expsum = uexp << 1;
+ }
+
+ /* EXPSUM is the exponent range, approximately equal to EMAX - EMIN + 1 . */
+ *emax = expsum + *emin - 1;
+ nbits = exbits + 1 + *p;
+
+/* NBITS is the total number of bits needed to store a floating-point number. */
+
+ if (nbits % 2 == 1 && *beta == 2) {
+/* Either there are an odd number of bits used to store a
+ floating-point number, which is unlikely, or some bits are
+ not used in the representation of numbers, which is possible,
+ (e.g. Cray machines) or the mantissa has an implicit bit,
+ (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+ most likely. We have to assume the last alternative.
+ If this is true, then we need to reduce EMAX by one because
+ there must be some way of representing zero in an implicit-bit
+ system. On machines like Cray, we are reducing EMAX by one
+ unnecessarily.
+*/
+ --(*emax);
+ }
+
+ if (*ieee) {
+ /* Assume we are on an IEEE machine which reserves one exponent for infinity and NaN. */
+ --(*emax);
+ }
+
+/* Now create RMAX, the largest machine number, which should be equal to (1.0 - BETA**(-P)) * BETA**EMAX . */
+/* First compute 1.0 - BETA**(-P), being careful that the result is less than 1.0 . */
+
+ recbas = 1.f / *beta;
+ z = *beta - 1.f;
+ y = 0.f;
+ for (i = 1; i <= *p; ++i) {
+ z *= recbas;
+ if (y < 1.f) {
+ oldy = y;
+ }
+ y = slamc3_(&y, &z);
+ }
+ if (y >= 1.f) {
+ y = oldy;
+ }
+
+ /* Now multiply by BETA**EMAX to get RMAX. */
+ for (i = 1; i <= *emax; ++i) {
+ r__1 = y * *beta;
+ y = slamc3_(&r__1, &c_b5);
+ }
+
+ *rmax = y;
+} /* slamc5_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.f
new file mode 100644
index 0000000000000000000000000000000000000000..cd348ba588922ff4cc2acc03e0ceb8d5cad4711d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slamch.f
@@ -0,0 +1,857 @@
+ REAL FUNCTION SLAMCH( CMACH )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER CMACH
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMCH determines single precision machine parameters.
+*
+* Arguments
+* =========
+*
+* CMACH (input) CHARACTER*1
+* Specifies the value to be returned by SLAMCH:
+* = 'E' or 'e', SLAMCH := eps
+* = 'S' or 's , SLAMCH := sfmin
+* = 'B' or 'b', SLAMCH := base
+* = 'P' or 'p', SLAMCH := eps*base
+* = 'N' or 'n', SLAMCH := t
+* = 'R' or 'r', SLAMCH := rnd
+* = 'M' or 'm', SLAMCH := emin
+* = 'U' or 'u', SLAMCH := rmin
+* = 'L' or 'l', SLAMCH := emax
+* = 'O' or 'o', SLAMCH := rmax
+*
+* where
+*
+* eps = relative machine precision
+* sfmin = safe minimum, such that 1/sfmin does not overflow
+* base = base of the machine
+* prec = eps*base
+* t = number of (base) digits in the mantissa
+* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+* emin = minimum exponent before (gradual) underflow
+* rmin = underflow threshold - base**(emin-1)
+* emax = largest exponent before overflow
+* rmax = overflow threshold - (base**emax)*(1-eps)
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FIRST, LRND
+ INTEGER BETA, IMAX, IMIN, IT
+ REAL BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
+ $ RND, SFMIN, SMALL, T
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLAMC2
+* ..
+* .. Save statement ..
+ SAVE FIRST, EPS, SFMIN, BASE, T, RND, EMIN, RMIN,
+ $ EMAX, RMAX, PREC
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ CALL SLAMC2( BETA, IT, LRND, EPS, IMIN, RMIN, IMAX, RMAX )
+ BASE = BETA
+ T = IT
+ IF( LRND ) THEN
+ RND = ONE
+ EPS = ( BASE**( 1-IT ) ) / 2
+ ELSE
+ RND = ZERO
+ EPS = BASE**( 1-IT )
+ END IF
+ PREC = EPS*BASE
+ EMIN = IMIN
+ EMAX = IMAX
+ SFMIN = RMIN
+ SMALL = ONE / RMAX
+ IF( SMALL.GE.SFMIN ) THEN
+*
+* Use SMALL plus a bit, to avoid the possibility of rounding
+* causing overflow when computing 1/sfmin.
+*
+ SFMIN = SMALL*( ONE+EPS )
+ END IF
+ END IF
+*
+ IF( LSAME( CMACH, 'E' ) ) THEN
+ RMACH = EPS
+ ELSE IF( LSAME( CMACH, 'S' ) ) THEN
+ RMACH = SFMIN
+ ELSE IF( LSAME( CMACH, 'B' ) ) THEN
+ RMACH = BASE
+ ELSE IF( LSAME( CMACH, 'P' ) ) THEN
+ RMACH = PREC
+ ELSE IF( LSAME( CMACH, 'N' ) ) THEN
+ RMACH = T
+ ELSE IF( LSAME( CMACH, 'R' ) ) THEN
+ RMACH = RND
+ ELSE IF( LSAME( CMACH, 'M' ) ) THEN
+ RMACH = EMIN
+ ELSE IF( LSAME( CMACH, 'U' ) ) THEN
+ RMACH = RMIN
+ ELSE IF( LSAME( CMACH, 'L' ) ) THEN
+ RMACH = EMAX
+ ELSE IF( LSAME( CMACH, 'O' ) ) THEN
+ RMACH = RMAX
+ END IF
+*
+ SLAMCH = RMACH
+ RETURN
+*
+* End of SLAMCH
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE SLAMC1( BETA, T, RND, IEEE1 )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL IEEE1, RND
+ INTEGER BETA, T
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMC1 determines the machine parameters given by BETA, T, RND, and
+* IEEE1.
+*
+* Arguments
+* =========
+*
+* BETA (output) INTEGER
+* The base of the machine.
+*
+* T (output) INTEGER
+* The number of ( BETA ) digits in the mantissa.
+*
+* RND (output) LOGICAL
+* Specifies whether proper rounding ( RND = .TRUE. ) or
+* chopping ( RND = .FALSE. ) occurs in addition. This may not
+* be a reliable guide to the way in which the machine performs
+* its arithmetic.
+*
+* IEEE1 (output) LOGICAL
+* Specifies whether rounding appears to be done in the IEEE
+* 'round to nearest' style.
+*
+* Further Details
+* ===============
+*
+* The routine is based on the routine ENVRON by Malcolm and
+* incorporates suggestions by Gentleman and Marovich. See
+*
+* Malcolm M. A. (1972) Algorithms to reveal properties of
+* floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+*
+* Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+* that reveal properties of floating point arithmetic units.
+* Comms. of the ACM, 17, 276-277.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL FIRST, LIEEE1, LRND
+ INTEGER LBETA, LT
+ REAL A, B, C, F, ONE, QTR, SAVEC, T1, T2
+* ..
+* .. External Functions ..
+ REAL SLAMC3
+ EXTERNAL SLAMC3
+* ..
+* .. Save statement ..
+ SAVE FIRST, LIEEE1, LBETA, LRND, LT
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ ONE = 1
+*
+* LBETA, LIEEE1, LT and LRND are the local values of BETA,
+* IEEE1, T and RND.
+*
+* Throughout this routine we use the function SLAMC3 to ensure
+* that relevant values are stored and not held in registers, or
+* are not affected by optimizers.
+*
+* Compute a = 2.0**m with the smallest positive integer m such
+* that
+*
+* fl( a + 1.0 ) = a.
+*
+ A = 1
+ C = 1
+*
+*+ WHILE( C.EQ.ONE )LOOP
+ 10 CONTINUE
+ IF( C.EQ.ONE ) THEN
+ A = 2*A
+ C = SLAMC3( A, ONE )
+ C = SLAMC3( C, -A )
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+* Now compute b = 2.0**m with the smallest positive integer m
+* such that
+*
+* fl( a + b ) .gt. a.
+*
+ B = 1
+ C = SLAMC3( A, B )
+*
+*+ WHILE( C.EQ.A )LOOP
+ 20 CONTINUE
+ IF( C.EQ.A ) THEN
+ B = 2*B
+ C = SLAMC3( A, B )
+ GO TO 20
+ END IF
+*+ END WHILE
+*
+* Now compute the base. a and c are neighbouring floating point
+* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
+* their difference is beta. Adding 0.25 to c is to ensure that it
+* is truncated to beta and not ( beta - 1 ).
+*
+ QTR = ONE / 4
+ SAVEC = C
+ C = SLAMC3( C, -A )
+ LBETA = C + QTR
+*
+* Now determine whether rounding or chopping occurs, by adding a
+* bit less than beta/2 and a bit more than beta/2 to a.
+*
+ B = LBETA
+ F = SLAMC3( B / 2, -B / 100 )
+ C = SLAMC3( F, A )
+ IF( C.EQ.A ) THEN
+ LRND = .TRUE.
+ ELSE
+ LRND = .FALSE.
+ END IF
+ F = SLAMC3( B / 2, B / 100 )
+ C = SLAMC3( F, A )
+ IF( ( LRND ) .AND. ( C.EQ.A ) )
+ $ LRND = .FALSE.
+*
+* Try and decide whether rounding is done in the IEEE 'round to
+* nearest' style. B/2 is half a unit in the last place of the two
+* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
+* zero, and SAVEC is odd. Thus adding B/2 to A should not change
+* A, but adding B/2 to SAVEC should change SAVEC.
+*
+ T1 = SLAMC3( B / 2, A )
+ T2 = SLAMC3( B / 2, SAVEC )
+ LIEEE1 = ( T1.EQ.A ) .AND. ( T2.GT.SAVEC ) .AND. LRND
+*
+* Now find the mantissa, t. It should be the integer part of
+* log to the base beta of a, however it is safer to determine t
+* by powering. So we find t as the smallest positive integer for
+* which
+*
+* fl( beta**t + 1.0 ) = 1.0.
+*
+ LT = 0
+ A = 1
+ C = 1
+*
+*+ WHILE( C.EQ.ONE )LOOP
+ 30 CONTINUE
+ IF( C.EQ.ONE ) THEN
+ LT = LT + 1
+ A = A*LBETA
+ C = SLAMC3( A, ONE )
+ C = SLAMC3( C, -A )
+ GO TO 30
+ END IF
+*+ END WHILE
+*
+ END IF
+*
+ BETA = LBETA
+ T = LT
+ RND = LRND
+ IEEE1 = LIEEE1
+ RETURN
+*
+* End of SLAMC1
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE SLAMC2( BETA, T, RND, EPS, EMIN, RMIN, EMAX, RMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL RND
+ INTEGER BETA, EMAX, EMIN, T
+ REAL EPS, RMAX, RMIN
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMC2 determines the machine parameters specified in its argument
+* list.
+*
+* Arguments
+* =========
+*
+* BETA (output) INTEGER
+* The base of the machine.
+*
+* T (output) INTEGER
+* The number of ( BETA ) digits in the mantissa.
+*
+* RND (output) LOGICAL
+* Specifies whether proper rounding ( RND = .TRUE. ) or
+* chopping ( RND = .FALSE. ) occurs in addition. This may not
+* be a reliable guide to the way in which the machine performs
+* its arithmetic.
+*
+* EPS (output) REAL
+* The smallest positive number such that
+*
+* fl( 1.0 - EPS ) .LT. 1.0,
+*
+* where fl denotes the computed value.
+*
+* EMIN (output) INTEGER
+* The minimum exponent before (gradual) underflow occurs.
+*
+* RMIN (output) REAL
+* The smallest normalized number for the machine, given by
+* BASE**( EMIN - 1 ), where BASE is the floating point value
+* of BETA.
+*
+* EMAX (output) INTEGER
+* The maximum exponent before overflow occurs.
+*
+* RMAX (output) REAL
+* The largest positive number for the machine, given by
+* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+* value of BETA.
+*
+* Further Details
+* ===============
+*
+* The computation of EPS is based on a routine PARANOIA by
+* W. Kahan of the University of California at Berkeley.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
+ INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
+ $ NGNMIN, NGPMIN
+ REAL A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
+ $ SIXTH, SMALL, THIRD, TWO, ZERO
+* ..
+* .. External Functions ..
+ REAL SLAMC3
+ EXTERNAL SLAMC3
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLAMC1, SLAMC4, SLAMC5
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. Save statement ..
+ SAVE FIRST, IWARN, LBETA, LEMAX, LEMIN, LEPS, LRMAX,
+ $ LRMIN, LT
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. / , IWARN / .FALSE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ ZERO = 0
+ ONE = 1
+ TWO = 2
+*
+* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
+* BETA, T, RND, EPS, EMIN and RMIN.
+*
+* Throughout this routine we use the function SLAMC3 to ensure
+* that relevant values are stored and not held in registers, or
+* are not affected by optimizers.
+*
+* SLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
+*
+ CALL SLAMC1( LBETA, LT, LRND, LIEEE1 )
+*
+* Start to find EPS.
+*
+ B = LBETA
+ A = B**( -LT )
+ LEPS = A
+*
+* Try some tricks to see whether or not this is the correct EPS.
+*
+ B = TWO / 3
+ HALF = ONE / 2
+ SIXTH = SLAMC3( B, -HALF )
+ THIRD = SLAMC3( SIXTH, SIXTH )
+ B = SLAMC3( THIRD, -HALF )
+ B = SLAMC3( B, SIXTH )
+ B = ABS( B )
+ IF( B.LT.LEPS )
+ $ B = LEPS
+*
+ LEPS = 1
+*
+*+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
+ 10 CONTINUE
+ IF( ( LEPS.GT.B ) .AND. ( B.GT.ZERO ) ) THEN
+ LEPS = B
+ C = SLAMC3( HALF*LEPS, ( TWO**5 )*( LEPS**2 ) )
+ C = SLAMC3( HALF, -C )
+ B = SLAMC3( HALF, C )
+ C = SLAMC3( HALF, -B )
+ B = SLAMC3( HALF, C )
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+ IF( A.LT.LEPS )
+ $ LEPS = A
+*
+* Computation of EPS complete.
+*
+* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
+* Keep dividing A by BETA until (gradual) underflow occurs. This
+* is detected when we cannot recover the previous A.
+*
+ RBASE = ONE / LBETA
+ SMALL = ONE
+ DO 20 I = 1, 3
+ SMALL = SLAMC3( SMALL*RBASE, ZERO )
+ 20 CONTINUE
+ A = SLAMC3( ONE, SMALL )
+ CALL SLAMC4( NGPMIN, ONE, LBETA )
+ CALL SLAMC4( NGNMIN, -ONE, LBETA )
+ CALL SLAMC4( GPMIN, A, LBETA )
+ CALL SLAMC4( GNMIN, -A, LBETA )
+ IEEE = .FALSE.
+*
+ IF( ( NGPMIN.EQ.NGNMIN ) .AND. ( GPMIN.EQ.GNMIN ) ) THEN
+ IF( NGPMIN.EQ.GPMIN ) THEN
+ LEMIN = NGPMIN
+* ( Non twos-complement machines, no gradual underflow;
+* e.g., VAX )
+ ELSE IF( ( GPMIN-NGPMIN ).EQ.3 ) THEN
+ LEMIN = NGPMIN - 1 + LT
+ IEEE = .TRUE.
+* ( Non twos-complement machines, with gradual underflow;
+* e.g., IEEE standard followers )
+ ELSE
+ LEMIN = MIN( NGPMIN, GPMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE IF( ( NGPMIN.EQ.GPMIN ) .AND. ( NGNMIN.EQ.GNMIN ) ) THEN
+ IF( ABS( NGPMIN-NGNMIN ).EQ.1 ) THEN
+ LEMIN = MAX( NGPMIN, NGNMIN )
+* ( Twos-complement machines, no gradual underflow;
+* e.g., CYBER 205 )
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE IF( ( ABS( NGPMIN-NGNMIN ).EQ.1 ) .AND.
+ $ ( GPMIN.EQ.GNMIN ) ) THEN
+ IF( ( GPMIN-MIN( NGPMIN, NGNMIN ) ).EQ.3 ) THEN
+ LEMIN = MAX( NGPMIN, NGNMIN ) - 1 + LT
+* ( Twos-complement machines with gradual underflow;
+* no known machine )
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+*
+ ELSE
+ LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
+* ( A guess; no known machine )
+ IWARN = .TRUE.
+ END IF
+***
+* Comment out this if block if EMIN is ok
+ IF( IWARN ) THEN
+ FIRST = .TRUE.
+ WRITE( 6, FMT = 9999 )LEMIN
+ END IF
+***
+*
+* Assume IEEE arithmetic if we found denormalised numbers above,
+* or if arithmetic seems to round in the IEEE style, determined
+* in routine SLAMC1. A true IEEE machine should have both things
+* true; however, faulty machines may have one or the other.
+*
+ IEEE = IEEE .OR. LIEEE1
+*
+* Compute RMIN by successive division by BETA. We could compute
+* RMIN as BASE**( EMIN - 1 ), but some machines underflow during
+* this computation.
+*
+ LRMIN = 1
+ DO 30 I = 1, 1 - LEMIN
+ LRMIN = SLAMC3( LRMIN*RBASE, ZERO )
+ 30 CONTINUE
+*
+* Finally, call SLAMC5 to compute EMAX and RMAX.
+*
+ CALL SLAMC5( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
+ END IF
+*
+ BETA = LBETA
+ T = LT
+ RND = LRND
+ EPS = LEPS
+ EMIN = LEMIN
+ RMIN = LRMIN
+ EMAX = LEMAX
+ RMAX = LRMAX
+*
+ RETURN
+*
+ 9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
+ $ ' EMIN = ', I8, /
+ $ ' If, after inspection, the value EMIN looks',
+ $ ' acceptable please comment out ',
+ $ / ' the IF block as marked within the code of routine',
+ $ ' SLAMC2,', / ' otherwise supply EMIN explicitly.', / )
+*
+* End of SLAMC2
+*
+ END
+*
+************************************************************************
+*
+ REAL FUNCTION SLAMC3( A, B )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ REAL A, B
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMC3 is intended to force A and B to be stored prior to doing
+* the addition of A and B , for use in situations where optimizers
+* might hold one of these in a register.
+*
+* Arguments
+* =========
+*
+* A, B (input) REAL
+* The values A and B.
+*
+* =====================================================================
+*
+* .. Executable Statements ..
+*
+ SLAMC3 = A + B
+*
+ RETURN
+*
+* End of SLAMC3
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE SLAMC4( EMIN, START, BASE )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER BASE, EMIN
+ REAL START
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMC4 is a service routine for SLAMC2.
+*
+* Arguments
+* =========
+*
+* EMIN (output) EMIN
+* The minimum exponent before (gradual) underflow, computed by
+* setting A = START and dividing by BASE until the previous A
+* can not be recovered.
+*
+* START (input) REAL
+* The starting point for determining EMIN.
+*
+* BASE (input) INTEGER
+* The base of the machine.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I
+ REAL A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
+* ..
+* .. External Functions ..
+ REAL SLAMC3
+ EXTERNAL SLAMC3
+* ..
+* .. Executable Statements ..
+*
+ A = START
+ ONE = 1
+ RBASE = ONE / BASE
+ ZERO = 0
+ EMIN = 1
+ B1 = SLAMC3( A*RBASE, ZERO )
+ C1 = A
+ C2 = A
+ D1 = A
+ D2 = A
+*+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
+* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
+ 10 CONTINUE
+ IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
+ $ ( D2.EQ.A ) ) THEN
+ EMIN = EMIN - 1
+ A = B1
+ B1 = SLAMC3( A / BASE, ZERO )
+ C1 = SLAMC3( B1*BASE, ZERO )
+ D1 = ZERO
+ DO 20 I = 1, BASE
+ D1 = D1 + B1
+ 20 CONTINUE
+ B2 = SLAMC3( A*RBASE, ZERO )
+ C2 = SLAMC3( B2 / RBASE, ZERO )
+ D2 = ZERO
+ DO 30 I = 1, BASE
+ D2 = D2 + B2
+ 30 CONTINUE
+ GO TO 10
+ END IF
+*+ END WHILE
+*
+ RETURN
+*
+* End of SLAMC4
+*
+ END
+*
+************************************************************************
+*
+ SUBROUTINE SLAMC5( BETA, P, EMIN, IEEE, EMAX, RMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ LOGICAL IEEE
+ INTEGER BETA, EMAX, EMIN, P
+ REAL RMAX
+* ..
+*
+* Purpose
+* =======
+*
+* SLAMC5 attempts to compute RMAX, the largest machine floating-point
+* number, without overflow. It assumes that EMAX + abs(EMIN) sum
+* approximately to a power of 2. It will fail on machines where this
+* assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+* EMAX = 28718). It will also fail if the value supplied for EMIN is
+* too large (i.e. too close to zero), probably with overflow.
+*
+* Arguments
+* =========
+*
+* BETA (input) INTEGER
+* The base of floating-point arithmetic.
+*
+* P (input) INTEGER
+* The number of base BETA digits in the mantissa of a
+* floating-point value.
+*
+* EMIN (input) INTEGER
+* The minimum exponent before (gradual) underflow.
+*
+* IEEE (input) LOGICAL
+* A logical flag specifying whether or not the arithmetic
+* system is thought to comply with the IEEE standard.
+*
+* EMAX (output) INTEGER
+* The largest exponent before overflow
+*
+* RMAX (output) REAL
+* The largest machine floating-point number.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
+* ..
+* .. Local Scalars ..
+ INTEGER EXBITS, EXPSUM, I, LEXP, NBITS, TRY, UEXP
+ REAL OLDY, RECBAS, Y, Z
+* ..
+* .. External Functions ..
+ REAL SLAMC3
+ EXTERNAL SLAMC3
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MOD
+* ..
+* .. Executable Statements ..
+*
+* First compute LEXP and UEXP, two powers of 2 that bound
+* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+* approximately to the bound that is closest to abs(EMIN).
+* (EMAX is the exponent of the required number RMAX).
+*
+ LEXP = 1
+ EXBITS = 1
+ 10 CONTINUE
+ TRY = LEXP*2
+ IF( TRY.LE.( -EMIN ) ) THEN
+ LEXP = TRY
+ EXBITS = EXBITS + 1
+ GO TO 10
+ END IF
+ IF( LEXP.EQ.-EMIN ) THEN
+ UEXP = LEXP
+ ELSE
+ UEXP = TRY
+ EXBITS = EXBITS + 1
+ END IF
+*
+* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+* than or equal to EMIN. EXBITS is the number of bits needed to
+* store the exponent.
+*
+ IF( ( UEXP+EMIN ).GT.( -LEXP-EMIN ) ) THEN
+ EXPSUM = 2*LEXP
+ ELSE
+ EXPSUM = 2*UEXP
+ END IF
+*
+* EXPSUM is the exponent range, approximately equal to
+* EMAX - EMIN + 1 .
+*
+ EMAX = EXPSUM + EMIN - 1
+ NBITS = 1 + EXBITS + P
+*
+* NBITS is the total number of bits needed to store a
+* floating-point number.
+*
+ IF( ( MOD( NBITS, 2 ).EQ.1 ) .AND. ( BETA.EQ.2 ) ) THEN
+*
+* Either there are an odd number of bits used to store a
+* floating-point number, which is unlikely, or some bits are
+* not used in the representation of numbers, which is possible,
+* (e.g. Cray machines) or the mantissa has an implicit bit,
+* (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+* most likely. We have to assume the last alternative.
+* If this is true, then we need to reduce EMAX by one because
+* there must be some way of representing zero in an implicit-bit
+* system. On machines like Cray, we are reducing EMAX by one
+* unnecessarily.
+*
+ EMAX = EMAX - 1
+ END IF
+*
+ IF( IEEE ) THEN
+*
+* Assume we are on an IEEE machine which reserves one exponent
+* for infinity and NaN.
+*
+ EMAX = EMAX - 1
+ END IF
+*
+* Now create RMAX, the largest machine number, which should
+* be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
+*
+* First compute 1.0 - BETA**(-P), being careful that the
+* result is less than 1.0 .
+*
+ RECBAS = ONE / BETA
+ Z = BETA - ONE
+ Y = ZERO
+ DO 20 I = 1, P
+ Z = Z*RECBAS
+ IF( Y.LT.ONE )
+ $ OLDY = Y
+ Y = SLAMC3( Y, Z )
+ 20 CONTINUE
+ IF( Y.GE.ONE )
+ $ Y = OLDY
+*
+* Now multiply by BETA**EMAX to get RMAX.
+*
+ DO 30 I = 1, EMAX
+ Y = SLAMC3( Y*BETA, ZERO )
+ 30 CONTINUE
+*
+ RMAX = Y
+ RETURN
+*
+* End of SLAMC5
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.c
new file mode 100644
index 0000000000000000000000000000000000000000..08afc173afe7da8b54f6f7a2803a3a6e2d9bf0ec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.c
@@ -0,0 +1,126 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+real slange_(const char *norm, const integer *m, const integer *n, real *a, const integer *lda, real *work)
+{
+ /* Local variables */
+ static integer i, j;
+ static real value;
+ static real sum;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLANGE returns the value of the one norm, or the Frobenius norm, or */
+/* the infinity norm, or the element of largest absolute value of a */
+/* real matrix A. */
+/* */
+/* Description */
+/* =========== */
+/* */
+/* SLANGE returns the value */
+/* */
+/* SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+/* */
+/* where norm1 denotes the one norm of a matrix (maximum column sum), */
+/* normI denotes the infinity norm of a matrix (maximum row sum) and */
+/* normF denotes the Frobenius norm of a matrix (square root of sum of */
+/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in SLANGE as described */
+/* above. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. When M = 0, */
+/* SLANGE is set to zero. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. When N = 0, */
+/* SLANGE is set to zero. */
+/* */
+/* A (input) REAL array, dimension (LDA,N) */
+/* The m by n matrix A. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(M,1). */
+/* */
+/* WORK (workspace) REAL array, dimension (LWORK), */
+/* where LWORK >= M when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+/* */
+/* ===================================================================== */
+
+ value = 0.f;
+ if (*m == 0 || *n == 0) {
+ return value;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ if (value < abs(a[i + j * *lda]))
+ value = abs(a[i + j * *lda]);
+ }
+ }
+ } else if (lsame_(norm, "O") || *norm == '1') {
+
+/* Find norm1(A). */
+
+ for (j = 0; j < *n; ++j) {
+ sum = 0.f;
+ for (i = 0; i < *m; ++i) {
+ sum += abs(a[i + j * *lda]);
+ }
+ if (value < sum)
+ value = sum;
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ for (i = 0; i < *m; ++i) {
+ work[i] = 0.f;
+ }
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ work[i] += abs(a[i + j * *lda]);
+ }
+ }
+ for (i = 0; i < *m; ++i) {
+ if (value < work[i])
+ value = work[i];
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ sum = 1.f;
+ for (j = 0; j < *n; ++j) {
+ slassq_(m, &a[j * *lda], &c__1, &value, &sum);
+ }
+ value *= sqrtf(sum);
+ }
+
+ return value;
+
+} /* slange_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.f
new file mode 100644
index 0000000000000000000000000000000000000000..28af152b08c47d091fde61b001bcaed125b77f59
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slange.f
@@ -0,0 +1,145 @@
+ REAL FUNCTION SLANGE( NORM, M, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER LDA, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLANGE returns the value of the one norm, or the Frobenius norm, or
+* the infinity norm, or the element of largest absolute value of a
+* real matrix A.
+*
+* Description
+* ===========
+*
+* SLANGE returns the value
+*
+* SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+* (
+* ( norm1(A), NORM = '1', 'O' or 'o'
+* (
+* ( normI(A), NORM = 'I' or 'i'
+* (
+* ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+*
+* where norm1 denotes the one norm of a matrix (maximum column sum),
+* normI denotes the infinity norm of a matrix (maximum row sum) and
+* normF denotes the Frobenius norm of a matrix (square root of sum of
+* squares). Note that max(abs(A(i,j))) is not a matrix norm.
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies the value to be returned in SLANGE as described
+* above.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0. When M = 0,
+* SLANGE is set to zero.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0. When N = 0,
+* SLANGE is set to zero.
+*
+* A (input) REAL array, dimension (LDA,N)
+* The m by n matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(M,1).
+*
+* WORK (workspace) REAL array, dimension (LWORK),
+* where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+* referenced.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ REAL SCALE, SUM, VALUE
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLASSQ
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( MIN( M, N ).EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ DO 20 J = 1, N
+ DO 10 I = 1, M
+ VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+* Find norm1(A).
+*
+ VALUE = ZERO
+ DO 40 J = 1, N
+ SUM = ZERO
+ DO 30 I = 1, M
+ SUM = SUM + ABS( A( I, J ) )
+ 30 CONTINUE
+ VALUE = MAX( VALUE, SUM )
+ 40 CONTINUE
+ ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+* Find normI(A).
+*
+ DO 50 I = 1, M
+ WORK( I ) = ZERO
+ 50 CONTINUE
+ DO 70 J = 1, N
+ DO 60 I = 1, M
+ WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+ 60 CONTINUE
+ 70 CONTINUE
+ VALUE = ZERO
+ DO 80 I = 1, M
+ VALUE = MAX( VALUE, WORK( I ) )
+ 80 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ DO 90 J = 1, N
+ CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM )
+ 90 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ SLANGE = VALUE
+ RETURN
+*
+* End of SLANGE
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.c
new file mode 100644
index 0000000000000000000000000000000000000000..7c52a921d8abca0cdfa537b484dbad6daae67b9f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.c
@@ -0,0 +1,82 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slapll_(integer *n, real *x, integer *incx, real *y, integer *incy, real *ssmin)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static real c, ssmax, a11, a12, a22, tau;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* Given two column vectors X and Y, let */
+/* */
+/* A = ( X Y ). */
+/* */
+/* The subroutine first computes the QR factorization of A = Q*R, */
+/* and then computes the SVD of the 2-by-2 upper triangular matrix R. */
+/* The smaller singular value of R is returned in SSMIN, which is used */
+/* as the measurement of the linear dependency of the vectors X and Y. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The length of the vectors X and Y. */
+/* */
+/* X (input/output) REAL array, */
+/* dimension (1+(N-1)*INCX) */
+/* On entry, X contains the N-vector X. */
+/* On exit, X is overwritten. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive elements of X. INCX > 0. */
+/* */
+/* Y (input/output) REAL array, */
+/* dimension (1+(N-1)*INCY) */
+/* On entry, Y contains the N-vector Y. */
+/* On exit, Y is overwritten. */
+/* */
+/* INCY (input) INTEGER */
+/* The increment between successive elements of Y. INCY > 0. */
+/* */
+/* SSMIN (output) REAL */
+/* The smallest singular value of the N-by-2 matrix A = (X Y). */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ *ssmin = 0.f;
+ return;
+ }
+
+/* Compute the QR factorization of the N-by-2 matrix ( X Y ) */
+
+ slarfg_(n, x, &x[*incx], incx, &tau);
+ a11 = x[0];
+ x[0] = 1.f;
+
+ c = -tau * sdot_(n, x, incx, y, incy);
+ saxpy_(n, &c, x, incx, y, incy);
+
+ i__1 = *n - 1;
+ slarfg_(&i__1, &y[*incy], &y[2 * *incy], incy, &tau);
+
+ a12 = y[0];
+ a22 = y[*incy];
+
+/* Compute the SVD of 2-by-2 Upper triangular matrix. */
+
+ slas2_(&a11, &a12, &a22, ssmin, &ssmax);
+
+} /* slapll_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.f
new file mode 100644
index 0000000000000000000000000000000000000000..3b17911e4549a670a27fc3a25ba5e0b0920998a5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapll.f
@@ -0,0 +1,100 @@
+ SUBROUTINE SLAPLL( N, X, INCX, Y, INCY, SSMIN )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, INCY, N
+ REAL SSMIN
+* ..
+* .. Array Arguments ..
+ REAL X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* Given two column vectors X and Y, let
+*
+* A = ( X Y ).
+*
+* The subroutine first computes the QR factorization of A = Q*R,
+* and then computes the SVD of the 2-by-2 upper triangular matrix R.
+* The smaller singular value of R is returned in SSMIN, which is used
+* as the measurement of the linear dependency of the vectors X and Y.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The length of the vectors X and Y.
+*
+* X (input/output) REAL array,
+* dimension (1+(N-1)*INCX)
+* On entry, X contains the N-vector X.
+* On exit, X is overwritten.
+*
+* INCX (input) INTEGER
+* The increment between successive elements of X. INCX > 0.
+*
+* Y (input/output) REAL array,
+* dimension (1+(N-1)*INCY)
+* On entry, Y contains the N-vector Y.
+* On exit, Y is overwritten.
+*
+* INCY (input) INTEGER
+* The increment between successive elements of Y. INCY > 0.
+*
+* SSMIN (output) REAL
+* The smallest singular value of the N-by-2 matrix A = ( X Y ).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ REAL A11, A12, A22, C, SSMAX, TAU
+* ..
+* .. External Functions ..
+ REAL SDOT
+ EXTERNAL SDOT
+* ..
+* .. External Subroutines ..
+ EXTERNAL SAXPY, SLARFG, SLAS2
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.LE.1 ) THEN
+ SSMIN = ZERO
+ RETURN
+ END IF
+*
+* Compute the QR factorization of the N-by-2 matrix ( X Y )
+*
+ CALL SLARFG( N, X( 1 ), X( 1+INCX ), INCX, TAU )
+ A11 = X( 1 )
+ X( 1 ) = ONE
+*
+ C = -TAU*SDOT( N, X, INCX, Y, INCY )
+ CALL SAXPY( N, C, X, INCX, Y, INCY )
+*
+ CALL SLARFG( N-1, Y( 1+INCY ), Y( 1+2*INCY ), INCY, TAU )
+*
+ A12 = Y( 1 )
+ A22 = Y( 1+INCY )
+*
+* Compute the SVD of 2-by-2 Upper triangular matrix.
+*
+ CALL SLAS2( A11, A12, A22, SSMIN, SSMAX )
+*
+ RETURN
+*
+* End of SLAPLL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.c
new file mode 100644
index 0000000000000000000000000000000000000000..0f9e5193ae64302648c4ab7db40647da85ed3b39
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.c
@@ -0,0 +1,139 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slapmt_(logical *forwrd, integer *m, integer *n, real *x, integer *ldx, integer *k)
+{
+ /* System generated locals */
+ integer x_dim1, x_offset, i__1, i__2;
+
+ /* Local variables */
+ static real temp;
+ static integer i, j, ii, in;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* March 31, 1993 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLAPMT rearranges the columns of the M by N matrix X as specified */
+/* by the permutation K(1),K(2),...,K(N) of the integers 1,...,N. */
+/* If FORWRD = .TRUE., forward permutation: */
+/* */
+/* X(*,K(J)) is moved X(*,J) for J = 1,2,...,N. */
+/* */
+/* If FORWRD = .FALSE., backward permutation: */
+/* */
+/* X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* FORWRD (input) LOGICAL */
+/* = .TRUE., forward permutation */
+/* = .FALSE., backward permutation */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix X. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix X. N >= 0. */
+/* */
+/* X (input/output) REAL array, dimension (LDX,N) */
+/* On entry, the M by N matrix X. */
+/* On exit, X contains the permuted matrix X. */
+/* */
+/* LDX (input) INTEGER */
+/* The leading dimension of the array X, LDX >= MAX(1,M). */
+/* */
+/* K (input) INTEGER array, dimension (N) */
+/* On entry, K contains the permutation vector. */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ --k;
+ x_dim1 = *ldx;
+ x_offset = x_dim1 + 1;
+ x -= x_offset;
+
+ if (*n <= 1) {
+ return;
+ }
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+ k[i] = -k[i];
+ }
+
+ if (*forwrd) {
+
+/* Forward permutation */
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+
+ if (k[i] > 0) {
+ goto L40;
+ }
+
+ j = i;
+ k[j] = -k[j];
+ in = k[j];
+L20:
+ if (k[in] > 0) {
+ goto L40;
+ }
+
+ i__2 = *m;
+ for (ii = 1; ii <= i__2; ++ii) {
+ temp = x[ii + j * x_dim1];
+ x[ii + j * x_dim1] = x[ii + in * x_dim1];
+ x[ii + in * x_dim1] = temp;
+ }
+
+ k[in] = -k[in];
+ j = in;
+ in = k[in];
+ goto L20;
+
+L40:
+ ;
+ }
+
+ } else {
+
+/* Backward permutation */
+
+ i__1 = *n;
+ for (i = 1; i <= i__1; ++i) {
+
+ if (k[i] > 0) {
+ goto L100;
+ }
+
+ k[i] = -k[i];
+ j = k[i];
+L80:
+ if (j == i) {
+ goto L100;
+ }
+
+ i__2 = *m;
+ for (ii = 1; ii <= i__2; ++ii) {
+ temp = x[ii + i * x_dim1];
+ x[ii + i * x_dim1] = x[ii + j * x_dim1];
+ x[ii + j * x_dim1] = temp;
+ }
+
+ k[j] = -k[j];
+ j = k[j];
+ goto L80;
+L100:
+ ;
+ }
+ }
+} /* slapmt_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.f
new file mode 100644
index 0000000000000000000000000000000000000000..97e156a63ada0d094f4451e7e134e7ac09c61ec1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapmt.f
@@ -0,0 +1,135 @@
+ SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* March 31, 1993
+*
+* .. Scalar Arguments ..
+ LOGICAL FORWRD
+ INTEGER LDX, M, N
+* ..
+* .. Array Arguments ..
+ INTEGER K( * )
+ REAL X( LDX, * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLAPMT rearranges the columns of the M by N matrix X as specified
+* by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
+* If FORWRD = .TRUE., forward permutation:
+*
+* X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
+*
+* If FORWRD = .FALSE., backward permutation:
+*
+* X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
+*
+* Arguments
+* =========
+*
+* FORWRD (input) LOGICAL
+* = .TRUE., forward permutation
+* = .FALSE., backward permutation
+*
+* M (input) INTEGER
+* The number of rows of the matrix X. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix X. N >= 0.
+*
+* X (input/output) REAL array, dimension (LDX,N)
+* On entry, the M by N matrix X.
+* On exit, X contains the permuted matrix X.
+*
+* LDX (input) INTEGER
+* The leading dimension of the array X, LDX >= MAX(1,M).
+*
+* K (input) INTEGER array, dimension (N)
+* On entry, K contains the permutation vector.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, II, J, IN
+ REAL TEMP
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 )
+ $ RETURN
+*
+ DO 10 I = 1, N
+ K( I ) = -K( I )
+ 10 CONTINUE
+*
+ IF( FORWRD ) THEN
+*
+* Forward permutation
+*
+ DO 60 I = 1, N
+*
+ IF( K( I ).GT.0 )
+ $ GO TO 40
+*
+ J = I
+ K( J ) = -K( J )
+ IN = K( J )
+*
+ 20 CONTINUE
+ IF( K( IN ).GT.0 )
+ $ GO TO 40
+*
+ DO 30 II = 1, M
+ TEMP = X( II, J )
+ X( II, J ) = X( II, IN )
+ X( II, IN ) = TEMP
+ 30 CONTINUE
+*
+ K( IN ) = -K( IN )
+ J = IN
+ IN = K( IN )
+ GO TO 20
+*
+ 40 CONTINUE
+*
+ 60 CONTINUE
+*
+ ELSE
+*
+* Backward permutation
+*
+ DO 110 I = 1, N
+*
+ IF( K( I ).GT.0 )
+ $ GO TO 100
+*
+ K( I ) = -K( I )
+ J = K( I )
+ 80 CONTINUE
+ IF( J.EQ.I )
+ $ GO TO 100
+*
+ DO 90 II = 1, M
+ TEMP = X( II, I )
+ X( II, I ) = X( II, J )
+ X( II, J ) = TEMP
+ 90 CONTINUE
+*
+ K( J ) = -K( J )
+ J = K( J )
+ GO TO 80
+*
+ 100 CONTINUE
+
+ 110 CONTINUE
+*
+ END IF
+*
+ RETURN
+*
+* End of SLAPMT
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.c
new file mode 100644
index 0000000000000000000000000000000000000000..a2c7eb2f44a7a10f14827dd3ec3147835a379ce1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.c
@@ -0,0 +1,40 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+real slapy2_(const real *x, const real *y)
+{
+ /* Local variables */
+ static real xabs, yabs, w, z;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary */
+/* overflow. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* X (input) REAL */
+/* Y (input) REAL */
+/* X and Y specify the values x and y. */
+/* */
+/* ===================================================================== */
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ w = max(xabs,yabs);
+ z = min(xabs,yabs);
+ if (z == 0.f) {
+ return w;
+ } else {
+ z /= w;
+ return w * sqrtf(z * z + 1.f);
+ }
+} /* slapy2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.f
new file mode 100644
index 0000000000000000000000000000000000000000..8d99be5d05480eff7eb8ca315452d30029f66381
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slapy2.f
@@ -0,0 +1,54 @@
+ REAL FUNCTION SLAPY2( X, Y )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ REAL X, Y
+* ..
+*
+* Purpose
+* =======
+*
+* SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+* overflow.
+*
+* Arguments
+* =========
+*
+* X (input) REAL
+* Y (input) REAL
+* X and Y specify the values x and y.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+ REAL ONE
+ PARAMETER ( ONE = 1.0E0 )
+* ..
+* .. Local Scalars ..
+ REAL W, XABS, YABS, Z
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ XABS = ABS( X )
+ YABS = ABS( Y )
+ W = MAX( XABS, YABS )
+ Z = MIN( XABS, YABS )
+ IF( Z.EQ.ZERO ) THEN
+ SLAPY2 = W
+ ELSE
+ SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+ END IF
+ RETURN
+*
+* End of SLAPY2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slaran.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaran.f
new file mode 100644
index 0000000000000000000000000000000000000000..d8d7ad62678be1d0e195d95293b31141815ef969
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaran.f
@@ -0,0 +1,33 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLARAN(N, X)
+C
+C THIS SUBROUTINE SETS THE VECTOR X TO RANDOM NUMBERS
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N
+ REAL X(N)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, IURAND
+C
+C FUNCTIONS CALLED
+C
+ REAL URAND
+C
+C SUBROUTINES CALLED
+C
+C NONE
+C
+C INITIALIZE SEED
+C
+ DATA IURAND /0/
+C
+ DO 10 I = 1, N
+ X(I) = URAND(IURAND) - 0.5
+ 10 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.c
new file mode 100644
index 0000000000000000000000000000000000000000..1ebd3797eba2b0a11271461b2a288fafd4b7b5ad
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.c
@@ -0,0 +1,102 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static real c_b4 = 1.f;
+static real c_b5 = 0.f;
+static integer c__1 = 1;
+
+/* Subroutine */ void slarf_(const char *side, const integer *m, const integer *n, real *v, const integer *incv,
+ const real *tau, real *c, const integer *ldc, real *work)
+{
+ /* System generated locals */
+ real r__1;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLARF applies a real elementary reflector H to a real m by n matrix */
+/* C, from either the left or the right. H is represented in the form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a real scalar and v is a real vector. */
+/* */
+/* If tau = 0, then H is taken to be the unit matrix. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': form H * C */
+/* = 'R': form C * H */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* V (input) REAL array, dimension */
+/* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
+/* or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
+/* The vector v in the representation of H. V is not used if */
+/* TAU = 0. */
+/* */
+/* INCV (input) INTEGER */
+/* The increment between elements of v. INCV <> 0. */
+/* */
+/* TAU (input) REAL */
+/* The value tau in the representation of H. */
+/* */
+/* C (input/output) REAL array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
+/* or C * H if SIDE = 'R'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) REAL array, dimension */
+/* (N) if SIDE = 'L' */
+/* or (M) if SIDE = 'R' */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C */
+
+ if (*tau != 0.f) {
+
+/* w := C' * v */
+
+ sgemv_("Transpose", m, n, &c_b4, c, ldc, v, incv, &c_b5, work, &c__1);
+
+/* C := C - v * w' */
+
+ r__1 = -(*tau);
+ sger_(m, n, &r__1, v, incv, work, &c__1, c, ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (*tau != 0.f) {
+
+/* w := C * v */
+
+ sgemv_("No transpose", m, n, &c_b4, c, ldc, v, incv, &c_b5, work, &c__1);
+
+/* C := C - w * v' */
+
+ r__1 = -(*tau);
+ sger_(m, n, &r__1, work, &c__1, v, incv, c, ldc);
+ }
+ }
+} /* slarf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.f
new file mode 100644
index 0000000000000000000000000000000000000000..c379820599b93633c40f1cd889a98a8e000ec2bd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarf.f
@@ -0,0 +1,116 @@
+ SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ REAL TAU
+* ..
+* .. Array Arguments ..
+ REAL C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLARF applies a real elementary reflector H to a real m by n matrix
+* C, from either the left or the right. H is represented in the form
+*
+* H = I - tau * v * v'
+*
+* where tau is a real scalar and v is a real vector.
+*
+* If tau = 0, then H is taken to be the unit matrix.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': form H * C
+* = 'R': form C * H
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* V (input) REAL array, dimension
+* (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+* or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+* The vector v in the representation of H. V is not used if
+* TAU = 0.
+*
+* INCV (input) INTEGER
+* The increment between elements of v. INCV <> 0.
+*
+* TAU (input) REAL
+* The value tau in the representation of H.
+*
+* C (input/output) REAL array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+* or C * H if SIDE = 'R'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) REAL array, dimension
+* (N) if SIDE = 'L'
+* or (M) if SIDE = 'R'
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEMV, SGER
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C' * v
+*
+ CALL SGEMV( 'Transpose', M, N, ONE, C, LDC, V, INCV, ZERO,
+ $ WORK, 1 )
+*
+* C := C - v * w'
+*
+ CALL SGER( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C * v
+*
+ CALL SGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
+ $ ZERO, WORK, 1 )
+*
+* C := C - w * v'
+*
+ CALL SGER( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of SLARF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.c
new file mode 100644
index 0000000000000000000000000000000000000000..1bab93794f1307479e4464106338bfadfd0f9077
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.c
@@ -0,0 +1,122 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slarfg_(const integer *n, real *alpha, real *x, const integer *incx, real *tau)
+{
+ /* System generated locals */
+ const integer nm1 = *n - 1;
+ real r__1;
+
+ /* Local variables */
+ static real beta;
+ static integer j;
+ static real xnorm;
+ static real safmin, rsafmn;
+ static integer knt;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLARFG generates a real elementary reflector H of order n, such */
+/* that */
+/* */
+/* H * ( alpha ) = ( beta ), H' * H = I. */
+/* ( x ) ( 0 ) */
+/* */
+/* where alpha and beta are scalars, and x is an (n-1)-element real */
+/* vector. H is represented in the form */
+/* */
+/* H = I - tau * ( 1 ) * ( 1 v' ) , */
+/* ( v ) */
+/* */
+/* where tau is a real scalar and v is a real (n-1)-element */
+/* vector. */
+/* */
+/* If the elements of x are all zero, then tau = 0 and H is taken to be */
+/* the unit matrix. */
+/* */
+/* Otherwise 1 <= tau <= 2. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the elementary reflector. */
+/* */
+/* ALPHA (input/output) REAL */
+/* On entry, the value alpha. */
+/* On exit, it is overwritten with the value beta. */
+/* */
+/* X (input/output) REAL array, dimension */
+/* (1+(N-2)*abs(INCX)) */
+/* On entry, the vector x. */
+/* On exit, it is overwritten with the vector v. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between elements of X. INCX > 0. */
+/* */
+/* TAU (output) REAL */
+/* The value tau. */
+/* */
+/* ===================================================================== */
+
+ if (*n <= 1) {
+ *tau = 0.f;
+ return;
+ }
+
+ xnorm = snrm2_(&nm1, x, incx);
+
+ if (xnorm == 0.f) {
+
+/* H = I */
+
+ *tau = 0.f;
+ } else {
+
+/* general case */
+
+ r__1 = slapy2_(alpha, &xnorm);
+ beta = -r_sign(&r__1, alpha);
+ safmin = slamch_("S") / slamch_("E");
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ rsafmn = 1.f / safmin;
+ knt = 0;
+ do {
+ ++knt;
+ sscal_(&nm1, &rsafmn, x, incx);
+ beta *= rsafmn;
+ *alpha *= rsafmn;
+ } while (abs(beta) < safmin);
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ xnorm = snrm2_(&nm1, x, incx);
+ r__1 = slapy2_(alpha, &xnorm);
+ beta = -r_sign(&r__1, alpha);
+ *tau = (beta - *alpha) / beta;
+ r__1 = 1.f / (*alpha - beta);
+ sscal_(&nm1, &r__1, x, incx);
+
+/* If ALPHA is subnormal, it may lose relative accuracy */
+
+ *alpha = beta;
+ for (j = 0; j < knt; ++j) {
+ *alpha *= safmin;
+ }
+ } else {
+ *tau = (beta - *alpha) / beta;
+ r__1 = 1.f / (*alpha - beta);
+ sscal_(&nm1, &r__1, x, incx);
+ *alpha = beta;
+ }
+ }
+} /* slarfg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.f
new file mode 100644
index 0000000000000000000000000000000000000000..cf78e35365b0ff4ce7dcc1ca9d4efc82a1bbdffa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slarfg.f
@@ -0,0 +1,138 @@
+ SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ REAL ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ REAL X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLARFG generates a real elementary reflector H of order n, such
+* that
+*
+* H * ( alpha ) = ( beta ), H' * H = I.
+* ( x ) ( 0 )
+*
+* where alpha and beta are scalars, and x is an (n-1)-element real
+* vector. H is represented in the form
+*
+* H = I - tau * ( 1 ) * ( 1 v' ) ,
+* ( v )
+*
+* where tau is a real scalar and v is a real (n-1)-element
+* vector.
+*
+* If the elements of x are all zero, then tau = 0 and H is taken to be
+* the unit matrix.
+*
+* Otherwise 1 <= tau <= 2.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the elementary reflector.
+*
+* ALPHA (input/output) REAL
+* On entry, the value alpha.
+* On exit, it is overwritten with the value beta.
+*
+* X (input/output) REAL array, dimension
+* (1+(N-2)*abs(INCX))
+* On entry, the vector x.
+* On exit, it is overwritten with the vector v.
+*
+* INCX (input) INTEGER
+* The increment between elements of X. INCX > 0.
+*
+* TAU (output) REAL
+* The value tau.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ REAL BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ REAL SLAMCH, SLAPY2, SNRM2
+ EXTERNAL SLAMCH, SLAPY2, SNRM2
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL SSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.1 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = SNRM2( N-1, X, INCX )
+*
+ IF( XNORM.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+ SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ RSAFMN = ONE / SAFMIN
+ KNT = 0
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL SSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHA = ALPHA*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = SNRM2( N-1, X, INCX )
+ BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ ALPHA = BETA
+ DO 20 J = 1, KNT
+ ALPHA = ALPHA*SAFMIN
+ 20 CONTINUE
+ ELSE
+ TAU = ( BETA-ALPHA ) / BETA
+ CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+ ALPHA = BETA
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of SLARFG
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.c
new file mode 100644
index 0000000000000000000000000000000000000000..bc94ed1deb87cab5f2b6a60c682c5797dfb00e2d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.c
@@ -0,0 +1,120 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double log(double), sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void slartg_(real *f, real *g, real *cs, real *sn, real *r)
+{
+ /* Initialized data */
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static integer i;
+ static real scale;
+ static integer count;
+ static real f1, g1, safmn2, safmx2;
+ static real safmin, eps;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLARTG generate a plane rotation so that */
+/* */
+/* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1. */
+/* [ -SN CS ] [ G ] [ 0 ] */
+/* */
+/* This is a slower, more accurate version of the BLAS1 routine SROTG, */
+/* with the following other differences: */
+/* F and G are unchanged on return. */
+/* If G=0, then CS=1 and SN=0. */
+/* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any */
+/* floating point operations (saves work in SBDSQR when */
+/* there are zeros on the diagonal). */
+/* */
+/* If F exceeds G in magnitude, CS will be positive. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) REAL */
+/* The first component of vector to be rotated. */
+/* */
+/* G (input) REAL */
+/* The second component of vector to be rotated. */
+/* */
+/* CS (output) REAL */
+/* The cosine of the rotation. */
+/* */
+/* SN (output) REAL */
+/* The sine of the rotation. */
+/* */
+/* R (output) REAL */
+/* The nonzero component of the rotated vector. */
+/* */
+/* ===================================================================== */
+
+ if (first) {
+ first = FALSE_;
+ safmin = slamch_("S");
+ eps = slamch_("E");
+ r__1 = slamch_("B");
+ i__1 = (integer) (log(safmin / eps) / log((double)slamch_("B")) / 2.f);
+ safmn2 = pow_ri(&r__1, &i__1);
+ safmx2 = 1.f / safmn2;
+ }
+ if (*g == 0.f) {
+ *cs = 1.f; *sn = 0.f;
+ *r = *f;
+ } else if (*f == 0.f) {
+ *cs = 0.f; *sn = 1.f;
+ *r = *g;
+ } else {
+ f1 = *f; g1 = *g;
+ scale = max(abs(f1),abs(g1));
+ count = 0;
+ if (scale >= safmx2) {
+ while (scale >= safmx2) {
+ ++count;
+ f1 *= safmn2;
+ g1 *= safmn2;
+ scale = max(abs(f1),abs(g1));
+ }
+ *r = sqrtf(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ for (i = 1; i <= count; ++i) {
+ *r *= safmx2;
+ }
+ } else if (scale <= safmn2) {
+ while (scale <= safmn2) {
+ ++count;
+ f1 *= safmx2;
+ g1 *= safmx2;
+ scale = max(abs(f1),abs(g1));
+ }
+ *r = sqrtf(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ for (i = 1; i <= count; ++i) {
+ *r *= safmn2;
+ }
+ } else {
+ *r = sqrtf(f1 * f1 + g1 * g1);
+ *cs = f1 / *r;
+ *sn = g1 / *r;
+ }
+ if (abs(*f) > abs(*g) && *cs < 0.f) {
+ *cs = -(*cs);
+ *sn = -(*sn);
+ *r = -(*r);
+ }
+ }
+} /* slartg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.f
new file mode 100644
index 0000000000000000000000000000000000000000..fd06ef8b0a87aa2c9aea82b591b4ea43b53f68ec
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slartg.f
@@ -0,0 +1,143 @@
+ SUBROUTINE SLARTG( F, G, CS, SN, R )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ REAL CS, F, G, R, SN
+* ..
+*
+* Purpose
+* =======
+*
+* SLARTG generate a plane rotation so that
+*
+* [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+* [ -SN CS ] [ G ] [ 0 ]
+*
+* This is a slower, more accurate version of the BLAS1 routine SROTG,
+* with the following other differences:
+* F and G are unchanged on return.
+* If G=0, then CS=1 and SN=0.
+* If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+* floating point operations (saves work in SBDSQR when
+* there are zeros on the diagonal).
+*
+* If F exceeds G in magnitude, CS will be positive.
+*
+* Arguments
+* =========
+*
+* F (input) REAL
+* The first component of vector to be rotated.
+*
+* G (input) REAL
+* The second component of vector to be rotated.
+*
+* CS (output) REAL
+* The cosine of the rotation.
+*
+* SN (output) REAL
+* The sine of the rotation.
+*
+* R (output) REAL
+* The nonzero component of the rotated vector.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+ REAL ONE
+ PARAMETER ( ONE = 1.0E0 )
+ REAL TWO
+ PARAMETER ( TWO = 2.0E0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL FIRST
+ INTEGER COUNT, I
+ REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
+* ..
+* .. External Functions ..
+ REAL SLAMCH
+ EXTERNAL SLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, INT, LOG, MAX, SQRT
+* ..
+* .. Save statement ..
+ SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
+* ..
+* .. Data statements ..
+ DATA FIRST / .TRUE. /
+* ..
+* .. Executable Statements ..
+*
+ IF( FIRST ) THEN
+ FIRST = .FALSE.
+ SAFMIN = SLAMCH( 'S' )
+ EPS = SLAMCH( 'E' )
+ SAFMN2 = SLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /
+ $ LOG( SLAMCH( 'B' ) ) / TWO )
+ SAFMX2 = ONE / SAFMN2
+ END IF
+ IF( G.EQ.ZERO ) THEN
+ CS = ONE
+ SN = ZERO
+ R = F
+ ELSE IF( F.EQ.ZERO ) THEN
+ CS = ZERO
+ SN = ONE
+ R = G
+ ELSE
+ F1 = F
+ G1 = G
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.GE.SAFMX2 ) THEN
+ COUNT = 0
+ 10 CONTINUE
+ COUNT = COUNT + 1
+ F1 = F1*SAFMN2
+ G1 = G1*SAFMN2
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.GE.SAFMX2 )
+ $ GO TO 10
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ DO 20 I = 1, COUNT
+ R = R*SAFMX2
+ 20 CONTINUE
+ ELSE IF( SCALE.LE.SAFMN2 ) THEN
+ COUNT = 0
+ 30 CONTINUE
+ COUNT = COUNT + 1
+ F1 = F1*SAFMX2
+ G1 = G1*SAFMX2
+ SCALE = MAX( ABS( F1 ), ABS( G1 ) )
+ IF( SCALE.LE.SAFMN2 )
+ $ GO TO 30
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ DO 40 I = 1, COUNT
+ R = R*SAFMN2
+ 40 CONTINUE
+ ELSE
+ R = SQRT( F1**2+G1**2 )
+ CS = F1 / R
+ SN = G1 / R
+ END IF
+ IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN
+ CS = -CS
+ SN = -SN
+ R = -R
+ END IF
+ END IF
+ RETURN
+*
+* End of SLARTG
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.c
new file mode 100644
index 0000000000000000000000000000000000000000..89929e76475a639dacced77f4c0f52751df1314c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.c
@@ -0,0 +1,105 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void slas2_(real *f, real *g, real *h, real *ssmin, real *ssmax)
+{
+ /* Local variables */
+ static real fhmn, fhmx, c, fa, ga, ha, as, at, au;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLAS2 computes the singular values of the 2-by-2 matrix */
+/* [ F G ] */
+/* [ 0 H ]. */
+/* On return, SSMIN is the smaller singular value and SSMAX is the */
+/* larger singular value. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) REAL */
+/* The (1,1) element of the 2-by-2 matrix. */
+/* */
+/* G (input) REAL */
+/* The (1,2) element of the 2-by-2 matrix. */
+/* */
+/* H (input) REAL */
+/* The (2,2) element of the 2-by-2 matrix. */
+/* */
+/* SSMIN (output) REAL */
+/* The smaller singular value. */
+/* */
+/* SSMAX (output) REAL */
+/* The larger singular value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Barring over/underflow, all output quantities are correct to within */
+/* a few units in the last place (ulps), even in the absence of a guard */
+/* digit in addition/subtraction. */
+/* */
+/* In IEEE arithmetic, the code works correctly if one matrix element is*/
+/* infinite. */
+/* */
+/* Overflow will not occur unless the largest singular value itself */
+/* overflows, or is within a few ulps of overflow. (On machines with */
+/* partial overflow, like the Cray, overflow may occur if the largest */
+/* singular value is within a factor of 2 of overflow.) */
+/* */
+/* Underflow is harmless if underflow is gradual. Otherwise, results */
+/* may correspond to a matrix modified by perturbations of size near */
+/* the underflow threshold. */
+/* */
+/* ==================================================================== */
+
+ fa = abs(*f);
+ ga = abs(*g);
+ ha = abs(*h);
+ fhmn = min(fa,ha);
+ fhmx = max(fa,ha);
+ if (fhmn == 0.f) {
+ *ssmin = 0.f;
+ if (fhmx == 0.f) {
+ *ssmax = ga;
+ } else {
+ au = min(fhmx,ga) / max(fhmx,ga);
+ *ssmax = max(fhmx,ga) * sqrtf(au * au + 1.f);
+ }
+ } else {
+ if (ga < fhmx) {
+ as = fhmn / fhmx + 1.f;
+ at = (fhmx - fhmn) / fhmx;
+ au = ga / fhmx; au *= au;
+ c = 2.f / (sqrtf(as * as + au) + sqrtf(at * at + au));
+ *ssmin = fhmn * c;
+ *ssmax = fhmx / c;
+ } else {
+ au = fhmx / ga;
+ if (au == 0.f) {
+
+/* Avoid possible harmful underflow if exponent range asymmetric */
+/* (true SSMIN may not underflow even if AU underflows) */
+
+ *ssmin = fhmn * fhmx / ga;
+ *ssmax = ga;
+ } else {
+ as = fhmn / fhmx + 1.f;
+ at = (fhmx - fhmn) / fhmx;
+ as *= au;
+ at *= au;
+ c = 1.f / (sqrtf(as * as + 1.f) + sqrtf(at * at + 1.f));
+ *ssmin = fhmn * c * au;
+ *ssmin += *ssmin;
+ *ssmax = ga / (c + c);
+ }
+ }
+ }
+} /* slas2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.f
new file mode 100644
index 0000000000000000000000000000000000000000..536dd65d3fb823a0513454d54818c88fc2c89402
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slas2.f
@@ -0,0 +1,122 @@
+ SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ REAL F, G, H, SSMAX, SSMIN
+* ..
+*
+* Purpose
+* =======
+*
+* SLAS2 computes the singular values of the 2-by-2 matrix
+* [ F G ]
+* [ 0 H ].
+* On return, SSMIN is the smaller singular value and SSMAX is the
+* larger singular value.
+*
+* Arguments
+* =========
+*
+* F (input) REAL
+* The (1,1) element of the 2-by-2 matrix.
+*
+* G (input) REAL
+* The (1,2) element of the 2-by-2 matrix.
+*
+* H (input) REAL
+* The (2,2) element of the 2-by-2 matrix.
+*
+* SSMIN (output) REAL
+* The smaller singular value.
+*
+* SSMAX (output) REAL
+* The larger singular value.
+*
+* Further Details
+* ===============
+*
+* Barring over/underflow, all output quantities are correct to within
+* a few units in the last place (ulps), even in the absence of a guard
+* digit in addition/subtraction.
+*
+* In IEEE arithmetic, the code works correctly if one matrix element is
+* infinite.
+*
+* Overflow will not occur unless the largest singular value itself
+* overflows, or is within a few ulps of overflow. (On machines with
+* partial overflow, like the Cray, overflow may occur if the largest
+* singular value is within a factor of 2 of overflow.)
+*
+* Underflow is harmless if underflow is gradual. Otherwise, results
+* may correspond to a matrix modified by perturbations of size near
+* the underflow threshold.
+*
+* ====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+ REAL ONE
+ PARAMETER ( ONE = 1.0E0 )
+ REAL TWO
+ PARAMETER ( TWO = 2.0E0 )
+* ..
+* .. Local Scalars ..
+ REAL AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ FA = ABS( F )
+ GA = ABS( G )
+ HA = ABS( H )
+ FHMN = MIN( FA, HA )
+ FHMX = MAX( FA, HA )
+ IF( FHMN.EQ.ZERO ) THEN
+ SSMIN = ZERO
+ IF( FHMX.EQ.ZERO ) THEN
+ SSMAX = GA
+ ELSE
+ SSMAX = MAX( FHMX, GA )*SQRT( ONE+
+ $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
+ END IF
+ ELSE
+ IF( GA.LT.FHMX ) THEN
+ AS = ONE + FHMN / FHMX
+ AT = ( FHMX-FHMN ) / FHMX
+ AU = ( GA / FHMX )**2
+ C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
+ SSMIN = FHMN*C
+ SSMAX = FHMX / C
+ ELSE
+ AU = FHMX / GA
+ IF( AU.EQ.ZERO ) THEN
+*
+* Avoid possible harmful underflow if exponent range
+* asymmetric (true SSMIN may not underflow even if
+* AU underflows)
+*
+ SSMIN = ( FHMN*FHMX ) / GA
+ SSMAX = GA
+ ELSE
+ AS = ONE + FHMN / FHMX
+ AT = ( FHMX-FHMN ) / FHMX
+ C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
+ $ SQRT( ONE+( AT*AU )**2 ) )
+ SSMIN = ( FHMN*C )*AU
+ SSMIN = SSMIN + SSMIN
+ SSMAX = GA / ( C+C )
+ END IF
+ END IF
+ END IF
+ RETURN
+*
+* End of SLAS2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.c
new file mode 100644
index 0000000000000000000000000000000000000000..b75f199c297bf286a0e68a38b2740494234223a9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.c
@@ -0,0 +1,96 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slaset_(const char *uplo, const integer *m, const integer *n,
+ real *alpha, real *beta, real *a, const integer *lda)
+{
+ /* Local variables */
+ static integer i, j;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLASET initializes an m-by-n matrix A to BETA on the diagonal and */
+/* ALPHA on the offdiagonals. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be set. */
+/* = 'U': Upper triangular part is set; the strictly lower */
+/* triangular part of A is not changed. */
+/* = 'L': Lower triangular part is set; the strictly upper */
+/* triangular part of A is not changed. */
+/* Otherwise: All of the matrix A is set. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* ALPHA (input) REAL */
+/* The constant to which the offdiagonal elements are to be set.*/
+/* */
+/* BETA (input) REAL */
+/* The constant to which the diagonal elements are to be set. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On exit, the leading m-by-n submatrix of A is set as follows:*/
+/* */
+/* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, */
+/* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, */
+/* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, */
+/* */
+/* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+
+/* Set the strictly upper triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ for (j = 1; j < *n; ++j) {
+ for (i = 0; i < j && i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/* Set the strictly lower triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ for (j = 0; j < *m && j < *n; ++j) {
+ for (i = j + 1; i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+
+ } else {
+
+/* Set the leading m-by-n submatrix to ALPHA. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ a[i + j * *lda] = *alpha;
+ }
+ }
+ }
+
+/* Set the first min(M,N) diagonal elements to BETA. */
+
+ for (i = 0; i < *m && i < *n; ++i) {
+ a[i + i * *lda] = *beta;
+ }
+} /* slaset_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.f
new file mode 100644
index 0000000000000000000000000000000000000000..9e1feea7c6a37bec7d327c9ac5a11e2bf98f05ed
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slaset.f
@@ -0,0 +1,115 @@
+ SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, M, N
+ REAL ALPHA, BETA
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLASET initializes an m-by-n matrix A to BETA on the diagonal and
+* ALPHA on the offdiagonals.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be set.
+* = 'U': Upper triangular part is set; the strictly lower
+* triangular part of A is not changed.
+* = 'L': Lower triangular part is set; the strictly upper
+* triangular part of A is not changed.
+* Otherwise: All of the matrix A is set.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* ALPHA (input) REAL
+* The constant to which the offdiagonal elements are to be set.
+*
+* BETA (input) REAL
+* The constant to which the diagonal elements are to be set.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On exit, the leading m-by-n submatrix of A is set as follows:
+*
+* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+*
+* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+*
+* Set the strictly upper triangular or trapezoidal part of the
+* array to ALPHA.
+*
+ DO 20 J = 2, N
+ DO 10 I = 1, MIN( J-1, M )
+ A( I, J ) = ALPHA
+ 10 CONTINUE
+ 20 CONTINUE
+*
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+*
+* Set the strictly lower triangular or trapezoidal part of the
+* array to ALPHA.
+*
+ DO 40 J = 1, MIN( M, N )
+ DO 30 I = J + 1, M
+ A( I, J ) = ALPHA
+ 30 CONTINUE
+ 40 CONTINUE
+*
+ ELSE
+*
+* Set the leading m-by-n submatrix to ALPHA.
+*
+ DO 60 J = 1, N
+ DO 50 I = 1, M
+ A( I, J ) = ALPHA
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+* Set the first min(M,N) diagonal elements to BETA.
+*
+ DO 70 I = 1, MIN( M, N )
+ A( I, I ) = BETA
+ 70 CONTINUE
+*
+ RETURN
+*
+* End of SLASET
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.c
new file mode 100644
index 0000000000000000000000000000000000000000..ffe4b8c60ac1810056ae7fc92e2e08b0f7eaf3f4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.c
@@ -0,0 +1,73 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void slassq_(const integer *n, const real *x, const integer *incx, real *scale, real *sumsq)
+{
+ /* Local variables */
+ static real absxi;
+ static integer ix;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLASSQ returns the values scl and smsq such that */
+/* */
+/* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,*/
+/* */
+/* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is */
+/* assumed to be non-negative and scl returns the value */
+/* */
+/* scl = max( scale, abs( x( i ) ) ). */
+/* */
+/* scale and sumsq must be supplied in SCALE and SUMSQ and */
+/* scl and smsq are overwritten on SCALE and SUMSQ respectively. */
+/* */
+/* The routine makes only one pass through the vector x. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of elements to be used from the vector X. */
+/* */
+/* X (input) REAL */
+/* The vector for which a scaled sum of squares is computed. */
+/* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector X. */
+/* INCX > 0. */
+/* */
+/* SCALE (input/output) REAL */
+/* On entry, the value scale in the equation above. */
+/* On exit, SCALE is overwritten with scl , the scaling factor*/
+/* for the sum of squares. */
+/* */
+/* SUMSQ (input/output) REAL */
+/* On entry, the value sumsq in the equation above. */
+/* On exit, SUMSQ is overwritten with smsq , the basic sum of */
+/* squares from which scl has been factored out. */
+/* */
+/* =====================================================================*/
+
+ if (*n > 0) {
+ for (ix = 0; *incx < 0 ? ix > *n * *incx : ix < *n * *incx; ix += *incx) {
+ if (x[ix] != 0.f) {
+ absxi = abs(x[ix]);
+ if (*scale < absxi) {
+ *scale /= absxi;
+ *sumsq = *sumsq * *scale * *scale + 1;
+ *scale = absxi;
+ } else {
+ absxi /= *scale;
+ *sumsq += absxi * absxi;
+ }
+ }
+ }
+ }
+} /* slassq_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.f
new file mode 100644
index 0000000000000000000000000000000000000000..04444b6a958c1a4d4f89c2aa4c5a35e1a54403cb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slassq.f
@@ -0,0 +1,89 @@
+ SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ REAL SCALE, SUMSQ
+* ..
+* .. Array Arguments ..
+ REAL X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SLASSQ returns the values scl and smsq such that
+*
+* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+*
+* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+* assumed to be non-negative and scl returns the value
+*
+* scl = max( scale, abs( x( i ) ) ).
+*
+* scale and sumsq must be supplied in SCALE and SUMSQ and
+* scl and smsq are overwritten on SCALE and SUMSQ respectively.
+*
+* The routine makes only one pass through the vector x.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of elements to be used from the vector X.
+*
+* X (input) REAL
+* The vector for which a scaled sum of squares is computed.
+* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+*
+* INCX (input) INTEGER
+* The increment between successive values of the vector X.
+* INCX > 0.
+*
+* SCALE (input/output) REAL
+* On entry, the value scale in the equation above.
+* On exit, SCALE is overwritten with scl , the scaling factor
+* for the sum of squares.
+*
+* SUMSQ (input/output) REAL
+* On entry, the value sumsq in the equation above.
+* On exit, SUMSQ is overwritten with smsq , the basic sum of
+* squares from which scl has been factored out.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER IX
+ REAL ABSXI
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS
+* ..
+* .. Executable Statements ..
+*
+ IF( N.GT.0 ) THEN
+ DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
+ IF( X( IX ).NE.ZERO ) THEN
+ ABSXI = ABS( X( IX ) )
+ IF( SCALE.LT.ABSXI ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
+ SCALE = ABSXI
+ ELSE
+ SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ END IF
+ RETURN
+*
+* End of SLASSQ
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.c
new file mode 100644
index 0000000000000000000000000000000000000000..296342b286269b69f1a0f19a9b557750ed643bf3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.c
@@ -0,0 +1,239 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static real c_b3 = 2.f;
+static real c_b4 = 1.f;
+
+/* Subroutine */ void slasv2_(real *f, real *g, real *h,
+ real *ssmin, real *ssmax, real *snr, real *csr, real *snl, real *csl)
+{
+ /* System generated locals */
+ real r__1;
+
+ /* Local variables */
+ static integer pmax;
+ static real temp;
+ static logical swap;
+ static real a, d, l, m, r, s, t, tsign, fa, ga, ha, ft, gt, ht, mm;
+ static logical gasmal;
+ static real tt, clt, crt, slt, srt;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SLASV2 computes the singular value decomposition of a 2-by-2 */
+/* triangular matrix */
+/* [ F G ] */
+/* [ 0 H ]. */
+/* On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the*/
+/* smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and */
+/* right singular vectors for abs(SSMAX), giving the decomposition */
+/* */
+/* [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] */
+/* [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* F (input) REAL */
+/* The (1,1) element of the 2-by-2 matrix. */
+/* */
+/* G (input) REAL */
+/* The (1,2) element of the 2-by-2 matrix. */
+/* */
+/* H (input) REAL */
+/* The (2,2) element of the 2-by-2 matrix. */
+/* */
+/* SSMIN (output) REAL */
+/* abs(SSMIN) is the smaller singular value. */
+/* */
+/* SSMAX (output) REAL */
+/* abs(SSMAX) is the larger singular value. */
+/* */
+/* SNL (output) REAL */
+/* CSL (output) REAL */
+/* The vector (CSL, SNL) is a unit left singular vector for the */
+/* singular value abs(SSMAX). */
+/* */
+/* SNR (output) REAL */
+/* CSR (output) REAL */
+/* The vector (CSR, SNR) is a unit right singular vector for the*/
+/* singular value abs(SSMAX). */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* Any input parameter may be aliased with any output parameter. */
+/* */
+/* Barring over/underflow and assuming a guard digit in subtraction, all*/
+/* output quantities are correct to within a few units in the last */
+/* place (ulps). */
+/* */
+/* In IEEE arithmetic, the code works correctly if one matrix element is*/
+/* infinite. */
+/* */
+/* Overflow will not occur unless the largest singular value itself */
+/* overflows or is within a few ulps of overflow. (On machines with */
+/* partial overflow, like the Cray, overflow may occur if the largest */
+/* singular value is within a factor of 2 of overflow.) */
+/* */
+/* Underflow is harmless if underflow is gradual. Otherwise, results */
+/* may correspond to a matrix modified by perturbations of size near */
+/* the underflow threshold. */
+/* */
+/* ===================================================================== */
+
+ ft = *f;
+ fa = abs(ft);
+ ht = *h;
+ ha = abs(*h);
+
+/* PMAX points to the maximum absolute element of matrix */
+/* PMAX = 1 if F largest in absolute values */
+/* PMAX = 2 if G largest in absolute values */
+/* PMAX = 3 if H largest in absolute values */
+
+ pmax = 1;
+ swap = ha > fa;
+ if (swap) {
+ pmax = 3;
+ temp = ft;
+ ft = ht;
+ ht = temp;
+ temp = fa;
+ fa = ha;
+ ha = temp;
+ }
+
+/* Now FA .ge. HA */
+
+ gt = *g;
+ ga = abs(gt);
+ if (ga == 0.f) {
+
+/* Diagonal matrix */
+
+ *ssmin = ha;
+ *ssmax = fa;
+ clt = 1.f;
+ crt = 1.f;
+ slt = 0.f;
+ srt = 0.f;
+ } else {
+ gasmal = TRUE_;
+ if (ga > fa) {
+ pmax = 2;
+ if (fa / ga < slamch_("EPS")) {
+
+/* Case of very large GA */
+
+ gasmal = FALSE_;
+ *ssmax = ga;
+ if (ha > 1.f) {
+ *ssmin = fa / (ga / ha);
+ } else {
+ *ssmin = fa / ga * ha;
+ }
+ clt = 1.f;
+ slt = ht / gt;
+ srt = 1.f;
+ crt = ft / gt;
+ }
+ }
+ if (gasmal) {
+
+/* Normal case */
+
+ d = fa - ha;
+ if (d == fa) {
+
+/* Copes with infinite F or H */
+
+ l = 1.f;
+ } else {
+ l = d / fa;
+ }
+
+/* Note that 0 .le. L .le. 1 */
+
+ m = gt / ft;
+
+/* Note that abs(M) .le. 1/macheps */
+
+ t = 2.f - l;
+
+/* Note that T .ge. 1 */
+
+ mm = m * m;
+ tt = t * t;
+ s = sqrtf(tt + mm);
+
+/* Note that 1 .le. S .le. 1 + 1/macheps */
+
+ if (l == 0.f) {
+ r = abs(m);
+ } else {
+ r = sqrtf(l * l + mm);
+ }
+
+/* Note that 0 .le. R .le. 1 + 1/macheps */
+
+ a = (s + r) * .5f;
+
+/* Note that 1 .le. A .le. 1 + abs(M) */
+
+ *ssmin = ha / a;
+ *ssmax = fa * a;
+ if (mm == 0.f) {
+
+/* Note that M is very tiny */
+
+ if (l == 0.f) {
+ t = r_sign(&c_b3, &ft) * r_sign(&c_b4, >);
+ } else {
+ t = gt / r_sign(&d, &ft) + m / t;
+ }
+ } else {
+ t = (m / (s + t) + m / (r + l)) * (a + 1.f);
+ }
+ l = sqrtf(t * t + 4.f);
+ crt = 2.f / l;
+ srt = t / l;
+ clt = (crt + srt * m) / a;
+ slt = ht / ft * srt / a;
+ }
+ }
+ if (swap) {
+ *csl = srt;
+ *snl = crt;
+ *csr = slt;
+ *snr = clt;
+ } else {
+ *csl = clt;
+ *snl = slt;
+ *csr = crt;
+ *snr = srt;
+ }
+
+/* Correct signs of SSMAX and SSMIN */
+
+ if (pmax == 1) {
+ tsign = r_sign(&c_b4, csr) * r_sign(&c_b4, csl) * r_sign(&c_b4, f);
+ }
+ if (pmax == 2) {
+ tsign = r_sign(&c_b4, snr) * r_sign(&c_b4, csl) * r_sign(&c_b4, g);
+ }
+ if (pmax == 3) {
+ tsign = r_sign(&c_b4, snr) * r_sign(&c_b4, snl) * r_sign(&c_b4, h);
+ }
+ *ssmax = r_sign(ssmax, &tsign);
+ r__1 = tsign * r_sign(&c_b4, f) * r_sign(&c_b4, h);
+ *ssmin = r_sign(ssmin, &r__1);
+} /* slasv2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.f
new file mode 100644
index 0000000000000000000000000000000000000000..c6f8efd5292c21ebd007268ee3e3020025ba6082
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/slasv2.f
@@ -0,0 +1,250 @@
+ SUBROUTINE SLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ REAL CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
+* ..
+*
+* Purpose
+* =======
+*
+* SLASV2 computes the singular value decomposition of a 2-by-2
+* triangular matrix
+* [ F G ]
+* [ 0 H ].
+* On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+* smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+* right singular vectors for abs(SSMAX), giving the decomposition
+*
+* [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+* [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+*
+* Arguments
+* =========
+*
+* F (input) REAL
+* The (1,1) element of the 2-by-2 matrix.
+*
+* G (input) REAL
+* The (1,2) element of the 2-by-2 matrix.
+*
+* H (input) REAL
+* The (2,2) element of the 2-by-2 matrix.
+*
+* SSMIN (output) REAL
+* abs(SSMIN) is the smaller singular value.
+*
+* SSMAX (output) REAL
+* abs(SSMAX) is the larger singular value.
+*
+* SNL (output) REAL
+* CSL (output) REAL
+* The vector (CSL, SNL) is a unit left singular vector for the
+* singular value abs(SSMAX).
+*
+* SNR (output) REAL
+* CSR (output) REAL
+* The vector (CSR, SNR) is a unit right singular vector for the
+* singular value abs(SSMAX).
+*
+* Further Details
+* ===============
+*
+* Any input parameter may be aliased with any output parameter.
+*
+* Barring over/underflow and assuming a guard digit in subtraction, all
+* output quantities are correct to within a few units in the last
+* place (ulps).
+*
+* In IEEE arithmetic, the code works correctly if one matrix element is
+* infinite.
+*
+* Overflow will not occur unless the largest singular value itself
+* overflows or is within a few ulps of overflow. (On machines with
+* partial overflow, like the Cray, overflow may occur if the largest
+* singular value is within a factor of 2 of overflow.)
+*
+* Underflow is harmless if underflow is gradual. Otherwise, results
+* may correspond to a matrix modified by perturbations of size near
+* the underflow threshold.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO
+ PARAMETER ( ZERO = 0.0E0 )
+ REAL HALF
+ PARAMETER ( HALF = 0.5E0 )
+ REAL ONE
+ PARAMETER ( ONE = 1.0E0 )
+ REAL TWO
+ PARAMETER ( TWO = 2.0E0 )
+ REAL FOUR
+ PARAMETER ( FOUR = 4.0E0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL GASMAL, SWAP
+ INTEGER PMAX
+ REAL A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
+ $ MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SIGN, SQRT
+* ..
+* .. External Functions ..
+ REAL SLAMCH
+ EXTERNAL SLAMCH
+* ..
+* .. Executable Statements ..
+*
+ FT = F
+ FA = ABS( FT )
+ HT = H
+ HA = ABS( H )
+*
+* PMAX points to the maximum absolute element of matrix
+* PMAX = 1 if F largest in absolute values
+* PMAX = 2 if G largest in absolute values
+* PMAX = 3 if H largest in absolute values
+*
+ PMAX = 1
+ SWAP = ( HA.GT.FA )
+ IF( SWAP ) THEN
+ PMAX = 3
+ TEMP = FT
+ FT = HT
+ HT = TEMP
+ TEMP = FA
+ FA = HA
+ HA = TEMP
+*
+* Now FA .ge. HA
+*
+ END IF
+ GT = G
+ GA = ABS( GT )
+ IF( GA.EQ.ZERO ) THEN
+*
+* Diagonal matrix
+*
+ SSMIN = HA
+ SSMAX = FA
+ CLT = ONE
+ CRT = ONE
+ SLT = ZERO
+ SRT = ZERO
+ ELSE
+ GASMAL = .TRUE.
+ IF( GA.GT.FA ) THEN
+ PMAX = 2
+ IF( ( FA / GA ).LT.SLAMCH( 'EPS' ) ) THEN
+*
+* Case of very large GA
+*
+ GASMAL = .FALSE.
+ SSMAX = GA
+ IF( HA.GT.ONE ) THEN
+ SSMIN = FA / ( GA / HA )
+ ELSE
+ SSMIN = ( FA / GA )*HA
+ END IF
+ CLT = ONE
+ SLT = HT / GT
+ SRT = ONE
+ CRT = FT / GT
+ END IF
+ END IF
+ IF( GASMAL ) THEN
+*
+* Normal case
+*
+ D = FA - HA
+ IF( D.EQ.FA ) THEN
+*
+* Copes with infinite F or H
+*
+ L = ONE
+ ELSE
+ L = D / FA
+ END IF
+*
+* Note that 0 .le. L .le. 1
+*
+ M = GT / FT
+*
+* Note that abs(M) .le. 1/macheps
+*
+ T = TWO - L
+*
+* Note that T .ge. 1
+*
+ MM = M*M
+ TT = T*T
+ S = SQRT( TT+MM )
+*
+* Note that 1 .le. S .le. 1 + 1/macheps
+*
+ IF( L.EQ.ZERO ) THEN
+ R = ABS( M )
+ ELSE
+ R = SQRT( L*L+MM )
+ END IF
+*
+* Note that 0 .le. R .le. 1 + 1/macheps
+*
+ A = HALF*( S+R )
+*
+* Note that 1 .le. A .le. 1 + abs(M)
+*
+ SSMIN = HA / A
+ SSMAX = FA*A
+ IF( MM.EQ.ZERO ) THEN
+*
+* Note that M is very tiny
+*
+ IF( L.EQ.ZERO ) THEN
+ T = SIGN( TWO, FT )*SIGN( ONE, GT )
+ ELSE
+ T = GT / SIGN( D, FT ) + M / T
+ END IF
+ ELSE
+ T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
+ END IF
+ L = SQRT( T*T+FOUR )
+ CRT = TWO / L
+ SRT = T / L
+ CLT = ( CRT+SRT*M ) / A
+ SLT = ( HT / FT )*SRT / A
+ END IF
+ END IF
+ IF( SWAP ) THEN
+ CSL = SRT
+ SNL = CRT
+ CSR = SLT
+ SNR = CLT
+ ELSE
+ CSL = CLT
+ SNL = SLT
+ CSR = CRT
+ SNR = SRT
+ END IF
+*
+* Correct signs of SSMAX and SSMIN
+*
+ IF( PMAX.EQ.1 )
+ $ TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
+ IF( PMAX.EQ.2 )
+ $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
+ IF( PMAX.EQ.3 )
+ $ TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
+ SSMAX = SIGN( SSMAX, TSIGN )
+ SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
+ RETURN
+*
+* End of SLASV2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/smvpc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/smvpc.f
new file mode 100644
index 0000000000000000000000000000000000000000..d8b234a3f1a9ccf63e7b75acfa9b715c0d86c6ac
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/smvpc.f
@@ -0,0 +1,32 @@
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SMVPC(NBLOCK, BET, MAXJ, J, S, NUMBER, RESNRM,
+ * ORTHCF, RV)
+C
+ INTEGER NBLOCK, MAXJ, J, NUMBER
+ REAL BET(NBLOCK,1), S(MAXJ,1), RESNRM(1),
+ * ORTHCF(1), RV(1)
+C
+C THIS SUBROUTINE COMPUTES THE NORM AND THE SMALLEST ELEMENT
+C (IN ABSOLUTE VALUE) OF THE VECTOR BET*SJI, WHERE SJI
+C IS AN NBLOCK VECTOR OF THE LAST NBLOCK ELEMENTS OF THE ITH
+C EIGENVECTOR OF T. THESE QUANTITIES ARE THE RESIDUAL NORM
+C AND THE ORTHOGONALITY COEFFICIENT RESPECTIVELY FOR THE
+C CORRESPONDING RITZ PAIR. THE ORTHOGONALITY COEFFICIENT IS
+C NORMALIZED TO ACCOUNT FOR THE LOCAL REORTHOGONALIZATION.
+C
+ INTEGER I, K, M
+ REAL SDOT, SNRM2, ABS, AMIN1
+C
+ M = J - NBLOCK + 1
+ DO 20 I=1,NUMBER
+ DO 10 K=1,NBLOCK
+ RV(K) = SDOT(NBLOCK,S(M,I),1,BET(K,1),NBLOCK)
+ IF (K.EQ.1) ORTHCF(I) = ABS(RV(K))
+ ORTHCF(I) = AMIN1(ORTHCF(I),ABS(RV(K)))
+ 10 CONTINUE
+ RESNRM(I) = SNRM2(NBLOCK,RV,1)
+ 20 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.c
new file mode 100644
index 0000000000000000000000000000000000000000..1b7332acb0aa44165fa2d9badd0deb2d5c02f579
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.c
@@ -0,0 +1,1872 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+static void slabax_(const integer *n, const integer *nband, real *a, real *x, real *y);
+static void slabcm_(const integer *n, const integer *nband, const integer *nl, const integer *nr,
+ real *a, real *eigval, const integer *lde, real *eigvec,
+ real *atol, real *artol, real *bound, real *atemp, real *d, real *vtemp);
+static void slabfc_(const integer *n, const integer *nband, real *a, real *sigma, const integer *number,
+ const integer *lde, real *eigvec, integer *numl, integer *ldad,
+ real *atemp, real *d, real *atol);
+static void slaeig_(const integer *n, const integer *nband, const integer *nl, const integer *nr,
+ real *a, real *eigval, const integer *lde,
+ real *eigvec, real *bound, real *atemp, real *d,
+ real *vtemp, real *eps, real *tmin, real *tmax);
+static void slager_(const integer *n, const integer *nband, const integer *nstart,
+ real *a, real *tmin, real *tmax);
+static void slaran_(const integer *n, real *x);
+static void smvpc_(const integer *nblock, const real *bet, const integer *maxj, const integer *j,
+ const real *s, const integer *number, real *resnrm, real *orthcf, real *rv);
+static void snppla_(void (*op)(const integer*,const integer*,const real*,real*),
+ void (*iovect)(const integer*,const integer*,real*,const integer*,const integer*),
+ const integer *n, const integer *nperm, integer *nop, const integer *nmval,
+ real *val, const integer *nmvec, real *vec, const integer *nblock,
+ real *h, real *hv, real *p, real *q, real *bound,
+ real *d, real *delta, logical *small, logical *raritz, real *eps);
+static void snwla_(void (*op)(const integer*,const integer*,const real*,real*),
+ void (*iovect)(const integer*,const integer*,real*,const integer*,const integer*),
+ const integer *n, const integer *nband, const integer *nval,
+ const integer *nfig, integer *nperm, real *val, const integer *nmvec, real *vec,
+ const integer *nblock, const integer *maxop, const integer *maxj, integer *nop,
+ real *p1, real *p0, real *res, real *tau, real *otau,
+ real *t, real *alp, real *bet, real *s, real *p2,
+ real *bound, real *atemp, real *vtemp,
+ real *d, integer *ind, logical *small, logical *raritz,
+ real *delta, real *eps, integer *ierr);
+static void sortqr_(const integer *nz, const integer *n, const integer *nblock, real *z, real *b);
+static void svsort_(const integer *num, real *val, real *res, const integer *iflag,
+ real *v, const integer *nmvec, const integer *n, real *vec);
+
+/* Table of constant values */
+static integer c__0 = 0;
+static integer c__1 = 1;
+static real c__10 = 0.1f;
+static real c__00 = 0.0f;
+
+/* VERSION 2 DOES NOT USE EISPACK */
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */ void snlaso_(op, iovect, n, nval, nfig, nperm, nmval, val, nmvec, vec, nblock, maxop, maxj, work, ind, ierr)
+void (*op) (const integer* n,const integer* m,const real* p,real* q);
+void (*iovect) (const integer* n,const integer* m,real* q,const integer* j,const integer* k);
+const integer *n, *nval, *nfig, *nmval;
+integer *nperm;
+real *val;
+const integer *nmvec;
+real *vec;
+const integer *nblock, *maxop, *maxj;
+real *work;
+integer *ind, *ierr;
+{
+ /* Local variables */
+ static real temp, tarr;
+ static integer i, m, nband;
+ static real delta;
+ static logical small;
+ static integer i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, nv;
+ static logical raritz;
+ static real eps;
+ static integer nop;
+
+/* AUTHOR/IMPLEMENTER D.S.SCOTT-B.N.PARLETT/D.S.SCOTT */
+/* */
+/* COMPUTER SCIENCES DEPARTMENT */
+/* UNIVERSITY OF TEXAS AT AUSTIN */
+/* AUSTIN, TX 78712 */
+/* */
+/* VERSION 2 ORIGINATED APRIL 1982 */
+/* */
+/* CURRENT VERSION JUNE 1983 */
+
+/* SNLASO FINDS A FEW EIGENVALUES AND EIGENVECTORS AT EITHER END OF */
+/* THE SPECTRUM OF A LARGE SPARSE SYMMETRIC MATRIX. THE SUBROUTINE */
+/* SNLASO IS PRIMARILY A DRIVER FOR SUBROUTINE SNWLA WHICH IMPLEMENTS */
+/* THE LANCZOS ALGORITHM WITH SELECTIVE ORTHOGONALIZATION AND */
+/* SUBROUTINE SNPPLA WHICH POST PROCESSES THE OUTPUT OF SNWLA. */
+/* HOWEVER SNLASO DOES CHECK FOR INCONSISTENCIES IN THE CALLING */
+/* PARAMETERS AND DOES PREPROCESS ANY USER SUPPLIED EIGENPAIRS. */
+/* SNLASO ALWAYS LOOKS FOR THE SMALLEST (LEFTMOST) EIGENVALUES. IF */
+/* THE LARGEST EIGENVALUES ARE DESIRED SNLASO IMPLICITLY USES THE */
+/* NEGATIVE OF THE MATRIX. */
+/* */
+/* ON INPUT */
+/* */
+/* OP A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE */
+/* OP(N,M,P,Q). P AND Q ARE N X M MATRICES AND Q IS */
+/* RETURNED AS THE MATRIX TIMES P. */
+/* */
+/* IOVECT A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE */
+/* IOVECT(N,M,Q,J,K). Q IS AN N X M MATRIX. IF K = 0 */
+/* THE COLUMNS OF Q ARE STORED AS THE (J-M+1)TH THROUGH */
+/* THE JTH LANCZOS VECTORS. IF K = 1 THEN Q IS RETURNED */
+/* AS THE (J-M+1)TH THROUGH THE JTH LANCZOS VECTORS. SEE */
+/* DOCUMENTATION FOR FURTHER DETAILS AND EXAMPLES. */
+/* */
+/* N THE ORDER OF THE MATRIX. */
+/* */
+/* NVAL NVAL SPECIFIES THE EIGENVALUES TO BE FOUND. */
+/* ABS(NVAL) IS THE NUMBER OF EIGENVALUES DESIRED. */
+/* IF NVAL < 0 THE ALGEBRAICALLY SMALLEST (LEFTMOST) */
+/* EIGENVALUES ARE FOUND. IF NVAL > 0 THE ALGEBRAICALLY */
+/* LARGEST (RIGHTMOST) EIGENVALUES ARE FOUND. NVAL MUST NOT */
+/* BE ZERO. ABS(NVAL) MUST BE LESS THAN MAXJ/2. */
+/* */
+/* NFIG THE NUMBER OF DECIMAL DIGITS OF ACCURACY DESIRED IN THE */
+/* EIGENVALUES. NFIG MUST BE GREATER THAN OR EQUAL TO 1. */
+/* */
+/* NPERM AN INTEGER VARIABLE WHICH SPECIFIES THE NUMBER OF USER */
+/* SUPPLIED EIGENPAIRS. IN MOST CASES NPERM WILL BE ZERO. SEE */
+/* DOCUMENTAION FOR FURTHER DETAILS OF USING NPERM GREATER */
+/* THAN ZERO. NPERM MUST NOT BE LESS THAN ZERO. */
+/* */
+/* NMVAL THE ROW DIMENSION OF THE ARRAY VAL. NMVAL MUST BE GREATER */
+/* THAN OR EQUAL TO ABS(NVAL). */
+/* */
+/* VAL A TWO DIMENSIONAL REAL ARRAY OF ROW */
+/* DIMENSION NMVAL AND COLUMN DIMENSION AT LEAST 4. IF NPERM */
+/* IS GREATER THAN ZERO THEN CERTAIN INFORMATION MUST BE STORED */
+/* IN VAL. SEE DOCUMENTATION FOR DETAILS. */
+/* */
+/* NMVEC THE ROW DIMENSION OF THE ARRAY VEC. NMVEC MUST BE GREATER */
+/* THAN OR EQUAL TO N. */
+/* */
+/* VEC A TWO DIMENSIONAL REAL ARRAY OF ROW */
+/* DIMENSION NMVEC AND COLUMN DIMENSION AT LEAST ABS(NVAL). IF */
+/* NPERM > 0 THEN THE FIRST NPERM COLUMNS OF VEC MUST */
+/* CONTAIN THE USER SUPPLIED EIGENVECTORS. */
+/* */
+/* NBLOCK THE BLOCK SIZE. SEE DOCUMENTATION FOR CHOOSING */
+/* AN APPROPRIATE VALUE FOR NBLOCK. NBLOCK MUST BE GREATER */
+/* THAN ZERO AND LESS THAN MAXJ/6. */
+/* */
+/* MAXOP AN UPPER BOUND ON THE NUMBER OF CALLS TO THE SUBROUTINE */
+/* OP. SNLASO TERMINATES WHEN MAXOP IS EXCEEDED. SEE */
+/* DOCUMENTATION FOR GUIDELINES IN CHOOSING A VALUE FOR MAXOP. */
+/* */
+/* MAXJ AN INDICATION OF THE AVAILABLE STORAGE (SEE WORK AND */
+/* DOCUMENTATION ON IOVECT). FOR THE FASTEST CONVERGENCE MAXJ */
+/* SHOULD BE AS LARGE AS POSSIBLE, ALTHOUGH IT IS USELESS TO HAVE */
+/* MAXJ LARGER THAN MAXOP*NBLOCK. */
+/* */
+/* WORK A REAL ARRAY OF DIMENSION AT LEAST AS */
+/* LARGE AS */
+/* */
+/* 2*N*NBLOCK + MAXJ*(NBLOCK+NV+2) + 2*NBLOCK*NBLOCK + 3*NV */
+/* */
+/* + THE MAXIMUM OF */
+/* N*NBLOCK */
+/* AND */
+/* MAXJ*(2*NBLOCK+3) + 2*NV + 6 + (2*NBLOCK+2)*(NBLOCK+1) */
+/* */
+/* WHERE NV = ABS(NVAL) */
+/* */
+/* THE FIRST N*NBLOCK ELEMENTS OF WORK MUST CONTAIN THE DESIRED */
+/* STARTING VECTORS. SEE DOCUMENTATION FOR GUIDELINES IN */
+/* CHOOSING STARTING VECTORS. */
+/* */
+/* IND AN INTEGER ARRAY OF DIMENSION AT LEAST ABS(NVAL). */
+/* */
+/* IERR AN INTEGER VARIABLE. */
+/* */
+/* ON OUTPUT */
+/* */
+/* NPERM THE NUMBER OF EIGENPAIRS NOW KNOWN. */
+/* */
+/* VEC THE FIRST NPERM COLUMNS OF VEC CONTAIN THE EIGENVECTORS. */
+/* */
+/* VAL THE FIRST COLUMN OF VAL CONTAINS THE CORRESPONDING */
+/* EIGENVALUES. THE SECOND COLUMN CONTAINS THE RESIDUAL NORMS OF */
+/* THE EIGENPAIRS WHICH ARE BOUNDS ON THE ACCURACY OF THE EIGEN- */
+/* VALUES. THE THIRD COLUMN CONTAINS MORE REALISTIC ESTIMATES */
+/* OF THE ACCURACY OF THE EIGENVALUES. THE FOURTH COLUMN CONTAINS */
+/* ESTIMATES OF THE ACCURACY OF THE EIGENVECTORS. SEE */
+/* DOCUMENTATION FOR FURTHER INFORMATION ON THESE QUANTITIES. */
+/* */
+/* WORK IF WORK IS TERMINATED BEFORE COMPLETION (IERR = -2) */
+/* THE FIRST N*NBLOCK ELEMENTS OF WORK CONTAIN THE BEST VECTORS */
+/* FOR RESTARTING THE ALGORITHM AND SNLASO CAN BE IMMEDIATELY */
+/* RECALLED TO CONTINUE WORKING ON THE PROBLEM. */
+/* */
+/* IND IND(1) CONTAINS THE ACTUAL NUMBER OF CALLS TO OP. ON SOME */
+/* OCCASIONS THE NUMBER OF CALLS TO OP MAY BE SLIGHTLY LARGER */
+/* THAN MAXOP. */
+/* */
+/* IERR AN ERROR COMPLETION CODE. THE NORMAL COMPLETION CODE IS */
+/* ZERO. SEE THE DOCUMENTATION FOR INTERPRETATIONS OF NON-ZERO */
+/* COMPLETION CODES. */
+/* */
+/* INTERNAL VARIABLES. */
+/* */
+/* NOP RETURNED FROM SNWLA AS THE NUMBER OF CALLS TO THE */
+/* SUBROUTINE OP. */
+/* */
+/* NV SET EQUAL TO ABS(NVAL), THE NUMBER OF EIGENVALUES DESIRED, */
+/* AND PASSED TO SNWLA. */
+/* */
+/* SMALL SET TO .TRUE. IF THE SMALLEST EIGENVALUES ARE DESIRED. */
+/* */
+/* RARITZ RETURNED FROM SNWLA AND PASSED TO SNPPLA. RARITZ IS .TRUE. */
+/* IF A FINAL RAYLEIGH-RITZ PROCEDURE IS NEEDED. */
+/* */
+/* DELTA RETURNED FROM SNWLA AS THE EIGENVALUE OF THE MATRIX */
+/* WHICH IS CLOSEST TO THE DESIRED EIGENVALUES. */
+/* */
+/* SNPPLA A SUBROUTINE FOR POST-PROCESSING THE EIGENVECTORS COMPUTED */
+/* BY SNWLA. */
+/* */
+/* SNWLA A SUBROUTINE FOR IMPLEMENTING THE LANCZOS ALGORITHM */
+/* WITH SELECTIVE ORTHOGONALIZATION. */
+/* */
+/* SMVPC A SUBROUTINE FOR COMPUTING THE RESIDUAL NORM AND */
+/* ORTHOGONALITY COEFFICIENT OF GIVEN RITZ VECTORS. */
+/* */
+/* SORTQR A SUBROUTINE FOR ORTHONORMALIZING A BLOCK OF VECTORS */
+/* USING HOUSEHOLDER REFLECTIONS. */
+/* */
+/* SAXPY,SCOPY,SDOT,SNRM2,SSCAL,SSWAP A SUBSET OF THE BASIC LINEAR */
+/* ALGEBRA SUBPROGRAMS USED FOR VECTOR MANIPULATION. */
+/* */
+/* SLARAN A SUBROUTINE TO GENERATE RANDOM VECTORS */
+/* */
+/* SLAEIG, SLAGER, SLABCM, SLABFC SUBROUTINES FOR BAND EIGENVALUE */
+/* CALCULATIONS. */
+/* */
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CHECKS FOR INCONSISTENCY IN THE INPUT PARAMETERS. */
+
+ nv = abs(*nval);
+ ind[0] = 0;
+ *ierr = 0;
+ if (*n < *nblock * 6) {
+ *ierr = 1;
+ }
+ if (*nfig <= 0) {
+ *ierr += 2;
+ }
+ if (*nmvec < *n) {
+ *ierr += 4;
+ }
+ if (*nperm < 0) {
+ *ierr += 8;
+ }
+ if (*maxj < *nblock * 6) {
+ *ierr += 16;
+ }
+ if (nv < max(1,*nperm)) {
+ *ierr += 32;
+ }
+ if (nv > *nmval) {
+ *ierr += 64;
+ }
+ if (nv > *maxop) {
+ *ierr += 128;
+ }
+ if (nv >= *maxj / 2) {
+ *ierr += 256;
+ }
+ if (*nblock < 1) {
+ *ierr += 512;
+ }
+ if (*ierr != 0) {
+ return;
+ }
+
+ small = *nval < 0;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION SORTS AND ORTHONORMALIZES THE USER SUPPLIED VECTORS. */
+/* IF A USER SUPPLIED VECTOR IS ZERO OR IF SIGNIFICANT CANCELLATION */
+/* OCCURS IN THE ORTHOGONALIZATION PROCESS THEN IERR IS SET TO -1 */
+/* AND SNLASO TERMINATES. */
+
+ if (*nperm == 0) {
+ goto L110;
+ }
+
+/* THIS NEGATES THE USER SUPPLIED EIGENVALUES WHEN THE LARGEST */
+/* EIGENVALUES ARE DESIRED, SINCE SNWLA WILL IMPLICITLY USE THE */
+/* NEGATIVE OF THE MATRIX. */
+
+ if (!small)
+ for (i = 0; i < *nperm; ++i) {
+ val[i] = -val[i];
+ }
+
+/* THIS SORTS THE USER SUPPLIED VALUES AND VECTORS. */
+
+ svsort_(nperm, val, &val[*nmval], &c__0, &tarr, nmvec, n, vec);
+
+/* THIS STORES THE NORMS OF THE VECTORS FOR LATER COMPARISON. */
+/* IT ALSO INSURES THAT THE RESIDUAL NORMS ARE POSITIVE. */
+
+ for (i = 0; i < *nperm; ++i) {
+ val[i + *nmval] = abs(val[i + *nmval]);
+ val[i + *nmval * 2] = snrm2_(n, &vec[i * *nmvec], &c__1);
+ }
+
+/* THIS PERFORMS THE ORTHONORMALIZATION. */
+
+ m = *n * *nblock;
+ sortqr_(nmvec, n, nperm, vec, &work[m]);
+ for (i = 0; i < *nperm; ++i, m += *nperm + 1) {
+ if (abs(work[m]) <= val[i + *nmval * 2] * .9f) {
+ *ierr = -1;
+ return;
+ }
+ }
+
+/* THIS COPIES THE RESIDUAL NORMS INTO THE CORRECT LOCATIONS IN */
+/* THE ARRAY WORK FOR LATER REFERENCE IN SNWLA. */
+
+ m = (*n << 1) * *nblock;
+ scopy_(nperm, &val[*nmval], &c__1, &work[m], &c__1);
+
+/* THIS SETS EPS TO AN APPROXIMATION OF THE RELATIVE MACHINE */
+/* PRECISION */
+
+/* ***THIS SHOULD BE REPLACED BY AN ASSIGNMENT STATEMENT */
+/* ***IN A PRODUCTION CODE */
+
+L110:
+ eps = 1.f;
+ for (i = 0; i < 1000; ++i) {
+ eps *= .5f;
+ temp = eps + 1.f;
+ if (temp == 1.f) {
+ break;
+ }
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CALLS SNWLA WHICH IMPLEMENTS THE LANCZOS ALGORITHM */
+/* WITH SELECTIVE ORTHOGONALIZATION. */
+
+ nband = *nblock + 1;
+ i1 = *n * *nblock;
+ i2 = i1 + *n * *nblock;
+ i3 = i2 + nv;
+ i4 = i3 + nv;
+ i5 = i4 + nv;
+ i6 = i5 + *maxj * nband;
+ i7 = i6 + *nblock * *nblock;
+ i8 = i7 + *nblock * *nblock;
+ i9 = i8 + *maxj * (nv + 1);
+ i10 = i9 + *nblock;
+ i11 = i10 + (nv << 1) + 6;
+ i12 = i11 + *maxj * ((*nblock << 1) + 1);
+ i13 = i12 + *maxj;
+ snwla_(op, iovect, n, &nband, &nv, nfig, nperm, val, nmvec, vec, nblock,
+ maxop, maxj, &nop, work, &work[i1], &work[i2], &work[i3], &work[i4],
+ &work[i5], &work[i6], &work[i7], &work[i8], &work[i9], &work[i10],
+ &work[i11], &work[i12], &work[i13], ind, &small, &raritz, &delta, &eps, ierr);
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION CALLS SNPPLA (THE POST PROCESSOR). */
+
+ if (*nperm == 0) {
+ ind[0] = nop;
+ return;
+ }
+ i1 = *n * *nblock;
+ i2 = i1 + *nperm * *nperm;
+ i3 = i2 + *nperm * *nperm;
+ i4 = i3 + max(*n * *nblock, 2 * *nperm * *nperm);
+ i5 = i4 + *n * *nblock;
+ i6 = i5 + (*nperm << 1) + 4;
+ snppla_(op, iovect, n, nperm, &nop, nmval, val, nmvec, vec, nblock,
+ &work[i1], &work[i2], &work[i3], &work[i4], &work[i5], &work[i6],
+ &delta, &small, &raritz, &eps);
+
+ ind[0] = nop;
+ return;
+} /* snlaso_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void snwla_(op, iovect, n, nband, nval, nfig, nperm, val,
+ nmvec, vec, nblock, maxop, maxj, nop, p1, p0, res, tau, otau, t, alp,
+ bet, s, p2, bound, atemp, vtemp, d, ind, small, raritz, delta, eps, ierr)
+/* Subroutine */
+void (*op) (const integer*,const integer*,const real*,real*);
+/* Subroutine */
+void (*iovect) (const integer*,const integer*,real*,const integer*,const integer*);
+const integer *n, *nband, *nval, *nfig;
+integer *nperm;
+real *val;
+const integer *nmvec;
+real *vec;
+const integer *nblock, *maxop, *maxj;
+integer *nop;
+real *p1, *p0, *res, *tau, *otau, *t, *alp, *bet, *s, *p2, *bound, *atemp, *vtemp, *d;
+integer *ind;
+logical *small, *raritz;
+real *delta, *eps;
+integer *ierr;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static real tola, temp, tolg, tmin, tmax, tarr;
+ static logical test;
+ static real zero=0.f, utol;
+ static integer i, j, k, l, m;
+ static integer ngood, nleft;
+ static real anorm;
+ static integer mtemp;
+ static integer i1;
+ static real pnorm, epsrt, rnorm;
+ static integer ng;
+ static real betmin, alpmin, betmax, alpmax;
+ static integer ntheta;
+ static logical enough;
+ static integer number, nstart;
+
+/* SNWLA IMPLEMENTS THE LANCZOS ALGORITHM WITH SELECTIVE */
+/* ORTHOGONALIZATION. */
+/* */
+/* NBAND NBLOCK + 1 THE BAND WIDTH OF T. */
+/* */
+/* NVAL THE NUMBER OF DESIRED EIGENVALUES. */
+/* */
+/* NPERM THE NUMBER OF PERMANENT VECTORS (THOSE EIGENVECTORS */
+/* INPUT BY THE USER OR THOSE EIGENVECTORS SAVED WHEN THE */
+/* ALGORITHM IS ITERATED). PERMANENT VECTORS ARE ORTHOGONAL */
+/* TO THE CURRENT KRYLOV SUBSPACE. */
+/* */
+/* NOP THE NUMBER OF CALLS TO OP. */
+/* */
+/* P0, P1, AND P2 THE CURRENT BLOCKS OF LANCZOS VECTORS. */
+/* */
+/* RES THE (APPROXIMATE) RESIDUAL NORMS OF THE PERMANENT VECTORS. */
+/* */
+/* TAU AND OTAU USED TO MONITOR THE NEED FOR ORTHOGONALIZATION. */
+/* */
+/* T THE BAND MATRIX. */
+/* */
+/* ALP THE CURRENT DIAGONAL BLOCK. */
+/* */
+/* BET THE CURRENT OFF DIAGONAL BLOCK. */
+/* */
+/* BOUND, ATEMP, VTEMP, D */
+/* TEMPORARY STORAGE USED BY THE BAND EIGENVALUE SOLVER SLAEIG. */
+/* */
+/* S EIGENVECTORS OF T. */
+/* */
+/* SMALL .TRUE. IF THE SMALL EIGENVALUES ARE DESIRED. */
+/* */
+/* RARITZ RETURNED AS .TRUE. IF A FINAL RAYLEIGH-RITZ PROCEDURE */
+/* IS TO BE DONE. */
+/* */
+/* DELTA RETURNED AS THE VALUE OF THE (NVAL+1)TH EIGENVALUE */
+/* OF THE MATRIX. USED IN ESTIMATING THE ACCURACY OF THE */
+/* COMPUTED EIGENVALUES. */
+/* */
+/* INTERNAL VARIABLES USED */
+/* */
+/* J THE CURRENT DIMENSION OF T. (THE DIMENSION OF THE CURRENT */
+/* KRYLOV SUBSPACE. */
+/* */
+/* NGOOD THE NUMBER OF GOOD RITZ VECTORS (GOOD VECTORS */
+/* LIE IN THE CURRENT KRYLOV SUBSPACE). */
+/* */
+/* NLEFT THE NUMBER OF VALUES WHICH REMAIN TO BE DETERMINED, */
+/* I.E. NLEFT = NVAL - NPERM. */
+/* */
+/* NUMBER = NPERM + NGOOD. */
+/* */
+/* ANORM AN ESTIMATE OF THE NORM OF THE MATRIX. */
+/* */
+/* EPS THE RELATIVE MACHINE PRECISION. */
+/* */
+/* UTOL THE USER TOLERANCE. */
+/* */
+/* TARR AN ARRAY OF LENGTH ONE USED TO INSURE TYPE CONSISTENCY IN */
+/* CALLS TO SLAEIG */
+/* */
+/* ZERO AN ARRAY OF LENGTH ONE CONTAINING ZERO, USED TO INSURE TYPE */
+/* CONSISTENCY IN CALLS TO SCOPY */
+
+ rnorm = 0.f;
+ if (*nperm != 0) {
+ rnorm = max(-val[0],val[*nperm-1]);
+ }
+ pnorm = rnorm;
+ *delta = 1e31f;
+ epsrt = sqrtf(*eps);
+ nleft = *nval - *nperm;
+ *nop = 0;
+ number = *nperm;
+ *raritz = FALSE_;
+ utol = max((*n) * *eps, pow_ri(&c__10, nfig));
+ j = *maxj;
+
+/* ------------------------------------------------------------------ */
+
+/* ANY ITERATION OF THE ALGORITHM BEGINS HERE. */
+
+L30:
+ for (i = 0; i < *nblock; ++i) {
+ temp = snrm2_(n, &p1[i * *n], &c__1);
+ if (temp == 0.f) {
+ slaran_(n, &p1[i * *n]);
+ }
+ }
+ for (i = 0; i < *nperm; ++i) {
+ tau[i] = 1.f;
+ otau[i] = 0.f;
+ }
+ i__1 = *n * *nblock;
+ scopy_(&i__1, &zero, &c__0, p0, &c__1);
+ i__1 = *nblock * *nblock;
+ scopy_(&i__1, &zero, &c__0, bet, &c__1);
+ i__1 = j * *nband;
+ scopy_(&i__1, &zero, &c__0, t, &c__1);
+ mtemp = *nval + 1;
+ for (i = 0; i < mtemp; ++i) {
+ scopy_(&j, &zero, &c__0, &s[i * *maxj], &c__1);
+ }
+ ngood = 0;
+ tmin = 1e30f;
+ tmax = -1e30f;
+ test = TRUE_;
+ enough = FALSE_;
+ betmax = 0.f;
+ j = 0;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION TAKES A SINGLE BLOCK LANCZOS STEP. */
+
+L80:
+ j += *nblock;
+
+/* THIS IS THE SELECTIVE ORTHOGONALIZATION. */
+
+ for (i = 0; i < number; ++i) {
+ if (tau[i] < epsrt) {
+ continue;
+ }
+ test = TRUE_;
+ tau[i] = 0.f;
+ if (otau[i] != 0.f) {
+ otau[i] = 1.f;
+ }
+ for (k = 0; k < *nblock; ++k) {
+ temp = -sdot_(n, &vec[i * *nmvec], &c__1, &p1[k * *n], &c__1);
+ saxpy_(n, &temp, &vec[i * *nmvec], &c__1, &p1[k * *n], &c__1);
+
+/* THIS CHECKS FOR TOO GREAT A LOSS OF ORTHOGONALITY BETWEEN A */
+/* NEW LANCZOS VECTOR AND A GOOD RITZ VECTOR. THE ALGORITHM IS */
+/* TERMINATED IF TOO MUCH ORTHOGONALITY IS LOST. */
+
+ if (abs(temp * bet[k + k * *nblock]) > (*n) * epsrt * anorm && i >= *nperm) {
+ goto L380;
+ }
+ }
+ }
+
+/* IF NECESSARY, THIS REORTHONORMALIZES P1 AND UPDATES BET. */
+
+ if (test)
+ sortqr_(n, n, nblock, p1, alp);
+ if (test && j != *nblock)
+ for (i = 0; i < *nblock; ++i) {
+ if (alp[i + i * *nblock] > 0.f) {
+ continue;
+ }
+ m = j - (*nblock << 1) + i;
+ l = *nblock;
+ for (k = i; k < *nblock; ++k, --l, ++m) {
+ bet[i + k * *nblock] = -bet[i + k * *nblock];
+ t[l + m * *nband] = -t[l + m * *nband];
+ }
+ }
+ test = FALSE_;
+
+/* THIS IS THE LANCZOS STEP. */
+
+ (*op)(n, nblock, p1, p2);
+ ++(*nop);
+ (*iovect)(n, nblock, p1, &j, &c__0);
+
+/* THIS COMPUTES P2=P2-P0*BET(TRANSPOSE) */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = i; k < *nblock; ++k) {
+ r__1 = -bet[i + k * *nblock];
+ saxpy_(n, &r__1, &p0[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ }
+
+/* THIS COMPUTES ALP AND P2=P2-P1*ALP. */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ i1 = i - k;
+ alp[i1 + k * *nblock] = sdot_(n, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ r__1 = -alp[i1 + k * *nblock];
+ saxpy_(n, &r__1, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ if (k != i) {
+ r__1 = -alp[i1 + k * *nblock];
+ saxpy_(n, &r__1, &p1[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ }
+ }
+
+/* REORTHOGONALIZATION OF THE SECOND BLOCK */
+
+ if (j == *nblock)
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ temp = -sdot_(n, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ saxpy_(n, &temp, &p1[i * *n], &c__1, &p2[k * *n], &c__1);
+ if (k != i) {
+ saxpy_(n, &temp, &p1[k * *n], &c__1, &p2[i * *n], &c__1);
+ }
+ i1 = i - k;
+ alp[i1 + k * *nblock] += temp;
+ }
+ }
+
+/* THIS ORTHONORMALIZES THE NEXT BLOCK */
+
+ sortqr_(n, n, nblock, p2, bet);
+
+/* THIS STORES ALP AND BET IN T. */
+
+ for (i = 0; i < *nblock; ++i) {
+ m = j - *nblock + i;
+ for (k = i; k < *nblock; ++k) {
+ l = k - i;
+ t[l + m * *nband] = alp[l + i * *nblock];
+ }
+ for (k = 0; k <= i; ++k) {
+ l = *nblock - i + k;
+ t[l + m * *nband] = bet[k + i * *nblock];
+ }
+ }
+
+/* THIS NEGATES T IF SMALL IS FALSE. */
+
+ if (! *small)
+ for (i = j - *nblock; i < j; ++i) {
+ for (k = 0; k <= l; ++k) { /* FIXME *** This must be an error! (already in the fortran code) -- l is undefined *** */
+ t[k + i * *nband] = -t[k + i * *nband];
+ }
+ }
+
+/* THIS SHIFTS THE LANCZOS VECTORS */
+
+ i__1 = *nblock * *n;
+ scopy_(&i__1, p1, &c__1, p0, &c__1);
+ scopy_(&i__1, p2, &c__1, p1, &c__1);
+ i__1 = j - *nblock + 1;
+ slager_(&j, nband, &i__1, t, &tmin, &tmax);
+ anorm = max(max(rnorm,tmax),-tmin);
+
+/* THIS COMPUTES THE EXTREME EIGENVALUES OF ALP. */
+
+ if (number != 0) {
+ scopy_(nblock, &zero, &c__0, p2, &c__1);
+ slaeig_(nblock, nblock, &c__1, &c__1, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ alpmin = tarr;
+ scopy_(nblock, &zero, &c__0, p2, &c__1);
+ slaeig_(nblock, nblock, nblock, nblock, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ alpmax = tarr;
+ }
+
+/* THIS COMPUTES ALP = BET(TRANSPOSE)*BET. */
+
+ for (i = 0; i < *nblock; ++i) {
+ for (k = 0; k <= i; ++k) {
+ l = i - k;
+ i__1 = *nblock - i;
+ alp[l + k * *nblock] = sdot_(&i__1, &bet[i + i * *nblock], nblock, &bet[k + i * *nblock], nblock);
+ }
+ }
+ if (number == 0) {
+ goto L330;
+ }
+
+/* THIS COMPUTES THE SMALLEST SINGULAR VALUE OF BET. */
+
+ scopy_(nblock, &zero, &c__0, p2, &c__1);
+ r__1 = anorm * anorm;
+ slaeig_(nblock, nblock, &c__1, &c__1, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &c__00, &r__1);
+ betmin = sqrtf(tarr);
+
+/* THIS UPDATES TAU AND OTAU. */
+
+ for (i = 0; i < number; ++i) {
+ temp = (tau[i] * max(alpmax-val[i],val[i]-alpmin) + otau[i] * betmax + *eps * anorm) / betmin;
+ if (i < *nperm) {
+ temp += res[i] / betmin;
+ }
+ otau[i] = tau[i];
+ tau[i] = temp;
+ }
+
+/* THIS COMPUTES THE LARGEST SINGULAR VALUE OF BET. */
+
+L330:
+ scopy_(nblock, &zero, &c__0, p2, &c__1);
+ r__1 = anorm * anorm;
+ slaeig_(nblock, nblock, nblock, nblock, alp, &tarr, nblock, p2, bound, atemp, d, vtemp, eps, &c__00, &r__1);
+ betmax = sqrtf(tarr);
+ if (j <= *nblock << 1) {
+ goto L80;
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES AND EXAMINES THE SMALLEST NONGOOD AND */
+/* LARGEST DESIRED EIGENVALUES OF T TO SEE IF A CLOSER LOOK */
+/* IS JUSTIFIED. */
+
+ tolg = epsrt * anorm;
+ tola = utol * rnorm;
+ if (*maxj - j < *nblock || ( *nop >= *maxop && nleft != 0 ) ) {
+ goto L390;
+ }
+ else
+ goto L400;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES SOME EIGENVALUES AND EIGENVECTORS OF T TO */
+/* SEE IF FURTHER ACTION IS INDICATED, ENTRY IS AT 380 OR 390 IF AN */
+/* ITERATION (OR TERMINATION) IS KNOWN TO BE NEEDED, OTHERWISE ENTRY */
+/* IS AT 400. */
+
+L380:
+ j -= *nblock;
+ *ierr = -8;
+L390:
+ if (nleft == 0) {
+ return;
+ }
+ test = TRUE_;
+L400:
+ ntheta = min(j/2, nleft+1);
+ slaeig_(&j, nband, &c__1, &ntheta, t, &val[number], maxj, s, bound, atemp, d, vtemp, eps, &tmin, &tmax);
+ smvpc_(nblock, bet, maxj, &j, s, &ntheta, atemp, vtemp, d);
+
+/* THIS CHECKS FOR TERMINATION OF A CHECK RUN */
+
+ if (nleft == 0 && j >= *nblock * 6) {
+ if (val[number] - atemp[0] > val[*nperm-1] - tola) {
+ goto L790;
+ }
+ }
+
+/* THIS UPDATES NLEFT BY EXAMINING THE COMPUTED EIGENVALUES OF T */
+/* TO DETERMINE IF SOME PERMANENT VALUES ARE NO LONGER DESIRED. */
+
+ if (ntheta <= nleft) {
+ goto L470;
+ }
+ if (*nperm != 0 && val[number+nleft] < val[*nperm-1]) {
+ --(*nperm);
+ ngood = 0;
+ number = *nperm;
+ ++nleft;
+ goto L400;
+ }
+
+/* THIS UPDATES DELTA. */
+
+ *delta = min(*delta,val[number+nleft]);
+ enough = TRUE_;
+ if (nleft == 0) {
+ goto L80;
+ }
+ ntheta = nleft;
+ vtemp[ntheta] = 1.f;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION EXAMINES THE COMPUTED EIGENPAIRS IN DETAIL. */
+
+/* THIS CHECKS FOR ENOUGH ACCEPTABLE VALUES. */
+
+ if (! (test || enough)) {
+ goto L470;
+ }
+ *delta = min(*delta,anorm);
+ pnorm = max(rnorm,max(-val[number],*delta));
+ tola = utol * pnorm;
+ nstart = 0;
+ for (i = 0; i < ntheta; ++i) {
+ if (min(atemp[i]*atemp[i]/(*delta-val[number+i]), atemp[i]) <= tola) {
+ ind[i] = -1;
+ continue;
+ }
+ enough = FALSE_;
+ if (! test) {
+ goto L470;
+ }
+ ind[i] = 1;
+ ++nstart;
+ }
+
+/* COPY VALUES OF IND INTO VTEMP */
+
+ for (i = 0; i < ntheta; ++i) {
+ vtemp[i] = (real) ind[i];
+ }
+ goto L500;
+
+/* THIS CHECKS FOR NEW GOOD VECTORS. */
+
+L470:
+ ng = 0;
+ for (i = 0; i < ntheta; ++i) {
+ if (vtemp[i] > tolg) {
+ vtemp[i] = 1.f;
+ }
+ else {
+ ++ng;
+ vtemp[i] = -1.f;
+ }
+ }
+
+ if (ng <= ngood) {
+ goto L80;
+ }
+ nstart = ntheta - ng;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES AND NORMALIZES THE INDICATED RITZ VECTORS. */
+/* IF NEEDED (TEST = .TRUE.), NEW STARTING VECTORS ARE COMPUTED. */
+
+L500:
+ test = test && ! enough;
+ ngood = ntheta - nstart;
+ ++nstart;
+ ++ntheta;
+
+/* THIS ALIGNS THE DESIRED (ACCEPTABLE OR GOOD) EIGENVALUES AND */
+/* EIGENVECTORS OF T. THE OTHER EIGENVECTORS ARE SAVED FOR */
+/* FORMING STARTING VECTORS, IF NECESSARY. IT ALSO SHIFTS THE */
+/* EIGENVALUES TO OVERWRITE THE GOOD VALUES FROM THE PREVIOUS */
+/* PAUSE. */
+
+ scopy_(&ntheta, &val[number], &c__1, &val[*nperm], &c__1);
+ if (nstart == 0) {
+ goto L580;
+ }
+ if (nstart != ntheta) {
+ svsort_(&ntheta, vtemp, atemp, &c__1, &val[*nperm], maxj, &j, s);
+ }
+
+/* THES ACCUMULATES THE J-VECTORS USED TO FORM THE STARTING */
+/* VECTORS. */
+
+ if (! test) {
+ nstart = 0;
+ }
+ if (! test) {
+ goto L580;
+ }
+
+/* FIND MINIMUM ATEMP VALUE TO AVOID POSSIBLE OVERFLOW */
+
+ temp = atemp[0];
+ for (i = 0; i < nstart; ++i) {
+ temp = min(temp,atemp[i]);
+ }
+ l = ngood + min(nstart,*nblock);
+ for (i = ngood; i < l; ++i) {
+ r__1 = temp / atemp[i];
+ sscal_(&j, &r__1, &s[i * *maxj], &c__1);
+ }
+ m = (nstart - 1) / *nblock;
+ l = ngood + *nblock;
+ for (i = 0; i < m; ++i) {
+ for (k = 0; k < *nblock; ++k, ++l) {
+ if (l >= ntheta) {
+ goto L570;
+ }
+ i1 = ngood + k;
+ r__1 = temp / atemp[l];
+ saxpy_(&j, &r__1, &s[l * *maxj], &c__1, &s[i1 * *maxj], &c__1);
+ }
+ }
+L570:
+ nstart = min(nstart,*nblock);
+
+/* THIS STORES THE RESIDUAL NORMS OF THE NEW PERMANENT VECTORS. */
+
+L580:
+ if (test || enough)
+ for (i = 0; i < ngood; ++i) {
+ res[*nperm+i] = atemp[i];
+ }
+
+/* THIS COMPUTES THE RITZ VECTORS BY SEQUENTIALLY RECALLING THE */
+/* LANCZOS VECTORS. */
+
+ number = *nperm + ngood;
+ if (test || enough) {
+ i__1 = *n * *nblock;
+ scopy_(&i__1, &zero, &c__0, p1, &c__1);
+ }
+ if (ngood != 0)
+ for (i = *nperm; i < number; ++i) {
+ scopy_(n, &zero, &c__0, &vec[i * *nmvec], &c__1);
+ }
+ for (i = *nblock; *nblock < 0 ? i >= j : i <= j; i += *nblock) {
+ (*iovect)(n, nblock, p2, &i, &c__1);
+ for (k = 0; k < *nblock; ++k) {
+ m = i - *nblock + k;
+ for (l = 0; l < nstart; ++l) {
+ i1 = ngood + l;
+ saxpy_(n, &s[m + i1 * *maxj], &p2[k * *n], &c__1, &p1[l * *n], &c__1);
+ }
+ for (l = 0; l < ngood; ++l) {
+ i1 = l + *nperm;
+ saxpy_(n, &s[m + l * *maxj], &p2[k * *n], &c__1, &vec[i1 * *nmvec], &c__1);
+ }
+ }
+ }
+ if (test || enough) {
+ goto L690;
+ }
+
+/* THIS NORMALIZES THE RITZ VECTORS AND INITIALIZES THE */
+/* TAU RECURRENCE. */
+
+ for (i = *nperm; i < number; ++i) {
+ temp = 1.f / snrm2_(n, &vec[i * *nmvec], &c__1);
+ sscal_(n, &temp, &vec[i * *nmvec], &c__1);
+ tau[i] = 1.f;
+ otau[i] = 1.f;
+ }
+
+/* SHIFT S VECTORS TO ALIGN FOR LATER CALL TO SLAEIG */
+
+ scopy_(&ntheta, &val[*nperm], &c__1, vtemp, &c__1);
+ svsort_(&ntheta, vtemp, atemp, &c__0, &tarr, maxj, &j, s);
+ goto L80;
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION PREPARES TO ITERATE THE ALGORITHM BY SORTING THE */
+/* PERMANENT VALUES, RESETTING SOME PARAMETERS, AND ORTHONORMALIZING */
+/* THE PERMANENT VECTORS. */
+
+L690:
+ if (ngood == 0 && *nop >= *maxop) {
+ *ierr = -2; /* THIS REPORTS THAT MAXOP WAS EXCEEDED. */
+ goto L790;
+ }
+ if (ngood == 0) {
+ goto L30;
+ }
+
+/* THIS ORTHONORMALIZES THE VECTORS */
+
+ i__1 = *nperm + ngood;
+ sortqr_(nmvec, n, &i__1, vec, s);
+
+/* THIS SORTS THE VALUES AND VECTORS. */
+
+ if (*nperm != 0) {
+ i__1 = *nperm + ngood;
+ svsort_(&i__1, val, res, &c__0, &temp, nmvec, n, vec);
+ }
+ *nperm += ngood;
+ nleft -= ngood;
+ rnorm = max(-val[0],val[*nperm-1]);
+
+/* THIS DECIDES WHERE TO GO NEXT. */
+
+ if (*nop >= *maxop && nleft != 0) {
+ *ierr = -2; /* THIS REPORTS THAT MAXOP WAS EXCEEDED. */
+ goto L790;
+ }
+ if (nleft != 0) {
+ goto L30;
+ }
+ if (val[*nval-1] - val[0] < tola) {
+ goto L790;
+ }
+
+/* THIS DOES A CLUSTER TEST TO SEE IF A CHECK RUN IS NEEDED */
+/* TO LOOK FOR UNDISCLOSED MULTIPLICITIES. */
+
+ m = *nperm - *nblock;
+ for (i = 0; i <= m; ++i) {
+ if (val[i + *nblock - 1] - val[i] < tola) {
+ goto L30;
+ }
+ }
+
+/* THIS DOES A CLUSTER TEST TO SEE IF A FINAL RAYLEIGH-RITZ */
+/* PROCEDURE IS NEEDED. */
+
+L790:
+ m = *nperm - *nblock;
+ for (i = 0; i < m; ++i) {
+ if (val[i + *nblock] - val[i] < tola) {
+ *raritz = TRUE_;
+ break;
+ }
+ }
+} /* snwla_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void slabax_(n, nband, a, x, y)
+const integer *n, *nband;
+real *a, *x, *y;
+{
+ /* Local variables */
+ static real zero = 0.f;
+ static integer i, k, m;
+
+/* THIS SUBROUTINE SETS Y = A*X */
+/* WHERE X AND Y ARE VECTORS OF LENGTH N */
+/* AND A IS AN N X NBAND SYMMETRIC BAND MATRIX */
+
+ scopy_(n, &zero, &c__0, y, &c__1);
+ for (k = 0; k < *n; ++k) {
+ y[k] += a[k * *nband] * x[k];
+ m = min(*n-k,*nband);
+ for (i = 1; i < m; ++i) {
+ y[k+i] += a[i + k * *nband] * x[k];
+ y[k] += a[i + k * *nband] * x[k+i];
+ }
+ }
+} /* slabax_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void slabcm_(n, nband, nl, nr, a, eigval, lde, eigvec, atol, artol, bound, atemp, d, vtemp)
+const integer *n, *nband, *nl, *nr;
+real *a, *eigval;
+const integer *lde;
+real *eigvec, *atol, *artol, *bound, *atemp, *d, *vtemp;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static logical flag_;
+ static real errb;
+ static integer nval, numl;
+ static integer i, j;
+ static real sigma, resid;
+ static real vnorm;
+ static real rq;
+ static integer numvec;
+ static real gap;
+
+/* THIS SUBROUTINE ORGANIZES THE CALCULATION OF THE EIGENVALUES */
+/* FOR THE BNDEIG PACKAGE. EIGENVALUES ARE COMPUTED BY */
+/* A MODIFIED RAYLEIGH QUOTIENT ITERATION. THE EIGENVALUE COUNT */
+/* OBTAINED BY EACH FACTORIZATION IS USED TO OCCASIONALLY OVERRIDE */
+/* THE COMPUTED RAYLEIGH QUOTIENT WITH A DIFFERENT SHIFT TO */
+/* INSURE CONVERGENCE TO THE DESIRED EIGENVALUES. */
+
+/* REPLACE ZERO VECTORS BY RANDOM */
+
+ nval = *nr - *nl + 1;
+ flag_ = FALSE_;
+ for (i = 0; i < nval; ++i) {
+ if (sdot_(n, &eigvec[i * *lde], &c__1, &eigvec[i * *lde], &c__1) == 0.f) {
+ slaran_(n, &eigvec[i * *lde]);
+ }
+ }
+
+/* LOOP OVER EIGENVALUES */
+
+ sigma = bound[(nval << 1) + 1];
+ for (j = 0; j < nval; ++j) {
+ numl = j+1;
+
+/* PREPARE TO COMPUTE FIRST RAYLEIGH QUOTIENT */
+
+L10:
+ slabax_(n, nband, a, &eigvec[j * *lde], vtemp);
+ vnorm = snrm2_(n, vtemp, &c__1);
+ if (vnorm != 0.f) {
+ r__1 = 1.f / vnorm;
+ sscal_(n, &r__1, vtemp, &c__1);
+ sscal_(n, &r__1, &eigvec[j * *lde], &c__1);
+ r__1 = -sigma;
+ saxpy_(n, &r__1, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ }
+
+/* LOOP OVER SHIFTS */
+
+/* COMPUTE RAYLEIGH QUOTIENT, RESIDUAL NORM, AND CURRENT TOLERANCE */
+
+L20:
+ vnorm = snrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm == 0.f) {
+ slaran_(n, &eigvec[j * *lde]);
+ goto L10;
+ }
+
+ rq = sigma + sdot_(n, &eigvec[j * *lde], &c__1, vtemp, &c__1) / vnorm / vnorm;
+ r__1 = sigma - rq;
+ saxpy_(n, &r__1, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ resid = max(*atol,snrm2_(n, vtemp, &c__1) / vnorm);
+ r__1 = 1.f / vnorm;
+ sscal_(n, &r__1, &eigvec[j * *lde], &c__1);
+
+/* ACCEPT EIGENVALUE IF THE INTERVAL IS SMALL ENOUGH */
+
+ if (bound[(j << 1) + 3] - bound[(j << 1) + 2] < *atol * 3.f) {
+ goto L300;
+ }
+
+/* COMPUTE MINIMAL ERROR BOUND */
+
+ errb = resid;
+ gap = min(bound[(j << 1) + 4] - rq,rq - bound[(j << 1) + 1]);
+ if (gap > resid) {
+ errb = max(*atol,resid * resid / gap);
+ }
+
+/* TENTATIVE NEW SHIFT */
+
+ sigma = (bound[(j << 1) + 2] + bound[(j << 1) + 3]) * .5f;
+
+/* CHECK FOR TERMINALTION */
+
+ if (resid > *atol * 2.f) {
+ goto L40;
+ }
+ if (rq - errb > bound[(j << 1) + 1] && rq + errb < bound[(j << 1) + 4]) {
+ goto L310;
+ }
+
+/* RQ IS TO THE LEFT OF THE INTERVAL */
+
+L40:
+ if (rq >= bound[(j << 1) + 2]) {
+ goto L50;
+ }
+ if (rq - errb > bound[(j << 1) + 1]) {
+ goto L100;
+ }
+ if (rq + errb < bound[(j << 1) + 2]) {
+ slaran_(n, &eigvec[j * *lde]);
+ }
+ goto L200;
+
+/* RQ IS TO THE RIGHT OF THE INTERVAL */
+
+L50:
+ if (rq <= bound[(j << 1) + 3]) {
+ goto L100;
+ }
+ if (rq + errb < bound[(j << 1) + 4]) {
+ goto L100;
+ }
+
+/* SAVE THE REJECTED VECTOR IF INDICATED */
+
+ if (rq - errb <= bound[(j << 1) + 3]) {
+ goto L200;
+ }
+ for (i = j; i < nval; ++i) {
+ if (bound[(i << 1) + 3] > rq) {
+ scopy_(n, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ break;
+ }
+ }
+ slaran_(n, &eigvec[j * *lde]);
+ goto L200;
+
+/* PERTURB RQ TOWARD THE MIDDLE */
+
+L100:
+ if (sigma < rq-errb) {
+ sigma = rq-errb;
+ }
+ if (sigma > rq+errb) {
+ sigma = rq+errb;
+ }
+
+/* FACTOR AND SOLVE */
+
+L200:
+ for (i = j; i < nval; ++i) {
+ if (sigma < bound[(i << 1) + 2]) {
+ break;
+ }
+ }
+ numvec = i - j;
+ numvec = min(numvec,*nband+2);
+ if (resid < *artol) {
+ numvec = min(1,numvec);
+ }
+ scopy_(n, &eigvec[j * *lde], &c__1, vtemp, &c__1);
+ i__1 = (*nband << 1) - 1;
+ slabfc_(n, nband, a, &sigma, &numvec, lde, &eigvec[j * *lde], &numl, &i__1, atemp, d, atol);
+
+/* PARTIALLY SCALE EXTRA VECTORS TO PREVENT UNDERFLOW OR OVERFLOW */
+
+ for (i = j+1; i < numvec+j; ++i) {
+ r__1 = 1.f / vnorm;
+ sscal_(n, &r__1, &eigvec[i * *lde], &c__1);
+ }
+
+/* UPDATE INTERVALS */
+
+ numl -= *nl - 1;
+ if (numl >= 0) {
+ bound[1] = min(bound[1],sigma);
+ }
+ for (i = j; i < nval; ++i) {
+ if (sigma < bound[(i << 1) + 2]) {
+ goto L20;
+ }
+ if (numl <= i)
+ bound[(i << 1) + 2] = sigma;
+ else
+ bound[(i << 1) + 3] = sigma;
+ }
+ if (numl < nval + 1) {
+ if (sigma > bound[(nval << 1) + 2])
+ bound[(nval << 1) + 2] = sigma;
+ }
+ goto L20;
+
+/* ACCEPT AN EIGENPAIR */
+
+L300:
+ slaran_(n, &eigvec[j * *lde]);
+ flag_ = TRUE_;
+ goto L310;
+
+L305:
+ flag_ = FALSE_;
+ rq = (bound[(j << 1) + 2] + bound[(j << 1) + 3]) * .5f;
+ i__1 = (*nband << 1) - 1;
+ slabfc_(n, nband, a, &rq, &numvec, lde, &eigvec[j * *lde], &numl, &i__1, atemp, d, atol);
+ vnorm = snrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm != 0.f) {
+ r__1 = 1.f / vnorm;
+ sscal_(n, &r__1, &eigvec[j * *lde], &c__1);
+ }
+
+/* ORTHOGONALIZE THE NEW EIGENVECTOR AGAINST THE OLD ONES */
+
+L310:
+ eigval[j] = rq;
+ for (i = 0; i < j; ++i) {
+ r__1 = -sdot_(n, &eigvec[i * *lde], &c__1, &eigvec[j * *lde], &c__1);
+ saxpy_(n, &r__1, &eigvec[i * *lde], &c__1, &eigvec[j * *lde], &c__1);
+ }
+ vnorm = snrm2_(n, &eigvec[j * *lde], &c__1);
+ if (vnorm == 0.f) {
+ goto L305;
+ }
+ r__1 = 1.f / vnorm;
+ sscal_(n, &r__1, &eigvec[j * *lde], &c__1);
+
+/* ORTHOGONALIZE LATER VECTORS AGAINST THE CONVERGED ONE */
+
+ if (flag_) {
+ goto L305;
+ }
+ for (i = j+1; i < nval; ++i) {
+ r__1 = -sdot_(n, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ saxpy_(n, &r__1, &eigvec[j * *lde], &c__1, &eigvec[i * *lde], &c__1);
+ }
+ }
+} /* slabcm_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void slabfc_(n, nband, a, sigma, number, lde, eigvec, numl, ldad, atemp, d, atol)
+const integer *n, *nband;
+real *a, *sigma;
+const integer *number, *lde;
+real *eigvec;
+integer *numl, *ldad;
+real *atemp, *d, *atol;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static real zero=0.f;
+ static integer i, j, k, l, m;
+ static integer la, ld, nb1, lpm;
+
+/* THIS SUBROUTINE FACTORS (A-SIGMA*I) WHERE A IS A GIVEN BAND */
+/* MATRIX AND SIGMA IS AN INPUT PARAMETER. IT ALSO SOLVES ZERO */
+/* OR MORE SYSTEMS OF LINEAR EQUATIONS. IT RETURNS THE NUMBER */
+/* OF EIGENVALUES OF A LESS THAN SIGMA BY COUNTING THE STURM */
+/* SEQUENCE DURING THE FACTORIZATION. TO OBTAIN THE STURM */
+/* SEQUENCE COUNT WHILE ALLOWING NON-SYMMETRIC PIVOTING FOR */
+/* STABILITY, THE CODE USES A GUPTA'S MULTIPLE PIVOTING */
+/* ALGORITHM. */
+
+/* INITIALIZE */
+
+ nb1 = *nband - 1;
+ *numl = 0;
+ i__1 = *ldad * *nband;
+ scopy_(&i__1, &zero, &c__0, d, &c__1);
+
+/* LOOP OVER COLUMNS OF A */
+
+ for (k = 0; k < *n; ++k) {
+
+/* ADD A COLUMN OF A TO D */
+
+ d[nb1 + nb1 * *ldad] = a[k * *nband] - *sigma;
+ m = min(k,nb1);
+ for (i = 0; i < m; ++i) {
+ la = k - i - 1;
+ ld = nb1 - i - 1;
+ d[ld + nb1 * *ldad] = a[i + 1 + la * *nband];
+ }
+
+ m = min(*n-k-1,nb1);
+ for (i = 0; i < m; ++i) {
+ ld = *nband + i;
+ d[ld + nb1 * *ldad] = a[i + 1 + k * *nband];
+ }
+
+/* TERMINATE */
+
+ lpm = 1;
+ for (i = 0; i < nb1; ++i) {
+ l = k - nb1 + i;
+ if (d[i + nb1 * *ldad] == 0.f) {
+ continue;
+ }
+ if (abs(d[i + i * *ldad]) >= abs(d[i + nb1 * *ldad])) {
+ goto L50;
+ }
+ if ( (d[i + nb1 * *ldad] < 0.f && d[i + i * *ldad] < 0.f ) ||
+ (d[i + nb1 * *ldad] > 0.f && d[i + i * *ldad] >= 0.f) ) {
+ lpm = -lpm;
+ }
+ i__1 = *ldad - i;
+ sswap_(&i__1, &d[i + i * *ldad], &c__1, &d[i + nb1 * *ldad], &c__1);
+ sswap_(number, &eigvec[l], lde, &eigvec[k], lde);
+L50:
+ i__1 = *ldad - i - 1;
+ r__1 = -d[i + nb1 * *ldad] / d[i + i * *ldad];
+ saxpy_(&i__1, &r__1, &d[i + 1 + i * *ldad], &c__1, &d[i + 1 + nb1 * *ldad], &c__1);
+ r__1 = -d[i + nb1 * *ldad] / d[i + i * *ldad];
+ saxpy_(number, &r__1, &eigvec[l], lde, &eigvec[k], lde);
+ }
+
+/* UPDATE STURM SEQUENCE COUNT */
+
+ if (d[nb1 + nb1 * *ldad] < 0.f) {
+ lpm = -lpm;
+ }
+ if (lpm < 0) {
+ ++(*numl);
+ }
+ if (k == *n-1) {
+ goto L110;
+ }
+
+/* COPY FIRST COLUMN OF D INTO ATEMP */
+ if (k >= nb1) {
+ l = k - nb1;
+ scopy_(ldad, d, &c__1, &atemp[l * *ldad], &c__1);
+ }
+
+/* SHIFT THE COLUMNS OF D OVER AND UP */
+
+ for (i = 0; i < nb1; ++i) {
+ i__1 = *ldad - i - 1;
+ scopy_(&i__1, &d[i + 1 + (i + 1) * *ldad], &c__1, &d[i + i * *ldad], &c__1);
+ d[*ldad - 1 + i * *ldad] = 0.f;
+ }
+ }
+
+/* TRANSFER D TO ATEMP */
+
+L110:
+ for (i = 0; i < *nband; ++i) {
+ i__1 = *nband - i;
+ l = *n - i__1;
+ scopy_(&i__1, &d[i + i * *ldad], &c__1, &atemp[l * *ldad], &c__1);
+ }
+
+/* BACK SUBSTITUTION */
+
+ if (*number == 0) {
+ return;
+ }
+ for (k = *n-1; k >= 0; --k) {
+ if (abs(atemp[k * *ldad]) <= *atol) {
+ atemp[k * *ldad] = r_sign(atol, &atemp[k * *ldad]);
+ }
+
+ for (i = 0; i < *number; ++i) {
+ eigvec[k + i * *lde] /= atemp[k * *ldad];
+ m = min(*ldad-1,k);
+ for (j = 0; j < m; ++j) {
+ l = k - j - 1;
+ eigvec[l + i * *lde] -= atemp[j + 1 + l * *ldad] * eigvec[k + i * *lde];
+ }
+ }
+ }
+} /* slabfc_ */
+
+
+/* Subroutine */
+static void slaeig_(n, nband, nl, nr, a, eigval, lde, eigvec, bound, atemp, d, vtemp, eps, tmin, tmax)
+const integer *n, *nband, *nl, *nr;
+real *a, *eigval;
+const integer *lde;
+real *eigvec, *bound, *atemp, *d, *vtemp, *eps, *tmin, *tmax;
+{
+ /* Local variables */
+ static real atol;
+ static integer nval, i;
+ static real artol;
+
+/* THIS IS A SPECIALIZED VERSION OF THE SUBROUTINE BNDEIG TAILORED */
+/* SPECIFICALLY FOR USE BY THE LASO PACKAGE. */
+
+/* SET PARAMETERS */
+
+ atol = *n * *eps * max(*tmax,-(*tmin));
+ artol = atol / sqrtf(*eps);
+ nval = *nr - *nl + 1;
+
+/* CHECK FOR SPECIAL CASE OF N = 1 */
+
+ if (*n == 1) {
+ eigval[0] = a[0];
+ eigvec[0] = 1.f;
+ return;
+ }
+
+/* SET UP INITIAL EIGENVALUE BOUNDS */
+
+ for (i = 1; i <= nval; ++i) {
+ bound[(i << 1)] = *tmin;
+ bound[(i << 1) + 1] = *tmax;
+ }
+ bound[1] = *tmax;
+ bound[(nval << 1) + 2] = *tmin;
+ if (*nl == 1) {
+ bound[1] = *tmin;
+ }
+ if (*nr == *n) {
+ bound[(nval << 1) + 2] = *tmax;
+ }
+
+ slabcm_(n, nband, nl, nr, a, eigval, lde, eigvec, &atol, &artol, bound, atemp, d, vtemp);
+} /* slaeig_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void slager_(n, nband, nstart, a, tmin, tmax)
+const integer *n, *nband, *nstart;
+real *a, *tmin, *tmax;
+{
+ /* Local variables */
+ static real temp;
+ static integer i, k, l;
+
+/* THIS SUBROUTINE COMPUTES BOUNDS ON THE SPECTRUM OF A BY */
+/* EXAMINING THE GERSCHGORIN CIRCLES. ONLY THE NEWLY CREATED */
+/* CIRCLES ARE EXAMINED */
+
+ for (k = *nstart - 1; k < *n; ++k) {
+ temp = 0.f;
+ for (i = 1; i < *nband; ++i) {
+ temp += abs(a[i + k * *nband]);
+ }
+ l = min(k,*nband-1);
+ for (i = 1; i <= l; ++i) {
+ temp += abs(a[i + (k-i) * *nband]);
+ }
+ *tmin = min(*tmin,a[k * *nband] - temp);
+ *tmax = max(*tmax,a[k * *nband] + temp);
+ }
+} /* slager_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */
+static void slaran_(n, x)
+const integer *n;
+real *x;
+{
+ /* Initialized data */
+ static integer iurand = 0;
+
+ /* Local variables */
+ static integer i;
+
+/* THIS SUBROUTINE SETS THE VECTOR X TO RANDOM NUMBERS */
+
+/* INITIALIZE SEED */
+
+ for (i = 0; i < *n; ++i) {
+ x[i] = (real)urand_(&iurand) - .5f;
+ }
+} /* slaran_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void smvpc_(nblock, bet, maxj, j, s, number, resnrm, orthcf, rv)
+const integer *nblock;
+const real *bet;
+const integer *maxj, *j;
+const real *s;
+const integer *number;
+real *resnrm, *orthcf, *rv;
+{
+ /* Local variables */
+ static integer i, k, m;
+
+/* THIS SUBROUTINE COMPUTES THE NORM AND THE SMALLEST ELEMENT */
+/* (IN ABSOLUTE VALUE) OF THE VECTOR BET*SJI, WHERE SJI */
+/* IS AN NBLOCK VECTOR OF THE LAST NBLOCK ELEMENTS OF THE ITH */
+/* EIGENVECTOR OF T. THESE QUANTITIES ARE THE RESIDUAL NORM */
+/* AND THE ORTHOGONALITY COEFFICIENT RESPECTIVELY FOR THE */
+/* CORRESPONDING RITZ PAIR. THE ORTHOGONALITY COEFFICIENT IS */
+/* NORMALIZED TO ACCOUNT FOR THE LOCAL REORTHOGONALIZATION. */
+
+ m = *j - *nblock;
+ for (i = 0; i < *number; ++i) {
+ rv[0] = sdot_(nblock, &s[m + i * *maxj], &c__1, &bet[0], nblock);
+ orthcf[i] = abs(rv[0]);
+ for (k = 1; k < *nblock; ++k) {
+ rv[k] = sdot_(nblock, &s[m + i * *maxj], &c__1, &bet[k], nblock);
+ orthcf[i] = min(orthcf[i], abs(rv[k]));
+ }
+ resnrm[i] = snrm2_(nblock, rv, &c__1);
+ }
+} /* smvpc_ */
+
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void snppla_(op, iovect, n, nperm, nop, nmval, val, nmvec,
+ vec, nblock, h, hv, p, q, bound, d, delta, small, raritz, eps)
+/* Subroutine */
+void (*op) (const integer*,const integer*,const real*,real*);
+/* Subroutine */
+void (*iovect) (const integer*,const integer*,real*,const integer*,const integer*);
+const integer *n, *nperm, *nmval;
+integer *nop;
+real *val;
+const integer *nmvec;
+real *vec;
+const integer *nblock;
+real *h, *hv, *p, *q, *bound, *d, *delta;
+logical *small, *raritz;
+real *eps;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static real hmin, hmax, temp;
+ static real zero=0.f;
+ static integer i, j, k, l, m;
+ static integer jj, kk;
+
+/* THIS SUBROUTINE POST PROCESSES THE EIGENVECTORS. BLOCK MATRIX */
+/* VECTOR PRODUCTS ARE USED TO MINIMIZED THE NUMBER OF CALLS TO OP. */
+
+/* IF RARITZ IS .TRUE. A FINAL RAYLEIGH-RITZ PROCEDURE IS APPLIED */
+/* TO THE EIGENVECTORS. */
+
+ if (! (*raritz)) {
+ goto L190;
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS CONSTRUCTS H=Q*AQ, WHERE THE COLUMNS OF Q ARE THE */
+/* APPROXIMATE EIGENVECTORS. TEMP = -1 IS USED WHEN SMALL IS */
+/* FALSE TO AVOID HAVING TO RESORT THE EIGENVALUES AND EIGENVECTORS */
+/* COMPUTED BY SLAEIG. */
+
+ i__1 = *nperm * *nperm;
+ scopy_(&i__1, &zero, &c__0, h, &c__1);
+ temp = -1.f;
+ if (*small) {
+ temp = 1.f;
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L40;
+ }
+ for (i = 0; i < m; ++i) {
+ scopy_(n, &vec[i * *nmvec], &c__1, &p[i * *n], &c__1);
+ }
+ (*iovect)(n, &m, p, &m, &c__0);
+ (*op)(n, &m, p, q);
+ ++(*nop);
+ for (i = 0; i < m; ++i) {
+ for (j = i; j < *nperm; ++j) {
+ jj = j - i;
+ h[jj + i * *nperm] = temp * sdot_(n, &vec[j * *nmvec], &c__1, &q[i * *n], &c__1);
+ }
+ }
+ if (*nperm < *nblock) {
+ goto L90;
+ }
+L40:
+ m += *nblock;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ scopy_(n, &vec[l * *nmvec], &c__1, &p[j * *n], &c__1);
+ }
+ (*iovect)(n, nblock, p, &i, &c__0);
+ (*op)(n, nblock, p, q);
+ ++(*nop);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ for (k = l; k < *nperm; ++k) {
+ kk = k - l;
+ h[kk + l * *nperm] = temp * sdot_(n, &vec[k * *nmvec], &c__1, &q[j * *n], &c__1);
+ }
+ }
+ }
+
+/* THIS COMPUTES THE SPECTRAL DECOMPOSITION OF H. */
+
+L90:
+ hmin = h[0];
+ hmax = h[0];
+ slager_(nperm, nperm, &c__1, h, &hmin, &hmax);
+ slaeig_(nperm, nperm, &c__1, nperm, h, val, nperm, hv, bound, p, d, q, eps, &hmin, &hmax);
+
+/* THIS COMPUTES THE RITZ VECTORS--THE COLUMNS OF */
+/* Y = QS WHERE S IS THE MATRIX OF EIGENVECTORS OF H. */
+
+ for (i = 0; i < *nperm; ++i) {
+ scopy_(n, &zero, &c__0, &vec[i * *nmvec], &c__1);
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L150;
+ }
+ (*iovect)(n, &m, p, &m, &c__1);
+ for (i = 0; i < m; ++i) {
+ for (j = 0; j < *nperm; ++j) {
+ saxpy_(n, &hv[i + j * *nperm], &p[i * *n], &c__1, &vec[j * *nmvec], &c__1);
+ }
+ }
+ if (*nperm < *nblock) {
+ goto L190;
+ }
+L150:
+ m += *nblock;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ (*iovect)(n, nblock, p, &i, &c__1);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - *nblock + j;
+ for (k = 0; k < *nperm; ++k) {
+ saxpy_(n, &hv[l + k * *nperm], &p[j * *n], &c__1, &vec[k * *nmvec], &c__1);
+ }
+ }
+ }
+
+/* ------------------------------------------------------------------ */
+
+/* THIS SECTION COMPUTES THE RAYLEIGH QUOTIENTS (IN VAL(*,1)) */
+/* AND RESIDUAL NORMS (IN VAL(*,2)) OF THE EIGENVECTORS. */
+
+L190:
+ if (! (*small)) {
+ *delta = -(*delta);
+ }
+ m = *nperm % *nblock;
+ if (m == 0) {
+ goto L220;
+ }
+ for (i = 0; i < m; ++i) {
+ scopy_(n, &vec[i * *nmvec], &c__1, &p[i * *n], &c__1);
+ }
+ (*op)(n, &m, p, q);
+ ++(*nop);
+ for (i = 0; i < m; ++i) {
+ val[i] = sdot_(n, &p[i * *n], &c__1, &q[i * *n], &c__1);
+ r__1 = -val[i];
+ saxpy_(n, &r__1, &p[i * *n], &c__1, &q[i * *n], &c__1);
+ val[i + *nmval] = snrm2_(n, &q[i * *n], &c__1);
+ }
+ if (*nperm < *nblock) {
+ goto L260;
+ }
+L220:
+ ++m;
+ for (i = m; *nblock < 0 ? i >= *nperm : i <= *nperm; i += *nblock) {
+ for (j = 0; j < *nblock; ++j) {
+ l = i - 1 + j;
+ scopy_(n, &vec[l * *nmvec], &c__1, &p[j * *n], &c__1);
+ }
+ (*op)(n, nblock, p, q);
+ ++(*nop);
+ for (j = 0; j < *nblock; ++j) {
+ l = i - 1 + j;
+ val[l] = sdot_(n, &p[j * *n], &c__1, &q[j * *n], &c__1);
+ r__1 = -val[l];
+ saxpy_(n, &r__1, &p[j * *n], &c__1, &q[j * *n], &c__1);
+ val[l + *nmval] = snrm2_(n, &q[j * *n], &c__1);
+ }
+ }
+
+/* THIS COMPUTES THE ACCURACY ESTIMATES. FOR CONSISTENCY WITH SILASO */
+
+L260:
+ for (i = 0; i < *nperm; ++i) {
+ temp = *delta - val[i];
+ if (! (*small)) {
+ temp = -temp;
+ }
+ val[i + *nmval * 3] = 0.f;
+ if (temp > 0.f) {
+ val[i + *nmval * 3] = val[i + *nmval] / temp;
+ }
+ val[i + *nmval * 2] = val[i + *nmval * 3] * val[i + *nmval];
+ }
+
+} /* snppla_ */
+
+/* ------------------------------------------------------------------ */
+
+/* Subroutine */
+static void sortqr_(nz, n, nblock, z, b)
+const integer *nz, *n, *nblock;
+real *z, *b;
+{
+ /* System generated locals */
+ real r__1;
+
+ /* Local variables */
+ static real temp;
+ static integer i, k;
+ static real sigma;
+ static integer length;
+ static real tau;
+
+/* THIS SUBROUTINE COMPUTES THE QR FACTORIZATION OF THE N X NBLOCK */
+/* MATRIX Z. Q IS FORMED IN PLACE AND RETURNED IN Z. R IS */
+/* RETURNED IN B. */
+
+/* THIS SECTION REDUCES Z TO TRIANGULAR FORM. */
+
+ for (i = 0; i < *nblock; ++i) {
+
+/* THIS FORMS THE ITH REFLECTION. */
+
+ length = *n - i;
+ r__1 = snrm2_(&length, &z[i + i * *nz], &c__1);
+ sigma = r_sign(&r__1, &z[i + i * *nz]);
+ b[i + i * *nblock] = -sigma;
+ z[i + i * *nz] += sigma;
+ tau = sigma * z[i + i * *nz];
+
+/* THIS APPLIES THE ROTATION TO THE REST OF THE COLUMNS. */
+
+ for (k = i+1; k < *nblock; ++k) {
+ if (tau != 0.f) {
+ temp = -sdot_(&length, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1) / tau;
+ saxpy_(&length, &temp, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1);
+ }
+ b[i + k * *nblock] = z[i + k * *nz];
+ z[i + k * *nz] = 0.f;
+ }
+ }
+
+/* THIS ACCUMULATES THE REFLECTIONS IN REVERSE ORDER. */
+
+ for (i = *nblock-1; i >= 0; --i) {
+
+/* THIS RECREATES THE ITH = NBLOCK-M+1)TH REFLECTION. */
+
+ sigma = -b[i + i * *nblock];
+ tau = z[i + i * *nz] * sigma;
+ if (tau == 0.f) {
+ goto L60;
+ }
+ length = *n - i;
+
+/* THIS APPLIES IT TO THE LATER COLUMNS. */
+
+ for (k = i+1; k < *nblock; ++k) {
+ temp = -sdot_(&length, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1) / tau;
+ saxpy_(&length, &temp, &z[i + i * *nz], &c__1, &z[i + k * *nz], &c__1);
+ }
+ r__1 = -1.f / sigma;
+ sscal_(&length, &r__1, &z[i + i * *nz], &c__1);
+L60:
+ z[i + i * *nz] += 1.f;
+ }
+} /* sortqr_ */
+
+
+/* ------------------------------------------------------------------- */
+
+/* Subroutine */
+static void svsort_(num, val, res, iflag, v, nmvec, n, vec)
+const integer *num;
+real *val, *res;
+const integer *iflag;
+real *v;
+const integer *nmvec, *n;
+real *vec;
+{
+ /* Local variables */
+ static real temp;
+ static integer kk, k, m;
+
+/* THIS SUBROUTINE SORTS THE EIGENVALUES (VAL) IN ASCENDING ORDER */
+/* WHILE CONCURRENTLY SWAPPING THE RESIDUALS AND VECTORS. */
+
+ for (m = *num - 1; m > 0; --m) {
+ for (k = 0; k < m; ++k) {
+ kk = k+1;
+ if (val[k] <= val[kk])
+ continue;
+ temp = val[k]; val[k] = val[kk]; val[kk] = temp;
+ temp = res[k]; res[k] = res[kk]; res[kk] = temp;
+ sswap_(n, &vec[k * *nmvec], &c__1, &vec[kk * *nmvec], &c__1);
+ if (*iflag != 0) {
+ temp = v[k]; v[k] = v[kk]; v[kk] = temp;
+ }
+ }
+ }
+} /* svsort_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.f
new file mode 100644
index 0000000000000000000000000000000000000000..0cd32f60211800ba4301478f10b7ed25be199c6f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/snlaso.f
@@ -0,0 +1,1665 @@
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABAX(N, NBAND, A, X, Y)
+C
+C THIS SUBROUTINE SETS Y = A*X
+C WHERE X AND Y ARE VECTORS OF LENGTH N
+C AND A IS AN N X NBAND SYMMETRIC BAND MATRIX
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND
+ REAL A(NBAND,1), X(1), Y(1)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ REAL ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+C
+C SUBROUTINES CALLED
+C
+C SCOPY
+C
+ ZERO(1) = 0.0
+ CALL SCOPY(N, ZERO, 0, Y, 1)
+ DO 20 K = 1, N
+ Y(K) = Y(K) + A(1,K)*X(K)
+ M = MIN0(N-K+1, NBAND)
+ IF(M .LT. 2) GO TO 20
+ DO 10 I = 2, M
+ L = K + I - 1
+ Y(L) = Y(L) + A(I,K)*X(K)
+ Y(K) = Y(K) + A(I,K)*X(L)
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABCM(N, NBAND, NL, NR, A, EIGVAL,
+ 1 LDE, EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+C
+C THIS SUBROUTINE ORGANIZES THE CALCULATION OF THE EIGENVALUES
+C FOR THE BNDEIG PACKAGE. EIGENVALUES ARE COMPUTED BY
+C A MODIFIED RAYLEIGH QUOTIENT ITERATION. THE EIGENVALUE COUNT
+C OBTAINED BY EACH FACTORIZATION IS USED TO OCCASIONALLY OVERRIDE
+C THE COMPUTED RAYLEIGH QUOTIENT WITH A DIFFERENT SHIFT TO
+C INSURE CONVERGENCE TO THE DESIRED EIGENVALUES.
+C
+C FORMAL PARAMETERS.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ REAL A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), ATOL, ARTOL, BOUND(2,1), ATEMP(1),
+ 2 D(1), VTEMP(1)
+C
+C
+C LOCAL VARIABLES
+C
+ LOGICAL FLAG
+ INTEGER I, J, L, M, NUML, NUMVEC, NVAL
+ REAL ERRB, GAP, RESID, RQ, SIGMA, VNORM
+C
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL AMAX1, AMIN1, SDOT, SNRM2
+C
+C SUBROUTINES CALLED
+C
+C SLABAX, SLABFC, SLARAN, SAXPY, SCOPY, SSCAL
+C
+C REPLACE ZERO VECTORS BY RANDOM
+C
+ NVAL = NR - NL + 1
+ FLAG = .FALSE.
+ DO 5 I = 1, NVAL
+ IF(SDOT(N, EIGVEC(1,I), 1, EIGVEC(1,I), 1) .EQ. 0.0 )
+ 1 CALL SLARAN(N,EIGVEC(1,I))
+ 5 CONTINUE
+C
+C LOOP OVER EIGENVALUES
+C
+ SIGMA = BOUND(2,NVAL+1)
+ DO 400 J = 1, NVAL
+ NUML = J
+C
+C PREPARE TO COMPUTE FIRST RAYLEIGH QUOTIENT
+C
+ 10 CALL SLABAX(N, NBAND, A, EIGVEC(1,J), VTEMP)
+ VNORM = SNRM2(N, VTEMP, 1)
+ IF(VNORM .EQ. 0.0 ) GO TO 20
+ CALL SSCAL(N, 1.0 /VNORM, VTEMP, 1)
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+ CALL SAXPY(N, -SIGMA, EIGVEC(1,J), 1, VTEMP, 1)
+C
+C LOOP OVER SHIFTS
+C
+C COMPUTE RAYLEIGH QUOTIENT, RESIDUAL NORM, AND CURRENT TOLERANCE
+C
+ 20 VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0 ) GO TO 30
+ CALL SLARAN(N, EIGVEC(1,J))
+ GO TO 10
+C
+ 30 RQ = SIGMA + SDOT(N, EIGVEC(1,J), 1, VTEMP, 1)
+ 1 /VNORM/VNORM
+ CALL SAXPY(N, SIGMA-RQ, EIGVEC(1,J), 1, VTEMP, 1)
+ RESID = AMAX1(ATOL, SNRM2(N, VTEMP, 1)/VNORM)
+ CALL SSCAL(N, 1.0/VNORM, EIGVEC(1,J), 1)
+C
+C ACCEPT EIGENVALUE IF THE INTERVAL IS SMALL ENOUGH
+C
+ IF(BOUND(2,J+1) - BOUND(1,J+1) .LT. 3.0 *ATOL) GO TO 300
+C
+C COMPUTE MINIMAL ERROR BOUND
+C
+ ERRB = RESID
+ GAP = AMIN1(BOUND(1,J+2) - RQ, RQ - BOUND(2,J))
+ IF(GAP .GT. RESID) ERRB = AMAX1(ATOL, RESID*RESID/GAP)
+C
+C TENTATIVE NEW SHIFT
+C
+ SIGMA = 0.5 *(BOUND(1,J+1) + BOUND(2,J+1))
+C
+C CHECK FOR TERMINALTION
+C
+ IF(RESID .GT. 2.0 *ATOL) GO TO 40
+ IF(RQ - ERRB .GT. BOUND(2,J) .AND.
+ 1 RQ + ERRB .LT. BOUND(1,J+2)) GO TO 310
+C
+C RQ IS TO THE LEFT OF THE INTERVAL
+C
+ 40 IF(RQ .GE. BOUND(1,J+1)) GO TO 50
+ IF(RQ - ERRB .GT. BOUND(2,J)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+1)) CALL SLARAN(N,EIGVEC(1,J))
+ GO TO 200
+C
+C RQ IS TO THE RIGHT OF THE INTERVAL
+C
+ 50 IF(RQ .LE. BOUND(2,J+1)) GO TO 100
+ IF(RQ + ERRB .LT. BOUND(1,J+2)) GO TO 100
+C
+C SAVE THE REJECTED VECTOR IF INDICATED
+C
+ IF(RQ - ERRB .LE. BOUND(2,J+1)) GO TO 200
+ DO 60 I = J, NVAL
+ IF(BOUND(2,I+1) .GT. RQ) GO TO 70
+ 60 CONTINUE
+ GO TO 80
+C
+ 70 CALL SCOPY(N, EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+C
+ 80 CALL SLARAN(N, EIGVEC(1,J))
+ GO TO 200
+C
+C PERTURB RQ TOWARD THE MIDDLE
+C
+ 100 IF(SIGMA .LT. RQ) SIGMA = AMAX1(SIGMA, RQ-ERRB)
+ IF(SIGMA .GT. RQ) SIGMA = AMIN1(SIGMA, RQ+ERRB)
+C
+C FACTOR AND SOLVE
+C
+ 200 DO 210 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 220
+ 210 CONTINUE
+ I = NVAL + 1
+ 220 NUMVEC = I - J
+ NUMVEC = MIN0(NUMVEC, NBAND + 2)
+ IF(RESID .LT. ARTOL) NUMVEC = MIN0(1,NUMVEC)
+ CALL SCOPY(N, EIGVEC(1,J), 1, VTEMP, 1)
+ CALL SLABFC(N, NBAND, A, SIGMA, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+C
+C PARTIALLY SCALE EXTRA VECTORS TO PREVENT UNDERFLOW OR OVERFLOW
+C
+ IF(NUMVEC .EQ. 1) GO TO 227
+ L = NUMVEC - 1
+ DO 225 I = 1,L
+ M = J + I
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,M), 1)
+ 225 CONTINUE
+C
+C UPDATE INTERVALS
+C
+ 227 NUML = NUML - NL + 1
+ IF(NUML .GE. 0) BOUND(2,1) = AMIN1(BOUND(2,1), SIGMA)
+ DO 230 I = J, NVAL
+ IF(SIGMA .LT. BOUND(1,I+1)) GO TO 20
+ IF(NUML .LT. I) BOUND(1,I+1) = SIGMA
+ IF(NUML .GE. I) BOUND(2,I+1) = SIGMA
+ 230 CONTINUE
+ IF(NUML .LT. NVAL + 1) BOUND(1,NVAL+2) = AMAX1(SIGMA,
+ 1 BOUND(1,NVAL+2))
+ GO TO 20
+C
+C ACCEPT AN EIGENPAIR
+C
+ 300 CALL SLARAN(N, EIGVEC(1,J))
+ FLAG = .TRUE.
+ GO TO 310
+C
+ 305 FLAG = .FALSE.
+ RQ = 0.5 *(BOUND(1,J+1) + BOUND(2,J+1))
+ CALL SLABFC(N, NBAND, A, RQ, NUMVEC, LDE,
+ 1 EIGVEC(1,J), NUML, 2*NBAND-1, ATEMP, D, ATOL)
+ VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .NE. 0.0) CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE THE NEW EIGENVECTOR AGAINST THE OLD ONES
+C
+ 310 EIGVAL(J) = RQ
+ IF(J .EQ. 1) GO TO 330
+ M = J - 1
+ DO 320 I = 1, M
+ CALL SAXPY(N, -SDOT(N,EIGVEC(1,I),1,EIGVEC(1,J),1),
+ 1 EIGVEC(1,I), 1, EIGVEC(1,J), 1)
+ 320 CONTINUE
+ 330 VNORM = SNRM2(N, EIGVEC(1,J), 1)
+ IF(VNORM .EQ. 0.0 ) GO TO 305
+ CALL SSCAL(N, 1.0 /VNORM, EIGVEC(1,J), 1)
+C
+C ORTHOGONALIZE LATER VECTORS AGAINST THE CONVERGED ONE
+C
+ IF(FLAG) GO TO 305
+ IF(J .EQ. NVAL) RETURN
+ M = J + 1
+ DO 340 I = M, NVAL
+ CALL SAXPY(N, -SDOT(N,EIGVEC(1,J),1,EIGVEC(1,I),1),
+ 1 EIGVEC(1,J), 1, EIGVEC(1,I), 1)
+ 340 CONTINUE
+ 400 CONTINUE
+ RETURN
+C
+ 500 CONTINUE
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE SLABFC(N, NBAND, A, SIGMA, NUMBER, LDE,
+ 1 EIGVEC, NUML, LDAD, ATEMP, D, ATOL)
+C
+C THIS SUBROUTINE FACTORS (A-SIGMA*I) WHERE A IS A GIVEN BAND
+C MATRIX AND SIGMA IS AN INPUT PARAMETER. IT ALSO SOLVES ZERO
+C OR MORE SYSTEMS OF LINEAR EQUATIONS. IT RETURNS THE NUMBER
+C OF EIGENVALUES OF A LESS THAN SIGMA BY COUNTING THE STURM
+C SEQUENCE DURING THE FACTORIZATION. TO OBTAIN THE STURM
+C SEQUENCE COUNT WHILE ALLOWING NON-SYMMETRIC PIVOTING FOR
+C STABILITY, THE CODE USES A GUPTA'S MULTIPLE PIVOTING
+C ALGORITHM.
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NUMBER, LDE, NUML, LDAD
+ REAL A(NBAND,1), SIGMA, EIGVEC(LDE,1),
+ 1 ATEMP(LDAD,1), D(LDAD,1), ATOL
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, J, K, KK, L, LA, LD, LPM, M, NB1
+ REAL ZERO(1)
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL ABS
+C
+C SUBROUTINES CALLED
+C
+C SAXPY, SCOPY, SSWAP
+C
+C
+C INITIALIZE
+C
+ ZERO(1) = 0.0
+ NB1 = NBAND - 1
+ NUML = 0
+ CALL SCOPY(LDAD*NBAND, ZERO, 0, D, 1)
+C
+C LOOP OVER COLUMNS OF A
+C
+ DO 100 K = 1, N
+C
+C ADD A COLUMN OF A TO D
+C
+ D(NBAND, NBAND) = A(1,K) - SIGMA
+ M = MIN0(K, NBAND) - 1
+ IF(M .EQ. 0) GO TO 20
+ DO 10 I = 1, M
+ LA = K - I
+ LD = NBAND - I
+ D(LD,NBAND) = A(I+1, LA)
+ 10 CONTINUE
+C
+ 20 M = MIN0(N-K, NB1)
+ IF(M .EQ. 0) GO TO 40
+ DO 30 I = 1, M
+ LD = NBAND + I
+ D(LD, NBAND) = A(I+1, K)
+ 30 CONTINUE
+C
+C TERMINATE
+C
+ 40 LPM = 1
+ IF(NB1 .EQ. 0) GO TO 70
+ DO 60 I = 1, NB1
+ L = K - NBAND + I
+ IF(D(I,NBAND) .EQ. 0.0 ) GO TO 60
+ IF(ABS(D(I,I)) .GE. ABS(D(I,NBAND))) GO TO 50
+ IF((D(I,NBAND) .LT. 0.0 .AND. D(I,I) .LT. 0.0 )
+ 1 .OR. (D(I,NBAND) .GT. 0.0 .AND. D(I,I) .GE. 0.0 ))
+ 2 LPM = -LPM
+ CALL SSWAP(LDAD-I+1, D(I,I), 1, D(I,NBAND), 1)
+ CALL SSWAP(NUMBER, EIGVEC(L,1), LDE, EIGVEC(K,1), LDE)
+ 50 CALL SAXPY(LDAD-I, -D(I,NBAND)/D(I,I), D(I+1,I), 1,
+ 1 D(I+1,NBAND), 1)
+ CALL SAXPY(NUMBER, -D(I,NBAND)/D(I,I), EIGVEC(L,1),
+ 1 LDE, EIGVEC(K,1), LDE)
+ 60 CONTINUE
+C
+C UPDATE STURM SEQUENCE COUNT
+C
+ 70 IF(D(NBAND,NBAND) .LT. 0.0 ) LPM = -LPM
+ IF(LPM .LT. 0) NUML = NUML + 1
+ IF(K .EQ. N) GO TO 110
+C
+C COPY FIRST COLUMN OF D INTO ATEMP
+ IF(K .LT. NBAND) GO TO 80
+ L = K - NB1
+ CALL SCOPY(LDAD, D, 1, ATEMP(1,L), 1)
+C
+C SHIFT THE COLUMNS OF D OVER AND UP
+C
+ IF(NB1 .EQ. 0) GO TO 100
+ 80 DO 90 I = 1, NB1
+ CALL SCOPY(LDAD-I, D(I+1,I+1), 1, D(I,I), 1)
+ D(LDAD,I) = 0.0
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C TRANSFER D TO ATEMP
+C
+ 110 DO 120 I = 1, NBAND
+ L = N - NBAND + I
+ CALL SCOPY(NBAND-I+1, D(I,I), 1, ATEMP(1,L), 1)
+ 120 CONTINUE
+C
+C BACK SUBSTITUTION
+C
+ IF(NUMBER .EQ. 0) RETURN
+ DO 160 KK = 1, N
+ K = N - KK + 1
+ IF(ABS(ATEMP(1,K)) .LE. ATOL)
+ 1 ATEMP(1,K) = SIGN(ATOL,ATEMP(1,K))
+C
+ 130 DO 150 I = 1, NUMBER
+ EIGVEC(K,I) = EIGVEC(K,I)/ATEMP(1,K)
+ M = MIN0(LDAD, K) - 1
+ IF(M .EQ. 0) GO TO 150
+ DO 140 J = 1, M
+ L = K - J
+ EIGVEC(L,I) = EIGVEC(L,I) - ATEMP(J+1,L)*EIGVEC(K,I)
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ RETURN
+ END
+ SUBROUTINE SLAEIG(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+C
+C THIS IS A SPECIALIZED VERSION OF THE SUBROUTINE BNDEIG TAILORED
+C SPECIFICALLY FOR USE BY THE LASO PACKAGE.
+C
+ INTEGER N, NBAND, NL, NR, LDE
+ REAL A(NBAND,1), EIGVAL(1),
+ 1 EIGVEC(LDE,1), BOUND(2,1), ATEMP(1), D(1), VTEMP(1),
+ 2 EPS, TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, M, NVAL
+ REAL ARTOL, ATOL
+C
+C FUNCTIONS CALLED
+C
+ REAL AMAX1
+C
+C SUBROUTINES CALLED
+C
+C SLABCM, SLABFC, SLAGER, SCOPY
+C
+C SET PARAMETERS
+C
+ ATOL = FLOAT(N)*EPS*AMAX1(TMAX,-TMIN)
+ ARTOL = ATOL/SQRT(EPS)
+ NVAL = NR - NL + 1
+C
+C CHECK FOR SPECIAL CASE OF N = 1
+C
+ IF(N .NE. 1) GO TO 30
+ EIGVAL(1) = A(1,1)
+ EIGVEC(1,1) = 1.0
+ RETURN
+C
+C SET UP INITIAL EIGENVALUE BOUNDS
+C
+ 30 M = NVAL + 1
+ DO 50 I = 2, M
+ BOUND(1,I) = TMIN
+ BOUND(2,I) = TMAX
+ 50 CONTINUE
+ BOUND(2,1) = TMAX
+ BOUND(1,NVAL + 2) = TMIN
+ IF(NL .EQ. 1) BOUND(2,1) = TMIN
+ IF(NR .EQ. N) BOUND(1,NVAL + 2) = TMAX
+C
+ 60 CALL SLABCM(N, NBAND, NL, NR, A, EIGVAL, LDE,
+ 1 EIGVEC, ATOL, ARTOL, BOUND, ATEMP, D, VTEMP)
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE SLAGER(N, NBAND, NSTART, A, TMIN, TMAX)
+C
+C THIS SUBROUTINE COMPUTES BOUNDS ON THE SPECTRUM OF A BY
+C EXAMINING THE GERSCHGORIN CIRCLES. ONLY THE NEWLY CREATED
+C CIRCLES ARE EXAMINED
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N, NBAND, NSTART
+ REAL A(NBAND,1), TMIN, TMAX
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, K, L, M
+ REAL TEMP
+C
+C FUNCTIONS CALLED
+C
+ INTEGER MIN0
+ REAL AMIN1, AMAX1
+C
+ DO 50 K = NSTART, N
+ TEMP = 0.0
+ DO 10 I = 2, NBAND
+ TEMP = TEMP + ABS(A(I,K))
+ 10 CONTINUE
+ 20 L = MIN0(K,NBAND)
+ IF(L .EQ. 1) GO TO 40
+ DO 30 I = 2, L
+ M = K - I + 1
+ TEMP = TEMP + ABS(A(I,M))
+ 30 CONTINUE
+ 40 TMIN = AMIN1(TMIN, A(1,K)-TEMP)
+ TMAX = AMAX1(TMAX, A(1,K)+TEMP)
+ 50 CONTINUE
+ RETURN
+ END
+C
+C***********************************************************************
+C
+ SUBROUTINE SLARAN(N, X)
+C
+C THIS SUBROUTINE SETS THE VECTOR X TO RANDOM NUMBERS
+C
+C FORMAL PARAMETERS
+C
+ INTEGER N
+ REAL X(N)
+C
+C LOCAL VARIABLES
+C
+ INTEGER I, IURAND
+C
+C FUNCTIONS CALLED
+C
+ REAL URAND
+C
+C SUBROUTINES CALLED
+C
+C NONE
+C
+C INITIALIZE SEED
+C
+ DATA IURAND /0/
+C
+ DO 10 I = 1, N
+ X(I) = URAND(IURAND) - 0.5
+ 10 CONTINUE
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SMVPC(NBLOCK, BET, MAXJ, J, S, NUMBER, RESNRM,
+ * ORTHCF, RV)
+C
+ INTEGER NBLOCK, MAXJ, J, NUMBER
+ REAL BET(NBLOCK,1), S(MAXJ,1), RESNRM(1),
+ * ORTHCF(1), RV(1)
+C
+C THIS SUBROUTINE COMPUTES THE NORM AND THE SMALLEST ELEMENT
+C (IN ABSOLUTE VALUE) OF THE VECTOR BET*SJI, WHERE SJI
+C IS AN NBLOCK VECTOR OF THE LAST NBLOCK ELEMENTS OF THE ITH
+C EIGENVECTOR OF T. THESE QUANTITIES ARE THE RESIDUAL NORM
+C AND THE ORTHOGONALITY COEFFICIENT RESPECTIVELY FOR THE
+C CORRESPONDING RITZ PAIR. THE ORTHOGONALITY COEFFICIENT IS
+C NORMALIZED TO ACCOUNT FOR THE LOCAL REORTHOGONALIZATION.
+C
+ INTEGER I, K, M
+ REAL SDOT, SNRM2, ABS, AMIN1
+C
+ M = J - NBLOCK + 1
+ DO 20 I=1,NUMBER
+ DO 10 K=1,NBLOCK
+ RV(K) = SDOT(NBLOCK,S(M,I),1,BET(K,1),NBLOCK)
+ IF (K.EQ.1) ORTHCF(I) = ABS(RV(K))
+ ORTHCF(I) = AMIN1(ORTHCF(I),ABS(RV(K)))
+ 10 CONTINUE
+ RESNRM(I) = SNRM2(NBLOCK,RV,1)
+ 20 CONTINUE
+ RETURN
+ END
+C VERSION 2 DOES NOT USE EISPACK
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SNLASO(OP, IOVECT, N, NVAL, NFIG, NPERM,
+ * NMVAL, VAL, NMVEC, VEC, NBLOCK, MAXOP, MAXJ, WORK,
+ * IND, IERR)
+C
+ INTEGER N, NVAL, NFIG, NPERM, NMVAL, NMVEC, NBLOCK,
+ * MAXOP, MAXJ, IND(1), IERR
+ REAL VEC(NMVEC,1), VAL(NMVAL,1), WORK(1)
+ EXTERNAL OP, IOVECT
+C
+C AUTHOR/IMPLEMENTER D.S.SCOTT-B.N.PARLETT/D.S.SCOTT
+C
+C COMPUTER SCIENCES DEPARTMENT
+C UNIVERSITY OF TEXAS AT AUSTIN
+C AUSTIN, TX 78712
+C
+C VERSION 2 ORIGINATED APRIL 1982
+C
+C CURRENT VERSION JUNE 1983
+C
+C SNLASO FINDS A FEW EIGENVALUES AND EIGENVECTORS AT EITHER END OF
+C THE SPECTRUM OF A LARGE SPARSE SYMMETRIC MATRIX. THE SUBROUTINE
+C SNLASO IS PRIMARILY A DRIVER FOR SUBROUTINE SNWLA WHICH IMPLEMENTS
+C THE LANCZOS ALGORITHM WITH SELECTIVE ORTHOGONALIZATION AND
+C SUBROUTINE SNPPLA WHICH POST PROCESSES THE OUTPUT OF SNWLA.
+C HOWEVER SNLASO DOES CHECK FOR INCONSISTENCIES IN THE CALLING
+C PARAMETERS AND DOES PREPROCESS ANY USER SUPPLIED EIGENPAIRS.
+C SNLASO ALWAYS LOOKS FOR THE SMALLEST (LEFTMOST) EIGENVALUES. IF
+C THE LARGEST EIGENVALUES ARE DESIRED SNLASO IMPLICITLY USES THE
+C NEGATIVE OF THE MATRIX.
+C
+C
+C ON INPUT
+C
+C
+C OP A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE
+C OP(N,M,P,Q). P AND Q ARE N X M MATRICES AND Q IS
+C RETURNED AS THE MATRIX TIMES P.
+C
+C IOVECT A USER SUPPLIED SUBROUTINE WITH CALLING SEQUENCE
+C IOVECT(N,M,Q,J,K). Q IS AN N X M MATRIX. IF K = 0
+C THE COLUMNS OF Q ARE STORED AS THE (J-M+1)TH THROUGH
+C THE JTH LANCZOS VECTORS. IF K = 1 THEN Q IS RETURNED
+C AS THE (J-M+1)TH THROUGH THE JTH LANCZOS VECTORS. SEE
+C DOCUMENTATION FOR FURTHER DETAILS AND EXAMPLES.
+C
+C N THE ORDER OF THE MATRIX.
+C
+C NVAL NVAL SPECIFIES THE EIGENVALUES TO BE FOUND.
+C ABS(NVAL) IS THE NUMBER OF EIGENVALUES DESIRED.
+C IF NVAL < 0 THE ALGEBRAICALLY SMALLEST (LEFTMOST)
+C EIGENVALUES ARE FOUND. IF NVAL > 0 THE ALGEBRAICALLY
+C LARGEST (RIGHTMOST) EIGENVALUES ARE FOUND. NVAL MUST NOT
+C BE ZERO. ABS(NVAL) MUST BE LESS THAN MAXJ/2.
+C
+C NFIG THE NUMBER OF DECIMAL DIGITS OF ACCURACY DESIRED IN THE
+C EIGENVALUES. NFIG MUST BE GREATER THAN OR EQUAL TO 1.
+C
+C NPERM AN INTEGER VARIABLE WHICH SPECIFIES THE NUMBER OF USER
+C SUPPLIED EIGENPAIRS. IN MOST CASES NPERM WILL BE ZERO. SEE
+C DOCUMENTAION FOR FURTHER DETAILS OF USING NPERM GREATER
+C THAN ZERO. NPERM MUST NOT BE LESS THAN ZERO.
+C
+C NMVAL THE ROW DIMENSION OF THE ARRAY VAL. NMVAL MUST BE GREATER
+C THAN OR EQUAL TO ABS(NVAL).
+C
+C VAL A TWO DIMENSIONAL REAL ARRAY OF ROW
+C DIMENSION NMVAL AND COLUMN DIMENSION AT LEAST 4. IF NPERM
+C IS GREATER THAN ZERO THEN CERTAIN INFORMATION MUST BE STORED
+C IN VAL. SEE DOCUMENTATION FOR DETAILS.
+C
+C NMVEC THE ROW DIMENSION OF THE ARRAY VEC. NMVEC MUST BE GREATER
+C THAN OR EQUAL TO N.
+C
+C VEC A TWO DIMENSIONAL REAL ARRAY OF ROW
+C DIMENSION NMVEC AND COLUMN DIMENSION AT LEAST ABS(NVAL). IF
+C NPERM > 0 THEN THE FIRST NPERM COLUMNS OF VEC MUST
+C CONTAIN THE USER SUPPLIED EIGENVECTORS.
+C
+C NBLOCK THE BLOCK SIZE. SEE DOCUMENTATION FOR CHOOSING
+C AN APPROPRIATE VALUE FOR NBLOCK. NBLOCK MUST BE GREATER
+C THAN ZERO AND LESS THAN MAXJ/6.
+C
+C MAXOP AN UPPER BOUND ON THE NUMBER OF CALLS TO THE SUBROUTINE
+C OP. SNLASO TERMINATES WHEN MAXOP IS EXCEEDED. SEE
+C DOCUMENTATION FOR GUIDELINES IN CHOOSING A VALUE FOR MAXOP.
+C
+C MAXJ AN INDICATION OF THE AVAILABLE STORAGE (SEE WORK AND
+C DOCUMENTATION ON IOVECT). FOR THE FASTEST CONVERGENCE MAXJ
+C SHOULD BE AS LARGE AS POSSIBLE, ALTHOUGH IT IS USELESS TO HAVE
+C MAXJ LARGER THAN MAXOP*NBLOCK.
+C
+C WORK A REAL ARRAY OF DIMENSION AT LEAST AS
+C LARGE AS
+C
+C 2*N*NBLOCK + MAXJ*(NBLOCK+NV+2) + 2*NBLOCK*NBLOCK + 3*NV
+C
+C + THE MAXIMUM OF
+C N*NBLOCK
+C AND
+C MAXJ*(2*NBLOCK+3) + 2*NV + 6 + (2*NBLOCK+2)*(NBLOCK+1)
+C
+C WHERE NV = ABS(NVAL)
+C
+C THE FIRST N*NBLOCK ELEMENTS OF WORK MUST CONTAIN THE DESIRED
+C STARTING VECTORS. SEE DOCUMENTATION FOR GUIDELINES IN
+C CHOOSING STARTING VECTORS.
+C
+C IND AN INTEGER ARRAY OF DIMENSION AT LEAST ABS(NVAL).
+C
+C IERR AN INTEGER VARIABLE.
+C
+C
+C ON OUTPUT
+C
+C
+C NPERM THE NUMBER OF EIGENPAIRS NOW KNOWN.
+C
+C VEC THE FIRST NPERM COLUMNS OF VEC CONTAIN THE EIGENVECTORS.
+C
+C VAL THE FIRST COLUMN OF VAL CONTAINS THE CORRESPONDING
+C EIGENVALUES. THE SECOND COLUMN CONTAINS THE RESIDUAL NORMS OF
+C THE EIGENPAIRS WHICH ARE BOUNDS ON THE ACCURACY OF THE EIGEN-
+C VALUES. THE THIRD COLUMN CONTAINS MORE REALISTIC ESTIMATES
+C OF THE ACCURACY OF THE EIGENVALUES. THE FOURTH COLUMN CONTAINS
+C ESTIMATES OF THE ACCURACY OF THE EIGENVECTORS. SEE
+C DOCUMENTATION FOR FURTHER INFORMATION ON THESE QUANTITIES.
+C
+C WORK IF WORK IS TERMINATED BEFORE COMPLETION (IERR = -2)
+C THE FIRST N*NBLOCK ELEMENTS OF WORK CONTAIN THE BEST VECTORS
+C FOR RESTARTING THE ALGORITHM AND SNLASO CAN BE IMMEDIATELY
+C RECALLED TO CONTINUE WORKING ON THE PROBLEM.
+C
+C IND IND(1) CONTAINS THE ACTUAL NUMBER OF CALLS TO OP. ON SOME
+C OCCASIONS THE NUMBER OF CALLS TO OP MAY BE SLIGHTLY LARGER
+C THAN MAXOP.
+C
+C IERR AN ERROR COMPLETION CODE. THE NORMAL COMPLETION CODE IS
+C ZERO. SEE THE DOCUMENTATION FOR INTERPRETATIONS OF NON-ZERO
+C COMPLETION CODES.
+C
+C
+C INTERNAL VARIABLES.
+C
+C
+ INTEGER I, I1, I2, I3, I4, I5, I6, I7, I8, I9, I10, I11,
+ * I12, I13, M, NBAND, NOP, NV, IABS, MAX0
+ LOGICAL RARITZ, SMALL
+ REAL DELTA, EPS, TEMP, SDOT, SNRM2, ABS, TARR(1)
+ EXTERNAL SNPPLA, SNWLA, SMVPC, SORTQR, SAXPY,
+ * SCOPY, SDOT, SNRM2, SSCAL, SSWAP, SLAEIG, SLABCM,
+ * SLABFC, SLAGER, SLARAN, SVSORT
+C
+C NOP RETURNED FROM SNWLA AS THE NUMBER OF CALLS TO THE
+C SUBROUTINE OP.
+C
+C NV SET EQUAL TO ABS(NVAL), THE NUMBER OF EIGENVALUES DESIRED,
+C AND PASSED TO SNWLA.
+C
+C SMALL SET TO .TRUE. IF THE SMALLEST EIGENVALUES ARE DESIRED.
+C
+C RARITZ RETURNED FROM SNWLA AND PASSED TO SNPPLA. RARITZ IS .TRUE.
+C IF A FINAL RAYLEIGH-RITZ PROCEDURE IS NEEDED.
+C
+C DELTA RETURNED FROM SNWLA AS THE EIGENVALUE OF THE MATRIX
+C WHICH IS CLOSEST TO THE DESIRED EIGENVALUES.
+C
+C SNPPLA A SUBROUTINE FOR POST-PROCESSING THE EIGENVECTORS COMPUTED
+C BY SNWLA.
+C
+C SNWLA A SUBROUTINE FOR IMPLEMENTING THE LANCZOS ALGORITHM
+C WITH SELECTIVE ORTHOGONALIZATION.
+C
+C SMVPC A SUBROUTINE FOR COMPUTING THE RESIDUAL NORM AND
+C ORTHOGONALITY COEFFICIENT OF GIVEN RITZ VECTORS.
+C
+C SORTQR A SUBROUTINE FOR ORTHONORMALIZING A BLOCK OF VECTORS
+C USING HOUSEHOLDER REFLECTIONS.
+C
+C SAXPY,SCOPY,SDOT,SNRM2,SSCAL,SSWAP A SUBSET OF THE BASIC LINEAR
+C ALGEBRA SUBPROGRAMS USED FOR VECTOR MANIPULATION.
+C
+C SLARAN A SUBROUTINE TO GENERATE RANDOM VECTORS
+C
+C SLAEIG, SLAGER, SLABCM, SLABFC SUBROUTINES FOR BAND EIGENVALUE
+C CALCULATIONS.
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CHECKS FOR INCONSISTENCY IN THE INPUT PARAMETERS.
+C
+ NV = IABS(NVAL)
+ IND(1) = 0
+ IERR = 0
+ IF (N.LT.6*NBLOCK) IERR = 1
+ IF (NFIG.LE.0) IERR = IERR + 2
+ IF (NMVEC.LT.N) IERR = IERR + 4
+ IF (NPERM.LT.0) IERR = IERR + 8
+ IF (MAXJ.LT.6*NBLOCK) IERR = IERR + 16
+ IF (NV.LT.MAX0(1,NPERM)) IERR = IERR + 32
+ IF (NV.GT.NMVAL) IERR = IERR + 64
+ IF (NV.GT.MAXOP) IERR = IERR + 128
+ IF (NV.GE.MAXJ/2) IERR = IERR + 256
+ IF (NBLOCK.LT.1) IERR = IERR + 512
+ IF (IERR.NE.0) RETURN
+C
+ SMALL = NVAL.LT.0
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION SORTS AND ORTHONORMALIZES THE USER SUPPLIED VECTORS.
+C IF A USER SUPPLIED VECTOR IS ZERO OR IF SIGNIFICANT CANCELLATION
+C OCCURS IN THE ORTHOGONALIZATION PROCESS THEN IERR IS SET TO -1
+C AND SNLASO TERMINATES.
+C
+ IF (NPERM.EQ.0) GO TO 110
+C
+C THIS NEGATES THE USER SUPPLIED EIGENVALUES WHEN THE LARGEST
+C EIGENVALUES ARE DESIRED, SINCE SNWLA WILL IMPLICITLY USE THE
+C NEGATIVE OF THE MATRIX.
+C
+ IF (SMALL) GO TO 20
+ DO 10 I=1,NPERM
+ VAL(I,1) = -VAL(I,1)
+ 10 CONTINUE
+C
+C THIS SORTS THE USER SUPPLIED VALUES AND VECTORS.
+C
+ 20 CALL SVSORT(NPERM, VAL, VAL(1,2), 0, TARR, NMVEC, N, VEC)
+C
+C THIS STORES THE NORMS OF THE VECTORS FOR LATER COMPARISON.
+C IT ALSO INSURES THAT THE RESIDUAL NORMS ARE POSITIVE.
+C
+ DO 60 I=1,NPERM
+ VAL(I,2) = ABS(VAL(I,2))
+ VAL(I,3) = SNRM2(N,VEC(1,I),1)
+ 60 CONTINUE
+C
+C THIS PERFORMS THE ORTHONORMALIZATION.
+C
+ M = N*NBLOCK + 1
+ CALL SORTQR(NMVEC, N, NPERM, VEC, WORK(M))
+ M = N*NBLOCK - NPERM
+ DO 70 I = 1, NPERM
+ M = M + NPERM + 1
+ IF(ABS(WORK(M)) .GT. 0.9*VAL(I,3)) GO TO 70
+ IERR = -1
+ RETURN
+C
+ 70 CONTINUE
+C
+C THIS COPIES THE RESIDUAL NORMS INTO THE CORRECT LOCATIONS IN
+C THE ARRAY WORK FOR LATER REFERENCE IN SNWLA.
+C
+ M = 2*N*NBLOCK + 1
+ CALL SCOPY(NPERM, VAL(1,2), 1, WORK(M), 1)
+C
+C THIS SETS EPS TO AN APPROXIMATION OF THE RELATIVE MACHINE
+C PRECISION
+C
+C ***THIS SHOULD BE REPLACED BY AN ASSIGNMENT STATEMENT
+C ***IN A PRODUCTION CODE
+C
+ 110 EPS = 1.0
+ DO 120 I = 1,1000
+ EPS = 0.5 *EPS
+ TEMP = 1.0 + EPS
+ IF(TEMP.EQ.1.0 ) GO TO 130
+ 120 CONTINUE
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CALLS SNWLA WHICH IMPLEMENTS THE LANCZOS ALGORITHM
+C WITH SELECTIVE ORTHOGONALIZATION.
+C
+ 130 NBAND = NBLOCK + 1
+ I1 = 1 + N*NBLOCK
+ I2 = I1 + N*NBLOCK
+ I3 = I2 + NV
+ I4 = I3 + NV
+ I5 = I4 + NV
+ I6 = I5 + MAXJ*NBAND
+ I7 = I6 + NBLOCK*NBLOCK
+ I8 = I7 + NBLOCK*NBLOCK
+ I9 = I8 + MAXJ*(NV+1)
+ I10 = I9 + NBLOCK
+ I11 = I10 + 2*NV + 6
+ I12 = I11 + MAXJ*(2*NBLOCK+1)
+ I13 = I12 + MAXJ
+ CALL SNWLA(OP, IOVECT, N, NBAND, NV, NFIG, NPERM, VAL, NMVEC,
+ * VEC, NBLOCK, MAXOP, MAXJ, NOP, WORK(1), WORK(I1),
+ * WORK(I2), WORK(I3), WORK(I4), WORK(I5), WORK(I6),
+ * WORK(I7), WORK(I8), WORK(I9), WORK(I10), WORK(I11),
+ * WORK(I12), WORK(I13), IND, SMALL, RARITZ, DELTA, EPS, IERR)
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION CALLS SNPPLA (THE POST PROCESSOR).
+C
+ IF (NPERM.EQ.0) GO TO 140
+ I1 = N*NBLOCK + 1
+ I2 = I1 + NPERM*NPERM
+ I3 = I2 + NPERM*NPERM
+ I4 = I3 + MAX0(N*NBLOCK,2*NPERM*NPERM)
+ I5 = I4 + N*NBLOCK
+ I6 = I5 + 2*NPERM + 4
+ CALL SNPPLA(OP, IOVECT, N, NPERM, NOP, NMVAL, VAL, NMVEC,
+ * VEC, NBLOCK, WORK(I1), WORK(I2), WORK(I3), WORK(I4),
+ * WORK(I5), WORK(I6), DELTA, SMALL, RARITZ, EPS)
+C
+ 140 IND(1) = NOP
+ RETURN
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SNWLA(OP, IOVECT, N, NBAND, NVAL, NFIG, NPERM, VAL,
+ * NMVEC, VEC, NBLOCK, MAXOP, MAXJ, NOP, P1, P0,
+ * RES, TAU, OTAU, T, ALP, BET, S, P2, BOUND, ATEMP, VTEMP, D,
+ * IND, SMALL, RARITZ, DELTA, EPS, IERR)
+C
+ INTEGER N, NBAND, NVAL, NFIG, NPERM, NMVEC, NBLOCK, MAXOP, MAXJ,
+ * NOP, IND(1), IERR
+ LOGICAL RARITZ, SMALL
+ REAL VAL(1), VEC(NMVEC,1), P0(N,1), P1(N,1),
+ * P2(N,1), RES(1), TAU(1), OTAU(1), T(NBAND,1),
+ * ALP(NBLOCK,1), BET(NBLOCK,1), BOUND(1), ATEMP(1),
+ * VTEMP(1), D(1), S(MAXJ,1), DELTA, EPS
+ EXTERNAL OP, IOVECT
+C
+C SNWLA IMPLEMENTS THE LANCZOS ALGORITHM WITH SELECTIVE
+C ORTHOGONALIZATION.
+C
+C NBAND NBLOCK + 1 THE BAND WIDTH OF T.
+C
+C NVAL THE NUMBER OF DESIRED EIGENVALUES.
+C
+C NPERM THE NUMBER OF PERMANENT VECTORS (THOSE EIGENVECTORS
+C INPUT BY THE USER OR THOSE EIGENVECTORS SAVED WHEN THE
+C ALGORITHM IS ITERATED). PERMANENT VECTORS ARE ORTHOGONAL
+C TO THE CURRENT KRYLOV SUBSPACE.
+C
+C NOP THE NUMBER OF CALLS TO OP.
+C
+C P0, P1, AND P2 THE CURRENT BLOCKS OF LANCZOS VECTORS.
+C
+C RES THE (APPROXIMATE) RESIDUAL NORMS OF THE PERMANENT VECTORS.
+C
+C TAU AND OTAU USED TO MONITOR THE NEED FOR ORTHOGONALIZATION.
+C
+C T THE BAND MATRIX.
+C
+C ALP THE CURRENT DIAGONAL BLOCK.
+C
+C BET THE CURRENT OFF DIAGONAL BLOCK.
+C
+C BOUND, ATEMP, VTEMP, D TEMPORARY STORAGE USED BY THE BAND
+C EIGENVALUE SOLVER SLAEIG.
+C
+C S EIGENVECTORS OF T.
+C
+C SMALL .TRUE. IF THE SMALL EIGENVALUES ARE DESIRED.
+C
+C RARITZ RETURNED AS .TRUE. IF A FINAL RAYLEIGH-RITZ PROCEDURE
+C IS TO BE DONE.
+C
+C DELTA RETURNED AS THE VALUE OF THE (NVAL+1)TH EIGENVALUE
+C OF THE MATRIX. USED IN ESTIMATING THE ACCURACY OF THE
+C COMPUTED EIGENVALUES.
+C
+C
+C INTERNAL VARIABLES USED
+C
+ INTEGER I, I1, II, J, K, L, M, NG, NGOOD,
+ * NLEFT, NSTART, NTHETA, NUMBER, MIN0, MTEMP
+ LOGICAL ENOUGH, TEST
+ REAL ALPMAX, ALPMIN, ANORM, BETMAX, BETMIN,
+ * EPSRT, PNORM, RNORM, TEMP,
+ * TMAX, TMIN, TOLA, TOLG, UTOL, ABS,
+ * AMAX1, AMIN1, SQRT, SDOT, SNRM2, TARR(1), ZERO(1)
+ EXTERNAL SMVPC, SORTQR, SAXPY, SCOPY, SDOT,
+ * SNRM2, SSCAL, SSWAP, SLAEIG, SLAGER, SLARAN, SVSORT
+C
+C J THE CURRENT DIMENSION OF T. (THE DIMENSION OF THE CURRENT
+C KRYLOV SUBSPACE.
+C
+C NGOOD THE NUMBER OF GOOD RITZ VECTORS (GOOD VECTORS
+C LIE IN THE CURRENT KRYLOV SUBSPACE).
+C
+C NLEFT THE NUMBER OF VALUES WHICH REMAIN TO BE DETERMINED,
+C I.E. NLEFT = NVAL - NPERM.
+C
+C NUMBER = NPERM + NGOOD.
+C
+C ANORM AN ESTIMATE OF THE NORM OF THE MATRIX.
+C
+C EPS THE RELATIVE MACHINE PRECISION.
+C
+C UTOL THE USER TOLERANCE.
+C
+C TARR AN ARRAY OF LENGTH ONE USED TO INSURE TYPE CONSISTENCY IN CALLS TO
+C SLAEIG
+C
+C ZERO AN ARRAY OF LENGTH ONE CONTAINING ZERO, USED TO INSURE TYPE CONSISTENCY
+C IN CALLS TO SCOPY
+C
+ ZERO(1) = 0.0
+ RNORM = 0.0
+ IF (NPERM.NE.0) RNORM = AMAX1(-VAL(1),VAL(NPERM))
+ PNORM = RNORM
+ DELTA = 10.D30
+ EPSRT = SQRT(EPS)
+ NLEFT = NVAL - NPERM
+ NOP = 0
+ NUMBER = NPERM
+ RARITZ = .FALSE.
+ UTOL = AMAX1(FLOAT(N)*EPS,10.0 **-FLOAT(NFIG))
+ J = MAXJ
+C
+C ------------------------------------------------------------------
+C
+C ANY ITERATION OF THE ALGORITHM BEGINS HERE.
+C
+ 30 DO 50 I=1,NBLOCK
+ TEMP = SNRM2(N,P1(1,I),1)
+ IF (TEMP.EQ.0 ) CALL SLARAN(N, P1(1,I))
+ 50 CONTINUE
+ IF (NPERM.EQ.0) GO TO 70
+ DO 60 I=1,NPERM
+ TAU(I) = 1.0
+ OTAU(I) = 0.0
+ 60 CONTINUE
+ 70 CALL SCOPY(N*NBLOCK, ZERO, 0, P0, 1)
+ CALL SCOPY(NBLOCK*NBLOCK, ZERO, 0, BET, 1)
+ CALL SCOPY(J*NBAND, ZERO, 0, T, 1)
+ MTEMP = NVAL + 1
+ DO 75 I = 1, MTEMP
+ CALL SCOPY(J, ZERO, 0, S(1,I), 1)
+ 75 CONTINUE
+ NGOOD = 0
+ TMIN = 1.0D30
+ TMAX = -1.0D30
+ TEST = .TRUE.
+ ENOUGH = .FALSE.
+ BETMAX = 0.0
+ J = 0
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION TAKES A SINGLE BLOCK LANCZOS STEP.
+C
+ 80 J = J + NBLOCK
+C
+C THIS IS THE SELECTIVE ORTHOGONALIZATION.
+C
+ IF (NUMBER.EQ.0) GO TO 110
+ DO 100 I=1,NUMBER
+ IF (TAU(I).LT.EPSRT) GO TO 100
+ TEST = .TRUE.
+ TAU(I) = 0.0
+ IF (OTAU(I).NE.0.0 ) OTAU(I) = 1.0
+ DO 90 K=1,NBLOCK
+ TEMP = -SDOT(N,VEC(1,I),1,P1(1,K),1)
+ CALL SAXPY(N, TEMP, VEC(1,I), 1, P1(1,K), 1)
+C
+C THIS CHECKS FOR TOO GREAT A LOSS OF ORTHOGONALITY BETWEEN A
+C NEW LANCZOS VECTOR AND A GOOD RITZ VECTOR. THE ALGORITHM IS
+C TERMINATED IF TOO MUCH ORTHOGONALITY IS LOST.
+C
+ IF (ABS(TEMP*BET(K,K)).GT.FLOAT(N)*EPSRT*
+ * ANORM .AND. I.GT.NPERM) GO TO 380
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C IF NECESSARY, THIS REORTHONORMALIZES P1 AND UPDATES BET.
+C
+ 110 IF(.NOT. TEST) GO TO 160
+ CALL SORTQR(N, N, NBLOCK, P1, ALP)
+ TEST = .FALSE.
+ IF(J .EQ. NBLOCK) GO TO 160
+ DO 130 I = 1,NBLOCK
+ IF(ALP(I,I) .GT. 0.0 ) GO TO 130
+ M = J - 2*NBLOCK + I
+ L = NBLOCK + 1
+ DO 120 K = I,NBLOCK
+ BET(I,K) = -BET(I,K)
+ T(L,M) = -T(L,M)
+ L = L - 1
+ M = M + 1
+ 120 CONTINUE
+ 130 CONTINUE
+C
+C THIS IS THE LANCZOS STEP.
+C
+ 160 CALL OP(N, NBLOCK, P1, P2)
+ NOP = NOP + 1
+ CALL IOVECT(N, NBLOCK, P1, J, 0)
+C
+C THIS COMPUTES P2=P2-P0*BET(TRANSPOSE)
+C
+ DO 180 I=1,NBLOCK
+ DO 170 K=I,NBLOCK
+ CALL SAXPY(N, -BET(I,K), P0(1,K), 1, P2(1,I), 1)
+ 170 CONTINUE
+ 180 CONTINUE
+C
+C THIS COMPUTES ALP AND P2=P2-P1*ALP.
+C
+ DO 200 I=1,NBLOCK
+ DO 190 K=1,I
+ II = I - K + 1
+ ALP(II,K) = SDOT(N,P1(1,I),1,P2(1,K),1)
+ CALL SAXPY(N, -ALP(II,K), P1(1,I), 1, P2(1,K), 1)
+ IF (K.NE.I) CALL SAXPY(N, -ALP(II,K), P1(1,K),
+ * 1, P2(1,I), 1)
+ 190 CONTINUE
+ 200 CONTINUE
+C
+C REORTHOGONALIZATION OF THE SECOND BLOCK
+C
+ IF(J .NE. NBLOCK) GO TO 220
+ DO 215 I=1,NBLOCK
+ DO 210 K=1,I
+ TEMP = SDOT(N,P1(1,I),1,P2(1,K),1)
+ CALL SAXPY(N, -TEMP, P1(1,I), 1, P2(1,K), 1)
+ IF (K.NE.I) CALL SAXPY(N, -TEMP, P1(1,K),
+ * 1, P2(1,I), 1)
+ II = I - K + 1
+ ALP(II,K) = ALP(II,K) + TEMP
+ 210 CONTINUE
+ 215 CONTINUE
+C
+C THIS ORTHONORMALIZES THE NEXT BLOCK
+C
+ 220 CALL SORTQR(N, N, NBLOCK, P2, BET)
+C
+C THIS STORES ALP AND BET IN T.
+C
+ DO 250 I=1,NBLOCK
+ M = J - NBLOCK + I
+ DO 230 K=I,NBLOCK
+ L = K - I + 1
+ T(L,M) = ALP(L,I)
+ 230 CONTINUE
+ DO 240 K=1,I
+ L = NBLOCK - I + K + 1
+ T(L,M) = BET(K,I)
+ 240 CONTINUE
+ 250 CONTINUE
+C
+C THIS NEGATES T IF SMALL IS FALSE.
+C
+ IF (SMALL) GO TO 280
+ M = J - NBLOCK + 1
+ DO 270 I=M,J
+ DO 260 K=1,L
+ T(K,I) = -T(K,I)
+ 260 CONTINUE
+ 270 CONTINUE
+C
+C THIS SHIFTS THE LANCZOS VECTORS
+C
+ 280 CALL SCOPY(NBLOCK*N, P1, 1, P0, 1)
+ CALL SCOPY(NBLOCK*N, P2, 1, P1, 1)
+ CALL SLAGER(J, NBAND, J-NBLOCK+1, T, TMIN, TMAX)
+ ANORM = AMAX1(RNORM, TMAX, -TMIN)
+ IF (NUMBER.EQ.0) GO TO 305
+C
+C THIS COMPUTES THE EXTREME EIGENVALUES OF ALP.
+C
+ CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
+ CALL SLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
+ 1 P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ ALPMIN = TARR(1)
+ CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
+ CALL SLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
+ 1 NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ ALPMAX = TARR(1)
+C
+C THIS COMPUTES ALP = BET(TRANSPOSE)*BET.
+C
+ 305 DO 310 I = 1, NBLOCK
+ DO 300 K = 1, I
+ L = I - K + 1
+ ALP(L,K) = SDOT(NBLOCK-I+1, BET(I,I), NBLOCK, BET(K,I),
+ 1 NBLOCK)
+ 300 CONTINUE
+ 310 CONTINUE
+ IF(NUMBER .EQ. 0) GO TO 330
+C
+C THIS COMPUTES THE SMALLEST SINGULAR VALUE OF BET.
+C
+ CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
+ CALL SLAEIG(NBLOCK, NBLOCK, 1, 1, ALP, TARR, NBLOCK,
+ 1 P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0, ANORM*ANORM)
+ BETMIN = SQRT(TARR(1))
+C
+C THIS UPDATES TAU AND OTAU.
+C
+ DO 320 I=1,NUMBER
+ TEMP = (TAU(I)*AMAX1(ALPMAX-VAL(I),VAL(I)-ALPMIN)
+ * +OTAU(I)*BETMAX+EPS*ANORM)/BETMIN
+ IF (I.LE.NPERM) TEMP = TEMP + RES(I)/BETMIN
+ OTAU(I) = TAU(I)
+ TAU(I) = TEMP
+ 320 CONTINUE
+C
+C THIS COMPUTES THE LARGEST SINGULAR VALUE OF BET.
+C
+ 330 CALL SCOPY(NBLOCK, ZERO, 0, P2, 1)
+ CALL SLAEIG(NBLOCK, NBLOCK, NBLOCK, NBLOCK, ALP, TARR,
+ 1 NBLOCK, P2, BOUND, ATEMP, D, VTEMP, EPS, 0.0,
+ 2 ANORM*ANORM)
+ BETMAX = SQRT(TARR(1))
+ IF (J.LE.2*NBLOCK) GO TO 80
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES AND EXAMINES THE SMALLEST NONGOOD AND
+C LARGEST DESIRED EIGENVALUES OF T TO SEE IF A CLOSER LOOK
+C IS JUSTIFIED.
+C
+ TOLG = EPSRT*ANORM
+ TOLA = UTOL*RNORM
+ IF(MAXJ-J .LT. NBLOCK .OR. (NOP .GE. MAXOP .AND.
+ 1 NLEFT .NE. 0)) GO TO 390
+ GO TO 400
+
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES SOME EIGENVALUES AND EIGENVECTORS OF T TO
+C SEE IF FURTHER ACTION IS INDICATED, ENTRY IS AT 380 OR 390 IF AN
+C ITERATION (OR TERMINATION) IS KNOWN TO BE NEEDED, OTHERWISE ENTRY
+C IS AT 400.
+C
+ 380 J = J - NBLOCK
+ IERR = -8
+ 390 IF (NLEFT.EQ.0) RETURN
+ TEST = .TRUE.
+ 400 NTHETA = MIN0(J/2,NLEFT+1)
+ CALL SLAEIG(J, NBAND, 1, NTHETA, T, VAL(NUMBER+1),
+ 1 MAXJ, S, BOUND, ATEMP, D, VTEMP, EPS, TMIN, TMAX)
+ CALL SMVPC(NBLOCK, BET, MAXJ, J, S, NTHETA, ATEMP, VTEMP, D)
+C
+C THIS CHECKS FOR TERMINATION OF A CHECK RUN
+C
+ IF(NLEFT .NE. 0 .OR. J .LT. 6*NBLOCK) GO TO 410
+ IF(VAL(NUMBER+1)-ATEMP(1) .GT. VAL(NPERM) - TOLA) GO TO 790
+C
+C THIS UPDATES NLEFT BY EXAMINING THE COMPUTED EIGENVALUES OF T
+C TO DETERMINE IF SOME PERMANENT VALUES ARE NO LONGER DESIRED.
+C
+ 410 IF (NTHETA.LE.NLEFT) GO TO 470
+ IF (NPERM.EQ.0) GO TO 430
+ M = NUMBER + NLEFT + 1
+ IF (VAL(M).GE.VAL(NPERM)) GO TO 430
+ NPERM = NPERM - 1
+ NGOOD = 0
+ NUMBER = NPERM
+ NLEFT = NLEFT + 1
+ GO TO 400
+C
+C THIS UPDATES DELTA.
+C
+ 430 M = NUMBER + NLEFT + 1
+ DELTA = AMIN1(DELTA,VAL(M))
+ ENOUGH = .TRUE.
+ IF(NLEFT .EQ. 0) GO TO 80
+ NTHETA = NLEFT
+ VTEMP(NTHETA+1) = 1
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION EXAMINES THE COMPUTED EIGENPAIRS IN DETAIL.
+C
+C THIS CHECKS FOR ENOUGH ACCEPTABLE VALUES.
+C
+ IF (.NOT.(TEST .OR. ENOUGH)) GO TO 470
+ DELTA = AMIN1(DELTA,ANORM)
+ PNORM = AMAX1(RNORM,AMAX1(-VAL(NUMBER+1),DELTA))
+ TOLA = UTOL*PNORM
+ NSTART = 0
+ DO 460 I=1,NTHETA
+ M = NUMBER + I
+ IF (AMIN1(ATEMP(I)*ATEMP(I)/(DELTA-VAL(M)),ATEMP(I))
+ * .GT.TOLA) GO TO 450
+ IND(I) = -1
+ GO TO 460
+C
+ 450 ENOUGH = .FALSE.
+ IF (.NOT.TEST) GO TO 470
+ IND(I) = 1
+ NSTART = NSTART + 1
+ 460 CONTINUE
+C
+C COPY VALUES OF IND INTO VTEMP
+C
+ DO 465 I = 1,NTHETA
+ VTEMP(I) = FLOAT(IND(I))
+ 465 CONTINUE
+ GO TO 500
+C
+C THIS CHECKS FOR NEW GOOD VECTORS.
+C
+ 470 NG = 0
+ DO 490 I=1,NTHETA
+ IF (VTEMP(I).GT.TOLG) GO TO 480
+ NG = NG + 1
+ VTEMP(I) = -1
+ GO TO 490
+C
+ 480 VTEMP(I) = 1
+ 490 CONTINUE
+C
+ IF (NG.LE.NGOOD) GO TO 80
+ NSTART = NTHETA - NG
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES AND NORMALIZES THE INDICATED RITZ VECTORS.
+C IF NEEDED (TEST = .TRUE.), NEW STARTING VECTORS ARE COMPUTED.
+C
+ 500 TEST = TEST .AND. .NOT.ENOUGH
+ NGOOD = NTHETA - NSTART
+ NSTART = NSTART + 1
+ NTHETA = NTHETA + 1
+C
+C THIS ALIGNS THE DESIRED (ACCEPTABLE OR GOOD) EIGENVALUES AND
+C EIGENVECTORS OF T. THE OTHER EIGENVECTORS ARE SAVED FOR
+C FORMING STARTING VECTORS, IF NECESSARY. IT ALSO SHIFTS THE
+C EIGENVALUES TO OVERWRITE THE GOOD VALUES FROM THE PREVIOUS
+C PAUSE.
+C
+ CALL SCOPY(NTHETA, VAL(NUMBER+1), 1, VAL(NPERM+1), 1)
+ IF (NSTART.EQ.0) GO TO 580
+ IF (NSTART.EQ.NTHETA) GO TO 530
+ CALL SVSORT(NTHETA, VTEMP, ATEMP, 1, VAL(NPERM+1), MAXJ,
+ * J, S)
+C
+C THES ACCUMULATES THE J-VECTORS USED TO FORM THE STARTING
+C VECTORS.
+C
+ 530 IF (.NOT.TEST) NSTART = 0
+ IF (.NOT.TEST) GO TO 580
+C
+C FIND MINIMUM ATEMP VALUE TO AVOID POSSIBLE OVERFLOW
+C
+ TEMP = ATEMP(1)
+ DO 535 I = 1, NSTART
+ TEMP = AMIN1(TEMP, ATEMP(I))
+ 535 CONTINUE
+ M = NGOOD + 1
+ L = NGOOD + MIN0(NSTART,NBLOCK)
+ DO 540 I=M,L
+ CALL SSCAL(J, TEMP/ATEMP(I), S(1,I), 1)
+ 540 CONTINUE
+ M = (NSTART-1)/NBLOCK
+ IF (M.EQ.0) GO TO 570
+ L = NGOOD + NBLOCK
+ DO 560 I=1,M
+ DO 550 K=1,NBLOCK
+ L = L + 1
+ IF (L.GT.NTHETA) GO TO 570
+ I1 = NGOOD + K
+ CALL SAXPY(J, TEMP/ATEMP(L), S(1,L), 1, S(1,I1), 1)
+ 550 CONTINUE
+ 560 CONTINUE
+ 570 NSTART = MIN0(NSTART,NBLOCK)
+C
+C THIS STORES THE RESIDUAL NORMS OF THE NEW PERMANENT VECTORS.
+C
+ 580 IF (NGOOD.EQ.0 .OR. .NOT.(TEST .OR. ENOUGH)) GO TO 600
+ DO 590 I=1,NGOOD
+ M = NPERM + I
+ RES(M) = ATEMP(I)
+ 590 CONTINUE
+C
+C THIS COMPUTES THE RITZ VECTORS BY SEQUENTIALLY RECALLING THE
+C LANCZOS VECTORS.
+C
+ 600 NUMBER = NPERM + NGOOD
+ IF (TEST .OR. ENOUGH) CALL SCOPY(N*NBLOCK, ZERO, 0, P1, 1)
+ IF (NGOOD.EQ.0) GO TO 620
+ M = NPERM + 1
+ DO 610 I=M,NUMBER
+ CALL SCOPY(N, ZERO, 0, VEC(1,I), 1)
+ 610 CONTINUE
+ 620 DO 670 I=NBLOCK,J,NBLOCK
+ CALL IOVECT(N, NBLOCK, P2, I, 1)
+ DO 660 K=1,NBLOCK
+ M = I - NBLOCK + K
+ IF (NSTART.EQ.0) GO TO 640
+ DO 630 L=1,NSTART
+ I1 = NGOOD + L
+ CALL SAXPY(N, S(M,I1), P2(1,K), 1, P1(1,L), 1)
+ 630 CONTINUE
+ 640 IF (NGOOD.EQ.0) GO TO 660
+ DO 650 L=1,NGOOD
+ I1 = L + NPERM
+ CALL SAXPY(N, S(M,L), P2(1,K), 1, VEC(1,I1), 1)
+ 650 CONTINUE
+ 660 CONTINUE
+ 670 CONTINUE
+ IF (TEST .OR. ENOUGH) GO TO 690
+C
+C THIS NORMALIZES THE RITZ VECTORS AND INITIALIZES THE
+C TAU RECURRENCE.
+C
+ M = NPERM + 1
+ DO 680 I=M,NUMBER
+ TEMP = 1.0 /SNRM2(N,VEC(1,I),1)
+ CALL SSCAL(N, TEMP, VEC(1,I), 1)
+ TAU(I) = 1.0
+ OTAU(I) = 1.0
+ 680 CONTINUE
+C
+C SHIFT S VECTORS TO ALIGN FOR LATER CALL TO SLAEIG
+C
+ CALL SCOPY(NTHETA, VAL(NPERM+1), 1, VTEMP, 1)
+ CALL SVSORT(NTHETA, VTEMP, ATEMP, 0, TARR, MAXJ, J, S)
+ GO TO 80
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION PREPARES TO ITERATE THE ALGORITHM BY SORTING THE
+C PERMANENT VALUES, RESETTING SOME PARAMETERS, AND ORTHONORMALIZING
+C THE PERMANENT VECTORS.
+C
+ 690 IF (NGOOD.EQ.0 .AND. NOP.GE.MAXOP) GO TO 810
+ IF (NGOOD.EQ.0) GO TO 30
+C
+C THIS ORTHONORMALIZES THE VECTORS
+C
+ CALL SORTQR(NMVEC, N, NPERM+NGOOD, VEC, S)
+C
+C THIS SORTS THE VALUES AND VECTORS.
+C
+ IF(NPERM .NE. 0) CALL SVSORT(NPERM+NGOOD, VAL, RES, 0, TEMP,
+ * NMVEC, N, VEC)
+ NPERM = NPERM + NGOOD
+ NLEFT = NLEFT - NGOOD
+ RNORM = AMAX1(-VAL(1),VAL(NPERM))
+C
+C THIS DECIDES WHERE TO GO NEXT.
+C
+ IF (NOP.GE.MAXOP .AND. NLEFT.NE.0) GO TO 810
+ IF (NLEFT.NE.0) GO TO 30
+ IF (VAL(NVAL)-VAL(1).LT.TOLA) GO TO 790
+C
+C THIS DOES A CLUSTER TEST TO SEE IF A CHECK RUN IS NEEDED
+C TO LOOK FOR UNDISCLOSED MULTIPLICITIES.
+C
+ M = NPERM - NBLOCK + 1
+ IF (M.LE.0) RETURN
+ DO 780 I=1,M
+ L = I + NBLOCK - 1
+ IF (VAL(L)-VAL(I).LT.TOLA) GO TO 30
+ 780 CONTINUE
+C
+C THIS DOES A CLUSTER TEST TO SEE IF A FINAL RAYLEIGH-RITZ
+C PROCEDURE IS NEEDED.
+C
+ 790 M = NPERM - NBLOCK
+ IF (M.LE.0) RETURN
+ DO 800 I=1,M
+ L = I + NBLOCK
+ IF (VAL(L)-VAL(I).GE.TOLA) GO TO 800
+ RARITZ = .TRUE.
+ RETURN
+ 800 CONTINUE
+C
+ RETURN
+C
+C ------------------------------------------------------------------
+C
+C THIS REPORTS THAT MAXOP WAS EXCEEDED.
+C
+ 810 IERR = -2
+ GO TO 790
+C
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SNPPLA(OP, IOVECT, N, NPERM, NOP, NMVAL, VAL,
+ * NMVEC, VEC, NBLOCK, H, HV, P, Q, BOUND, D, DELTA, SMALL,
+ * RARITZ, EPS)
+C
+ INTEGER N, NPERM, NOP, NMVAL, NMVEC, NBLOCK
+ LOGICAL SMALL, RARITZ
+ REAL VAL(NMVAL,1), VEC(NMVEC,1), H(NPERM,1),
+ * HV(NPERM,1), P(N,1), Q(N,1), BOUND(1), D(1), DELTA, EPS
+ EXTERNAL OP, IOVECT
+C
+C THIS SUBROUTINE POST PROCESSES THE EIGENVECTORS. BLOCK MATRIX
+C VECTOR PRODUCTS ARE USED TO MINIMIZED THE NUMBER OF CALLS TO OP.
+C
+ INTEGER I, J, JJ, K, KK, L, M, MOD
+ REAL HMIN, HMAX, TEMP, SDOT, SNRM2, ZERO(1)
+ EXTERNAL SAXPY, SCOPY, SDOT, SLAGER, SLAEIG
+C
+C IF RARITZ IS .TRUE. A FINAL RAYLEIGH-RITZ PROCEDURE IS APPLIED
+C TO THE EIGENVECTORS.
+C
+ ZERO(1) = 0.0
+ IF (.NOT.RARITZ) GO TO 190
+C
+C ------------------------------------------------------------------
+C
+C THIS CONSTRUCTS H=Q*AQ, WHERE THE COLUMNS OF Q ARE THE
+C APPROXIMATE EIGENVECTORS. TEMP = -1 IS USED WHEN SMALL IS
+C FALSE TO AVOID HAVING TO RESORT THE EIGENVALUES AND EIGENVECTORS
+C COMPUTED BY SLAEIG.
+C
+ CALL SCOPY(NPERM*NPERM, ZERO, 0, H, 1)
+ TEMP = -1.0
+ IF (SMALL) TEMP = 1.0
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 40
+ DO 10 I=1,M
+ CALL SCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 10 CONTINUE
+ CALL IOVECT(N, M, P, M, 0)
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 30 I=1,M
+ DO 20 J=I,NPERM
+ JJ = J - I + 1
+ H(JJ,I) = TEMP*SDOT(N,VEC(1,J),1,Q(1,I),1)
+ 20 CONTINUE
+ 30 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 90
+ 40 M = M + NBLOCK
+ DO 80 I=M,NPERM,NBLOCK
+ DO 50 J=1,NBLOCK
+ L = I - NBLOCK + J
+ CALL SCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 50 CONTINUE
+ CALL IOVECT(N, NBLOCK, P, I, 0)
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 70 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 60 K=L,NPERM
+ KK = K - L + 1
+ H(KK,L) = TEMP*SDOT(N,VEC(1,K),1,Q(1,J),1)
+ 60 CONTINUE
+ 70 CONTINUE
+ 80 CONTINUE
+C
+C THIS COMPUTES THE SPECTRAL DECOMPOSITION OF H.
+C
+ 90 HMIN = H(1,1)
+ HMAX = H(1,1)
+ CALL SLAGER(NPERM, NPERM, 1, H, HMIN, HMAX)
+ CALL SLAEIG(NPERM, NPERM, 1, NPERM, H, VAL, NPERM,
+ 1 HV, BOUND, P, D, Q, EPS, HMIN, HMAX)
+C
+C THIS COMPUTES THE RITZ VECTORS--THE COLUMNS OF
+C Y = QS WHERE S IS THE MATRIX OF EIGENVECTORS OF H.
+C
+ DO 120 I=1,NPERM
+ CALL SCOPY(N, ZERO, 0, VEC(1,I), 1)
+ 120 CONTINUE
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 150
+ CALL IOVECT(N, M, P, M, 1)
+ DO 140 I=1,M
+ DO 130 J=1,NPERM
+ CALL SAXPY(N, HV(I,J), P(1,I), 1, VEC(1,J), 1)
+ 130 CONTINUE
+ 140 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 190
+ 150 M = M + NBLOCK
+ DO 180 I=M,NPERM,NBLOCK
+ CALL IOVECT(N, NBLOCK, P, I, 1)
+ DO 170 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 160 K=1,NPERM
+ CALL SAXPY(N, HV(L,K), P(1,J), 1, VEC(1,K), 1)
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES THE RAYLEIGH QUOTIENTS (IN VAL(*,1))
+C AND RESIDUAL NORMS (IN VAL(*,2)) OF THE EIGENVECTORS.
+C
+ 190 IF (.NOT.SMALL) DELTA = -DELTA
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 220
+ DO 200 I=1,M
+ CALL SCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 200 CONTINUE
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 210 I=1,M
+ VAL(I,1) = SDOT(N,P(1,I),1,Q(1,I),1)
+ CALL SAXPY(N, -VAL(I,1), P(1,I), 1, Q(1,I), 1)
+ VAL(I,2) = SNRM2(N,Q(1,I),1)
+ 210 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 260
+ 220 M = M + 1
+ DO 250 I=M,NPERM,NBLOCK
+ DO 230 J=1,NBLOCK
+ L = I - 1 + J
+ CALL SCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 230 CONTINUE
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 240 J=1,NBLOCK
+ L = I - 1 + J
+ VAL(L,1) = SDOT(N,P(1,J),1,Q(1,J),1)
+ CALL SAXPY(N, -VAL(L,1), P(1,J), 1, Q(1,J), 1)
+ VAL(L,2) = SNRM2(N,Q(1,J),1)
+ 240 CONTINUE
+ 250 CONTINUE
+C
+C THIS COMPUTES THE ACCURACY ESTIMATES. FOR CONSISTENCY WITH SILASO
+C A DO LOOP IS NOT USED.
+C
+ 260 I = 0
+ 270 I = I + 1
+ IF (I.GT.NPERM) RETURN
+ TEMP = DELTA - VAL(I,1)
+ IF (.NOT.SMALL) TEMP = -TEMP
+ VAL(I,4) = 0.0
+ IF (TEMP.GT.0.0 ) VAL(I,4) = VAL(I,2)/TEMP
+ VAL(I,3) = VAL(I,4)*VAL(I,2)
+ GO TO 270
+C
+ END
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SORTQR(NZ, N, NBLOCK, Z, B)
+C
+ INTEGER NZ, N, NBLOCK
+ REAL Z(NZ,1), B(NBLOCK,1)
+C
+C THIS SUBROUTINE COMPUTES THE QR FACTORIZATION OF THE N X NBLOCK
+C MATRIX Z. Q IS FORMED IN PLACE AND RETURNED IN Z. R IS
+C RETURNED IN B.
+C
+ INTEGER I, J, K, LENGTH, M
+ REAL SIGMA, TAU, TEMP, SDOT, SNRM2, SIGN
+ EXTERNAL SAXPY, SDOT, SNRM2, SSCAL
+C
+C THIS SECTION REDUCES Z TO TRIANGULAR FORM.
+C
+ DO 30 I=1,NBLOCK
+C
+C THIS FORMS THE ITH REFLECTION.
+C
+ LENGTH = N - I + 1
+ SIGMA = SIGN(SNRM2(LENGTH,Z(I,I),1),Z(I,I))
+ B(I,I) = -SIGMA
+ Z(I,I) = Z(I,I) + SIGMA
+ TAU = SIGMA*Z(I,I)
+ IF (I.EQ.NBLOCK) GO TO 30
+ J = I + 1
+C
+C THIS APPLIES THE ROTATION TO THE REST OF THE COLUMNS.
+C
+ DO 20 K=J,NBLOCK
+ IF (TAU.EQ.0.0 ) GO TO 10
+ TEMP = -SDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL SAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 10 B(I,K) = Z(I,K)
+ Z(I,K) = 0.0
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C THIS ACCUMULATES THE REFLECTIONS IN REVERSE ORDER.
+C
+ DO 70 M=1,NBLOCK
+C
+C THIS RECREATES THE ITH = NBLOCK-M+1)TH REFLECTION.
+C
+ I = NBLOCK + 1 - M
+ SIGMA = -B(I,I)
+ TAU = Z(I,I)*SIGMA
+ IF (TAU.EQ.0.0 ) GO TO 60
+ LENGTH = N - NBLOCK + M
+ IF (I.EQ.NBLOCK) GO TO 50
+ J = I + 1
+C
+C THIS APPLIES IT TO THE LATER COLUMNS.
+C
+ DO 40 K=J,NBLOCK
+ TEMP = -SDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL SAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 40 CONTINUE
+ 50 CALL SSCAL(LENGTH, -1.0 /SIGMA, Z(I,I), 1)
+ 60 Z(I,I) = 1.0 + Z(I,I)
+ 70 CONTINUE
+ RETURN
+ END
+C
+C-------------------------------------------------------------------
+C
+ SUBROUTINE SVSORT(NUM, VAL, RES, IFLAG, V, NMVEC, N, VEC)
+ INTEGER NUM, IFLAG, NMVEC, N
+ REAL VAL(1), RES(1), V(1), VEC(NMVEC,1)
+C
+C THIS SUBROUTINE SORTS THE EIGENVALUES (VAL) IN ASCENDING ORDER
+C WHILE CONCURRENTLY SWAPPING THE RESIDUALS AND VECTORS.
+ INTEGER I, K, M
+ REAL TEMP
+ IF(NUM .LE. 1) RETURN
+ DO 20 I = 2, NUM
+ M = NUM - I + 1
+ DO 10 K = 1, M
+ IF(VAL(K) .LE. VAL(K+1)) GO TO 10
+ TEMP = VAL(K)
+ VAL(K) = VAL(K+1)
+ VAL(K+1) = TEMP
+ TEMP = RES(K)
+ RES(K) = RES(K+1)
+ RES(K+1) = TEMP
+ CALL SSWAP(N, VEC(1,K), 1, VEC(1,K+1), 1)
+ IF(IFLAG .EQ. 0) GO TO 10
+ TEMP = V(K)
+ V(K) = V(K+1)
+ V(K+1) = TEMP
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/snppla.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/snppla.f
new file mode 100644
index 0000000000000000000000000000000000000000..2799b8bb90c3b604536200830d4c63cda60f4ad2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/snppla.f
@@ -0,0 +1,152 @@
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SNPPLA(OP, IOVECT, N, NPERM, NOP, NMVAL, VAL,
+ * NMVEC, VEC, NBLOCK, H, HV, P, Q, BOUND, D, DELTA, SMALL,
+ * RARITZ, EPS)
+C
+ INTEGER N, NPERM, NOP, NMVAL, NMVEC, NBLOCK
+ LOGICAL SMALL, RARITZ
+ REAL VAL(NMVAL,1), VEC(NMVEC,1), H(NPERM,1),
+ * HV(NPERM,1), P(N,1), Q(N,1), BOUND(1), D(1), DELTA, EPS
+ EXTERNAL OP, IOVECT
+C
+C THIS SUBROUTINE POST PROCESSES THE EIGENVECTORS. BLOCK MATRIX
+C VECTOR PRODUCTS ARE USED TO MINIMIZED THE NUMBER OF CALLS TO OP.
+C
+ INTEGER I, J, JJ, K, KK, L, M, MOD
+ REAL HMIN, HMAX, TEMP, SDOT, SNRM2, ZERO(1)
+ EXTERNAL SAXPY, SCOPY, SDOT, SLAGER, SLAEIG
+C
+C IF RARITZ IS .TRUE. A FINAL RAYLEIGH-RITZ PROCEDURE IS APPLIED
+C TO THE EIGENVECTORS.
+C
+ ZERO(1) = 0.0
+ IF (.NOT.RARITZ) GO TO 190
+C
+C ------------------------------------------------------------------
+C
+C THIS CONSTRUCTS H=Q*AQ, WHERE THE COLUMNS OF Q ARE THE
+C APPROXIMATE EIGENVECTORS. TEMP = -1 IS USED WHEN SMALL IS
+C FALSE TO AVOID HAVING TO RESORT THE EIGENVALUES AND EIGENVECTORS
+C COMPUTED BY SLAEIG.
+C
+ CALL SCOPY(NPERM*NPERM, ZERO, 0, H, 1)
+ TEMP = -1.0
+ IF (SMALL) TEMP = 1.0
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 40
+ DO 10 I=1,M
+ CALL SCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 10 CONTINUE
+ CALL IOVECT(N, M, P, M, 0)
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 30 I=1,M
+ DO 20 J=I,NPERM
+ JJ = J - I + 1
+ H(JJ,I) = TEMP*SDOT(N,VEC(1,J),1,Q(1,I),1)
+ 20 CONTINUE
+ 30 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 90
+ 40 M = M + NBLOCK
+ DO 80 I=M,NPERM,NBLOCK
+ DO 50 J=1,NBLOCK
+ L = I - NBLOCK + J
+ CALL SCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 50 CONTINUE
+ CALL IOVECT(N, NBLOCK, P, I, 0)
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 70 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 60 K=L,NPERM
+ KK = K - L + 1
+ H(KK,L) = TEMP*SDOT(N,VEC(1,K),1,Q(1,J),1)
+ 60 CONTINUE
+ 70 CONTINUE
+ 80 CONTINUE
+C
+C THIS COMPUTES THE SPECTRAL DECOMPOSITION OF H.
+C
+ 90 HMIN = H(1,1)
+ HMAX = H(1,1)
+ CALL SLAGER(NPERM, NPERM, 1, H, HMIN, HMAX)
+ CALL SLAEIG(NPERM, NPERM, 1, NPERM, H, VAL, NPERM,
+ 1 HV, BOUND, P, D, Q, EPS, HMIN, HMAX)
+C
+C THIS COMPUTES THE RITZ VECTORS--THE COLUMNS OF
+C Y = QS WHERE S IS THE MATRIX OF EIGENVECTORS OF H.
+C
+ DO 120 I=1,NPERM
+ CALL SCOPY(N, ZERO, 0, VEC(1,I), 1)
+ 120 CONTINUE
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 150
+ CALL IOVECT(N, M, P, M, 1)
+ DO 140 I=1,M
+ DO 130 J=1,NPERM
+ CALL SAXPY(N, HV(I,J), P(1,I), 1, VEC(1,J), 1)
+ 130 CONTINUE
+ 140 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 190
+ 150 M = M + NBLOCK
+ DO 180 I=M,NPERM,NBLOCK
+ CALL IOVECT(N, NBLOCK, P, I, 1)
+ DO 170 J=1,NBLOCK
+ L = I - NBLOCK + J
+ DO 160 K=1,NPERM
+ CALL SAXPY(N, HV(L,K), P(1,J), 1, VEC(1,K), 1)
+ 160 CONTINUE
+ 170 CONTINUE
+ 180 CONTINUE
+C
+C ------------------------------------------------------------------
+C
+C THIS SECTION COMPUTES THE RAYLEIGH QUOTIENTS (IN VAL(*,1))
+C AND RESIDUAL NORMS (IN VAL(*,2)) OF THE EIGENVECTORS.
+C
+ 190 IF (.NOT.SMALL) DELTA = -DELTA
+ M = MOD(NPERM,NBLOCK)
+ IF (M.EQ.0) GO TO 220
+ DO 200 I=1,M
+ CALL SCOPY(N, VEC(1,I), 1, P(1,I), 1)
+ 200 CONTINUE
+ CALL OP(N, M, P, Q)
+ NOP = NOP + 1
+ DO 210 I=1,M
+ VAL(I,1) = SDOT(N,P(1,I),1,Q(1,I),1)
+ CALL SAXPY(N, -VAL(I,1), P(1,I), 1, Q(1,I), 1)
+ VAL(I,2) = SNRM2(N,Q(1,I),1)
+ 210 CONTINUE
+ IF (NPERM.LT.NBLOCK) GO TO 260
+ 220 M = M + 1
+ DO 250 I=M,NPERM,NBLOCK
+ DO 230 J=1,NBLOCK
+ L = I - 1 + J
+ CALL SCOPY(N, VEC(1,L), 1, P(1,J), 1)
+ 230 CONTINUE
+ CALL OP(N, NBLOCK, P, Q)
+ NOP = NOP + 1
+ DO 240 J=1,NBLOCK
+ L = I - 1 + J
+ VAL(L,1) = SDOT(N,P(1,J),1,Q(1,J),1)
+ CALL SAXPY(N, -VAL(L,1), P(1,J), 1, Q(1,J), 1)
+ VAL(L,2) = SNRM2(N,Q(1,J),1)
+ 240 CONTINUE
+ 250 CONTINUE
+C
+C THIS COMPUTES THE ACCURACY ESTIMATES. FOR CONSISTENCY WITH SILASO
+C A DO LOOP IS NOT USED.
+C
+ 260 I = 0
+ 270 I = I + 1
+ IF (I.GT.NPERM) RETURN
+ TEMP = DELTA - VAL(I,1)
+ IF (.NOT.SMALL) TEMP = -TEMP
+ VAL(I,4) = 0.0
+ IF (TEMP.GT.0.0 ) VAL(I,4) = VAL(I,2)/TEMP
+ VAL(I,3) = VAL(I,4)*VAL(I,2)
+ GO TO 270
+C
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.c
new file mode 100644
index 0000000000000000000000000000000000000000..5ee94ef7c3f092ff5feb9b84f1661ce37820d4c4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.c
@@ -0,0 +1,56 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+real snrm2_(n, x, incx)
+const integer *n;
+const real *x;
+const integer *incx;
+{
+ /* System generated locals */
+ real r__1;
+
+ /* Local variables */
+ static real norm, scale, absxi;
+ static integer ix;
+ static real ssq;
+
+/* SNRM2 returns the euclidean norm of a vector via the function */
+/* name, so that */
+/* */
+/* SNRM2 := sqrt( x'*x ) */
+/* */
+/* -- This version written on 25-October-1982. */
+/* Modified on 14-October-1993 to inline the call to SLASSQ. */
+/* Sven Hammarling, Nag Ltd. */
+
+ if (*n < 1 || *incx < 1) {
+ norm = 0.f;
+ } else if (*n == 1) {
+ norm = abs(x[0]);
+ } else {
+ scale = 0.f;
+ ssq = 1.f;
+/* The following loop is equivalent to this call to the LAPACK */
+/* auxiliary routine: */
+/* CALL SLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+ for (ix = 0; ix < *n * *incx; ix += *incx) {
+ if (x[ix] != 0.f) {
+ absxi = abs(x[ix]);
+ if (scale < absxi) {
+ r__1 = scale / absxi;
+ ssq = ssq * r__1 * r__1 + 1.f;
+ scale = absxi;
+ } else {
+ r__1 = absxi / scale;
+ ssq += r__1 * r__1;
+ }
+ }
+ }
+ norm = scale * sqrtf(ssq);
+ }
+
+ return norm;
+
+} /* snrm2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.f
new file mode 100644
index 0000000000000000000000000000000000000000..81dc0cda6c032b7edb006f44c7aaf161fdca691d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/snrm2.f
@@ -0,0 +1,60 @@
+ REAL FUNCTION SNRM2 ( N, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* .. Array Arguments ..
+ REAL X( * )
+* ..
+*
+* SNRM2 returns the euclidean norm of a vector via the function
+* name, so that
+*
+* SNRM2 := sqrt( x'*x )
+*
+*
+*
+* -- This version written on 25-October-1982.
+* Modified on 14-October-1993 to inline the call to SLASSQ.
+* Sven Hammarling, Nag Ltd.
+*
+*
+* .. Parameters ..
+ REAL ONE , ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* .. Local Scalars ..
+ INTEGER IX
+ REAL ABSXI, NORM, SCALE, SSQ
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, SQRT
+* ..
+* .. Executable Statements ..
+ IF( N.LT.1 .OR. INCX.LT.1 )THEN
+ NORM = ZERO
+ ELSE IF( N.EQ.1 )THEN
+ NORM = ABS( X( 1 ) )
+ ELSE
+ SCALE = ZERO
+ SSQ = ONE
+* The following loop is equivalent to this call to the LAPACK
+* auxiliary routine:
+* CALL SLASSQ( N, X, INCX, SCALE, SSQ )
+*
+ DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
+ IF( X( IX ).NE.ZERO )THEN
+ ABSXI = ABS( X( IX ) )
+ IF( SCALE.LT.ABSXI )THEN
+ SSQ = ONE + SSQ*( SCALE/ABSXI )**2
+ SCALE = ABSXI
+ ELSE
+ SSQ = SSQ + ( ABSXI/SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ NORM = SCALE * SQRT( SSQ )
+ END IF
+*
+ SNRM2 = NORM
+ RETURN
+*
+* End of SNRM2.
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.c
new file mode 100644
index 0000000000000000000000000000000000000000..09dcc06f83f0cd5e4e5c0d7cb5d122665d78aded
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.c
@@ -0,0 +1,124 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sorg2r_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ real r__1;
+
+ /* Local variables */
+ static integer i, j, l;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SORG2R generates an m by n real matrix Q with orthonormal columns, */
+/* which is defined as the first n columns of a product of k elementary */
+/* reflectors of order m */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by SGEQRF. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. M >= N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. N >= K >= 0. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the i-th column must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by SGEQRF in the first k columns of its array */
+/* argument A. */
+/* On exit, the m-by-n matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (input) REAL array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by SGEQRF. */
+/* */
+/* WORK (workspace) REAL array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SORG2R", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return;
+ }
+
+/* Initialise columns k+1:n to columns of the unit matrix */
+
+ for (j = *k; j < *n; ++j) {
+ for (l = 0; l < *m; ++l) {
+ a[l + j * *lda] = 0.f;
+ }
+ a[j + j * *lda] = 1.f;
+ }
+
+ for (i = *k - 1; i >= 0; --i) {
+
+/* Apply H(i) to A(i:m,i:n) from the left */
+
+ if (i < *n - 1) {
+ a[i + i * *lda] = 1.f;
+ i__1 = *m - i;
+ i__2 = *n - i - 1;
+ slarf_("Left", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i], &a[i + (i + 1) * *lda], lda, work);
+ }
+ if (i < *m - 1) {
+ i__1 = *m - i - 1;
+ r__1 = -tau[i];
+ sscal_(&i__1, &r__1, &a[i + 1 + i * *lda], &c__1);
+ }
+ a[i + i * *lda] = 1.f - tau[i];
+
+/* Set A(1:i-1,i) to zero */
+
+ for (l = 0; l < i-1; ++l) {
+ a[l + i * *lda] = 0.f;
+ }
+ }
+} /* sorg2r_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..3d7a51c17e7b148741ee4ef3e92fcaa13df0dd7f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorg2r.f
@@ -0,0 +1,130 @@
+ SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SORG2R generates an m by n real matrix Q with orthonormal columns,
+* which is defined as the first n columns of a product of k elementary
+* reflectors of order m
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by SGEQRF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. M >= N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. N >= K >= 0.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the i-th column must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by SGEQRF in the first k columns of its array
+* argument A.
+* On exit, the m-by-n matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) REAL array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by SGEQRF.
+*
+* WORK (workspace) REAL array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, SSCAL, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SORG2R', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Initialise columns k+1:n to columns of the unit matrix
+*
+ DO 20 J = K + 1, N
+ DO 10 L = 1, M
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ A( J, J ) = ONE
+ 20 CONTINUE
+*
+ DO 40 I = K, 1, -1
+*
+* Apply H(i) to A(i:m,i:n) from the left
+*
+ IF( I.LT.N ) THEN
+ A( I, I ) = ONE
+ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK )
+ END IF
+ IF( I.LT.M )
+ $ CALL SSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
+ A( I, I ) = ONE - TAU( I )
+*
+* Set A(1:i-1,i) to zero
+*
+ DO 30 L = 1, I - 1
+ A( L, I ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of SORG2R
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.c
new file mode 100644
index 0000000000000000000000000000000000000000..a2a58ca4ca560d5fab5dada4694873fc5456a9de
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.c
@@ -0,0 +1,182 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sorm2r_(const char *side, const char *trans, const integer *m, const integer *n,
+ const integer *k, real *a, const integer *lda, const real *tau, real *c,
+ const integer *ldc, real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical left;
+ static integer i;
+ static integer i1, i2, i3, ic, jc, mi, ni, nq;
+ static logical notran;
+ static real aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SORM2R overwrites the general real m by n matrix C with */
+/* */
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+/* */
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+/* */
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+/* */
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+/* */
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+/* */
+/* A (input) REAL array, dimension (LDA,K) */
+/* The i-th column must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* SGEQRF in the first k columns of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* If SIDE = 'L', LDA >= max(1,M); */
+/* if SIDE = 'R', LDA >= max(1,N). */
+/* */
+/* TAU (input) REAL array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by SGEQRF. */
+/* */
+/* C (input/output) REAL array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) REAL array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SORM2R", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return;
+ }
+
+ if ( (left && ! notran) || ( ! left && notran) ) {
+ i1 = 0;
+ i2 = *k - 1;
+ i3 = 1;
+ } else {
+ i1 = *k - 1;
+ i2 = 0;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 0;
+ } else {
+ mi = *m;
+ ic = 0;
+ }
+
+ for (i = i1; i3 < 0 ? i >= i2 : i <= i2; i += i3) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i;
+ ic = i;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i;
+ jc = i;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i + i * *lda];
+ a[i + i * *lda] = 1.f;
+ slarf_(side, &mi, &ni, &a[i + i * *lda], &c__1, &tau[i], &c[ic + jc * *ldc], ldc, work);
+ a[i + i * *lda] = aii;
+ }
+} /* sorm2r_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..85addcdc81e6150fb00cbeae3f6a4f03d29aef0d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sorm2r.f
@@ -0,0 +1,198 @@
+ SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+ $ WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, K, LDA, LDC, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SORM2R overwrites the general real m by n matrix C with
+*
+* Q * C if SIDE = 'L' and TRANS = 'N', or
+*
+* Q'* C if SIDE = 'L' and TRANS = 'T', or
+*
+* C * Q if SIDE = 'R' and TRANS = 'N', or
+*
+* C * Q' if SIDE = 'R' and TRANS = 'T',
+*
+* where Q is a real orthogonal matrix defined as the product of k
+* elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n
+* if SIDE = 'R'.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply Q or Q' from the Left
+* = 'R': apply Q or Q' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply Q (No transpose)
+* = 'T': apply Q' (Transpose)
+*
+* M (input) INTEGER
+* The number of rows of the matrix C. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C. N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines
+* the matrix Q.
+* If SIDE = 'L', M >= K >= 0;
+* if SIDE = 'R', N >= K >= 0.
+*
+* A (input) REAL array, dimension (LDA,K)
+* The i-th column must contain the vector which defines the
+* elementary reflector H(i), for i = 1,2,...,k, as returned by
+* SGEQRF in the first k columns of its array argument A.
+* A is modified by the routine but restored on exit.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A.
+* If SIDE = 'L', LDA >= max(1,M);
+* if SIDE = 'R', LDA >= max(1,N).
+*
+* TAU (input) REAL array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by SGEQRF.
+*
+* C (input/output) REAL array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) REAL array, dimension
+* (N) if SIDE = 'L',
+* (M) if SIDE = 'R'
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFT, NOTRAN
+ INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
+ REAL AII
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LEFT = LSAME( SIDE, 'L' )
+ NOTRAN = LSAME( TRANS, 'N' )
+*
+* NQ is the order of Q
+*
+ IF( LEFT ) THEN
+ NQ = M
+ ELSE
+ NQ = N
+ END IF
+ IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -2
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
+ INFO = -7
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SORM2R', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+ $ RETURN
+*
+ IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
+ $ THEN
+ I1 = 1
+ I2 = K
+ I3 = 1
+ ELSE
+ I1 = K
+ I2 = 1
+ I3 = -1
+ END IF
+*
+ IF( LEFT ) THEN
+ NI = N
+ JC = 1
+ ELSE
+ MI = M
+ IC = 1
+ END IF
+*
+ DO 10 I = I1, I2, I3
+ IF( LEFT ) THEN
+*
+* H(i) is applied to C(i:m,1:n)
+*
+ MI = M - I + 1
+ IC = I
+ ELSE
+*
+* H(i) is applied to C(1:m,i:n)
+*
+ NI = N - I + 1
+ JC = I
+ END IF
+*
+* Apply H(i)
+*
+ AII = A( I, I )
+ A( I, I ) = ONE
+ CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
+ $ LDC, WORK )
+ A( I, I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of SORM2R
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.c
new file mode 100644
index 0000000000000000000000000000000000000000..846a5ccf6635034ffa551ecf7165cf6bd499ec19
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.c
@@ -0,0 +1,174 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c, integer *ldc, real *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical left;
+ static integer i;
+ static integer i1, i2, i3, mi, ni, nq;
+ static logical notran;
+ static real aii;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* SORMR2 overwrites the general real m by n matrix C with */
+/* */
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+/* */
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+/* */
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+/* */
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+/* */
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+/* */
+/* A (input) REAL array, dimension */
+/* (LDA,M) if SIDE = 'L', */
+/* (LDA,N) if SIDE = 'R' */
+/* The i-th row must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* SGERQF in the last k rows of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,K). */
+/* */
+/* TAU (input) REAL array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by SGERQF. */
+/* */
+/* C (input/output) REAL array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) REAL array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+/* Test the input arguments */
+
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("SORMR2", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return;
+ }
+
+ if ( (left && !notran) || (!left && notran) ) {
+ i1 = 0;
+ i2 = *k - 1;
+ i3 = 1;
+ } else {
+ i1 = *k - 1;
+ i2 = 0;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ for (i = i1; i3 < 0 ? i >= i2 : i <= i2; i += i3) {
+ if (left) {
+
+/* H(i) is applied to C(1:m-k+i,1:n) */
+
+ mi = *m - *k + i + 1;
+ } else {
+
+/* H(i) is applied to C(1:m,1:n-k+i) */
+
+ ni = *n - *k + i + 1;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i + (nq - *k + i) * *lda];
+ a[i + (nq - *k + i) * *lda] = 1.f;
+ slarf_(side, &mi, &ni, &a[i], lda, &tau[i], c, ldc, work);
+ a[i + (nq - *k + i) * *lda] = aii;
+ }
+} /* sormr2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.f
new file mode 100644
index 0000000000000000000000000000000000000000..3bc4020bf7d6459cea90a89b86cffaba9590b342
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sormr2.f
@@ -0,0 +1,194 @@
+ SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+ $ WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, K, LDA, LDC, M, N
+* ..
+* .. Array Arguments ..
+ REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* SORMR2 overwrites the general real m by n matrix C with
+*
+* Q * C if SIDE = 'L' and TRANS = 'N', or
+*
+* Q'* C if SIDE = 'L' and TRANS = 'T', or
+*
+* C * Q if SIDE = 'R' and TRANS = 'N', or
+*
+* C * Q' if SIDE = 'R' and TRANS = 'T',
+*
+* where Q is a real orthogonal matrix defined as the product of k
+* elementary reflectors
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by SGERQF. Q is of order m if SIDE = 'L' and of order n
+* if SIDE = 'R'.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply Q or Q' from the Left
+* = 'R': apply Q or Q' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply Q (No transpose)
+* = 'T': apply Q' (Transpose)
+*
+* M (input) INTEGER
+* The number of rows of the matrix C. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C. N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines
+* the matrix Q.
+* If SIDE = 'L', M >= K >= 0;
+* if SIDE = 'R', N >= K >= 0.
+*
+* A (input) REAL array, dimension
+* (LDA,M) if SIDE = 'L',
+* (LDA,N) if SIDE = 'R'
+* The i-th row must contain the vector which defines the
+* elementary reflector H(i), for i = 1,2,...,k, as returned by
+* SGERQF in the last k rows of its array argument A.
+* A is modified by the routine but restored on exit.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,K).
+*
+* TAU (input) REAL array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by SGERQF.
+*
+* C (input/output) REAL array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) REAL array, dimension
+* (N) if SIDE = 'L',
+* (M) if SIDE = 'R'
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE
+ PARAMETER ( ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFT, NOTRAN
+ INTEGER I, I1, I2, I3, MI, NI, NQ
+ REAL AII
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ LEFT = LSAME( SIDE, 'L' )
+ NOTRAN = LSAME( TRANS, 'N' )
+*
+* NQ is the order of Q
+*
+ IF( LEFT ) THEN
+ NQ = M
+ ELSE
+ NQ = N
+ END IF
+ IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+ INFO = -2
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+ INFO = -7
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SORMR2', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+ $ RETURN
+*
+ IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
+ $ THEN
+ I1 = 1
+ I2 = K
+ I3 = 1
+ ELSE
+ I1 = K
+ I2 = 1
+ I3 = -1
+ END IF
+*
+ IF( LEFT ) THEN
+ NI = N
+ ELSE
+ MI = M
+ END IF
+*
+ DO 10 I = I1, I2, I3
+ IF( LEFT ) THEN
+*
+* H(i) is applied to C(1:m-k+i,1:n)
+*
+ MI = M - K + I
+ ELSE
+*
+* H(i) is applied to C(1:m,1:n-k+i)
+*
+ NI = N - K + I
+ END IF
+*
+* Apply H(i)
+*
+ AII = A( I, NQ-K+I )
+ A( I, NQ-K+I ) = ONE
+ CALL SLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
+ $ WORK )
+ A( I, NQ-K+I ) = AII
+ 10 CONTINUE
+ RETURN
+*
+* End of SORMR2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sortqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sortqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..2e5a493d58e801ccd459ccd8a180028709cde000
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sortqr.f
@@ -0,0 +1,66 @@
+C
+C ------------------------------------------------------------------
+C
+ SUBROUTINE SORTQR(NZ, N, NBLOCK, Z, B)
+C
+ INTEGER NZ, N, NBLOCK
+ REAL Z(NZ,1), B(NBLOCK,1)
+C
+C THIS SUBROUTINE COMPUTES THE QR FACTORIZATION OF THE N X NBLOCK
+C MATRIX Z. Q IS FORMED IN PLACE AND RETURNED IN Z. R IS
+C RETURNED IN B.
+C
+ INTEGER I, J, K, LENGTH, M
+ REAL SIGMA, TAU, TEMP, SDOT, SNRM2, SIGN
+ EXTERNAL SAXPY, SDOT, SNRM2, SSCAL
+C
+C THIS SECTION REDUCES Z TO TRIANGULAR FORM.
+C
+ DO 30 I=1,NBLOCK
+C
+C THIS FORMS THE ITH REFLECTION.
+C
+ LENGTH = N - I + 1
+ SIGMA = SIGN(SNRM2(LENGTH,Z(I,I),1),Z(I,I))
+ B(I,I) = -SIGMA
+ Z(I,I) = Z(I,I) + SIGMA
+ TAU = SIGMA*Z(I,I)
+ IF (I.EQ.NBLOCK) GO TO 30
+ J = I + 1
+C
+C THIS APPLIES THE ROTATION TO THE REST OF THE COLUMNS.
+C
+ DO 20 K=J,NBLOCK
+ IF (TAU.EQ.0.0 ) GO TO 10
+ TEMP = -SDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL SAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 10 B(I,K) = Z(I,K)
+ Z(I,K) = 0.0
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C THIS ACCUMULATES THE REFLECTIONS IN REVERSE ORDER.
+C
+ DO 70 M=1,NBLOCK
+C
+C THIS RECREATES THE ITH = NBLOCK-M+1)TH REFLECTION.
+C
+ I = NBLOCK + 1 - M
+ SIGMA = -B(I,I)
+ TAU = Z(I,I)*SIGMA
+ IF (TAU.EQ.0.0 ) GO TO 60
+ LENGTH = N - NBLOCK + M
+ IF (I.EQ.NBLOCK) GO TO 50
+ J = I + 1
+C
+C THIS APPLIES IT TO THE LATER COLUMNS.
+C
+ DO 40 K=J,NBLOCK
+ TEMP = -SDOT(LENGTH,Z(I,I),1,Z(I,K),1)/TAU
+ CALL SAXPY(LENGTH, TEMP, Z(I,I), 1, Z(I,K), 1)
+ 40 CONTINUE
+ 50 CALL SSCAL(LENGTH, -1.0 /SIGMA, Z(I,I), 1)
+ 60 Z(I,I) = 1.0 + Z(I,I)
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..be81ab5696428a58c4f1c3121cf86514f4cb5dfb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.c
@@ -0,0 +1,240 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sqrdc_(x, ldx, n, p, qraux, jpvt, work, job)
+real *x;
+const integer *ldx, *n, *p;
+real *qraux;
+integer *jpvt;
+real *work;
+const integer *job;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static logical negj;
+ static integer maxj;
+ static integer j, l;
+ static real t;
+ static logical swapj;
+ static real nrmxl;
+ static integer jp, pl, pu;
+ static real tt, maxnrm;
+
+/* sqrdc uses householder transformations to compute the qr */
+/* factorization of an n by p matrix x. column pivoting */
+/* based on the 2-norms of the reduced columns may be */
+/* performed at the users option. */
+/* */
+/* on entry */
+/* */
+/* x real(ldx,p), where ldx .ge. n. */
+/* x contains the matrix whose decomposition is to be */
+/* computed. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* jpvt integer(p). */
+/* jpvt contains integers that control the selection */
+/* of the pivot columns. the k-th column x(k) of x */
+/* is placed in one of three classes according to the */
+/* value of jpvt(k). */
+/* */
+/* if jpvt(k) .gt. 0, then x(k) is an initial */
+/* column. */
+/* */
+/* if jpvt(k) .eq. 0, then x(k) is a free column. */
+/* */
+/* if jpvt(k) .lt. 0, then x(k) is a final column. */
+/* */
+/* before the decomposition is computed, initial columns */
+/* are moved to the beginning of the array x and final */
+/* columns to the end. both initial and final columns */
+/* are frozen in place during the computation and only */
+/* free columns are moved. at the k-th stage of the */
+/* reduction, if x(k) is occupied by a free column */
+/* it is interchanged with the free column of largest */
+/* reduced norm. jpvt is not referenced if */
+/* job .eq. 0. */
+/* */
+/* work real(p). */
+/* work is a work array. work is not referenced if */
+/* job .eq. 0. */
+/* */
+/* job integer. */
+/* job is an integer that initiates column pivoting. */
+/* if job .eq. 0, no pivoting is done. */
+/* if job .ne. 0, pivoting is done. */
+/* */
+/* on return */
+/* */
+/* x x contains in its upper triangle the upper */
+/* triangular matrix r of the qr factorization. */
+/* below its diagonal x contains information from */
+/* which the orthogonal part of the decomposition */
+/* can be recovered. note that if pivoting has */
+/* been requested, the decomposition is not that */
+/* of the original matrix x but that of x */
+/* with its columns permuted as described by jpvt. */
+/* */
+/* qraux real(p). */
+/* qraux contains further information required to recover */
+/* the orthogonal part of the decomposition. */
+/* */
+/* jpvt jpvt(k) contains the index of the column of the */
+/* original matrix that has been interchanged into */
+/* the k-th column, if pivoting was requested. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* sqrdc uses the following functions and subprograms. */
+/* */
+/* blas saxpy,sdot,sscal,sswap,snrm2 */
+/* fortran abs,amax1,min0,sqrt */
+
+/* internal variables */
+
+ pl = 0;
+ pu = -1;
+ if (*job == 0) {
+ goto L60;
+ }
+
+/* pivoting has been requested. rearrange the columns */
+/* according to jpvt. */
+
+ for (j = 0; j < *p; ++j) {
+ swapj = jpvt[j] > 0;
+ negj = jpvt[j] < 0;
+ jpvt[j] = j+1;
+ if (negj) {
+ jpvt[j] = -j-1;
+ }
+ if (! swapj) {
+ continue;
+ }
+ if (j != pl) {
+ sswap_(n, &x[pl * *ldx], &c__1, &x[j * *ldx], &c__1);
+ }
+ jpvt[j] = jpvt[pl];
+ jpvt[pl] = j+1;
+ ++pl;
+ }
+ pu = *p - 1;
+ for (j = pu; j >= 0; --j) {
+ if (jpvt[j] >= 0) {
+ continue;
+ }
+ jpvt[j] = -jpvt[j];
+ if (j != pu) {
+ sswap_(n, &x[pu * *ldx], &c__1, &x[j * *ldx], &c__1);
+ jp = jpvt[pu];
+ jpvt[pu] = jpvt[j];
+ jpvt[j] = jp;
+ }
+ --pu;
+ }
+L60:
+
+/* compute the norms of the free columns. */
+
+ for (j = pl; j <= pu; ++j) {
+ qraux[j] = snrm2_(n, &x[j * *ldx], &c__1);
+ work[j] = qraux[j];
+ }
+
+/* perform the householder reduction of x. */
+
+ for (l = 0; l < *n && l < *p; ++l) {
+ if (l < pl || l >= pu) {
+ goto L120;
+ }
+
+/* locate the column of largest norm and bring it */
+/* into the pivot position. */
+
+ maxnrm = 0.f;
+ maxj = l;
+ for (j = l; j <= pu; ++j) {
+ if (qraux[j] <= maxnrm) {
+ continue;
+ }
+ maxnrm = qraux[j];
+ maxj = j;
+ }
+ if (maxj != l) {
+ sswap_(n, &x[l * *ldx], &c__1, &x[maxj * *ldx], &c__1);
+ qraux[maxj] = qraux[l];
+ work[maxj] = work[l];
+ jp = jpvt[maxj]; jpvt[maxj] = jpvt[l]; jpvt[l] = jp;
+ }
+L120:
+ qraux[l] = 0.f;
+ if (l+1 == *n) {
+ continue;
+ }
+
+/* compute the householder transformation for column l. */
+
+ i__1 = *n - l;
+ nrmxl = snrm2_(&i__1, &x[l + l * *ldx], &c__1);
+ if (nrmxl == 0.f) {
+ continue;
+ }
+ if (x[l + l * *ldx] != 0.f) {
+ nrmxl = r_sign(&nrmxl, &x[l + l * *ldx]);
+ }
+ i__1 = *n - l;
+ r__1 = 1.f / nrmxl;
+ sscal_(&i__1, &r__1, &x[l + l * *ldx], &c__1);
+ x[l + l * *ldx] += 1.f;
+
+/* apply the transformation to the remaining columns, */
+/* updating the norms. */
+
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l;
+ t = -sdot_(&i__1, &x[l + l * *ldx], &c__1,
+ &x[l + j * *ldx], &c__1) / x[l + l * *ldx];
+ saxpy_(&i__1, &t, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1);
+ if (j < pl || j > pu) {
+ continue;
+ }
+ if (qraux[j] == 0.f) {
+ continue;
+ }
+ tt = abs(x[l + j * *ldx]) / qraux[j];
+ tt = 1.f - tt * tt;
+ tt = max(tt,0.f);
+ t = tt;
+ r__1 = qraux[j] / work[j];
+ tt = tt * .05f * r__1 * r__1 + 1.f;
+ if (tt != 1.f) {
+ qraux[j] *= sqrtf(t);
+ continue;
+ }
+ i__1 = *n - l - 1;
+ qraux[j] = snrm2_(&i__1, &x[l + 1 + j * *ldx], &c__1);
+ work[j] = qraux[j];
+ }
+
+/* save the transformation. */
+
+ qraux[l] = x[l + l * *ldx];
+ x[l + l * *ldx] = -nrmxl;
+ }
+} /* sqrdc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..e4c87f2cf7a20f8d1fd72cc832d73bac82841667
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrdc.f
@@ -0,0 +1,207 @@
+ subroutine sqrdc(x,ldx,n,p,qraux,jpvt,work,job)
+ integer ldx,n,p,job
+ integer jpvt(1)
+ real x(ldx,1),qraux(1),work(1)
+c
+c sqrdc uses householder transformations to compute the qr
+c factorization of an n by p matrix x. column pivoting
+c based on the 2-norms of the reduced columns may be
+c performed at the users option.
+c
+c on entry
+c
+c x real(ldx,p), where ldx .ge. n.
+c x contains the matrix whose decomposition is to be
+c computed.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c jpvt integer(p).
+c jpvt contains integers that control the selection
+c of the pivot columns. the k-th column x(k) of x
+c is placed in one of three classes according to the
+c value of jpvt(k).
+c
+c if jpvt(k) .gt. 0, then x(k) is an initial
+c column.
+c
+c if jpvt(k) .eq. 0, then x(k) is a free column.
+c
+c if jpvt(k) .lt. 0, then x(k) is a final column.
+c
+c before the decomposition is computed, initial columns
+c are moved to the beginning of the array x and final
+c columns to the end. both initial and final columns
+c are frozen in place during the computation and only
+c free columns are moved. at the k-th stage of the
+c reduction, if x(k) is occupied by a free column
+c it is interchanged with the free column of largest
+c reduced norm. jpvt is not referenced if
+c job .eq. 0.
+c
+c work real(p).
+c work is a work array. work is not referenced if
+c job .eq. 0.
+c
+c job integer.
+c job is an integer that initiates column pivoting.
+c if job .eq. 0, no pivoting is done.
+c if job .ne. 0, pivoting is done.
+c
+c on return
+c
+c x x contains in its upper triangle the upper
+c triangular matrix r of the qr factorization.
+c below its diagonal x contains information from
+c which the orthogonal part of the decomposition
+c can be recovered. note that if pivoting has
+c been requested, the decomposition is not that
+c of the original matrix x but that of x
+c with its columns permuted as described by jpvt.
+c
+c qraux real(p).
+c qraux contains further information required to recover
+c the orthogonal part of the decomposition.
+c
+c jpvt jpvt(k) contains the index of the column of the
+c original matrix that has been interchanged into
+c the k-th column, if pivoting was requested.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c sqrdc uses the following functions and subprograms.
+c
+c blas saxpy,sdot,sscal,sswap,snrm2
+c fortran abs,amax1,min0,sqrt
+c
+c internal variables
+c
+ integer j,jp,l,lp1,lup,maxj,pl,pu
+ real maxnrm,snrm2,tt
+ real sdot,nrmxl,t
+ logical negj,swapj
+c
+c
+ pl = 1
+ pu = 0
+ if (job .eq. 0) go to 60
+c
+c pivoting has been requested. rearrange the columns
+c according to jpvt.
+c
+ do 20 j = 1, p
+ swapj = jpvt(j) .gt. 0
+ negj = jpvt(j) .lt. 0
+ jpvt(j) = j
+ if (negj) jpvt(j) = -j
+ if (.not.swapj) go to 10
+ if (j .ne. pl) call sswap(n,x(1,pl),1,x(1,j),1)
+ jpvt(j) = jpvt(pl)
+ jpvt(pl) = j
+ pl = pl + 1
+ 10 continue
+ 20 continue
+ pu = p
+ do 50 jj = 1, p
+ j = p - jj + 1
+ if (jpvt(j) .ge. 0) go to 40
+ jpvt(j) = -jpvt(j)
+ if (j .eq. pu) go to 30
+ call sswap(n,x(1,pu),1,x(1,j),1)
+ jp = jpvt(pu)
+ jpvt(pu) = jpvt(j)
+ jpvt(j) = jp
+ 30 continue
+ pu = pu - 1
+ 40 continue
+ 50 continue
+ 60 continue
+c
+c compute the norms of the free columns.
+c
+ if (pu .lt. pl) go to 80
+ do 70 j = pl, pu
+ qraux(j) = snrm2(n,x(1,j),1)
+ work(j) = qraux(j)
+ 70 continue
+ 80 continue
+c
+c perform the householder reduction of x.
+c
+ lup = min0(n,p)
+ do 200 l = 1, lup
+ if (l .lt. pl .or. l .ge. pu) go to 120
+c
+c locate the column of largest norm and bring it
+c into the pivot position.
+c
+ maxnrm = 0.0e0
+ maxj = l
+ do 100 j = l, pu
+ if (qraux(j) .le. maxnrm) go to 90
+ maxnrm = qraux(j)
+ maxj = j
+ 90 continue
+ 100 continue
+ if (maxj .eq. l) go to 110
+ call sswap(n,x(1,l),1,x(1,maxj),1)
+ qraux(maxj) = qraux(l)
+ work(maxj) = work(l)
+ jp = jpvt(maxj)
+ jpvt(maxj) = jpvt(l)
+ jpvt(l) = jp
+ 110 continue
+ 120 continue
+ qraux(l) = 0.0e0
+ if (l .eq. n) go to 190
+c
+c compute the householder transformation for column l.
+c
+ nrmxl = snrm2(n-l+1,x(l,l),1)
+ if (nrmxl .eq. 0.0e0) go to 180
+ if (x(l,l) .ne. 0.0e0) nrmxl = sign(nrmxl,x(l,l))
+ call sscal(n-l+1,1.0e0/nrmxl,x(l,l),1)
+ x(l,l) = 1.0e0 + x(l,l)
+c
+c apply the transformation to the remaining columns,
+c updating the norms.
+c
+ lp1 = l + 1
+ if (p .lt. lp1) go to 170
+ do 160 j = lp1, p
+ t = -sdot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call saxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ if (j .lt. pl .or. j .gt. pu) go to 150
+ if (qraux(j) .eq. 0.0e0) go to 150
+ tt = 1.0e0 - (abs(x(l,j))/qraux(j))**2
+ tt = amax1(tt,0.0e0)
+ t = tt
+ tt = 1.0e0 + 0.05e0*tt*(qraux(j)/work(j))**2
+ if (tt .eq. 1.0e0) go to 130
+ qraux(j) = qraux(j)*sqrt(t)
+ go to 140
+ 130 continue
+ qraux(j) = snrm2(n-l,x(l+1,j),1)
+ work(j) = qraux(j)
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c save the transformation.
+c
+ qraux(l) = x(l,l)
+ x(l,l) = -nrmxl
+ 180 continue
+ 190 continue
+ 200 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.c
new file mode 100644
index 0000000000000000000000000000000000000000..3b31966ed9356f69d8e32d987e4ba7f412343167
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.c
@@ -0,0 +1,286 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void sqrsl_(x, ldx, n, k, qraux, y, qy, qty, b, rsd, xb, job, info)
+const real *x;
+const integer *ldx, *n, *k;
+const real *qraux, *y;
+real *qy, *qty, *b, *rsd, *xb;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static real temp;
+ static logical cqty;
+ static integer i, j;
+ static real t;
+ static logical cb;
+ static logical cr;
+ static integer ju;
+ static logical cxb, cqy;
+
+/* sqrsl applies the output of sqrdc to compute coordinate */
+/* transformations, projections, and least squares solutions. */
+/* for k .le. min(n,p), let xk be the matrix */
+/* */
+/* xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) */
+/* */
+/* formed from columns jpvt(1), ... ,jpvt(k) of the original */
+/* n x p matrix x that was input to sqrdc (if no pivoting was */
+/* done, xk consists of the first k columns of x in their */
+/* original order). sqrdc produces a factored orthogonal matrix q */
+/* and an upper triangular matrix r such that */
+/* */
+/* xk = q * (r) */
+/* (0) */
+/* */
+/* this information is contained in coded form in the arrays */
+/* x and qraux. */
+/* */
+/* on entry */
+/* */
+/* x real(ldx,p). */
+/* x contains the output of sqrdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix xk. it must */
+/* have the same value as n in sqrdc. */
+/* */
+/* k integer. */
+/* k is the number of columns of the matrix xk. k */
+/* must nnot be greater than min(n,p), where p is the */
+/* same as in the calling sequence to sqrdc. */
+/* */
+/* qraux real(p). */
+/* qraux contains the auxiliary output from sqrdc. */
+/* */
+/* y real(n) */
+/* y contains an n-vector that is to be manipulated */
+/* by sqrsl. */
+/* */
+/* job integer. */
+/* job specifies what is to be computed. job has */
+/* the decimal expansion abcde, with the following */
+/* meaning. */
+/* */
+/* if a.ne.0, compute qy. */
+/* if b,c,d, or e .ne. 0, compute qty. */
+/* if c.ne.0, compute b. */
+/* if d.ne.0, compute rsd. */
+/* if e.ne.0, compute xb. */
+/* */
+/* note that a request to compute b, rsd, or xb */
+/* automatically triggers the computation of qty, for */
+/* which an array must be provided in the calling */
+/* sequence. */
+/* */
+/* on return */
+/* */
+/* qy real(n). */
+/* qy contains q*y, if its computation has been */
+/* requested. */
+/* */
+/* qty real(n). */
+/* qty contains trans(q)*y, if its computation has */
+/* been requested. here trans(q) is the */
+/* transpose of the matrix q. */
+/* */
+/* b real(k) */
+/* b contains the solution of the least squares problem */
+/* */
+/* minimize norm2(y - xk*b), */
+/* */
+/* if its computation has been requested. (note that */
+/* if pivoting was requested in sqrdc, the j-th */
+/* component of b will be associated with column jpvt(j) */
+/* of the original matrix x that was input into sqrdc.) */
+/* */
+/* rsd real(n). */
+/* rsd contains the least squares residual y - xk*b, */
+/* if its computation has been requested. rsd is */
+/* also the orthogonal projection of y onto the */
+/* orthogonal complement of the column space of xk. */
+/* */
+/* xb real(n). */
+/* xb contains the least squares approximation xk*b, */
+/* if its computation has been requested. xb is also */
+/* the orthogonal projection of y onto the column space */
+/* of x. */
+/* */
+/* info integer. */
+/* info is zero unless the computation of b has */
+/* been requested and r is exactly singular. in */
+/* this case, info is the index of the first zero */
+/* diagonal element of r and b is left unaltered. */
+/* */
+/* the parameters qy, qty, b, rsd, and xb are not referenced */
+/* if their computation is not requested and in this case */
+/* can be replaced by dummy variables in the calling program. */
+/* to save storage, the user may in some cases use the same */
+/* array for different parameters in the calling sequence. a */
+/* frequently occurring example is when one wishes to compute */
+/* any of b, rsd, or xb and does not need y or qty. in this */
+/* case one may identify y, qty, and one of b, rsd, or xb, while */
+/* providing separate arrays for anything else that is to be */
+/* computed. thus the calling sequence */
+/* */
+/* call sqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info) */
+/* */
+/* will result in the computation of b and rsd, with rsd */
+/* overwriting y. more generally, each item in the following */
+/* list contains groups of permissible identifications for */
+/* a single callinng sequence. */
+/* */
+/* 1. (y,qty,b) (rsd) (xb) (qy) */
+/* */
+/* 2. (y,qty,rsd) (b) (xb) (qy) */
+/* */
+/* 3. (y,qty,xb) (b) (rsd) (qy) */
+/* */
+/* 4. (y,qy) (qty,b) (rsd) (xb) */
+/* */
+/* 5. (y,qy) (qty,rsd) (b) (xb) */
+/* */
+/* 6. (y,qy) (qty,xb) (b) (rsd) */
+/* */
+/* in any group the value returned in the array allocated to */
+/* the group corresponds to the last member of the group. */
+
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* sqrsl uses the following functions and subprograms. */
+
+/* blas saxpy,scopy,sdot */
+/* fortran abs,min0,mod */
+
+/* set info flag. */
+ *info = 0;
+
+/* determine what is to be computed. */
+
+ cqy = *job / 10000 != 0;
+ cqty = *job % 10000 != 0;
+ cb = *job % 1000 / 100 != 0;
+ cr = *job % 100 / 10 != 0;
+ cxb = *job % 10 != 0;
+ ju = min(*k,*n - 1);
+
+/* special action when n=1. */
+
+ if (ju == 0) {
+ if (cqy) qy[0] = y[0];
+ if (cqty) qty[0] = y[0];
+ if (cxb) xb[0] = y[0];
+ if (cb) {
+ if (x[0] == 0.f) *info = 1;
+ else b[0] = y[0] / x[0];
+ }
+ if (cr) rsd[0] = 0.f;
+ return;
+ }
+
+/* set up to compute qy or qty. */
+
+ if (cqy) {
+ scopy_(n, y, &c__1, qy, &c__1);
+ }
+ if (cqty) {
+ scopy_(n, y, &c__1, qty, &c__1);
+ }
+
+/* compute qy. */
+
+ if (cqy)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j] == 0.f)
+ continue;
+ temp = x[j + j * *ldx];
+ ((real*)x)[j + j * *ldx] = qraux[j]; /* temporarily */
+ i__1 = *n - j;
+ t = -sdot_(&i__1, &x[j + j * *ldx], &c__1, &qy[j], &c__1) / x[j + j * *ldx];
+ saxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &qy[j], &c__1);
+ ((real*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+
+/* compute trans(q)*y. */
+
+ if (cqty)
+ for (j = 0; j < ju; ++j) {
+ if (qraux[j] == 0.f)
+ continue;
+ temp = x[j + j * *ldx];
+ ((real*)x)[j + j * *ldx] = qraux[j]; /* temporarily */
+ i__1 = *n - j;
+ t = -sdot_(&i__1, &x[j + j * *ldx], &c__1, &qty[j], &c__1) / x[j + j * *ldx];
+ saxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &qty[j], &c__1);
+ ((real*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+
+/* set up to compute b, rsd, or xb. */
+
+ if (cb) {
+ scopy_(k, qty, &c__1, b, &c__1);
+ }
+ if (cxb) {
+ scopy_(k, qty, &c__1, xb, &c__1);
+ }
+ if (cr && *k < *n) {
+ i__1 = *n - *k;
+ scopy_(&i__1, &qty[*k], &c__1, &rsd[*k], &c__1);
+ }
+ if (cxb)
+ for (i = *k; i < *n; ++i) {
+ xb[i] = 0.f;
+ }
+ if (cr)
+ for (i = 0; i < *k; ++i) {
+ rsd[i] = 0.f;
+ }
+
+/* compute b. */
+
+ if (cb)
+ for (j = *k-1; j >= 0; --j) {
+ if (x[j + j * *ldx] == 0.f) {
+ *info = j+1;
+ break;
+ }
+ b[j] /= x[j + j * *ldx];
+ if (j != 0) {
+ t = -b[j];
+ saxpy_(&j, &t, &x[j * *ldx], &c__1, b, &c__1);
+ }
+ }
+ if (! cr && ! cxb)
+ return;
+
+/* compute rsd or xb as required. */
+
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j] == 0.f) {
+ continue;
+ }
+ temp = x[j + j * *ldx];
+ ((real*)x)[j + j * *ldx] = qraux[j]; /* temporarily */
+ i__1 = *n - j;
+ if (cr) {
+ t = -sdot_(&i__1, &x[j + j * *ldx], &c__1, &rsd[j], &c__1) / x[j + j * *ldx];
+ saxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &rsd[j], &c__1);
+ }
+ if (cxb) {
+ t = -sdot_(&i__1, &x[j + j * *ldx], &c__1, &xb[j], &c__1) / x[j + j * *ldx];
+ saxpy_(&i__1, &t, &x[j + j * *ldx], &c__1, &xb[j], &c__1);
+ }
+ ((real*)x)[j + j * *ldx] = temp; /* restore original */
+ }
+} /* sqrsl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.f
new file mode 100644
index 0000000000000000000000000000000000000000..3339a1633456026af828010eb8ac9469abeeed82
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sqrsl.f
@@ -0,0 +1,273 @@
+ subroutine sqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info)
+ integer ldx,n,k,job,info
+ real x(ldx,1),qraux(1),y(1),qy(1),qty(1),b(1),rsd(1),xb(1)
+c
+c sqrsl applies the output of sqrdc to compute coordinate
+c transformations, projections, and least squares solutions.
+c for k .le. min(n,p), let xk be the matrix
+c
+c xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k)))
+c
+c formed from columns jpvt(1), ... ,jpvt(k) of the original
+c n x p matrix x that was input to sqrdc (if no pivoting was
+c done, xk consists of the first k columns of x in their
+c original order). sqrdc produces a factored orthogonal matrix q
+c and an upper triangular matrix r such that
+c
+c xk = q * (r)
+c (0)
+c
+c this information is contained in coded form in the arrays
+c x and qraux.
+c
+c on entry
+c
+c x real(ldx,p).
+c x contains the output of sqrdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix xk. it must
+c have the same value as n in sqrdc.
+c
+c k integer.
+c k is the number of columns of the matrix xk. k
+c must nnot be greater than min(n,p), where p is the
+c same as in the calling sequence to sqrdc.
+c
+c qraux real(p).
+c qraux contains the auxiliary output from sqrdc.
+c
+c y real(n)
+c y contains an n-vector that is to be manipulated
+c by sqrsl.
+c
+c job integer.
+c job specifies what is to be computed. job has
+c the decimal expansion abcde, with the following
+c meaning.
+c
+c if a.ne.0, compute qy.
+c if b,c,d, or e .ne. 0, compute qty.
+c if c.ne.0, compute b.
+c if d.ne.0, compute rsd.
+c if e.ne.0, compute xb.
+c
+c note that a request to compute b, rsd, or xb
+c automatically triggers the computation of qty, for
+c which an array must be provided in the calling
+c sequence.
+c
+c on return
+c
+c qy real(n).
+c qy contains q*y, if its computation has been
+c requested.
+c
+c qty real(n).
+c qty contains trans(q)*y, if its computation has
+c been requested. here trans(q) is the
+c transpose of the matrix q.
+c
+c b real(k)
+c b contains the solution of the least squares problem
+c
+c minimize norm2(y - xk*b),
+c
+c if its computation has been requested. (note that
+c if pivoting was requested in sqrdc, the j-th
+c component of b will be associated with column jpvt(j)
+c of the original matrix x that was input into sqrdc.)
+c
+c rsd real(n).
+c rsd contains the least squares residual y - xk*b,
+c if its computation has been requested. rsd is
+c also the orthogonal projection of y onto the
+c orthogonal complement of the column space of xk.
+c
+c xb real(n).
+c xb contains the least squares approximation xk*b,
+c if its computation has been requested. xb is also
+c the orthogonal projection of y onto the column space
+c of x.
+c
+c info integer.
+c info is zero unless the computation of b has
+c been requested and r is exactly singular. in
+c this case, info is the index of the first zero
+c diagonal element of r and b is left unaltered.
+c
+c the parameters qy, qty, b, rsd, and xb are not referenced
+c if their computation is not requested and in this case
+c can be replaced by dummy variables in the calling program.
+c to save storage, the user may in some cases use the same
+c array for different parameters in the calling sequence. a
+c frequently occurring example is when one wishes to compute
+c any of b, rsd, or xb and does not need y or qty. in this
+c case one may identify y, qty, and one of b, rsd, or xb, while
+c providing separate arrays for anything else that is to be
+c computed. thus the calling sequence
+c
+c call sqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info)
+c
+c will result in the computation of b and rsd, with rsd
+c overwriting y. more generally, each item in the following
+c list contains groups of permissible identifications for
+c a single callinng sequence.
+c
+c 1. (y,qty,b) (rsd) (xb) (qy)
+c
+c 2. (y,qty,rsd) (b) (xb) (qy)
+c
+c 3. (y,qty,xb) (b) (rsd) (qy)
+c
+c 4. (y,qy) (qty,b) (rsd) (xb)
+c
+c 5. (y,qy) (qty,rsd) (b) (xb)
+c
+c 6. (y,qy) (qty,xb) (b) (rsd)
+c
+c in any group the value returned in the array allocated to
+c the group corresponds to the last member of the group.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c sqrsl uses the following functions and subprograms.
+c
+c blas saxpy,scopy,sdot
+c fortran abs,min0,mod
+c
+c internal variables
+c
+ integer i,j,jj,ju,kp1
+ real sdot,t,temp
+ logical cb,cqy,cqty,cr,cxb
+c
+c
+c set info flag.
+c
+ info = 0
+c
+c determine what is to be computed.
+c
+ cqy = job/10000 .ne. 0
+ cqty = mod(job,10000) .ne. 0
+ cb = mod(job,1000)/100 .ne. 0
+ cr = mod(job,100)/10 .ne. 0
+ cxb = mod(job,10) .ne. 0
+ ju = min0(k,n-1)
+c
+c special action when n=1.
+c
+ if (ju .ne. 0) go to 40
+ if (cqy) qy(1) = y(1)
+ if (cqty) qty(1) = y(1)
+ if (cxb) xb(1) = y(1)
+ if (.not.cb) go to 30
+ if (x(1,1) .ne. 0.0e0) go to 10
+ info = 1
+ go to 20
+ 10 continue
+ b(1) = y(1)/x(1,1)
+ 20 continue
+ 30 continue
+ if (cr) rsd(1) = 0.0e0
+ go to 250
+ 40 continue
+c
+c set up to compute qy or qty.
+c
+ if (cqy) call scopy(n,y,1,qy,1)
+ if (cqty) call scopy(n,y,1,qty,1)
+ if (.not.cqy) go to 70
+c
+c compute qy.
+c
+ do 60 jj = 1, ju
+ j = ju - jj + 1
+ if (qraux(j) .eq. 0.0e0) go to 50
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -sdot(n-j+1,x(j,j),1,qy(j),1)/x(j,j)
+ call saxpy(n-j+1,t,x(j,j),1,qy(j),1)
+ x(j,j) = temp
+ 50 continue
+ 60 continue
+ 70 continue
+ if (.not.cqty) go to 100
+c
+c compute trans(q)*y.
+c
+ do 90 j = 1, ju
+ if (qraux(j) .eq. 0.0e0) go to 80
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -sdot(n-j+1,x(j,j),1,qty(j),1)/x(j,j)
+ call saxpy(n-j+1,t,x(j,j),1,qty(j),1)
+ x(j,j) = temp
+ 80 continue
+ 90 continue
+ 100 continue
+c
+c set up to compute b, rsd, or xb.
+c
+ if (cb) call scopy(k,qty,1,b,1)
+ kp1 = k + 1
+ if (cxb) call scopy(k,qty,1,xb,1)
+ if (cr .and. k .lt. n) call scopy(n-k,qty(kp1),1,rsd(kp1),1)
+ if (.not.cxb .or. kp1 .gt. n) go to 120
+ do 110 i = kp1, n
+ xb(i) = 0.0e0
+ 110 continue
+ 120 continue
+ if (.not.cr) go to 140
+ do 130 i = 1, k
+ rsd(i) = 0.0e0
+ 130 continue
+ 140 continue
+ if (.not.cb) go to 190
+c
+c compute b.
+c
+ do 170 jj = 1, k
+ j = k - jj + 1
+ if (x(j,j) .ne. 0.0e0) go to 150
+ info = j
+c ......exit
+ go to 180
+ 150 continue
+ b(j) = b(j)/x(j,j)
+ if (j .eq. 1) go to 160
+ t = -b(j)
+ call saxpy(j-1,t,x(1,j),1,b,1)
+ 160 continue
+ 170 continue
+ 180 continue
+ 190 continue
+ if (.not.cr .and. .not.cxb) go to 240
+c
+c compute rsd or xb as required.
+c
+ do 230 jj = 1, ju
+ j = ju - jj + 1
+ if (qraux(j) .eq. 0.0e0) go to 220
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ if (.not.cr) go to 200
+ t = -sdot(n-j+1,x(j,j),1,rsd(j),1)/x(j,j)
+ call saxpy(n-j+1,t,x(j,j),1,rsd(j),1)
+ 200 continue
+ if (.not.cxb) go to 210
+ t = -sdot(n-j+1,x(j,j),1,xb(j),1)/x(j,j)
+ call saxpy(n-j+1,t,x(j,j),1,xb(j),1)
+ 210 continue
+ x(j,j) = temp
+ 220 continue
+ 230 continue
+ 240 continue
+ 250 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.c
new file mode 100644
index 0000000000000000000000000000000000000000..a62a77462a038c39a9621502e96beab46aae0828
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.c
@@ -0,0 +1,46 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void srot_(n, sx, incx, sy, incy, c, s)
+const integer *n;
+real *sx;
+const integer *incx;
+real *sy;
+const integer *incy;
+const real *c, *s;
+{
+ /* Local variables */
+ static integer i;
+ static real stemp;
+ static integer ix, iy;
+
+/* applies a plane rotation. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ stemp = *c * sx[i] + *s * sy[i];
+ sy[i] = *c * sy[i] - *s * sx[i];
+ sx[i] = stemp;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ stemp = *c * sx[ix] + *s * sy[iy];
+ sy[iy] = *c * sy[iy] - *s * sx[ix];
+ sx[ix] = stemp;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* srot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.f
new file mode 100644
index 0000000000000000000000000000000000000000..e0ee1e50c72b09e5799932dfa08d7a45ad8be12d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/srot.f
@@ -0,0 +1,37 @@
+ subroutine srot (n,sx,incx,sy,incy,c,s)
+c
+c applies a plane rotation.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),sy(*),stemp,c,s
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ stemp = c*sx(ix) + s*sy(iy)
+ sy(iy) = c*sy(iy) - s*sx(ix)
+ sx(ix) = stemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ stemp = c*sx(i) + s*sy(i)
+ sy(i) = c*sy(i) - s*sx(i)
+ sx(i) = stemp
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.c
new file mode 100644
index 0000000000000000000000000000000000000000..cd1940b071d18fa8ae07e4766dc36bc38a282ff1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.c
@@ -0,0 +1,43 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Table of constant values */
+static real c_b4 = 1.f;
+
+/* Subroutine */ void srotg_(sa, sb, c, s)
+real *sa, *sb, *c, *s;
+{
+ /* Local variables */
+ static real r, scale, z, roe;
+
+/* construct givens plane rotation. */
+/* jack dongarra, linpack, 3/11/78. */
+
+ scale = abs(*sa) + abs(*sb);
+ if (scale == 0.f) {
+ *c = 1.f; *s = 0.f;
+ *sa = *sb = 0.f;
+ }
+ else {
+ roe = *sb;
+ if (abs(*sa) > abs(*sb)) {
+ roe = *sa;
+ }
+ r = *sa / scale;
+ z = *sb / scale;
+ r = scale * sqrtf(r * r + z * z);
+ r *= r_sign(&c_b4, &roe);
+ *c = *sa / r;
+ *s = *sb / r;
+ z = 1.f;
+ if (abs(*sa) > abs(*sb)) {
+ z = *s;
+ }
+ if (abs(*sb) >= abs(*sa) && *c != 0.f) {
+ z = 1.f / *c;
+ }
+ *sa = r;
+ *sb = z;
+ }
+} /* srotg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.f
new file mode 100644
index 0000000000000000000000000000000000000000..84d1922af7657504e7f0cf051a446fdd7c700ed5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/srotg.f
@@ -0,0 +1,27 @@
+ subroutine srotg(sa,sb,c,s)
+c
+c construct givens plane rotation.
+c jack dongarra, linpack, 3/11/78.
+c
+ real sa,sb,c,s,roe,scale,r,z
+c
+ roe = sb
+ if( abs(sa) .gt. abs(sb) ) roe = sa
+ scale = abs(sa) + abs(sb)
+ if( scale .ne. 0.0 ) go to 10
+ c = 1.0
+ s = 0.0
+ r = 0.0
+ z = 0.0
+ go to 20
+ 10 r = scale*sqrt((sa/scale)**2 + (sb/scale)**2)
+ r = sign(1.0,roe)*r
+ c = sa/r
+ s = sb/r
+ z = 1.0
+ if( abs(sa) .gt. abs(sb) ) z = s
+ if( abs(sb) .ge. abs(sa) .and. c .ne. 0.0 ) z = 1.0/c
+ 20 sa = r
+ sb = z
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.c
new file mode 100644
index 0000000000000000000000000000000000000000..0340ef125eb75b0df2587a34deba43acd81891f2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.c
@@ -0,0 +1,39 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sscal_(n, sa, sx, incx)
+const integer *n;
+const real *sa;
+real *sx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i, m, nincx;
+
+/* scales a vector by a constant. */
+/* uses unrolled loops for increment equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0 || *incx <= 0) {
+ return;
+ }
+/* code for increment equal to 1 */
+ if (*incx == 1) {
+ m = *n % 5;
+ for (i = 0; i < m; ++i) {
+ sx[i] *= *sa;
+ }
+ for (i = m; i < *n; i += 5) {
+ sx[i] *= *sa; sx[i+1] *= *sa; sx[i+2] *= *sa; sx[i+3] *= *sa; sx[i+4] *= *sa;
+ }
+ }
+/* code for increment not equal to 1 */
+ else {
+ nincx = *n * *incx;
+ for (i = 0; i < nincx; i += *incx) {
+ sx[i] *= *sa;
+ }
+ }
+} /* sscal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.f
new file mode 100644
index 0000000000000000000000000000000000000000..ac7ee00105f981255be64aebc4e617ee51f7a7ae
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sscal.f
@@ -0,0 +1,43 @@
+ subroutine sscal(n,sa,sx,incx)
+c
+c scales a vector by a constant.
+c uses unrolled loops for increment equal to 1.
+c jack dongarra, linpack, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sa,sx(*)
+ integer i,incx,m,mp1,n,nincx
+c
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ nincx = n*incx
+ do 10 i = 1,nincx,incx
+ sx(i) = sa*sx(i)
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,5)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ sx(i) = sa*sx(i)
+ 30 continue
+ if( n .lt. 5 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,5
+ sx(i) = sa*sx(i)
+ sx(i + 1) = sa*sx(i + 1)
+ sx(i + 2) = sa*sx(i + 2)
+ sx(i + 3) = sa*sx(i + 3)
+ sx(i + 4) = sa*sx(i + 4)
+ 50 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..8f32e77ba1c4ae0d4bbba05fd2e80c7ccb74a5f1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.c
@@ -0,0 +1,546 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/*
+ * Calling this ensures that the operands are spilled to
+ * memory and thus avoids excessive precision when compiling
+ * for x86 with heavy optimization (gcc). It is better to do
+ * this than to turn on -ffloat-store.
+ */
+static int fsm_ieee_floats_equal(const real *x, const real *y);
+
+/* Table of constant values */
+static integer c__1 = 1;
+static real c_m1 = -1.f;
+
+/* Subroutine */ void ssvdc_(x, ldx, n, p, s, e, u, ldu, v, ldv, work, job, info)
+real *x;
+const integer *ldx, *n, *p;
+real *s, *e, *u;
+const integer *ldu;
+real *v;
+const integer *ldv;
+real *work;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static integer kase, jobu, iter;
+ static real test;
+ static real b, c;
+ static real f, g;
+ static integer i, j, k, l, m;
+ static real t, scale;
+ static real shift;
+ static integer maxit;
+ static logical wantu, wantv;
+ static real t1, ztest, el;
+ static real cs;
+ static integer mm, ls;
+ static real sl;
+ static integer lu;
+ static real sm, sn;
+ static integer lp1, nct, ncu, nrt;
+ static real emm1, smm1;
+
+/* ssvdc is a subroutine to reduce a real nxp matrix x by */
+/* orthogonal transformations u and v to diagonal form. the */
+/* diagonal elements s(i) are the singular values of x. the */
+/* columns of u are the corresponding left singular vectors, */
+/* and the columns of v the right singular vectors. */
+/* */
+/* on entry */
+/* */
+/* x real(ldx,p), where ldx.ge.n. */
+/* x contains the matrix whose singular value */
+/* decomposition is to be computed. x is */
+/* destroyed by ssvdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* ldu integer. */
+/* ldu is the leading dimension of the array u. */
+/* (see below). */
+/* */
+/* ldv integer. */
+/* ldv is the leading dimension of the array v. */
+/* (see below). */
+/* */
+/* work real(n). */
+/* work is a scratch array. */
+/* */
+/* job integer. */
+/* job controls the computation of the singular */
+/* vectors. it has the decimal expansion ab */
+/* with the following meaning */
+/* */
+/* a.eq.0 do not compute the left singular */
+/* vectors. */
+/* a.eq.1 return the n left singular vectors */
+/* in u. */
+/* a.ge.2 return the first min(n,p) singular */
+/* vectors in u. */
+/* b.eq.0 do not compute the right singular */
+/* vectors. */
+/* b.eq.1 return the right singular vectors */
+/* in v. */
+/* */
+/* on return */
+/* */
+/* s real(mm), where mm=min(n+1,p). */
+/* the first min(n,p) entries of s contain the */
+/* singular values of x arranged in descending */
+/* order of magnitude. */
+/* */
+/* e real(p). */
+/* e ordinarily contains zeros. however see the */
+/* discussion of info for exceptions. */
+/* */
+/* u real(ldu,k), where ldu.ge.n. if joba.eq.1 then */
+/* k.eq.n, if joba.ge.2 then */
+/* k.eq.min(n,p). */
+/* u contains the matrix of left singular vectors. */
+/* u is not referenced if joba.eq.0. if n.le.p */
+/* or if joba.eq.2, then u may be identified with x */
+/* in the subroutine call. */
+/* */
+/* v real(ldv,p), where ldv.ge.p. */
+/* v contains the matrix of right singular vectors. */
+/* v is not referenced if job.eq.0. if p.le.n, */
+/* then v may be identified with x in the */
+/* subroutine call. */
+/* */
+/* info integer. */
+/* the singular values (and their corresponding */
+/* singular vectors) s(info+1),s(info+2),...,s(m) */
+/* are correct (here m=min(n,p)). thus if */
+/* info.eq.0, all the singular values and their */
+/* vectors are correct. in any event, the matrix */
+/* b = trans(u)*x*v is the bidiagonal matrix */
+/* with the elements of s on its diagonal and the */
+/* elements of e on its super-diagonal (trans(u) */
+/* is the transpose of u). thus the singular */
+/* values of x and b are the same. */
+/* */
+/* linpack. this version dated 03/19/79 . */
+/* correction to shift calculation made 2/85. */
+/* g.w. stewart, university of maryland, argonne national lab. */
+
+/* ***** uses the following functions and subprograms. */
+/* */
+/* external srot */
+/* blas saxpy,sdot,sscal,sswap,snrm2,srotg */
+/* fortran abs,amax1,max0,min0,mod,sqrt */
+
+/* set the maximum number of iterations. */
+
+ maxit = 50;
+
+/* determine what is to be computed. */
+
+ wantu = FALSE_;
+ wantv = FALSE_;
+ jobu = *job % 100 / 10;
+ ncu = *n;
+ if (jobu > 1) {
+ ncu = min(*n,*p);
+ }
+ if (jobu != 0) {
+ wantu = TRUE_;
+ }
+ if (*job % 10 != 0) {
+ wantv = TRUE_;
+ }
+
+/* reduce x to bidiagonal form, storing the diagonal elements */
+/* in s and the super-diagonal elements in e. */
+
+ *info = 0;
+ nct = min(*n-1,*p);
+ nrt = max(0,min(*p-2,*n));
+ lu = max(nct,nrt);
+ for (l = 0; l < lu; ++l) {
+ lp1 = l+1;
+ if (lp1 > nct) {
+ goto L20;
+ }
+
+/* compute the transformation for the l-th column and */
+/* place the l-th diagonal in s(l). */
+
+ i__1 = *n - l;
+ s[l] = snrm2_(&i__1, &x[l + l * *ldx], &c__1);
+ if (s[l] == 0.f) {
+ goto L10;
+ }
+ if (x[l + l * *ldx] != 0.f) {
+ s[l] = r_sign(&s[l], &x[l + l * *ldx]);
+ }
+ i__1 = *n - l;
+ r__1 = 1.f / s[l];
+ sscal_(&i__1, &r__1, &x[l + l * *ldx], &c__1);
+ x[l + l * *ldx] += 1.f;
+L10:
+ s[l] = -s[l];
+L20:
+ for (j = lp1; j < *p; ++j) {
+
+/* apply the transformation. */
+
+ if (l < nct && s[l] != 0.f) {
+ i__1 = *n - l;
+ t = -sdot_(&i__1, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1) / x[l + l * *ldx];
+ saxpy_(&i__1, &t, &x[l + l * *ldx], &c__1, &x[l + j * *ldx], &c__1);
+ }
+
+/* place the l-th row of x into e for the */
+/* subsequent calculation of the row transformation. */
+
+ e[j] = x[l + j * *ldx];
+ }
+
+/* place the transformation in u for subsequent back */
+/* multiplication. */
+
+ if (wantu && l < nct)
+ for (i = l; i < *n; ++i) {
+ u[i + l * *ldu] = x[i + l * *ldx];
+ }
+ if (lp1 > nrt) {
+ continue;
+ }
+
+/* compute the l-th row transformation and place the */
+/* l-th super-diagonal in e(l). */
+
+ i__1 = *p - lp1;
+ e[l] = snrm2_(&i__1, &e[lp1], &c__1);
+ if (e[l] == 0.f) {
+ goto L80;
+ }
+ if (e[lp1] != 0.f) {
+ e[l] = r_sign(&e[l], &e[lp1]);
+ }
+ i__1 = *p - lp1;
+ r__1 = 1.f / e[l];
+ sscal_(&i__1, &r__1, &e[lp1], &c__1);
+ e[lp1] += 1.f;
+L80:
+ e[l] = -e[l];
+ if (l+2 > *n || e[l] == 0.f) {
+ goto L120;
+ }
+
+/* apply the transformation. */
+
+ for (i = lp1; i < *n; ++i) {
+ work[i] = 0.f;
+ }
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *n - lp1;
+ saxpy_(&i__1, &e[j], &x[lp1 + j * *ldx], &c__1, &work[lp1], &c__1);
+ }
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *n - lp1;
+ r__1 = -e[j] / e[lp1];
+ saxpy_(&i__1, &r__1, &work[lp1], &c__1, &x[lp1 + j * *ldx], &c__1);
+ }
+L120:
+
+/* place the transformation in v for subsequent */
+/* back multiplication. */
+
+ if (wantv)
+ for (i = lp1; i < *p; ++i) {
+ v[i + l * *ldv] = e[i];
+ }
+ }
+
+/* set up the final bidiagonal matrix or order m. */
+
+ m = min(*p-1,*n);
+ if (nct < *p) {
+ s[nct] = x[nct + nct * *ldx];
+ }
+ if (*n < m+1) {
+ s[m] = 0.f;
+ }
+ if (nrt < m) {
+ e[nrt] = x[nrt + m * *ldx];
+ }
+ e[m] = 0.f;
+
+/* if required, generate u. */
+
+ if (wantu)
+ for (j = nct; j < ncu; ++j) {
+ for (i = 0; i < *n; ++i) {
+ u[i + j * *ldu] = 0.f;
+ }
+ u[j + j * *ldu] = 1.f;
+ }
+ if (wantu)
+ for (l = nct-1; l >= 0; --l) {
+ if (s[l] == 0.f) {
+ for (i = 0; i < *n; ++i) {
+ u[i + l * *ldu] = 0.f;
+ }
+ u[l + l * *ldu] = 1.f;
+ continue;
+ }
+ for (j = l+1; j < ncu; ++j) {
+ i__1 = *n - l;
+ t = -sdot_(&i__1, &u[l + l * *ldu], &c__1, &u[l + j * *ldu], &c__1) / u[l + l * *ldu];
+ saxpy_(&i__1, &t, &u[l + l * *ldu], &c__1, &u[l + j * *ldu], &c__1);
+ }
+ i__1 = *n - l;
+ sscal_(&i__1, &c_m1, &u[l + l * *ldu], &c__1);
+ u[l + l * *ldu] += 1.f;
+ for (i = 0; i < l; ++i) {
+ u[i + l * *ldu] = 0.f;
+ }
+ }
+
+/* if it is required, generate v. */
+
+ if (wantv)
+ for (l = *p-1; l >= 0; --l) {
+ lp1 = l+1;
+ if (l < nrt && e[l] != 0.f)
+ for (j = lp1; j < *p; ++j) {
+ i__1 = *p - lp1;
+ t = -sdot_(&i__1, &v[lp1 + l * *ldv], &c__1, &v[lp1 + j * *ldv], &c__1) / v[lp1 + l * *ldv];
+ saxpy_(&i__1, &t, &v[lp1 + l * *ldv], &c__1, &v[lp1 + j * *ldv], &c__1);
+ }
+ for (i = 0; i < *p; ++i) {
+ v[i + l * *ldv] = 0.f;
+ }
+ v[l + l * *ldv] = 1.f;
+ }
+
+/* main iteration loop for the singular values. */
+
+ mm = m;
+ iter = 0;
+L360:
+
+/* quit if all the singular values have been found. */
+
+ if (m < 0) {
+ return;
+ }
+
+/* if too many iterations have been performed, set */
+/* flag and return. */
+
+ if (iter >= maxit) {
+ *info = m+1;
+ return;
+ }
+
+/* this section of the program inspects for */
+/* negligible elements in the s and e arrays. on */
+/* completion the variables kase and l are set as follows. */
+
+/* kase = 1 if s(m) and e(l-1) are negligible and l.lt.m */
+/* kase = 2 if s(l) is negligible and l.lt.m */
+/* kase = 3 if e(l-1) is negligible, l.lt.m, and */
+/* s(l), ..., s(m) are not negligible (qr step). */
+/* kase = 4 if e(m-1) is negligible (convergence). */
+
+ for (l = m-1; l >= 0; --l) {
+ test = abs(s[l]) + abs(s[l+1]);
+ ztest = test + abs(e[l]);
+ if (fsm_ieee_floats_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ e[l] = 0.f;
+ break;
+ }
+ }
+ if (l == m-1) {
+ kase = 4;
+ goto L480;
+ }
+ for (ls = m; ls > l; --ls) {
+ test = 0.f;
+ if (ls != m) {
+ test += abs(e[ls]);
+ }
+ if (ls != l+1) {
+ test += abs(e[ls-1]);
+ }
+ ztest = test + abs(s[ls]);
+ if (fsm_ieee_floats_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ s[ls] = 0.f;
+ break;
+ }
+ }
+ if (ls == l) {
+ kase = 3;
+ }
+ else if (ls == m) {
+ kase = 1;
+ }
+ else {
+ kase = 2;
+ l = ls;
+ }
+L480:
+ ++l;
+
+/* perform the task indicated by kase. */
+
+ switch ((int)kase) {
+ case 1: goto L490;
+ case 2: goto L520;
+ case 3: goto L540;
+ case 4: goto L570;
+ }
+
+/* deflate negligible s(m). */
+
+L490:
+ f = e[m-1];
+ e[m-1] = 0.f;
+ for (k = m-1; k >= l; --k) {
+ t1 = s[k];
+ srotg_(&t1, &f, &cs, &sn);
+ s[k] = t1;
+ if (k != l) {
+ f = -sn * e[k-1];
+ e[k-1] *= cs;
+ }
+ if (wantv) {
+ srot_(p, &v[k * *ldv], &c__1, &v[m * *ldv], &c__1, &cs, &sn);
+ }
+ }
+ goto L360;
+
+/* split at negligible s(l). */
+
+L520:
+ f = e[l-1];
+ e[l-1] = 0.f;
+ for (k = l; k <= m; ++k) {
+ t1 = s[k];
+ srotg_(&t1, &f, &cs, &sn);
+ s[k] = t1;
+ f = -sn * e[k];
+ e[k] *= cs;
+ if (wantu) {
+ srot_(n, &u[k * *ldu], &c__1, &u[(l-1) * *ldu], &c__1, &cs, &sn);
+ }
+ }
+ goto L360;
+
+/* perform one qr step. */
+
+L540:
+
+/* calculate the shift. */
+
+ scale = max(max(max(max(abs(s[m]),abs(s[m-1])),abs(e[m-1])),abs(s[l])),abs(e[l]));
+ sm = s[m] / scale;
+ smm1 = s[m-1] / scale;
+ emm1 = e[m-1] / scale;
+ sl = s[l] / scale;
+ el = e[l] / scale;
+ b = ((smm1 + sm) * (smm1 - sm) + emm1 * emm1) / 2.f;
+ c = sm * emm1; c *= c;
+ if (b == 0.f && c == 0.f) {
+ shift = 0.f;
+ }
+ else {
+ shift = sqrtf(b * b + c);
+ if (b < 0.f) {
+ shift = -shift;
+ }
+ shift = c / (b + shift);
+ }
+ f = (sl + sm) * (sl - sm) + shift;
+ g = sl * el;
+
+/* chase zeros. */
+
+ for (k = l; k < m; ++k) {
+ srotg_(&f, &g, &cs, &sn);
+ if (k != l) {
+ e[k-1] = f;
+ }
+ f = cs * s[k] + sn * e[k];
+ e[k] = cs * e[k] - sn * s[k];
+ g = sn * s[k+1];
+ s[k+1] *= cs;
+ if (wantv) {
+ srot_(p, &v[k * *ldv], &c__1, &v[(k+1) * *ldv], &c__1, &cs, &sn);
+ }
+ srotg_(&f, &g, &cs, &sn);
+ s[k] = f;
+ f = cs * e[k] + sn * s[k+1];
+ s[k+1] = -sn * e[k] + cs * s[k+1];
+ g = sn * e[k+1];
+ e[k+1] *= cs;
+ if (wantu && k+1 < *n) {
+ srot_(n, &u[k * *ldu], &c__1, &u[(k+1) * *ldu], &c__1, &cs, &sn);
+ }
+ }
+ e[m-1] = f;
+ ++iter;
+ goto L360;
+
+/* convergence. */
+
+L570:
+
+/* make the singular value positive. */
+
+ if (s[l] < 0.f) {
+ s[l] = -s[l];
+ if (wantv) {
+ sscal_(p, &c_m1, &v[l * *ldv], &c__1);
+ }
+ }
+
+/* order the singular value. */
+
+L590:
+ if (l == mm) {
+ goto L600;
+ }
+ if (s[l] >= s[l+1]) {
+ goto L600;
+ }
+ t = s[l];
+ s[l] = s[l+1];
+ s[l+1] = t;
+ if (wantv && l+1 < *p) {
+ sswap_(p, &v[l * *ldv], &c__1, &v[(l+1) * *ldv], &c__1);
+ }
+ if (wantu && l+1 < *n) {
+ sswap_(n, &u[l * *ldu], &c__1, &u[(l+1) * *ldu], &c__1);
+ }
+ ++l;
+ goto L590;
+L600:
+ iter = 0;
+ --m;
+ goto L360;
+} /* ssvdc_ */
+
+static int fsm_ieee_floats_equal(const real *x, const real *y)
+{
+ return *x == *y;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..e153246cc6f78ab2438cf8d957a25b17b3122750
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ssvdc.f
@@ -0,0 +1,481 @@
+ subroutine ssvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info)
+ integer ldx,n,p,ldu,ldv,job,info
+ real x(ldx,1),s(1),e(1),u(ldu,1),v(ldv,1),work(1)
+c
+c
+c ssvdc is a subroutine to reduce a real nxp matrix x by
+c orthogonal transformations u and v to diagonal form. the
+c diagonal elements s(i) are the singular values of x. the
+c columns of u are the corresponding left singular vectors,
+c and the columns of v the right singular vectors.
+c
+c on entry
+c
+c x real(ldx,p), where ldx.ge.n.
+c x contains the matrix whose singular value
+c decomposition is to be computed. x is
+c destroyed by ssvdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c ldu integer.
+c ldu is the leading dimension of the array u.
+c (see below).
+c
+c ldv integer.
+c ldv is the leading dimension of the array v.
+c (see below).
+c
+c work real(n).
+c work is a scratch array.
+c
+c job integer.
+c job controls the computation of the singular
+c vectors. it has the decimal expansion ab
+c with the following meaning
+c
+c a.eq.0 do not compute the left singular
+c vectors.
+c a.eq.1 return the n left singular vectors
+c in u.
+c a.ge.2 return the first min(n,p) singular
+c vectors in u.
+c b.eq.0 do not compute the right singular
+c vectors.
+c b.eq.1 return the right singular vectors
+c in v.
+c
+c on return
+c
+c s real(mm), where mm=min(n+1,p).
+c the first min(n,p) entries of s contain the
+c singular values of x arranged in descending
+c order of magnitude.
+c
+c e real(p).
+c e ordinarily contains zeros. however see the
+c discussion of info for exceptions.
+c
+c u real(ldu,k), where ldu.ge.n. if joba.eq.1 then
+c k.eq.n, if joba.ge.2 then
+c k.eq.min(n,p).
+c u contains the matrix of left singular vectors.
+c u is not referenced if joba.eq.0. if n.le.p
+c or if joba.eq.2, then u may be identified with x
+c in the subroutine call.
+c
+c v real(ldv,p), where ldv.ge.p.
+c v contains the matrix of right singular vectors.
+c v is not referenced if job.eq.0. if p.le.n,
+c then v may be identified with x in the
+c subroutine call.
+c
+c info integer.
+c the singular values (and their corresponding
+c singular vectors) s(info+1),s(info+2),...,s(m)
+c are correct (here m=min(n,p)). thus if
+c info.eq.0, all the singular values and their
+c vectors are correct. in any event, the matrix
+c b = trans(u)*x*v is the bidiagonal matrix
+c with the elements of s on its diagonal and the
+c elements of e on its super-diagonal (trans(u)
+c is the transpose of u). thus the singular
+c values of x and b are the same.
+c
+c linpack. this version dated 03/19/79 .
+c correction to shift calculation made 2/85.
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c ***** uses the following functions and subprograms.
+c
+c external srot
+c blas saxpy,sdot,sscal,sswap,snrm2,srotg
+c fortran abs,amax1,max0,min0,mod,sqrt
+c
+c internal variables
+c
+ integer i,iter,j,jobu,k,kase,kk,l,ll,lls,lm1,lp1,ls,lu,m,maxit,
+ * mm,mm1,mp1,nct,nctp1,ncu,nrt,nrtp1
+ real sdot,t,r
+ real b,c,cs,el,emm1,f,g,snrm2,scale,shift,sl,sm,sn,smm1,t1,test,
+ * ztest
+ logical wantu,wantv
+c
+c
+c set the maximum number of iterations.
+c
+ maxit = 50
+c
+c determine what is to be computed.
+c
+ wantu = .false.
+ wantv = .false.
+ jobu = mod(job,100)/10
+ ncu = n
+ if (jobu .gt. 1) ncu = min0(n,p)
+ if (jobu .ne. 0) wantu = .true.
+ if (mod(job,10) .ne. 0) wantv = .true.
+c
+c reduce x to bidiagonal form, storing the diagonal elements
+c in s and the super-diagonal elements in e.
+c
+ info = 0
+ nct = min0(n-1,p)
+ nrt = max0(0,min0(p-2,n))
+ lu = max0(nct,nrt)
+ if (lu .lt. 1) go to 170
+ do 160 l = 1, lu
+ lp1 = l + 1
+ if (l .gt. nct) go to 20
+c
+c compute the transformation for the l-th column and
+c place the l-th diagonal in s(l).
+c
+ s(l) = snrm2(n-l+1,x(l,l),1)
+ if (s(l) .eq. 0.0e0) go to 10
+ if (x(l,l) .ne. 0.0e0) s(l) = sign(s(l),x(l,l))
+ call sscal(n-l+1,1.0e0/s(l),x(l,l),1)
+ x(l,l) = 1.0e0 + x(l,l)
+ 10 continue
+ s(l) = -s(l)
+ 20 continue
+ if (p .lt. lp1) go to 50
+ do 40 j = lp1, p
+ if (l .gt. nct) go to 30
+ if (s(l) .eq. 0.0e0) go to 30
+c
+c apply the transformation.
+c
+ t = -sdot(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call saxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ 30 continue
+c
+c place the l-th row of x into e for the
+c subsequent calculation of the row transformation.
+c
+ e(j) = x(l,j)
+ 40 continue
+ 50 continue
+ if (.not.wantu .or. l .gt. nct) go to 70
+c
+c place the transformation in u for subsequent back
+c multiplication.
+c
+ do 60 i = l, n
+ u(i,l) = x(i,l)
+ 60 continue
+ 70 continue
+ if (l .gt. nrt) go to 150
+c
+c compute the l-th row transformation and place the
+c l-th super-diagonal in e(l).
+c
+ e(l) = snrm2(p-l,e(lp1),1)
+ if (e(l) .eq. 0.0e0) go to 80
+ if (e(lp1) .ne. 0.0e0) e(l) = sign(e(l),e(lp1))
+ call sscal(p-l,1.0e0/e(l),e(lp1),1)
+ e(lp1) = 1.0e0 + e(lp1)
+ 80 continue
+ e(l) = -e(l)
+ if (lp1 .gt. n .or. e(l) .eq. 0.0e0) go to 120
+c
+c apply the transformation.
+c
+ do 90 i = lp1, n
+ work(i) = 0.0e0
+ 90 continue
+ do 100 j = lp1, p
+ call saxpy(n-l,e(j),x(lp1,j),1,work(lp1),1)
+ 100 continue
+ do 110 j = lp1, p
+ call saxpy(n-l,-e(j)/e(lp1),work(lp1),1,x(lp1,j),1)
+ 110 continue
+ 120 continue
+ if (.not.wantv) go to 140
+c
+c place the transformation in v for subsequent
+c back multiplication.
+c
+ do 130 i = lp1, p
+ v(i,l) = e(i)
+ 130 continue
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c set up the final bidiagonal matrix or order m.
+c
+ m = min0(p,n+1)
+ nctp1 = nct + 1
+ nrtp1 = nrt + 1
+ if (nct .lt. p) s(nctp1) = x(nctp1,nctp1)
+ if (n .lt. m) s(m) = 0.0e0
+ if (nrtp1 .lt. m) e(nrtp1) = x(nrtp1,m)
+ e(m) = 0.0e0
+c
+c if required, generate u.
+c
+ if (.not.wantu) go to 300
+ if (ncu .lt. nctp1) go to 200
+ do 190 j = nctp1, ncu
+ do 180 i = 1, n
+ u(i,j) = 0.0e0
+ 180 continue
+ u(j,j) = 1.0e0
+ 190 continue
+ 200 continue
+ if (nct .lt. 1) go to 290
+ do 280 ll = 1, nct
+ l = nct - ll + 1
+ if (s(l) .eq. 0.0e0) go to 250
+ lp1 = l + 1
+ if (ncu .lt. lp1) go to 220
+ do 210 j = lp1, ncu
+ t = -sdot(n-l+1,u(l,l),1,u(l,j),1)/u(l,l)
+ call saxpy(n-l+1,t,u(l,l),1,u(l,j),1)
+ 210 continue
+ 220 continue
+ call sscal(n-l+1,-1.0e0,u(l,l),1)
+ u(l,l) = 1.0e0 + u(l,l)
+ lm1 = l - 1
+ if (lm1 .lt. 1) go to 240
+ do 230 i = 1, lm1
+ u(i,l) = 0.0e0
+ 230 continue
+ 240 continue
+ go to 270
+ 250 continue
+ do 260 i = 1, n
+ u(i,l) = 0.0e0
+ 260 continue
+ u(l,l) = 1.0e0
+ 270 continue
+ 280 continue
+ 290 continue
+ 300 continue
+c
+c if it is required, generate v.
+c
+ if (.not.wantv) go to 350
+ do 340 ll = 1, p
+ l = p - ll + 1
+ lp1 = l + 1
+ if (l .gt. nrt) go to 320
+ if (e(l) .eq. 0.0e0) go to 320
+ do 310 j = lp1, p
+ t = -sdot(p-l,v(lp1,l),1,v(lp1,j),1)/v(lp1,l)
+ call saxpy(p-l,t,v(lp1,l),1,v(lp1,j),1)
+ 310 continue
+ 320 continue
+ do 330 i = 1, p
+ v(i,l) = 0.0e0
+ 330 continue
+ v(l,l) = 1.0e0
+ 340 continue
+ 350 continue
+c
+c main iteration loop for the singular values.
+c
+ mm = m
+ iter = 0
+ 360 continue
+c
+c quit if all the singular values have been found.
+c
+c ...exit
+ if (m .eq. 0) go to 620
+c
+c if too many iterations have been performed, set
+c flag and return.
+c
+ if (iter .lt. maxit) go to 370
+ info = m
+c ......exit
+ go to 620
+ 370 continue
+c
+c this section of the program inspects for
+c negligible elements in the s and e arrays. on
+c completion the variables kase and l are set as follows.
+c
+c kase = 1 if s(m) and e(l-1) are negligible and l.lt.m
+c kase = 2 if s(l) is negligible and l.lt.m
+c kase = 3 if e(l-1) is negligible, l.lt.m, and
+c s(l), ..., s(m) are not negligible (qr step).
+c kase = 4 if e(m-1) is negligible (convergence).
+c
+ do 390 ll = 1, m
+ l = m - ll
+c ...exit
+ if (l .eq. 0) go to 400
+ test = abs(s(l)) + abs(s(l+1))
+ ztest = test + abs(e(l))
+ if (ztest .ne. test) go to 380
+ e(l) = 0.0e0
+c ......exit
+ go to 400
+ 380 continue
+ 390 continue
+ 400 continue
+ if (l .ne. m - 1) go to 410
+ kase = 4
+ go to 480
+ 410 continue
+ lp1 = l + 1
+ mp1 = m + 1
+ do 430 lls = lp1, mp1
+ ls = m - lls + lp1
+c ...exit
+ if (ls .eq. l) go to 440
+ test = 0.0e0
+ if (ls .ne. m) test = test + abs(e(ls))
+ if (ls .ne. l + 1) test = test + abs(e(ls-1))
+ ztest = test + abs(s(ls))
+ if (ztest .ne. test) go to 420
+ s(ls) = 0.0e0
+c ......exit
+ go to 440
+ 420 continue
+ 430 continue
+ 440 continue
+ if (ls .ne. l) go to 450
+ kase = 3
+ go to 470
+ 450 continue
+ if (ls .ne. m) go to 460
+ kase = 1
+ go to 470
+ 460 continue
+ kase = 2
+ l = ls
+ 470 continue
+ 480 continue
+ l = l + 1
+c
+c perform the task indicated by kase.
+c
+ go to (490,520,540,570), kase
+c
+c deflate negligible s(m).
+c
+ 490 continue
+ mm1 = m - 1
+ f = e(m-1)
+ e(m-1) = 0.0e0
+ do 510 kk = l, mm1
+ k = mm1 - kk + l
+ t1 = s(k)
+ call srotg(t1,f,cs,sn)
+ s(k) = t1
+ if (k .eq. l) go to 500
+ f = -sn*e(k-1)
+ e(k-1) = cs*e(k-1)
+ 500 continue
+ if (wantv) call srot(p,v(1,k),1,v(1,m),1,cs,sn)
+ 510 continue
+ go to 610
+c
+c split at negligible s(l).
+c
+ 520 continue
+ f = e(l-1)
+ e(l-1) = 0.0e0
+ do 530 k = l, m
+ t1 = s(k)
+ call srotg(t1,f,cs,sn)
+ s(k) = t1
+ f = -sn*e(k)
+ e(k) = cs*e(k)
+ if (wantu) call srot(n,u(1,k),1,u(1,l-1),1,cs,sn)
+ 530 continue
+ go to 610
+c
+c perform one qr step.
+c
+ 540 continue
+c
+c calculate the shift.
+c
+ scale = amax1(abs(s(m)),abs(s(m-1)),abs(e(m-1)),abs(s(l)),
+ * abs(e(l)))
+ sm = s(m)/scale
+ smm1 = s(m-1)/scale
+ emm1 = e(m-1)/scale
+ sl = s(l)/scale
+ el = e(l)/scale
+ b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0e0
+ c = (sm*emm1)**2
+ shift = 0.0e0
+ if (b .eq. 0.0e0 .and. c .eq. 0.0e0) go to 550
+ shift = sqrt(b**2+c)
+ if (b .lt. 0.0e0) shift = -shift
+ shift = c/(b + shift)
+ 550 continue
+ f = (sl + sm)*(sl - sm) + shift
+ g = sl*el
+c
+c chase zeros.
+c
+ mm1 = m - 1
+ do 560 k = l, mm1
+ call srotg(f,g,cs,sn)
+ if (k .ne. l) e(k-1) = f
+ f = cs*s(k) + sn*e(k)
+ e(k) = cs*e(k) - sn*s(k)
+ g = sn*s(k+1)
+ s(k+1) = cs*s(k+1)
+ if (wantv) call srot(p,v(1,k),1,v(1,k+1),1,cs,sn)
+ call srotg(f,g,cs,sn)
+ s(k) = f
+ f = cs*e(k) + sn*s(k+1)
+ s(k+1) = -sn*e(k) + cs*s(k+1)
+ g = sn*e(k+1)
+ e(k+1) = cs*e(k+1)
+ if (wantu .and. k .lt. n)
+ * call srot(n,u(1,k),1,u(1,k+1),1,cs,sn)
+ 560 continue
+ e(m-1) = f
+ iter = iter + 1
+ go to 610
+c
+c convergence.
+c
+ 570 continue
+c
+c make the singular value positive.
+c
+ if (s(l) .ge. 0.0e0) go to 580
+ s(l) = -s(l)
+ if (wantv) call sscal(p,-1.0e0,v(1,l),1)
+ 580 continue
+c
+c order the singular value.
+c
+ 590 if (l .eq. mm) go to 600
+c ...exit
+ if (s(l) .ge. s(l+1)) go to 600
+ t = s(l)
+ s(l) = s(l+1)
+ s(l+1) = t
+ if (wantv .and. l .lt. p)
+ * call sswap(p,v(1,l),1,v(1,l+1),1)
+ if (wantu .and. l .lt. n)
+ * call sswap(n,u(1,l),1,u(1,l+1),1)
+ l = l + 1
+ go to 590
+ 600 continue
+ iter = 0
+ m = m - 1
+ 610 continue
+ go to 360
+ 620 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.c
new file mode 100644
index 0000000000000000000000000000000000000000..cfe28e750e0ade0c828b38a4b9d687d452430aea
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.c
@@ -0,0 +1,58 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void sswap_(n, sx, incx, sy, incy)
+const integer *n;
+real *sx;
+const integer *incx;
+real *sy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, m;
+ static real stemp;
+ static integer ix, iy;
+
+/* interchanges two vectors. */
+/* uses unrolled loops for increments equal to 1. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ m = *n % 3;
+ for (i = 0; i < m; ++i) {
+ stemp = sx[i];
+ sx[i] = sy[i];
+ sy[i] = stemp;
+ }
+ for (i = m; i < *n; i += 3) {
+ stemp = sx[i];
+ sx[i] = sy[i];
+ sy[i] = stemp;
+ stemp = sx[i + 1];
+ sx[i + 1] = sy[i + 1];
+ sy[i + 1] = stemp;
+ stemp = sx[i + 2];
+ sx[i + 2] = sy[i + 2];
+ sy[i + 2] = stemp;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ stemp = sx[ix];
+ sx[ix] = sy[iy];
+ sy[iy] = stemp;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* sswap_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.f
new file mode 100644
index 0000000000000000000000000000000000000000..ef0722272c311e2ae78c9534cce7ada948e61603
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/sswap.f
@@ -0,0 +1,56 @@
+ subroutine sswap (n,sx,incx,sy,incy)
+c
+c interchanges two vectors.
+c uses unrolled loops for increments equal to 1.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ real sx(*),sy(*),stemp
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ stemp = sx(ix)
+ sx(ix) = sy(iy)
+ sy(iy) = stemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,3)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ stemp = sx(i)
+ sx(i) = sy(i)
+ sy(i) = stemp
+ 30 continue
+ if( n .lt. 3 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,3
+ stemp = sx(i)
+ sx(i) = sy(i)
+ sy(i) = stemp
+ stemp = sx(i + 1)
+ sx(i + 1) = sy(i + 1)
+ sy(i + 1) = stemp
+ stemp = sx(i + 2)
+ sx(i + 2) = sy(i + 2)
+ sy(i + 2) = stemp
+ 50 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.c
new file mode 100644
index 0000000000000000000000000000000000000000..89166f8e4303b4152c065331c1d0ce721ac0b465
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.c
@@ -0,0 +1,504 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static real c_b13 = 0.f;
+static real c_b14 = 1.f;
+static integer c__1 = 1;
+static real c_b43 = -1.f;
+
+/* Subroutine */ void stgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *tola, real *tolb,
+ real *alpha, real *beta, real *u, integer *ldu,
+ real *v, integer *ldv, real *q, integer *ldq,
+ real *work, integer *ncycle, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+ real r__1;
+
+ /* Local variables */
+ static integer i, j;
+ static real gamma;
+ static real a1;
+ static logical initq;
+ static real a2, a3, b1;
+ static logical initu, initv, wantq, upper;
+ static real b2, b3;
+ static logical wantu, wantv;
+ static real error, ssmin;
+ static integer kcycle;
+ static real csq, csu, csv, snq, rwk, snu, snv;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* STGSJA computes the generalized singular value decomposition (GSVD) */
+/* of two real upper triangular (or trapezoidal) matrices A and B. */
+/* */
+/* On entry, it is assumed that matrices A and B have the following */
+/* forms, which may be obtained by the preprocessing subroutine SGGSVP */
+/* from a general M-by-N matrix A and P-by-N matrix B: */
+/* */
+/* N-K-L K L */
+/* A = K ( 0 A12 A13 ) if M-K-L >= 0; */
+/* L ( 0 0 A23 ) */
+/* M-K-L ( 0 0 0 ) */
+/* */
+/* N-K-L K L */
+/* A = K ( 0 A12 A13 ) if M-K-L < 0; */
+/* M-K ( 0 0 A23 ) */
+/* */
+/* N-K-L K L */
+/* B = L ( 0 0 B13 ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular */
+/* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0, */
+/* otherwise A23 is (M-K)-by-L upper trapezoidal. */
+/* */
+/* On exit, */
+/* */
+/* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ), */
+/* */
+/* where U, V and Q are orthogonal matrices, Z' denotes the transpose */
+/* of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are */
+/* ``diagonal'' matrices, which are of the following structures: */
+/* */
+/* If M-K-L >= 0, */
+/* */
+/* K L */
+/* D1 = K ( I 0 ) */
+/* L ( 0 C ) */
+/* M-K-L ( 0 0 ) */
+/* */
+/* K L */
+/* D2 = L ( 0 S ) */
+/* P-L ( 0 0 ) */
+/* */
+/* N-K-L K L */
+/* ( 0 R ) = K ( 0 R11 R12 ) K */
+/* L ( 0 0 R22 ) L */
+/* */
+/* where */
+/* */
+/* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */
+/* S = diag( BETA(K+1), ... , BETA(K+L) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R is stored in A(1:K+L,N-K-L+1:N) on exit. */
+/* */
+/* If M-K-L < 0, */
+/* */
+/* K M-K K+L-M */
+/* D1 = K ( I 0 0 ) */
+/* M-K ( 0 C 0 ) */
+/* */
+/* K M-K K+L-M */
+/* D2 = M-K ( 0 S 0 ) */
+/* K+L-M ( 0 0 I ) */
+/* P-L ( 0 0 0 ) */
+/* */
+/* N-K-L K M-K K+L-M */
+/* ( 0 R ) = K ( 0 R11 R12 R13 ) */
+/* M-K ( 0 0 R22 R23 ) */
+/* K+L-M ( 0 0 0 R33 ) */
+/* */
+/* where */
+/* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */
+/* S = diag( BETA(K+1), ... , BETA(M) ), */
+/* C**2 + S**2 = I. */
+/* */
+/* R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored */
+/* ( 0 R22 R23 ) */
+/* in B(M-K+1:L,N+M-K-L+1:N) on exit. */
+/* */
+/* The computation of the orthogonal transformation matrices U, V or Q */
+/* is optional. These matrices may either be formed explicitly, or they */
+/* may be postmultiplied into input matrices U1, V1, or Q1. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBU (input) CHARACTER*1 */
+/* = 'U': U must contain an orthogonal matrix U1 on entry, and */
+/* the product U1*U is returned; */
+/* = 'I': U is initialized to the unit matrix, and the */
+/* orthogonal matrix U is returned; */
+/* = 'N': U is not computed. */
+/* */
+/* JOBV (input) CHARACTER*1 */
+/* = 'V': V must contain an orthogonal matrix V1 on entry, and */
+/* the product V1*V is returned; */
+/* = 'I': V is initialized to the unit matrix, and the */
+/* orthogonal matrix V is returned; */
+/* = 'N': V is not computed. */
+/* */
+/* JOBQ (input) CHARACTER*1 */
+/* = 'Q': Q must contain an orthogonal matrix Q1 on entry, and */
+/* the product Q1*Q is returned; */
+/* = 'I': Q is initialized to the unit matrix, and the */
+/* orthogonal matrix Q is returned; */
+/* = 'N': Q is not computed. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* P (input) INTEGER */
+/* The number of rows of the matrix B. P >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrices A and B. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* L (input) INTEGER */
+/* K and L specify the subblocks in the input matrices A and B: */
+/* A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N) */
+/* of A and B, whose GSVD is going to be computed by STGSJA. */
+/* See Further details. */
+/* */
+/* A (input/output) REAL array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular */
+/* matrix R or part of R. See Purpose for details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (input/output) REAL array, dimension (LDB,N) */
+/* On entry, the P-by-N matrix B. */
+/* On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains */
+/* a part of R. See Purpose for details. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,P). */
+/* */
+/* TOLA (input) REAL */
+/* TOLB (input) REAL */
+/* TOLA and TOLB are the convergence criteria for the Jacobi- */
+/* Kogbetliantz iteration procedure. Generally, they are the */
+/* same as used in the preprocessing step, say */
+/* TOLA = max(M,N)*norm(A)*MACHEPS, */
+/* TOLB = max(P,N)*norm(B)*MACHEPS. */
+/* */
+/* ALPHA (output) REAL array, dimension (N) */
+/* BETA (output) REAL array, dimension (N) */
+/* On exit, ALPHA and BETA contain the generalized singular */
+/* value pairs of A and B; */
+/* ALPHA(1:K) = 1, */
+/* BETA(1:K) = 0, */
+/* and if M-K-L >= 0, */
+/* ALPHA(K+1:K+L) = diag(C), */
+/* BETA(K+1:K+L) = diag(S), */
+/* or if M-K-L < 0, */
+/* ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0 */
+/* BETA(K+1:M) = S, BETA(M+1:K+L) = 1. */
+/* Furthermore, if K+L < N, */
+/* ALPHA(K+L+1:N) = 0 and */
+/* BETA(K+L+1:N) = 0. */
+/* */
+/* U (input/output) REAL array, dimension (LDU,M) */
+/* On entry, if JOBU = 'U', U must contain a matrix U1 (usually */
+/* the orthogonal matrix returned by SGGSVP). */
+/* On exit, */
+/* if JOBU = 'I', U contains the orthogonal matrix U; */
+/* if JOBU = 'U', U contains the product U1*U. */
+/* If JOBU = 'N', U is not referenced. */
+/* */
+/* LDU (input) INTEGER */
+/* The leading dimension of the array U. LDU >= max(1,M) if */
+/* JOBU = 'U'; LDU >= 1 otherwise. */
+/* */
+/* V (input/output) REAL array, dimension (LDV,P) */
+/* On entry, if JOBV = 'V', V must contain a matrix V1 (usually */
+/* the orthogonal matrix returned by SGGSVP). */
+/* On exit, */
+/* if JOBV = 'I', V contains the orthogonal matrix V; */
+/* if JOBV = 'V', V contains the product V1*V. */
+/* If JOBV = 'N', V is not referenced. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,P) if */
+/* JOBV = 'V'; LDV >= 1 otherwise. */
+/* */
+/* Q (input/output) REAL array, dimension (LDQ,N) */
+/* On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually */
+/* the orthogonal matrix returned by SGGSVP). */
+/* On exit, */
+/* if JOBQ = 'I', Q contains the orthogonal matrix Q; */
+/* if JOBQ = 'Q', Q contains the product Q1*Q. */
+/* If JOBQ = 'N', Q is not referenced. */
+/* */
+/* LDQ (input) INTEGER */
+/* The leading dimension of the array Q. LDQ >= max(1,N) if */
+/* JOBQ = 'Q'; LDQ >= 1 otherwise. */
+/* */
+/* WORK (workspace) REAL array, dimension (2*N) */
+/* */
+/* NCYCLE (output) INTEGER */
+/* The number of cycles required for convergence. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* = 1: the procedure does not converge after MAXIT cycles. */
+/* */
+/* Internal Parameters */
+/* =================== */
+/* */
+/* MAXIT INTEGER */
+/* MAXIT specifies the total loops that the iterative procedure */
+/* may take. If after MAXIT cycles, the routine fails to */
+/* converge, we return INFO = 1. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* STGSJA essentially uses a variant of Kogbetliantz algorithm to reduce */
+/* min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L */
+/* matrix B13 to the form: */
+/* */
+/* U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1, */
+/* */
+/* where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose */
+/* of Z. C1 and S1 are diagonal matrices satisfying */
+/* */
+/* C1**2 + S1**2 = I, */
+/* */
+/* and R1 is an L-by-L nonsingular upper triangular matrix. */
+/* */
+/* ===================================================================== */
+
+/* Decode and test the input parameters */
+
+ initu = lsame_(jobu, "I");
+ wantu = initu || lsame_(jobu, "U");
+
+ initv = lsame_(jobv, "I");
+ wantv = initv || lsame_(jobv, "V");
+
+ initq = lsame_(jobq, "I");
+ wantq = initq || lsame_(jobq, "Q");
+
+ *info = 0;
+ if (! (initu || wantu || lsame_(jobu, "N"))) {
+ *info = -1;
+ } else if (! (initv || wantv || lsame_(jobv, "N"))) {
+ *info = -2;
+ } else if (! (initq || wantq || lsame_(jobq, "N"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*p < 0) {
+ *info = -5;
+ } else if (*n < 0) {
+ *info = -6;
+ } else if (*lda < max(1,*m)) {
+ *info = -10;
+ } else if (*ldb < max(1,*p)) {
+ *info = -12;
+ } else if (*ldu < 1 || (wantu && *ldu < *m)) {
+ *info = -18;
+ } else if (*ldv < 1 || (wantv && *ldv < *p)) {
+ *info = -20;
+ } else if (*ldq < 1 || (wantq && *ldq < *n)) {
+ *info = -22;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("STGSJA", &i__1);
+ return;
+ }
+
+/* Initialize U, V and Q, if necessary */
+
+ if (initu) {
+ slaset_("Full", m, m, &c_b13, &c_b14, u, ldu);
+ }
+ if (initv) {
+ slaset_("Full", p, p, &c_b13, &c_b14, v, ldv);
+ }
+ if (initq) {
+ slaset_("Full", n, n, &c_b13, &c_b14, q, ldq);
+ }
+
+/* Loop until convergence */
+
+ upper = FALSE_;
+ for (kcycle = 1; kcycle <= 40; ++kcycle) {
+ upper = ! upper;
+ for (i = 0; i < *l; ++i) {
+ for (j = i + 1; j < *l; ++j) {
+ a1 = a2 = a3 = 0.f;
+ if (*k + i < *m) {
+ a1 = a[*k + i + (*n - *l + i) * *lda];
+ }
+ if (*k + j < *m) {
+ a3 = a[*k + j + (*n - *l + j) * *lda];
+ }
+
+ b1 = b[i + (*n - *l + i) * *ldb];
+ b3 = b[j + (*n - *l + j) * *ldb];
+
+ if (upper) {
+ if (*k + i < *m) {
+ a2 = a[*k + i + (*n - *l + j) * *lda];
+ }
+ b2 = b[i + (*n - *l + j) * *ldb];
+ } else {
+ if (*k + j < *m) {
+ a2 = a[*k + j + (*n - *l + i) * *lda];
+ }
+ b2 = b[j + (*n - *l + i) * *ldb];
+ }
+
+ slags2_(&upper, &a1, &a2, &a3, &b1, &b2, &b3, &csu, &snu, &csv, &snv, &csq, &snq);
+
+/* Update (K+I)-th and (K+J)-th rows of matrix A: U'*A */
+
+ if (*k + j < *m) {
+ srot_(l, &a[*k + j + (*n - *l) * *lda], lda, &a[*k + i + (*n - *l) * *lda], lda, &csu, &snu);
+ }
+
+/* Update I-th and J-th rows of matrix B: V'*B */
+
+ srot_(l, &b[j + (*n - *l) * *ldb], ldb, &b[i + (*n - *l) * *ldb], ldb, &csv, &snv);
+
+/* Update (N-L+I)-th and (N-L+J)-th columns of matrices */
+/* A and B: A*Q and B*Q */
+
+ i__1 = min(*k + *l,*m);
+ srot_(&i__1, &a[(*n - *l + j) * *lda], &c__1, &a[(*n - *l + i) * *lda], &c__1, &csq, &snq);
+ srot_(l, &b[(*n - *l + j) * *ldb], &c__1, &b[(*n - *l + i) * *ldb], &c__1, &csq, &snq);
+
+ if (upper) {
+ if (*k + i < *m) {
+ a[*k + i + (*n - *l + j) * *lda] = 0.f;
+ }
+ b[i + (*n - *l + j) * *ldb] = 0.f;
+ } else {
+ if (*k + j < *m) {
+ a[*k + j + (*n - *l + i) * *lda] = 0.f;
+ }
+ b[j + (*n - *l + i) * *ldb] = 0.f;
+ }
+
+/* Update orthogonal matrices U, V, Q, if desired. */
+
+ if (wantu && *k + j < *m) {
+ srot_(m, &u[(*k + j) * *ldu], &c__1, &u[(*k + i) * *ldu], &c__1, &csu, &snu);
+ }
+
+ if (wantv) {
+ srot_(p, &v[j * *ldv], &c__1, &v[i * *ldv], &c__1, &csv, &snv);
+ }
+
+ if (wantq) {
+ srot_(n, &q[(*n - *l + j) * *ldq], &c__1, &q[(*n - *l + i) * *ldq], &c__1, &csq, &snq);
+ }
+ }
+ }
+
+ if (! upper) {
+
+/* The matrices A13 and B13 were lower triangular at the start */
+/* of the cycle, and are now upper triangular. */
+
+/* Convergence test: test the parallelism of the corresponding */
+/* rows of A and B. */
+
+ error = 0.f;
+ for (i = 0; i < min(*l,*m - *k); ++i) {
+ i__1 = *l - i;
+ scopy_(&i__1, &a[*k + i + (*n - *l + i) * *lda], lda, work, &c__1);
+ scopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &work[*l], &c__1);
+ slapll_(&i__1, work, &c__1, &work[*l], &c__1, &ssmin);
+ error = max(error,ssmin);
+ }
+
+ if (abs(error) <= (real) (*n) * min(*tola,*tolb)) {
+ goto L50;
+ }
+ }
+/* End of cycle loop */
+ }
+
+/* The algorithm has not converged after MAXIT cycles. */
+
+ *info = 1;
+ *ncycle = kcycle;
+ return;
+
+L50:
+
+/* If ERROR <= N*MIN(TOLA,TOLB), then the algorithm has converged. */
+/* Compute the generalized singular value pairs (ALPHA, BETA), and */
+/* set the triangular matrix R to array A. */
+
+ for (i = 0; i < *k; ++i) {
+ alpha[i] = 1.f;
+ beta[i] = 0.f;
+ }
+
+ for (i = 0; i < min(*l,*m - *k); ++i) {
+ a1 = a[*k + i + (*n - *l + i) * *lda];
+ b1 = b[i + (*n - *l + i) * *ldb];
+
+ if (a1 != 0.f) {
+ gamma = b1 / a1;
+
+/* change sign if necessary */
+
+ if (gamma < 0.f) {
+ i__1 = *l - i;
+ sscal_(&i__1, &c_b43, &b[i + (*n - *l + i) * *ldb], ldb);
+ if (wantv) {
+ sscal_(p, &c_b43, &v[i * *ldv], &c__1);
+ }
+ }
+
+ r__1 = abs(gamma);
+ slartg_(&r__1, &c_b14, &beta[*k + i], &alpha[*k + i], &rwk);
+
+ if (alpha[*k + i] >= beta[*k + i]) {
+ i__1 = *l - i;
+ r__1 = 1.f / alpha[*k + i];
+ sscal_(&i__1, &r__1, &a[*k + i + (*n - *l + i) * *lda], lda);
+ } else {
+ i__1 = *l - i;
+ r__1 = 1.f / beta[*k + i];
+ sscal_(&i__1, &r__1, &b[i + (*n - *l + i) * *ldb], ldb);
+ scopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &a[*k + i + (*n - *l + i) * *lda], lda);
+ }
+ } else {
+ alpha[*k + i] = 0.f;
+ beta[*k + i] = 1.f;
+ i__1 = *l - i;
+ scopy_(&i__1, &b[i + (*n - *l + i) * *ldb], ldb, &a[*k + i + (*n - *l + i) * *lda], lda);
+ }
+ }
+
+/* Post-assignment */
+
+ for (i = *m; i < *k + *l; ++i) {
+ alpha[i] = 0.f;
+ beta[i] = 1.f;
+ }
+
+ if (*k + *l < *n) {
+ for (i = *k + *l; i < *n; ++i) {
+ alpha[i] = 0.f;
+ beta[i] = 0.f;
+ }
+ }
+
+ *ncycle = kcycle;
+ return;
+
+} /* stgsja_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.f
new file mode 100644
index 0000000000000000000000000000000000000000..6c2df37b1d43e09fb66859f4e51ddea65d898fef
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/stgsja.f
@@ -0,0 +1,516 @@
+ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B,
+ $ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV,
+ $ Q, LDQ, WORK, NCYCLE, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBQ, JOBU, JOBV
+ INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N,
+ $ NCYCLE, P
+ REAL TOLA, TOLB
+* ..
+* .. Array Arguments ..
+ REAL ALPHA( * ), BETA( * ), A( LDA, * ),
+ $ B( LDB, * ), Q( LDQ, * ), U( LDU, * ),
+ $ V( LDV, * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* STGSJA computes the generalized singular value decomposition (GSVD)
+* of two real upper triangular (or trapezoidal) matrices A and B.
+*
+* On entry, it is assumed that matrices A and B have the following
+* forms, which may be obtained by the preprocessing subroutine SGGSVP
+* from a general M-by-N matrix A and P-by-N matrix B:
+*
+* N-K-L K L
+* A = K ( 0 A12 A13 ) if M-K-L >= 0;
+* L ( 0 0 A23 )
+* M-K-L ( 0 0 0 )
+*
+* N-K-L K L
+* A = K ( 0 A12 A13 ) if M-K-L < 0;
+* M-K ( 0 0 A23 )
+*
+* N-K-L K L
+* B = L ( 0 0 B13 )
+* P-L ( 0 0 0 )
+*
+* where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
+* upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
+* otherwise A23 is (M-K)-by-L upper trapezoidal.
+*
+* On exit,
+*
+* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ),
+*
+* where U, V and Q are orthogonal matrices, Z' denotes the transpose
+* of Z, R is a nonsingular upper triangular matrix, and D1 and D2 are
+* ``diagonal'' matrices, which are of the following structures:
+*
+* If M-K-L >= 0,
+*
+* K L
+* D1 = K ( I 0 )
+* L ( 0 C )
+* M-K-L ( 0 0 )
+*
+* K L
+* D2 = L ( 0 S )
+* P-L ( 0 0 )
+*
+* N-K-L K L
+* ( 0 R ) = K ( 0 R11 R12 ) K
+* L ( 0 0 R22 ) L
+*
+* where
+*
+* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ),
+* S = diag( BETA(K+1), ... , BETA(K+L) ),
+* C**2 + S**2 = I.
+*
+* R is stored in A(1:K+L,N-K-L+1:N) on exit.
+*
+* If M-K-L < 0,
+*
+* K M-K K+L-M
+* D1 = K ( I 0 0 )
+* M-K ( 0 C 0 )
+*
+* K M-K K+L-M
+* D2 = M-K ( 0 S 0 )
+* K+L-M ( 0 0 I )
+* P-L ( 0 0 0 )
+*
+* N-K-L K M-K K+L-M
+* ( 0 R ) = K ( 0 R11 R12 R13 )
+* M-K ( 0 0 R22 R23 )
+* K+L-M ( 0 0 0 R33 )
+*
+* where
+* C = diag( ALPHA(K+1), ... , ALPHA(M) ),
+* S = diag( BETA(K+1), ... , BETA(M) ),
+* C**2 + S**2 = I.
+*
+* R = ( R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N) and R33 is stored
+* ( 0 R22 R23 )
+* in B(M-K+1:L,N+M-K-L+1:N) on exit.
+*
+* The computation of the orthogonal transformation matrices U, V or Q
+* is optional. These matrices may either be formed explicitly, or they
+* may be postmultiplied into input matrices U1, V1, or Q1.
+*
+* Arguments
+* =========
+*
+* JOBU (input) CHARACTER*1
+* = 'U': U must contain an orthogonal matrix U1 on entry, and
+* the product U1*U is returned;
+* = 'I': U is initialized to the unit matrix, and the
+* orthogonal matrix U is returned;
+* = 'N': U is not computed.
+*
+* JOBV (input) CHARACTER*1
+* = 'V': V must contain an orthogonal matrix V1 on entry, and
+* the product V1*V is returned;
+* = 'I': V is initialized to the unit matrix, and the
+* orthogonal matrix V is returned;
+* = 'N': V is not computed.
+*
+* JOBQ (input) CHARACTER*1
+* = 'Q': Q must contain an orthogonal matrix Q1 on entry, and
+* the product Q1*Q is returned;
+* = 'I': Q is initialized to the unit matrix, and the
+* orthogonal matrix Q is returned;
+* = 'N': Q is not computed.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* P (input) INTEGER
+* The number of rows of the matrix B. P >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrices A and B. N >= 0.
+*
+* K (input) INTEGER
+* L (input) INTEGER
+* K and L specify the subblocks in the input matrices A and B:
+* A23 = A(K+1:MIN(K+L,M),N-L+1:N) and B13 = B(1:L,N-L+1:N)
+* of A and B, whose GSVD is going to be computed by STGSJA.
+* See Further details.
+*
+* A (input/output) REAL array, dimension (LDA,N)
+* On entry, the M-by-N matrix A.
+* On exit, A(N-K+1:N,1:MIN(K+L,M) ) contains the triangular
+* matrix R or part of R. See Purpose for details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (input/output) REAL array, dimension (LDB,N)
+* On entry, the P-by-N matrix B.
+* On exit, if necessary, B(M-K+1:L,N+M-K-L+1:N) contains
+* a part of R. See Purpose for details.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,P).
+*
+* TOLA (input) REAL
+* TOLB (input) REAL
+* TOLA and TOLB are the convergence criteria for the Jacobi-
+* Kogbetliantz iteration procedure. Generally, they are the
+* same as used in the preprocessing step, say
+* TOLA = max(M,N)*norm(A)*MACHEPS,
+* TOLB = max(P,N)*norm(B)*MACHEPS.
+*
+* ALPHA (output) REAL array, dimension (N)
+* BETA (output) REAL array, dimension (N)
+* On exit, ALPHA and BETA contain the generalized singular
+* value pairs of A and B;
+* ALPHA(1:K) = 1,
+* BETA(1:K) = 0,
+* and if M-K-L >= 0,
+* ALPHA(K+1:K+L) = diag(C),
+* BETA(K+1:K+L) = diag(S),
+* or if M-K-L < 0,
+* ALPHA(K+1:M)= C, ALPHA(M+1:K+L)= 0
+* BETA(K+1:M) = S, BETA(M+1:K+L) = 1.
+* Furthermore, if K+L < N,
+* ALPHA(K+L+1:N) = 0 and
+* BETA(K+L+1:N) = 0.
+*
+* U (input/output) REAL array, dimension (LDU,M)
+* On entry, if JOBU = 'U', U must contain a matrix U1 (usually
+* the orthogonal matrix returned by SGGSVP).
+* On exit,
+* if JOBU = 'I', U contains the orthogonal matrix U;
+* if JOBU = 'U', U contains the product U1*U.
+* If JOBU = 'N', U is not referenced.
+*
+* LDU (input) INTEGER
+* The leading dimension of the array U. LDU >= max(1,M) if
+* JOBU = 'U'; LDU >= 1 otherwise.
+*
+* V (input/output) REAL array, dimension (LDV,P)
+* On entry, if JOBV = 'V', V must contain a matrix V1 (usually
+* the orthogonal matrix returned by SGGSVP).
+* On exit,
+* if JOBV = 'I', V contains the orthogonal matrix V;
+* if JOBV = 'V', V contains the product V1*V.
+* If JOBV = 'N', V is not referenced.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,P) if
+* JOBV = 'V'; LDV >= 1 otherwise.
+*
+* Q (input/output) REAL array, dimension (LDQ,N)
+* On entry, if JOBQ = 'Q', Q must contain a matrix Q1 (usually
+* the orthogonal matrix returned by SGGSVP).
+* On exit,
+* if JOBQ = 'I', Q contains the orthogonal matrix Q;
+* if JOBQ = 'Q', Q contains the product Q1*Q.
+* If JOBQ = 'N', Q is not referenced.
+*
+* LDQ (input) INTEGER
+* The leading dimension of the array Q. LDQ >= max(1,N) if
+* JOBQ = 'Q'; LDQ >= 1 otherwise.
+*
+* WORK (workspace) REAL array, dimension (2*N)
+*
+* NCYCLE (output) INTEGER
+* The number of cycles required for convergence.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* = 1: the procedure does not converge after MAXIT cycles.
+*
+* Internal Parameters
+* ===================
+*
+* MAXIT INTEGER
+* MAXIT specifies the total loops that the iterative procedure
+* may take. If after MAXIT cycles, the routine fails to
+* converge, we return INFO = 1.
+*
+* Further Details
+* ===============
+*
+* STGSJA essentially uses a variant of Kogbetliantz algorithm to reduce
+* min(L,M-K)-by-L triangular (or trapezoidal) matrix A23 and L-by-L
+* matrix B13 to the form:
+*
+* U1'*A13*Q1 = C1*R1; V1'*B13*Q1 = S1*R1,
+*
+* where U1, V1 and Q1 are orthogonal matrix, and Z' is the transpose
+* of Z. C1 and S1 are diagonal matrices satisfying
+*
+* C1**2 + S1**2 = I,
+*
+* and R1 is an L-by-L nonsingular upper triangular matrix.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER MAXIT
+ PARAMETER ( MAXIT = 40 )
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+*
+ LOGICAL INITQ, INITU, INITV, UPPER, WANTQ, WANTU, WANTV
+ INTEGER I, J, KCYCLE
+ REAL A1, A2, A3, B1, B2, B3, CSQ, CSU, CSV, ERROR,
+ $ RWK, SSMIN, SNQ, SNU, SNV, GAMMA
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL SCOPY, SLAGS2, SLAPLL, SLASET, SROT, SSCAL,
+ $ SLARTG, XERBLA
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, REAL
+* ..
+* .. Executable Statements ..
+*
+* Decode and test the input parameters
+*
+ INITU = LSAME( JOBU, 'I' )
+ WANTU = INITU .OR. LSAME( JOBU, 'U' )
+*
+ INITV = LSAME( JOBV, 'I' )
+ WANTV = INITV .OR. LSAME( JOBV, 'V' )
+*
+ INITQ = LSAME( JOBQ, 'I' )
+ WANTQ = INITQ .OR. LSAME( JOBQ, 'Q' )
+*
+ INFO = 0
+ IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
+ INFO = -3
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( P.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -10
+ ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
+ INFO = -12
+ ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
+ INFO = -18
+ ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
+ INFO = -20
+ ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
+ INFO = -22
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'STGSJA', -INFO )
+ RETURN
+ END IF
+*
+* Initialize U, V and Q, if necessary
+*
+ IF( INITU )
+ $ CALL SLASET( 'Full', M, M, ZERO, ONE, U, LDU )
+ IF( INITV )
+ $ CALL SLASET( 'Full', P, P, ZERO, ONE, V, LDV )
+ IF( INITQ )
+ $ CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDQ )
+*
+* Loop until convergence
+*
+ UPPER = .FALSE.
+ DO 40 KCYCLE = 1, MAXIT
+*
+ UPPER = .NOT.UPPER
+*
+ DO 20 I = 1, L - 1
+ DO 10 J = I + 1, L
+*
+ A1 = ZERO
+ A2 = ZERO
+ A3 = ZERO
+ IF( K+I.LE.M )
+ $ A1 = A( K+I, N-L+I )
+ IF( K+J.LE.M )
+ $ A3 = A( K+J, N-L+J )
+*
+ B1 = B( I, N-L+I )
+ B3 = B( J, N-L+J )
+*
+ IF( UPPER ) THEN
+ IF( K+I.LE.M )
+ $ A2 = A( K+I, N-L+J )
+ B2 = B( I, N-L+J )
+ ELSE
+ IF( K+J.LE.M )
+ $ A2 = A( K+J, N-L+I )
+ B2 = B( J, N-L+I )
+ END IF
+*
+ CALL SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU,
+ $ CSV, SNV, CSQ, SNQ )
+*
+* Update (K+I)-th and (K+J)-th rows of matrix A: U'*A
+*
+ IF( K+J.LE.M )
+ $ CALL SROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ),
+ $ LDA, CSU, SNU )
+*
+* Update I-th and J-th rows of matrix B: V'*B
+*
+ CALL SROT( L, B( J, N-L+1 ), LDB, B( I, N-L+1 ), LDB,
+ $ CSV, SNV )
+*
+* Update (N-L+I)-th and (N-L+J)-th columns of matrices
+* A and B: A*Q and B*Q
+*
+ CALL SROT( MIN( K+L, M ), A( 1, N-L+J ), 1,
+ $ A( 1, N-L+I ), 1, CSQ, SNQ )
+*
+ CALL SROT( L, B( 1, N-L+J ), 1, B( 1, N-L+I ), 1, CSQ,
+ $ SNQ )
+*
+ IF( UPPER ) THEN
+ IF( K+I.LE.M )
+ $ A( K+I, N-L+J ) = ZERO
+ B( I, N-L+J ) = ZERO
+ ELSE
+ IF( K+J.LE.M )
+ $ A( K+J, N-L+I ) = ZERO
+ B( J, N-L+I ) = ZERO
+ END IF
+*
+* Update orthogonal matrices U, V, Q, if desired.
+*
+ IF( WANTU .AND. K+J.LE.M )
+ $ CALL SROT( M, U( 1, K+J ), 1, U( 1, K+I ), 1, CSU,
+ $ SNU )
+*
+ IF( WANTV )
+ $ CALL SROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV )
+*
+ IF( WANTQ )
+ $ CALL SROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ,
+ $ SNQ )
+*
+ 10 CONTINUE
+ 20 CONTINUE
+*
+ IF( .NOT.UPPER ) THEN
+*
+* The matrices A13 and B13 were lower triangular at the start
+* of the cycle, and are now upper triangular.
+*
+* Convergence test: test the parallelism of the corresponding
+* rows of A and B.
+*
+ ERROR = ZERO
+ DO 30 I = 1, MIN( L, M-K )
+ CALL SCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 )
+ CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 )
+ CALL SLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN )
+ ERROR = MAX( ERROR, SSMIN )
+ 30 CONTINUE
+*
+ IF( ABS( ERROR ).LE.REAL( N )*MIN( TOLA, TOLB ) )
+ $ GO TO 50
+ END IF
+*
+* End of cycle loop
+*
+ 40 CONTINUE
+*
+* The algorithm has not converged after MAXIT cycles.
+*
+ INFO = 1
+ GO TO 90
+*
+ 50 CONTINUE
+*
+* If ERROR <= N*MIN(TOLA,TOLB), then the algorithm has converged.
+* Compute the generalized singular value pairs (ALPHA, BETA), and
+* set the triangular matrix R to array A.
+*
+ DO 60 I = 1, K
+ ALPHA( I ) = ONE
+ BETA( I ) = ZERO
+ 60 CONTINUE
+*
+ DO 70 I = 1, MIN( L, M-K )
+*
+ A1 = A( K+I, N-L+I )
+ B1 = B( I, N-L+I )
+*
+ IF( A1.NE.ZERO ) THEN
+ GAMMA = B1 / A1
+*
+* change sign if necessary
+*
+ IF( GAMMA.LT.ZERO )THEN
+ CALL SSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB )
+ IF( WANTV )
+ $ CALL SSCAL( P, -ONE, V( 1, I ), 1 )
+ END IF
+*
+ CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ),
+ $ RWK )
+*
+ IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN
+ CALL SSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ),
+ $ LDA )
+ ELSE
+ CALL SSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ),
+ $ LDB )
+ CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
+ $ LDA )
+ END IF
+*
+ ELSE
+*
+ ALPHA( K+I ) = ZERO
+ BETA( K+I ) = ONE
+ CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ),
+ $ LDA )
+*
+ END IF
+*
+ 70 CONTINUE
+*
+* Post-assignment
+*
+ DO 80 I = M + 1, K + L
+ ALPHA( I ) = ZERO
+ BETA( I ) = ONE
+ 80 CONTINUE
+*
+ IF( K+L.LT.N )THEN
+ DO 85 I = K + L + 1, N
+ ALPHA( I ) = ZERO
+ BETA( I ) = ZERO
+ 85 CONTINUE
+ END IF
+*
+ 90 CONTINUE
+ NCYCLE = KCYCLE
+ RETURN
+*
+* End of STGSJA
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/svsort.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/svsort.f
new file mode 100644
index 0000000000000000000000000000000000000000..1a2087496ef3ce17e6f5f1a7c841ad37ee0f64b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/svsort.f
@@ -0,0 +1,31 @@
+C
+C-------------------------------------------------------------------
+C
+ SUBROUTINE SVSORT(NUM, VAL, RES, IFLAG, V, NMVEC, N, VEC)
+ INTEGER NUM, IFLAG, NMVEC, N
+ REAL VAL(1), RES(1), V(1), VEC(NMVEC,1)
+C
+C THIS SUBROUTINE SORTS THE EIGENVALUES (VAL) IN ASCENDING ORDER
+C WHILE CONCURRENTLY SWAPPING THE RESIDUALS AND VECTORS.
+ INTEGER I, K, M
+ REAL TEMP
+ IF(NUM .LE. 1) RETURN
+ DO 20 I = 2, NUM
+ M = NUM - I + 1
+ DO 10 K = 1, M
+ IF(VAL(K) .LE. VAL(K+1)) GO TO 10
+ TEMP = VAL(K)
+ VAL(K) = VAL(K+1)
+ VAL(K+1) = TEMP
+ TEMP = RES(K)
+ RES(K) = RES(K+1)
+ RES(K+1) = TEMP
+ CALL SSWAP(N, VEC(1,K), 1, VEC(1,K+1), 1)
+ IF(IFLAG .EQ. 0) GO TO 10
+ TEMP = V(K)
+ V(K) = V(K+1)
+ V(K+1) = TEMP
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..503838b9d24e67a34b4c069ed58912e6ed099e04
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/CMakeLists.txt
@@ -0,0 +1,21 @@
+SET(EXECUTABLE_OUTPUT_PATH ${vxl_BINARY_DIR}/v3p/netlib/tests)
+
+IF(BUILD_TESTING)
+ LINK_LIBRARIES( netlib )
+
+ # test
+ ADD_EXECUTABLE( netlib_lbfgs_example lbfgs-example.c )
+ ADD_TEST( netlib_test_lbfgs netlib_lbfgs_example )
+ # test
+ ADD_EXECUTABLE( netlib_lsqr_test lsqr-test.c )
+ ADD_TEST( netlib_test_lsqr netlib_lsqr_test )
+ # test
+ ADD_EXECUTABLE( netlib_slamch_test slamch-test.c )
+ ADD_TEST( netlib_test_slamch netlib_slamch_test )
+ # test
+ ADD_EXECUTABLE( netlib_tricall tricall.c )
+ ADD_TEST( netlib_test_tricall netlib_tricall )
+ # test
+ ADD_EXECUTABLE( netlib_integral_test integral-test.c )
+ ADD_TEST( netlib_test_integral netlib_integral_test )
+ENDIF(BUILD_TESTING)
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/integral-test.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/integral-test.c
new file mode 100644
index 0000000000000000000000000000000000000000..6373628f935a51c2e13c57fcf55d6e0e6543b638
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/integral-test.c
@@ -0,0 +1,56 @@
+#include "../f2c.h"
+#include "../netlib.h"
+#include <stdio.h>
+
+double f(double *x)
+{
+ return (*x)/(1+(*x)*(*x));
+}
+
+void test_simpson_integral()
+{
+ double a = 0;
+ double b = 1;
+ double res;
+ int n = 100;
+
+ simpru_(&f, &a, &b, &n, &res);
+ printf("simpson integral of x/(1+x^2) from 0 to 1 (%d grids) is %2.10f\n", n, res);
+}
+
+void test_adapted_simpson_integral()
+{
+ double a = 0;
+ double b = 1;
+ double res;
+ int n = 100;
+ double rmat[1111];
+ double tol = 1e-10;
+ double errbound;
+ int stat;
+
+ adaptquad_(&f, &a, &b, &tol, rmat, &res, &errbound, &n, &stat);
+ printf("adapted simpson integral (with tol=%g) of x/(1+x^2) from 0 to 1 (%d grids) is %2.10f\n", tol, n, res);
+ printf("errbound is %f, state is %d\n", errbound, stat);
+}
+
+void test_trapezod_integral()
+{
+ double a = 0;
+ double b = 1;
+ double res;
+ int n = 500;
+
+ trapru_(&f, &a, &b, &n, &res);
+ printf("trapezod integral of x/(1+x^2) from 0 to 1 (%d grids) is %f\n", n, res);
+}
+
+
+
+int main()
+{
+ test_simpson_integral();
+ test_adapted_simpson_integral();
+ test_trapezod_integral();
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lbfgs-example.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lbfgs-example.c
new file mode 100644
index 0000000000000000000000000000000000000000..77a20a519360c831bb22b9074868cb23e57c0bc9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lbfgs-example.c
@@ -0,0 +1,106 @@
+/* lbfgs-example.f -- translated by f2c (version of 23 April 1993 18:34:30).
+ You must link the resulting object file with the libraries:
+ -lf2c -lm (in that order)
+*/
+
+#include "../f2c.h"
+#include "../netlib.h"
+#include <stdio.h>
+/* Common Block Declarations */
+
+Extern struct {
+ integer mp, lp;
+ doublereal gtol, stpmin, stpmax;
+} lb3_;
+
+#define lb3_1 lb3_
+
+
+/* *********************** */
+/* SIMPLE DRIVER FOR LBFGS */
+/* *********************** */
+
+/* Example of driver for LBFGS routine, using a */
+/* simple test problem. The solution point is at */
+/* X=(1,...,1) and the optimal function value of 0. */
+
+/* JORGE NOCEDAL */
+/* *** July 1990 *** */
+
+/* Main program */ int main(void)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal diag[2000], xtol;
+ static doublereal f, g[2000];
+ static integer j, m, n, iflag, icall;
+ static doublereal w[30014], x[2000];
+ static doublereal t1, t2;
+ static logical diagco;
+ static integer iprint[2];
+ static doublereal eps;
+
+
+/* The driver for LBFGS must always declare LB2 as EXTERNAL */
+
+
+ lb3_1.lp = 1;
+ n = 100;
+ m = 5;
+ iprint[0] = 1;
+ iprint[1] = 0;
+
+/* We do not wish to provide the diagonal matrices Hk0, and */
+/* therefore set DIAGCO to FALSE. */
+
+ diagco = FALSE_;
+ eps = 1e-5;
+ xtol = 1e-16;
+ icall = 0;
+ iflag = 0;
+ i__1 = n;
+ for (j = 1; j <= i__1; j += 2) {
+ x[j - 1] = -1.2;
+ x[j] = 1.;
+/* L10: */
+ }
+
+L20:
+ f = 0.;
+ i__1 = n;
+ for (j = 1; j <= i__1; j += 2) {
+ t1 = 1. - x[j - 1];
+/* Computing 2nd power */
+ d__1 = x[j - 1];
+ t2 = (x[j] - d__1 * d__1) * 10.;
+ g[j] = t2 * 20.;
+ g[j - 1] = (x[j - 1] * g[j] + t1) * -2.;
+/* Computing 2nd power */
+ d__1 = t1;
+/* Computing 2nd power */
+ d__2 = t2;
+ f = f + d__1 * d__1 + d__2 * d__2;
+/* L30: */
+ }
+ lbfgs_(&n, &m, x, &f, g, &diagco, diag, iprint, &eps, &xtol, w, &iflag);
+ printf("f = %7g\n", f);
+ if (iflag <= 0) {
+ goto L50;
+ }
+ ++icall;
+/* We allow at most 2000 evaluations of F and G */
+ if (icall > 2000) {
+ goto L50;
+ }
+ goto L20;
+L50:
+ printf("f = %7g\n", f);
+ printf("iterations = %16d\n", icall);
+
+ return 0;
+} /* main */
+
+/* Main program alias */ int sdrive_ (void); int sdrive_() { return main (); }
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lsqr-test.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lsqr-test.c
new file mode 100644
index 0000000000000000000000000000000000000000..bf2bb3aa6ee77f7f9a80585eecfde3b7c1ebefb1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/lsqr-test.c
@@ -0,0 +1,389 @@
+/* lsqr-test.f -- translated by f2c (version of 23 April 1993 18:34:30).
+ You must link the resulting object file with the libraries:
+ -lf2c -lm (in that order)
+*/
+/* Peter Vanroose - May 2002 - re-inserted FORTRAN output format, now using printf() */
+
+#include "../f2c.h"
+#include "../netlib.h"
+#include <stdio.h>
+extern double sin(double), cos(double), sqrt(double);
+
+/* Subroutine */ void lstp_(int*m, int*n, int*nduplc, int*npower, double*damp, double*x, double*b, double*d,
+ double*hy, double*hz, double*w, double*acond, double*rnorm);
+
+/* Subroutine */ void aprod_(int*mode, int*m, int*n, double*x, double*y, int*leniw, int*lenrw, int*iw, double*rw);
+/* Subroutine */ void hprod_(int*n, double*hz, double*x, double*y);
+/* Subroutine */ void aprod1_(int*m, int*n, double*x, double*y, double*d, double*hy, double*hz, double*w);
+/* Subroutine */ void aprod2_(int*m, int*n, double*x, double*y, double*d, double*hy, double*hz, double*w);
+
+/* Subroutine */ void test_(int*m, int*n, int*nduplc, int*npower, double*damp);
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__600 = 600;
+static doublereal c_m1 = -1.;
+static integer c__2 = 2;
+static integer c__40 = 40;
+static integer c__4 = 4;
+static integer c__80 = 80;
+
+/* ****************************************************** */
+/* */
+/* WARNING. Delete the following imitation BLAS routines */
+/* if a genuine BLAS library is available. */
+/* */
+/* ****************************************************** */
+/* */
+/* SUBROUTINE DCOPY ( N,X,INCX,Y,INCY ) */
+/* INTEGER N,INCX,INCY */
+/* DOUBLE PRECISION X(N),Y(N) */
+/* */
+/* This may be replaced by the corresponding BLAS routine.*/
+/* The following is a simple version for use with LSQR. */
+/* */
+/* DO 10 I = 1, N */
+/* Y(I) = X(I) */
+/* 10 CONTINUE */
+/* RETURN */
+/* */
+/* END OF DCOPY */
+/* END */
+/* DOUBLE PRECISION FUNCTION DNRM2 ( N,X,INCX ) */
+/* INTEGER N,INCX */
+/* DOUBLE PRECISION X(N) */
+/* */
+/* This may be replaced by the corresponding BLAS routine.*/
+/* The following is a simple version for use with LSQR. */
+/* */
+/* INTEGER I */
+/* DOUBLE PRECISION D, DSQRT */
+/* */
+/* D = 0.0 */
+/* DO 10 I = 1, N */
+/* D = D + X(I)**2 */
+/* 10 CONTINUE */
+/* DNRM2 = DSQRT(D) */
+/* RETURN */
+/* */
+/* END OF DNRM2 */
+/* END */
+/* SUBROUTINE DSCAL ( N,A,X,INCX ) */
+/* INTEGER N,INCX */
+/* DOUBLE PRECISION A,X(N) */
+/* */
+/* This may be replaced by the corresponding BLAS routine.*/
+/* The following is a simple version for use with LSQR. */
+/* */
+/* DO 10 I = 1, N */
+/* X(I) = A*X(I) */
+/* 10 CONTINUE */
+/* RETURN */
+/* */
+/* END OF DSCAL */
+/* END */
+
+/* ******************************************************** */
+/* */
+/* These routines are for testing LSQR. */
+/* */
+/* ******************************************************** */
+
+/* Subroutine */ void aprod_(mode, m, n, x, y, leniw, lenrw, iw, rw)
+integer *mode, *m, *n;
+doublereal *x, *y;
+integer *leniw, *lenrw, *iw; /* these three parameters are unused */
+doublereal *rw;
+{
+/* ------------------------------------------------------------------ */
+/* This is the matrix-vector product routine required by LSQR */
+/* for a test matrix of the form A = HY*D*HZ. The quantities */
+/* defining D, HY, HZ are in the work array RW, followed by a */
+/* work array W. These are passed to APROD1 and APROD2 in order to */
+/* make the code readable. */
+/* ------------------------------------------------------------------ */
+
+ if (*mode == 1)
+ aprod1_(m, n, x, y, rw, rw + *n, rw + *n + *m, rw + *n + *m + *n);
+ else
+ aprod2_(m, n, x, y, rw, rw + *n, rw + *n + *m, rw + *n + *m + *n);
+} /* aprod_ */
+
+/* Subroutine */ void aprod1_(m, n, x, y, d, hy, hz, w)
+integer *m, *n;
+doublereal *x, *y, *d, *hy, *hz, *w;
+{
+ /* Local variables */
+ static integer i;
+
+/* ------------------------------------------------------------------ */
+/* APROD1 computes Y = Y + A*X for subroutine APROD, */
+/* where A is a test matrix of the form A = HY*D*HZ, */
+/* and the latter matrices HY, D, HZ are represented by */
+/* input vectors with the same name. */
+/* ------------------------------------------------------------------ */
+
+ hprod_(n, hz, x, w);
+ for (i = 0; i < *n; ++i) w[i] = d[i] * w[i];
+ for (i = *n; i < *m; ++i) w[i] = 0.;
+ hprod_(m, hy, w, w);
+ for (i = 0; i < *m; ++i) y[i] += w[i];
+} /* aprod1_ */
+
+/* Subroutine */ void aprod2_(m, n, x, y, d, hy, hz, w)
+integer *m, *n;
+doublereal *x, *y, *d, *hy, *hz, *w;
+{
+ /* Local variables */
+ static integer i;
+
+/* ------------------------------------------------------------------ */
+/* APROD2 computes X = X + A(T)*Y for subroutine APROD, */
+/* where A is a test matrix of the form A = HY*D*HZ, */
+/* and the latter matrices HY, D, HZ are represented by */
+/* input vectors with the same name. */
+/* ------------------------------------------------------------------ */
+
+ hprod_(m, hy, y, w);
+ for (i = 0; i < *n; ++i) w[i] = d[i] * w[i];
+ hprod_(n, hz, w, w);
+ for (i = 0; i < *n; ++i) x[i] += w[i];
+} /* aprod2_ */
+
+/* Subroutine */ void hprod_(n, hz, x, y)
+integer *n;
+doublereal *hz, *x, *y;
+{
+ /* Local variables */
+ static integer i;
+ static doublereal s;
+
+/* ------------------------------------------------------------------ */
+/* HPROD applies a Householder transformation stored in HZ */
+/* to get Y = ( I - 2*HZ*HZ(transpose) ) * X. */
+/* ------------------------------------------------------------------ */
+
+ s = 0.0;
+ for (i = 0; i < *n; ++i)
+ s += hz[i] * x[i];
+ s += s;
+ for (i = 0; i < *n; ++i)
+ y[i] = x[i] - s * hz[i];
+} /* hprod_ */
+
+/* Subroutine */ void lstp_(m, n, nduplc, npower, damp, x, b, d, hy, hz, w, acond, rnorm)
+integer *m, *n, *nduplc, *npower;
+doublereal *damp, *x, *b, *d, *hy, *hz, *w, *acond, *rnorm;
+{
+ /* System generated locals */
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal alfa, beta;
+ static integer i, j;
+ static doublereal t;
+ static doublereal dampsq, fourpi;
+
+/* ------------------------------------------------------------------ */
+/* LSTP generates a sparse least-squares test problem of the form */
+/* */
+/* ( A )*X = ( B ) */
+/* ( DAMP*I ) ( 0 ) */
+/* */
+/* having a specified solution X. The matrix A is constructed */
+/* in the form A = HY*D*HZ, where D is an M by N diagonal matrix, */
+/* and HY and HZ are Householder transformations. */
+/* */
+/* The first 6 parameters are input to LSTP. The remainder are */
+/* output. LSTP is intended for use with M .GE. N. */
+/* */
+/* */
+/* Functions and subroutines */
+/* */
+/* TESTPROB APROD1, HPROD */
+/* BLAS DNRM2 */
+/* ------------------------------------------------------------------ */
+/* Intrinsics and local variables */
+/* ------------------------------------------------------------------ */
+/* Make two vectors of norm 1.0 for the Householder transformations. */
+/* FOURPI need not be exact. */
+/* ------------------------------------------------------------------ */
+
+ dampsq = *damp * *damp;
+ fourpi = 12.566368000000001f;
+ alfa = fourpi / *m;
+ beta = fourpi / *n;
+ for (i = 0; i < *m; ++i)
+ hy[i] = sin((i+1) * alfa);
+ for (i = 0; i < *n; ++i)
+ hz[i] = cos((i+1) * beta);
+ alfa = dnrm2_(m, hy, &c__1);
+ beta = dnrm2_(n, hz, &c__1);
+ d__1 = -1./alfa; dscal_(m, &d__1, hy, &c__1);
+ d__1 = -1./beta; dscal_(n, &d__1, hz, &c__1);
+
+/* ------------------------------------------------------------------ */
+/* Set the diagonal matrix D. These are the singular values of A. */
+/* ------------------------------------------------------------------ */
+ for (i = 0; i < *n; ++i) {
+ j = (i + *nduplc) / *nduplc;
+ t = (doublereal) (j * *nduplc);
+ t /= *n;
+ d[i] = pow_di(&t, npower);
+ }
+ *acond = sqrt((d[*n-1] * d[*n-1] + dampsq) / (d[0] * d[0] + dampsq));
+/* ------------------------------------------------------------------ */
+/* Compute the residual vector, storing it in B. */
+/* It takes the form HY*( s ) */
+/* ( t ) */
+/* where s is obtained from D*s = DAMP**2 * HZ * X */
+/* and t can be anything. */
+/* ------------------------------------------------------------------ */
+ hprod_(n, hz, x, b);
+ for (i = 0; i < *n; ++i)
+ b[i] = dampsq * b[i] / d[i];
+ t = 1.;
+ for (i = *n; i < *m; ++i) {
+ j = i + 1 - *n;
+ b[i] = t * j / *m;
+ t = -t;
+ }
+ hprod_(m, hy, b, b);
+/* ------------------------------------------------------------------ */
+/* Now compute the true B = RESIDUAL + A*X. */
+/* ------------------------------------------------------------------ */
+ d__1 = dnrm2_(m, b, &c__1);
+ d__2 = dnrm2_(n, x, &c__1);
+ *rnorm = sqrt(d__1 * d__1 + dampsq * (d__2 * d__2));
+ aprod1_(m, n, x, b, d, hy, hz, w);
+} /* lstp_ */
+
+/* Subroutine */ void test_(m, n, nduplc, npower, damp)
+integer *m, *n, *nduplc, *npower;
+doublereal *damp;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal atol, btol;
+ static integer nout;
+ static doublereal b[200];
+ static integer j;
+ static doublereal acond, u[200], v[100], w[100], x[100];
+ static doublereal anorm;
+ static doublereal enorm;
+ static doublereal rnorm;
+ static integer istop;
+ static doublereal xnorm, xtrue[100], se[100];
+ static integer iw[1];
+ static doublereal rw[600], conlim, dampsq;
+ static integer itnlim;
+ static doublereal arnorm;
+ static integer ltotal, itn;
+
+/* ------------------------------------------------------------------ */
+/* This is an example driver routine for running LSQR. */
+/* It generates a test problem, solves it, and examines the results. */
+/* Note that subroutine APROD must be declared EXTERNAL */
+/* if it is used only in the call to LSQR. */
+
+/* Functions and subroutines */
+/* */
+/* TESTPROB APROD */
+/* BLAS DCOPY, DNRM2, DSCAL */
+/* ------------------------------------------------------------------ */
+
+/* Set the desired solution XTRUE. */
+ for (j = 0; j < *n; ++j) {
+ xtrue[j] = (doublereal) (*n - j - 1);
+ }
+/* Generate the specified test problem. */
+/* The workspace array IW is not needed in this application. */
+/* The workspace array RW is used for the following vectors: */
+/* D(N), HY(M), HZ(N), W(MAX(M,N)). */
+/* The vectors D, HY, HZ will define the test matrix A. */
+/* W is needed for workspace in APROD1 and APROD2. */
+ ltotal = *n + *m + *n + max(*m,*n);
+ if (ltotal > 600) {
+ /* Not enough workspace. */
+ printf("\n XXX Insufficient workspace. The length of RW should be at least %d\n", ltotal);
+ return;
+ }
+ lstp_(m, n, nduplc, npower, damp, xtrue, b, rw, rw + *n, rw + *n + *m, rw + *n + *m + *n, &acond, &rnorm);
+/* Solve the problem defined by APROD, DAMP and B. */
+/* Copy the rhs vector B into U (LSQR will overwrite U) */
+/* and set the other input parameters for LSQR. */
+ dcopy_(m, b, &c__1, u, &c__1);
+ atol = 1e-10f;
+ btol = atol;
+ conlim = acond * 10.f;
+ itnlim = *m + *n + 50;
+ printf("\n\n --------------------------------------------------------------------\n");
+ printf(" Least-Squares Test Problem P( %d %d %d %d %12.2e )\n\n", *m,*n,*nduplc,*npower,*damp);
+ printf(" Condition no. =%12.4e Residual function =%17.9e\n", acond, rnorm);
+ printf(" --------------------------------------------------------------------\n");
+ lsqr_(m, n, aprod_, damp, &c__1, &c__600, iw, rw, u, v, w, x, se, &atol, &btol, &conlim,
+ &itnlim, &nout, &istop, &itn, &anorm, &acond, &rnorm, &arnorm, &xnorm);
+/* Examine the results. */
+/* We print the residual norms RNORM and ARNORM given by LSQR, */
+/* and then compute their true values in terms of the solution X */
+/* obtained by LSQR. At least one of them should be small. */
+ dampsq = *damp * *damp;
+ printf("\n\n Residual norm Residual norm Solution norm\n");
+ printf(" (Abar X - bbar) (Normal eqns) (X)\n");
+ printf(" Estimated by LSQR%17.5e%17.5e%17.5e\n", rnorm, arnorm, xnorm);
+/* Compute U = A*X - B. */
+/* This is the negative of the usual residual vector. */
+/* It will be close to zero only if B is a compatible rhs */
+/* and X is close to a solution. */
+ dcopy_(m, b, &c__1, u, &c__1);
+ dscal_(m, &c_m1, u, &c__1);
+ aprod_(&c__1, m, n, x, u, &c__1, &c__600, iw, rw);
+/* Compute V = A(transpose)*U + DAMP**2 * X. */
+/* This will be close to zero in all cases */
+/* if X is close to a solution. */
+ dcopy_(n, x, &c__1, v, &c__1);
+ dscal_(n, &dampsq, v, &c__1);
+ aprod_(&c__2, m, n, v, u, &c__1, &c__600, iw, rw);
+/* Compute the norms associated with X, U, V. */
+ xnorm = dnrm2_(n, x, &c__1);
+ d__1 = dnrm2_(m, u, &c__1);
+ rnorm = sqrt(d__1 * d__1 + dampsq * xnorm * xnorm);
+ arnorm = dnrm2_(n, v, &c__1);
+ printf(" Computed from X %17.5e%17.5e%17.5e\n", rnorm, arnorm, xnorm);
+/* Print the solution and standard error estimates from LSQR. */
+ printf("\n\n Solution X\n");
+ for (j = 0; j < *n; ++j)
+ printf("%6d%14.6g\n", j+1, x[j]);
+ printf("\n\n Standard errors SE\n");
+ for (j = 0; j < *n; ++j)
+ printf("%6d%14.6g\n", j+1, se[j]);
+ printf("\n");
+/* Print a clue about whether the solution looks OK. */
+ for (j = 0; j < *n; ++j)
+ w[j] = x[j] - xtrue[j];
+ enorm = dnrm2_(n, w, &c__1) / (dnrm2_(n, xtrue, &c__1) + 1.);
+ if (enorm <= 1e-5)
+ printf("\n LSQR appears to be successful. Relative error in X =%10.2e\n", enorm);
+ else
+ printf("\n LSQR appears to have failed. Relative error in X =%10.2e\n", enorm);
+} /* test_ */
+
+/* ------------- */
+/* Main program. */
+/* ------------- */
+int main(void)
+{
+ static doublereal zero = 0.f;
+/* static doublereal damp1 = .1f; */
+ static doublereal damp2 = .01f;
+/* static doublereal damp3 = .001f; */
+/* static doublereal damp4 = 1e-4f; */
+ test_(&c__1, &c__1, &c__1, &c__1, &zero);
+ test_(&c__2, &c__1, &c__1, &c__1, &zero);
+ test_(&c__40, &c__40, &c__4, &c__4, &zero);
+ test_(&c__40, &c__40, &c__4, &c__4, &damp2);
+ test_(&c__80, &c__40, &c__4, &c__4, &damp2);
+ return 0;
+} /* End of main program for testing LSQR */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/slamch-test.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/slamch-test.c
new file mode 100644
index 0000000000000000000000000000000000000000..bd16cc200d04697912cfc99a4f41ad28c58916d4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/slamch-test.c
@@ -0,0 +1,19 @@
+/* slamch-test.c -- Written by Peter Vanroose, 9 November 2003 */
+#include "../f2c.h"
+#include "../netlib.h"
+#include <stdio.h>
+
+int main(void)
+{
+ printf("eps = %g\n", slamch_("E"));
+ printf("sfmin= %g\n", slamch_("S"));
+ printf("base = %g\n", slamch_("B"));
+ printf("prec = %g\n", slamch_("P"));
+ printf("t = %g\n", slamch_("N"));
+ printf("rnd = %g\n", slamch_("R"));
+ printf("emin = %g\n", slamch_("M"));
+ printf("rmin = %g\n", slamch_("U"));
+ printf("emax = %g\n", slamch_("L"));
+ printf("rmax = %g\n", slamch_("O"));
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/tricall.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/tricall.c
new file mode 100644
index 0000000000000000000000000000000000000000..210ec4ca99b4b6c66d53fb97d31d974c6abbc567
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tests/tricall.c
@@ -0,0 +1,279 @@
+/*****************************************************************************/
+/* */
+/* (tricall.c) */
+/* */
+/* Example program that demonstrates how to call Triangle. */
+/* */
+/* Accompanies Triangle Version 1.3 */
+/* July 19, 1996 */
+/* */
+/* This file is placed in the public domain (but the file that it calls */
+/* is still copyrighted!) by */
+/* Jonathan Richard Shewchuk */
+/* School of Computer Science */
+/* Carnegie Mellon University */
+/* 5000 Forbes Avenue */
+/* Pittsburgh, Pennsylvania 15213-3891 */
+/* jrs@cs.cmu.edu */
+/* */
+/*****************************************************************************/
+
+/* If SINGLE is defined when triangle.o is compiled, it should also be */
+/* defined here. If not, it should not be defined here. */
+
+/* #define SINGLE */
+
+#ifdef SINGLE
+#define REAL float
+#else /* not SINGLE */
+#define REAL double
+#endif /* not SINGLE */
+
+#include <stdio.h>
+#include "../triangle.h"
+
+#ifndef _STDLIB_H_
+extern void *malloc();
+extern void free();
+#endif /* _STDLIB_H_ */
+
+/*****************************************************************************/
+/* */
+/* report() Print the input or output. */
+/* */
+/*****************************************************************************/
+
+void report(io, markers, reporttriangles, reportneighbors, reportsegments,
+ reportedges, reportnorms)
+struct triangulateio *io;
+int markers;
+int reporttriangles;
+int reportneighbors;
+int reportsegments;
+int reportedges;
+int reportnorms;
+{
+ int i, j;
+
+ for (i = 0; i < io->numberofpoints; i++) {
+ printf("Point %4d:", i);
+ for (j = 0; j < 2; j++) {
+ printf(" %.6g", io->pointlist[i * 2 + j]);
+ }
+ if (io->numberofpointattributes > 0) {
+ printf(" attributes");
+ }
+ for (j = 0; j < io->numberofpointattributes; j++) {
+ printf(" %.6g",
+ io->pointattributelist[i * io->numberofpointattributes + j]);
+ }
+ if (markers) {
+ printf(" marker %d\n", io->pointmarkerlist[i]);
+ } else {
+ printf("\n");
+ }
+ }
+ printf("\n");
+
+ if (reporttriangles || reportneighbors) {
+ for (i = 0; i < io->numberoftriangles; i++) {
+ if (reporttriangles) {
+ printf("Triangle %4d points:", i);
+ for (j = 0; j < io->numberofcorners; j++) {
+ printf(" %4d", io->trianglelist[i * io->numberofcorners + j]);
+ }
+ if (io->numberoftriangleattributes > 0) {
+ printf(" attributes");
+ }
+ for (j = 0; j < io->numberoftriangleattributes; j++) {
+ printf(" %.6g", io->triangleattributelist[i *
+ io->numberoftriangleattributes + j]);
+ }
+ printf("\n");
+ }
+ if (reportneighbors) {
+ printf("Triangle %4d neighbors:", i);
+ for (j = 0; j < 3; j++) {
+ printf(" %4d", io->neighborlist[i * 3 + j]);
+ }
+ printf("\n");
+ }
+ }
+ printf("\n");
+ }
+
+ if (reportsegments) {
+ for (i = 0; i < io->numberofsegments; i++) {
+ printf("Segment %4d points:", i);
+ for (j = 0; j < 2; j++) {
+ printf(" %4d", io->segmentlist[i * 2 + j]);
+ }
+ if (markers) {
+ printf(" marker %d\n", io->segmentmarkerlist[i]);
+ } else {
+ printf("\n");
+ }
+ }
+ printf("\n");
+ }
+
+ if (reportedges) {
+ for (i = 0; i < io->numberofedges; i++) {
+ printf("Edge %4d points:", i);
+ for (j = 0; j < 2; j++) {
+ printf(" %4d", io->edgelist[i * 2 + j]);
+ }
+ if (reportnorms && (io->edgelist[i * 2 + 1] == -1)) {
+ for (j = 0; j < 2; j++) {
+ printf(" %.6g", io->normlist[i * 2 + j]);
+ }
+ }
+ if (markers) {
+ printf(" marker %d\n", io->edgemarkerlist[i]);
+ } else {
+ printf("\n");
+ }
+ }
+ printf("\n");
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* main() Create and refine a mesh. */
+/* */
+/*****************************************************************************/
+
+int main()
+{
+ struct triangulateio in, mid, out, vorout;
+
+ /* Define input points. */
+
+ in.numberofpoints = 4;
+ in.numberofpointattributes = 1;
+ in.pointlist = (REAL *) malloc(in.numberofpoints * 2 * sizeof(REAL));
+ in.pointlist[0] = 0.0;
+ in.pointlist[1] = 0.0;
+ in.pointlist[2] = 1.0;
+ in.pointlist[3] = 0.0;
+ in.pointlist[4] = 1.0;
+ in.pointlist[5] = 10.0;
+ in.pointlist[6] = 0.0;
+ in.pointlist[7] = 10.0;
+ in.pointattributelist = (REAL *) malloc(in.numberofpoints *
+ in.numberofpointattributes *
+ sizeof(REAL));
+ in.pointattributelist[0] = 0.0;
+ in.pointattributelist[1] = 1.0;
+ in.pointattributelist[2] = 11.0;
+ in.pointattributelist[3] = 10.0;
+ in.pointmarkerlist = (int *) malloc(in.numberofpoints * sizeof(int));
+ in.pointmarkerlist[0] = 0;
+ in.pointmarkerlist[1] = 2;
+ in.pointmarkerlist[2] = 0;
+ in.pointmarkerlist[3] = 0;
+
+ in.numberofsegments = 0;
+ in.numberofholes = 0;
+ in.numberofregions = 1;
+ in.regionlist = (REAL *) malloc(in.numberofregions * 4 * sizeof(REAL));
+ in.regionlist[0] = 0.5;
+ in.regionlist[1] = 5.0;
+ in.regionlist[2] = 7.0; /* Regional attribute (for whole mesh). */
+ in.regionlist[3] = 0.1; /* Area constraint that will not be used. */
+
+ printf("Input point set:\n\n");
+ report(&in, 1, 0, 0, 0, 0, 0);
+
+ /* Make necessary initializations so that Triangle can return a */
+ /* triangulation in `mid' and a voronoi diagram in `vorout'. */
+
+ mid.pointlist = (REAL *) NULL; /* Not needed if -N switch used. */
+ /* Not needed if -N switch used or number of point attributes is zero: */
+ mid.pointattributelist = (REAL *) NULL;
+ mid.pointmarkerlist = (int *) NULL; /* Not needed if -N or -B switch used. */
+ mid.trianglelist = (int *) NULL; /* Not needed if -E switch used. */
+ /* Not needed if -E switch used or number of triangle attributes is zero: */
+ mid.triangleattributelist = (REAL *) NULL;
+ mid.neighborlist = (int *) NULL; /* Needed only if -n switch used. */
+ /* Needed only if segments are output (-p or -c) and -P not used: */
+ mid.segmentlist = (int *) NULL;
+ /* Needed only if segments are output (-p or -c) and -P and -B not used: */
+ mid.segmentmarkerlist = (int *) NULL;
+ mid.edgelist = (int *) NULL; /* Needed only if -e switch used. */
+ mid.edgemarkerlist = (int *) NULL; /* Needed if -e used and -B not used. */
+
+ vorout.pointlist = (REAL *) NULL; /* Needed only if -v switch used. */
+ /* Needed only if -v switch used and number of attributes is not zero: */
+ vorout.pointattributelist = (REAL *) NULL;
+ vorout.edgelist = (int *) NULL; /* Needed only if -v switch used. */
+ vorout.normlist = (REAL *) NULL; /* Needed only if -v switch used. */
+
+ /* Triangulate the points. Switches are chosen to read and write a */
+ /* PSLG (p), preserve the convex hull (c), number everything from */
+ /* zero (z), assign a regional attribute to each element (A), and */
+ /* produce an edge list (e), a Voronoi diagram (v), and a triangle */
+ /* neighbor list (n). */
+
+ triangulate("pczAevn", &in, &mid, &vorout);
+
+ printf("Initial triangulation:\n\n");
+ report(&mid, 1, 1, 1, 1, 1, 0);
+ printf("Initial Voronoi diagram:\n\n");
+ report(&vorout, 0, 0, 0, 0, 1, 1);
+
+ /* Attach area constraints to the triangles in preparation for */
+ /* refining the triangulation. */
+
+ /* Needed only if -r and -a switches used: */
+ mid.trianglearealist = (REAL *) malloc(mid.numberoftriangles * sizeof(REAL));
+ mid.trianglearealist[0] = 3.0;
+ mid.trianglearealist[1] = 1.0;
+
+ /* Make necessary initializations so that Triangle can return a */
+ /* triangulation in `out'. */
+
+ out.pointlist = (REAL *) NULL; /* Not needed if -N switch used. */
+ /* Not needed if -N switch used or number of attributes is zero: */
+ out.pointattributelist = (REAL *) NULL;
+ out.trianglelist = (int *) NULL; /* Not needed if -E switch used. */
+ /* Not needed if -E switch used or number of triangle attributes is zero: */
+ out.triangleattributelist = (REAL *) NULL;
+
+ /* Refine the triangulation according to the attached */
+ /* triangle area constraints. */
+
+ triangulate("prazBP", &mid, &out, (struct triangulateio *) NULL);
+
+ printf("Refined triangulation:\n\n");
+ report(&out, 0, 1, 0, 0, 0, 0);
+
+ /* Free all allocated arrays, including those allocated by Triangle. */
+
+ free(in.pointlist);
+ free(in.pointattributelist);
+ free(in.pointmarkerlist);
+ free(in.regionlist);
+ free(mid.pointlist);
+ free(mid.pointattributelist);
+ free(mid.pointmarkerlist);
+ free(mid.trianglelist);
+ free(mid.triangleattributelist);
+ free(mid.trianglearealist);
+ free(mid.neighborlist);
+ free(mid.segmentlist);
+ free(mid.segmentmarkerlist);
+ free(mid.edgelist);
+ free(mid.edgemarkerlist);
+ free(vorout.pointlist);
+ free(vorout.pointattributelist);
+ free(vorout.edgelist);
+ free(vorout.normlist);
+ free(out.pointlist);
+ free(out.pointattributelist);
+ free(out.trianglelist);
+ free(out.triangleattributelist);
+
+ return 0;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tql1.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tql1.c
new file mode 100644
index 0000000000000000000000000000000000000000..e0c750f18d4ce519a81a3dad79a4b544f215ae16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tql1.c
@@ -0,0 +1,151 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static doublereal c_b10 = 1.;
+
+/* Subroutine */ void tql1_(n, d, e, ierr)
+const integer *n;
+doublereal *d, *e;
+integer *ierr;
+{
+ /* Local variables */
+ static doublereal c, f, g, h;
+ static integer i, j, l, m;
+ static doublereal p, r, s, c2, c3;
+ static doublereal s2;
+ static doublereal dl1, el1;
+ static doublereal tst1, tst2;
+
+/* this subroutine is a translation of the algol procedure tql1, */
+/* num. math. 11, 293-306(1968) by bowdler, martin, reinsch, and */
+/* wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 227-240(1971). */
+/* */
+/* this subroutine finds the eigenvalues of a symmetric */
+/* tridiagonal matrix by the ql method. */
+/* */
+/* on input */
+/* */
+/* n is the order of the matrix. */
+/* */
+/* d contains the diagonal elements of the input matrix. */
+/* */
+/* e contains the subdiagonal elements of the input matrix */
+/* in its last n-1 positions. e(1) is arbitrary. */
+/* */
+/* on output */
+/* */
+/* d contains the eigenvalues in ascending order. if an */
+/* error exit is made, the eigenvalues are correct and */
+/* ordered for indices 1,2,...ierr-1, but may not be */
+/* the smallest eigenvalues. */
+/* */
+/* e has been destroyed. */
+/* */
+/* ierr is set to */
+/* zero for normal return, */
+/* j if the j-th eigenvalue has not been */
+/* determined after 30 iterations. */
+/* */
+/* calls pythag for sqrt(a*a + b*b) . */
+/* */
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+/* */
+/* this version dated august 1983. */
+/* */
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ if (*n == 1) {
+ return;
+ }
+
+ for (i = 1; i < *n; ++i) {
+ e[i-1] = e[i];
+ }
+
+ f = 0.;
+ tst1 = 0.;
+ e[*n-1] = 0.;
+
+ for (l = 0; l < *n; ++l) {
+ j = 0;
+ h = abs(d[l]) + abs(e[l]);
+ if (tst1 < h) {
+ tst1 = h;
+ }
+/* .......... look for small sub-diagonal element .......... */
+ for (m = l; m < *n; ++m) {
+ tst2 = tst1 + abs(e[m]);
+ if (tst2 == tst1) {
+ break;
+ }
+/* .......... e(n) is always zero, so there is no exit */
+/* through the bottom of the loop .......... */
+ }
+
+ if (m == l) {
+ goto L210;
+ }
+L130:
+ if (j == 30) {
+/* .......... set error -- no convergence to an */
+/* eigenvalue after 30 iterations .......... */
+ *ierr = l+1;
+ return;
+ }
+ ++j;
+/* .......... form shift .......... */
+ g = d[l];
+ p = (d[l+1] - g) / (e[l] * 2.);
+ r = pythag_(&p, &c_b10);
+ d[l] = e[l] / (p + d_sign(&r, &p));
+ d[l+1] = e[l] * (p + d_sign(&r, &p));
+ dl1 = d[l+1];
+ h = g - d[l];
+
+ for (i = l+2; i < *n; ++i) {
+ d[i] -= h;
+ }
+
+ f += h;
+/* .......... ql transformation .......... */
+ p = d[m];
+ c = 1.;
+ c2 = c;
+ el1 = e[l+1];
+ s = 0.;
+ for (i = m-1; i >= l; --i) {
+ c3 = c2;
+ c2 = c;
+ s2 = s;
+ g = c * e[i];
+ h = c * p;
+ r = pythag_(&p, &e[i]);
+ e[i+1] = s * r;
+ s = e[i] / r;
+ c = p / r;
+ p = c * d[i] - s * g;
+ d[i+1] = h + s * (c * g + s * d[i]);
+ }
+
+ p = -s * s2 * c3 * el1 * e[l] / dl1;
+ e[l] = s * p;
+ d[l] = c * p;
+ tst2 = tst1 + abs(e[l]);
+ if (tst2 > tst1) {
+ goto L130;
+ }
+L210:
+ p = d[l] + f;
+/* .......... order eigenvalues .......... */
+ for (i = l; i > 0; --i) {
+ if (p >= d[i-1])
+ break;
+ d[i] = d[i-1];
+ }
+ d[i] = p;
+ }
+} /* tql1_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tql2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tql2.c
new file mode 100644
index 0000000000000000000000000000000000000000..db2d99c6b30de33166508da061ebceef98cdd6bc
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tql2.c
@@ -0,0 +1,191 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Table of constant values */
+static doublereal c_b10 = 1.;
+
+/* Subroutine */ void tql2_(nm, n, d, e, z, ierr)
+const integer *nm, *n;
+doublereal *d, *e, *z;
+integer *ierr;
+{
+ /* Local variables */
+ static doublereal c, f, g, h;
+ static integer i, j, k, l, m;
+ static doublereal p, r, s, c2, c3;
+ static doublereal s2;
+ static doublereal dl1, el1;
+ static doublereal tst1, tst2;
+
+/* this subroutine is a translation of the algol procedure tql2, */
+/* num. math. 11, 293-306(1968) by bowdler, martin, reinsch, and */
+/* wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 227-240(1971). */
+
+/* this subroutine finds the eigenvalues and eigenvectors */
+/* of a symmetric tridiagonal matrix by the ql method. */
+/* the eigenvectors of a full symmetric matrix can also */
+/* be found if tred2 has been used to reduce this */
+/* full matrix to tridiagonal form. */
+/* */
+/* on input */
+/* */
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+/* */
+/* n is the order of the matrix. */
+/* */
+/* d contains the diagonal elements of the input matrix. */
+/* */
+/* e contains the subdiagonal elements of the input matrix */
+/* in its last n-1 positions. e(1) is arbitrary. */
+/* */
+/* z contains the transformation matrix produced in the */
+/* reduction by tred2, if performed. if the eigenvectors */
+/* of the tridiagonal matrix are desired, z must contain */
+/* the identity matrix. */
+/* */
+/* on output */
+/* */
+/* d contains the eigenvalues in ascending order. if an */
+/* error exit is made, the eigenvalues are correct but */
+/* unordered for indices 1,2,...,ierr-1. */
+/* */
+/* e has been destroyed. */
+/* */
+/* z contains orthonormal eigenvectors of the symmetric */
+/* tridiagonal (or full) matrix. if an error exit is made, */
+/* z contains the eigenvectors associated with the stored */
+/* eigenvalues. */
+/* */
+/* ierr is set to */
+/* zero for normal return, */
+/* j if the j-th eigenvalue has not been */
+/* determined after 1000 iterations. */
+/* */
+/* calls pythag for sqrt(a*a + b*b) . */
+/* */
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+/* */
+/* this version dated august 1983. */
+/* */
+/* ------------------------------------------------------------------ */
+
+ *ierr = 0;
+ if (*n == 1) {
+ return;
+ }
+
+ for (i = 1; i < *n; ++i) {
+ e[i - 1] = e[i];
+ }
+
+ f = 0.;
+ tst1 = 0.;
+ e[*n-1] = 0.;
+
+ for (l = 0; l < *n; ++l) {
+ j = 0;
+ h = abs(d[l]) + abs(e[l]);
+ if (tst1 < h) {
+ tst1 = h;
+ }
+/* .......... look for small sub-diagonal element .......... */
+ for (m = l; m < *n; ++m) {
+ tst2 = tst1 + abs(e[m]);
+ if (tst2 == tst1) {
+ break;
+ }
+/* .......... e(n) is always zero, so there is no exit */
+/* through the bottom of the loop .......... */
+ }
+
+ if (m == l) {
+ goto L220;
+ }
+L130:
+ if (j == 1000) {
+/* .......... set error -- no convergence to an */
+/* eigenvalue after 1000 iterations .......... */
+ *ierr = l+1;
+ return;
+ }
+ ++j;
+/* .......... form shift .......... */
+ g = d[l];
+ p = (d[l+1] - g) / (e[l] * 2.);
+ r = pythag_(&p, &c_b10);
+ d[l] = e[l] / (p + d_sign(&r, &p));
+ d[l+1] = e[l] * (p + d_sign(&r, &p));
+ dl1 = d[l+1];
+ h = g - d[l];
+
+ for (i = l+2; i < *n; ++i) {
+ d[i] -= h;
+ }
+
+ f += h;
+/* .......... ql transformation .......... */
+ p = d[m];
+ c = 1.;
+ c2 = c;
+ el1 = e[l+1];
+ s = 0.;
+ for (i = m-1; i >= l; --i) {
+ c3 = c2;
+ c2 = c;
+ s2 = s;
+ g = c * e[i];
+ h = c * p;
+ r = pythag_(&p, &e[i]);
+ e[i + 1] = s * r;
+ s = e[i] / r;
+ c = p / r;
+ p = c * d[i] - s * g;
+ d[i + 1] = h + s * (c * g + s * d[i]);
+/* .......... form vector .......... */
+ for (k = 0; k < *n; ++k) {
+ h = z[k + (i + 1) * *nm];
+ z[k + (i + 1) * *nm] = s * z[k + i * *nm] + c * h;
+ z[k + i * *nm] = c * z[k + i * *nm] - s * h;
+ }
+ }
+
+ p = -s * s2 * c3 * el1 * e[l] / dl1;
+ e[l] = s * p;
+ d[l] = c * p;
+ tst2 = tst1 + abs(e[l]);
+ if (tst2 > tst1) {
+ goto L130;
+ }
+L220:
+ d[l] += f;
+ }
+/* .......... order eigenvalues and eigenvectors .......... */
+ for (i = 0; i < *n-1; ++i) {
+ k = i;
+ p = d[i];
+
+ for (j = i+1; j < *n; ++j) {
+ if (d[j] >= p) {
+ continue;
+ }
+ k = j;
+ p = d[j];
+ }
+
+ if (k == i) {
+ continue;
+ }
+ d[k] = d[i];
+ d[i] = p;
+
+ for (j = 0; j < *n; ++j) {
+ p = z[j + i * *nm];
+ z[j + i * *nm] = z[j + k * *nm];
+ z[j + k * *nm] = p;
+ }
+ }
+} /* tql2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.c
new file mode 100644
index 0000000000000000000000000000000000000000..7babe2941fc1b6ca21da79a6c83d0908ce97563c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.c
@@ -0,0 +1,168 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void trans_(a, m, n, mn, move, iwrk, iok)
+real *a;
+const integer *m, *n, *mn;
+integer *move, *iwrk, *iok;
+{
+ /* Local variables */
+ static real b, c, d;
+ static integer i, j, k, i1, i2, im, i1c, i2c, ncount, ir0, ir1, ir2, kmi, max_;
+
+/* ***** */
+/* ALGORITHM 380 - REVISED */
+/* ***** */
+/* A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH */
+/* CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED */
+/* COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK */
+/* USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE */
+/* VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE */
+/* SUCCESS OR FAILURE OF THE ROUTINE. */
+/* NORMAL RETURN IOK=0 */
+/* ERRORS IOK=-1 ,MN NOT EQUAL TO M*N */
+/* IOK=-2 ,IWRK NEGATIVE OR ZERO */
+/* IOK.GT.0, (SHOULD NEVER OCCUR),IN THIS CASE */
+/* WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH */
+/* IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED */
+/* NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS */
+
+/* CHECK ARGUMENTS AND INITIALIZE. */
+
+ if (*m < 2 || *n < 2) {
+ goto L120;
+ }
+ if (*mn != *m * *n) {
+ goto L180;
+ }
+ if (*iwrk < 1) {
+ goto L190;
+ }
+ if (*m == *n) {
+ goto L130;
+ }
+ ncount = 2;
+ k = *mn - 1;
+ for (i = 0; i < *iwrk; ++i) {
+ move[i] = 0;
+ }
+ if (*m < 3 || *n < 3) {
+ goto L30;
+ }
+/* CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM */
+/* FOR GCD(M-1,N-1). */
+ ir2 = *m - 1;
+ ir1 = *n - 1;
+L20:
+ ir0 = ir2 % ir1;
+ ir2 = ir1;
+ ir1 = ir0;
+ if (ir0 != 0) {
+ goto L20;
+ }
+ ncount = ncount + ir2 - 1;
+/* SET INITIAL VALUES FOR SEARCH */
+L30:
+ i = 0;
+ im = *m;
+/* AT LEAST ONE LOOP MUST BE RE-ARRANGED */
+ goto L80;
+/* SEARCH FOR LOOPS TO REARRANGE */
+L40:
+ ++i;
+ max_ = k - i;
+ if (i >= max_) {
+ goto L160;
+ }
+ im += *m;
+ if (im > k) {
+ im -= k;
+ }
+ i2 = im;
+ if (i+1 == i2) {
+ goto L40;
+ }
+ if (i >= *iwrk) {
+ goto L60;
+ }
+ if (move[i] == 0) {
+ goto L80;
+ }
+ goto L40;
+L50:
+ i2 = *m * i1 - k * (i1 / *n);
+L60:
+ if (i2 <= i+1 || i2 >= max_) {
+ goto L70;
+ }
+ i1 = i2;
+ goto L50;
+L70:
+ if (i2 != i+1) {
+ goto L40;
+ }
+/* REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP */
+L80:
+ i1 = i + 1;
+ kmi = k - i - 1;
+ b = a[i1];
+ i1c = kmi;
+ c = a[i1c];
+L90:
+ i2 = *m * i1 - k * (i1 / *n);
+ i2c = k - i2;
+ if (i1 <= *iwrk) {
+ move[i1-1] = 2;
+ }
+ if (i1c <= *iwrk) {
+ move[i1c-1] = 2;
+ }
+ ncount += 2;
+ if (i2 == i+1) {
+ goto L110;
+ }
+ if (i2 == kmi) {
+ goto L100;
+ }
+ a[i1] = a[i2];
+ a[i1c] = a[i2c];
+ i1 = i2;
+ i1c = i2c;
+ goto L90;
+/* FINAL STORE AND TEST FOR FINISHED */
+L100:
+ d = b;
+ b = c;
+ c = d;
+L110:
+ a[i1] = b;
+ a[i1c] = c;
+ if (ncount < *mn) {
+ goto L40;
+ }
+/* NORMAL RETURN */
+L120:
+ *iok = 0;
+ return;
+/* IF MATRIX IS SQUARE,EXCHANGE ELEMENTS A(I,J) AND A(J,I). */
+L130:
+ for (i = 0; i < *n; ++i) {
+ for (j = i+1; j < *n; ++j) {
+ i1 = i + j * *n;
+ i2 = j + i * *m;
+ b = a[i1]; a[i1] = a[i2]; a[i2] = b;
+ }
+ }
+ goto L120;
+/* ERROR RETURNS. */
+L160:
+ *iok = i+1;
+L170:
+ return;
+L180:
+ *iok = -1;
+ goto L170;
+L190:
+ *iok = -2;
+ goto L170;
+} /* trans_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.f
new file mode 100644
index 0000000000000000000000000000000000000000..a032aeb82dc49252d2a4942f41e2f940bb283748
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/trans.f
@@ -0,0 +1,108 @@
+ SUBROUTINE TRANS(A, M, N, MN, MOVE, IWRK, IOK) TRA 10
+C *****
+C ALGORITHM 380 - REVISED
+C *****
+C A IS A ONE-DIMENSIONAL ARRAY OF LENGTH MN=M*N, WHICH
+C CONTAINS THE MXN MATRIX TO BE TRANSPOSED (STORED
+C COLUMNWISE). MOVE IS A ONE-DIMENSIONAL ARRAY OF LENGTH IWRK
+C USED TO STORE INFORMATION TO SPEED UP THE PROCESS. THE
+C VALUE IWRK=(M+N)/2 IS RECOMMENDED. IOK INDICATES THE
+C SUCCESS OR FAILURE OF THE ROUTINE.
+C NORMAL RETURN IOK=0
+C ERRORS IOK=-1 ,MN NOT EQUAL TO M*N
+C IOK=-2 ,IWRK NEGATIVE OR ZERO
+C IOK.GT.0, (SHOULD NEVER OCCUR),IN THIS CASE
+C WE SET IOK EQUAL TO THE FINAL VALUE OF I WHEN THE SEARCH
+C IS COMPLETED BUT SOME LOOPS HAVE NOT BEEN MOVED
+C NOTE * MOVE(I) WILL STAY ZERO FOR FIXED POINTS
+ DIMENSION A(MN), MOVE(IWRK)
+C CHECK ARGUMENTS AND INITIALIZE.
+ IF (M.LT.2 .OR. N.LT.2) GO TO 120
+ IF (MN.NE.M*N) GO TO 180
+ IF (IWRK.LT.1) GO TO 190
+ IF (M.EQ.N) GO TO 130
+ NCOUNT = 2
+ K = MN - 1
+ DO 10 I=1,IWRK
+ MOVE(I) = 0
+ 10 CONTINUE
+ IF (M.LT.3 .OR. N.LT.3) GO TO 30
+C CALCULATE THE NUMBER OF FIXED POINTS, EUCLIDS ALGORITHM
+C FOR GCD(M-1,N-1).
+ IR2 = M - 1
+ IR1 = N - 1
+ 20 IR0 = MOD(IR2,IR1)
+ IR2 = IR1
+ IR1 = IR0
+ IF (IR0.NE.0) GO TO 20
+ NCOUNT = NCOUNT + IR2 - 1
+C SET INITIAL VALUES FOR SEARCH
+ 30 I = 1
+ IM = M
+C AT LEAST ONE LOOP MUST BE RE-ARRANGED
+ GO TO 80
+C SEARCH FOR LOOPS TO REARRANGE
+ 40 MAX = K - I
+ I = I + 1
+ IF (I.GT.MAX) GO TO 160
+ IM = IM + M
+ IF (IM.GT.K) IM = IM - K
+ I2 = IM
+ IF (I.EQ.I2) GO TO 40
+ IF (I.GT.IWRK) GO TO 60
+ IF (MOVE(I).EQ.0) GO TO 80
+ GO TO 40
+ 50 I2 = M*I1 - K*(I1/N)
+ 60 IF (I2.LE.I .OR. I2.GE.MAX) GO TO 70
+ I1 = I2
+ GO TO 50
+ 70 IF (I2.NE.I) GO TO 40
+C REARRANGE THE ELEMENTS OF A LOOP AND ITS COMPANION LOOP
+ 80 I1 = I
+ KMI = K - I
+ B = A(I1+1)
+ I1C = KMI
+ C = A(I1C+1)
+ 90 I2 = M*I1 - K*(I1/N)
+ I2C = K - I2
+ IF (I1.LE.IWRK) MOVE(I1) = 2
+ IF (I1C.LE.IWRK) MOVE(I1C) = 2
+ NCOUNT = NCOUNT + 2
+ IF (I2.EQ.I) GO TO 110
+ IF (I2.EQ.KMI) GO TO 100
+ A(I1+1) = A(I2+1)
+ A(I1C+1) = A(I2C+1)
+ I1 = I2
+ I1C = I2C
+ GO TO 90
+C FINAL STORE AND TEST FOR FINISHED
+ 100 D = B
+ B = C
+ C = D
+ 110 A(I1+1) = B
+ A(I1C+1) = C
+ IF (NCOUNT.LT.MN) GO TO 40
+C NORMAL RETURN
+ 120 IOK = 0
+ RETURN
+C IF MATRIX IS SQUARE,EXCHANGE ELEMENTS A(I,J) AND A(J,I).
+ 130 N1 = N - 1
+ DO 150 I=1,N1
+ J1 = I + 1
+ DO 140 J=J1,N
+ I1 = I + (J-1)*N
+ I2 = J + (I-1)*M
+ B = A(I1)
+ A(I1) = A(I2)
+ A(I2) = B
+ 140 CONTINUE
+ 150 CONTINUE
+ GO TO 120
+C ERROR RETURNS.
+ 160 IOK = I
+ 170 RETURN
+ 180 IOK = -1
+ GO TO 170
+ 190 IOK = -2
+ GO TO 170
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.c
new file mode 100644
index 0000000000000000000000000000000000000000..2dd147f3293f2648fd084e5de32dd047add7c1d7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.c
@@ -0,0 +1,51 @@
+/* trapezod.f -- translated by f2c (version 20020621). */
+#include "f2c.h"
+
+/* NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994 */
+/* To accompany the text: */
+/* NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992 */
+/* Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A. */
+/* This free software is complements of the author. */
+
+/* Algorithm 7.1 (Composite Trapezoidal Rule). */
+/* Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365 */
+
+/* Subroutine */
+int trapru_(E_fp f, doublereal *a, doublereal *b, integer *m, doublereal *trule)
+{
+ /* Local variables */
+ static doublereal h__;
+ static integer k;
+ static doublereal x;
+ static doublereal sum;
+
+ h__ = (*b - *a) / *m;
+ sum = 0.f;
+ for (k = 1; k < *m; ++k) {
+ x = *a + h__ * k;
+ sum += (*f)(&x);
+ }
+ sum = h__ * ((*f)(a) + (*f)(b) + sum * 2) / 2;
+ *trule = sum;
+ return 0;
+} /* trapru_ */
+
+/* Subroutine */
+int xtrapru_(E_fp f, doublereal *a, doublereal *b, integer *m, doublereal *trule)
+{
+ /* Local variables */
+ static doublereal h__;
+ static integer k;
+ static doublereal x, sum;
+
+/* This subroutine uses labeled DO loop(s). */
+ h__ = (*b - *a) / *m;
+ sum = 0.f;
+ for (k = 1; k < *m; ++k) {
+ x = *a + h__ * k;
+ sum += (*f)(&x);
+ }
+ sum = h__ * ((*f)(a) + (*f)(b) + sum * 2) / 2;
+ *trule = sum;
+ return 0;
+} /* xtrapru_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.f
new file mode 100644
index 0000000000000000000000000000000000000000..704ebe5b6dfa4f9040d431721b816fd0e2440d87
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapezod.f
@@ -0,0 +1,47 @@
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.1 (Composite Trapezoidal Rule).
+C Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365
+C
+ SUBROUTINE TRAPRU(F,A,B,M,Trule)
+ INTEGER K,M
+ REAL A,B,H,Sum,Trule,X
+ EXTERNAL F
+ H=(B-A)/M
+ Sum=0
+ DO K=1,M-1
+ X=A+H*K
+ Sum=Sum+F(X)
+ ENDDO
+ Sum=H*(F(A)+F(B)+2*Sum)/2
+ Trule=Sum
+ RETURN
+ END
+
+ SUBROUTINE XTRAPRU(F,A,B,M,Trule)
+C This subroutine uses labeled DO loop(s).
+ INTEGER K,M
+ REAL A,B,H,Sum,Trule,X
+ EXTERNAL F
+ H=(B-A)/M
+ Sum=0
+ DO 10 K=1,M-1
+ X=A+H*K
+ Sum=Sum+F(X)
+10 CONTINUE
+ Sum=H*(F(A)+F(B)+2*Sum)/2
+ Trule=Sum
+ RETURN
+ END
+
+
+
+
+
+
+
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/trapru.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapru.f
new file mode 100644
index 0000000000000000000000000000000000000000..7a31471dbf1fe8d3dc4ae898efec9a9087a1dbcb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/trapru.f
@@ -0,0 +1,1200 @@
+ PROGRAM TRAPEZOD
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.1 (Composite Trapezoidal Rule).
+C Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365
+C
+ INTEGER M
+ REAL A,B,Trule
+ CHARACTER*60 ANS*1,DFUN,FUN
+ EXTERNAL F
+10 CALL INPUTS(A,B,M,DFUN,FUN)
+ CALL TRAPRU(F,A,B,M,Trule)
+ CALL RESULT(A,B,M,Trule,DFUN,FUN)
+ WRITE(9,*)'WANT TO TRY ANOTHER INTERVAL ? <Y/N> '
+ READ (9,'(A)') ANS
+ IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10
+ END
+
+ REAL FUNCTION F(X)
+ REAL X
+ F=X/(1+X*X)
+ RETURN
+ END
+
+ SUBROUTINE PRINTFUN(DFUN,FUN)
+ CHARACTER*(*) DFUN,FUN
+ FUN ='X/(1+X*X)'
+ DFUN='X/(1+X*X) DX'
+ RETURN
+ END
+
+ SUBROUTINE TRAPRU(F,A,B,M,Trule)
+ INTEGER K,M
+ REAL A,B,H,Sum,Trule,X
+ EXTERNAL F
+ H=(B-A)/M
+ Sum=0
+ DO K=1,M-1
+ X=A+H*K
+ Sum=Sum+F(X)
+ ENDDO
+ Sum=H*(F(A)+F(B)+2*Sum)/2
+ Trule=Sum
+ RETURN
+ END
+
+ SUBROUTINE XTRAPRU(F,A,B,M,Trule)
+C This subroutine uses labeled DO loop(s).
+ INTEGER K,M
+ REAL A,B,H,Sum,Trule,X
+ EXTERNAL F
+ H=(B-A)/M
+ Sum=0
+ DO 10 K=1,M-1
+ X=A+H*K
+ Sum=Sum+F(X)
+10 CONTINUE
+ Sum=H*(F(A)+F(B)+2*Sum)/2
+ Trule=Sum
+ RETURN
+ END
+
+ SUBROUTINE INPUTS(A,B,M,DFUN,FUN)
+ INTEGER I,M
+ REAL A,B
+ CHARACTER*(*) DFUN,FUN
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' THE TRAPEZOIDAL RULE IS USED TO COMPUTE AN APPROXIM
+ +ATION'
+ WRITE(9,*)' '
+ WRITE(9,*)'FOR THE VALUE OF THE DEFINITE INTEGRAL:'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)' B'
+ WRITE(9,*)' /'
+ WRITE(9,*)' | ',DFUN
+ WRITE(9,*)' /'
+ WRITE(9,*)' A'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE LEFT ENDPOINT A = '
+ READ(9,*) A
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE RIGHT ENDPOINT B = '
+ READ(9,*) B
+ WRITE(9,*)' '
+ WRITE(9,*)' NUMBER OF SUBINTERVALS M = '
+ READ(9,*) M
+ WRITE(9,*)' '
+ RETURN
+ END
+
+ SUBROUTINE RESULT(A,B,M,Trule,DFUN,FUN)
+ INTEGER I,M
+ REAL A,B,Trule
+ CHARACTER*(*) DFUN,FUN
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' ',B
+ WRITE(9,*)' /'
+ WRITE(9,*)' |'
+ WRITE(9,*)Trule,' ~ | ',DFUN
+ WRITE(9,*)' |'
+ WRITE(9,*)' /'
+ WRITE(9,*)' ',A
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'AN APPROXIMATE VALUE FOR THE DEFINITE INTEGRAL OF'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'F(X) = ',FUN
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'TAKEN OVER [',A,' ,',B,' ] WAS FOUND.'
+ WRITE(9,*)' '
+ WRITE(9,*)'WHEN ',M,' SUBINTERVALS ARE USED,'
+ WRITE(9,*)' '
+ WRITE(9,*)'THE TRAPEZOIDAL RULE APPROXIMATION IS ',Trule
+ WRITE(9,*)' '
+ RETURN
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PROGRAM SIMPSON
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.2 (Composite Simpson Rule).
+C Section 7.2, Composite Trapezoidal and Simpson's Rule, Page 365
+C
+ INTEGER M
+ REAL A,B,Srule
+ CHARACTER*60 ANS*1,DFUN,FUN
+ EXTERNAL F
+10 CALL INPUTS(A,B,M,DFUN,FUN)
+ CALL SIMPRU(F,A,B,M,Srule)
+ CALL RESULT(A,B,M,Srule,DFUN,FUN)
+ WRITE(9,*)'WANT TO TRY ANOTHER INTERVAL ? <Y/N> '
+ READ (9,'(A)') ANS
+ IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10
+ END
+
+ REAL FUNCTION F(X)
+ REAL X
+ F=X/(1+X*X)
+ RETURN
+ END
+
+ SUBROUTINE PRINTFUN(DFUN,FUN)
+ CHARACTER*(*) DFUN,FUN
+ FUN ='X/(1+X*X)'
+ DFUN='X/(1+X*X) DX'
+ RETURN
+ END
+
+ SUBROUTINE SIMPRU(F,A,B,M,Srule)
+ INTEGER K,M
+ REAL A,B,H,Sum,SumEven,SumOdd,Srule,X
+ EXTERNAL F
+ H=(B-A)/(2*M)
+ SumEven=0
+ DO K=1,(M-1)
+ X=A+H*2*K
+ SumEven=SumEven+F(X)
+ ENDDO
+ SumOdd=0
+ DO K=1,M
+ X=A+H*(2*K-1)
+ SumOdd=SumOdd+F(X)
+ ENDDO
+ Sum=H*(F(A)+F(B)+2*SumEven+4*SumOdd)/3
+ Srule=Sum
+ RETURN
+ END
+
+ SUBROUTINE XSIMPRU(F,A,B,M,Srule)
+C This subroutine uses labeled DO loop(s).
+ INTEGER K,M
+ REAL A,B,H,Sum,SumEven,SumOdd,Srule,X
+ EXTERNAL F
+ H=(B-A)/(2*M)
+ SumEven=0
+ DO 10 K=1,(M-1)
+ X=A+H*2*K
+ SumEven=SumEven+F(X)
+10 CONTINUE
+ SumOdd=0
+ DO 20 K=1,M
+ X=A+H*(2*K-1)
+ SumOdd=SumOdd+F(X)
+20 CONTINUE
+ Sum=H*(F(A)+F(B)+2*SumEven+4*SumOdd)/3
+ Srule=Sum
+ RETURN
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PROGRAM ROMBERG
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.3 (Recursive Trapezoidal Rule).
+C Algorithm 7.4 (Romberg Integration).
+C Section 7.3, Recursive Rules and Romberg Integration, Page 379
+C
+ PARAMETER(MaxN=12,Tol=1E-6)
+ INTEGER J
+ REAL A,B,Close,R,Rrule
+ CHARACTER*56 ANS*1,DFUN,FUN
+ DIMENSION R(0:MaxN,0:MaxN)
+ EXTERNAL F
+10 CALL INPUTS(A,B,DFUN,FUN)
+ CALL ROMBRU(F,A,B,Tol,R,Rrule,Close,J)
+ CALL RESULT(A,B,R,Rrule,Close,J,DFUN,FUN)
+ WRITE(9,*)'WANT TO TRY ANOTHER INTERVAL ? <Y/N> '
+ READ (9,'(A)') ANS
+ IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10
+ END
+
+ REAL FUNCTION F(X)
+ REAL X
+ F=SIN(X)
+ RETURN
+ END
+
+ SUBROUTINE PRINTFUN(DFUN,FUN)
+ CHARACTER*(*) DFUN,FUN
+ FUN ='SIN(X)'
+ DFUN='SIN(X) DX'
+ RETURN
+ END
+
+ SUBROUTINE ROMBRU(F,A,B,Tol,R,Rrule,Close,J)
+ PARAMETER(MaxN=12,Min=4)
+ INTEGER J,K,M,P
+ REAL A,B,Close,H,R,Rrule,Sum,Tol,X
+ DIMENSION R(0:MaxN,0:MaxN)
+ EXTERNAL F
+ M=1
+ H=B-A
+ Close=1
+ J=0
+ R(0,0)=H*(F(A)+F(B))/2
+ WHILE ((Close.GT.Tol .AND. J.LT.MaxN) .OR. J.LT.Min)
+ J=J+1 !This is the Trapezoidal Rule:
+ H=H/2
+ Sum=0
+ DO P=1,M
+ X=A+H*(2*P-1)
+ Sum=Sum+F(X)
+ ENDDO
+ R(J,0)=H*Sum+R(J-1,0)/2
+ M=2*M !This is the Extrapolation part:
+ DO K=1,J
+ R(J,K)=R(J,K-1)+(R(J,K-1)-R(J-1,K-1))/(4**K-1)
+ ENDDO
+ Close = ABS(R(J-1,J-1)-R(J,J))
+ REPEAT
+ Rrule=R(J,J)
+ RETURN
+ END
+
+ SUBROUTINE XROMBRU(F,A,B,Tol,R,Rrule,Close,J)
+C This subroutine uses simulated WHILE loop(s).
+ PARAMETER(MaxN=12,Min=4)
+ INTEGER J,K,M,P
+ REAL A,B,Close,H,R,Rrule,Sum,Tol,X
+ DIMENSION R(0:MaxN,0:MaxN)
+ EXTERNAL F
+ M=1
+ H=B-A
+ Close=1
+ J=0
+ R(0,0)=H*(F(A)+F(B))/2
+10 IF ((Close.GT.Tol .AND. J.LT.MaxN) .OR. J.LT.Min) THEN
+ J=J+1 !This is the Trapezoidal Rule:
+ H=H/2
+ Sum=0
+ DO 20 P=1,M
+ X=A+H*(2*P-1)
+ Sum=Sum+F(X)
+20 CONTINUE
+ R(J,0)=H*Sum+R(J-1,0)/2
+ M=2*M !This is the Extrapolation part:
+ DO 30 K=1,J
+ R(J,K)=R(J,K-1)+(R(J,K-1)-R(J-1,K-1))/(4**K-1)
+30 CONTINUE
+ Close = ABS(R(J-1,J-1)-R(J,J))
+ GOTO 10
+ ENDIF
+ Rrule=R(J,J)
+ RETURN
+ END
+
+ SUBROUTINE INPUTS(A,B,DFUN,FUN)
+ INTEGER I
+ REAL A,B
+ CHARACTER*(*) DFUN,FUN
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' ROMBERG INTEGRATION IS PERFORMED TO FIND AN APPROXI
+ +MATION'
+ WRITE(9,*)' '
+ WRITE(9,*)'FOR THE VALUE OF THE DEFINITE INTEGRAL:'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)' B'
+ WRITE(9,*)' /'
+ WRITE(9,*)' | ',DFUN
+ WRITE(9,*)' /'
+ WRITE(9,*)' A'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE LEFT ENDPOINT A = '
+ READ(9,*) A
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE RIGHT ENDPOINT B = '
+ READ(9,*) B
+ WRITE(9,*)' '
+ RETURN
+ END
+
+ SUBROUTINE RESULT(A,B,R,Rrule,Close,J,DFUN,FUN)
+ PARAMETER(MaxN=12,Tol=1E-9)
+ INTEGER I,J,K
+ REAL A,B,Close,R,Rrule
+ CHARACTER*(*) DFUN,FUN
+ DIMENSION R(0:MaxN,0:MaxN)
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' ',B
+ WRITE(9,*)' /'
+ WRITE(9,*)' |'
+ WRITE(9,*)Rrule,' ~ | ',DFUN
+ WRITE(9,*)' |'
+ WRITE(9,*)' /'
+ WRITE(9,*)' ',A
+ WRITE(9,*)' '
+ WRITE(9,*)'THE DIAGONAL ELEMENTS IN THE ROMBERG TABLE ARE:'
+ IF (J.LE.5) THEN
+ WRITE(9,*)' '
+ ENDIF
+ DO 20 K=0,J,2
+ IF (K.LT.J) THEN
+ WRITE(9,998) K,K,R(K,K),K+1,K+1,R(K+1,K+1)
+ ELSE
+ WRITE(9,999) K,K,R(K,K)
+ ENDIF
+20 CONTINUE
+ IF (J.LE.7) THEN
+ WRITE(9,*)' '
+ ENDIF
+ WRITE(9,*)'AN APPROXIMATE VALUE FOR THE DEFINITE INTEGRAL OF'
+ WRITE(9,*)' '
+ WRITE(9,*)'F(X) = ',FUN
+ WRITE(9,*)' '
+ WRITE(9,*)'TAKEN OVER [',A,' ,',B,' ] WAS FOUND.'
+ WRITE(9,*)' '
+ WRITE(9,*)'THE ROMBERG APPROXIMATION IS ',Rrule
+ IF (J.LE.9) THEN
+ WRITE(9,*)' '
+ ENDIF
+ WRITE(9,*)' THE ERROR ESTIMATE IS ',Close
+ IF (J.LE.11) THEN
+ WRITE(9,*)' '
+ ENDIF
+998 FORMAT(' R(',I2,',',I2,') = ',F15.7,
+ +' R(',I2,',',I2,') = ',F15.7)
+999 FORMAT(' R(',I2,',',I2,') = ',F15.7)
+ RETURN
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PROGRAM ADAQUAD
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.5 (Adaptive Quadrature Using Simpson's Rule).
+C Section 7.4, Adaptive Quadrature, Page 389
+C
+ PARAMETER(MaxN=12,Tol=1E-6)
+ INTEGER P,M,State
+ REAL A,B,Tol0,SRmat,SRvec,Integral,ErrBdd
+ REAL Close,Rrule
+ INTEGER J
+ CHARACTER*56 ANS*1,DFUN,FUN
+ DIMENSION SRvec(1:11),SRmat(1:101,1:11)
+ EXTERNAL F
+10 CALL INPUTS(A,B,DFUN,FUN)
+ CALL AdaptQuad(F,A,B,Tol,SRmat,Integral,ErrBdd,M,State)
+ CALL RESULT(A,B,SRmat,Integral,ErrBdd,M,DFUN,FUN)
+ WRITE(9,*)'WANT TO TRY ANOTHER INTERVAL ? <Y/N> '
+ READ (9,'(A)') ANS
+ IF (ANS.NE.'Y' .AND. ANS.NE.'y') STOP
+ IF (ANS.EQ.'Y' .OR. ANS.EQ.'y') GOTO 10
+ STOP
+ END
+
+ REAL FUNCTION F(X)
+ REAL X
+ F=SIN(X)
+ RETURN
+ END
+
+ SUBROUTINE PRINTFUN(DFUN,FUN)
+ CHARACTER*(*) DFUN,FUN
+ FUN ='SIN(X)'
+ DFUN='SIN(X) DX'
+ RETURN
+ END
+
+ SUBROUTINE AdaptQuad(F,A,B,Tol,SRmat,Integral,ErrBdd,M,State)
+ INTEGER M,State
+ REAL A,B,Tol,SRmat,Integral,ErrBdd
+ INTEGER J,K,N,Iterating,Done
+ REAL Sum1,Sum2,SRvec
+ DIMENSION SRmat(1:101,1:11),SRvec(1:11)
+ EXTERNAL F
+ Iterating = 0
+ Done = 1
+ CALL Srule(F,A,B,Tol,SRvec)
+ DO K=1,11
+ SRmat(1, K) = SRvec(K)
+ ENDDO
+ M = 1
+ State = Iterating
+ WHILE (State .EQ. Iterating)
+ N = M
+ DO J=N,1,-1
+ CALL Refine(J,SRmat,M,State)
+ ENDDO
+ REPEAT
+ Sum1 = 0
+ Sum2 = 0
+ DO J=1,M
+ Sum1 = Sum1 + SRmat(J, 8)
+ Sum2 = Sum2 + Abs(SRmat(J, 9))
+ ENDDO
+ Integral = Sum1
+ ErrBdd = Sum2
+ RETURN
+ END
+
+ SUBROUTINE Refine(P,SRmat,M,State)
+ INTEGER P,M,State
+ REAL SRmat
+ INTEGER J,K,Iterating,Done
+ REAL A,B,C,Err,Fa,Fb,Fc,S,S2,Tol,Tol2,Err,Check
+ REAL SR0vec,SR1vec,SR2vec
+ DIMENSION SRmat(1:101,1:11)
+ DIMENSION SR0vec(1:11),SR1vec(1:11),SR2vec(1:11)
+ EXTERNAL F
+ Iterating = 0
+ Done = 1
+ State = Done
+ DO K=1,11
+ SR0vec(K) = SRmat(P, K)
+ ENDDO
+ A = SR0vec(1)
+ C = SR0vec(2)
+ B = SR0vec(3)
+ Fa = SR0vec(4)
+ Fc = SR0vec(5)
+ Fb = SR0vec(6)
+ S = SR0vec(7)
+ S2 = SR0vec(8)
+ Err = SR0vec(9)
+ Tol = SR0vec(10)
+ Check = SR0vec(11)
+ IF (Check .EQ. 1) RETURN
+ Tol2 = Tol / 2
+ CALL Srule(F, A, C, Tol2, SR1vec)
+ CALL Srule(F, C, B, Tol2, SR2vec)
+ Err = ABS(SR0vec(7) - SR1vec(7) - SR2vec(7)) / 10
+ IF (Err .LT. Tol) THEN
+ SR0vec(11) = 1
+ ENDIF
+ IF (Err .LT. Tol) THEN
+ DO K=1,11
+ SRmat(P, K) = SR0vec(K)
+ ENDDO
+ SRmat(P, 8) = SR1vec(7) + SR2vec(7)
+ SRmat(P, 9) = Err
+ ELSE
+ DO J=(M + 1),P,-1
+ DO K=1,11
+ SRmat(J, K) = SRmat(J - 1, K)
+ ENDDO
+ ENDDO
+ M = M + 1
+ DO K=1,11
+ SRmat(P, K) = SR1vec(K)
+ ENDDO
+ DO K=1,11
+ SRmat(P + 1, K) = SR2vec(K)
+ ENDDO
+ State = Iterating
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE Srule(F,A,B,Tol0,SRvec)
+ REAL A,B,Tol0,SRvec
+ REAL C,H,Fa,Fb,Fc,S,S2,Tol1,Err,Check
+ DIMENSION SRvec(1:11)
+ EXTERNAL F
+ H = (B - A) / 2
+ C = (A + B) / 2
+ Fa = F(A)
+ Fc = F(C)
+ Fb = F(B)
+ S = H * (F(A) + 4 * F(C) + F(B)) / 3
+ S2 = S
+ Tol1 = Tol0
+ Err = Tol0
+ Check = 0
+ SRvec(1) = A
+ SRvec(2) = C
+ SRvec(3) = B
+ SRvec(4) = Fa
+ SRvec(5) = Fc
+ SRvec(6) = Fb
+ SRvec(7) = S
+ SRvec(8) = S2
+ SRvec(9) = Err
+ SRvec(10) = Tol1
+ SRvec(11) = Check
+ RETURN
+ END
+
+ SUBROUTINE INPUTS(A,B,DFUN,FUN)
+ INTEGER I
+ REAL A,B
+ CHARACTER*(*) DFUN,FUN
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' ROMBERG INTEGRATION IS PERFORMED TO FIND AN APPROXI
+ +MATION'
+ WRITE(9,*)' '
+ WRITE(9,*)'FOR THE VALUE OF THE DEFINITE INTEGRAL:'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)' B'
+ WRITE(9,*)' /'
+ WRITE(9,*)' | ',DFUN
+ WRITE(9,*)' /'
+ WRITE(9,*)' A'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE LEFT ENDPOINT A = '
+ READ(9,*) A
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER THE RIGHT ENDPOINT B = '
+ READ(9,*) B
+ WRITE(9,*)' '
+ RETURN
+ END
+
+ SUBROUTINE RESULT(A,B,SRmat,Integral,ErrBdd,M,DFUN,FUN)
+ INTEGER I,J,K,M
+ REAL A,B,SRmat,Integral,ErrBdd
+ CHARACTER*(*) DFUN,FUN
+ DIMENSION SRmat(1:101,1:11)
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' ',B
+ WRITE(9,*)' /'
+ WRITE(9,*)' |'
+ WRITE(9,*)Integral,' ~ | ',DFUN
+ WRITE(9,*)' |'
+ WRITE(9,*)' /'
+ WRITE(9,*)' ',A
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'AN APPROXIMATE VALUE FOR THE DEFINITE INTEGRAL OF'
+ WRITE(9,*)' '
+ WRITE(9,*)'F(X) = ',FUN
+ WRITE(9,*)' '
+ WRITE(9,*)'TAKEN OVER [',A,' ,',B,' ] WAS FOUND.'
+ WRITE(9,*)' '
+ WRITE(9,*)'THE ADAVTIVE QUADRATURE APPROXIMATION IS ',Integral
+ WRITE(9,*)' '
+ WRITE(9,*)' THE ERROR ESTIMATE IS ',ErrBdd
+ WRITE(9,*)' '
+ WRITE(9,*)' THE NUMBER OF SUBINTERVALS USED WAS ',M
+ WRITE(9,*)' '
+ RETURN
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PROGRAM GAUSSINT
+C NUMERICAL METHODS: FORTRAN Programs, (c) John H. Mathews 1994
+C To accompany the text:
+C NUMERICAL METHODS for Mathematics, Science and Engineering, 2nd Ed, 1992
+C Prentice Hall, Englewood Cliffs, New Jersey, 07632, U.S.A.
+C This free software is complements of the author.
+C
+C Algorithm 7.6 (Gauss-Legendre Quadrature).
+C Section 7.5, Gauss-Legendre Integration, Page 397
+C
+ PARAMETER(Tol=1E-6)
+ INTEGER I,J
+ REAL A,A0,B0,Close,Q,W
+ CHARACTER*56 ANS*1,DFUN,FUN
+ DIMENSION A(1:17,1:96),Q(1:17),W(1:17,1:96)
+ EXTERNAL F
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)'Now loading abscissas and weights. Please wait!'
+ CALL READAW(A,W)
+20 CALL INPUTS(A0,B0,DFUN,FUN)
+ CALL GAUSQUAD(F,A0,B0,A,W,Q,Close,J)
+ CALL RESULT(A0,B0,Close,Q,J,FUN,DFUN)
+ WRITE(9,*)'Wand to try another interval ? <Y/N> '
+ READ (9,'(A)') ANS
+ IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') GOTO 20
+ END
+
+ REAL FUNCTION F(X)
+ REAL X
+ F=SIN(X)
+ RETURN
+ END
+
+ SUBROUTINE PRINTFUN(DFUN,FUN)
+ CHARACTER*(*) DFUN,FUN
+ FUN ='SIN(X)'
+ DFUN='SIN(X) DX'
+ RETURN
+ END
+
+ SUBROUTINE GAUSQUAD(F,A0,B0,A,W,Q,Close,J)
+ PARAMETER(Min=3)
+ INTEGER I,J,K
+ REAL A,A0,B0,Close,Mid,Sum,Q,W,Wide,X
+ DIMENSION A(1:17,1:96),Q(1:17),W(1:17,1:96)
+ EXTERNAL F
+ Mid=(A0+B0)/2
+ Wide=(B0-A0)/2
+ Close=1
+ J=1
+ X= Mid+A(1,1)
+ Q(1)= W(1,1)*F(X)*Wide
+ WHILE ((Close.GT.Tol.OR.J.LT.Min).AND.J.LT.17)
+ J=J+1
+ Sum=0
+ I=J
+ IF (J.GT.10) I=12+4*(J-11)
+ IF (J.GT.14) I=24+8*(J-14)
+ DO K=1,I
+ X=Mid+A(J,K)*Wide
+ Sum=Sum+W(J,K)*F(X)
+ ENDDO
+ Q(J)=Sum*Wide
+ Close=ABS(Q(J)-Q(J-1))
+ REPEAT
+ RETURN
+ END
+
+ SUBROUTINE XGAUSQUAD(F,A0,B0,A,W,Q,Close,J)
+C This subroutine uses simulated WHILE loop(s).
+ PARAMETER(Min=3)
+ INTEGER I,J,K
+ REAL A,A0,B0,Close,Mid,Sum,Q,W,Wide,X
+ DIMENSION A(1:17,1:96),Q(1:17),W(1:17,1:96)
+ EXTERNAL F
+ Mid=(A0+B0)/2
+ Wide=(B0-A0)/2
+ Close=1
+ J=1
+ X= Mid+A(1,1)
+ Q(1)= W(1,1)*F(X)*Wide
+10 IF ((Close.GT.Tol.OR.J.LT.Min).AND.J.LT.17) THEN
+ J=J+1
+ Sum=0
+ I=J
+ IF (J.GT.10) I=12+4*(J-11)
+ IF (J.GT.14) I=24+8*(J-14)
+ DO 20 K=1,I
+ X=Mid+A(J,K)*Wide
+ Sum=Sum+W(J,K)*F(X)
+20 CONTINUE
+ Q(J)=Sum*Wide
+ Close=ABS(Q(J)-Q(J-1))
+ GOTO 10
+ ENDIF
+ RETURN
+ END
+
+ SUBROUTINE READAW(A,W)
+ INTEGER I,J,K
+ REAL A,M,W
+ CHARACTER*56 ANS*1,DFUN,FUN
+ DIMENSION A(1:17,1:96),Q(1:17),W(1:17,1:96)
+ OPEN(4,FILE='ALG7-6AW.DAT',STATUS='OLD')
+ DO 50 J=1,17
+ M=J
+ I=J
+ IF (J.GT.10) THEN
+ M=12+4*(J-11)
+ I=INT(M)
+ ENDIF
+ IF (J.GT.14) THEN
+ M=24+8*(J-14)
+ I=INT(M)
+ ENDIF
+ DO 10 K=1,INT((M+1)/2)
+ READ(4,*) A(J,K)
+10 CONTINUE
+ DO 20 K=1,INT(M/2)
+ A(J,I+1-K)=-A(J,K)
+20 CONTINUE
+ DO 30 K=1,INT((M+1)/2)
+ READ(4,*) W(J,K)
+30 CONTINUE
+ DO 40 K=1,INT(M/2)
+ W(J,I+1-K)=W(J,K)
+40 CONTINUE
+50 CONTINUE
+ CLOSE(4,STATUS='KEEP')
+ RETURN
+ END
+
+ SUBROUTINE INPUTS(A0,B0,DFUN,FUN)
+ INTEGER I
+ REAL A0,B0
+ CHARACTER*(*) DFUN,FUN
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ WRITE(9,*)' '
+ WRITE(9,*)' Gaussian quadrature is performed to find an'
+ WRITE(9,*)' '
+ WRITE(9,*)' approximation for the value of the definite integr
+ +al:'
+ WRITE(9,*)' '
+ WRITE(9,*)' B N '
+ WRITE(9,*)' / '
+ WRITE(9,*)' | F(X) DX ~ SUM w F(x ) '
+ WRITE(9,*)' / k k '
+ WRITE(9,*)' A k=1 '
+ WRITE(9,*)' '
+ WRITE(9,*)' You chose to approximate the definite integral:'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)' B'
+ WRITE(9,*)' /'
+ WRITE(9,*)' | ',DFUN
+ WRITE(9,*)' /'
+ WRITE(9,*)' A'
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER the left endpoint A = '
+ READ(9,*) A0
+ WRITE(9,*)' '
+ WRITE(9,*)'ENTER the right endpoint B = '
+ READ(9,*) B0
+ WRITE(9,*)' '
+ RETURN
+ END
+
+ SUBROUTINE RESULT(A0,B0,Close,Q,J,FUN,DFUN)
+ INTEGER I,II,J,JJ,K,L,U,V
+ REAL A0,B0,Close,Q
+ CHARACTER*(*) DFUN,FUN
+ DIMENSION Q(1:17)
+ CALL PRINTFUN(DFUN,FUN)
+ DO 10 I=1,18
+ WRITE(9,*)' '
+10 CONTINUE
+ JJ=J
+ IF (J.GT.10) THEN
+ JJ=12+4*(J-11)
+ ENDIF
+ IF (J.GT.14) THEN
+ JJ=24+8*(J-14)
+ ENDIF
+ WRITE(9,*)' ',B0
+ WRITE(9,*)' /'
+ WRITE(9,*)' |'
+ WRITE(9,*)Q(J),' ~ | ',DFUN
+ WRITE(9,*)' |'
+ WRITE(9,*)' /'
+ WRITE(9,*)' ',A0
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'Gaussian quadrature with',JJ,' points was used to inte
+ +grate'
+ WRITE(9,*)' '
+ WRITE(9,*)'F(X) = ',FUN
+ WRITE(9,*)' '
+ WRITE(9,*)' '
+ WRITE(9,*)'over the interval [',A0,' ,',B0,' ].'
+ WRITE(9,*)' '
+ WRITE(9,*)'The values of the previous Gaussian rules are:'
+ L=1
+ IF (J.GT.14) THEN
+ L=2
+ ENDIF
+ IF (J.GT.16) THEN
+ L=3
+ ENDIF
+ DO 20 K=L,INT((J+1)/2)
+ U=2*K-1
+ V=2*K
+ I=U
+ IF (U.GT.10) THEN
+ I=12+4*(U-11)
+ ENDIF
+ IF (U.GT.14) THEN
+ I=24+8*(U-14)
+ ENDIF
+ II=V
+ IF (V.GT.10) THEN
+ II=12+4*(V-11)
+ ENDIF
+ IF (V.GT.14) THEN
+ II=24+8*(V-14)
+ ENDIF
+ IF (U.LE.J.AND.V.LE.J) THEN
+ WRITE(9,998) I,Q(U),II,Q(V)
+ ENDIF
+ IF (U.LE.J.AND.V.GT.J) THEN
+ WRITE(9,999) I,Q(U)
+ ENDIF
+20 CONTINUE
+ WRITE(9,*)' '
+ WRITE(9,*)'The best Gaussian approximation is Q(',JJ,') =',Q(J)
+ IF (J.LE.11) THEN
+ WRITE(9,*)' '
+ ENDIF
+ WRITE(9,*)' The error estimate is +-',Close
+998 FORMAT(' Q(',I2,') = ',F15.7,
+ +' Q(',I2,') = ',F15.7)
+999 FORMAT(' Q(',I2,') = ',F15.7)
+ RETURN
+ END
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+C
+C The following data must be stored in the file
+C
+C ALG7-6.DAT
+C
+C which contains the abscissas and weights.
+C
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+0.0
+2.0
+0.577350269189626
+1.0
+0.774596669241483
+0.0
+0.555555555555556
+0.888888888888889
+0.861136311594053
+0.339981043584856
+0.347854845137454
+0.652145154862546
+0.906179845938664
+0.538469310105683
+0.0
+0.236926885056189
+0.478628670499366
+0.568888888888889
+0.932469514203152
+0.661209386466265
+0.238619186083197
+0.171324492379170
+0.360761573048139
+0.467913934572691
+0.949107912342759
+0.741531185599394
+0.405845151377397
+0.0
+0.129484966168870
+0.279705391489277
+0.381830050505119
+0.417959183673469
+0.960289856497536
+0.796666477413627
+0.525532409916329
+0.183434642495650
+0.101228536290376
+0.222381034453374
+0.313706645877887
+0.362683783378362
+0.968160239507626
+0.836031107326636
+0.613371432700590
+0.324253423403809
+0.0
+0.081274388361574
+0.180648160694857
+0.260610696402935
+0.312347077040003
+0.330239355001260
+0.973906528517172
+0.865063366688985
+0.679409568299024
+0.433395394129247
+0.148874338981631
+0.066671344308688
+0.149451349150581
+0.219086362515982
+0.269266719309996
+0.295524224714735
+0.981560634246719
+0.904117256370475
+0.769902674194305
+0.587317954286617
+0.367831498998180
+0.125233408511469
+0.047175336386512
+0.106939325995318
+0.160078328543346
+0.203167426723066
+0.233492536538355
+0.249147045813403
+0.989400934991650
+0.944575023073233
+0.865631202387832
+0.755404408355003
+0.617876244402644
+0.458016777657227
+0.281603550779259
+0.095012509837637
+0.027152459411754
+0.062253523938648
+0.095158511682493
+0.124628971255534
+0.149595988816577
+0.169156519395003
+0.182603415044924
+0.189450610455068
+0.993128599185095
+0.963971927277914
+0.912234428251326
+0.839116971822219
+0.746331906460151
+0.636053680726515
+0.510867001950827
+0.373706088715420
+0.227785851141645
+0.076526521133497
+0.017614007139152
+0.040601429800387
+0.062672048334109
+0.083276741576705
+0.101930119817240
+0.118194531961518
+0.131688638449177
+0.142096109318382
+0.149172986472604
+0.152753387130726
+0.995187219997021
+0.974728555971309
+0.938274552002733
+0.886415527004401
+0.820001985973903
+0.740124191578554
+0.648093651936976
+0.545421471388840
+0.433793507626045
+0.315042679696163
+0.191118867473616
+0.064056892862606
+0.012341229799987
+0.028531388628934
+0.044277438817420
+0.059298584915437
+0.073346481411080
+0.086190161531953
+0.097618652104114
+0.107444270115966
+0.115505668053726
+0.121670472927803
+0.125837456346828
+0.127938195346752
+0.997263861849482
+0.985611511545268
+0.964762255587506
+0.934906075937740
+0.896321155766052
+0.849367613732570
+0.794483795967942
+0.732182118740290
+0.663044266930215
+0.587715757240762
+0.506899908932229
+0.421351276130635
+0.331868602282128
+0.239287362252137
+0.144471961582796
+0.048307665687738
+0.007018610009470
+0.016274394730906
+0.025392065309262
+0.034273862913021
+0.042835898022227
+0.050998059262376
+0.058684093478536
+0.065822222776362
+0.072345794108849
+0.078193895787070
+0.083311924226947
+0.087652093004404
+0.091173878695764
+0.093844399080805
+0.095638720079275
+0.096540088514728
+0.998237709710559
+0.990726238699457
+0.977259949983774
+0.957916819213792
+0.932812808278677
+0.902098806968874
+0.865959503212260
+0.824612230833312
+0.778305651426519
+0.727318255189927
+0.671956684614180
+0.612553889667980
+0.549467125095128
+0.483075801686179
+0.413779204371605
+0.341994090825758
+0.268152185007254
+0.192697580701371
+0.116084070675255
+0.038772417506051
+0.004521277098533
+0.010498284531153
+0.016421058381908
+0.022245849194167
+0.027937006980023
+0.033460195282548
+0.038782167974472
+0.043870908185673
+0.048695807635072
+0.053227846983937
+0.057439769099392
+0.061306242492929
+0.064804013456601
+0.067912045815234
+0.070611647391287
+0.072886582395804
+0.074723169057968
+0.076110361900626
+0.077039818164248
+0.077505947978425
+0.998771007252426
+0.993530172266351
+0.984124583722827
+0.970591592546247
+0.952987703160431
+0.931386690706554
+0.905879136715570
+0.876572020274248
+0.843588261624394
+0.807066204029443
+0.767159032515740
+0.724034130923815
+0.677872379632664
+0.628867396776514
+0.577224726083973
+0.523160974722233
+0.466902904750958
+0.408686481990717
+0.348755886292161
+0.287362487355456
+0.224763790394689
+0.161222356068892
+0.097004699209463
+0.032380170962869
+0.003153346052306
+0.007327553901276
+0.011477234579235
+0.015579315722944
+0.019616160457356
+0.023570760839324
+0.027426509708357
+0.031167227832798
+0.034777222564770
+0.038241351065831
+0.041545082943465
+0.044674560856694
+0.047616658492490
+0.050359035553854
+0.052890189485194
+0.055199503699984
+0.057277292100403
+0.059114839698396
+0.060704439165894
+0.062039423159893
+0.063114192286254
+0.063924238584648
+0.064466164435950
+0.064737696812684
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tred1.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tred1.c
new file mode 100644
index 0000000000000000000000000000000000000000..75353a7845220b9c45943b530a2ce7792742a7f3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tred1.c
@@ -0,0 +1,139 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void tred1_(nm, n, a, d, e, e2)
+const integer *nm, *n;
+doublereal *a, *d, *e, *e2;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal f, g, h;
+ static integer i, j, k, l;
+ static doublereal scale;
+
+/* this subroutine is a translation of the algol procedure tred1, */
+/* num. math. 11, 181-195(1968) by martin, reinsch, and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 212-226(1971). */
+
+/* this subroutine reduces a real symmetric matrix */
+/* to a symmetric tridiagonal matrix using */
+/* orthogonal similarity transformations. */
+/* */
+/* on input */
+/* */
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+/* */
+/* n is the order of the matrix. */
+/* */
+/* a contains the real symmetric input matrix. only the */
+/* lower triangle of the matrix need be supplied. */
+/* */
+/* on output */
+/* */
+/* a contains information about the orthogonal trans- */
+/* formations used in the reduction in its strict lower */
+/* triangle. the full upper triangle of a is unaltered. */
+/* */
+/* d contains the diagonal elements of the tridiagonal matrix. */
+/* */
+/* e contains the subdiagonal elements of the tridiagonal */
+/* matrix in its last n-1 positions. e(1) is set to zero. */
+/* */
+/* e2 contains the squares of the corresponding elements of e. */
+/* e2 may coincide with e if the squares are not needed. */
+/* */
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+/* */
+/* this version dated august 1983. */
+/* */
+/* ------------------------------------------------------------------ */
+
+ for (i = 0; i < *n; ++i) {
+ d[i] = a[*n-1 + i * *nm];
+ a[*n-1 + i * *nm] = a[i + i * *nm];
+ }
+ for (i = *n-1; i >= 0; --i) {
+ l = i - 1;
+ h = 0.;
+ scale = 0.;
+/* .......... scale row (algol tol then not needed) .......... */
+ for (k = 0; k <= l; ++k) {
+ scale += abs(d[k]);
+ }
+ if (scale == 0.) {
+ for (j = 0; j <= l; ++j) {
+ d[j] = a[l + j * *nm];
+ a[l + j * *nm] = a[i + j * *nm];
+ a[i + j * *nm] = 0.;
+ }
+ e[i] = 0.;
+ e2[i] = 0.;
+ continue;
+ }
+ for (k = 0; k <= l; ++k) {
+ d[k] /= scale;
+ h += d[k] * d[k];
+ }
+
+ e2[i] = scale * scale * h;
+ f = d[l];
+ d__1 = sqrt(h);
+ g = -d_sign(&d__1, &f);
+ e[i] = scale * g;
+ h -= f * g;
+ d[l] = f - g;
+ if (l == 0) {
+ goto L285;
+ }
+/* .......... form a*u .......... */
+ for (j = 0; j <= l; ++j) {
+ e[j] = 0.;
+ }
+
+ for (j = 0; j <= l; ++j) {
+ f = d[j];
+ g = e[j] + a[j + j * *nm] * f;
+
+ for (k = j+1; k <= l; ++k) {
+ g += a[k + j * *nm] * d[k];
+ e[k] += a[k + j * *nm] * f;
+ }
+ e[j] = g;
+ }
+/* .......... form p .......... */
+ f = 0.;
+
+ for (j = 0; j <= l; ++j) {
+ e[j] /= h;
+ f += e[j] * d[j];
+ }
+
+ h = f / (h + h);
+/* .......... form q .......... */
+ for (j = 0; j <= l; ++j) {
+ e[j] -= h * d[j];
+ }
+/* .......... form reduced a .......... */
+ for (j = 0; j <= l; ++j) {
+ f = d[j];
+ g = e[j];
+
+ for (k = j; k <= l; ++k) {
+ a[k + j * *nm] = a[k + j * *nm] - f * e[k] - g * d[k];
+ }
+ }
+L285:
+ for (j = 0; j <= l; ++j) {
+ f = d[j];
+ d[j] = a[l + j * *nm];
+ a[l + j * *nm] = a[i + j * *nm];
+ a[i + j * *nm] = f * scale;
+ }
+ }
+} /* tred1_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/tred2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/tred2.c
new file mode 100644
index 0000000000000000000000000000000000000000..aac1efc321c1d695723727f79a26f105b6c62944
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/tred2.c
@@ -0,0 +1,174 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Subroutine */ void tred2_(nm, n, a, d, e, z)
+const integer *nm, *n;
+const doublereal *a;
+doublereal *d, *e, *z;
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal f, g, h;
+ static integer i, j, k, l;
+ static doublereal scale, hh;
+
+/* this subroutine is a translation of the algol procedure tred2, */
+/* num. math. 11, 181-195(1968) by martin, reinsch, and wilkinson. */
+/* handbook for auto. comp., vol.ii-linear algebra, 212-226(1971). */
+
+/* this subroutine reduces a real symmetric matrix to a */
+/* symmetric tridiagonal matrix using and accumulating */
+/* orthogonal similarity transformations. */
+
+/* on input */
+
+/* nm must be set to the row dimension of two-dimensional */
+/* array parameters as declared in the calling program */
+/* dimension statement. */
+
+/* n is the order of the matrix. */
+
+/* a contains the real symmetric input matrix. only the */
+/* lower triangle of the matrix need be supplied. */
+
+/* on output */
+
+/* d contains the diagonal elements of the tridiagonal matrix. */
+
+/* e contains the subdiagonal elements of the tridiagonal */
+/* matrix in its last n-1 positions. e(1) is set to zero. */
+
+/* z contains the orthogonal transformation matrix */
+/* produced in the reduction. */
+
+/* a and z may coincide. if distinct, a is unaltered. */
+
+/* questions and comments should be directed to burton s. garbow, */
+/* mathematics and computer science div, argonne national laboratory */
+
+/* this version dated august 1983. */
+
+/* ------------------------------------------------------------------ */
+
+ for (i = 0; i < *n; ++i) {
+ for (j = i; j < *n; ++j) {
+ z[j + i * *nm] = a[j + i * *nm];
+ }
+
+ d[i] = a[*n-1 + i * *nm];
+ }
+
+ for (i = *n-1; i > 0; --i) {
+ l = i - 1;
+ h = 0.;
+ scale = 0.;
+/* .......... scale row (algol tol then not needed) .......... */
+ for (k = 0; k <= l; ++k) {
+ scale += abs(d[k]);
+ }
+ if (scale == 0.) {
+ e[i] = d[l];
+ for (j = 0; j <= l; ++j) {
+ d[j] = z[l + j * *nm];
+ z[i + j * *nm] = 0.;
+ z[j + i * *nm] = 0.;
+ }
+ goto L290;
+ }
+ for (k = 0; k <= l; ++k) {
+ d[k] /= scale;
+ h += d[k] * d[k];
+ }
+
+ f = d[l];
+ d__1 = sqrt(h);
+ g = -d_sign(&d__1, &f);
+ e[i] = scale * g;
+ h -= f * g;
+ d[l] = f - g;
+/* .......... form a*u .......... */
+ for (j = 0; j <= l; ++j) {
+ e[j] = 0.;
+ }
+
+ for (j = 0; j <= l; ++j) {
+ f = d[j];
+ z[j + i * *nm] = f;
+ g = e[j] + z[j + j * *nm] * f;
+
+ for (k = j+1; k <= l; ++k) {
+ g += z[k + j * *nm] * d[k];
+ e[k] += z[k + j * *nm] * f;
+ }
+
+ e[j] = g;
+ }
+/* .......... form p .......... */
+ f = 0.;
+
+ for (j = 0; j <= l; ++j) {
+ e[j] /= h;
+ f += e[j] * d[j];
+ }
+
+ hh = f / (h + h);
+/* .......... form q .......... */
+ for (j = 0; j <= l; ++j) {
+ e[j] -= hh * d[j];
+ }
+/* .......... form reduced a .......... */
+ for (j = 0; j <= l; ++j) {
+ f = d[j];
+ g = e[j];
+
+ for (k = j; k <= l; ++k) {
+ z[k + j * *nm] = z[k + j * *nm] - f * e[k] - g * d[k];
+ }
+
+ d[j] = z[l + j * *nm];
+ z[i + j * *nm] = 0.;
+ }
+L290:
+ d[i] = h;
+ }
+/* .......... accumulation of transformation matrices .......... */
+ for (i = 1; i < *n; ++i) {
+ l = i - 1;
+ z[*n-1 + l * *nm] = z[l + l * *nm];
+ z[l + l * *nm] = 1.;
+ h = d[i];
+ if (h == 0.) {
+ goto L380;
+ }
+
+ for (k = 0; k <= l; ++k) {
+ d[k] = z[k + i * *nm] / h;
+ }
+
+ for (j = 0; j <= l; ++j) {
+ g = 0.;
+
+ for (k = 0; k <= l; ++k) {
+ g += z[k + i * *nm] * z[k + j * *nm];
+ }
+
+ for (k = 0; k <= l; ++k) {
+ z[k + j * *nm] -= g * d[k];
+ }
+ }
+L380:
+ for (k = 0; k <= l; ++k) {
+ z[k + i * *nm] = 0.;
+ }
+ }
+ for (i = 0; i < *n; ++i) {
+ d[i] = z[*n-1 + i * *nm];
+ z[*n-1 + i * *nm] = 0.;
+ }
+
+ z[*n-1 + (*n-1) * *nm] = 1.;
+ e[0] = 0.;
+} /* tred2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.README b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.README
new file mode 100644
index 0000000000000000000000000000000000000000..571d5689f736c9a6332a2be3769b8886d8982590
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.README
@@ -0,0 +1,181 @@
+Triangle
+A Two-Dimensional Quality Mesh Generator and Delaunay Triangulator.
+Version 1.3
+
+Show Me
+A Display Program for Meshes and More.
+Version 1.3
+
+Copyright 1996 Jonathan Richard Shewchuk
+School of Computer Science
+Carnegie Mellon University
+5000 Forbes Avenue
+Pittsburgh, Pennsylvania 15213-3891
+Please send bugs and comments to jrs@cs.cmu.edu
+
+Created as part of the Archimedes project (tools for parallel FEM).
+Supported in part by NSF Grant CMS-9318163 and an NSERC 1967 Scholarship.
+There is no warranty whatsoever. Use at your own risk.
+
+
+Triangle generates exact Delaunay triangulations, constrained Delaunay
+triangulations, and quality conforming Delaunay triangulations. The
+latter can be generated with no small angles, and are thus suitable for
+finite element analysis. Show Me graphically displays the contents of
+the geometric files used by Triangle. Show Me can also write images in
+PostScript form.
+
+Information on the algorithms used by Triangle, including complete
+references, can be found in the comments at the beginning of the triangle.c
+source file. Another listing of these references, with PostScript copies
+of some of the papers, is available from the Web page
+
+ http://www.cs.cmu.edu/~quake/triangle.research.html
+
+------------------------------------------------------------------------------
+
+These programs may be freely redistributed under the condition that the
+copyright notices (including the copy of this notice in the code comments
+and the copyright notice printed when the `-h' switch is selected) are
+not removed, and no compensation is received. Private, research, and
+institutional use is free. You may distribute modified versions of this
+code UNDER THE CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE TO IT
+IN THE SAME FILE REMAIN UNDER COPYRIGHT OF THE ORIGINAL AUTHOR, BOTH
+SOURCE AND OBJECT CODE ARE MADE FREELY AVAILABLE WITHOUT CHARGE, AND
+CLEAR NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution of this code as
+part of a commercial system is permissible ONLY BY DIRECT ARRANGEMENT
+WITH THE AUTHOR. (If you are not directly supplying this code to a
+customer, and you are instead telling them how they can obtain it for
+free, then you are not required to make any arrangement with me.)
+
+------------------------------------------------------------------------------
+
+The files included in this distribution are:
+
+ README The file you're reading now.
+ triangle.c Complete C source code for Triangle.
+ showme.c Complete C source code for Show Me.
+ triangle.h Include file for calling Triangle from another program.
+ tricall.c Sample program that calls Triangle.
+ makefile Makefile for compiling Triangle and Show Me.
+ A.poly A sample data file.
+
+Triangle and Show Me are each a single portable C file. The easiest way to
+compile them is to edit and use the included makefile. Before compiling,
+read the makefile, which describes your options, and edit it accordingly.
+You should specify:
+
+ The source and binary directories.
+
+ The C compiler and level of optimization.
+
+ Do you want single precision or double? Do you want to leave out some of
+ Triangle's features to reduce the size of the executable file?
+
+ The "correct" directories for include files (especially X include files),
+ if necessary.
+
+Once you've done this, type "make" to compile the programs. Alternatively,
+the files are usually easy to compile without a makefile:
+
+ cc -O -o triangle triangle.c -lm
+ cc -O -o showme showme.c -lX11
+
+On some systems, the C compiler won't be able to find the X include files
+or libraries, and you'll need to specify an include path or library path:
+
+ cc -O -I/usr/local/include -o showme showme.c -L/usr/local/lib -lX11
+
+However, on other systems (like my workstation), the latter incantation
+will cause the wrong files to be read, and the Show Me mouse buttons won't
+work properly in the main window. Hence, try the "-I" and "-L" switches
+ONLY if the compiler fails without it. (If you're using the makefile, you
+may edit it to add this switch.)
+
+Some processors, possibly including Intel x86 family and Motorola 68xxx
+family chips, are IEEE conformant but have extended length internal
+floating-point registers that may defeat Triangle's exact arithmetic
+routines by failing to cause enough roundoff error! Typically, there is
+a way to set these internal registers so that they are rounded off to
+IEEE single or double precision format. If you have such a processor,
+you should check your C compiler or system manuals to find out how to
+configure these internal registers to the precision you are using.
+Otherwise, the exact arithmetic routines won't be exact at all.
+Unfortunately, I don't have access to any such systems, and can't give
+advice on how to configure them. These problems don't occur on any
+workstations I am aware of. However, Triangle's exact arithmetic hasn't
+a hope of working on machines like the Cray C90 or Y-MP, which are not
+IEEE conformant and have inaccurate rounding.
+
+Triangle and Show Me both produce their own documentation. Complete
+instructions are printed by invoking each program with the `-h' switch:
+
+ triangle -h
+ showme -h
+
+The instructions are long; you'll probably want to pipe the output to
+`more' or `lpr' or redirect it to a file. Both programs give a short list
+of command line options if they are invoked without arguments (that is,
+just type `triangle' or `showme'). Alternatively, you may want to read
+the instructions on the World Wide Web. The appropriate URLs are:
+
+ http://www.cs.cmu.edu/~quake/triangle.html
+ http://www.cs.cmu.edu/~quake/showme.html
+
+Try out Triangle on the enclosed sample file, A.poly:
+
+ triangle -p A
+ showme A.poly &
+
+Triangle will read the Planar Straight Line Graph defined by A.poly, and
+write its constrained Delaunay triangulation to A.1.node and A.1.ele.
+Show Me will display the figure defined by A.poly. There are two buttons
+marked "ele" in the Show Me window; click on the top one. This will cause
+Show Me to load and display the triangulation.
+
+For contrast, try running
+
+ triangle -pq A
+
+Now, click on the same "ele" button. A new triangulation will be loaded;
+this one having no angles smaller than 20 degrees.
+
+To see a Voronoi diagram, try this:
+
+ cp A.poly A.node
+ triangle -v A
+
+Click the "ele" button again. You will see the Delaunay triangulation of
+the points in A.poly, without the segments. Now click the top "voro" button.
+You will see the Voronoi diagram corresponding to that Delaunay triangulation.
+Click the "Reset" button to see the full extent of the diagram.
+
+------------------------------------------------------------------------------
+
+If you wish to call Triangle from another program, instructions for doing
+so are contained in the file `triangle.h' (but read Triangle's regular
+instructions first!). Also look at `tricall.c', which provides an example.
+
+Type "make trilibrary" to create triangle.o, a callable object file.
+Alternatively, the object file is usually easy to compile without a
+makefile:
+
+ cc -DTRILIBRARY -O -c triangle.c
+
+------------------------------------------------------------------------------
+
+If you use Triangle, and especially if you use it to accomplish real
+work, I would like very much to hear from you. A short letter or email
+(to jrs@cs.cmu.edu) describing how you use Triangle will mean a lot to
+me. The more people I know are using this program, the more easily I can
+justify spending time on improvements and on the three-dimensional
+successor to Triangle, which in turn will benefit you. Also, I can put
+you on a list to receive email whenever a new version of Triangle is
+available.
+
+If you use a mesh generated by Triangle or plotted by Show Me in a
+publication, please include an acknowledgment as well.
+
+
+Jonathan Richard Shewchuk
+July 20, 1996
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.c
new file mode 100644
index 0000000000000000000000000000000000000000..9f6963c5f4087d59d917d877caead4a6003bfd36
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.c
@@ -0,0 +1,12622 @@
+/*****************************************************************************/
+/* */
+/* 888888888 ,o, / 888 */
+/* 888 88o88o " o8888o 88o8888o o88888o 888 o88888o */
+/* 888 888 888 88b 888 888 888 888 888 d888 88b */
+/* 888 888 888 o88^o888 888 888 "88888" 888 8888oo888 */
+/* 888 888 888 C888 888 888 888 / 888 q888 */
+/* 888 888 888 "88o^888 888 888 Cb 888 "88oooo" */
+/* "8oo8D */
+/* */
+/* A Two-Dimensional Quality Mesh Generator and Delaunay Triangulator. */
+/* (triangle.c) */
+/* */
+/* Version 1.3 */
+/* July 19, 1996 */
+/* */
+/* Copyright 1996 */
+/* Jonathan Richard Shewchuk */
+/* School of Computer Science */
+/* Carnegie Mellon University */
+/* 5000 Forbes Avenue */
+/* Pittsburgh, Pennsylvania 15213-3891 */
+/* jrs@cs.cmu.edu */
+/* */
+/* This program may be freely redistributed under the condition that the */
+/* copyright notices (including this entire header and the copyright */
+/* notice printed when the `-h' switch is selected) are not removed, and */
+/* no compensation is received. Private, research, and institutional */
+/* use is free. You may distribute modified versions of this code UNDER */
+/* THE CONDITION THAT THIS CODE AND ANY MODIFICATIONS MADE TO IT IN THE */
+/* SAME FILE REMAIN UNDER COPYRIGHT OF THE ORIGINAL AUTHOR, BOTH SOURCE */
+/* AND OBJECT CODE ARE MADE FREELY AVAILABLE WITHOUT CHARGE, AND CLEAR */
+/* NOTICE IS GIVEN OF THE MODIFICATIONS. Distribution of this code as */
+/* part of a commercial system is permissible ONLY BY DIRECT ARRANGEMENT */
+/* WITH THE AUTHOR. (If you are not directly supplying this code to a */
+/* customer, and you are instead telling them how they can obtain it for */
+/* free, then you are not required to make any arrangement with me.) */
+/* */
+/* Hypertext instructions for Triangle are available on the Web at */
+/* */
+/* http://www.cs.cmu.edu/~quake/triangle.html */
+/* */
+/* Some of the references listed below are marked [*]. These are available */
+/* for downloading from the Web page */
+/* */
+/* http://www.cs.cmu.edu/~quake/triangle.research.html */
+/* */
+/* A paper discussing some aspects of Triangle is available. See Jonathan */
+/* Richard Shewchuk, "Triangle: Engineering a 2D Quality Mesh Generator */
+/* and Delaunay Triangulator," First Workshop on Applied Computational */
+/* Geometry, ACM, May 1996. [*] */
+/* */
+/* Triangle was created as part of the Archimedes project in the School of */
+/* Computer Science at Carnegie Mellon University. Archimedes is a */
+/* system for compiling parallel finite element solvers. For further */
+/* information, see Anja Feldmann, Omar Ghattas, John R. Gilbert, Gary L. */
+/* Miller, David R. O'Hallaron, Eric J. Schwabe, Jonathan R. Shewchuk, */
+/* and Shang-Hua Teng, "Automated Parallel Solution of Unstructured PDE */
+/* Problems." To appear in Communications of the ACM, we hope. */
+/* */
+/* The quality mesh generation algorithm is due to Jim Ruppert, "A */
+/* Delaunay Refinement Algorithm for Quality 2-Dimensional Mesh */
+/* Generation," Journal of Algorithms 18(3):548-585, May 1995. [*] */
+/* */
+/* My implementation of the divide-and-conquer and incremental Delaunay */
+/* triangulation algorithms follows closely the presentation of Guibas */
+/* and Stolfi, even though I use a triangle-based data structure instead */
+/* of their quad-edge data structure. (In fact, I originally implemented */
+/* Triangle using the quad-edge data structure, but switching to a */
+/* triangle-based data structure sped Triangle by a factor of two.) The */
+/* mesh manipulation primitives and the two aforementioned Delaunay */
+/* triangulation algorithms are described by Leonidas J. Guibas and Jorge */
+/* Stolfi, "Primitives for the Manipulation of General Subdivisions and */
+/* the Computation of Voronoi Diagrams," ACM Transactions on Graphics */
+/* 4(2):74-123, April 1985. */
+/* */
+/* Their O(n log n) divide-and-conquer algorithm is adapted from Der-Tsai */
+/* Lee and Bruce J. Schachter, "Two Algorithms for Constructing the */
+/* Delaunay Triangulation," International Journal of Computer and */
+/* Information Science 9(3):219-242, 1980. The idea to improve the */
+/* divide-and-conquer algorithm by alternating between vertical and */
+/* horizontal cuts was introduced by Rex A. Dwyer, "A Faster Divide-and- */
+/* Conquer Algorithm for Constructing Delaunay Triangulations," */
+/* Algorithmica 2(2):137-151, 1987. */
+/* */
+/* The incremental insertion algorithm was first proposed by C. L. Lawson, */
+/* "Software for C1 Surface Interpolation," in Mathematical Software III, */
+/* John R. Rice, editor, Academic Press, New York, pp. 161-194, 1977. */
+/* For point location, I use the algorithm of Ernst P. Mucke, Isaac */
+/* Saias, and Binhai Zhu, "Fast Randomized Point Location Without */
+/* Preprocessing in Two- and Three-dimensional Delaunay Triangulations," */
+/* Proceedings of the Twelfth Annual Symposium on Computational Geometry, */
+/* ACM, May 1996. [*] If I were to randomize the order of point */
+/* insertion (I currently don't bother), their result combined with the */
+/* result of Leonidas J. Guibas, Donald E. Knuth, and Micha Sharir, */
+/* "Randomized Incremental Construction of Delaunay and Voronoi */
+/* Diagrams," Algorithmica 7(4):381-413, 1992, would yield an expected */
+/* O(n^{4/3}) bound on running time. */
+/* */
+/* The O(n log n) sweepline Delaunay triangulation algorithm is taken from */
+/* Steven Fortune, "A Sweepline Algorithm for Voronoi Diagrams", */
+/* Algorithmica 2(2):153-174, 1987. A random sample of edges on the */
+/* boundary of the triangulation are maintained in a splay tree for the */
+/* purpose of point location. Splay trees are described by Daniel */
+/* Dominic Sleator and Robert Endre Tarjan, "Self-Adjusting Binary Search */
+/* Trees," Journal of the ACM 32(3):652-686, July 1985. */
+/* */
+/* The algorithms for exact computation of the signs of determinants are */
+/* described in Jonathan Richard Shewchuk, "Adaptive Precision Floating- */
+/* Point Arithmetic and Fast Robust Geometric Predicates," Technical */
+/* Report CMU-CS-96-140, School of Computer Science, Carnegie Mellon */
+/* University, Pittsburgh, Pennsylvania, May 1996. [*] (Submitted to */
+/* Discrete & Computational Geometry.) An abbreviated version appears as */
+/* Jonathan Richard Shewchuk, "Robust Adaptive Floating-Point Geometric */
+/* Predicates," Proceedings of the Twelfth Annual Symposium on Computa- */
+/* tional Geometry, ACM, May 1996. [*] Many of the ideas for my exact */
+/* arithmetic routines originate with Douglas M. Priest, "Algorithms for */
+/* Arbitrary Precision Floating Point Arithmetic," Tenth Symposium on */
+/* Computer Arithmetic, 132-143, IEEE Computer Society Press, 1991. [*] */
+/* Many of the ideas for the correct evaluation of the signs of */
+/* determinants are taken from Steven Fortune and Christopher J. Van Wyk, */
+/* "Efficient Exact Arithmetic for Computational Geometry," Proceedings */
+/* of the Ninth Annual Symposium on Computational Geometry, ACM, */
+/* pp. 163-172, May 1993, and from Steven Fortune, "Numerical Stability */
+/* of Algorithms for 2D Delaunay Triangulations," International Journal */
+/* of Computational Geometry & Applications 5(1-2):193-213, March-June */
+/* 1995. */
+/* */
+/* For definitions of and results involving Delaunay triangulations, */
+/* constrained and conforming versions thereof, and other aspects of */
+/* triangular mesh generation, see the excellent survey by Marshall Bern */
+/* and David Eppstein, "Mesh Generation and Optimal Triangulation," in */
+/* Computing and Euclidean Geometry, Ding-Zhu Du and Frank Hwang, */
+/* editors, World Scientific, Singapore, pp. 23-90, 1992. */
+/* */
+/* The time for incrementally adding PSLG (planar straight line graph) */
+/* segments to create a constrained Delaunay triangulation is probably */
+/* O(n^2) per segment in the worst case and O(n) per edge in the common */
+/* case, where n is the number of triangles that intersect the segment */
+/* before it is inserted. This doesn't count point location, which can */
+/* be much more expensive. (This note does not apply to conforming */
+/* Delaunay triangulations, for which a different method is used to */
+/* insert segments.) */
+/* */
+/* The time for adding segments to a conforming Delaunay triangulation is */
+/* not clear, but does not depend upon n alone. In some cases, very */
+/* small features (like a point lying next to a segment) can cause a */
+/* single segment to be split an arbitrary number of times. Of course, */
+/* floating-point precision is a practical barrier to how much this can */
+/* happen. */
+/* */
+/* The time for deleting a point from a Delaunay triangulation is O(n^2) in */
+/* the worst case and O(n) in the common case, where n is the degree of */
+/* the point being deleted. I could improve this to expected O(n) time */
+/* by "inserting" the neighboring vertices in random order, but n is */
+/* usually quite small, so it's not worth the bother. (The O(n) time */
+/* for random insertion follows from L. Paul Chew, "Building Voronoi */
+/* Diagrams for Convex Polygons in Linear Expected Time," Technical */
+/* Report PCS-TR90-147, Department of Mathematics and Computer Science, */
+/* Dartmouth College, 1990. */
+/* */
+/* Ruppert's Delaunay refinement algorithm typically generates triangles */
+/* at a linear rate (constant time per triangle) after the initial */
+/* triangulation is formed. There may be pathological cases where more */
+/* time is required, but these never arise in practice. */
+/* */
+/* The segment intersection formulae are straightforward. If you want to */
+/* see them derived, see Franklin Antonio. "Faster Line Segment */
+/* Intersection." In Graphics Gems III (David Kirk, editor), pp. 199- */
+/* 202. Academic Press, Boston, 1992. */
+/* */
+/* If you make any improvements to this code, please please please let me */
+/* know, so that I may obtain the improvements. Even if you don't change */
+/* the code, I'd still love to hear what it's being used for. */
+/* */
+/* Disclaimer: Neither I nor Carnegie Mellon warrant this code in any way */
+/* whatsoever. This code is provided "as-is". Use at your own risk. */
+/* */
+/* Modifications: Ian Scott 10 Jan 2003 - attempt to quash 64 bit */
+/* conversion warnings. Replaced most (unsigned long) with */
+/* (ptr_sized_int). */
+/* Amitha Perera 13 Jan 2003 - replace ptr_sized_int with */
+/* intptr_t */
+/* */
+/*****************************************************************************/
+
+/* For single precision (which will save some memory and reduce paging), */
+/* define the symbol SINGLE by using the -DSINGLE compiler switch or by */
+/* writing "#define SINGLE" below. */
+/* */
+/* For double precision (which will allow you to refine meshes to a smaller */
+/* edge length), leave SINGLE undefined. */
+/* */
+/* Double precision uses more memory, but improves the resolution of the */
+/* meshes you can generate with Triangle. It also reduces the likelihood */
+/* of a floating exception due to overflow. Finally, it is much faster */
+/* than single precision on 64-bit architectures like the DEC Alpha. I */
+/* recommend double precision unless you want to generate a mesh for which */
+/* you do not have enough memory. */
+
+/* #define SINGLE */
+
+/* If yours is not a Unix system, define the NO_TIMER compiler switch to */
+/* remove the Unix-specific timing code. */
+
+#define NO_TIMER
+
+/* To insert lots of self-checks for internal errors, define the SELF_CHECK */
+/* symbol. This will slow down the program significantly. It is best to */
+/* define the symbol using the -DSELF_CHECK compiler switch, but you could */
+/* write "#define SELF_CHECK" below. If you are modifying this code, I */
+/* recommend you turn self-checks on. */
+
+/* #define SELF_CHECK */
+
+/* To compile Triangle as a callable object library (triangle.o), define the */
+/* TRILIBRARY symbol. Read the file triangle.h for details on how to call */
+/* the procedure triangulate() that results. */
+
+#define TRILIBRARY
+
+/* It is possible to generate a smaller version of Triangle using one or */
+/* both of the following symbols. Define the REDUCED symbol to eliminate */
+/* all features that are primarily of research interest; specifically, the */
+/* -i, -F, -s, and -C switches. Define the CDT_ONLY symbol to eliminate */
+/* all meshing algorithms above and beyond constrained Delaunay */
+/* triangulation; specifically, the -r, -q, -a, -S, and -s switches. */
+/* These reductions are most likely to be useful when generating an object */
+/* library (triangle.o) by defining the TRILIBRARY symbol. */
+
+/* #define REDUCED */
+/* #define CDT_ONLY */
+
+/* On some machines, the exact arithmetic routines might be defeated by the */
+/* use of internal extended precision floating-point registers. Sometimes */
+/* this problem can be fixed by defining certain values to be volatile, */
+/* thus forcing them to be stored to memory and rounded off. This isn't */
+/* a great solution, though, as it slows Triangle down. */
+/* */
+/* To try this out, write "#define INEXACT volatile" below. Normally, */
+/* however, INEXACT should be defined to be nothing. ("#define INEXACT".) */
+
+#define INEXACT /* Nothing */
+/* #define INEXACT volatile */
+
+/* Maximum number of characters in a file name (including the null). */
+
+#define FILENAMESIZE 1024
+
+/* Maximum number of characters in a line read from a file (including the */
+/* null). */
+
+#define INPUTLINESIZE 4096
+
+/* For efficiency, a variety of data structures are allocated in bulk. The */
+/* following constants determine how many of each structure is allocated */
+/* at once. */
+
+#define TRIPERBLOCK 4092 /* Number of triangles allocated at once. */
+#define SHELLEPERBLOCK 508 /* Number of shell edges allocated at once. */
+#define POINTPERBLOCK 4092 /* Number of points allocated at once. */
+#define VIRUSPERBLOCK 1020 /* Number of virus triangles allocated at once. */
+/* Number of encroached segments allocated at once. */
+#define BADSEGMENTPERBLOCK 252
+/* Number of skinny triangles allocated at once. */
+#define BADTRIPERBLOCK 4092
+/* Number of splay tree nodes allocated at once. */
+#define SPLAYNODEPERBLOCK 508
+
+/* The point marker DEADPOINT is an arbitrary number chosen large enough to */
+/* (hopefully) not conflict with user boundary markers. Make sure that it */
+/* is small enough to fit into your machine's integer size. */
+
+#define DEADPOINT -1073741824
+
+/* The next line is used to outsmart some very stupid compilers. If your */
+/* compiler is smarter, feel free to replace the "int" with "void". */
+/* Not that it matters. */
+
+#define VOID int
+
+/* Two constants for algorithms based on random sampling. Both constants */
+/* have been chosen empirically to optimize their respective algorithms. */
+
+/* Used for the point location scheme of Mucke, Saias, and Zhu, to decide */
+/* how large a random sample of triangles to inspect. */
+#define SAMPLEFACTOR 11
+/* Used in Fortune's sweepline Delaunay algorithm to determine what fraction */
+/* of boundary edges should be maintained in the splay tree for point */
+/* location on the front. */
+#define SAMPLERATE 10
+
+/* A number that speaks for itself, every kissable digit. */
+
+#define PI 3.141592653589793238462643383279502884197169399375105820974944592308
+
+/* Another fave. */
+
+#define SQUAREROOTTWO 1.4142135623730950488016887242096980785696718753769480732
+
+/* And here's one for those of you who are intimidated by math. */
+
+#define ONETHIRD 0.333333333333333333333333333333333333333333333333333333333333
+
+#include <stdio.h>
+#include <string.h>
+
+/* Borland compiler provides a "poly" function in math.h. This
+ conflicts with the variable name used below. Move the symbol out
+ of the way. */
+#ifdef __BORLANDC__
+# define poly borland_poly
+# include <math.h>
+# undef poly
+#else
+# include <math.h>
+#endif
+
+#ifndef NO_TIMER
+#include <sys/time.h>
+#endif /* NO_TIMER */
+#ifdef TRILIBRARY
+#include "triangle.h"
+#endif /* TRILIBRARY */
+
+/* The following obscenity seems to be necessary to ensure that this program */
+/* will port to Dec Alphas running OSF/1, because their stdio.h file commits */
+/* the unpardonable sin of including stdlib.h. Hence, malloc(), free(), and */
+/* exit() may or may not already be defined at this point. I declare these */
+/* functions explicitly because some non-ANSI C compilers lack stdlib.h. */
+
+#ifndef _MSC_VER
+#ifndef _STDLIB_H_
+extern void *malloc();
+extern void free();
+extern void exit();
+extern double strtod();
+extern long strtol();
+#endif /* _STDLIB_H_ */
+#else
+# include <stdlib.h>
+#endif
+
+/* A few forward declarations. */
+
+void poolrestart();
+#ifndef TRILIBRARY
+char *readline();
+char *findfield();
+#endif /* not TRILIBRARY */
+
+/* Labels that signify whether a record consists primarily of pointers or of */
+/* floating-point words. Used to make decisions about data alignment. */
+
+enum wordtype {POINTER, FLOATINGPOINT};
+
+/* Labels that signify the result of point location. The result of a */
+/* search indicates that the point falls in the interior of a triangle, on */
+/* an edge, on a vertex, or outside the mesh. */
+
+enum locateresult {INTRIANGLE, ONEDGE, ONVERTEX, OUTSIDE};
+
+/* Labels that signify the result of site insertion. The result indicates */
+/* that the point was inserted with complete success, was inserted but */
+/* encroaches on a segment, was not inserted because it lies on a segment, */
+/* or was not inserted because another point occupies the same location. */
+
+enum insertsiteresult {SUCCESSFULPOINT, ENCROACHINGPOINT, VIOLATINGPOINT,
+ DUPLICATEPOINT};
+
+/* Labels that signify the result of direction finding. The result */
+/* indicates that a segment connecting the two query points falls within */
+/* the direction triangle, along the left edge of the direction triangle, */
+/* or along the right edge of the direction triangle. */
+
+enum finddirectionresult {WITHIN, LEFTCOLLINEAR, RIGHTCOLLINEAR};
+
+/* Labels that signify the result of the circumcenter computation routine. */
+/* The return value indicates which edge of the triangle is shortest. */
+
+enum circumcenterresult {OPPOSITEORG, OPPOSITEDEST, OPPOSITEAPEX};
+
+/*****************************************************************************/
+/* */
+/* The basic mesh data structures */
+/* */
+/* There are three: points, triangles, and shell edges (abbreviated */
+/* `shelle'). These three data structures, linked by pointers, comprise */
+/* the mesh. A point simply represents a point in space and its properties.*/
+/* A triangle is a triangle. A shell edge is a special data structure used */
+/* to represent impenetrable segments in the mesh (including the outer */
+/* boundary, boundaries of holes, and internal boundaries separating two */
+/* triangulated regions). Shell edges represent boundaries defined by the */
+/* user that triangles may not lie across. */
+/* */
+/* A triangle consists of a list of three vertices, a list of three */
+/* adjoining triangles, a list of three adjoining shell edges (when shell */
+/* edges are used), an arbitrary number of optional user-defined floating- */
+/* point attributes, and an optional area constraint. The latter is an */
+/* upper bound on the permissible area of each triangle in a region, used */
+/* for mesh refinement. */
+/* */
+/* For a triangle on a boundary of the mesh, some or all of the neighboring */
+/* triangles may not be present. For a triangle in the interior of the */
+/* mesh, often no neighboring shell edges are present. Such absent */
+/* triangles and shell edges are never represented by NULL pointers; they */
+/* are represented by two special records: `dummytri', the triangle that */
+/* fills "outer space", and `dummysh', the omnipresent shell edge. */
+/* `dummytri' and `dummysh' are used for several reasons; for instance, */
+/* they can be dereferenced and their contents examined without causing the */
+/* memory protection exception that would occur if NULL were dereferenced. */
+/* */
+/* However, it is important to understand that a triangle includes other */
+/* information as well. The pointers to adjoining vertices, triangles, and */
+/* shell edges are ordered in a way that indicates their geometric relation */
+/* to each other. Furthermore, each of these pointers contains orientation */
+/* information. Each pointer to an adjoining triangle indicates which face */
+/* of that triangle is contacted. Similarly, each pointer to an adjoining */
+/* shell edge indicates which side of that shell edge is contacted, and how */
+/* the shell edge is oriented relative to the triangle. */
+/* */
+/* Shell edges are found abutting edges of triangles; either sandwiched */
+/* between two triangles, or resting against one triangle on an exterior */
+/* boundary or hole boundary. */
+/* */
+/* A shell edge consists of a list of two vertices, a list of two */
+/* adjoining shell edges, and a list of two adjoining triangles. One of */
+/* the two adjoining triangles may not be present (though there should */
+/* always be one), and neighboring shell edges might not be present. */
+/* Shell edges also store a user-defined integer "boundary marker". */
+/* Typically, this integer is used to indicate what sort of boundary */
+/* conditions are to be applied at that location in a finite element */
+/* simulation. */
+/* */
+/* Like triangles, shell edges maintain information about the relative */
+/* orientation of neighboring objects. */
+/* */
+/* Points are relatively simple. A point is a list of floating point */
+/* numbers, starting with the x, and y coordinates, followed by an */
+/* arbitrary number of optional user-defined floating-point attributes, */
+/* followed by an integer boundary marker. During the segment insertion */
+/* phase, there is also a pointer from each point to a triangle that may */
+/* contain it. Each pointer is not always correct, but when one is, it */
+/* speeds up segment insertion. These pointers are assigned values once */
+/* at the beginning of the segment insertion phase, and are not used or */
+/* updated at any other time. Edge swapping during segment insertion will */
+/* render some of them incorrect. Hence, don't rely upon them for */
+/* anything. For the most part, points do not have any information about */
+/* what triangles or shell edges they are linked to. */
+/* */
+/*****************************************************************************/
+
+/*****************************************************************************/
+/* */
+/* Handles */
+/* */
+/* The oriented triangle (`triedge') and oriented shell edge (`edge') data */
+/* structures defined below do not themselves store any part of the mesh. */
+/* The mesh itself is made of `triangle's, `shelle's, and `point's. */
+/* */
+/* Oriented triangles and oriented shell edges will usually be referred to */
+/* as "handles". A handle is essentially a pointer into the mesh; it */
+/* allows you to "hold" one particular part of the mesh. Handles are used */
+/* to specify the regions in which one is traversing and modifying the mesh.*/
+/* A single `triangle' may be held by many handles, or none at all. (The */
+/* latter case is not a memory leak, because the triangle is still */
+/* connected to other triangles in the mesh.) */
+/* */
+/* A `triedge' is a handle that holds a triangle. It holds a specific side */
+/* of the triangle. An `edge' is a handle that holds a shell edge. It */
+/* holds either the left or right side of the edge. */
+/* */
+/* Navigation about the mesh is accomplished through a set of mesh */
+/* manipulation primitives, further below. Many of these primitives take */
+/* a handle and produce a new handle that holds the mesh near the first */
+/* handle. Other primitives take two handles and glue the corresponding */
+/* parts of the mesh together. The exact position of the handles is */
+/* important. For instance, when two triangles are glued together by the */
+/* bond() primitive, they are glued by the sides on which the handles lie. */
+/* */
+/* Because points have no information about which triangles they are */
+/* attached to, I commonly represent a point by use of a handle whose */
+/* origin is the point. A single handle can simultaneously represent a */
+/* triangle, an edge, and a point. */
+/* */
+/*****************************************************************************/
+
+/* The triangle data structure. Each triangle contains three pointers to */
+/* adjoining triangles, plus three pointers to vertex points, plus three */
+/* pointers to shell edges (defined below; these pointers are usually */
+/* `dummysh'). It may or may not also contain user-defined attributes */
+/* and/or a floating-point "area constraint". It may also contain extra */
+/* pointers for nodes, when the user asks for high-order elements. */
+/* Because the size and structure of a `triangle' is not decided until */
+/* runtime, I haven't simply defined the type `triangle' to be a struct. */
+
+typedef REAL **triangle; /* Really: typedef triangle *triangle */
+
+/* An oriented triangle: includes a pointer to a triangle and orientation. */
+/* The orientation denotes an edge of the triangle. Hence, there are */
+/* three possible orientations. By convention, each edge is always */
+/* directed to point counterclockwise about the corresponding triangle. */
+
+struct triedge {
+ triangle *tri;
+ int orient; /* Ranges from 0 to 2. */
+};
+
+/* The shell data structure. Each shell edge contains two pointers to */
+/* adjoining shell edges, plus two pointers to vertex points, plus two */
+/* pointers to adjoining triangles, plus one shell marker. */
+
+typedef REAL **shelle; /* Really: typedef shelle *shelle */
+
+/* An oriented shell edge: includes a pointer to a shell edge and an */
+/* orientation. The orientation denotes a side of the edge. Hence, there */
+/* are two possible orientations. By convention, the edge is always */
+/* directed so that the "side" denoted is the right side of the edge. */
+
+struct edge {
+ shelle *sh;
+ int shorient; /* Ranges from 0 to 1. */
+};
+
+/* The point data structure. Each point is actually an array of REALs. */
+/* The number of REALs is unknown until runtime. An integer boundary */
+/* marker, and sometimes a pointer to a triangle, is appended after the */
+/* REALs. */
+
+typedef REAL *point;
+
+/* A queue used to store encroached segments. Each segment's vertices are */
+/* stored so that one can check whether a segment is still the same. */
+
+struct badsegment {
+ struct edge encsegment; /* An encroached segment. */
+ point segorg, segdest; /* The two vertices. */
+ struct badsegment *nextsegment; /* Pointer to next encroached segment. */
+};
+
+/* A queue used to store bad triangles. The key is the square of the cosine */
+/* of the smallest angle of the triangle. Each triangle's vertices are */
+/* stored so that one can check whether a triangle is still the same. */
+
+struct badface {
+ struct triedge badfacetri; /* A bad triangle. */
+ REAL key; /* cos^2 of smallest (apical) angle. */
+ point faceorg, facedest, faceapex; /* The three vertices. */
+ struct badface *nextface; /* Pointer to next bad triangle. */
+};
+
+/* A node in a heap used to store events for the sweepline Delaunay */
+/* algorithm. Nodes do not point directly to their parents or children in */
+/* the heap. Instead, each node knows its position in the heap, and can */
+/* look up its parent and children in a separate array. The `eventptr' */
+/* points either to a `point' or to a triangle (in encoded format, so that */
+/* an orientation is included). In the latter case, the origin of the */
+/* oriented triangle is the apex of a "circle event" of the sweepline */
+/* algorithm. To distinguish site events from circle events, all circle */
+/* events are given an invalid (smaller than `xmin') x-coordinate `xkey'. */
+
+struct event {
+ REAL xkey, ykey; /* Coordinates of the event. */
+ VOID *eventptr; /* Can be a point or the location of a circle event. */
+ int heapposition; /* Marks this event's position in the heap. */
+};
+
+/* A node in the splay tree. Each node holds an oriented ghost triangle */
+/* that represents a boundary edge of the growing triangulation. When a */
+/* circle event covers two boundary edges with a triangle, so that they */
+/* are no longer boundary edges, those edges are not immediately deleted */
+/* from the tree; rather, they are lazily deleted when they are next */
+/* encountered. (Since only a random sample of boundary edges are kept */
+/* in the tree, lazy deletion is faster.) `keydest' is used to verify */
+/* that a triangle is still the same as when it entered the splay tree; if */
+/* it has been rotated (due to a circle event), it no longer represents a */
+/* boundary edge and should be deleted. */
+
+struct splaynode {
+ struct triedge keyedge; /* Lprev of an edge on the front. */
+ point keydest; /* Used to verify that splay node is still live. */
+ struct splaynode *lchild, *rchild; /* Children in splay tree. */
+};
+
+/* A type used to allocate memory. firstblock is the first block of items. */
+/* nowblock is the block from which items are currently being allocated. */
+/* nextitem points to the next slab of free memory for an item. */
+/* deaditemstack is the head of a linked list (stack) of deallocated items */
+/* that can be recycled. unallocateditems is the number of items that */
+/* remain to be allocated from nowblock. */
+/* */
+/* Traversal is the process of walking through the entire list of items, and */
+/* is separate from allocation. Note that a traversal will visit items on */
+/* the "deaditemstack" stack as well as live items. pathblock points to */
+/* the block currently being traversed. pathitem points to the next item */
+/* to be traversed. pathitemsleft is the number of items that remain to */
+/* be traversed in pathblock. */
+/* */
+/* itemwordtype is set to POINTER or FLOATINGPOINT, and is used to suggest */
+/* what sort of word the record is primarily made up of. alignbytes */
+/* determines how new records should be aligned in memory. itembytes and */
+/* itemwords are the length of a record in bytes (after rounding up) and */
+/* words. itemsperblock is the number of items allocated at once in a */
+/* single block. items is the number of currently allocated items. */
+/* maxitems is the maximum number of items that have been allocated at */
+/* once; it is the current number of items plus the number of records kept */
+/* on deaditemstack. */
+
+struct memorypool {
+ VOID **firstblock, **nowblock;
+ VOID *nextitem;
+ VOID *deaditemstack;
+ VOID **pathblock;
+ VOID *pathitem;
+ enum wordtype itemwordtype;
+ int alignbytes;
+ int itembytes, itemwords;
+ int itemsperblock;
+ long items, maxitems;
+ int unallocateditems;
+ int pathitemsleft;
+};
+
+/* Variables used to allocate memory for triangles, shell edges, points, */
+/* viri (triangles being eaten), bad (encroached) segments, bad (skinny */
+/* or too large) triangles, and splay tree nodes. */
+
+static struct memorypool triangles;
+static struct memorypool shelles;
+static struct memorypool points;
+static struct memorypool viri;
+static struct memorypool badsegments;
+static struct memorypool badtriangles;
+static struct memorypool splaynodes;
+
+/* Variables that maintain the bad triangle queues. The tails are pointers */
+/* to the pointers that have to be filled in to enqueue an item. */
+
+static struct badface *queuefront[64];
+static struct badface **queuetail[64];
+
+static REAL xmin, xmax, ymin, ymax; /* x and y bounds. */
+static REAL xminextreme; /* Nonexistent x value used as a flag in sweepline. */
+static int inpoints; /* Number of input points. */
+static int inelements; /* Number of input triangles. */
+static int insegments; /* Number of input segments. */
+static int holes; /* Number of input holes. */
+static int regions; /* Number of input regions. */
+static long edges; /* Number of output edges. */
+static int mesh_dim; /* Dimension (ought to be 2). */
+static int nextras; /* Number of attributes per point. */
+static int eextras; /* Number of attributes per triangle. */
+static long hullsize; /* Number of edges of convex hull. */
+static int triwords; /* Total words per triangle. */
+static int shwords; /* Total words per shell edge. */
+static int pointmarkindex; /* Index to find boundary marker of a point. */
+static int point2triindex; /* Index to find a triangle adjacent to a point. */
+static int highorderindex;/* Index to find extra nodes for high-order elements. */
+static int elemattribindex; /* Index to find attributes of a triangle. */
+static int areaboundindex; /* Index to find area bound of a triangle. */
+static int checksegments; /* Are there segments in the triangulation yet? */
+static int readnodefile; /* Has a .node file been read? */
+static long samples; /* Number of random samples for point location. */
+static unsigned long randomseed; /* Current random number seed. */
+
+static REAL splitter;/* Used to split REAL factors for exact multiplication. */
+static REAL epsilon; /* Floating-point machine epsilon. */
+static REAL resulterrbound;
+static REAL ccwerrboundA, ccwerrboundB, ccwerrboundC;
+static REAL iccerrboundA, iccerrboundB, iccerrboundC;
+
+static long incirclecount; /* Number of incircle tests performed. */
+static long counterclockcount;/* Number of counterclockwise tests performed. */
+static long hyperbolacount; /* Number of right-of-hyperbola tests performed. */
+static long circumcentercount;/* Number of circumcenter calculations performed. */
+static long circletopcount; /* Number of circle top calculations performed. */
+
+/* Switches for the triangulator. */
+/* poly: -p switch. refine: -r switch. */
+/* quality: -q switch. */
+/* minangle: minimum angle bound, specified after -q switch. */
+/* goodangle: cosine squared of minangle. */
+/* vararea: -a switch without number. */
+/* fixedarea: -a switch with number. */
+/* maxarea: maximum area bound, specified after -a switch. */
+/* regionattrib: -A switch. convex: -c switch. */
+/* firstnumber: inverse of -z switch. All items are numbered starting */
+/* from firstnumber. */
+/* edgesout: -e switch. voronoi: -v switch. */
+/* neighbors: -n switch. geomview: -g switch. */
+/* nobound: -B switch. nopolywritten: -P switch. */
+/* nonodewritten: -N switch. noelewritten: -E switch. */
+/* noiterationnum: -I switch. noholes: -O switch. */
+/* noexact: -X switch. */
+/* order: element order, specified after -o switch. */
+/* nobisect: count of how often -Y switch is selected. */
+/* steiner: maximum number of Steiner points, specified after -S switch. */
+/* steinerleft: number of Steiner points not yet used. */
+/* incremental: -i switch. sweepline: -F switch. */
+/* dwyer: inverse of -l switch. */
+/* splitseg: -s switch. */
+/* docheck: -C switch. */
+/* quiet: -Q switch. verbose: count of how often -V switch is selected. */
+/* useshelles: -p, -r, -q, or -c switch; determines whether shell edges */
+/* are used at all. */
+/* */
+/* Read the instructions to find out the meaning of these switches. */
+
+static int poly, refine, quality, vararea, fixedarea, regionattrib, convex;
+static int firstnumber;
+static int edgesout, voronoi, neighbors, geomview;
+static int nobound, nopolywritten, nonodewritten, noelewritten, noiterationnum;
+static int noholes, noexact;
+static int incremental, sweepline, dwyer;
+static int splitseg;
+static int docheck;
+static int quiet, verbose;
+static int useshelles;
+static int order;
+static int nobisect;
+static int steiner, steinerleft;
+static REAL minangle, goodangle;
+static REAL maxarea;
+
+/* Variables for file names. */
+
+#ifndef TRILIBRARY
+char innodefilename[FILENAMESIZE];
+char inelefilename[FILENAMESIZE];
+char inpolyfilename[FILENAMESIZE];
+char areafilename[FILENAMESIZE];
+char outnodefilename[FILENAMESIZE];
+char outelefilename[FILENAMESIZE];
+char outpolyfilename[FILENAMESIZE];
+char edgefilename[FILENAMESIZE];
+char vnodefilename[FILENAMESIZE];
+char vedgefilename[FILENAMESIZE];
+char neighborfilename[FILENAMESIZE];
+char offfilename[FILENAMESIZE];
+#endif /* not TRILIBRARY */
+
+/* Triangular bounding box points. */
+
+static point infpoint1, infpoint2, infpoint3;
+
+/* Pointer to the `triangle' that occupies all of "outer space". */
+
+static triangle *dummytri;
+static triangle *dummytribase; /* Keep base address so we can free() it later. */
+
+/* Pointer to the omnipresent shell edge. Referenced by any triangle or */
+/* shell edge that isn't really connected to a shell edge at that */
+/* location. */
+
+static shelle *dummysh;
+static shelle *dummyshbase; /* Keep base address so we can free() it later. */
+
+/* Pointer to a recently visited triangle. Improves point location if */
+/* proximate points are inserted sequentially. */
+
+static struct triedge recenttri;
+
+
+/* Deal with point types that are not unsigned long */
+#ifdef _MSC_VER
+# if _MSC_VER <= 1200
+ typedef unsigned long intptr_t;
+# else
+# include <stddef.h>
+# include <stdlib.h> /* for malloc and friends */
+# endif
+#else
+# if defined(__alpha) /* there is no inttypes.h here */
+ typedef unsigned long intptr_t;
+# elif defined(__CYGWIN__)
+# include <sys/types.h> /* for intptr_t on Cygwin */
+# elif defined(__BORLANDC__)
+# if __BORLANDC__ < 0x0560
+ typedef unsigned long intptr_t;
+# else
+# include <stdint.h> /* for intptr_t on Borland 5.6. */
+# endif
+# else
+# include <inttypes.h> /* for intptr_t on e.g. SGI, Linux, Solaris */
+# endif
+#endif
+
+/*****************************************************************************/
+/* */
+/* Mesh manipulation primitives. Each triangle contains three pointers to */
+/* other triangles, with orientations. Each pointer points not to the */
+/* first byte of a triangle, but to one of the first three bytes of a */
+/* triangle. It is necessary to extract both the triangle itself and the */
+/* orientation. To save memory, I keep both pieces of information in one */
+/* pointer. To make this possible, I assume that all triangles are aligned */
+/* to four-byte boundaries. The `decode' routine below decodes a pointer, */
+/* extracting an orientation (in the range 0 to 2) and a pointer to the */
+/* beginning of a triangle. The `encode' routine compresses a pointer to a */
+/* triangle and an orientation into a single pointer. My assumptions that */
+/* triangles are four-byte-aligned and that the `unsigned long' type is */
+/* long enough to hold a pointer are two of the few kludges in this program.*/
+/* */
+/* Shell edges are manipulated similarly. A pointer to a shell edge */
+/* carries both an address and an orientation in the range 0 to 1. */
+/* */
+/* The other primitives take an oriented triangle or oriented shell edge, */
+/* and return an oriented triangle or oriented shell edge or point; or they */
+/* change the connections in the data structure. */
+/* */
+/*****************************************************************************/
+
+/********* Mesh manipulation primitives begin here *********/
+/** **/
+/** **/
+
+/* Fast lookup arrays to speed some of the mesh manipulation primitives. */
+
+static int plus1mod3[3] = {1, 2, 0};
+static int minus1mod3[3] = {2, 0, 1};
+
+/********* Primitives for triangles *********/
+/* */
+/* */
+
+
+/* decode() converts a pointer to an oriented triangle. The orientation is */
+/* extracted from the two least significant bits of the pointer. */
+
+#define decode(ptr, triedge) \
+ (triedge).orient = (int) ((intptr_t) (ptr) & (intptr_t) 3l); \
+ (triedge).tri = (triangle *) \
+ ((intptr_t) (ptr) ^ (intptr_t) (triedge).orient)
+
+/* encode() compresses an oriented triangle into a single pointer. It */
+/* relies on the assumption that all triangles are aligned to four-byte */
+/* boundaries, so the two least significant bits of (triedge).tri are zero.*/
+
+#define encode(triedge) \
+ (triangle) ((intptr_t) (triedge).tri | (intptr_t) (triedge).orient)
+
+/* The following edge manipulation primitives are all described by Guibas */
+/* and Stolfi. However, they use an edge-based data structure, whereas I */
+/* am using a triangle-based data structure. */
+
+/* sym() finds the abutting triangle, on the same edge. Note that the */
+/* edge direction is necessarily reversed, because triangle/edge handles */
+/* are always directed counterclockwise around the triangle. */
+
+#define sym(triedge1, triedge2) \
+ ptr = (triedge1).tri[(triedge1).orient]; \
+ decode(ptr, triedge2);
+
+#define symself(triedge) \
+ ptr = (triedge).tri[(triedge).orient]; \
+ decode(ptr, triedge);
+
+/* lnext() finds the next edge (counterclockwise) of a triangle. */
+
+#define lnext(triedge1, triedge2) \
+ (triedge2).tri = (triedge1).tri; \
+ (triedge2).orient = plus1mod3[(triedge1).orient]
+
+#define lnextself(triedge) \
+ (triedge).orient = plus1mod3[(triedge).orient]
+
+/* lprev() finds the previous edge (clockwise) of a triangle. */
+
+#define lprev(triedge1, triedge2) \
+ (triedge2).tri = (triedge1).tri; \
+ (triedge2).orient = minus1mod3[(triedge1).orient]
+
+#define lprevself(triedge) \
+ (triedge).orient = minus1mod3[(triedge).orient]
+
+/* onext() spins counterclockwise around a point; that is, it finds the next */
+/* edge with the same origin in the counterclockwise direction. This edge */
+/* will be part of a different triangle. */
+
+#define onext(triedge1, triedge2) \
+ lprev(triedge1, triedge2); \
+ symself(triedge2);
+
+#define onextself(triedge) \
+ lprevself(triedge); \
+ symself(triedge);
+
+/* oprev() spins clockwise around a point; that is, it finds the next edge */
+/* with the same origin in the clockwise direction. This edge will be */
+/* part of a different triangle. */
+
+#define oprev(triedge1, triedge2) \
+ sym(triedge1, triedge2); \
+ lnextself(triedge2);
+
+#define oprevself(triedge) \
+ symself(triedge); \
+ lnextself(triedge);
+
+/* dnext() spins counterclockwise around a point; that is, it finds the next */
+/* edge with the same destination in the counterclockwise direction. This */
+/* edge will be part of a different triangle. */
+
+#define dnext(triedge1, triedge2) \
+ sym(triedge1, triedge2); \
+ lprevself(triedge2);
+
+#define dnextself(triedge) \
+ symself(triedge); \
+ lprevself(triedge);
+
+/* dprev() spins clockwise around a point; that is, it finds the next edge */
+/* with the same destination in the clockwise direction. This edge will */
+/* be part of a different triangle. */
+
+#define dprev(triedge1, triedge2) \
+ lnext(triedge1, triedge2); \
+ symself(triedge2);
+
+#define dprevself(triedge) \
+ lnextself(triedge); \
+ symself(triedge);
+
+/* rnext() moves one edge counterclockwise about the adjacent triangle. */
+/* (It's best understood by reading Guibas and Stolfi. It involves */
+/* changing triangles twice.) */
+
+#define rnext(triedge1, triedge2) \
+ sym(triedge1, triedge2); \
+ lnextself(triedge2); \
+ symself(triedge2);
+
+#define rnextself(triedge) \
+ symself(triedge); \
+ lnextself(triedge); \
+ symself(triedge);
+
+/* rnext() moves one edge clockwise about the adjacent triangle. */
+/* (It's best understood by reading Guibas and Stolfi. It involves */
+/* changing triangles twice.) */
+
+#define rprev(triedge1, triedge2) \
+ sym(triedge1, triedge2); \
+ lprevself(triedge2); \
+ symself(triedge2);
+
+#define rprevself(triedge) \
+ symself(triedge); \
+ lprevself(triedge); \
+ symself(triedge);
+
+/* These primitives determine or set the origin, destination, or apex of a */
+/* triangle. */
+
+#define org(triedge, pointptr) \
+ pointptr = (point) (triedge).tri[plus1mod3[(triedge).orient] + 3]
+
+#define dest(triedge, pointptr) \
+ pointptr = (point) (triedge).tri[minus1mod3[(triedge).orient] + 3]
+
+#define apex(triedge, pointptr) \
+ pointptr = (point) (triedge).tri[(triedge).orient + 3]
+
+#define setorg(triedge, pointptr) \
+ (triedge).tri[plus1mod3[(triedge).orient] + 3] = (triangle) pointptr
+
+#define setdest(triedge, pointptr) \
+ (triedge).tri[minus1mod3[(triedge).orient] + 3] = (triangle) pointptr
+
+#define setapex(triedge, pointptr) \
+ (triedge).tri[(triedge).orient + 3] = (triangle) pointptr
+
+#define setvertices2null(triedge) \
+ (triedge).tri[3] = (triangle) NULL; \
+ (triedge).tri[4] = (triangle) NULL; \
+ (triedge).tri[5] = (triangle) NULL;
+
+/* Bond two triangles together. */
+
+#define bond(triedge1, triedge2) \
+ (triedge1).tri[(triedge1).orient] = encode(triedge2); \
+ (triedge2).tri[(triedge2).orient] = encode(triedge1)
+
+/* Dissolve a bond (from one side). Note that the other triangle will still */
+/* think it's connected to this triangle. Usually, however, the other */
+/* triangle is being deleted entirely, or bonded to another triangle, so */
+/* it doesn't matter. */
+
+#define dissolve(triedge) \
+ (triedge).tri[(triedge).orient] = (triangle) dummytri
+
+/* Copy a triangle/edge handle. */
+
+#define triedgecopy(triedge1, triedge2) \
+ (triedge2).tri = (triedge1).tri; \
+ (triedge2).orient = (triedge1).orient
+
+/* Test for equality of triangle/edge handles. */
+
+#define triedgeequal(triedge1, triedge2) \
+ (((triedge1).tri == (triedge2).tri) && \
+ ((triedge1).orient == (triedge2).orient))
+
+/* Primitives to infect or cure a triangle with the virus. These rely on */
+/* the assumption that all shell edges are aligned to four-byte boundaries.*/
+
+#define infect(triedge) \
+ (triedge).tri[6] = (triangle) \
+ ((intptr_t) (triedge).tri[6] | (intptr_t) 2l)
+
+#define uninfect(triedge) \
+ (triedge).tri[6] = (triangle) \
+ ((intptr_t) (triedge).tri[6] & ~ (intptr_t) 2l)
+
+/* Test a triangle for viral infection. */
+
+#define infected(triedge) \
+ (((intptr_t) (triedge).tri[6] & (intptr_t) 2l) != 0)
+
+/* Check or set a triangle's attributes. */
+
+#define elemattribute(triedge, attnum) \
+ ((REAL *) (triedge).tri)[elemattribindex + (attnum)]
+
+#define setelemattribute(triedge, attnum, value) \
+ ((REAL *) (triedge).tri)[elemattribindex + (attnum)] = value
+
+/* Check or set a triangle's maximum area bound. */
+
+#define areabound(triedge) ((REAL *) (triedge).tri)[areaboundindex]
+
+#define setareabound(triedge, value) \
+ ((REAL *) (triedge).tri)[areaboundindex] = value
+
+/********* Primitives for shell edges *********/
+/* */
+/* */
+
+/* sdecode() converts a pointer to an oriented shell edge. The orientation */
+/* is extracted from the least significant bit of the pointer. The two */
+/* least significant bits (one for orientation, one for viral infection) */
+/* are masked out to produce the real pointer. */
+
+#define sdecode(sptr, edge) \
+ (edge).shorient = (int) ((intptr_t) (sptr) & (intptr_t) 1l); \
+ (edge).sh = (shelle *) \
+ ((intptr_t) (sptr) & ~ (intptr_t) 3l)
+
+/* sencode() compresses an oriented shell edge into a single pointer. It */
+/* relies on the assumption that all shell edges are aligned to two-byte */
+/* boundaries, so the least significant bit of (edge).sh is zero. */
+
+#define sencode(edge) \
+ (shelle) ((intptr_t) (edge).sh | (intptr_t) (edge).shorient)
+
+/* ssym() toggles the orientation of a shell edge. */
+
+#define ssym(edge1, edge2) \
+ (edge2).sh = (edge1).sh; \
+ (edge2).shorient = 1 - (edge1).shorient
+
+#define ssymself(edge) \
+ (edge).shorient = 1 - (edge).shorient
+
+/* spivot() finds the other shell edge (from the same segment) that shares */
+/* the same origin. */
+
+#define spivot(edge1, edge2) \
+ sptr = (edge1).sh[(edge1).shorient]; \
+ sdecode(sptr, edge2)
+
+#define spivotself(edge) \
+ sptr = (edge).sh[(edge).shorient]; \
+ sdecode(sptr, edge)
+
+/* snext() finds the next shell edge (from the same segment) in sequence; */
+/* one whose origin is the input shell edge's destination. */
+
+#define snext(edge1, edge2) \
+ sptr = (edge1).sh[1 - (edge1).shorient]; \
+ sdecode(sptr, edge2)
+
+#define snextself(edge) \
+ sptr = (edge).sh[1 - (edge).shorient]; \
+ sdecode(sptr, edge)
+
+/* These primitives determine or set the origin or destination of a shell */
+/* edge. */
+
+#define sorg(edge, pointptr) \
+ pointptr = (point) (edge).sh[2 + (edge).shorient]
+
+#define sdest(edge, pointptr) \
+ pointptr = (point) (edge).sh[3 - (edge).shorient]
+
+#define setsorg(edge, pointptr) \
+ (edge).sh[2 + (edge).shorient] = (shelle) pointptr
+
+#define setsdest(edge, pointptr) \
+ (edge).sh[3 - (edge).shorient] = (shelle) pointptr
+
+/* These primitives read or set a shell marker. Shell markers are used to */
+/* hold user boundary information. */
+
+#define mark(edge) (* (int *) ((edge).sh + 6))
+
+#define setmark(edge, value) \
+ * (int *) ((edge).sh + 6) = value
+
+/* Bond two shell edges together. */
+
+#define sbond(edge1, edge2) \
+ (edge1).sh[(edge1).shorient] = sencode(edge2); \
+ (edge2).sh[(edge2).shorient] = sencode(edge1)
+
+/* Dissolve a shell edge bond (from one side). Note that the other shell */
+/* edge will still think it's connected to this shell edge. */
+
+#define sdissolve(edge) \
+ (edge).sh[(edge).shorient] = (shelle) dummysh
+
+/* Copy a shell edge. */
+
+#define shellecopy(edge1, edge2) \
+ (edge2).sh = (edge1).sh; \
+ (edge2).shorient = (edge1).shorient
+
+/* Test for equality of shell edges. */
+
+#define shelleequal(edge1, edge2) \
+ (((edge1).sh == (edge2).sh) && \
+ ((edge1).shorient == (edge2).shorient))
+
+/********* Primitives for interacting triangles and shell edges *********/
+/* */
+/* */
+
+/* tspivot() finds a shell edge abutting a triangle. */
+
+#define tspivot(triedge, edge) \
+ sptr = (shelle) (triedge).tri[6 + (triedge).orient]; \
+ sdecode(sptr, edge)
+
+/* stpivot() finds a triangle abutting a shell edge. It requires that the */
+/* variable `ptr' of type `triangle' be defined. */
+
+#define stpivot(edge, triedge) \
+ ptr = (triangle) (edge).sh[4 + (edge).shorient]; \
+ decode(ptr, triedge)
+
+/* Bond a triangle to a shell edge. */
+
+#define tsbond(triedge, edge) \
+ (triedge).tri[6 + (triedge).orient] = (triangle) sencode(edge); \
+ (edge).sh[4 + (edge).shorient] = (shelle) encode(triedge)
+
+/* Dissolve a bond (from the triangle side). */
+
+#define tsdissolve(triedge) \
+ (triedge).tri[6 + (triedge).orient] = (triangle) dummysh
+
+/* Dissolve a bond (from the shell edge side). */
+
+#define stdissolve(edge) \
+ (edge).sh[4 + (edge).shorient] = (shelle) dummytri
+
+/********* Primitives for points *********/
+/* */
+/* */
+
+#define pointmark(pt) ((int *) (pt))[pointmarkindex]
+
+#define setpointmark(pt, value) \
+ ((int *) (pt))[pointmarkindex] = value
+
+#define point2tri(pt) ((triangle *) (pt))[point2triindex]
+
+#define setpoint2tri(pt, value) \
+ ((triangle *) (pt))[point2triindex] = value
+
+/** **/
+/** **/
+/********* Mesh manipulation primitives end here *********/
+
+/********* User interaction routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* syntax() Print list of command line switches. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void syntax()
+{
+#ifdef CDT_ONLY
+#ifdef REDUCED
+ printf("triangle [-pAcevngBPNEIOXzo_lQVh] input_file\n");
+#else /* not REDUCED */
+ printf("triangle [-pAcevngBPNEIOXzo_iFlCQVh] input_file\n");
+#endif /* not REDUCED */
+#else /* not CDT_ONLY */
+#ifdef REDUCED
+ printf("triangle [-prq__a__AcevngBPNEIOXzo_YS__lQVh] input_file\n");
+#else /* not REDUCED */
+ printf("triangle [-prq__a__AcevngBPNEIOXzo_YS__iFlsCQVh] input_file\n");
+#endif /* not REDUCED */
+#endif /* not CDT_ONLY */
+
+ printf(" -p Triangulates a Planar Straight Line Graph (.poly file).\n");
+#ifndef CDT_ONLY
+ printf(" -r Refines a previously generated mesh.\n");
+ printf(
+ " -q Quality mesh generation. A minimum angle may be specified.\n");
+ printf(" -a Applies a maximum triangle area constraint.\n");
+#endif /* not CDT_ONLY */
+ printf(
+ " -A Applies attributes to identify elements in certain regions.\n");
+ printf(" -c Encloses the convex hull with segments.\n");
+ printf(" -e Generates an edge list.\n");
+ printf(" -v Generates a Voronoi diagram.\n");
+ printf(" -n Generates a list of triangle neighbors.\n");
+ printf(" -g Generates an .off file for Geomview.\n");
+ printf(" -B Suppresses output of boundary information.\n");
+ printf(" -P Suppresses output of .poly file.\n");
+ printf(" -N Suppresses output of .node file.\n");
+ printf(" -E Suppresses output of .ele file.\n");
+ printf(" -I Suppresses mesh iteration numbers.\n");
+ printf(" -O Ignores holes in .poly file.\n");
+ printf(" -X Suppresses use of exact arithmetic.\n");
+ printf(" -z Numbers all items starting from zero (rather than one).\n");
+ printf(" -o2 Generates second-order subparametric elements.\n");
+#ifndef CDT_ONLY
+ printf(" -Y Suppresses boundary segment splitting.\n");
+ printf(" -S Specifies maximum number of added Steiner points.\n");
+#endif /* not CDT_ONLY */
+#ifndef REDUCED
+ printf(" -i Uses incremental method, rather than divide-and-conquer.\n");
+ printf(" -F Uses Fortune's sweepline algorithm, rather than d-and-c.\n");
+#endif /* not REDUCED */
+ printf(" -l Uses vertical cuts only, rather than alternating cuts.\n");
+#ifndef REDUCED
+#ifndef CDT_ONLY
+ printf(
+ " -s Force segments into mesh by splitting (instead of using CDT).\n");
+#endif /* not CDT_ONLY */
+ printf(" -C Check consistency of final mesh.\n");
+#endif /* not REDUCED */
+ printf(" -Q Quiet: No terminal output except errors.\n");
+ printf(" -V Verbose: Detailed information on what I'm doing.\n");
+ printf(" -h Help: Detailed instructions for Triangle.\n");
+ exit(0);
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* info() Print out complete instructions. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void info()
+{
+ printf("Triangle\n");
+ printf("A Two-Dimensional Quality Mesh Generator and Delaunay Triangulator.\n");
+ printf("Version 1.3\n\n");
+
+ printf("Copyright 1996 Jonathan Richard Shewchuk (bugs/comments to jrs@cs.cmu.edu)\n");
+ printf("School of Computer Science / Carnegie Mellon University\n");
+ printf("5000 Forbes Avenue / Pittsburgh, Pennsylvania 15213-3891\n");
+ printf("Created as part of the Archimedes project (tools for parallel FEM).\n");
+ printf("Supported in part by NSF Grant CMS-9318163 and an NSERC 1967 Scholarship.\n");
+ printf("There is no warranty whatsoever. Use at your own risk.\n");
+#ifdef SINGLE
+ printf("This executable is compiled for single precision arithmetic.\n\n\n");
+#else /* not SINGLE */
+ printf("This executable is compiled for double precision arithmetic.\n\n\n");
+#endif /* not SINGLE */
+ printf("Triangle generates exact Delaunay triangulations, constrained Delaunay\n");
+ printf("triangulations, and quality conforming Delaunay triangulations. The latter\n");
+ printf("can be generated with no small angles, and are thus suitable for finite\n");
+ printf("element analysis. If no command line switches are specified, your .node\n");
+ printf("input file will be read, and the Delaunay triangulation will be returned in\n");
+ printf(".node and .ele output files. The command syntax is:\n\n");
+#ifdef CDT_ONLY
+#ifdef REDUCED
+ printf("triangle [-pAcevngBPNEIOXzo_lQVh] input_file\n\n");
+#else /* not REDUCED */
+ printf("triangle [-pAcevngBPNEIOXzo_iFlCQVh] input_file\n\n");
+#endif /* not REDUCED */
+#else /* not CDT_ONLY */
+#ifdef REDUCED
+ printf("triangle [-prq__a__AcevngBPNEIOXzo_YS__lQVh] input_file\n\n");
+#else /* not REDUCED */
+ printf("triangle [-prq__a__AcevngBPNEIOXzo_YS__iFlsCQVh] input_file\n\n");
+#endif /* not REDUCED */
+#endif /* not CDT_ONLY */
+ printf("Underscores indicate that numbers may optionally follow certain switches;\n");
+ printf("do not leave any space between a switch and its numeric parameter.\n");
+ printf("input_file must be a file with extension .node, or extension .poly if the\n");
+ printf("-p switch is used. If -r is used, you must supply .node and .ele files,\n");
+ printf("and possibly a .poly file and .area file as well. The formats of these\n");
+ printf("files are described below.\n\n");
+
+ printf("Command Line Switches:\n\n");
+
+ printf(" -p Reads a Planar Straight Line Graph (.poly file), which can specify\n");
+ printf(" points, segments, holes, and regional attributes and area\n");
+ printf(" constraints. Will generate a constrained Delaunay triangulation\n");
+ printf(" fitting the input; or, if -s, -q, or -a is used, a conforming\n");
+ printf(" Delaunay triangulation. If -p is not used, Triangle reads a .node\n");
+ printf(" file by default.\n");
+ printf(" -r Refines a previously generated mesh. The mesh is read from a .node\n");
+ printf(" file and an .ele file. If -p is also used, a .poly file is read\n");
+ printf(" and used to constrain edges in the mesh. Further details on\n");
+ printf(" refinement are given below.\n");
+ printf(" -q Quality mesh generation by Jim Ruppert's Delaunay refinement\n");
+ printf(" algorithm. Adds points to the mesh to ensure that no angles\n");
+ printf(" smaller than 20 degrees occur. An alternative minimum angle may be\n");
+ printf(" specified after the `q'. If the minimum angle is 20.7 degrees or\n");
+ printf(" smaller, the triangulation algorithm is theoretically guaranteed to\n");
+ printf(" terminate (assuming infinite precision arithmetic - Triangle may\n");
+ printf(" fail to terminate if you run out of precision). In practice, the\n");
+ printf(" algorithm often succeeds for minimum angles up to 33.8 degrees.\n");
+ printf(" For highly refined meshes, however, it may be necessary to reduce\n");
+ printf(" the minimum angle to well below 20 to avoid problems associated\n");
+ printf(" with insufficient floating-point precision. The specified angle\n");
+ printf(" may include a decimal point.\n");
+ printf(" -a Imposes a maximum triangle area. If a number follows the `a', no\n");
+ printf(" triangle will be generated whose area is larger than that number.\n");
+ printf(" If no number is specified, an .area file (if -r is used) or .poly\n");
+ printf(" file (if -r is not used) specifies a number of maximum area\n");
+ printf(" constraints. An .area file contains a separate area constraint for\n");
+ printf(" each triangle, and is useful for refining a finite element mesh\n");
+ printf(" based on a posteriori error estimates. A .poly file can optionally\n");
+ printf(" contain an area constraint for each segment-bounded region, thereby\n");
+ printf(" enforcing triangle densities in a first triangulation. You can\n");
+ printf(" impose both a fixed area constraint and a varying area constraint\n");
+ printf(" by invoking the -a switch twice, once with and once without a\n");
+ printf(" number following. Each area specified may include a decimal point.\n");
+ printf(" -A Assigns an additional attribute to each triangle that identifies\n");
+ printf(" what segment-bounded region each triangle belongs to. Attributes\n");
+ printf(" are assigned to regions by the .poly file. If a region is not\n");
+ printf(" explicitly marked by the .poly file, triangles in that region are\n");
+ printf(" assigned an attribute of zero. The -A switch has an effect only\n");
+ printf(" when the -p switch is used and the -r switch is not.\n");
+ printf(" -c Creates segments on the convex hull of the triangulation. If you\n");
+ printf(" are triangulating a point set, this switch causes a .poly file to\n");
+ printf(" be written, containing all edges in the convex hull. (By default,\n");
+ printf(" a .poly file is written only if a .poly file is read.) If you are\n");
+ printf(" triangulating a PSLG, this switch specifies that the interior of\n");
+ printf(" the convex hull of the PSLG should be triangulated. If you do not\n");
+ printf(" use this switch when triangulating a PSLG, it is assumed that you\n");
+ printf(" have identified the region to be triangulated by surrounding it\n");
+ printf(" with segments of the input PSLG. Beware: if you are not careful,\n");
+ printf(" this switch can cause the introduction of an extremely thin angle\n");
+ printf(" between a PSLG segment and a convex hull segment, which can cause\n");
+ printf(" overrefinement or failure if Triangle runs out of precision. If\n");
+ printf(" you are refining a mesh, the -c switch works differently; it\n");
+ printf(" generates the set of boundary edges of the mesh, rather than the\n");
+ printf(" convex hull.\n");
+ printf(" -e Outputs (to an .edge file) a list of edges of the triangulation.\n");
+ printf(" -v Outputs the Voronoi diagram associated with the triangulation.\n");
+ printf(" Does not attempt to detect degeneracies.\n");
+ printf(" -n Outputs (to a .neigh file) a list of triangles neighboring each\n");
+ printf(" triangle.\n");
+ printf(" -g Outputs the mesh to an Object File Format (.off) file, suitable for\n");
+ printf(" viewing with the Geometry Center's Geomview package.\n");
+ printf(" -B No boundary markers in the output .node, .poly, and .edge output\n");
+ printf(" files. See the detailed discussion of boundary markers below.\n");
+ printf(" -P No output .poly file. Saves disk space, but you lose the ability\n");
+ printf(" to impose segment constraints on later refinements of the mesh.\n");
+ printf(" -N No output .node file.\n");
+ printf(" -E No output .ele file.\n");
+ printf(" -I No iteration numbers. Suppresses the output of .node and .poly\n");
+ printf(" files, so your input files won't be overwritten. (If your input is\n");
+ printf(" a .poly file only, a .node file will be written.) Cannot be used\n");
+ printf(" with the -r switch, because that would overwrite your input .ele\n");
+ printf(" file. Shouldn't be used with the -s, -q, or -a switch if you are\n");
+ printf(" using a .node file for input, because no .node file will be\n");
+ printf(" written, so there will be no record of any added points.\n");
+ printf(" -O No holes. Ignores the holes in the .poly file.\n");
+ printf(" -X No exact arithmetic. Normally, Triangle uses exact floating-point\n");
+ printf(" arithmetic for certain tests if it thinks the inexact tests are not\n");
+ printf(" accurate enough. Exact arithmetic ensures the robustness of the\n");
+ printf(" triangulation algorithms, despite floating-point roundoff error.\n");
+ printf(" Disabling exact arithmetic with the -X switch will cause a small\n");
+ printf(" improvement in speed and create the possibility (albeit small) that\n");
+ printf(" Triangle will fail to produce a valid mesh. Not recommended.\n");
+ printf(" -z Numbers all items starting from zero (rather than one). Note that\n");
+ printf(" this switch is normally overrided by the value used to number the\n");
+ printf(" first point of the input .node or .poly file. However, this switch\n");
+ printf(" is useful when calling Triangle from another program.\n");
+ printf(" -o2 Generates second-order subparametric elements with six nodes each.\n");
+ printf(" -Y No new points on the boundary. This switch is useful when the mesh\n");
+ printf(" boundary must be preserved so that it conforms to some adjacent\n");
+ printf(" mesh. Be forewarned that you will probably sacrifice some of the\n");
+ printf(" quality of the mesh; Triangle will try, but the resulting mesh may\n");
+ printf(" contain triangles of poor aspect ratio. Works well if all the\n");
+ printf(" boundary points are closely spaced. Specify this switch twice\n");
+ printf(" (`-YY') to prevent all segment splitting, including internal\n");
+ printf(" boundaries.\n");
+ printf(" -S Specifies the maximum number of Steiner points (points that are not\n");
+ printf(" in the input, but are added to meet the constraints of minimum\n");
+ printf(" angle and maximum area). The default is to allow an unlimited\n");
+ printf(" number. If you specify this switch with no number after it,\n");
+ printf(" the limit is set to zero. Triangle always adds points at segment\n");
+ printf(" intersections, even if it needs to use more points than the limit\n");
+ printf(" you set. When Triangle inserts segments by splitting (-s), it\n");
+ printf(" always adds enough points to ensure that all the segments appear in\n");
+ printf(" the triangulation, again ignoring the limit. Be forewarned that\n");
+ printf(" the -S switch may result in a conforming triangulation that is not\n");
+ printf(" truly Delaunay, because Triangle may be forced to stop adding\n");
+ printf(" points when the mesh is in a state where a segment is non-Delaunay\n");
+ printf(" and needs to be split. If so, Triangle will print a warning.\n");
+ printf(" -i Uses an incremental rather than divide-and-conquer algorithm to\n");
+ printf(" form a Delaunay triangulation. Try it if the divide-and-conquer\n");
+ printf(" algorithm fails.\n");
+ printf(" -F Uses Steven Fortune's sweepline algorithm to form a Delaunay\n");
+ printf(" triangulation. Warning: does not use exact arithmetic for all\n");
+ printf(" calculations. An exact result is not guaranteed.\n");
+ printf(" -l Uses only vertical cuts in the divide-and-conquer algorithm. By\n");
+ printf(" default, Triangle uses alternating vertical and horizontal cuts,\n");
+ printf(" which usually improve the speed except with point sets that are\n");
+ printf(" small or short and wide. This switch is primarily of theoretical\n");
+ printf(" interest.\n");
+ printf(" -s Specifies that segments should be forced into the triangulation by\n");
+ printf(" recursively splitting them at their midpoints, rather than by\n");
+ printf(" generating a constrained Delaunay triangulation. Segment splitting\n");
+ printf(" is true to Ruppert's original algorithm, but can create needlessly\n");
+ printf(" small triangles near external small features.\n");
+ printf(" -C Check the consistency of the final mesh. Uses exact arithmetic for\n");
+ printf(" checking, even if the -X switch is used. Useful if you suspect\n");
+ printf(" Triangle is buggy.\n");
+ printf(" -Q Quiet: Suppresses all explanation of what Triangle is doing, unless\n");
+ printf(" an error occurs.\n");
+ printf(" -V Verbose: Gives detailed information about what Triangle is doing.\n");
+ printf(" Add more `V's for increasing amount of detail. `-V' gives\n");
+ printf(" information on algorithmic progress and more detailed statistics.\n");
+ printf(" `-VV' gives point-by-point details, and will print so much that\n");
+ printf(" Triangle will run much more slowly. `-VVV' gives information only\n");
+ printf(" a debugger could love.\n");
+ printf(" -h Help: Displays these instructions.\n\n");
+
+ printf("Definitions:\n\n");
+
+ printf(" A Delaunay triangulation of a point set is a triangulation whose vertices\n");
+ printf(" are the point set, having the property that no point in the point set\n");
+ printf(" falls in the interior of the circumcircle (circle that passes through all\n");
+ printf(" three vertices) of any triangle in the triangulation.\n\n");
+
+ printf(" A Voronoi diagram of a point set is a subdivision of the plane into\n");
+ printf(" polygonal regions (some of which may be infinite), where each region is\n");
+ printf(" the set of points in the plane that are closer to some input point than\n");
+ printf(" to any other input point. (The Voronoi diagram is the geometric dual of\n");
+ printf(" the Delaunay triangulation.)\n\n");
+
+ printf(" A Planar Straight Line Graph (PSLG) is a collection of points and\n");
+ printf(" segments. Segments are simply edges, whose endpoints are points in the\n");
+ printf(" PSLG. The file format for PSLGs (.poly files) is described below.\n\n");
+
+ printf(" A constrained Delaunay triangulation of a PSLG is similar to a Delaunay\n");
+ printf(" triangulation, but each PSLG segment is present as a single edge in the\n");
+ printf(" triangulation. (A constrained Delaunay triangulation is not truly a\n");
+ printf(" Delaunay triangulation.)\n\n");
+
+ printf(" A conforming Delaunay triangulation of a PSLG is a true Delaunay\n");
+ printf(" triangulation in which each PSLG segment may have been subdivided into\n");
+ printf(" several edges by the insertion of additional points. These inserted\n");
+ printf(" points are necessary to allow the segments to exist in the mesh while\n");
+ printf(" maintaining the Delaunay property.\n\n");
+
+ printf("File Formats:\n\n");
+
+ printf(" All files may contain comments prefixed by the character '#'. Points,\n");
+ printf(" triangles, edges, holes, and maximum area constraints must be numbered\n");
+ printf(" consecutively, starting from either 1 or 0. Whichever you choose, all\n");
+ printf(" input files must be consistent; if the nodes are numbered from 1, so must\n");
+ printf(" be all other objects. Triangle automatically detects your choice while\n");
+ printf(" reading the .node (or .poly) file. (When calling Triangle from another\n");
+ printf(" program, use the -z switch if you wish to number objects from zero.)\n");
+ printf(" Examples of these file formats are given below.\n\n");
+
+ printf(" .node files:\n");
+ printf(" First line: <# of points> <dimension (must be 2)> <# of attributes>\n");
+ printf(" <# of boundary markers (0 or 1)>\n");
+ printf(" Remaining lines: <point #> <x> <y> [attributes] [boundary marker]\n\n");
+
+ printf(" The attributes, which are typically floating-point values of physical\n");
+ printf(" quantities (such as mass or conductivity) associated with the nodes of\n");
+ printf(" a finite element mesh, are copied unchanged to the output mesh. If -s,\n");
+ printf(" -q, or -a is selected, each new Steiner point added to the mesh will\n");
+ printf(" have attributes assigned to it by linear interpolation.\n\n");
+
+ printf(" If the fourth entry of the first line is `1', the last column of the\n");
+ printf(" remainder of the file is assumed to contain boundary markers. Boundary\n");
+ printf(" markers are used to identify boundary points and points resting on PSLG\n");
+ printf(" segments; a complete description appears in a section below. The .node\n");
+ printf(" file produced by Triangle will contain boundary markers in the last\n");
+ printf(" column unless they are suppressed by the -B switch.\n\n");
+
+ printf(" .ele files:\n");
+ printf(" First line: <# of triangles> <points per triangle> <# of attributes>\n");
+ printf(" Remaining lines: <triangle #> <point> <point> <point> ... [attributes]\n\n");
+
+ printf(" Points are indices into the corresponding .node file. The first three\n");
+ printf(" points are the corners, and are listed in counterclockwise order around\n");
+ printf(" each triangle. (The remaining points, if any, depend on the type of\n");
+ printf(" finite element used.) The attributes are just like those of .node\n");
+ printf(" files. Because there is no simple mapping from input to output\n");
+ printf(" triangles, an attempt is made to interpolate attributes, which may\n");
+ printf(" result in a good deal of diffusion of attributes among nearby triangles\n");
+ printf(" as the triangulation is refined. Diffusion does not occur across\n");
+ printf(" segments, so attributes used to identify segment-bounded regions remain\n");
+ printf(" intact. In output .ele files, all triangles have three points each\n");
+ printf(" unless the -o2 switch is used, in which case they have six, and the\n");
+ printf(" fourth, fifth, and sixth points lie on the midpoints of the edges\n");
+ printf(" opposite the first, second, and third corners.\n\n");
+
+ printf(" .poly files:\n");
+ printf(" First line: <# of points> <dimension (must be 2)> <# of attributes>\n");
+ printf(" <# of boundary markers (0 or 1)>\n");
+ printf(" Following lines: <point #> <x> <y> [attributes] [boundary marker]\n");
+ printf(" One line: <# of segments> <# of boundary markers (0 or 1)>\n");
+ printf(" Following lines: <segment #> <endpoint> <endpoint> [boundary marker]\n");
+ printf(" One line: <# of holes>\n");
+ printf(" Following lines: <hole #> <x> <y>\n");
+ printf(" Optional line: <# of regional attributes and/or area constraints>\n");
+ printf(" Optional following lines: <constraint #> <x> <y> <attrib> <max area>\n\n");
+
+ printf(" A .poly file represents a PSLG, as well as some additional information.\n");
+ printf(" The first section lists all the points, and is identical to the format\n");
+ printf(" of .node files. <# of points> may be set to zero to indicate that the\n");
+ printf(" points are listed in a separate .node file; .poly files produced by\n");
+ printf(" Triangle always have this format. This has the advantage that a point\n");
+ printf(" set may easily be triangulated with or without segments. (The same\n");
+ printf(" effect can be achieved, albeit using more disk space, by making a copy\n");
+ printf(" of the .poly file with the extension .node; all sections of the file\n");
+ printf(" but the first are ignored.)\n\n");
+
+ printf(" The second section lists the segments. Segments are edges whose\n");
+ printf(" presence in the triangulation is enforced. Each segment is specified\n");
+ printf(" by listing the indices of its two endpoints. This means that you must\n");
+ printf(" include its endpoints in the point list. If -s, -q, and -a are not\n");
+ printf(" selected, Triangle will produce a constrained Delaunay triangulation,\n");
+ printf(" in which each segment appears as a single edge in the triangulation.\n");
+ printf(" If -q or -a is selected, Triangle will produce a conforming Delaunay\n");
+ printf(" triangulation, in which segments may be subdivided into smaller edges.\n");
+ printf(" Each segment, like each point, may have a boundary marker.\n\n");
+
+ printf(" The third section lists holes (and concavities, if -c is selected) in\n");
+ printf(" the triangulation. Holes are specified by identifying a point inside\n");
+ printf(" each hole. After the triangulation is formed, Triangle creates holes\n");
+ printf(" by eating triangles, spreading out from each hole point until its\n");
+ printf(" progress is blocked by PSLG segments; you must be careful to enclose\n");
+ printf(" each hole in segments, or your whole triangulation may be eaten away.\n");
+ printf(" If the two triangles abutting a segment are eaten, the segment itself\n");
+ printf(" is also eaten. Do not place a hole directly on a segment; if you do,\n");
+ printf(" Triangle will choose one side of the segment arbitrarily.\n\n");
+
+ printf(" The optional fourth section lists regional attributes (to be assigned\n");
+ printf(" to all triangles in a region) and regional constraints on the maximum\n");
+ printf(" triangle area. Triangle will read this section only if the -A switch\n");
+ printf(" is used or the -a switch is used without a number following it, and the\n");
+ printf(" -r switch is not used. Regional attributes and area constraints are\n");
+ printf(" propagated in the same manner as holes; you specify a point for each\n");
+ printf(" attribute and/or constraint, and the attribute and/or constraint will\n");
+ printf(" affect the whole region (bounded by segments) containing the point. If\n");
+ printf(" two values are written on a line after the x and y coordinate, the\n");
+ printf(" former is assumed to be a regional attribute (but will only be applied\n");
+ printf(" if the -A switch is selected), and the latter is assumed to be a\n");
+ printf(" regional area constraint (but will only be applied if the -a switch is\n");
+ printf(" selected). You may also specify just one value after the coordinates,\n");
+ printf(" which can serve as both an attribute and an area constraint, depending\n");
+ printf(" on the choice of switches. If you are using the -A and -a switches\n");
+ printf(" simultaneously and wish to assign an attribute to some region without\n");
+ printf(" imposing an area constraint, use a negative maximum area.\n\n");
+
+ printf(" When a triangulation is created from a .poly file, you must either\n");
+ printf(" enclose the entire region to be triangulated in PSLG segments, or\n");
+ printf(" use the -c switch, which encloses the convex hull of the input point\n");
+ printf(" set. If you do not use the -c switch, Triangle will eat all triangles\n");
+ printf(" on the outer boundary that are not protected by segments; if you are\n");
+ printf(" not careful, your whole triangulation may be eaten away. If you do\n");
+ printf(" use the -c switch, you can still produce concavities by appropriate\n");
+ printf(" placement of holes just inside the convex hull.\n\n");
+
+ printf(" An ideal PSLG has no intersecting segments, nor any points that lie\n");
+ printf(" upon segments (except, of course, the endpoints of each segment.) You\n");
+ printf(" aren't required to make your .poly files ideal, but you should be aware\n");
+ printf(" of what can go wrong. Segment intersections are relatively safe -\n");
+ printf(" Triangle will calculate the intersection points for you and add them to\n");
+ printf(" the triangulation - as long as your machine's floating-point precision\n");
+ printf(" doesn't become a problem. You are tempting the fates if you have three\n");
+ printf(" segments that cross at the same location, and expect Triangle to figure\n");
+ printf(" out where the intersection point is. Thanks to floating-point roundoff\n");
+ printf(" error, Triangle will probably decide that the three segments intersect\n");
+ printf(" at three different points, and you will find a minuscule triangle in\n");
+ printf(" your output - unless Triangle tries to refine the tiny triangle, uses\n");
+ printf(" up the last bit of machine precision, and fails to terminate at all.\n");
+ printf(" You're better off putting the intersection point in the input files,\n");
+ printf(" and manually breaking up each segment into two. Similarly, if you\n");
+ printf(" place a point at the middle of a segment, and hope that Triangle will\n");
+ printf(" break up the segment at that point, you might get lucky. On the other\n");
+ printf(" hand, Triangle might decide that the point doesn't lie precisely on the\n");
+ printf(" line, and you'll have a needle-sharp triangle in your output - or a lot\n");
+ printf(" of tiny triangles if you're generating a quality mesh.\n\n");
+
+ printf(" When Triangle reads a .poly file, it also writes a .poly file, which\n");
+ printf(" includes all edges that are part of input segments. If the -c switch\n");
+ printf(" is used, the output .poly file will also include all of the edges on\n");
+ printf(" the convex hull. Hence, the output .poly file is useful for finding\n");
+ printf(" edges associated with input segments and setting boundary conditions in\n");
+ printf(" finite element simulations. More importantly, you will need it if you\n");
+ printf(" plan to refine the output mesh, and don't want segments to be missing\n");
+ printf(" in later triangulations.\n\n");
+
+ printf(" .area files:\n");
+ printf(" First line: <# of triangles>\n");
+ printf(" Following lines: <triangle #> <maximum area>\n\n");
+
+ printf(" An .area file associates with each triangle a maximum area that is used\n");
+ printf(" for mesh refinement. As with other file formats, every triangle must\n");
+ printf(" be represented, and they must be numbered consecutively. A triangle\n");
+ printf(" may be left unconstrained by assigning it a negative maximum area.\n\n");
+
+ printf(" .edge files:\n");
+ printf(" First line: <# of edges> <# of boundary markers (0 or 1)>\n");
+ printf(" Following lines: <edge #> <endpoint> <endpoint> [boundary marker]\n\n");
+
+ printf(" Endpoints are indices into the corresponding .node file. Triangle can\n");
+ printf(" produce .edge files (use the -e switch), but cannot read them. The\n");
+ printf(" optional column of boundary markers is suppressed by the -B switch.\n\n");
+
+ printf(" In Voronoi diagrams, one also finds a special kind of edge that is an\n");
+ printf(" infinite ray with only one endpoint. For these edges, a different\n");
+ printf(" format is used:\n\n");
+
+ printf(" <edge #> <endpoint> -1 <direction x> <direction y>\n\n");
+
+ printf(" The `direction' is a floating-point vector that indicates the direction\n");
+ printf(" of the infinite ray.\n\n");
+
+ printf(" .neigh files:\n");
+ printf(" First line: <# of triangles> <# of neighbors per triangle (always 3)>\n");
+ printf(" Following lines: <triangle #> <neighbor> <neighbor> <neighbor>\n\n");
+
+ printf(" Neighbors are indices into the corresponding .ele file. An index of -1\n");
+ printf(" indicates a mesh boundary, and therefore no neighbor. Triangle can\n");
+ printf(" produce .neigh files (use the -n switch), but cannot read them.\n\n");
+
+ printf(" The first neighbor of triangle i is opposite the first corner of\n");
+ printf(" triangle i, and so on.\n\n");
+
+ printf("Boundary Markers:\n\n");
+
+ printf(" Boundary markers are tags used mainly to identify which output points and\n");
+ printf(" edges are associated with which PSLG segment, and to identify which\n");
+ printf(" points and edges occur on a boundary of the triangulation. A common use\n");
+ printf(" is to determine where boundary conditions should be applied to a finite\n");
+ printf(" element mesh. You can prevent boundary markers from being written into\n");
+ printf(" files produced by Triangle by using the -B switch.\n\n");
+
+ printf(" The boundary marker associated with each segment in an output .poly file\n");
+ printf(" or edge in an output .edge file is chosen as follows:\n");
+ printf(" - If an output edge is part or all of a PSLG segment with a nonzero\n");
+ printf(" boundary marker, then the edge is assigned the same marker.\n");
+ printf(" - Otherwise, if the edge occurs on a boundary of the triangulation\n");
+ printf(" (including boundaries of holes), then the edge is assigned the marker\n");
+ printf(" one (1).\n");
+ printf(" - Otherwise, the edge is assigned the marker zero (0).\n");
+ printf(" The boundary marker associated with each point in an output .node file is\n");
+ printf(" chosen as follows:\n");
+ printf(" - If a point is assigned a nonzero boundary marker in the input file,\n");
+ printf(" then it is assigned the same marker in the output .node file.\n");
+ printf(" - Otherwise, if the point lies on a PSLG segment (including the\n");
+ printf(" segment's endpoints) with a nonzero boundary marker, then the point\n");
+ printf(" is assigned the same marker. If the point lies on several such\n");
+ printf(" segments, one of the markers is chosen arbitrarily.\n");
+ printf(" - Otherwise, if the point occurs on a boundary of the triangulation,\n");
+ printf(" then the point is assigned the marker one (1).\n");
+ printf(" - Otherwise, the point is assigned the marker zero (0).\n\n");
+
+ printf(" If you want Triangle to determine for you which points and edges are on\n");
+ printf(" the boundary, assign them the boundary marker zero (or use no markers at\n");
+ printf(" all) in your input files. Alternatively, you can mark some of them and\n");
+ printf(" leave others marked zero, allowing Triangle to label them.\n\n");
+
+ printf("Triangulation Iteration Numbers:\n\n");
+
+ printf(" Because Triangle can read and refine its own triangulations, input\n");
+ printf(" and output files have iteration numbers. For instance, Triangle might\n");
+ printf(" read the files mesh.3.node, mesh.3.ele, and mesh.3.poly, refine the\n");
+ printf(" triangulation, and output the files mesh.4.node, mesh.4.ele, and\n");
+ printf(" mesh.4.poly. Files with no iteration number are treated as if\n");
+ printf(" their iteration number is zero; hence, Triangle might read the file\n");
+ printf(" points.node, triangulate it, and produce the files points.1.node and\n");
+ printf(" points.1.ele.\n\n");
+
+ printf(" Iteration numbers allow you to create a sequence of successively finer\n");
+ printf(" meshes suitable for multigrid methods. They also allow you to produce a\n");
+ printf(" sequence of meshes using error estimate-driven mesh refinement.\n\n");
+
+ printf(" If you're not using refinement or quality meshing, and you don't like\n");
+ printf(" iteration numbers, use the -I switch to disable them. This switch will\n");
+ printf(" also disable output of .node and .poly files to prevent your input files\n");
+ printf(" from being overwritten. (If the input is a .poly file that contains its\n");
+ printf(" own points, a .node file will be written.)\n\n");
+
+ printf("Examples of How to Use Triangle:\n\n");
+
+ printf(" `triangle dots' will read points from dots.node, and write their Delaunay\n");
+ printf(" triangulation to dots.1.node and dots.1.ele. (dots.1.node will be\n");
+ printf(" identical to dots.node.) `triangle -I dots' writes the triangulation to\n");
+ printf(" dots.ele instead. (No additional .node file is needed, so none is\n");
+ printf(" written.)\n\n");
+
+ printf(" `triangle -pe object.1' will read a PSLG from object.1.poly (and possibly\n");
+ printf(" object.1.node, if the points are omitted from object.1.poly) and write\n");
+ printf(" their constrained Delaunay triangulation to object.2.node and\n");
+ printf(" object.2.ele. The segments will be copied to object.2.poly, and all\n");
+ printf(" edges will be written to object.2.edge.\n\n");
+
+ printf(" `triangle -pq31.5a.1 object' will read a PSLG from object.poly (and\n");
+ printf(" possibly object.node), generate a mesh whose angles are all greater than\n");
+ printf(" 31.5 degrees and whose triangles all have area smaller than 0.1, and\n");
+ printf(" write the mesh to object.1.node and object.1.ele. Each segment may have\n");
+ printf(" been broken up into multiple edges; the resulting constrained edges are\n");
+ printf(" written to object.1.poly.\n\n");
+
+ printf(" Here is a sample file `box.poly' describing a square with a square hole:\n\n");
+
+ printf(" # A box with eight points in 2D, no attributes, one boundary marker.\n");
+ printf(" 8 2 0 1\n");
+ printf(" # Outer box has these vertices:\n");
+ printf(" 1 0 0 0\n");
+ printf(" 2 0 3 0\n");
+ printf(" 3 3 0 0\n");
+ printf(" 4 3 3 33 # A special marker for this point.\n");
+ printf(" # Inner square has these vertices:\n");
+ printf(" 5 1 1 0\n");
+ printf(" 6 1 2 0\n");
+ printf(" 7 2 1 0\n");
+ printf(" 8 2 2 0\n");
+ printf(" # Five segments with boundary markers.\n");
+ printf(" 5 1\n");
+ printf(" 1 1 2 5 # Left side of outer box.\n");
+ printf(" 2 5 7 0 # Segments 2 through 5 enclose the hole.\n");
+ printf(" 3 7 8 0\n");
+ printf(" 4 8 6 10\n");
+ printf(" 5 6 5 0\n");
+ printf(" # One hole in the middle of the inner square.\n");
+ printf(" 1\n");
+ printf(" 1 1.5 1.5\n\n");
+
+ printf(" Note that some segments are missing from the outer square, so one must\n");
+ printf(" use the `-c' switch. After `triangle -pqc box.poly', here is the output\n");
+ printf(" file `box.1.node', with twelve points. The last four points were added\n");
+ printf(" to meet the angle constraint. Points 1, 2, and 9 have markers from\n");
+ printf(" segment 1. Points 6 and 8 have markers from segment 4. All the other\n");
+ printf(" points but 4 have been marked to indicate that they lie on a boundary.\n\n");
+
+ printf(" 12 2 0 1\n");
+ printf(" 1 0 0 5\n");
+ printf(" 2 0 3 5\n");
+ printf(" 3 3 0 1\n");
+ printf(" 4 3 3 33\n");
+ printf(" 5 1 1 1\n");
+ printf(" 6 1 2 10\n");
+ printf(" 7 2 1 1\n");
+ printf(" 8 2 2 10\n");
+ printf(" 9 0 1.5 5\n");
+ printf(" 10 1.5 0 1\n");
+ printf(" 11 3 1.5 1\n");
+ printf(" 12 1.5 3 1\n");
+ printf(" # Generated by triangle -pqc box.poly\n\n");
+
+ printf(" Here is the output file `box.1.ele', with twelve triangles.\n\n");
+
+ printf(" 12 3 0\n");
+ printf(" 1 5 6 9\n");
+ printf(" 2 10 3 7\n");
+ printf(" 3 6 8 12\n");
+ printf(" 4 9 1 5\n");
+ printf(" 5 6 2 9\n");
+ printf(" 6 7 3 11\n");
+ printf(" 7 11 4 8\n");
+ printf(" 8 7 5 10\n");
+ printf(" 9 12 2 6\n");
+ printf(" 10 8 7 11\n");
+ printf(" 11 5 1 10\n");
+ printf(" 12 8 4 12\n");
+ printf(" # Generated by triangle -pqc box.poly\n\n");
+
+ printf(" Here is the output file `box.1.poly'. Note that segments have been added\n");
+ printf(" to represent the convex hull, and some segments have been split by newly\n");
+ printf(" added points. Note also that <# of points> is set to zero to indicate\n");
+ printf(" that the points should be read from the .node file.\n\n");
+
+ printf(" 0 2 0 1\n");
+ printf(" 12 1\n");
+ printf(" 1 1 9 5\n");
+ printf(" 2 5 7 1\n");
+ printf(" 3 8 7 1\n");
+ printf(" 4 6 8 10\n");
+ printf(" 5 5 6 1\n");
+ printf(" 6 3 10 1\n");
+ printf(" 7 4 11 1\n");
+ printf(" 8 2 12 1\n");
+ printf(" 9 9 2 5\n");
+ printf(" 10 10 1 1\n");
+ printf(" 11 11 3 1\n");
+ printf(" 12 12 4 1\n");
+ printf(" 1\n");
+ printf(" 1 1.5 1.5\n");
+ printf(" # Generated by triangle -pqc box.poly\n\n");
+
+ printf("Refinement and Area Constraints:\n\n");
+
+ printf(" The -r switch causes a mesh (.node and .ele files) to be read and\n");
+ printf(" refined. If the -p switch is also used, a .poly file is read and used to\n");
+ printf(" specify edges that are constrained and cannot be eliminated (although\n");
+ printf(" they can be divided into smaller edges) by the refinement process.\n\n");
+
+ printf(" When you refine a mesh, you generally want to impose tighter quality\n");
+ printf(" constraints. One way to accomplish this is to use -q with a larger\n");
+ printf(" angle, or -a followed by a smaller area than you used to generate the\n");
+ printf(" mesh you are refining. Another way to do this is to create an .area\n");
+ printf(" file, which specifies a maximum area for each triangle, and use the -a\n");
+ printf(" switch (without a number following). Each triangle's area constraint is\n");
+ printf(" applied to that triangle. Area constraints tend to diffuse as the mesh\n");
+ printf(" is refined, so if there are large variations in area constraint between\n");
+ printf(" adjacent triangles, you may not get the results you want.\n\n");
+
+ printf(" If you are refining a mesh composed of linear (three-node) elements, the\n");
+ printf(" output mesh will contain all the nodes present in the input mesh, in the\n");
+ printf(" same order, with new nodes added at the end of the .node file. However,\n");
+ printf(" there is no guarantee that each output element is contained in a single\n");
+ printf(" input element. Often, output elements will overlap two input elements,\n");
+ printf(" and input edges are not present in the output mesh. Hence, a sequence of\n");
+ printf(" refined meshes will form a hierarchy of nodes, but not a hierarchy of\n");
+ printf(" elements. If you a refining a mesh of higher-order elements, the\n");
+ printf(" hierarchical property applies only to the nodes at the corners of an\n");
+ printf(" element; other nodes may not be present in the refined mesh.\n\n");
+
+ printf(" It is important to understand that maximum area constraints in .poly\n");
+ printf(" files are handled differently from those in .area files. A maximum area\n");
+ printf(" in a .poly file applies to the whole (segment-bounded) region in which a\n");
+ printf(" point falls, whereas a maximum area in an .area file applies to only one\n");
+ printf(" triangle. Area constraints in .poly files are used only when a mesh is\n");
+ printf(" first generated, whereas area constraints in .area files are used only to\n");
+ printf(" refine an existing mesh, and are typically based on a posteriori error\n");
+ printf(" estimates resulting from a finite element simulation on that mesh.\n\n");
+
+ printf(" `triangle -rq25 object.1' will read object.1.node and object.1.ele, then\n");
+ printf(" refine the triangulation to enforce a 25 degree minimum angle, and then\n");
+ printf(" write the refined triangulation to object.2.node and object.2.ele.\n\n");
+
+ printf(" `triangle -rpaa6.2 z.3' will read z.3.node, z.3.ele, z.3.poly, and\n");
+ printf(" z.3.area. After reconstructing the mesh and its segments, Triangle will\n");
+ printf(" refine the mesh so that no triangle has area greater than 6.2, and\n");
+ printf(" furthermore the triangles satisfy the maximum area constraints in\n");
+ printf(" z.3.area. The output is written to z.4.node, z.4.ele, and z.4.poly.\n\n");
+
+ printf(" The sequence `triangle -qa1 x', `triangle -rqa.3 x.1', `triangle -rqa.1\n");
+ printf(" x.2' creates a sequence of successively finer meshes x.1, x.2, and x.3,\n");
+ printf(" suitable for multigrid.\n\n");
+
+ printf("Convex Hulls and Mesh Boundaries:\n\n");
+
+ printf(" If the input is a point set (rather than a PSLG), Triangle produces its\n");
+ printf(" convex hull as a by-product in the output .poly file if you use the -c\n");
+ printf(" switch. There are faster algorithms for finding a two-dimensional convex\n");
+ printf(" hull than triangulation, of course, but this one comes for free. If the\n");
+ printf(" input is an unconstrained mesh (you are using the -r switch but not the\n");
+ printf(" -p switch), Triangle produces a list of its boundary edges (including\n");
+ printf(" hole boundaries) as a by-product if you use the -c switch.\n\n");
+
+ printf("Voronoi Diagrams:\n\n");
+
+ printf(" The -v switch produces a Voronoi diagram, in files suffixed .v.node and\n");
+ printf(" .v.edge. For example, `triangle -v points' will read points.node,\n");
+ printf(" produce its Delaunay triangulation in points.1.node and points.1.ele,\n");
+ printf(" and produce its Voronoi diagram in points.1.v.node and points.1.v.edge.\n");
+ printf(" The .v.node file contains a list of all Voronoi vertices, and the .v.edge\n");
+ printf(" file contains a list of all Voronoi edges, some of which may be infinite\n");
+ printf(" rays. (The choice of filenames makes it easy to run the set of Voronoi\n");
+ printf(" vertices through Triangle, if so desired.)\n\n");
+
+ printf(" This implementation does not use exact arithmetic to compute the Voronoi\n");
+ printf(" vertices, and does not check whether neighboring vertices are identical.\n");
+ printf(" Be forewarned that if the Delaunay triangulation is degenerate or\n");
+ printf(" near-degenerate, the Voronoi diagram may have duplicate points, crossing\n");
+ printf(" edges, or infinite rays whose direction vector is zero. Also, if you\n");
+ printf(" generate a constrained (as opposed to conforming) Delaunay triangulation,\n");
+ printf(" or if the triangulation has holes, the corresponding Voronoi diagram is\n");
+ printf(" likely to have crossing edges and unlikely to make sense.\n\n");
+
+ printf("Mesh Topology:\n\n");
+
+ printf(" You may wish to know which triangles are adjacent to a certain Delaunay\n");
+ printf(" edge in an .edge file, which Voronoi regions are adjacent to a certain\n");
+ printf(" Voronoi edge in a .v.edge file, or which Voronoi regions are adjacent to\n");
+ printf(" each other. All of this information can be found by cross-referencing\n");
+ printf(" output files with the recollection that the Delaunay triangulation and\n");
+ printf(" the Voronoi diagrams are planar duals.\n\n");
+
+ printf(" Specifically, edge i of an .edge file is the dual of Voronoi edge i of\n");
+ printf(" the corresponding .v.edge file, and is rotated 90 degrees counterclock-\n");
+ printf(" wise from the Voronoi edge. Triangle j of an .ele file is the dual of\n");
+ printf(" vertex j of the corresponding .v.node file; and Voronoi region k is the\n");
+ printf(" dual of point k of the corresponding .node file.\n\n");
+
+ printf(" Hence, to find the triangles adjacent to a Delaunay edge, look at the\n");
+ printf(" vertices of the corresponding Voronoi edge; their dual triangles are on\n");
+ printf(" the left and right of the Delaunay edge, respectively. To find the\n");
+ printf(" Voronoi regions adjacent to a Voronoi edge, look at the endpoints of the\n");
+ printf(" corresponding Delaunay edge; their dual regions are on the right and left\n");
+ printf(" of the Voronoi edge, respectively. To find which Voronoi regions are\n");
+ printf(" adjacent to each other, just read the list of Delaunay edges.\n\n");
+
+ printf("Statistics:\n\n");
+
+ printf(" After generating a mesh, Triangle prints a count of the number of points,\n");
+ printf(" triangles, edges, boundary edges, and segments in the output mesh. If\n");
+ printf(" you've forgotten the statistics for an existing mesh, the -rNEP switches\n");
+ printf(" (or -rpNEP if you've got a .poly file for the existing mesh) will\n");
+ printf(" regenerate these statistics without writing any output.\n\n");
+
+ printf(" The -V switch produces extended statistics, including a rough estimate\n");
+ printf(" of memory use and a histogram of triangle aspect ratios and angles in the\n");
+ printf(" mesh.\n\n");
+
+ printf("Exact Arithmetic:\n\n");
+
+ printf(" Triangle uses adaptive exact arithmetic to perform what computational\n");
+ printf(" geometers call the `orientation' and `incircle' tests. If the floating-\n");
+ printf(" point arithmetic of your machine conforms to the IEEE 754 standard (as\n");
+ printf(" most workstations do), and does not use extended precision internal\n");
+ printf(" registers, then your output is guaranteed to be an absolutely true\n");
+ printf(" Delaunay or conforming Delaunay triangulation, roundoff error\n");
+ printf(" notwithstanding. The word `adaptive' implies that these arithmetic\n");
+ printf(" routines compute the result only to the precision necessary to guarantee\n");
+ printf(" correctness, so they are usually nearly as fast as their approximate\n");
+ printf(" counterparts. The exact tests can be disabled with the -X switch. On\n");
+ printf(" most inputs, this switch will reduce the computation time by about eight\n");
+ printf(" percent - it's not worth the risk. There are rare difficult inputs\n");
+ printf(" (having many collinear and cocircular points), however, for which the\n");
+ printf(" difference could be a factor of two. These are precisely the inputs most\n");
+ printf(" likely to cause errors if you use the -X switch.\n\n");
+
+ printf(" Unfortunately, these routines don't solve every numerical problem. Exact\n");
+ printf(" arithmetic is not used to compute the positions of points, because the\n");
+ printf(" bit complexity of point coordinates would grow without bound. Hence,\n");
+ printf(" segment intersections aren't computed exactly; in very unusual cases,\n");
+ printf(" roundoff error in computing an intersection point might actually lead to\n");
+ printf(" an inverted triangle and an invalid triangulation. (This is one reason\n");
+ printf(" to compute your own intersection points in your .poly files.) Similarly,\n");
+ printf(" exact arithmetic is not used to compute the vertices of the Voronoi\n");
+ printf(" diagram.\n\n");
+
+ printf(" Underflow and overflow can also cause difficulties; the exact arithmetic\n");
+ printf(" routines do not ameliorate out-of-bounds exponents, which can arise\n");
+ printf(" during the orientation and incircle tests. As a rule of thumb, you\n");
+ printf(" should ensure that your input values are within a range such that their\n");
+ printf(" third powers can be taken without underflow or overflow. Underflow can\n");
+ printf(" silently prevent the tests from being performed exactly, while overflow\n");
+ printf(" will typically cause a floating exception.\n\n");
+
+ printf("Calling Triangle from Another Program:\n\n");
+
+ printf(" Read the file triangle.h for details.\n\n");
+
+ printf("Troubleshooting:\n\n");
+
+ printf(" Please read this section before mailing me bugs.\n\n");
+
+ printf(" `My output mesh has no triangles!'\n\n");
+
+ printf(" If you're using a PSLG, you've probably failed to specify a proper set\n");
+ printf(" of bounding segments, or forgotten to use the -c switch. Or you may\n");
+ printf(" have placed a hole badly. To test these possibilities, try again with\n");
+ printf(" the -c and -O switches. Alternatively, all your input points may be\n");
+ printf(" collinear, in which case you can hardly expect to triangulate them.\n\n");
+
+ printf(" `Triangle doesn't terminate, or just crashes.'\n\n");
+
+ printf(" Bad things can happen when triangles get so small that the distance\n");
+ printf(" between their vertices isn't much larger than the precision of your\n");
+ printf(" machine's arithmetic. If you've compiled Triangle for single-precision\n");
+ printf(" arithmetic, you might do better by recompiling it for double-precision.\n");
+ printf(" Then again, you might just have to settle for more lenient constraints\n");
+ printf(" on the minimum angle and the maximum area than you had planned.\n\n");
+
+ printf(" You can minimize precision problems by ensuring that the origin lies\n");
+ printf(" inside your point set, or even inside the densest part of your\n");
+ printf(" mesh. On the other hand, if you're triangulating an object whose x\n");
+ printf(" coordinates all fall between 6247133 and 6247134, you're not leaving\n");
+ printf(" much floating-point precision for Triangle to work with.\n\n");
+
+ printf(" Precision problems can occur covertly if the input PSLG contains two\n");
+ printf(" segments that meet (or intersect) at a very small angle, or if such an\n");
+ printf(" angle is introduced by the -c switch, which may occur if a point lies\n");
+ printf(" ever-so-slightly inside the convex hull, and is connected by a PSLG\n");
+ printf(" segment to a point on the convex hull. If you don't realize that a\n");
+ printf(" small angle is being formed, you might never discover why Triangle is\n");
+ printf(" crashing. To check for this possibility, use the -S switch (with an\n");
+ printf(" appropriate limit on the number of Steiner points, found by trial-and-\n");
+ printf(" error) to stop Triangle early, and view the output .poly file with\n");
+ printf(" Show Me (described below). Look carefully for small angles between\n");
+ printf(" segments; zoom in closely, as such segments might look like a single\n");
+ printf(" segment from a distance.\n\n");
+
+ printf(" If some of the input values are too large, Triangle may suffer a\n");
+ printf(" floating exception due to overflow when attempting to perform an\n");
+ printf(" orientation or incircle test. (Read the section on exact arithmetic\n");
+ printf(" above.) Again, I recommend compiling Triangle for double (rather\n");
+ printf(" than single) precision arithmetic.\n\n");
+
+ printf(" `The numbering of the output points doesn't match the input points.'\n\n");
+
+ printf(" You may have eaten some of your input points with a hole, or by placing\n");
+ printf(" them outside the area enclosed by segments.\n\n");
+
+ printf(" `Triangle executes without incident, but when I look at the resulting\n");
+ printf(" mesh, it has overlapping triangles or other geometric inconsistencies.'\n\n");
+
+ printf(" If you select the -X switch, Triangle's divide-and-conquer Delaunay\n");
+ printf(" triangulation algorithm occasionally makes mistakes due to floating-\n");
+ printf(" point roundoff error. Although these errors are rare, don't use the -X\n");
+ printf(" switch. If you still have problems, please report the bug.\n\n");
+
+ printf(" Strange things can happen if you've taken liberties with your PSLG. Do\n");
+ printf(" you have a point lying in the middle of a segment? Triangle sometimes\n");
+ printf(" copes poorly with that sort of thing. Do you want to lay out a collinear\n");
+ printf(" row of evenly spaced, segment-connected points? Have you simply defined\n");
+ printf(" one long segment connecting the leftmost point to the rightmost point,\n");
+ printf(" and a bunch of points lying along it? This method occasionally works,\n");
+ printf(" especially with horizontal and vertical lines, but often it doesn't, and\n");
+ printf(" you'll have to connect each adjacent pair of points with a separate\n");
+ printf(" segment. If you don't like it, tough.\n\n");
+
+ printf(" Furthermore, if you have segments that intersect other than at their\n");
+ printf(" endpoints, try not to let the intersections fall extremely close to PSLG\n");
+ printf(" points or each other.\n\n");
+
+ printf(" If you have problems refining a triangulation not produced by Triangle:\n");
+ printf(" Are you sure the triangulation is geometrically valid? Is it formatted\n");
+ printf(" correctly for Triangle? Are the triangles all listed so the first three\n");
+ printf(" points are their corners in counterclockwise order?\n\n");
+
+ printf("Show Me:\n\n");
+
+ printf(" Triangle comes with a separate program named `Show Me', whose primary\n");
+ printf(" purpose is to draw meshes on your screen or in PostScript. Its secondary\n");
+ printf(" purpose is to check the validity of your input files, and do so more\n");
+ printf(" thoroughly than Triangle does. Show Me requires that you have the X\n");
+ printf(" Windows system. If you didn't receive Show Me with Triangle, complain to\n");
+ printf(" whomever you obtained Triangle from, then send me mail.\n\n");
+
+ printf("Triangle on the Web:\n\n");
+
+ printf(" To see an illustrated, updated version of these instructions, check out\n\n");
+
+ printf(" http://www.cs.cmu.edu/~quake/triangle.html\n\n");
+
+ printf("A Brief Plea:\n\n");
+
+ printf(" If you use Triangle, and especially if you use it to accomplish real\n");
+ printf(" work, I would like very much to hear from you. A short letter or email\n");
+ printf(" (to jrs@cs.cmu.edu) describing how you use Triangle will mean a lot to\n");
+ printf(" me. The more people I know are using this program, the more easily I can\n");
+ printf(" justify spending time on improvements and on the three-dimensional\n");
+ printf(" successor to Triangle, which in turn will benefit you. Also, I can put\n");
+ printf(" you on a list to receive email whenever a new version of Triangle is\n");
+ printf(" available.\n\n");
+
+ printf(" If you use a mesh generated by Triangle in a publication, please include\n");
+ printf(" an acknowledgment as well.\n\n");
+
+ printf("Research credit:\n\n");
+
+ printf(" Of course, I can take credit for only a fraction of the ideas that made\n");
+ printf(" this mesh generator possible. Triangle owes its existence to the efforts\n");
+ printf(" of many fine computational geometers and other researchers, including\n");
+ printf(" Marshall Bern, L. Paul Chew, Boris Delaunay, Rex A. Dwyer, David\n");
+ printf(" Eppstein, Steven Fortune, Leonidas J. Guibas, Donald E. Knuth, C. L.\n");
+ printf(" Lawson, Der-Tsai Lee, Ernst P. Mucke, Douglas M. Priest, Jim Ruppert,\n");
+ printf(" Isaac Saias, Bruce J. Schachter, Micha Sharir, Jorge Stolfi, Christopher\n");
+ printf(" J. Van Wyk, David F. Watson, and Binhai Zhu. See the comments at the\n");
+ printf(" beginning of the source code for references.\n\n");
+ exit(0);
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* internalerror() Ask the user to send me the defective product. Exit. */
+/* */
+/*****************************************************************************/
+
+void internalerror(void)
+{
+ printf(" Please report this bug to jrs@cs.cmu.edu\n");
+ printf(" Include the message above, your input data set, and the exact\n");
+ printf(" command line you used to run Triangle.\n");
+ exit(1);
+}
+
+/*****************************************************************************/
+/* */
+/* parsecommandline() Read the command line, identify switches, and set */
+/* up options and file names. */
+/* */
+/* The effects of this routine are felt entirely through global variables. */
+/* */
+/*****************************************************************************/
+
+void parsecommandline(argc, argv)
+int argc;
+char **argv;
+{
+#ifdef TRILIBRARY
+#define STARTINDEX 0
+#else /* not TRILIBRARY */
+#define STARTINDEX 1
+ int increment;
+ int meshnumber;
+#endif /* not TRILIBRARY */
+ int i, j, k;
+ char workstring[FILENAMESIZE];
+
+ poly = refine = quality = vararea = fixedarea = regionattrib = convex = 0;
+ firstnumber = 1;
+ edgesout = voronoi = neighbors = geomview = 0;
+ nobound = nopolywritten = nonodewritten = noelewritten = noiterationnum = 0;
+ noholes = noexact = 0;
+ incremental = sweepline = 0;
+ dwyer = 1;
+ splitseg = 0;
+ docheck = 0;
+ nobisect = 0;
+ steiner = -1;
+ order = 1;
+ minangle = 0.0;
+ maxarea = -1.0;
+ quiet = verbose = 0;
+#ifndef TRILIBRARY
+ innodefilename[0] = '\0';
+#endif /* not TRILIBRARY */
+
+ for (i = STARTINDEX; i < argc; i++) {
+#ifndef TRILIBRARY
+ if (argv[i][0] == '-') {
+#endif /* not TRILIBRARY */
+ for (j = STARTINDEX; argv[i][j] != '\0'; j++) {
+ if (argv[i][j] == 'p') {
+ poly = 1;
+ }
+#ifndef CDT_ONLY
+ if (argv[i][j] == 'r') {
+ refine = 1;
+ }
+ if (argv[i][j] == 'q') {
+ quality = 1;
+ if (((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) ||
+ (argv[i][j + 1] == '.')) {
+ k = 0;
+ while (((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) ||
+ (argv[i][j + 1] == '.')) {
+ j++;
+ workstring[k] = argv[i][j];
+ k++;
+ }
+ workstring[k] = '\0';
+ minangle = (REAL) strtod(workstring, (char **) NULL);
+ } else {
+ minangle = 20.0;
+ }
+ }
+ if (argv[i][j] == 'a') {
+ quality = 1;
+ if (((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) ||
+ (argv[i][j + 1] == '.')) {
+ fixedarea = 1;
+ k = 0;
+ while (((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) ||
+ (argv[i][j + 1] == '.')) {
+ j++;
+ workstring[k] = argv[i][j];
+ k++;
+ }
+ workstring[k] = '\0';
+ maxarea = (REAL) strtod(workstring, (char **) NULL);
+ if (maxarea <= 0.0) {
+ printf("Error: Maximum area must be greater than zero.\n");
+ exit(1);
+ }
+ } else {
+ vararea = 1;
+ }
+ }
+#endif /* not CDT_ONLY */
+ if (argv[i][j] == 'A') {
+ regionattrib = 1;
+ }
+ if (argv[i][j] == 'c') {
+ convex = 1;
+ }
+ if (argv[i][j] == 'z') {
+ firstnumber = 0;
+ }
+ if (argv[i][j] == 'e') {
+ edgesout = 1;
+ }
+ if (argv[i][j] == 'v') {
+ voronoi = 1;
+ }
+ if (argv[i][j] == 'n') {
+ neighbors = 1;
+ }
+ if (argv[i][j] == 'g') {
+ geomview = 1;
+ }
+ if (argv[i][j] == 'B') {
+ nobound = 1;
+ }
+ if (argv[i][j] == 'P') {
+ nopolywritten = 1;
+ }
+ if (argv[i][j] == 'N') {
+ nonodewritten = 1;
+ }
+ if (argv[i][j] == 'E') {
+ noelewritten = 1;
+ }
+#ifndef TRILIBRARY
+ if (argv[i][j] == 'I') {
+ noiterationnum = 1;
+ }
+#endif /* not TRILIBRARY */
+ if (argv[i][j] == 'O') {
+ noholes = 1;
+ }
+ if (argv[i][j] == 'X') {
+ noexact = 1;
+ }
+ if (argv[i][j] == 'o') {
+ if (argv[i][j + 1] == '2') {
+ j++;
+ order = 2;
+ }
+ }
+#ifndef CDT_ONLY
+ if (argv[i][j] == 'Y') {
+ nobisect++;
+ }
+ if (argv[i][j] == 'S') {
+ steiner = 0;
+ while ((argv[i][j + 1] >= '0') && (argv[i][j + 1] <= '9')) {
+ j++;
+ steiner = steiner * 10 + (int) (argv[i][j] - '0');
+ }
+ }
+#endif /* not CDT_ONLY */
+#ifndef REDUCED
+ if (argv[i][j] == 'i') {
+ incremental = 1;
+ }
+ if (argv[i][j] == 'F') {
+ sweepline = 1;
+ }
+#endif /* not REDUCED */
+ if (argv[i][j] == 'l') {
+ dwyer = 0;
+ }
+#ifndef REDUCED
+#ifndef CDT_ONLY
+ if (argv[i][j] == 's') {
+ splitseg = 1;
+ }
+#endif /* not CDT_ONLY */
+ if (argv[i][j] == 'C') {
+ docheck = 1;
+ }
+#endif /* not REDUCED */
+ if (argv[i][j] == 'Q') {
+ quiet = 1;
+ }
+ if (argv[i][j] == 'V') {
+ verbose++;
+ }
+#ifndef TRILIBRARY
+ if ((argv[i][j] == 'h') || (argv[i][j] == 'H') || (argv[i][j] == '?')) {
+ info();
+ }
+#endif /* not TRILIBRARY */
+ }
+#ifndef TRILIBRARY
+ } else {
+ strncpy(innodefilename, argv[i], FILENAMESIZE - 1);
+ innodefilename[FILENAMESIZE - 1] = '\0';
+ }
+#endif /* not TRILIBRARY */
+ }
+#ifndef TRILIBRARY
+ if (innodefilename[0] == '\0') {
+ syntax();
+ }
+ if (!strcmp(&innodefilename[strlen(innodefilename) - 5], ".node")) {
+ innodefilename[strlen(innodefilename) - 5] = '\0';
+ }
+ if (!strcmp(&innodefilename[strlen(innodefilename) - 5], ".poly")) {
+ innodefilename[strlen(innodefilename) - 5] = '\0';
+ poly = 1;
+ }
+#ifndef CDT_ONLY
+ if (!strcmp(&innodefilename[strlen(innodefilename) - 4], ".ele")) {
+ innodefilename[strlen(innodefilename) - 4] = '\0';
+ refine = 1;
+ }
+ if (!strcmp(&innodefilename[strlen(innodefilename) - 5], ".area")) {
+ innodefilename[strlen(innodefilename) - 5] = '\0';
+ refine = 1;
+ quality = 1;
+ vararea = 1;
+ }
+#endif /* not CDT_ONLY */
+#endif /* not TRILIBRARY */
+ steinerleft = steiner;
+ useshelles = poly || refine || quality || convex;
+ goodangle = cos(minangle * PI / 180.0);
+ goodangle *= goodangle;
+ if (refine && noiterationnum) {
+ printf(
+ "Error: You cannot use the -I switch when refining a triangulation.\n");
+ exit(1);
+ }
+ /* Be careful not to allocate space for element area constraints that */
+ /* will never be assigned any value (other than the default -1.0). */
+ if (!refine && !poly) {
+ vararea = 0;
+ }
+ /* Be careful not to add an extra attribute to each element unless the */
+ /* input supports it (PSLG in, but not refining a preexisting mesh). */
+ if (refine || !poly) {
+ regionattrib = 0;
+ }
+
+#ifndef TRILIBRARY
+ strcpy(inpolyfilename, innodefilename);
+ strcpy(inelefilename, innodefilename);
+ strcpy(areafilename, innodefilename);
+ increment = 0;
+ strcpy(workstring, innodefilename);
+ j = 1;
+ while (workstring[j] != '\0') {
+ if ((workstring[j] == '.') && (workstring[j + 1] != '\0')) {
+ increment = j + 1;
+ }
+ j++;
+ }
+ meshnumber = 0;
+ if (increment > 0) {
+ j = increment;
+ do {
+ if ((workstring[j] >= '0') && (workstring[j] <= '9')) {
+ meshnumber = meshnumber * 10 + (int) (workstring[j] - '0');
+ } else {
+ increment = 0;
+ }
+ j++;
+ } while (workstring[j] != '\0');
+ }
+ if (noiterationnum) {
+ strcpy(outnodefilename, innodefilename);
+ strcpy(outelefilename, innodefilename);
+ strcpy(edgefilename, innodefilename);
+ strcpy(vnodefilename, innodefilename);
+ strcpy(vedgefilename, innodefilename);
+ strcpy(neighborfilename, innodefilename);
+ strcpy(offfilename, innodefilename);
+ strcat(outnodefilename, ".node");
+ strcat(outelefilename, ".ele");
+ strcat(edgefilename, ".edge");
+ strcat(vnodefilename, ".v.node");
+ strcat(vedgefilename, ".v.edge");
+ strcat(neighborfilename, ".neigh");
+ strcat(offfilename, ".off");
+ } else if (increment == 0) {
+ strcpy(outnodefilename, innodefilename);
+ strcpy(outpolyfilename, innodefilename);
+ strcpy(outelefilename, innodefilename);
+ strcpy(edgefilename, innodefilename);
+ strcpy(vnodefilename, innodefilename);
+ strcpy(vedgefilename, innodefilename);
+ strcpy(neighborfilename, innodefilename);
+ strcpy(offfilename, innodefilename);
+ strcat(outnodefilename, ".1.node");
+ strcat(outpolyfilename, ".1.poly");
+ strcat(outelefilename, ".1.ele");
+ strcat(edgefilename, ".1.edge");
+ strcat(vnodefilename, ".1.v.node");
+ strcat(vedgefilename, ".1.v.edge");
+ strcat(neighborfilename, ".1.neigh");
+ strcat(offfilename, ".1.off");
+ } else {
+ workstring[increment] = '%';
+ workstring[increment + 1] = 'd';
+ workstring[increment + 2] = '\0';
+ sprintf(outnodefilename, workstring, meshnumber + 1);
+ strcpy(outpolyfilename, outnodefilename);
+ strcpy(outelefilename, outnodefilename);
+ strcpy(edgefilename, outnodefilename);
+ strcpy(vnodefilename, outnodefilename);
+ strcpy(vedgefilename, outnodefilename);
+ strcpy(neighborfilename, outnodefilename);
+ strcpy(offfilename, outnodefilename);
+ strcat(outnodefilename, ".node");
+ strcat(outpolyfilename, ".poly");
+ strcat(outelefilename, ".ele");
+ strcat(edgefilename, ".edge");
+ strcat(vnodefilename, ".v.node");
+ strcat(vedgefilename, ".v.edge");
+ strcat(neighborfilename, ".neigh");
+ strcat(offfilename, ".off");
+ }
+ strcat(innodefilename, ".node");
+ strcat(inpolyfilename, ".poly");
+ strcat(inelefilename, ".ele");
+ strcat(areafilename, ".area");
+#endif /* not TRILIBRARY */
+}
+
+/** **/
+/** **/
+/********* User interaction routines begin here *********/
+
+/********* Debugging routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* print_cast() Convert a pointer to an unsigned long integer for display */
+/* */
+/* This is used to avoid compiler warnings for those compilers that check */
+/* and warn about potential 64-bit problems. */
+/*****************************************************************************/
+
+#if defined(_MSC_VER) && (_MSC_VER >= 1300)
+# pragma warning( push )
+ /* warning C4311: 'type cast' : pointer truncation from 'void *' to 'unsigned long' */
+# pragma warning( disable: 4311 )
+#endif
+
+static
+unsigned long print_cast( void* p )
+{
+ return (unsigned long)p;
+}
+
+#if defined(_MSC_VER) && (_MSC_VER >= 1300)
+# pragma warning( pop )
+#endif
+
+/*****************************************************************************/
+/* */
+/* printtriangle() Print out the details of a triangle/edge handle. */
+/* */
+/* I originally wrote this procedure to simplify debugging; it can be */
+/* called directly from the debugger, and presents information about a */
+/* triangle/edge handle in digestible form. It's also used when the */
+/* highest level of verbosity (`-VVV') is specified. */
+/* */
+/*****************************************************************************/
+
+void printtriangle(t)
+struct triedge *t;
+{
+ struct triedge printtri;
+ struct edge printsh;
+ point printpoint;
+
+ printf("triangle x%lx with orientation %d:\n", print_cast( t->tri ),
+ t->orient);
+ decode(t->tri[0], printtri);
+ if (printtri.tri == dummytri) {
+ printf(" [0] = Outer space\n");
+ } else {
+ printf(" [0] = x%lx %d\n", print_cast( printtri.tri ),
+ printtri.orient);
+ }
+ decode(t->tri[1], printtri);
+ if (printtri.tri == dummytri) {
+ printf(" [1] = Outer space\n");
+ } else {
+ printf(" [1] = x%lx %d\n", print_cast( printtri.tri ),
+ printtri.orient);
+ }
+ decode(t->tri[2], printtri);
+ if (printtri.tri == dummytri) {
+ printf(" [2] = Outer space\n");
+ } else {
+ printf(" [2] = x%lx %d\n", print_cast( printtri.tri ),
+ printtri.orient);
+ }
+ org(*t, printpoint);
+ if (printpoint == (point) NULL)
+ printf(" Origin[%d] = NULL\n", (t->orient + 1) % 3 + 3);
+ else
+ printf(" Origin[%d] = x%lx (%.12g, %.12g)\n",
+ (t->orient + 1) % 3 + 3, print_cast( printpoint ),
+ printpoint[0], printpoint[1]);
+ dest(*t, printpoint);
+ if (printpoint == (point) NULL)
+ printf(" Dest [%d] = NULL\n", (t->orient + 2) % 3 + 3);
+ else
+ printf(" Dest [%d] = x%lx (%.12g, %.12g)\n",
+ (t->orient + 2) % 3 + 3, print_cast( printpoint ),
+ printpoint[0], printpoint[1]);
+ apex(*t, printpoint);
+ if (printpoint == (point) NULL)
+ printf(" Apex [%d] = NULL\n", t->orient + 3);
+ else
+ printf(" Apex [%d] = x%lx (%.12g, %.12g)\n",
+ t->orient + 3, print_cast( printpoint ),
+ printpoint[0], printpoint[1]);
+ if (useshelles) {
+ sdecode(t->tri[6], printsh);
+ if (printsh.sh != dummysh) {
+ printf(" [6] = x%lx %d\n", print_cast( printsh.sh ),
+ printsh.shorient);
+ }
+ sdecode(t->tri[7], printsh);
+ if (printsh.sh != dummysh) {
+ printf(" [7] = x%lx %d\n", print_cast( printsh.sh ),
+ printsh.shorient);
+ }
+ sdecode(t->tri[8], printsh);
+ if (printsh.sh != dummysh) {
+ printf(" [8] = x%lx %d\n", print_cast( printsh.sh ),
+ printsh.shorient);
+ }
+ }
+ if (vararea) {
+ printf(" Area constraint: %.4g\n", areabound(*t));
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* printshelle() Print out the details of a shell edge handle. */
+/* */
+/* I originally wrote this procedure to simplify debugging; it can be */
+/* called directly from the debugger, and presents information about a */
+/* shell edge handle in digestible form. It's also used when the highest */
+/* level of verbosity (`-VVV') is specified. */
+/* */
+/*****************************************************************************/
+
+void printshelle(s)
+struct edge *s;
+{
+ struct edge printsh;
+ struct triedge printtri;
+ point printpoint;
+
+ printf("shell edge x%lx with orientation %d and mark %d:\n",
+ print_cast( s->sh ), s->shorient, mark(*s));
+ sdecode(s->sh[0], printsh);
+ if (printsh.sh == dummysh) {
+ printf(" [0] = No shell\n");
+ } else {
+ printf(" [0] = x%lx %d\n", print_cast( printsh.sh ),
+ printsh.shorient);
+ }
+ sdecode(s->sh[1], printsh);
+ if (printsh.sh == dummysh) {
+ printf(" [1] = No shell\n");
+ } else {
+ printf(" [1] = x%lx %d\n", print_cast( printsh.sh ),
+ printsh.shorient);
+ }
+ sorg(*s, printpoint);
+ if (printpoint == (point) NULL)
+ printf(" Origin[%d] = NULL\n", 2 + s->shorient);
+ else
+ printf(" Origin[%d] = x%lx (%.12g, %.12g)\n",
+ 2 + s->shorient, print_cast( printpoint ),
+ printpoint[0], printpoint[1]);
+ sdest(*s, printpoint);
+ if (printpoint == (point) NULL)
+ printf(" Dest [%d] = NULL\n", 3 - s->shorient);
+ else
+ printf(" Dest [%d] = x%lx (%.12g, %.12g)\n",
+ 3 - s->shorient, print_cast( printpoint ),
+ printpoint[0], printpoint[1]);
+ decode(s->sh[4], printtri);
+ if (printtri.tri == dummytri) {
+ printf(" [4] = Outer space\n");
+ } else {
+ printf(" [4] = x%lx %d\n", print_cast( printtri.tri ),
+ printtri.orient);
+ }
+ decode(s->sh[5], printtri);
+ if (printtri.tri == dummytri) {
+ printf(" [5] = Outer space\n");
+ } else {
+ printf(" [5] = x%lx %d\n", print_cast( printtri.tri ),
+ printtri.orient);
+ }
+}
+
+/** **/
+/** **/
+/********* Debugging routines end here *********/
+
+/********* Memory management routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* poolinit() Initialize a pool of memory for allocation of items. */
+/* */
+/* This routine initializes the machinery for allocating items. A `pool' */
+/* is created whose records have size at least `bytecount'. Items will be */
+/* allocated in `itemcount'-item blocks. Each item is assumed to be a */
+/* collection of words, and either pointers or floating-point values are */
+/* assumed to be the "primary" word type. (The "primary" word type is used */
+/* to determine alignment of items.) If `alignment' isn't zero, all items */
+/* will be `alignment'-byte aligned in memory. `alignment' must be either */
+/* a multiple or a factor of the primary word size; powers of two are safe. */
+/* `alignment' is normally used to create a few unused bits at the bottom */
+/* of each item's pointer, in which information may be stored. */
+/* */
+/* Don't change this routine unless you understand it. */
+/* */
+/*****************************************************************************/
+
+void poolinit(pool, bytecount, itemcount, wtype, alignment)
+struct memorypool *pool;
+int bytecount;
+int itemcount;
+enum wordtype wtype;
+int alignment;
+{
+ int wordsize;
+
+ /* Initialize values in the pool. */
+ pool->itemwordtype = wtype;
+ wordsize = (pool->itemwordtype == POINTER) ? sizeof(VOID *) : sizeof(REAL);
+ /* Find the proper alignment, which must be at least as large as: */
+ /* - The parameter `alignment'. */
+ /* - The primary word type, to avoid unaligned accesses. */
+ /* - sizeof(VOID *), so the stack of dead items can be maintained */
+ /* without unaligned accesses. */
+ if (alignment > wordsize) {
+ pool->alignbytes = alignment;
+ } else {
+ pool->alignbytes = wordsize;
+ }
+ if ((int)sizeof(VOID *) > pool->alignbytes) {
+ pool->alignbytes = sizeof(VOID *);
+ }
+ pool->itemwords = ((bytecount + pool->alignbytes - 1) / pool->alignbytes)
+ * (pool->alignbytes / wordsize);
+ pool->itembytes = pool->itemwords * wordsize;
+ pool->itemsperblock = itemcount;
+
+ /* Allocate a block of items. Space for `itemsperblock' items and one */
+ /* pointer (to point to the next block) are allocated, as well as space */
+ /* to ensure alignment of the items. */
+ pool->firstblock = (VOID **) malloc(pool->itemsperblock * pool->itembytes
+ + sizeof(VOID *) + pool->alignbytes);
+ if (pool->firstblock == (VOID **) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ /* Set the next block pointer to NULL. */
+ *(pool->firstblock) = (VOID *) NULL;
+ poolrestart(pool);
+}
+
+/*****************************************************************************/
+/* */
+/* poolrestart() Deallocate all items in a pool. */
+/* */
+/* The pool is returned to its starting state, except that no memory is */
+/* freed to the operating system. Rather, the previously allocated blocks */
+/* are ready to be reused. */
+/* */
+/*****************************************************************************/
+
+void poolrestart(pool)
+struct memorypool *pool;
+{
+ intptr_t alignptr;
+
+ pool->items = 0;
+ pool->maxitems = 0;
+
+ /* Set the currently active block. */
+ pool->nowblock = pool->firstblock;
+ /* Find the first item in the pool. Increment by the size of (VOID *). */
+ alignptr = (intptr_t) (pool->nowblock + 1);
+ /* Align the item on an `alignbytes'-byte boundary. */
+ pool->nextitem = (VOID *)
+ (alignptr + (intptr_t) pool->alignbytes
+ - (alignptr % (intptr_t) pool->alignbytes));
+ /* There are lots of unallocated items left in this block. */
+ pool->unallocateditems = pool->itemsperblock;
+ /* The stack of deallocated items is empty. */
+ pool->deaditemstack = (VOID *) NULL;
+}
+
+/*****************************************************************************/
+/* */
+/* pooldeinit() Free to the operating system all memory taken by a pool. */
+/* */
+/*****************************************************************************/
+
+void pooldeinit(pool)
+struct memorypool *pool;
+{
+ while (pool->firstblock != (VOID **) NULL) {
+ pool->nowblock = (VOID **) *(pool->firstblock);
+ free(pool->firstblock);
+ pool->firstblock = pool->nowblock;
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* poolalloc() Allocate space for an item. */
+/* */
+/*****************************************************************************/
+
+VOID *poolalloc(pool)
+struct memorypool *pool;
+{
+ VOID *newitem;
+ VOID **newblock;
+ intptr_t alignptr;
+
+ /* First check the linked list of dead items. If the list is not */
+ /* empty, allocate an item from the list rather than a fresh one. */
+ if (pool->deaditemstack != (VOID *) NULL) {
+ newitem = pool->deaditemstack; /* Take first item in list. */
+ pool->deaditemstack = * (VOID **) pool->deaditemstack;
+ } else {
+ /* Check if there are any free items left in the current block. */
+ if (pool->unallocateditems == 0) {
+ /* Check if another block must be allocated. */
+ if (*(pool->nowblock) == (VOID *) NULL) {
+ /* Allocate a new block of items, pointed to by the previous block. */
+ newblock = (VOID **) malloc(pool->itemsperblock * pool->itembytes
+ + sizeof(VOID *) + pool->alignbytes);
+ if (newblock == (VOID **) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ *(pool->nowblock) = (VOID *) newblock;
+ /* The next block pointer is NULL. */
+ *newblock = (VOID *) NULL;
+ }
+ /* Move to the new block. */
+ pool->nowblock = (VOID **) *(pool->nowblock);
+ /* Find the first item in the block. */
+ /* Increment by the size of (VOID *). */
+ alignptr = (intptr_t) (pool->nowblock + 1);
+ /* Align the item on an `alignbytes'-byte boundary. */
+ pool->nextitem = (VOID *)
+ (alignptr + (intptr_t) pool->alignbytes
+ - (alignptr % (intptr_t) pool->alignbytes));
+ /* There are lots of unallocated items left in this block. */
+ pool->unallocateditems = pool->itemsperblock;
+ }
+ /* Allocate a new item. */
+ newitem = pool->nextitem;
+ /* Advance `nextitem' pointer to next free item in block. */
+ if (pool->itemwordtype == POINTER) {
+ pool->nextitem = (VOID *) ((VOID **) pool->nextitem + pool->itemwords);
+ } else {
+ pool->nextitem = (VOID *) ((REAL *) pool->nextitem + pool->itemwords);
+ }
+ pool->unallocateditems--;
+ pool->maxitems++;
+ }
+ pool->items++;
+ return newitem;
+}
+
+/*****************************************************************************/
+/* */
+/* pooldealloc() Deallocate space for an item. */
+/* */
+/* The deallocated space is stored in a queue for later reuse. */
+/* */
+/*****************************************************************************/
+
+void pooldealloc(pool, dyingitem)
+struct memorypool *pool;
+VOID *dyingitem;
+{
+ /* Push freshly killed item onto stack. */
+ *((VOID **) dyingitem) = pool->deaditemstack;
+ pool->deaditemstack = dyingitem;
+ pool->items--;
+}
+
+/*****************************************************************************/
+/* */
+/* traversalinit() Prepare to traverse the entire list of items. */
+/* */
+/* This routine is used in conjunction with traverse(). */
+/* */
+/*****************************************************************************/
+
+void traversalinit(pool)
+struct memorypool *pool;
+{
+ intptr_t alignptr;
+
+ /* Begin the traversal in the first block. */
+ pool->pathblock = pool->firstblock;
+ /* Find the first item in the block. Increment by the size of (VOID *). */
+ alignptr = (intptr_t) (pool->pathblock + 1);
+ /* Align with item on an `alignbytes'-byte boundary. */
+ pool->pathitem = (VOID *)
+ (alignptr + (intptr_t) pool->alignbytes
+ - (alignptr % (intptr_t) pool->alignbytes));
+ /* Set the number of items left in the current block. */
+ pool->pathitemsleft = pool->itemsperblock;
+}
+
+/*****************************************************************************/
+/* */
+/* traverse() Find the next item in the list. */
+/* */
+/* This routine is used in conjunction with traversalinit(). Be forewarned */
+/* that this routine successively returns all items in the list, including */
+/* deallocated ones on the deaditemqueue. It's up to you to figure out */
+/* which ones are actually dead. Why? I don't want to allocate extra */
+/* space just to demarcate dead items. It can usually be done more */
+/* space-efficiently by a routine that knows something about the structure */
+/* of the item. */
+/* */
+/*****************************************************************************/
+
+VOID *traverse(pool)
+struct memorypool *pool;
+{
+ VOID *newitem;
+ intptr_t alignptr;
+
+ /* Stop upon exhausting the list of items. */
+ if (pool->pathitem == pool->nextitem) {
+ return (VOID *) NULL;
+ }
+ /* Check whether any untraversed items remain in the current block. */
+ if (pool->pathitemsleft == 0) {
+ /* Find the next block. */
+ pool->pathblock = (VOID **) *(pool->pathblock);
+ /* Find the first item in the block. Increment by the size of (VOID *). */
+ alignptr = (intptr_t) (pool->pathblock + 1);
+ /* Align with item on an `alignbytes'-byte boundary. */
+ pool->pathitem = (VOID *)
+ (alignptr + (intptr_t) pool->alignbytes
+ - (alignptr % (intptr_t) pool->alignbytes));
+ /* Set the number of items left in the current block. */
+ pool->pathitemsleft = pool->itemsperblock;
+ }
+ newitem = pool->pathitem;
+ /* Find the next item in the block. */
+ if (pool->itemwordtype == POINTER) {
+ pool->pathitem = (VOID *) ((VOID **) pool->pathitem + pool->itemwords);
+ } else {
+ pool->pathitem = (VOID *) ((REAL *) pool->pathitem + pool->itemwords);
+ }
+ pool->pathitemsleft--;
+ return newitem;
+}
+
+/*****************************************************************************/
+/* */
+/* dummyinit() Initialize the triangle that fills "outer space" and the */
+/* omnipresent shell edge. */
+/* */
+/* The triangle that fills "outer space", called `dummytri', is pointed to */
+/* by every triangle and shell edge on a boundary (be it outer or inner) of */
+/* the triangulation. Also, `dummytri' points to one of the triangles on */
+/* the convex hull (until the holes and concavities are carved), making it */
+/* possible to find a starting triangle for point location. */
+/* */
+/* The omnipresent shell edge, `dummysh', is pointed to by every triangle */
+/* or shell edge that doesn't have a full complement of real shell edges */
+/* to point to. */
+/* */
+/*****************************************************************************/
+
+void dummyinit(trianglewords, shellewords)
+int trianglewords;
+int shellewords;
+{
+ intptr_t alignptr;
+
+ /* `triwords' and `shwords' are used by the mesh manipulation primitives */
+ /* to extract orientations of triangles and shell edges from pointers. */
+ triwords = trianglewords; /* Initialize `triwords' once and for all. */
+ shwords = shellewords; /* Initialize `shwords' once and for all. */
+
+ /* Set up `dummytri', the `triangle' that occupies "outer space". */
+ dummytribase = (triangle *) malloc(triwords * sizeof(triangle)
+ + triangles.alignbytes);
+ if (dummytribase == (triangle *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ /* Align `dummytri' on a `triangles.alignbytes'-byte boundary. */
+ alignptr = (intptr_t) dummytribase;
+ dummytri = (triangle *)
+ (alignptr + (intptr_t) triangles.alignbytes
+ - (alignptr % (intptr_t) triangles.alignbytes));
+ /* Initialize the three adjoining triangles to be "outer space". These */
+ /* will eventually be changed by various bonding operations, but their */
+ /* values don't really matter, as long as they can legally be */
+ /* dereferenced. */
+ dummytri[0] = (triangle) dummytri;
+ dummytri[1] = (triangle) dummytri;
+ dummytri[2] = (triangle) dummytri;
+ /* Three NULL vertex points. */
+ dummytri[3] = (triangle) NULL;
+ dummytri[4] = (triangle) NULL;
+ dummytri[5] = (triangle) NULL;
+
+ if (useshelles) {
+ /* Set up `dummysh', the omnipresent "shell edge" pointed to by any */
+ /* triangle side or shell edge end that isn't attached to a real shell */
+ /* edge. */
+ dummyshbase = (shelle *) malloc(shwords * sizeof(shelle)
+ + shelles.alignbytes);
+ if (dummyshbase == (shelle *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ /* Align `dummysh' on a `shelles.alignbytes'-byte boundary. */
+ alignptr = (intptr_t) dummyshbase;
+ dummysh = (shelle *)
+ (alignptr + (intptr_t) shelles.alignbytes
+ - (alignptr % (intptr_t) shelles.alignbytes));
+ /* Initialize the two adjoining shell edges to be the omnipresent shell */
+ /* edge. These will eventually be changed by various bonding */
+ /* operations, but their values don't really matter, as long as they */
+ /* can legally be dereferenced. */
+ dummysh[0] = (shelle) dummysh;
+ dummysh[1] = (shelle) dummysh;
+ /* Two NULL vertex points. */
+ dummysh[2] = (shelle) NULL;
+ dummysh[3] = (shelle) NULL;
+ /* Initialize the two adjoining triangles to be "outer space". */
+ dummysh[4] = (shelle) dummytri;
+ dummysh[5] = (shelle) dummytri;
+ /* Set the boundary marker to zero. */
+ * (int *) (dummysh + 6) = 0;
+
+ /* Initialize the three adjoining shell edges of `dummytri' to be */
+ /* the omnipresent shell edge. */
+ dummytri[6] = (triangle) dummysh;
+ dummytri[7] = (triangle) dummysh;
+ dummytri[8] = (triangle) dummysh;
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* initializepointpool() Calculate the size of the point data structure */
+/* and initialize its memory pool. */
+/* */
+/* This routine also computes the `pointmarkindex' and `point2triindex' */
+/* indices used to find values within each point. */
+/* */
+/*****************************************************************************/
+
+void initializepointpool()
+{
+ int pointsize;
+
+ /* The index within each point at which the boundary marker is found. */
+ /* Ensure the point marker is aligned to a sizeof(int)-byte address. */
+ pointmarkindex = ((mesh_dim + nextras) * sizeof(REAL) + sizeof(int) - 1)
+ / sizeof(int);
+ pointsize = (pointmarkindex + 1) * sizeof(int);
+ if (poly) {
+ /* The index within each point at which a triangle pointer is found. */
+ /* Ensure the pointer is aligned to a sizeof(triangle)-byte address. */
+ point2triindex = (pointsize + sizeof(triangle) - 1) / sizeof(triangle);
+ pointsize = (point2triindex + 1) * sizeof(triangle);
+ }
+ /* Initialize the pool of points. */
+ poolinit(&points, pointsize, POINTPERBLOCK,
+ (sizeof(REAL) >= sizeof(triangle)) ? FLOATINGPOINT : POINTER, 0);
+}
+
+/*****************************************************************************/
+/* */
+/* initializetrisegpools() Calculate the sizes of the triangle and shell */
+/* edge data structures and initialize their */
+/* memory pools. */
+/* */
+/* This routine also computes the `highorderindex', `elemattribindex', and */
+/* `areaboundindex' indices used to find values within each triangle. */
+/* */
+/*****************************************************************************/
+
+void initializetrisegpools()
+{
+ int trisize;
+
+ /* The index within each triangle at which the extra nodes (above three) */
+ /* associated with high order elements are found. There are three */
+ /* pointers to other triangles, three pointers to corners, and possibly */
+ /* three pointers to shell edges before the extra nodes. */
+ highorderindex = 6 + (useshelles * 3);
+ /* The number of bytes occupied by a triangle. */
+ trisize = ((order + 1) * (order + 2) / 2 + (highorderindex - 3)) *
+ sizeof(triangle);
+ /* The index within each triangle at which its attributes are found, */
+ /* where the index is measured in REALs. */
+ elemattribindex = (trisize + sizeof(REAL) - 1) / sizeof(REAL);
+ /* The index within each triangle at which the maximum area constraint */
+ /* is found, where the index is measured in REALs. Note that if the */
+ /* `regionattrib' flag is set, an additional attribute will be added. */
+ areaboundindex = elemattribindex + eextras + regionattrib;
+ /* If triangle attributes or an area bound are needed, increase the number */
+ /* of bytes occupied by a triangle. */
+ if (vararea) {
+ trisize = (areaboundindex + 1) * sizeof(REAL);
+ } else if (eextras + regionattrib > 0) {
+ trisize = areaboundindex * sizeof(REAL);
+ }
+ /* If a Voronoi diagram or triangle neighbor graph is requested, make */
+ /* sure there's room to store an integer index in each triangle. This */
+ /* integer index can occupy the same space as the shell edges or */
+ /* attributes or area constraint or extra nodes. */
+ if ((voronoi || neighbors) &&
+ (trisize < 6 * (int)sizeof(triangle) + (int)sizeof(int))) {
+ trisize = 6 * sizeof(triangle) + sizeof(int);
+ }
+ /* Having determined the memory size of a triangle, initialize the pool. */
+ poolinit(&triangles, trisize, TRIPERBLOCK, POINTER, 4);
+
+ if (useshelles) {
+ /* Initialize the pool of shell edges. */
+ poolinit(&shelles, 6 * sizeof(triangle) + sizeof(int), SHELLEPERBLOCK,
+ POINTER, 4);
+
+ /* Initialize the "outer space" triangle and omnipresent shell edge. */
+ dummyinit(triangles.itemwords, shelles.itemwords);
+ } else {
+ /* Initialize the "outer space" triangle. */
+ dummyinit(triangles.itemwords, 0);
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* triangledealloc() Deallocate space for a triangle, marking it dead. */
+/* */
+/*****************************************************************************/
+
+void triangledealloc(dyingtriangle)
+triangle *dyingtriangle;
+{
+ /* Set triangle's vertices to NULL. This makes it possible to */
+ /* detect dead triangles when traversing the list of all triangles. */
+ dyingtriangle[3] = (triangle) NULL;
+ dyingtriangle[4] = (triangle) NULL;
+ dyingtriangle[5] = (triangle) NULL;
+ pooldealloc(&triangles, (VOID *) dyingtriangle);
+}
+
+/*****************************************************************************/
+/* */
+/* triangletraverse() Traverse the triangles, skipping dead ones. */
+/* */
+/*****************************************************************************/
+
+triangle *triangletraverse()
+{
+ triangle *newtriangle;
+
+ do {
+ newtriangle = (triangle *) traverse(&triangles);
+ if (newtriangle == (triangle *) NULL) {
+ return (triangle *) NULL;
+ }
+ } while (newtriangle[3] == (triangle) NULL); /* Skip dead ones. */
+ return newtriangle;
+}
+
+/*****************************************************************************/
+/* */
+/* shelledealloc() Deallocate space for a shell edge, marking it dead. */
+/* */
+/*****************************************************************************/
+
+void shelledealloc(dyingshelle)
+shelle *dyingshelle;
+{
+ /* Set shell edge's vertices to NULL. This makes it possible to */
+ /* detect dead shells when traversing the list of all shells. */
+ dyingshelle[2] = (shelle) NULL;
+ dyingshelle[3] = (shelle) NULL;
+ pooldealloc(&shelles, (VOID *) dyingshelle);
+}
+
+/*****************************************************************************/
+/* */
+/* shelletraverse() Traverse the shell edges, skipping dead ones. */
+/* */
+/*****************************************************************************/
+
+shelle *shelletraverse()
+{
+ shelle *newshelle;
+
+ do {
+ newshelle = (shelle *) traverse(&shelles);
+ if (newshelle == (shelle *) NULL) {
+ return (shelle *) NULL;
+ }
+ } while (newshelle[2] == (shelle) NULL); /* Skip dead ones. */
+ return newshelle;
+}
+
+/*****************************************************************************/
+/* */
+/* pointdealloc() Deallocate space for a point, marking it dead. */
+/* */
+/*****************************************************************************/
+
+void pointdealloc(dyingpoint)
+point dyingpoint;
+{
+ /* Mark the point as dead. This makes it possible to detect dead points */
+ /* when traversing the list of all points. */
+ setpointmark(dyingpoint, DEADPOINT);
+ pooldealloc(&points, (VOID *) dyingpoint);
+}
+
+/*****************************************************************************/
+/* */
+/* pointtraverse() Traverse the points, skipping dead ones. */
+/* */
+/*****************************************************************************/
+
+point pointtraverse()
+{
+ point newpoint;
+
+ do {
+ newpoint = (point) traverse(&points);
+ if (newpoint == (point) NULL) {
+ return (point) NULL;
+ }
+ } while (pointmark(newpoint) == DEADPOINT); /* Skip dead ones. */
+ return newpoint;
+}
+
+/*****************************************************************************/
+/* */
+/* badsegmentdealloc() Deallocate space for a bad segment, marking it */
+/* dead. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void badsegmentdealloc(dyingseg)
+struct edge *dyingseg;
+{
+ /* Set segment's orientation to -1. This makes it possible to */
+ /* detect dead segments when traversing the list of all segments. */
+ dyingseg->shorient = -1;
+ pooldealloc(&badsegments, (VOID *) dyingseg);
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* badsegmenttraverse() Traverse the bad segments, skipping dead ones. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+struct edge *badsegmenttraverse()
+{
+ struct edge *newseg;
+
+ do {
+ newseg = (struct edge *) traverse(&badsegments);
+ if (newseg == (struct edge *) NULL) {
+ return (struct edge *) NULL;
+ }
+ } while (newseg->shorient == -1); /* Skip dead ones. */
+ return newseg;
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* getpoint() Get a specific point, by number, from the list. */
+/* */
+/* The first point is number 'firstnumber'. */
+/* */
+/* Note that this takes O(n) time (with a small constant, if POINTPERBLOCK */
+/* is large). I don't care to take the trouble to make it work in constant */
+/* time. */
+/* */
+/*****************************************************************************/
+
+point getpoint(number)
+int number;
+{
+ VOID **getblock;
+ point foundpoint;
+ intptr_t alignptr;
+ int current;
+
+ getblock = points.firstblock;
+ current = firstnumber;
+ /* Find the right block. */
+ while (current + points.itemsperblock <= number) {
+ getblock = (VOID **) *getblock;
+ current += points.itemsperblock;
+ }
+ /* Now find the right point. */
+ alignptr = (intptr_t) (getblock + 1);
+ foundpoint = (point) (alignptr + (intptr_t) points.alignbytes
+ - (alignptr % (intptr_t) points.alignbytes));
+ while (current < number) {
+ foundpoint += points.itemwords;
+ current++;
+ }
+ return foundpoint;
+}
+
+/*****************************************************************************/
+/* */
+/* triangledeinit() Free all remaining allocated memory. */
+/* */
+/*****************************************************************************/
+
+void triangledeinit()
+{
+ pooldeinit(&triangles);
+ free(dummytribase);
+ if (useshelles) {
+ pooldeinit(&shelles);
+ free(dummyshbase);
+ }
+ pooldeinit(&points);
+#ifndef CDT_ONLY
+ if (quality) {
+ pooldeinit(&badsegments);
+ if ((minangle > 0.0) || vararea || fixedarea) {
+ pooldeinit(&badtriangles);
+ }
+ }
+#endif /* not CDT_ONLY */
+}
+
+/** **/
+/** **/
+/********* Memory management routines end here *********/
+
+/********* Constructors begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* maketriangle() Create a new triangle with orientation zero. */
+/* */
+/*****************************************************************************/
+
+void maketriangle(newtriedge)
+struct triedge *newtriedge;
+{
+ int i;
+
+ newtriedge->tri = (triangle *) poolalloc(&triangles);
+ /* Initialize the three adjoining triangles to be "outer space". */
+ newtriedge->tri[0] = (triangle) dummytri;
+ newtriedge->tri[1] = (triangle) dummytri;
+ newtriedge->tri[2] = (triangle) dummytri;
+ /* Three NULL vertex points. */
+ newtriedge->tri[3] = (triangle) NULL;
+ newtriedge->tri[4] = (triangle) NULL;
+ newtriedge->tri[5] = (triangle) NULL;
+ /* Initialize the three adjoining shell edges to be the omnipresent */
+ /* shell edge. */
+ if (useshelles) {
+ newtriedge->tri[6] = (triangle) dummysh;
+ newtriedge->tri[7] = (triangle) dummysh;
+ newtriedge->tri[8] = (triangle) dummysh;
+ }
+ for (i = 0; i < eextras; i++) {
+ setelemattribute(*newtriedge, i, 0.0);
+ }
+ if (vararea) {
+ setareabound(*newtriedge, -1.0);
+ }
+
+ newtriedge->orient = 0;
+}
+
+/*****************************************************************************/
+/* */
+/* makeshelle() Create a new shell edge with orientation zero. */
+/* */
+/*****************************************************************************/
+
+void makeshelle(newedge)
+struct edge *newedge;
+{
+ newedge->sh = (shelle *) poolalloc(&shelles);
+ /* Initialize the two adjoining shell edges to be the omnipresent */
+ /* shell edge. */
+ newedge->sh[0] = (shelle) dummysh;
+ newedge->sh[1] = (shelle) dummysh;
+ /* Two NULL vertex points. */
+ newedge->sh[2] = (shelle) NULL;
+ newedge->sh[3] = (shelle) NULL;
+ /* Initialize the two adjoining triangles to be "outer space". */
+ newedge->sh[4] = (shelle) dummytri;
+ newedge->sh[5] = (shelle) dummytri;
+ /* Set the boundary marker to zero. */
+ setmark(*newedge, 0);
+
+ newedge->shorient = 0;
+}
+
+/** **/
+/** **/
+/********* Constructors end here *********/
+
+/********* Determinant evaluation routines begin here *********/
+/** **/
+/** **/
+
+/* The adaptive exact arithmetic geometric predicates implemented herein are */
+/* described in detail in my Technical Report CMU-CS-96-140. The complete */
+/* reference is given in the header. */
+
+/* Which of the following two methods of finding the absolute values is */
+/* fastest is compiler-dependent. A few compilers can inline and optimize */
+/* the fabs() call; but most will incur the overhead of a function call, */
+/* which is disastrously slow. A faster way on IEEE machines might be to */
+/* mask the appropriate bit, but that's difficult to do in C. */
+
+#define Absolute(a) ((a) >= 0.0 ? (a) : -(a))
+/* #define Absolute(a) fabs(a) */
+
+/* Many of the operations are broken up into two pieces, a main part that */
+/* performs an approximate operation, and a "tail" that computes the */
+/* roundoff error of that operation. */
+/* */
+/* The operations Fast_Two_Sum(), Fast_Two_Diff(), Two_Sum(), Two_Diff(), */
+/* Split(), and Two_Product() are all implemented as described in the */
+/* reference. Each of these macros requires certain variables to be */
+/* defined in the calling routine. The variables `bvirt', `c', `abig', */
+/* `_i', `_j', `_k', `_l', `_m', and `_n' are declared `INEXACT' because */
+/* they store the result of an operation that may incur roundoff error. */
+/* The input parameter `x' (or the highest numbered `x_' parameter) must */
+/* also be declared `INEXACT'. */
+
+#define Fast_Two_Sum_Tail(a, b, x, y) \
+ bvirt = x - a; \
+ y = b - bvirt
+
+#define Fast_Two_Sum(a, b, x, y) \
+ x = (REAL) (a + b); \
+ Fast_Two_Sum_Tail(a, b, x, y)
+
+#define Two_Sum_Tail(a, b, x, y) \
+ bvirt = (REAL) (x - a); \
+ avirt = x - bvirt; \
+ bround = b - bvirt; \
+ around = a - avirt; \
+ y = around + bround
+
+#define Two_Sum(a, b, x, y) \
+ x = (REAL) (a + b); \
+ Two_Sum_Tail(a, b, x, y)
+
+#define Two_Diff_Tail(a, b, x, y) \
+ bvirt = (REAL) (a - x); \
+ avirt = x + bvirt; \
+ bround = bvirt - b; \
+ around = a - avirt; \
+ y = around + bround
+
+#define Two_Diff(a, b, x, y) \
+ x = (REAL) (a - b); \
+ Two_Diff_Tail(a, b, x, y)
+
+#define Split(a, ahi, alo) \
+ c = (REAL) (splitter * a); \
+ abig = (REAL) (c - a); \
+ ahi = c - abig; \
+ alo = a - ahi
+
+#define Two_Product_Tail(a, b, x, y) \
+ Split(a, ahi, alo); \
+ Split(b, bhi, blo); \
+ err1 = x - (ahi * bhi); \
+ err2 = err1 - (alo * bhi); \
+ err3 = err2 - (ahi * blo); \
+ y = (alo * blo) - err3
+
+#define Two_Product(a, b, x, y) \
+ x = (REAL) (a * b); \
+ Two_Product_Tail(a, b, x, y)
+
+/* Two_Product_Presplit() is Two_Product() where one of the inputs has */
+/* already been split. Avoids redundant splitting. */
+
+#define Two_Product_Presplit(a, b, bhi, blo, x, y) \
+ x = (REAL) (a * b); \
+ Split(a, ahi, alo); \
+ err1 = x - (ahi * bhi); \
+ err2 = err1 - (alo * bhi); \
+ err3 = err2 - (ahi * blo); \
+ y = (alo * blo) - err3
+
+/* Square() can be done more quickly than Two_Product(). */
+
+#define Square_Tail(a, x, y) \
+ Split(a, ahi, alo); \
+ err1 = x - (ahi * ahi); \
+ err3 = err1 - ((ahi + ahi) * alo); \
+ y = (alo * alo) - err3
+
+#define Square(a, x, y) \
+ x = (REAL) (a * a); \
+ Square_Tail(a, x, y)
+
+/* Macros for summing expansions of various fixed lengths. These are all */
+/* unrolled versions of Expansion_Sum(). */
+
+#define Two_One_Sum(a1, a0, b, x2, x1, x0) \
+ Two_Sum(a0, b , _i, x0); \
+ Two_Sum(a1, _i, x2, x1)
+
+#define Two_One_Diff(a1, a0, b, x2, x1, x0) \
+ Two_Diff(a0, b , _i, x0); \
+ Two_Sum( a1, _i, x2, x1)
+
+#define Two_Two_Sum(a1, a0, b1, b0, x3, x2, x1, x0) \
+ Two_One_Sum(a1, a0, b0, _j, _0, x0); \
+ Two_One_Sum(_j, _0, b1, x3, x2, x1)
+
+#define Two_Two_Diff(a1, a0, b1, b0, x3, x2, x1, x0) \
+ Two_One_Diff(a1, a0, b0, _j, _0, x0); \
+ Two_One_Diff(_j, _0, b1, x3, x2, x1)
+
+/*****************************************************************************/
+/* */
+/* exactinit() Initialize the variables used for exact arithmetic. */
+/* */
+/* `epsilon' is the largest power of two such that 1.0 + epsilon = 1.0 in */
+/* floating-point arithmetic. `epsilon' bounds the relative roundoff */
+/* error. It is used for floating-point error analysis. */
+/* */
+/* `splitter' is used to split floating-point numbers into two half- */
+/* length significands for exact multiplication. */
+/* */
+/* I imagine that a highly optimizing compiler might be too smart for its */
+/* own good, and somehow cause this routine to fail, if it pretends that */
+/* floating-point arithmetic is too much like real arithmetic. */
+/* */
+/* Don't change this routine unless you fully understand it. */
+/* */
+/*****************************************************************************/
+
+void exactinit()
+{
+ REAL half;
+ REAL check, lastcheck;
+ int every_other;
+
+ every_other = 1;
+ half = 0.5;
+ epsilon = 1.0;
+ splitter = 1.0;
+ check = 1.0;
+ /* Repeatedly divide `epsilon' by two until it is too small to add to */
+ /* one without causing roundoff. (Also check if the sum is equal to */
+ /* the previous sum, for machines that round up instead of using exact */
+ /* rounding. Not that these routines will work on such machines anyway. */
+ do {
+ lastcheck = check;
+ epsilon *= half;
+ if (every_other) {
+ splitter *= 2.0;
+ }
+ every_other = !every_other;
+ check = 1.0 + epsilon;
+ } while ((check != 1.0) && (check != lastcheck));
+ splitter += 1.0;
+ if (verbose > 1) {
+ printf("Floating point roundoff is of magnitude %.17g\n", epsilon);
+ printf("Floating point splitter is %.17g\n", splitter);
+ }
+ /* Error bounds for orientation and incircle tests. */
+ resulterrbound = (3.0 + 8.0 * epsilon) * epsilon;
+ ccwerrboundA = (3.0 + 16.0 * epsilon) * epsilon;
+ ccwerrboundB = (2.0 + 12.0 * epsilon) * epsilon;
+ ccwerrboundC = (9.0 + 64.0 * epsilon) * epsilon * epsilon;
+ iccerrboundA = (10.0 + 96.0 * epsilon) * epsilon;
+ iccerrboundB = (4.0 + 48.0 * epsilon) * epsilon;
+ iccerrboundC = (44.0 + 576.0 * epsilon) * epsilon * epsilon;
+}
+
+/*****************************************************************************/
+/* */
+/* fast_expansion_sum_zeroelim() Sum two expansions, eliminating zero */
+/* components from the output expansion. */
+/* */
+/* Sets h = e + f. See my Robust Predicates paper for details. */
+/* */
+/* If round-to-even is used (as with IEEE 754), maintains the strongly */
+/* nonoverlapping property. (That is, if e is strongly nonoverlapping, h */
+/* will be also.) Does NOT maintain the nonoverlapping or nonadjacent */
+/* properties. */
+/* */
+/*****************************************************************************/
+
+int fast_expansion_sum_zeroelim(elen, e, flen, f, h) /* h cannot be e or f. */
+int elen;
+REAL *e;
+int flen;
+REAL *f;
+REAL *h;
+{
+ REAL Q;
+ INEXACT REAL Qnew;
+ INEXACT REAL hh;
+ INEXACT REAL bvirt;
+ REAL avirt, bround, around;
+ int eindex, findex, hindex;
+ REAL enow, fnow;
+
+ enow = e[0];
+ fnow = f[0];
+ eindex = findex = 0;
+ if ((fnow > enow) == (fnow > -enow)) {
+ Q = enow;
+ enow = e[++eindex];
+ } else {
+ Q = fnow;
+ fnow = f[++findex];
+ }
+ hindex = 0;
+ if ((eindex < elen) && (findex < flen)) {
+ if ((fnow > enow) == (fnow > -enow)) {
+ Fast_Two_Sum(enow, Q, Qnew, hh);
+ enow = e[++eindex];
+ } else {
+ Fast_Two_Sum(fnow, Q, Qnew, hh);
+ fnow = f[++findex];
+ }
+ Q = Qnew;
+ if (hh != 0.0) {
+ h[hindex++] = hh;
+ }
+ while ((eindex < elen) && (findex < flen)) {
+ if ((fnow > enow) == (fnow > -enow)) {
+ Two_Sum(Q, enow, Qnew, hh);
+ enow = e[++eindex];
+ } else {
+ Two_Sum(Q, fnow, Qnew, hh);
+ fnow = f[++findex];
+ }
+ Q = Qnew;
+ if (hh != 0.0) {
+ h[hindex++] = hh;
+ }
+ }
+ }
+ while (eindex < elen) {
+ Two_Sum(Q, enow, Qnew, hh);
+ enow = e[++eindex];
+ Q = Qnew;
+ if (hh != 0.0) {
+ h[hindex++] = hh;
+ }
+ }
+ while (findex < flen) {
+ Two_Sum(Q, fnow, Qnew, hh);
+ fnow = f[++findex];
+ Q = Qnew;
+ if (hh != 0.0) {
+ h[hindex++] = hh;
+ }
+ }
+ if ((Q != 0.0) || (hindex == 0)) {
+ h[hindex++] = Q;
+ }
+ return hindex;
+}
+
+/*****************************************************************************/
+/* */
+/* scale_expansion_zeroelim() Multiply an expansion by a scalar, */
+/* eliminating zero components from the */
+/* output expansion. */
+/* */
+/* Sets h = be. See my Robust Predicates paper for details. */
+/* */
+/* Maintains the nonoverlapping property. If round-to-even is used (as */
+/* with IEEE 754), maintains the strongly nonoverlapping and nonadjacent */
+/* properties as well. (That is, if e has one of these properties, so */
+/* will h.) */
+/* */
+/*****************************************************************************/
+
+int scale_expansion_zeroelim(elen, e, b, h) /* e and h cannot be the same. */
+int elen;
+REAL *e;
+REAL b;
+REAL *h;
+{
+ INEXACT REAL Q, sum;
+ REAL hh;
+ INEXACT REAL product1;
+ REAL product0;
+ int eindex, hindex;
+ REAL enow;
+ INEXACT REAL bvirt;
+ REAL avirt, bround, around;
+ INEXACT REAL c;
+ INEXACT REAL abig;
+ REAL ahi, alo, bhi, blo;
+ REAL err1, err2, err3;
+
+ Split(b, bhi, blo);
+ Two_Product_Presplit(e[0], b, bhi, blo, Q, hh);
+ hindex = 0;
+ if (hh != 0) {
+ h[hindex++] = hh;
+ }
+ for (eindex = 1; eindex < elen; eindex++) {
+ enow = e[eindex];
+ Two_Product_Presplit(enow, b, bhi, blo, product1, product0);
+ Two_Sum(Q, product0, sum, hh);
+ if (hh != 0) {
+ h[hindex++] = hh;
+ }
+ Fast_Two_Sum(product1, sum, Q, hh);
+ if (hh != 0) {
+ h[hindex++] = hh;
+ }
+ }
+ if ((Q != 0.0) || (hindex == 0)) {
+ h[hindex++] = Q;
+ }
+ return hindex;
+}
+
+/*****************************************************************************/
+/* */
+/* estimate() Produce a one-word estimate of an expansion's value. */
+/* */
+/* See my Robust Predicates paper for details. */
+/* */
+/*****************************************************************************/
+
+REAL estimate(elen, e)
+int elen;
+REAL *e;
+{
+ REAL Q;
+ int eindex;
+
+ Q = e[0];
+ for (eindex = 1; eindex < elen; eindex++) {
+ Q += e[eindex];
+ }
+ return Q;
+}
+
+/*****************************************************************************/
+/* */
+/* counterclockwise() Return a positive value if the points pa, pb, and */
+/* pc occur in counterclockwise order; a negative */
+/* value if they occur in clockwise order; and zero */
+/* if they are collinear. The result is also a rough */
+/* approximation of twice the signed area of the */
+/* triangle defined by the three points. */
+/* */
+/* Uses exact arithmetic if necessary to ensure a correct answer. The */
+/* result returned is the determinant of a matrix. This determinant is */
+/* computed adaptively, in the sense that exact arithmetic is used only to */
+/* the degree it is needed to ensure that the returned value has the */
+/* correct sign. Hence, this function is usually quite fast, but will run */
+/* more slowly when the input points are collinear or nearly so. */
+/* */
+/* See my Robust Predicates paper for details. */
+/* */
+/*****************************************************************************/
+
+REAL counterclockwiseadapt(pa, pb, pc, detsum)
+point pa;
+point pb;
+point pc;
+REAL detsum;
+{
+ INEXACT REAL acx, acy, bcx, bcy;
+ REAL acxtail, acytail, bcxtail, bcytail;
+ INEXACT REAL detleft, detright;
+ REAL detlefttail, detrighttail;
+ REAL det, errbound;
+ REAL B[4], C1[8], C2[12], D[16];
+ INEXACT REAL B3;
+ int C1length, C2length, Dlength;
+ REAL u[4];
+ INEXACT REAL u3;
+ INEXACT REAL s1, t1;
+ REAL s0, t0;
+
+ INEXACT REAL bvirt;
+ REAL avirt, bround, around;
+ INEXACT REAL c;
+ INEXACT REAL abig;
+ REAL ahi, alo, bhi, blo;
+ REAL err1, err2, err3;
+ INEXACT REAL _i, _j;
+ REAL _0;
+
+ acx = (REAL) (pa[0] - pc[0]);
+ bcx = (REAL) (pb[0] - pc[0]);
+ acy = (REAL) (pa[1] - pc[1]);
+ bcy = (REAL) (pb[1] - pc[1]);
+
+ Two_Product(acx, bcy, detleft, detlefttail);
+ Two_Product(acy, bcx, detright, detrighttail);
+
+ Two_Two_Diff(detleft, detlefttail, detright, detrighttail,
+ B3, B[2], B[1], B[0]);
+ B[3] = B3;
+
+ det = estimate(4, B);
+ errbound = ccwerrboundB * detsum;
+ if ((det >= errbound) || (-det >= errbound)) {
+ return det;
+ }
+
+ Two_Diff_Tail(pa[0], pc[0], acx, acxtail);
+ Two_Diff_Tail(pb[0], pc[0], bcx, bcxtail);
+ Two_Diff_Tail(pa[1], pc[1], acy, acytail);
+ Two_Diff_Tail(pb[1], pc[1], bcy, bcytail);
+
+ if ((acxtail == 0.0) && (acytail == 0.0)
+ && (bcxtail == 0.0) && (bcytail == 0.0)) {
+ return det;
+ }
+
+ errbound = ccwerrboundC * detsum + resulterrbound * Absolute(det);
+ det += (acx * bcytail + bcy * acxtail)
+ - (acy * bcxtail + bcx * acytail);
+ if ((det >= errbound) || (-det >= errbound)) {
+ return det;
+ }
+
+ Two_Product(acxtail, bcy, s1, s0);
+ Two_Product(acytail, bcx, t1, t0);
+ Two_Two_Diff(s1, s0, t1, t0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ C1length = fast_expansion_sum_zeroelim(4, B, 4, u, C1);
+
+ Two_Product(acx, bcytail, s1, s0);
+ Two_Product(acy, bcxtail, t1, t0);
+ Two_Two_Diff(s1, s0, t1, t0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ C2length = fast_expansion_sum_zeroelim(C1length, C1, 4, u, C2);
+
+ Two_Product(acxtail, bcytail, s1, s0);
+ Two_Product(acytail, bcxtail, t1, t0);
+ Two_Two_Diff(s1, s0, t1, t0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ Dlength = fast_expansion_sum_zeroelim(C2length, C2, 4, u, D);
+
+ return D[Dlength - 1];
+}
+
+REAL counterclockwise(pa, pb, pc)
+point pa;
+point pb;
+point pc;
+{
+ REAL detleft, detright, det;
+ REAL detsum, errbound;
+
+ counterclockcount++;
+
+ detleft = (pa[0] - pc[0]) * (pb[1] - pc[1]);
+ detright = (pa[1] - pc[1]) * (pb[0] - pc[0]);
+ det = detleft - detright;
+
+ if (noexact) {
+ return det;
+ }
+
+ if (detleft > 0.0) {
+ if (detright <= 0.0) {
+ return det;
+ } else {
+ detsum = detleft + detright;
+ }
+ } else if (detleft < 0.0) {
+ if (detright >= 0.0) {
+ return det;
+ } else {
+ detsum = -detleft - detright;
+ }
+ } else {
+ return det;
+ }
+
+ errbound = ccwerrboundA * detsum;
+ if ((det >= errbound) || (-det >= errbound)) {
+ return det;
+ }
+
+ return counterclockwiseadapt(pa, pb, pc, detsum);
+}
+
+/*****************************************************************************/
+/* */
+/* incircle() Return a positive value if the point pd lies inside the */
+/* circle passing through pa, pb, and pc; a negative value if */
+/* it lies outside; and zero if the four points are cocircular.*/
+/* The points pa, pb, and pc must be in counterclockwise */
+/* order, or the sign of the result will be reversed. */
+/* */
+/* Uses exact arithmetic if necessary to ensure a correct answer. The */
+/* result returned is the determinant of a matrix. This determinant is */
+/* computed adaptively, in the sense that exact arithmetic is used only to */
+/* the degree it is needed to ensure that the returned value has the */
+/* correct sign. Hence, this function is usually quite fast, but will run */
+/* more slowly when the input points are cocircular or nearly so. */
+/* */
+/* See my Robust Predicates paper for details. */
+/* */
+/*****************************************************************************/
+
+REAL incircleadapt(pa, pb, pc, pd, permanent)
+point pa;
+point pb;
+point pc;
+point pd;
+REAL permanent;
+{
+ INEXACT REAL adx, bdx, cdx, ady, bdy, cdy;
+ REAL det, errbound;
+
+ INEXACT REAL bdxcdy1, cdxbdy1, cdxady1, adxcdy1, adxbdy1, bdxady1;
+ REAL bdxcdy0, cdxbdy0, cdxady0, adxcdy0, adxbdy0, bdxady0;
+ REAL bc[4], ca[4], ab[4];
+ INEXACT REAL bc3, ca3, ab3;
+ REAL axbc[8], axxbc[16], aybc[8], ayybc[16], adet[32];
+ int axbclen, axxbclen, aybclen, ayybclen, alen;
+ REAL bxca[8], bxxca[16], byca[8], byyca[16], bdet[32];
+ int bxcalen, bxxcalen, bycalen, byycalen, blen;
+ REAL cxab[8], cxxab[16], cyab[8], cyyab[16], cdet[32];
+ int cxablen, cxxablen, cyablen, cyyablen, clen;
+ REAL abdet[64];
+ int ablen;
+ REAL fin1[1152], fin2[1152];
+ REAL *finnow, *finother, *finswap;
+ int finlength;
+
+ REAL adxtail, bdxtail, cdxtail, adytail, bdytail, cdytail;
+ INEXACT REAL adxadx1, adyady1, bdxbdx1, bdybdy1, cdxcdx1, cdycdy1;
+ REAL adxadx0, adyady0, bdxbdx0, bdybdy0, cdxcdx0, cdycdy0;
+ REAL aa[4], bb[4], cc[4];
+ INEXACT REAL aa3, bb3, cc3;
+ INEXACT REAL ti1, tj1;
+ REAL ti0, tj0;
+ REAL u[4], v[4];
+ INEXACT REAL u3, v3;
+ REAL temp8[8], temp16a[16], temp16b[16], temp16c[16];
+ REAL temp32a[32], temp32b[32], temp48[48], temp64[64];
+ int temp8len, temp16alen, temp16blen, temp16clen;
+ int temp32alen, temp32blen, temp48len, temp64len;
+ REAL axtbb[8], axtcc[8], aytbb[8], aytcc[8];
+ int axtbblen, axtcclen, aytbblen, aytcclen;
+ REAL bxtaa[8], bxtcc[8], bytaa[8], bytcc[8];
+ int bxtaalen, bxtcclen, bytaalen, bytcclen;
+ REAL cxtaa[8], cxtbb[8], cytaa[8], cytbb[8];
+ int cxtaalen, cxtbblen, cytaalen, cytbblen;
+ REAL axtbc[8], aytbc[8], bxtca[8], bytca[8], cxtab[8], cytab[8];
+ int axtbclen=0, aytbclen=0, bxtcalen=0, bytcalen=0, cxtablen=0, cytablen=0;
+ REAL axtbct[16], aytbct[16], bxtcat[16], bytcat[16], cxtabt[16], cytabt[16];
+ int axtbctlen, aytbctlen, bxtcatlen, bytcatlen, cxtabtlen, cytabtlen;
+ REAL axtbctt[8], aytbctt[8], bxtcatt[8];
+ REAL bytcatt[8], cxtabtt[8], cytabtt[8];
+ int axtbcttlen, aytbcttlen, bxtcattlen, bytcattlen, cxtabttlen, cytabttlen;
+ REAL abt[8], bct[8], cat[8];
+ int abtlen, bctlen, catlen;
+ REAL abtt[4], bctt[4], catt[4];
+ int abttlen, bcttlen, cattlen;
+ INEXACT REAL abtt3, bctt3, catt3;
+ REAL negate;
+
+ INEXACT REAL bvirt;
+ REAL avirt, bround, around;
+ INEXACT REAL c;
+ INEXACT REAL abig;
+ REAL ahi, alo, bhi, blo;
+ REAL err1, err2, err3;
+ INEXACT REAL _i, _j;
+ REAL _0;
+
+ adx = (REAL) (pa[0] - pd[0]);
+ bdx = (REAL) (pb[0] - pd[0]);
+ cdx = (REAL) (pc[0] - pd[0]);
+ ady = (REAL) (pa[1] - pd[1]);
+ bdy = (REAL) (pb[1] - pd[1]);
+ cdy = (REAL) (pc[1] - pd[1]);
+
+ Two_Product(bdx, cdy, bdxcdy1, bdxcdy0);
+ Two_Product(cdx, bdy, cdxbdy1, cdxbdy0);
+ Two_Two_Diff(bdxcdy1, bdxcdy0, cdxbdy1, cdxbdy0, bc3, bc[2], bc[1], bc[0]);
+ bc[3] = bc3;
+ axbclen = scale_expansion_zeroelim(4, bc, adx, axbc);
+ axxbclen = scale_expansion_zeroelim(axbclen, axbc, adx, axxbc);
+ aybclen = scale_expansion_zeroelim(4, bc, ady, aybc);
+ ayybclen = scale_expansion_zeroelim(aybclen, aybc, ady, ayybc);
+ alen = fast_expansion_sum_zeroelim(axxbclen, axxbc, ayybclen, ayybc, adet);
+
+ Two_Product(cdx, ady, cdxady1, cdxady0);
+ Two_Product(adx, cdy, adxcdy1, adxcdy0);
+ Two_Two_Diff(cdxady1, cdxady0, adxcdy1, adxcdy0, ca3, ca[2], ca[1], ca[0]);
+ ca[3] = ca3;
+ bxcalen = scale_expansion_zeroelim(4, ca, bdx, bxca);
+ bxxcalen = scale_expansion_zeroelim(bxcalen, bxca, bdx, bxxca);
+ bycalen = scale_expansion_zeroelim(4, ca, bdy, byca);
+ byycalen = scale_expansion_zeroelim(bycalen, byca, bdy, byyca);
+ blen = fast_expansion_sum_zeroelim(bxxcalen, bxxca, byycalen, byyca, bdet);
+
+ Two_Product(adx, bdy, adxbdy1, adxbdy0);
+ Two_Product(bdx, ady, bdxady1, bdxady0);
+ Two_Two_Diff(adxbdy1, adxbdy0, bdxady1, bdxady0, ab3, ab[2], ab[1], ab[0]);
+ ab[3] = ab3;
+ cxablen = scale_expansion_zeroelim(4, ab, cdx, cxab);
+ cxxablen = scale_expansion_zeroelim(cxablen, cxab, cdx, cxxab);
+ cyablen = scale_expansion_zeroelim(4, ab, cdy, cyab);
+ cyyablen = scale_expansion_zeroelim(cyablen, cyab, cdy, cyyab);
+ clen = fast_expansion_sum_zeroelim(cxxablen, cxxab, cyyablen, cyyab, cdet);
+
+ ablen = fast_expansion_sum_zeroelim(alen, adet, blen, bdet, abdet);
+ finlength = fast_expansion_sum_zeroelim(ablen, abdet, clen, cdet, fin1);
+
+ det = estimate(finlength, fin1);
+ errbound = iccerrboundB * permanent;
+ if ((det >= errbound) || (-det >= errbound)) {
+ return det;
+ }
+
+ Two_Diff_Tail(pa[0], pd[0], adx, adxtail);
+ Two_Diff_Tail(pa[1], pd[1], ady, adytail);
+ Two_Diff_Tail(pb[0], pd[0], bdx, bdxtail);
+ Two_Diff_Tail(pb[1], pd[1], bdy, bdytail);
+ Two_Diff_Tail(pc[0], pd[0], cdx, cdxtail);
+ Two_Diff_Tail(pc[1], pd[1], cdy, cdytail);
+ if ((adxtail == 0.0) && (bdxtail == 0.0) && (cdxtail == 0.0)
+ && (adytail == 0.0) && (bdytail == 0.0) && (cdytail == 0.0)) {
+ return det;
+ }
+
+ errbound = iccerrboundC * permanent + resulterrbound * Absolute(det);
+ det += ((adx * adx + ady * ady) * ((bdx * cdytail + cdy * bdxtail)
+ - (bdy * cdxtail + cdx * bdytail))
+ + 2.0 * (adx * adxtail + ady * adytail) * (bdx * cdy - bdy * cdx))
+ + ((bdx * bdx + bdy * bdy) * ((cdx * adytail + ady * cdxtail)
+ - (cdy * adxtail + adx * cdytail))
+ + 2.0 * (bdx * bdxtail + bdy * bdytail) * (cdx * ady - cdy * adx))
+ + ((cdx * cdx + cdy * cdy) * ((adx * bdytail + bdy * adxtail)
+ - (ady * bdxtail + bdx * adytail))
+ + 2.0 * (cdx * cdxtail + cdy * cdytail) * (adx * bdy - ady * bdx));
+ if ((det >= errbound) || (-det >= errbound)) {
+ return det;
+ }
+
+ finnow = fin1;
+ finother = fin2;
+
+ if ((bdxtail != 0.0) || (bdytail != 0.0)
+ || (cdxtail != 0.0) || (cdytail != 0.0)) {
+ Square(adx, adxadx1, adxadx0);
+ Square(ady, adyady1, adyady0);
+ Two_Two_Sum(adxadx1, adxadx0, adyady1, adyady0, aa3, aa[2], aa[1], aa[0]);
+ aa[3] = aa3;
+ }
+ if ((cdxtail != 0.0) || (cdytail != 0.0)
+ || (adxtail != 0.0) || (adytail != 0.0)) {
+ Square(bdx, bdxbdx1, bdxbdx0);
+ Square(bdy, bdybdy1, bdybdy0);
+ Two_Two_Sum(bdxbdx1, bdxbdx0, bdybdy1, bdybdy0, bb3, bb[2], bb[1], bb[0]);
+ bb[3] = bb3;
+ }
+ if ((adxtail != 0.0) || (adytail != 0.0)
+ || (bdxtail != 0.0) || (bdytail != 0.0)) {
+ Square(cdx, cdxcdx1, cdxcdx0);
+ Square(cdy, cdycdy1, cdycdy0);
+ Two_Two_Sum(cdxcdx1, cdxcdx0, cdycdy1, cdycdy0, cc3, cc[2], cc[1], cc[0]);
+ cc[3] = cc3;
+ }
+
+ if (adxtail != 0.0) {
+ axtbclen = scale_expansion_zeroelim(4, bc, adxtail, axtbc);
+ temp16alen = scale_expansion_zeroelim(axtbclen, axtbc, 2.0 * adx, temp16a);
+
+ axtcclen = scale_expansion_zeroelim(4, cc, adxtail, axtcc);
+ temp16blen = scale_expansion_zeroelim(axtcclen, axtcc, bdy, temp16b);
+
+ axtbblen = scale_expansion_zeroelim(4, bb, adxtail, axtbb);
+ temp16clen = scale_expansion_zeroelim(axtbblen, axtbb, -cdy, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (adytail != 0.0) {
+ aytbclen = scale_expansion_zeroelim(4, bc, adytail, aytbc);
+ temp16alen = scale_expansion_zeroelim(aytbclen, aytbc, 2.0 * ady, temp16a);
+
+ aytbblen = scale_expansion_zeroelim(4, bb, adytail, aytbb);
+ temp16blen = scale_expansion_zeroelim(aytbblen, aytbb, cdx, temp16b);
+
+ aytcclen = scale_expansion_zeroelim(4, cc, adytail, aytcc);
+ temp16clen = scale_expansion_zeroelim(aytcclen, aytcc, -bdx, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (bdxtail != 0.0) {
+ bxtcalen = scale_expansion_zeroelim(4, ca, bdxtail, bxtca);
+ temp16alen = scale_expansion_zeroelim(bxtcalen, bxtca, 2.0 * bdx, temp16a);
+
+ bxtaalen = scale_expansion_zeroelim(4, aa, bdxtail, bxtaa);
+ temp16blen = scale_expansion_zeroelim(bxtaalen, bxtaa, cdy, temp16b);
+
+ bxtcclen = scale_expansion_zeroelim(4, cc, bdxtail, bxtcc);
+ temp16clen = scale_expansion_zeroelim(bxtcclen, bxtcc, -ady, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (bdytail != 0.0) {
+ bytcalen = scale_expansion_zeroelim(4, ca, bdytail, bytca);
+ temp16alen = scale_expansion_zeroelim(bytcalen, bytca, 2.0 * bdy, temp16a);
+
+ bytcclen = scale_expansion_zeroelim(4, cc, bdytail, bytcc);
+ temp16blen = scale_expansion_zeroelim(bytcclen, bytcc, adx, temp16b);
+
+ bytaalen = scale_expansion_zeroelim(4, aa, bdytail, bytaa);
+ temp16clen = scale_expansion_zeroelim(bytaalen, bytaa, -cdx, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (cdxtail != 0.0) {
+ cxtablen = scale_expansion_zeroelim(4, ab, cdxtail, cxtab);
+ temp16alen = scale_expansion_zeroelim(cxtablen, cxtab, 2.0 * cdx, temp16a);
+
+ cxtbblen = scale_expansion_zeroelim(4, bb, cdxtail, cxtbb);
+ temp16blen = scale_expansion_zeroelim(cxtbblen, cxtbb, ady, temp16b);
+
+ cxtaalen = scale_expansion_zeroelim(4, aa, cdxtail, cxtaa);
+ temp16clen = scale_expansion_zeroelim(cxtaalen, cxtaa, -bdy, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (cdytail != 0.0) {
+ cytablen = scale_expansion_zeroelim(4, ab, cdytail, cytab);
+ temp16alen = scale_expansion_zeroelim(cytablen, cytab, 2.0 * cdy, temp16a);
+
+ cytaalen = scale_expansion_zeroelim(4, aa, cdytail, cytaa);
+ temp16blen = scale_expansion_zeroelim(cytaalen, cytaa, bdx, temp16b);
+
+ cytbblen = scale_expansion_zeroelim(4, bb, cdytail, cytbb);
+ temp16clen = scale_expansion_zeroelim(cytbblen, cytbb, -adx, temp16c);
+
+ temp32alen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16clen, temp16c,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+
+ if ((adxtail != 0.0) || (adytail != 0.0)) {
+ if ((bdxtail != 0.0) || (bdytail != 0.0)
+ || (cdxtail != 0.0) || (cdytail != 0.0)) {
+ Two_Product(bdxtail, cdy, ti1, ti0);
+ Two_Product(bdx, cdytail, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ negate = -bdy;
+ Two_Product(cdxtail, negate, ti1, ti0);
+ negate = -bdytail;
+ Two_Product(cdx, negate, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, v3, v[2], v[1], v[0]);
+ v[3] = v3;
+ bctlen = fast_expansion_sum_zeroelim(4, u, 4, v, bct);
+
+ Two_Product(bdxtail, cdytail, ti1, ti0);
+ Two_Product(cdxtail, bdytail, tj1, tj0);
+ Two_Two_Diff(ti1, ti0, tj1, tj0, bctt3, bctt[2], bctt[1], bctt[0]);
+ bctt[3] = bctt3;
+ bcttlen = 4;
+ } else {
+ bct[0] = 0.0;
+ bctlen = 1;
+ bctt[0] = 0.0;
+ bcttlen = 1;
+ }
+
+ if (adxtail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(axtbclen, axtbc, adxtail, temp16a);
+ axtbctlen = scale_expansion_zeroelim(bctlen, bct, adxtail, axtbct);
+ temp32alen = scale_expansion_zeroelim(axtbctlen, axtbct, 2.0 * adx, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ if (bdytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, cc, adxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, bdytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (cdytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, bb, -adxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, cdytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+
+ temp32alen = scale_expansion_zeroelim(axtbctlen, axtbct, adxtail, temp32a);
+ axtbcttlen = scale_expansion_zeroelim(bcttlen, bctt, adxtail, axtbctt);
+ temp16alen = scale_expansion_zeroelim(axtbcttlen, axtbctt, 2.0 * adx, temp16a);
+ temp16blen = scale_expansion_zeroelim(axtbcttlen, axtbctt, adxtail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (adytail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(aytbclen, aytbc, adytail, temp16a);
+ aytbctlen = scale_expansion_zeroelim(bctlen, bct, adytail, aytbct);
+ temp32alen = scale_expansion_zeroelim(aytbctlen, aytbct, 2.0 * ady, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+
+
+ temp32alen = scale_expansion_zeroelim(aytbctlen, aytbct, adytail, temp32a);
+ aytbcttlen = scale_expansion_zeroelim(bcttlen, bctt, adytail, aytbctt);
+ temp16alen = scale_expansion_zeroelim(aytbcttlen, aytbctt, 2.0 * ady, temp16a);
+ temp16blen = scale_expansion_zeroelim(aytbcttlen, aytbctt, adytail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ }
+ if ((bdxtail != 0.0) || (bdytail != 0.0)) {
+ if ((cdxtail != 0.0) || (cdytail != 0.0)
+ || (adxtail != 0.0) || (adytail != 0.0)) {
+ Two_Product(cdxtail, ady, ti1, ti0);
+ Two_Product(cdx, adytail, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ negate = -cdy;
+ Two_Product(adxtail, negate, ti1, ti0);
+ negate = -cdytail;
+ Two_Product(adx, negate, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, v3, v[2], v[1], v[0]);
+ v[3] = v3;
+ catlen = fast_expansion_sum_zeroelim(4, u, 4, v, cat);
+
+ Two_Product(cdxtail, adytail, ti1, ti0);
+ Two_Product(adxtail, cdytail, tj1, tj0);
+ Two_Two_Diff(ti1, ti0, tj1, tj0, catt3, catt[2], catt[1], catt[0]);
+ catt[3] = catt3;
+ cattlen = 4;
+ } else {
+ cat[0] = 0.0;
+ catlen = 1;
+ catt[0] = 0.0;
+ cattlen = 1;
+ }
+
+ if (bdxtail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(bxtcalen, bxtca, bdxtail, temp16a);
+ bxtcatlen = scale_expansion_zeroelim(catlen, cat, bdxtail, bxtcat);
+ temp32alen = scale_expansion_zeroelim(bxtcatlen, bxtcat, 2.0 * bdx, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ if (cdytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, aa, bdxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, cdytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (adytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, cc, -bdxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, adytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+
+ temp32alen = scale_expansion_zeroelim(bxtcatlen, bxtcat, bdxtail, temp32a);
+ bxtcattlen = scale_expansion_zeroelim(cattlen, catt, bdxtail, bxtcatt);
+ temp16alen = scale_expansion_zeroelim(bxtcattlen, bxtcatt, 2.0 * bdx, temp16a);
+ temp16blen = scale_expansion_zeroelim(bxtcattlen, bxtcatt, bdxtail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (bdytail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(bytcalen, bytca, bdytail, temp16a);
+ bytcatlen = scale_expansion_zeroelim(catlen, cat, bdytail, bytcat);
+ temp32alen = scale_expansion_zeroelim(bytcatlen, bytcat, 2.0 * bdy, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+
+
+ temp32alen = scale_expansion_zeroelim(bytcatlen, bytcat, bdytail, temp32a);
+ bytcattlen = scale_expansion_zeroelim(cattlen, catt, bdytail, bytcatt);
+ temp16alen = scale_expansion_zeroelim(bytcattlen, bytcatt, 2.0 * bdy, temp16a);
+ temp16blen = scale_expansion_zeroelim(bytcattlen, bytcatt, bdytail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ }
+ if ((cdxtail != 0.0) || (cdytail != 0.0)) {
+ if ((adxtail != 0.0) || (adytail != 0.0)
+ || (bdxtail != 0.0) || (bdytail != 0.0)) {
+ Two_Product(adxtail, bdy, ti1, ti0);
+ Two_Product(adx, bdytail, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, u3, u[2], u[1], u[0]);
+ u[3] = u3;
+ negate = -ady;
+ Two_Product(bdxtail, negate, ti1, ti0);
+ negate = -adytail;
+ Two_Product(bdx, negate, tj1, tj0);
+ Two_Two_Sum(ti1, ti0, tj1, tj0, v3, v[2], v[1], v[0]);
+ v[3] = v3;
+ abtlen = fast_expansion_sum_zeroelim(4, u, 4, v, abt);
+
+ Two_Product(adxtail, bdytail, ti1, ti0);
+ Two_Product(bdxtail, adytail, tj1, tj0);
+ Two_Two_Diff(ti1, ti0, tj1, tj0, abtt3, abtt[2], abtt[1], abtt[0]);
+ abtt[3] = abtt3;
+ abttlen = 4;
+ } else {
+ abt[0] = 0.0;
+ abtlen = 1;
+ abtt[0] = 0.0;
+ abttlen = 1;
+ }
+
+ if (cdxtail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(cxtablen, cxtab, cdxtail, temp16a);
+ cxtabtlen = scale_expansion_zeroelim(abtlen, abt, cdxtail, cxtabt);
+ temp32alen = scale_expansion_zeroelim(cxtabtlen, cxtabt, 2.0 * cdx, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ if (adytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, bb, cdxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, adytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (bdytail != 0.0) {
+ temp8len = scale_expansion_zeroelim(4, aa, -cdxtail, temp8);
+ temp16alen = scale_expansion_zeroelim(temp8len, temp8, bdytail, temp16a);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp16alen,
+ temp16a, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+
+ temp32alen = scale_expansion_zeroelim(cxtabtlen, cxtabt, cdxtail, temp32a);
+ cxtabttlen = scale_expansion_zeroelim(abttlen, abtt, cdxtail, cxtabtt);
+ temp16alen = scale_expansion_zeroelim(cxtabttlen, cxtabtt, 2.0 * cdx, temp16a);
+ temp16blen = scale_expansion_zeroelim(cxtabttlen, cxtabtt, cdxtail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+ }
+ if (cdytail != 0.0) {
+ temp16alen = scale_expansion_zeroelim(cytablen, cytab, cdytail, temp16a);
+ cytabtlen = scale_expansion_zeroelim(abtlen, abt, cdytail, cytabt);
+ temp32alen = scale_expansion_zeroelim(cytabtlen, cytabt, 2.0 * cdy, temp32a);
+ temp48len = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp32alen, temp32a, temp48);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp48len,
+ temp48, finother);
+ finswap = finnow; finnow = finother; finother = finswap;
+
+
+ temp32alen = scale_expansion_zeroelim(cytabtlen, cytabt, cdytail, temp32a);
+ cytabttlen = scale_expansion_zeroelim(abttlen, abtt, cdytail, cytabtt);
+ temp16alen = scale_expansion_zeroelim(cytabttlen, cytabtt, 2.0 * cdy, temp16a);
+ temp16blen = scale_expansion_zeroelim(cytabttlen, cytabtt, cdytail, temp16b);
+ temp32blen = fast_expansion_sum_zeroelim(temp16alen, temp16a,
+ temp16blen, temp16b, temp32b);
+ temp64len = fast_expansion_sum_zeroelim(temp32alen, temp32a,
+ temp32blen, temp32b, temp64);
+ finlength = fast_expansion_sum_zeroelim(finlength, finnow, temp64len,
+ temp64, finother);
+ finswap = finnow; finnow = finother; /* finother = finswap; */
+ }
+ }
+
+ return finnow[finlength - 1];
+}
+
+REAL incircle(pa, pb, pc, pd)
+point pa;
+point pb;
+point pc;
+point pd;
+{
+ REAL adx, bdx, cdx, ady, bdy, cdy;
+ REAL bdxcdy, cdxbdy, cdxady, adxcdy, adxbdy, bdxady;
+ REAL alift, blift, clift;
+ REAL det;
+ REAL permanent, errbound;
+
+ incirclecount++;
+
+ adx = pa[0] - pd[0];
+ bdx = pb[0] - pd[0];
+ cdx = pc[0] - pd[0];
+ ady = pa[1] - pd[1];
+ bdy = pb[1] - pd[1];
+ cdy = pc[1] - pd[1];
+
+ bdxcdy = bdx * cdy;
+ cdxbdy = cdx * bdy;
+ alift = adx * adx + ady * ady;
+
+ cdxady = cdx * ady;
+ adxcdy = adx * cdy;
+ blift = bdx * bdx + bdy * bdy;
+
+ adxbdy = adx * bdy;
+ bdxady = bdx * ady;
+ clift = cdx * cdx + cdy * cdy;
+
+ det = alift * (bdxcdy - cdxbdy)
+ + blift * (cdxady - adxcdy)
+ + clift * (adxbdy - bdxady);
+
+ if (noexact) {
+ return det;
+ }
+
+ permanent = (Absolute(bdxcdy) + Absolute(cdxbdy)) * alift
+ + (Absolute(cdxady) + Absolute(adxcdy)) * blift
+ + (Absolute(adxbdy) + Absolute(bdxady)) * clift;
+ errbound = iccerrboundA * permanent;
+ if ((det > errbound) || (-det > errbound)) {
+ return det;
+ }
+
+ return incircleadapt(pa, pb, pc, pd, permanent);
+}
+
+/** **/
+/** **/
+/********* Determinant evaluation routines end here *********/
+
+/*****************************************************************************/
+/* */
+/* triangleinit() Initialize some variables. */
+/* */
+/*****************************************************************************/
+
+void triangleinit()
+{
+ points.maxitems = triangles.maxitems = shelles.maxitems = viri.maxitems =
+ badsegments.maxitems = badtriangles.maxitems = splaynodes.maxitems = 0l;
+ points.itembytes = triangles.itembytes = shelles.itembytes = viri.itembytes =
+ badsegments.itembytes = badtriangles.itembytes = splaynodes.itembytes = 0;
+ recenttri.tri = (triangle *) NULL; /* No triangle has been visited yet. */
+ samples = 1; /* Point location should take at least one sample. */
+ checksegments = 0; /* There are no segments in the triangulation yet. */
+ incirclecount = counterclockcount = hyperbolacount = 0;
+ circumcentercount = circletopcount = 0;
+ randomseed = 1;
+
+ exactinit(); /* Initialize exact arithmetic constants. */
+}
+
+/*****************************************************************************/
+/* */
+/* randomnation() Generate a random number between 0 and `choices' - 1. */
+/* */
+/* This is a simple linear congruential random number generator. Hence, it */
+/* is a bad random number generator, but good enough for most randomized */
+/* geometric algorithms. */
+/* */
+/*****************************************************************************/
+
+unsigned long randomnation(choices)
+unsigned int choices;
+{
+ randomseed = (randomseed * 1366l + 150889l) % 714025l;
+ return randomseed / (714025l / choices + 1);
+}
+
+/********* Mesh quality testing routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* checkmesh() Test the mesh for topological consistency. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+
+void checkmesh()
+{
+ struct triedge triangleloop;
+ struct triedge oppotri, oppooppotri;
+ point triorg, tridest, triapex;
+ point oppoorg, oppodest;
+ int horrors;
+ int saveexact;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ /* Temporarily turn on exact arithmetic if it's off. */
+ saveexact = noexact;
+ noexact = 0;
+ if (!quiet) {
+ printf(" Checking consistency of mesh...\n");
+ }
+ horrors = 0;
+ /* Run through the list of triangles, checking each one. */
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ while (triangleloop.tri != (triangle *) NULL) {
+ /* Check all three edges of the triangle. */
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ org(triangleloop, triorg);
+ dest(triangleloop, tridest);
+ if (triangleloop.orient == 0) { /* Only test for inversion once. */
+ /* Test if the triangle is flat or inverted. */
+ apex(triangleloop, triapex);
+ if (counterclockwise(triorg, tridest, triapex) <= 0.0) {
+ printf(" !! !! Inverted ");
+ printtriangle(&triangleloop);
+ horrors++;
+ }
+ }
+ /* Find the neighboring triangle on this edge. */
+ sym(triangleloop, oppotri);
+ if (oppotri.tri != dummytri) {
+ /* Check that the triangle's neighbor knows it's a neighbor. */
+ sym(oppotri, oppooppotri);
+ if ((triangleloop.tri != oppooppotri.tri)
+ || (triangleloop.orient != oppooppotri.orient)) {
+ printf(" !! !! Asymmetric triangle-triangle bond:\n");
+ if (triangleloop.tri == oppooppotri.tri) {
+ printf(" (Right triangle, wrong orientation)\n");
+ }
+ printf(" First ");
+ printtriangle(&triangleloop);
+ printf(" Second (nonreciprocating) ");
+ printtriangle(&oppotri);
+ horrors++;
+ }
+ /* Check that both triangles agree on the identities */
+ /* of their shared vertices. */
+ org(oppotri, oppoorg);
+ dest(oppotri, oppodest);
+ if ((triorg != oppodest) || (tridest != oppoorg)) {
+ printf(" !! !! Mismatched edge coordinates between two triangles:\n");
+ printf(" First mismatched ");
+ printtriangle(&triangleloop);
+ printf(" Second mismatched ");
+ printtriangle(&oppotri);
+ horrors++;
+ }
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+ if (horrors == 0) {
+ if (!quiet) {
+ printf(" In my studied opinion, the mesh appears to be consistent.\n");
+ }
+ } else if (horrors == 1) {
+ printf(" !! !! !! !! Precisely one festering wound discovered.\n");
+ } else {
+ printf(" !! !! !! !! %d abominations witnessed.\n", horrors);
+ }
+ /* Restore the status of exact arithmetic. */
+ noexact = saveexact;
+}
+
+#endif /* not REDUCED */
+
+/*****************************************************************************/
+/* */
+/* checkdelaunay() Ensure that the mesh is (constrained) Delaunay. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+
+void checkdelaunay()
+{
+ struct triedge triangleloop;
+ struct triedge oppotri;
+ struct edge opposhelle;
+ point triorg, tridest, triapex;
+ point oppoapex;
+ int shouldbedelaunay;
+ int horrors;
+ int saveexact;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ /* Temporarily turn on exact arithmetic if it's off. */
+ saveexact = noexact;
+ noexact = 0;
+ if (!quiet) {
+ printf(" Checking Delaunay property of mesh...\n");
+ }
+ horrors = 0;
+ /* Run through the list of triangles, checking each one. */
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ while (triangleloop.tri != (triangle *) NULL) {
+ /* Check all three edges of the triangle. */
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ org(triangleloop, triorg);
+ dest(triangleloop, tridest);
+ apex(triangleloop, triapex);
+ sym(triangleloop, oppotri);
+ apex(oppotri, oppoapex);
+ /* Only test that the edge is locally Delaunay if there is an */
+ /* adjoining triangle whose pointer is larger (to ensure that */
+ /* each pair isn't tested twice). */
+ shouldbedelaunay = (oppotri.tri != dummytri)
+ && (triapex != (point) NULL) && (oppoapex != (point) NULL)
+ && (triangleloop.tri < oppotri.tri);
+ if (checksegments && shouldbedelaunay) {
+ /* If a shell edge separates the triangles, then the edge is */
+ /* constrained, so no local Delaunay test should be done. */
+ tspivot(triangleloop, opposhelle);
+ if (opposhelle.sh != dummysh){
+ shouldbedelaunay = 0;
+ }
+ }
+ if (shouldbedelaunay) {
+ if (incircle(triorg, tridest, triapex, oppoapex) > 0.0) {
+ printf(" !! !! Non-Delaunay pair of triangles:\n");
+ printf(" First non-Delaunay ");
+ printtriangle(&triangleloop);
+ printf(" Second non-Delaunay ");
+ printtriangle(&oppotri);
+ horrors++;
+ }
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+ if (horrors == 0) {
+ if (!quiet) {
+ printf(" By virtue of my perceptive intelligence, I declare the mesh Delaunay.\n");
+ }
+ } else if (horrors == 1) {
+ printf(" !! !! !! !! Precisely one terrifying transgression identified.\n");
+ } else {
+ printf(" !! !! !! !! %d obscenities viewed with horror.\n", horrors);
+ }
+ /* Restore the status of exact arithmetic. */
+ noexact = saveexact;
+}
+
+#endif /* not REDUCED */
+
+/*****************************************************************************/
+/* */
+/* enqueuebadtri() Add a bad triangle to the end of a queue. */
+/* */
+/* The queue is actually a set of 64 queues. I use multiple queues to give */
+/* priority to smaller angles. I originally implemented a heap, but the */
+/* queues are (to my surprise) much faster. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void enqueuebadtri(instri, angle, insapex, insorg, insdest)
+struct triedge *instri;
+REAL angle;
+point insapex;
+point insorg;
+point insdest;
+{
+ struct badface *newface;
+ int queuenumber;
+
+ if (verbose > 2) {
+ printf(" Queueing bad triangle:\n");
+ printf(" (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n", insorg[0],
+ insorg[1], insdest[0], insdest[1], insapex[0], insapex[1]);
+ }
+ /* Allocate space for the bad triangle. */
+ newface = (struct badface *) poolalloc(&badtriangles);
+ triedgecopy(*instri, newface->badfacetri);
+ newface->key = angle;
+ newface->faceapex = insapex;
+ newface->faceorg = insorg;
+ newface->facedest = insdest;
+ newface->nextface = (struct badface *) NULL;
+ /* Determine the appropriate queue to put the bad triangle into. */
+ if (angle > 0.6) {
+ queuenumber = (int) (160.0 * (angle - 0.6));
+ if (queuenumber > 63) {
+ queuenumber = 63;
+ }
+ } else {
+ /* It's not a bad angle; put the triangle in the lowest-priority queue. */
+ queuenumber = 0;
+ }
+ /* Add the triangle to the end of a queue. */
+ *queuetail[queuenumber] = newface;
+ /* Maintain a pointer to the NULL pointer at the end of the queue. */
+ queuetail[queuenumber] = &newface->nextface;
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* dequeuebadtri() Remove a triangle from the front of the queue. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+struct badface *dequeuebadtri()
+{
+ struct badface *result;
+ int queuenumber;
+
+ /* Look for a nonempty queue. */
+ for (queuenumber = 63; queuenumber >= 0; queuenumber--) {
+ result = queuefront[queuenumber];
+ if (result != (struct badface *) NULL) {
+ /* Remove the triangle from the queue. */
+ queuefront[queuenumber] = result->nextface;
+ /* Maintain a pointer to the NULL pointer at the end of the queue. */
+ if (queuefront[queuenumber] == (struct badface *) NULL) {
+ queuetail[queuenumber] = &queuefront[queuenumber];
+ }
+ return result;
+ }
+ }
+ return (struct badface *) NULL;
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* checkedge4encroach() Check a segment to see if it is encroached; add */
+/* it to the list if it is. */
+/* */
+/* An encroached segment is an unflippable edge that has a point in its */
+/* diametral circle (that is, it faces an angle greater than 90 degrees). */
+/* This definition is due to Ruppert. */
+/* */
+/* Returns a nonzero value if the edge is encroached. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+int checkedge4encroach(testedge)
+struct edge *testedge;
+{
+ struct triedge neighbortri;
+ struct edge testsym;
+ struct edge *badedge;
+ int addtolist;
+ int sides;
+ point eorg, edest, eapex;
+ triangle ptr; /* Temporary variable used by stpivot(). */
+
+ addtolist = 0;
+ sides = 0;
+
+ sorg(*testedge, eorg);
+ sdest(*testedge, edest);
+ /* Check one neighbor of the shell edge. */
+ stpivot(*testedge, neighbortri);
+ /* Does the neighbor exist, or is this a boundary edge? */
+ if (neighbortri.tri != dummytri) {
+ sides++;
+ /* Find a vertex opposite this edge. */
+ apex(neighbortri, eapex);
+ /* Check whether the vertex is inside the diametral circle of the */
+ /* shell edge. Pythagoras' Theorem is used to check whether the */
+ /* angle at the vertex is greater than 90 degrees. */
+ if (eapex[0] * (eorg[0] + edest[0]) + eapex[1] * (eorg[1] + edest[1]) >
+ eapex[0] * eapex[0] + eorg[0] * edest[0] +
+ eapex[1] * eapex[1] + eorg[1] * edest[1]) {
+ addtolist = 1;
+ }
+ }
+ /* Check the other neighbor of the shell edge. */
+ ssym(*testedge, testsym);
+ stpivot(testsym, neighbortri);
+ /* Does the neighbor exist, or is this a boundary edge? */
+ if (neighbortri.tri != dummytri) {
+ sides++;
+ /* Find the other vertex opposite this edge. */
+ apex(neighbortri, eapex);
+ /* Check whether the vertex is inside the diametral circle of the */
+ /* shell edge. Pythagoras' Theorem is used to check whether the */
+ /* angle at the vertex is greater than 90 degrees. */
+ if (eapex[0] * (eorg[0] + edest[0]) +
+ eapex[1] * (eorg[1] + edest[1]) >
+ eapex[0] * eapex[0] + eorg[0] * edest[0] +
+ eapex[1] * eapex[1] + eorg[1] * edest[1]) {
+ addtolist += 2;
+ }
+ }
+
+ if (addtolist && (!nobisect || ((nobisect == 1) && (sides == 2)))) {
+ if (verbose > 2) {
+ printf(" Queueing encroached segment (%.12g, %.12g) (%.12g, %.12g).\n",
+ eorg[0], eorg[1], edest[0], edest[1]);
+ }
+ /* Add the shell edge to the list of encroached segments. */
+ /* Be sure to get the orientation right. */
+ badedge = (struct edge *) poolalloc(&badsegments);
+ if (addtolist == 1) {
+ shellecopy(*testedge, *badedge);
+ } else {
+ shellecopy(testsym, *badedge);
+ }
+ }
+ return addtolist;
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* testtriangle() Test a face for quality measures. */
+/* */
+/* Tests a triangle to see if it satisfies the minimum angle condition and */
+/* the maximum area condition. Triangles that aren't up to spec are added */
+/* to the bad triangle queue. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void testtriangle(testtri)
+struct triedge *testtri;
+{
+ struct triedge sametesttri;
+ struct edge edge1, edge2;
+ point torg, tdest, tapex;
+ point anglevertex;
+ REAL dxod, dyod, dxda, dyda, dxao, dyao;
+ REAL dxod2, dyod2, dxda2, dyda2, dxao2, dyao2;
+ REAL apexlen, orglen, destlen;
+ REAL angle;
+ REAL area;
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ org(*testtri, torg);
+ dest(*testtri, tdest);
+ apex(*testtri, tapex);
+ dxod = torg[0] - tdest[0];
+ dyod = torg[1] - tdest[1];
+ dxda = tdest[0] - tapex[0];
+ dyda = tdest[1] - tapex[1];
+ dxao = tapex[0] - torg[0];
+ dyao = tapex[1] - torg[1];
+ dxod2 = dxod * dxod;
+ dyod2 = dyod * dyod;
+ dxda2 = dxda * dxda;
+ dyda2 = dyda * dyda;
+ dxao2 = dxao * dxao;
+ dyao2 = dyao * dyao;
+ /* Find the lengths of the triangle's three edges. */
+ apexlen = dxod2 + dyod2;
+ orglen = dxda2 + dyda2;
+ destlen = dxao2 + dyao2;
+ if ((apexlen < orglen) && (apexlen < destlen)) {
+ /* The edge opposite the apex is shortest. */
+ /* Find the square of the cosine of the angle at the apex. */
+ angle = dxda * dxao + dyda * dyao;
+ angle = angle * angle / (orglen * destlen);
+ anglevertex = tapex;
+ lnext(*testtri, sametesttri);
+ tspivot(sametesttri, edge1);
+ lnextself(sametesttri);
+ tspivot(sametesttri, edge2);
+ } else if (orglen < destlen) {
+ /* The edge opposite the origin is shortest. */
+ /* Find the square of the cosine of the angle at the origin. */
+ angle = dxod * dxao + dyod * dyao;
+ angle = angle * angle / (apexlen * destlen);
+ anglevertex = torg;
+ tspivot(*testtri, edge1);
+ lprev(*testtri, sametesttri);
+ tspivot(sametesttri, edge2);
+ } else {
+ /* The edge opposite the destination is shortest. */
+ /* Find the square of the cosine of the angle at the destination. */
+ angle = dxod * dxda + dyod * dyda;
+ angle = angle * angle / (apexlen * orglen);
+ anglevertex = tdest;
+ tspivot(*testtri, edge1);
+ lnext(*testtri, sametesttri);
+ tspivot(sametesttri, edge2);
+ }
+ /* Check if both edges that form the angle are segments. */
+ if ((edge1.sh != dummysh) && (edge2.sh != dummysh)) {
+ /* The angle is a segment intersection. */
+ if ((angle > 0.9924) && !quiet) { /* Roughly 5 degrees. */
+ if (angle > 1.0) {
+ /* Beware of a floating exception in acos(). */
+ angle = 1.0;
+ }
+ /* Find the actual angle in degrees, for printing. */
+ angle = acos(sqrt(angle)) * (180.0 / PI);
+ printf("Warning: Small angle (%.4g degrees) between segments at point\n", angle);
+ printf(" (%.12g, %.12g)\n", anglevertex[0], anglevertex[1]);
+ }
+ /* Don't add this bad triangle to the list; there's nothing that */
+ /* can be done about a small angle between two segments. */
+ angle = 0.0;
+ }
+ /* Check whether the angle is smaller than permitted. */
+ if (angle > goodangle) {
+ /* Add this triangle to the list of bad triangles. */
+ enqueuebadtri(testtri, angle, tapex, torg, tdest);
+ return;
+ }
+ if (vararea || fixedarea) {
+ /* Check whether the area is larger than permitted. */
+ area = 0.5 * (dxod * dyda - dyod * dxda);
+ if (fixedarea && (area > maxarea)) {
+ /* Add this triangle to the list of bad triangles. */
+ enqueuebadtri(testtri, angle, tapex, torg, tdest);
+ } else if (vararea) {
+ /* Nonpositive area constraints are treated as unconstrained. */
+ if ((area > areabound(*testtri)) && (areabound(*testtri) > 0.0)) {
+ /* Add this triangle to the list of bad triangles. */
+ enqueuebadtri(testtri, angle, tapex, torg, tdest);
+ }
+ }
+ }
+}
+
+#endif /* not CDT_ONLY */
+
+/** **/
+/** **/
+/********* Mesh quality testing routines end here *********/
+
+/********* Point location routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* makepointmap() Construct a mapping from points to triangles to improve */
+/* the speed of point location for segment insertion. */
+/* */
+/* Traverses all the triangles, and provides each corner of each triangle */
+/* with a pointer to that triangle. Of course, pointers will be */
+/* overwritten by other pointers because (almost) each point is a corner */
+/* of several triangles, but in the end every point will point to some */
+/* triangle that contains it. */
+/* */
+/*****************************************************************************/
+
+void makepointmap()
+{
+ struct triedge triangleloop;
+ point triorg;
+
+ if (verbose) {
+ printf(" Constructing mapping from points to triangles.\n");
+ }
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ while (triangleloop.tri != (triangle *) NULL) {
+ /* Check all three points of the triangle. */
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ org(triangleloop, triorg);
+ setpoint2tri(triorg, encode(triangleloop));
+ }
+ triangleloop.tri = triangletraverse();
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* preciselocate() Find a triangle or edge containing a given point. */
+/* */
+/* Begins its search from `searchtri'. It is important that `searchtri' */
+/* be a handle with the property that `searchpoint' is strictly to the left */
+/* of the edge denoted by `searchtri', or is collinear with that edge and */
+/* does not intersect that edge. (In particular, `searchpoint' should not */
+/* be the origin or destination of that edge.) */
+/* */
+/* These conditions are imposed because preciselocate() is normally used in */
+/* one of two situations: */
+/* */
+/* (1) To try to find the location to insert a new point. Normally, we */
+/* know an edge that the point is strictly to the left of. In the */
+/* incremental Delaunay algorithm, that edge is a bounding box edge. */
+/* In Ruppert's Delaunay refinement algorithm for quality meshing, */
+/* that edge is the shortest edge of the triangle whose circumcenter */
+/* is being inserted. */
+/* */
+/* (2) To try to find an existing point. In this case, any edge on the */
+/* convex hull is a good starting edge. The possibility that the */
+/* vertex one seeks is an endpoint of the starting edge must be */
+/* screened out before preciselocate() is called. */
+/* */
+/* On completion, `searchtri' is a triangle that contains `searchpoint'. */
+/* */
+/* This implementation differs from that given by Guibas and Stolfi. It */
+/* walks from triangle to triangle, crossing an edge only if `searchpoint' */
+/* is on the other side of the line containing that edge. After entering */
+/* a triangle, there are two edges by which one can leave that triangle. */
+/* If both edges are valid (`searchpoint' is on the other side of both */
+/* edges), one of the two is chosen by drawing a line perpendicular to */
+/* the entry edge (whose endpoints are `forg' and `fdest') passing through */
+/* `fapex'. Depending on which side of this perpendicular `searchpoint' */
+/* falls on, an exit edge is chosen. */
+/* */
+/* This implementation is empirically faster than the Guibas and Stolfi */
+/* point location routine (which I originally used), which tends to spiral */
+/* in toward its target. */
+/* */
+/* Returns ONVERTEX if the point lies on an existing vertex. `searchtri' */
+/* is a handle whose origin is the existing vertex. */
+/* */
+/* Returns ONEDGE if the point lies on a mesh edge. `searchtri' is a */
+/* handle whose primary edge is the edge on which the point lies. */
+/* */
+/* Returns INTRIANGLE if the point lies strictly within a triangle. */
+/* `searchtri' is a handle on the triangle that contains the point. */
+/* */
+/* Returns OUTSIDE if the point lies outside the mesh. `searchtri' is a */
+/* handle whose primary edge the point is to the right of. This might */
+/* occur when the circumcenter of a triangle falls just slightly outside */
+/* the mesh due to floating-point roundoff error. It also occurs when */
+/* seeking a hole or region point that a foolish user has placed outside */
+/* the mesh. */
+/* */
+/* WARNING: This routine is designed for convex triangulations, and will */
+/* not generally work after the holes and concavities have been carved. */
+/* However, it can still be used to find the circumcenter of a triangle, as */
+/* long as the search is begun from the triangle in question. */
+/* */
+/*****************************************************************************/
+
+enum locateresult preciselocate(searchpoint, searchtri)
+point searchpoint;
+struct triedge *searchtri;
+{
+ struct triedge backtracktri;
+ point forg, fdest, fapex;
+ point swappoint;
+ REAL orgorient, destorient;
+ int moveleft;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (verbose > 2) {
+ printf(" Searching for point (%.12g, %.12g).\n",
+ searchpoint[0], searchpoint[1]);
+ }
+ /* Where are we? */
+ org(*searchtri, forg);
+ dest(*searchtri, fdest);
+ apex(*searchtri, fapex);
+ while (1) {
+ if (verbose > 2) {
+ printf(" At (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ forg[0], forg[1], fdest[0], fdest[1], fapex[0], fapex[1]);
+ }
+ /* Check whether the apex is the point we seek. */
+ if ((fapex[0] == searchpoint[0]) && (fapex[1] == searchpoint[1])) {
+ lprevself(*searchtri);
+ return ONVERTEX;
+ }
+ /* Does the point lie on the other side of the line defined by the */
+ /* triangle edge opposite the triangle's destination? */
+ destorient = counterclockwise(forg, fapex, searchpoint);
+ /* Does the point lie on the other side of the line defined by the */
+ /* triangle edge opposite the triangle's origin? */
+ orgorient = counterclockwise(fapex, fdest, searchpoint);
+ if (destorient > 0.0) {
+ if (orgorient > 0.0) {
+ /* Move left if the inner product of (fapex - searchpoint) and */
+ /* (fdest - forg) is positive. This is equivalent to drawing */
+ /* a line perpendicular to the line (forg, fdest) passing */
+ /* through `fapex', and determining which side of this line */
+ /* `searchpoint' falls on. */
+ moveleft = (fapex[0] - searchpoint[0]) * (fdest[0] - forg[0]) +
+ (fapex[1] - searchpoint[1]) * (fdest[1] - forg[1]) > 0.0;
+ } else {
+ moveleft = 1;
+ }
+ } else {
+ if (orgorient > 0.0) {
+ moveleft = 0;
+ } else {
+ /* The point we seek must be on the boundary of or inside this */
+ /* triangle. */
+ if (destorient == 0.0) {
+ lprevself(*searchtri);
+ return ONEDGE;
+ }
+ if (orgorient == 0.0) {
+ lnextself(*searchtri);
+ return ONEDGE;
+ }
+ return INTRIANGLE;
+ }
+ }
+
+ /* Move to another triangle. Leave a trace `backtracktri' in case */
+ /* floating-point roundoff or some such bogey causes us to walk */
+ /* off a boundary of the triangulation. We can just bounce off */
+ /* the boundary as if it were an elastic band. */
+ if (moveleft) {
+ lprev(*searchtri, backtracktri);
+ fdest = fapex;
+ } else {
+ lnext(*searchtri, backtracktri);
+ forg = fapex;
+ }
+ sym(backtracktri, *searchtri);
+
+ /* Check for walking off the edge. */
+ if (searchtri->tri == dummytri) {
+ /* Turn around. */
+ triedgecopy(backtracktri, *searchtri);
+ swappoint = forg;
+ forg = fdest;
+ fdest = swappoint;
+ apex(*searchtri, fapex);
+ /* Check if the point really is beyond the triangulation boundary. */
+ destorient = counterclockwise(forg, fapex, searchpoint);
+ orgorient = counterclockwise(fapex, fdest, searchpoint);
+ if ((orgorient < 0.0) && (destorient < 0.0)) {
+ return OUTSIDE;
+ }
+ } else {
+ apex(*searchtri, fapex);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* locate() Find a triangle or edge containing a given point. */
+/* */
+/* Searching begins from one of: the input `searchtri', a recently */
+/* encountered triangle `recenttri', or from a triangle chosen from a */
+/* random sample. The choice is made by determining which triangle's */
+/* origin is closest to the point we are searcing for. Normally, */
+/* `searchtri' should be a handle on the convex hull of the triangulation. */
+/* */
+/* Details on the random sampling method can be found in the Mucke, Saias, */
+/* and Zhu paper cited in the header of this code. */
+/* */
+/* On completion, `searchtri' is a triangle that contains `searchpoint'. */
+/* */
+/* Returns ONVERTEX if the point lies on an existing vertex. `searchtri' */
+/* is a handle whose origin is the existing vertex. */
+/* */
+/* Returns ONEDGE if the point lies on a mesh edge. `searchtri' is a */
+/* handle whose primary edge is the edge on which the point lies. */
+/* */
+/* Returns INTRIANGLE if the point lies strictly within a triangle. */
+/* `searchtri' is a handle on the triangle that contains the point. */
+/* */
+/* Returns OUTSIDE if the point lies outside the mesh. `searchtri' is a */
+/* handle whose primary edge the point is to the right of. This might */
+/* occur when the circumcenter of a triangle falls just slightly outside */
+/* the mesh due to floating-point roundoff error. It also occurs when */
+/* seeking a hole or region point that a foolish user has placed outside */
+/* the mesh. */
+/* */
+/* WARNING: This routine is designed for convex triangulations, and will */
+/* not generally work after the holes and concavities have been carved. */
+/* */
+/*****************************************************************************/
+
+enum locateresult locate(searchpoint, searchtri)
+point searchpoint;
+struct triedge *searchtri;
+{
+ VOID **sampleblock;
+ triangle *firsttri;
+ struct triedge sampletri;
+ point torg, tdest;
+ intptr_t alignptr;
+ REAL searchdist, dist;
+ REAL ahead;
+ long sampleblocks, samplesperblock, samplenum;
+ long triblocks;
+ long i, j;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (verbose > 2) {
+ printf(" Randomly sampling for a triangle near point (%.12g, %.12g).\n",
+ searchpoint[0], searchpoint[1]);
+ }
+ /* Record the distance from the suggested starting triangle to the */
+ /* point we seek. */
+ org(*searchtri, torg);
+ searchdist = (searchpoint[0] - torg[0]) * (searchpoint[0] - torg[0])
+ + (searchpoint[1] - torg[1]) * (searchpoint[1] - torg[1]);
+ if (verbose > 2) {
+ printf(" Boundary triangle has origin (%.12g, %.12g).\n",
+ torg[0], torg[1]);
+ }
+
+ /* If a recently encountered triangle has been recorded and has not been */
+ /* deallocated, test it as a good starting point. */
+ if (recenttri.tri != (triangle *) NULL) {
+ if (recenttri.tri[3] != (triangle) NULL) {
+ org(recenttri, torg);
+ if ((torg[0] == searchpoint[0]) && (torg[1] == searchpoint[1])) {
+ triedgecopy(recenttri, *searchtri);
+ return ONVERTEX;
+ }
+ dist = (searchpoint[0] - torg[0]) * (searchpoint[0] - torg[0])
+ + (searchpoint[1] - torg[1]) * (searchpoint[1] - torg[1]);
+ if (dist < searchdist) {
+ triedgecopy(recenttri, *searchtri);
+ searchdist = dist;
+ if (verbose > 2) {
+ printf(" Choosing recent triangle with origin (%.12g, %.12g).\n",
+ torg[0], torg[1]);
+ }
+ }
+ }
+ }
+
+ /* The number of random samples taken is proportional to the cube root of */
+ /* the number of triangles in the mesh. The next bit of code assumes */
+ /* that the number of triangles increases monotonically. */
+ while (SAMPLEFACTOR * samples * samples * samples < triangles.items) {
+ samples++;
+ }
+ triblocks = (triangles.maxitems + TRIPERBLOCK - 1) / TRIPERBLOCK;
+ samplesperblock = 1 + (samples / triblocks);
+ sampleblocks = samples / samplesperblock;
+ sampleblock = triangles.firstblock;
+ sampletri.orient = 0;
+ for (i = 0; i < sampleblocks; i++) {
+ alignptr = (intptr_t) (sampleblock + 1);
+ firsttri = (triangle *) (alignptr + (intptr_t) triangles.alignbytes
+ - (alignptr % (intptr_t) triangles.alignbytes));
+ for (j = 0; j < samplesperblock; j++) {
+ if (i == triblocks - 1) {
+ samplenum = randomnation((int)
+ (triangles.maxitems - (i * TRIPERBLOCK)));
+ } else {
+ samplenum = randomnation(TRIPERBLOCK);
+ }
+ sampletri.tri = (triangle *)
+ (firsttri + (samplenum * triangles.itemwords));
+ if (sampletri.tri[3] != (triangle) NULL) {
+ org(sampletri, torg);
+ dist = (searchpoint[0] - torg[0]) * (searchpoint[0] - torg[0])
+ + (searchpoint[1] - torg[1]) * (searchpoint[1] - torg[1]);
+ if (dist < searchdist) {
+ triedgecopy(sampletri, *searchtri);
+ searchdist = dist;
+ if (verbose > 2) {
+ printf(" Choosing triangle with origin (%.12g, %.12g).\n",
+ torg[0], torg[1]);
+ }
+ }
+ }
+ }
+ sampleblock = (VOID **) *sampleblock;
+ }
+ /* Where are we? */
+ org(*searchtri, torg);
+ dest(*searchtri, tdest);
+ /* Check the starting triangle's vertices. */
+ if ((torg[0] == searchpoint[0]) && (torg[1] == searchpoint[1])) {
+ return ONVERTEX;
+ }
+ if ((tdest[0] == searchpoint[0]) && (tdest[1] == searchpoint[1])) {
+ lnextself(*searchtri);
+ return ONVERTEX;
+ }
+ /* Orient `searchtri' to fit the preconditions of calling preciselocate(). */
+ ahead = counterclockwise(torg, tdest, searchpoint);
+ if (ahead < 0.0) {
+ /* Turn around so that `searchpoint' is to the left of the */
+ /* edge specified by `searchtri'. */
+ symself(*searchtri);
+ } else if (ahead == 0.0) {
+ /* Check if `searchpoint' is between `torg' and `tdest'. */
+ if (((torg[0] < searchpoint[0]) == (searchpoint[0] < tdest[0]))
+ && ((torg[1] < searchpoint[1]) == (searchpoint[1] < tdest[1]))) {
+ return ONEDGE;
+ }
+ }
+ return preciselocate(searchpoint, searchtri);
+}
+
+/** **/
+/** **/
+/********* Point location routines end here *********/
+
+/********* Mesh transformation routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* insertshelle() Create a new shell edge and insert it between two */
+/* triangles. */
+/* */
+/* The new shell edge is inserted at the edge described by the handle */
+/* `tri'. Its vertices are properly initialized. The marker `shellemark' */
+/* is applied to the shell edge and, if appropriate, its vertices. */
+/* */
+/*****************************************************************************/
+
+void insertshelle(tri, shellemark)
+struct triedge *tri; /* Edge at which to insert the new shell edge. */
+int shellemark; /* Marker for the new shell edge. */
+{
+ struct triedge oppotri;
+ struct edge newshelle;
+ point triorg, tridest;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ /* Mark points if possible. */
+ org(*tri, triorg);
+ dest(*tri, tridest);
+ if (pointmark(triorg) == 0) {
+ setpointmark(triorg, shellemark);
+ }
+ if (pointmark(tridest) == 0) {
+ setpointmark(tridest, shellemark);
+ }
+ /* Check if there's already a shell edge here. */
+ tspivot(*tri, newshelle);
+ if (newshelle.sh == dummysh) {
+ /* Make new shell edge and initialize its vertices. */
+ makeshelle(&newshelle);
+ setsorg(newshelle, tridest);
+ setsdest(newshelle, triorg);
+ /* Bond new shell edge to the two triangles it is sandwiched between. */
+ /* Note that the facing triangle `oppotri' might be equal to */
+ /* `dummytri' (outer space), but the new shell edge is bonded to it */
+ /* all the same. */
+ tsbond(*tri, newshelle);
+ sym(*tri, oppotri);
+ ssymself(newshelle);
+ tsbond(oppotri, newshelle);
+ setmark(newshelle, shellemark);
+ if (verbose > 2) {
+ printf(" Inserting new ");
+ printshelle(&newshelle);
+ }
+ } else {
+ if (mark(newshelle) == 0) {
+ setmark(newshelle, shellemark);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* Terminology */
+/* */
+/* A "local transformation" replaces a small set of triangles with another */
+/* set of triangles. This may or may not involve inserting or deleting a */
+/* point. */
+/* */
+/* The term "casing" is used to describe the set of triangles that are */
+/* attached to the triangles being transformed, but are not transformed */
+/* themselves. Think of the casing as a fixed hollow structure inside */
+/* which all the action happens. A "casing" is only defined relative to */
+/* a single transformation; each occurrence of a transformation will */
+/* involve a different casing. */
+/* */
+/* A "shell" is similar to a "casing". The term "shell" describes the set */
+/* of shell edges (if any) that are attached to the triangles being */
+/* transformed. However, I sometimes use "shell" to refer to a single */
+/* shell edge, so don't get confused. */
+/* */
+/*****************************************************************************/
+
+/*****************************************************************************/
+/* */
+/* flip() Transform two triangles to two different triangles by flipping */
+/* an edge within a quadrilateral. */
+/* */
+/* Imagine the original triangles, abc and bad, oriented so that the */
+/* shared edge ab lies in a horizontal plane, with the point b on the left */
+/* and the point a on the right. The point c lies below the edge, and the */
+/* point d lies above the edge. The `flipedge' handle holds the edge ab */
+/* of triangle abc, and is directed left, from vertex a to vertex b. */
+/* */
+/* The triangles abc and bad are deleted and replaced by the triangles cdb */
+/* and dca. The triangles that represent abc and bad are NOT deallocated; */
+/* they are reused for dca and cdb, respectively. Hence, any handles that */
+/* may have held the original triangles are still valid, although not */
+/* directed as they were before. */
+/* */
+/* Upon completion of this routine, the `flipedge' handle holds the edge */
+/* dc of triangle dca, and is directed down, from vertex d to vertex c. */
+/* (Hence, the two triangles have rotated counterclockwise.) */
+/* */
+/* WARNING: This transformation is geometrically valid only if the */
+/* quadrilateral adbc is convex. Furthermore, this transformation is */
+/* valid only if there is not a shell edge between the triangles abc and */
+/* bad. This routine does not check either of these preconditions, and */
+/* it is the responsibility of the calling routine to ensure that they are */
+/* met. If they are not, the streets shall be filled with wailing and */
+/* gnashing of teeth. */
+/* */
+/*****************************************************************************/
+
+void flip(flipedge)
+struct triedge *flipedge; /* Handle for the triangle abc. */
+{
+ struct triedge botleft, botright;
+ struct triedge topleft, topright;
+ struct triedge top;
+ struct triedge botlcasing, botrcasing;
+ struct triedge toplcasing, toprcasing;
+ struct edge botlshelle, botrshelle;
+ struct edge toplshelle, toprshelle;
+ point leftpoint, rightpoint, botpoint;
+ point farpoint;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ /* Identify the vertices of the quadrilateral. */
+ org(*flipedge, rightpoint);
+ dest(*flipedge, leftpoint);
+ apex(*flipedge, botpoint);
+ sym(*flipedge, top);
+#ifdef SELF_CHECK
+ if (top.tri == dummytri) {
+ printf("Internal error in flip(): Attempt to flip on boundary.\n");
+ lnextself(*flipedge);
+ return;
+ }
+ if (checksegments) {
+ tspivot(*flipedge, toplshelle);
+ if (toplshelle.sh != dummysh) {
+ printf("Internal error in flip(): Attempt to flip a segment.\n");
+ lnextself(*flipedge);
+ return;
+ }
+ }
+#endif /* SELF_CHECK */
+ apex(top, farpoint);
+
+ /* Identify the casing of the quadrilateral. */
+ lprev(top, topleft);
+ sym(topleft, toplcasing);
+ lnext(top, topright);
+ sym(topright, toprcasing);
+ lnext(*flipedge, botleft);
+ sym(botleft, botlcasing);
+ lprev(*flipedge, botright);
+ sym(botright, botrcasing);
+ /* Rotate the quadrilateral one-quarter turn counterclockwise. */
+ bond(topleft, botlcasing);
+ bond(botleft, botrcasing);
+ bond(botright, toprcasing);
+ bond(topright, toplcasing);
+
+ if (checksegments) {
+ /* Check for shell edges and rebond them to the quadrilateral. */
+ tspivot(topleft, toplshelle);
+ tspivot(botleft, botlshelle);
+ tspivot(botright, botrshelle);
+ tspivot(topright, toprshelle);
+ if (toplshelle.sh == dummysh) {
+ tsdissolve(topright);
+ } else {
+ tsbond(topright, toplshelle);
+ }
+ if (botlshelle.sh == dummysh) {
+ tsdissolve(topleft);
+ } else {
+ tsbond(topleft, botlshelle);
+ }
+ if (botrshelle.sh == dummysh) {
+ tsdissolve(botleft);
+ } else {
+ tsbond(botleft, botrshelle);
+ }
+ if (toprshelle.sh == dummysh) {
+ tsdissolve(botright);
+ } else {
+ tsbond(botright, toprshelle);
+ }
+ }
+
+ /* New point assignments for the rotated quadrilateral. */
+ setorg(*flipedge, farpoint);
+ setdest(*flipedge, botpoint);
+ setapex(*flipedge, rightpoint);
+ setorg(top, botpoint);
+ setdest(top, farpoint);
+ setapex(top, leftpoint);
+ if (verbose > 2) {
+ printf(" Edge flip results in left ");
+ lnextself(topleft);
+ printtriangle(&topleft);
+ printf(" and right ");
+ printtriangle(flipedge);
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* insertsite() Insert a vertex into a Delaunay triangulation, */
+/* performing flips as necessary to maintain the Delaunay */
+/* property. */
+/* */
+/* The point `insertpoint' is located. If `searchtri.tri' is not NULL, */
+/* the search for the containing triangle begins from `searchtri'. If */
+/* `searchtri.tri' is NULL, a full point location procedure is called. */
+/* If `insertpoint' is found inside a triangle, the triangle is split into */
+/* three; if `insertpoint' lies on an edge, the edge is split in two, */
+/* thereby splitting the two adjacent triangles into four. Edge flips are */
+/* used to restore the Delaunay property. If `insertpoint' lies on an */
+/* existing vertex, no action is taken, and the value DUPLICATEPOINT is */
+/* returned. On return, `searchtri' is set to a handle whose origin is the */
+/* existing vertex. */
+/* */
+/* Normally, the parameter `splitedge' is set to NULL, implying that no */
+/* segment should be split. In this case, if `insertpoint' is found to */
+/* lie on a segment, no action is taken, and the value VIOLATINGPOINT is */
+/* returned. On return, `searchtri' is set to a handle whose primary edge */
+/* is the violated segment. */
+/* */
+/* If the calling routine wishes to split a segment by inserting a point in */
+/* it, the parameter `splitedge' should be that segment. In this case, */
+/* `searchtri' MUST be the triangle handle reached by pivoting from that */
+/* segment; no point location is done. */
+/* */
+/* `segmentflaws' and `triflaws' are flags that indicate whether or not */
+/* there should be checks for the creation of encroached segments or bad */
+/* quality faces. If a newly inserted point encroaches upon segments, */
+/* these segments are added to the list of segments to be split if */
+/* `segmentflaws' is set. If bad triangles are created, these are added */
+/* to the queue if `triflaws' is set. */
+/* */
+/* If a duplicate point or violated segment does not prevent the point */
+/* from being inserted, the return value will be ENCROACHINGPOINT if the */
+/* point encroaches upon a segment (and checking is enabled), or */
+/* SUCCESSFULPOINT otherwise. In either case, `searchtri' is set to a */
+/* handle whose origin is the newly inserted vertex. */
+/* */
+/* insertsite() does not use flip() for reasons of speed; some */
+/* information can be reused from edge flip to edge flip, like the */
+/* locations of shell edges. */
+/* */
+/*****************************************************************************/
+
+enum insertsiteresult insertsite(insertpoint, searchtri, splitedge,
+ segmentflaws, triflaws)
+point insertpoint;
+struct triedge *searchtri;
+struct edge *splitedge;
+int segmentflaws;
+int triflaws;
+{
+ struct triedge horiz;
+ struct triedge top;
+ struct triedge botleft, botright;
+ struct triedge topleft, topright;
+ struct triedge newbotleft, newbotright;
+ struct triedge newtopright;
+ struct triedge botlcasing, botrcasing;
+ struct triedge toplcasing, toprcasing;
+ struct triedge testtri;
+ struct edge botlshelle, botrshelle;
+ struct edge toplshelle, toprshelle;
+ struct edge brokenshelle;
+ struct edge checkshelle;
+ struct edge rightedge;
+ struct edge newedge;
+ struct edge *encroached;
+ point first;
+ point leftpoint, rightpoint, botpoint, toppoint, farpoint;
+ REAL attrib;
+ REAL area;
+ enum insertsiteresult success;
+ enum locateresult intersect;
+ int doflip;
+ int mirrorflag;
+ int i;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by spivot() and tspivot(). */
+
+ if (verbose > 1) {
+ printf(" Inserting (%.12g, %.12g).\n", insertpoint[0], insertpoint[1]);
+ }
+ if (splitedge == (struct edge *) NULL) {
+ /* Find the location of the point to be inserted. Check if a good */
+ /* starting triangle has already been provided by the caller. */
+ if (searchtri->tri == (triangle *) NULL) {
+ /* Find a boundary triangle. */
+ horiz.tri = dummytri;
+ horiz.orient = 0;
+ symself(horiz);
+ /* Search for a triangle containing `insertpoint'. */
+ intersect = locate(insertpoint, &horiz);
+ } else {
+ /* Start searching from the triangle provided by the caller. */
+ triedgecopy(*searchtri, horiz);
+ intersect = preciselocate(insertpoint, &horiz);
+ }
+ } else {
+ /* The calling routine provides the edge in which the point is inserted. */
+ triedgecopy(*searchtri, horiz);
+ intersect = ONEDGE;
+ }
+ if (intersect == ONVERTEX) {
+ /* There's already a vertex there. Return in `searchtri' a triangle */
+ /* whose origin is the existing vertex. */
+ triedgecopy(horiz, *searchtri);
+ triedgecopy(horiz, recenttri);
+ return DUPLICATEPOINT;
+ }
+ if ((intersect == ONEDGE) || (intersect == OUTSIDE)) {
+ /* The vertex falls on an edge or boundary. */
+ if (checksegments && (splitedge == (struct edge *) NULL)) {
+ /* Check whether the vertex falls on a shell edge. */
+ tspivot(horiz, brokenshelle);
+ if (brokenshelle.sh != dummysh) {
+ /* The vertex falls on a shell edge. */
+ if (segmentflaws) {
+ if (nobisect == 0) {
+ /* Add the shell edge to the list of encroached segments. */
+ encroached = (struct edge *) poolalloc(&badsegments);
+ shellecopy(brokenshelle, *encroached);
+ } else if ((nobisect == 1) && (intersect == ONEDGE)) {
+ /* This segment may be split only if it is an internal boundary. */
+ sym(horiz, testtri);
+ if (testtri.tri != dummytri) {
+ /* Add the shell edge to the list of encroached segments. */
+ encroached = (struct edge *) poolalloc(&badsegments);
+ shellecopy(brokenshelle, *encroached);
+ }
+ }
+ }
+ /* Return a handle whose primary edge contains the point, */
+ /* which has not been inserted. */
+ triedgecopy(horiz, *searchtri);
+ triedgecopy(horiz, recenttri);
+ return VIOLATINGPOINT;
+ }
+ }
+ /* Insert the point on an edge, dividing one triangle into two (if */
+ /* the edge lies on a boundary) or two triangles into four. */
+ lprev(horiz, botright);
+ sym(botright, botrcasing);
+ sym(horiz, topright);
+ /* Is there a second triangle? (Or does this edge lie on a boundary?) */
+ mirrorflag = topright.tri != dummytri;
+ if (mirrorflag) {
+ lnextself(topright);
+ sym(topright, toprcasing);
+ maketriangle(&newtopright);
+ } else {
+ /* Splitting the boundary edge increases the number of boundary edges. */
+ hullsize++;
+ }
+ maketriangle(&newbotright);
+
+ /* Set the vertices of changed and new triangles. */
+ org(horiz, rightpoint);
+ dest(horiz, leftpoint);
+ apex(horiz, botpoint);
+ setorg(newbotright, botpoint);
+ setdest(newbotright, rightpoint);
+ setapex(newbotright, insertpoint);
+ setorg(horiz, insertpoint);
+ for (i = 0; i < eextras; i++) {
+ /* Set the element attributes of a new triangle. */
+ setelemattribute(newbotright, i, elemattribute(botright, i));
+ }
+ if (vararea) {
+ /* Set the area constraint of a new triangle. */
+ setareabound(newbotright, areabound(botright));
+ }
+ if (mirrorflag) {
+ dest(topright, toppoint);
+ setorg(newtopright, rightpoint);
+ setdest(newtopright, toppoint);
+ setapex(newtopright, insertpoint);
+ setorg(topright, insertpoint);
+ for (i = 0; i < eextras; i++) {
+ /* Set the element attributes of another new triangle. */
+ setelemattribute(newtopright, i, elemattribute(topright, i));
+ }
+ if (vararea) {
+ /* Set the area constraint of another new triangle. */
+ setareabound(newtopright, areabound(topright));
+ }
+ }
+
+ /* There may be shell edges that need to be bonded */
+ /* to the new triangle(s). */
+ if (checksegments) {
+ tspivot(botright, botrshelle);
+ if (botrshelle.sh != dummysh) {
+ tsdissolve(botright);
+ tsbond(newbotright, botrshelle);
+ }
+ if (mirrorflag) {
+ tspivot(topright, toprshelle);
+ if (toprshelle.sh != dummysh) {
+ tsdissolve(topright);
+ tsbond(newtopright, toprshelle);
+ }
+ }
+ }
+
+ /* Bond the new triangle(s) to the surrounding triangles. */
+ bond(newbotright, botrcasing);
+ lprevself(newbotright);
+ bond(newbotright, botright);
+ lprevself(newbotright);
+ if (mirrorflag) {
+ bond(newtopright, toprcasing);
+ lnextself(newtopright);
+ bond(newtopright, topright);
+ lnextself(newtopright);
+ bond(newtopright, newbotright);
+ }
+
+ if (splitedge != (struct edge *) NULL) {
+ /* Split the shell edge into two. */
+ setsdest(*splitedge, insertpoint);
+ ssymself(*splitedge);
+ spivot(*splitedge, rightedge);
+ insertshelle(&newbotright, mark(*splitedge));
+ tspivot(newbotright, newedge);
+ sbond(*splitedge, newedge);
+ ssymself(newedge);
+ sbond(newedge, rightedge);
+ ssymself(*splitedge);
+ }
+
+#ifdef SELF_CHECK
+ if (counterclockwise(rightpoint, leftpoint, botpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle prior to edge point insertion (bottom).\n");
+ }
+ if (mirrorflag) {
+ if (counterclockwise(leftpoint, rightpoint, toppoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle prior to edge point insertion (top).\n");
+ }
+ if (counterclockwise(rightpoint, toppoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge point insertion (top right).\n"
+ );
+ }
+ if (counterclockwise(toppoint, leftpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge point insertion (top left).\n"
+ );
+ }
+ }
+ if (counterclockwise(leftpoint, botpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge point insertion (bottom left).\n"
+ );
+ }
+ if (counterclockwise(botpoint, rightpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge point insertion (bottom right).\n");
+ }
+#endif /* SELF_CHECK */
+ if (verbose > 2) {
+ printf(" Updating bottom left ");
+ printtriangle(&botright);
+ if (mirrorflag) {
+ printf(" Updating top left ");
+ printtriangle(&topright);
+ printf(" Creating top right ");
+ printtriangle(&newtopright);
+ }
+ printf(" Creating bottom right ");
+ printtriangle(&newbotright);
+ }
+
+ /* Position `horiz' on the first edge to check for */
+ /* the Delaunay property. */
+ lnextself(horiz);
+ } else {
+ /* Insert the point in a triangle, splitting it into three. */
+ lnext(horiz, botleft);
+ lprev(horiz, botright);
+ sym(botleft, botlcasing);
+ sym(botright, botrcasing);
+ maketriangle(&newbotleft);
+ maketriangle(&newbotright);
+
+ /* Set the vertices of changed and new triangles. */
+ org(horiz, rightpoint);
+ dest(horiz, leftpoint);
+ apex(horiz, botpoint);
+ setorg(newbotleft, leftpoint);
+ setdest(newbotleft, botpoint);
+ setapex(newbotleft, insertpoint);
+ setorg(newbotright, botpoint);
+ setdest(newbotright, rightpoint);
+ setapex(newbotright, insertpoint);
+ setapex(horiz, insertpoint);
+ for (i = 0; i < eextras; i++) {
+ /* Set the element attributes of the new triangles. */
+ attrib = elemattribute(horiz, i);
+ setelemattribute(newbotleft, i, attrib);
+ setelemattribute(newbotright, i, attrib);
+ }
+ if (vararea) {
+ /* Set the area constraint of the new triangles. */
+ area = areabound(horiz);
+ setareabound(newbotleft, area);
+ setareabound(newbotright, area);
+ }
+
+ /* There may be shell edges that need to be bonded */
+ /* to the new triangles. */
+ if (checksegments) {
+ tspivot(botleft, botlshelle);
+ if (botlshelle.sh != dummysh) {
+ tsdissolve(botleft);
+ tsbond(newbotleft, botlshelle);
+ }
+ tspivot(botright, botrshelle);
+ if (botrshelle.sh != dummysh) {
+ tsdissolve(botright);
+ tsbond(newbotright, botrshelle);
+ }
+ }
+
+ /* Bond the new triangles to the surrounding triangles. */
+ bond(newbotleft, botlcasing);
+ bond(newbotright, botrcasing);
+ lnextself(newbotleft);
+ lprevself(newbotright);
+ bond(newbotleft, newbotright);
+ lnextself(newbotleft);
+ bond(botleft, newbotleft);
+ lprevself(newbotright);
+ bond(botright, newbotright);
+
+#ifdef SELF_CHECK
+ if (counterclockwise(rightpoint, leftpoint, botpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle prior to point insertion.\n");
+ }
+ if (counterclockwise(rightpoint, leftpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after point insertion (top).\n");
+ }
+ if (counterclockwise(leftpoint, botpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after point insertion (left).\n");
+ }
+ if (counterclockwise(botpoint, rightpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after point insertion (right).\n");
+ }
+#endif /* SELF_CHECK */
+ if (verbose > 2) {
+ printf(" Updating top ");
+ printtriangle(&horiz);
+ printf(" Creating left ");
+ printtriangle(&newbotleft);
+ printf(" Creating right ");
+ printtriangle(&newbotright);
+ }
+ }
+
+ /* The insertion is successful by default, unless an encroached */
+ /* edge is found. */
+ success = SUCCESSFULPOINT;
+ /* Circle around the newly inserted vertex, checking each edge opposite */
+ /* it for the Delaunay property. Non-Delaunay edges are flipped. */
+ /* `horiz' is always the edge being checked. `first' marks where to */
+ /* stop circling. */
+ org(horiz, first);
+ rightpoint = first;
+ dest(horiz, leftpoint);
+ /* Circle until finished. */
+ while (1) {
+ /* By default, the edge will be flipped. */
+ doflip = 1;
+ if (checksegments) {
+ /* Check for a segment, which cannot be flipped. */
+ tspivot(horiz, checkshelle);
+ if (checkshelle.sh != dummysh) {
+ /* The edge is a segment and cannot be flipped. */
+ doflip = 0;
+#ifndef CDT_ONLY
+ if (segmentflaws) {
+ /* Does the new point encroach upon this segment? */
+ if (checkedge4encroach(&checkshelle)) {
+ success = ENCROACHINGPOINT;
+ }
+ }
+#endif /* not CDT_ONLY */
+ }
+ }
+ if (doflip) {
+ /* Check if the edge is a boundary edge. */
+ sym(horiz, top);
+ if (top.tri == dummytri) {
+ /* The edge is a boundary edge and cannot be flipped. */
+ doflip = 0;
+ } else {
+ /* Find the point on the other side of the edge. */
+ apex(top, farpoint);
+ /* In the incremental Delaunay triangulation algorithm, any of */
+ /* `leftpoint', `rightpoint', and `farpoint' could be vertices */
+ /* of the triangular bounding box. These vertices must be */
+ /* treated as if they are infinitely distant, even though their */
+ /* "coordinates" are not. */
+ if ((leftpoint == infpoint1) ||
+ (leftpoint == infpoint2) ||
+ (leftpoint == infpoint3)) {
+ /* `leftpoint' is infinitely distant. Check the convexity of */
+ /* the boundary of the triangulation. 'farpoint' might be */
+ /* infinite as well, but trust me, this same condition */
+ /* should be applied. */
+ doflip = counterclockwise(insertpoint, rightpoint, farpoint) > 0.0;
+ } else if ((rightpoint == infpoint1) ||
+ (rightpoint == infpoint2) ||
+ (rightpoint == infpoint3)) {
+ /* `rightpoint' is infinitely distant. Check the convexity of */
+ /* the boundary of the triangulation. 'farpoint' might be */
+ /* infinite as well, but trust me, this same condition */
+ /* should be applied. */
+ doflip = counterclockwise(farpoint, leftpoint, insertpoint) > 0.0;
+ } else if ((farpoint == infpoint1) ||
+ (farpoint == infpoint2) ||
+ (farpoint == infpoint3)) {
+ /* `farpoint' is infinitely distant and cannot be inside */
+ /* the circumcircle of the triangle `horiz'. */
+ doflip = 0;
+ } else {
+ /* Test whether the edge is locally Delaunay. */
+ doflip = incircle(leftpoint, insertpoint, rightpoint, farpoint)
+ > 0.0;
+ }
+ if (doflip) {
+ /* We made it! Flip the edge `horiz' by rotating its containing */
+ /* quadrilateral (the two triangles adjacent to `horiz'). */
+ /* Identify the casing of the quadrilateral. */
+ lprev(top, topleft);
+ sym(topleft, toplcasing);
+ lnext(top, topright);
+ sym(topright, toprcasing);
+ lnext(horiz, botleft);
+ sym(botleft, botlcasing);
+ lprev(horiz, botright);
+ sym(botright, botrcasing);
+ /* Rotate the quadrilateral one-quarter turn counterclockwise. */
+ bond(topleft, botlcasing);
+ bond(botleft, botrcasing);
+ bond(botright, toprcasing);
+ bond(topright, toplcasing);
+ if (checksegments) {
+ /* Check for shell edges and rebond them to the quadrilateral. */
+ tspivot(topleft, toplshelle);
+ tspivot(botleft, botlshelle);
+ tspivot(botright, botrshelle);
+ tspivot(topright, toprshelle);
+ if (toplshelle.sh == dummysh) {
+ tsdissolve(topright);
+ } else {
+ tsbond(topright, toplshelle);
+ }
+ if (botlshelle.sh == dummysh) {
+ tsdissolve(topleft);
+ } else {
+ tsbond(topleft, botlshelle);
+ }
+ if (botrshelle.sh == dummysh) {
+ tsdissolve(botleft);
+ } else {
+ tsbond(botleft, botrshelle);
+ }
+ if (toprshelle.sh == dummysh) {
+ tsdissolve(botright);
+ } else {
+ tsbond(botright, toprshelle);
+ }
+ }
+ /* New point assignments for the rotated quadrilateral. */
+ setorg(horiz, farpoint);
+ setdest(horiz, insertpoint);
+ setapex(horiz, rightpoint);
+ setorg(top, insertpoint);
+ setdest(top, farpoint);
+ setapex(top, leftpoint);
+ for (i = 0; i < eextras; i++) {
+ /* Take the average of the two triangles' attributes. */
+ attrib = 0.5 * (elemattribute(top, i) + elemattribute(horiz, i));
+ setelemattribute(top, i, attrib);
+ setelemattribute(horiz, i, attrib);
+ }
+ if (vararea) {
+ if ((areabound(top) <= 0.0) || (areabound(horiz) <= 0.0)) {
+ area = -1.0;
+ } else {
+ /* Take the average of the two triangles' area constraints. */
+ /* This prevents small area constraints from migrating a */
+ /* long, long way from their original location due to flips. */
+ area = 0.5 * (areabound(top) + areabound(horiz));
+ }
+ setareabound(top, area);
+ setareabound(horiz, area);
+ }
+#ifdef SELF_CHECK
+ if (insertpoint != (point) NULL) {
+ if (counterclockwise(leftpoint, insertpoint, rightpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle prior to edge flip (bottom).\n");
+ }
+ /* The following test has been removed because constrainededge() */
+ /* sometimes generates inverted triangles that insertsite() */
+ /* removes. */
+/*
+ if (counterclockwise(rightpoint, farpoint, leftpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle prior to edge flip (top).\n");
+ }
+*/
+ if (counterclockwise(farpoint, leftpoint, insertpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge flip (left).\n");
+ }
+ if (counterclockwise(insertpoint, rightpoint, farpoint) < 0.0) {
+ printf("Internal error in insertsite():\n");
+ printf(" Clockwise triangle after edge flip (right).\n");
+ }
+ }
+#endif /* SELF_CHECK */
+ if (verbose > 2) {
+ printf(" Edge flip results in left ");
+ lnextself(topleft);
+ printtriangle(&topleft);
+ printf(" and right ");
+ printtriangle(&horiz);
+ }
+ /* On the next iterations, consider the two edges that were */
+ /* exposed (this is, are now visible to the newly inserted */
+ /* point) by the edge flip. */
+ lprevself(horiz);
+ leftpoint = farpoint;
+ }
+ }
+ }
+ if (!doflip) {
+ /* The handle `horiz' is accepted as locally Delaunay. */
+#ifndef CDT_ONLY
+ if (triflaws) {
+ /* Check the triangle `horiz' for quality. */
+ testtriangle(&horiz);
+ }
+#endif /* not CDT_ONLY */
+ /* Look for the next edge around the newly inserted point. */
+ lnextself(horiz);
+ sym(horiz, testtri);
+ /* Check for finishing a complete revolution about the new point, or */
+ /* falling off the edge of the triangulation. The latter will */
+ /* happen when a point is inserted at a boundary. */
+ if ((leftpoint == first) || (testtri.tri == dummytri)) {
+ /* We're done. Return a triangle whose origin is the new point. */
+ lnext(horiz, *searchtri);
+ lnext(horiz, recenttri);
+ return success;
+ }
+ /* Finish finding the next edge around the newly inserted point. */
+ lnext(testtri, horiz);
+ rightpoint = leftpoint;
+ dest(horiz, leftpoint);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* triangulatepolygon() Find the Delaunay triangulation of a polygon that */
+/* has a certain "nice" shape. This includes the */
+/* polygons that result from deletion of a point or */
+/* insertion of a segment. */
+/* */
+/* This is a conceptually difficult routine. The starting assumption is */
+/* that we have a polygon with n sides. n - 1 of these sides are currently */
+/* represented as edges in the mesh. One side, called the "base", need not */
+/* be. */
+/* */
+/* Inside the polygon is a structure I call a "fan", consisting of n - 1 */
+/* triangles that share a common origin. For each of these triangles, the */
+/* edge opposite the origin is one of the sides of the polygon. The */
+/* primary edge of each triangle is the edge directed from the origin to */
+/* the destination; note that this is not the same edge that is a side of */
+/* the polygon. `firstedge' is the primary edge of the first triangle. */
+/* From there, the triangles follow in counterclockwise order about the */
+/* polygon, until `lastedge', the primary edge of the last triangle. */
+/* `firstedge' and `lastedge' are probably connected to other triangles */
+/* beyond the extremes of the fan, but their identity is not important, as */
+/* long as the fan remains connected to them. */
+/* */
+/* Imagine the polygon oriented so that its base is at the bottom. This */
+/* puts `firstedge' on the far right, and `lastedge' on the far left. */
+/* The right vertex of the base is the destination of `firstedge', and the */
+/* left vertex of the base is the apex of `lastedge'. */
+/* */
+/* The challenge now is to find the right sequence of edge flips to */
+/* transform the fan into a Delaunay triangulation of the polygon. Each */
+/* edge flip effectively removes one triangle from the fan, committing it */
+/* to the polygon. The resulting polygon has one fewer edge. If `doflip' */
+/* is set, the final flip will be performed, resulting in a fan of one */
+/* (useless?) triangle. If `doflip' is not set, the final flip is not */
+/* performed, resulting in a fan of two triangles, and an unfinished */
+/* triangular polygon that is not yet filled out with a single triangle. */
+/* On completion of the routine, `lastedge' is the last remaining triangle, */
+/* or the leftmost of the last two. */
+/* */
+/* Although the flips are performed in the order described above, the */
+/* decisions about what flips to perform are made in precisely the reverse */
+/* order. The recursive triangulatepolygon() procedure makes a decision, */
+/* uses up to two recursive calls to triangulate the "subproblems" */
+/* (polygons with fewer edges), and then performs an edge flip. */
+/* */
+/* The "decision" it makes is which vertex of the polygon should be */
+/* connected to the base. This decision is made by testing every possible */
+/* vertex. Once the best vertex is found, the two edges that connect this */
+/* vertex to the base become the bases for two smaller polygons. These */
+/* are triangulated recursively. Unfortunately, this approach can take */
+/* O(n^2) time not only in the worst case, but in many common cases. It's */
+/* rarely a big deal for point deletion, where n is rarely larger than ten, */
+/* but it could be a big deal for segment insertion, especially if there's */
+/* a lot of long segments that each cut many triangles. I ought to code */
+/* a faster algorithm some time. */
+/* */
+/* The `edgecount' parameter is the number of sides of the polygon, */
+/* including its base. `triflaws' is a flag that determines whether the */
+/* new triangles should be tested for quality, and enqueued if they are */
+/* bad. */
+/* */
+/*****************************************************************************/
+
+void triangulatepolygon(firstedge, lastedge, edgecount, doflip, triflaws)
+struct triedge *firstedge;
+struct triedge *lastedge;
+int edgecount;
+int doflip;
+int triflaws;
+{
+ struct triedge testtri;
+ struct triedge besttri;
+ struct triedge tempedge;
+ point leftbasepoint, rightbasepoint;
+ point testpoint;
+ point bestpoint;
+ int bestnumber;
+ int i;
+ triangle ptr; /* Temporary variable used by sym(), onext(), and oprev(). */
+
+ /* Identify the base vertices. */
+ apex(*lastedge, leftbasepoint);
+ dest(*firstedge, rightbasepoint);
+ if (verbose > 2) {
+ printf(" Triangulating interior polygon at edge\n");
+ printf(" (%.12g, %.12g) (%.12g, %.12g)\n", leftbasepoint[0],
+ leftbasepoint[1], rightbasepoint[0], rightbasepoint[1]);
+ }
+ /* Find the best vertex to connect the base to. */
+ onext(*firstedge, besttri);
+ dest(besttri, bestpoint);
+ triedgecopy(besttri, testtri);
+ bestnumber = 1;
+ for (i = 2; i <= edgecount - 2; i++) {
+ onextself(testtri);
+ dest(testtri, testpoint);
+ /* Is this a better vertex? */
+ if (incircle(leftbasepoint, rightbasepoint, bestpoint, testpoint) > 0.0) {
+ triedgecopy(testtri, besttri);
+ bestpoint = testpoint;
+ bestnumber = i;
+ }
+ }
+ if (verbose > 2) {
+ printf(" Connecting edge to (%.12g, %.12g)\n", bestpoint[0],
+ bestpoint[1]);
+ }
+ if (bestnumber > 1) {
+ /* Recursively triangulate the smaller polygon on the right. */
+ oprev(besttri, tempedge);
+ triangulatepolygon(firstedge, &tempedge, bestnumber + 1, 1, triflaws);
+ }
+ if (bestnumber < edgecount - 2) {
+ /* Recursively triangulate the smaller polygon on the left. */
+ sym(besttri, tempedge);
+ triangulatepolygon(&besttri, lastedge, edgecount - bestnumber, 1, triflaws);
+ /* Find `besttri' again; it may have been lost to edge flips. */
+ sym(tempedge, besttri);
+ }
+ if (doflip) {
+ /* Do one final edge flip. */
+ flip(&besttri);
+#ifndef CDT_ONLY
+ if (triflaws) {
+ /* Check the quality of the newly committed triangle. */
+ sym(besttri, testtri);
+ testtriangle(&testtri);
+ }
+#endif /* not CDT_ONLY */
+ }
+ /* Return the base triangle. */
+ triedgecopy(besttri, *lastedge);
+}
+
+/*****************************************************************************/
+/* */
+/* deletesite() Delete a vertex from a Delaunay triangulation, ensuring */
+/* that the triangulation remains Delaunay. */
+/* */
+/* The origin of `deltri' is deleted. The union of the triangles adjacent */
+/* to this point is a polygon, for which the Delaunay triangulation is */
+/* found. Two triangles are removed from the mesh. */
+/* */
+/* Only interior points that do not lie on segments (shell edges) or */
+/* boundaries may be deleted. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void deletesite(deltri)
+struct triedge *deltri;
+{
+ struct triedge countingtri;
+ struct triedge firstedge, lastedge;
+ struct triedge deltriright;
+ struct triedge lefttri, righttri;
+ struct triedge leftcasing, rightcasing;
+ struct edge leftshelle, rightshelle;
+ point delpoint;
+ point neworg;
+ int edgecount;
+ triangle ptr; /* Temporary variable used by sym(), onext(), and oprev(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ org(*deltri, delpoint);
+ if (verbose > 1) {
+ printf(" Deleting (%.12g, %.12g).\n", delpoint[0], delpoint[1]);
+ }
+ pointdealloc(delpoint);
+
+ /* Count the degree of the point being deleted. */
+ onext(*deltri, countingtri);
+ edgecount = 1;
+ while (!triedgeequal(*deltri, countingtri)) {
+#ifdef SELF_CHECK
+ if (countingtri.tri == dummytri) {
+ printf("Internal error in deletesite():\n");
+ printf(" Attempt to delete boundary point.\n");
+ internalerror();
+ }
+#endif /* SELF_CHECK */
+ edgecount++;
+ onextself(countingtri);
+ }
+
+#ifdef SELF_CHECK
+ if (edgecount < 3) {
+ printf("Internal error in deletesite():\n Point has degree %d.\n",
+ edgecount);
+ internalerror();
+ }
+#endif /* SELF_CHECK */
+ if (edgecount > 3) {
+ /* Triangulate the polygon defined by the union of all triangles */
+ /* adjacent to the point being deleted. Check the quality of */
+ /* the resulting triangles. */
+ onext(*deltri, firstedge);
+ oprev(*deltri, lastedge);
+ triangulatepolygon(&firstedge, &lastedge, edgecount, 0, !nobisect);
+ }
+ /* Splice out two triangles. */
+ lprev(*deltri, deltriright);
+ dnext(*deltri, lefttri);
+ sym(lefttri, leftcasing);
+ oprev(deltriright, righttri);
+ sym(righttri, rightcasing);
+ bond(*deltri, leftcasing);
+ bond(deltriright, rightcasing);
+ tspivot(lefttri, leftshelle);
+ if (leftshelle.sh != dummysh) {
+ tsbond(*deltri, leftshelle);
+ }
+ tspivot(righttri, rightshelle);
+ if (rightshelle.sh != dummysh) {
+ tsbond(deltriright, rightshelle);
+ }
+
+ /* Set the new origin of `deltri' and check its quality. */
+ org(lefttri, neworg);
+ setorg(*deltri, neworg);
+ if (!nobisect) {
+ testtriangle(deltri);
+ }
+
+ /* Delete the two spliced-out triangles. */
+ triangledealloc(lefttri.tri);
+ triangledealloc(righttri.tri);
+}
+
+#endif /* not CDT_ONLY */
+
+/** **/
+/** **/
+/********* Mesh transformation routines end here *********/
+
+/********* Divide-and-conquer Delaunay triangulation begins here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* The divide-and-conquer bounding box */
+/* */
+/* I originally implemented the divide-and-conquer and incremental Delaunay */
+/* triangulations using the edge-based data structure presented by Guibas */
+/* and Stolfi. Switching to a triangle-based data structure doubled the */
+/* speed. However, I had to think of a few extra tricks to maintain the */
+/* elegance of the original algorithms. */
+/* */
+/* The "bounding box" used by my variant of the divide-and-conquer */
+/* algorithm uses one triangle for each edge of the convex hull of the */
+/* triangulation. These bounding triangles all share a common apical */
+/* vertex, which is represented by NULL and which represents nothing. */
+/* The bounding triangles are linked in a circular fan about this NULL */
+/* vertex, and the edges on the convex hull of the triangulation appear */
+/* opposite the NULL vertex. You might find it easiest to imagine that */
+/* the NULL vertex is a point in 3D space behind the center of the */
+/* triangulation, and that the bounding triangles form a sort of cone. */
+/* */
+/* This bounding box makes it easy to represent degenerate cases. For */
+/* instance, the triangulation of two vertices is a single edge. This edge */
+/* is represented by two bounding box triangles, one on each "side" of the */
+/* edge. These triangles are also linked together in a fan about the NULL */
+/* vertex. */
+/* */
+/* The bounding box also makes it easy to traverse the convex hull, as the */
+/* divide-and-conquer algorithm needs to do. */
+/* */
+/*****************************************************************************/
+
+/*****************************************************************************/
+/* */
+/* pointsort() Sort an array of points by x-coordinate, using the */
+/* y-coordinate as a secondary key. */
+/* */
+/* Uses quicksort. Randomized O(n log n) time. No, I did not make any of */
+/* the usual quicksort mistakes. */
+/* */
+/*****************************************************************************/
+
+void pointsort(sortarray, arraysize)
+point *sortarray;
+int arraysize;
+{
+ int left, right;
+ int pivot;
+ REAL pivotx, pivoty;
+ point temp;
+
+ if (arraysize == 2) {
+ /* Recursive base case. */
+ if ((sortarray[0][0] > sortarray[1][0]) ||
+ ((sortarray[0][0] == sortarray[1][0]) &&
+ (sortarray[0][1] > sortarray[1][1]))) {
+ temp = sortarray[1];
+ sortarray[1] = sortarray[0];
+ sortarray[0] = temp;
+ }
+ return;
+ }
+ /* Choose a random pivot to split the array. */
+ pivot = (int) randomnation(arraysize);
+ pivotx = sortarray[pivot][0];
+ pivoty = sortarray[pivot][1];
+ /* Split the array. */
+ left = -1;
+ right = arraysize;
+ while (left < right) {
+ /* Search for a point whose x-coordinate is too large for the left. */
+ do {
+ left++;
+ } while ((left <= right) && ((sortarray[left][0] < pivotx) ||
+ ((sortarray[left][0] == pivotx) &&
+ (sortarray[left][1] < pivoty))));
+ /* Search for a point whose x-coordinate is too small for the right. */
+ do {
+ right--;
+ } while ((left <= right) && ((sortarray[right][0] > pivotx) ||
+ ((sortarray[right][0] == pivotx) &&
+ (sortarray[right][1] > pivoty))));
+ if (left < right) {
+ /* Swap the left and right points. */
+ temp = sortarray[left];
+ sortarray[left] = sortarray[right];
+ sortarray[right] = temp;
+ }
+ }
+ if (left > 1) {
+ /* Recursively sort the left subset. */
+ pointsort(sortarray, left);
+ }
+ if (right < arraysize - 2) {
+ /* Recursively sort the right subset. */
+ pointsort(&sortarray[right + 1], arraysize - right - 1);
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* pointmedian() An order statistic algorithm, almost. Shuffles an array */
+/* of points so that the first `median' points occur */
+/* lexicographically before the remaining points. */
+/* */
+/* Uses the x-coordinate as the primary key if axis == 0; the y-coordinate */
+/* if axis == 1. Very similar to the pointsort() procedure, but runs in */
+/* randomized linear time. */
+/* */
+/*****************************************************************************/
+
+void pointmedian(sortarray, arraysize, median, axis)
+point *sortarray;
+int arraysize;
+int median;
+int axis;
+{
+ int left, right;
+ int pivot;
+ REAL pivot1, pivot2;
+ point temp;
+
+ if (arraysize == 2) {
+ /* Recursive base case. */
+ if ((sortarray[0][axis] > sortarray[1][axis]) ||
+ ((sortarray[0][axis] == sortarray[1][axis]) &&
+ (sortarray[0][1 - axis] > sortarray[1][1 - axis]))) {
+ temp = sortarray[1];
+ sortarray[1] = sortarray[0];
+ sortarray[0] = temp;
+ }
+ return;
+ }
+ /* Choose a random pivot to split the array. */
+ pivot = (int) randomnation(arraysize);
+ pivot1 = sortarray[pivot][axis];
+ pivot2 = sortarray[pivot][1 - axis];
+ /* Split the array. */
+ left = -1;
+ right = arraysize;
+ while (left < right) {
+ /* Search for a point whose x-coordinate is too large for the left. */
+ do {
+ left++;
+ } while ((left <= right) && ((sortarray[left][axis] < pivot1) ||
+ ((sortarray[left][axis] == pivot1) &&
+ (sortarray[left][1 - axis] < pivot2))));
+ /* Search for a point whose x-coordinate is too small for the right. */
+ do {
+ right--;
+ } while ((left <= right) && ((sortarray[right][axis] > pivot1) ||
+ ((sortarray[right][axis] == pivot1) &&
+ (sortarray[right][1 - axis] > pivot2))));
+ if (left < right) {
+ /* Swap the left and right points. */
+ temp = sortarray[left];
+ sortarray[left] = sortarray[right];
+ sortarray[right] = temp;
+ }
+ }
+ /* Unlike in pointsort(), at most one of the following */
+ /* conditionals is true. */
+ if (left > median) {
+ /* Recursively shuffle the left subset. */
+ pointmedian(sortarray, left, median, axis);
+ }
+ if (right < median - 1) {
+ /* Recursively shuffle the right subset. */
+ pointmedian(&sortarray[right + 1], arraysize - right - 1,
+ median - right - 1, axis);
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* alternateaxes() Sorts the points as appropriate for the divide-and- */
+/* conquer algorithm with alternating cuts. */
+/* */
+/* Partitions by x-coordinate if axis == 0; by y-coordinate if axis == 1. */
+/* For the base case, subsets containing only two or three points are */
+/* always sorted by x-coordinate. */
+/* */
+/*****************************************************************************/
+
+void alternateaxes(sortarray, arraysize, axis)
+point *sortarray;
+int arraysize;
+int axis;
+{
+ int divider;
+
+ divider = arraysize >> 1;
+ if (arraysize <= 3) {
+ /* Recursive base case: subsets of two or three points will be */
+ /* handled specially, and should always be sorted by x-coordinate. */
+ axis = 0;
+ }
+ /* Partition with a horizontal or vertical cut. */
+ pointmedian(sortarray, arraysize, divider, axis);
+ /* Recursively partition the subsets with a cross cut. */
+ if (arraysize - divider >= 2) {
+ if (divider >= 2) {
+ alternateaxes(sortarray, divider, 1 - axis);
+ }
+ alternateaxes(&sortarray[divider], arraysize - divider, 1 - axis);
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* mergehulls() Merge two adjacent Delaunay triangulations into a */
+/* single Delaunay triangulation. */
+/* */
+/* This is similar to the algorithm given by Guibas and Stolfi, but uses */
+/* a triangle-based, rather than edge-based, data structure. */
+/* */
+/* The algorithm walks up the gap between the two triangulations, knitting */
+/* them together. As they are merged, some of their bounding triangles */
+/* are converted into real triangles of the triangulation. The procedure */
+/* pulls each hull's bounding triangles apart, then knits them together */
+/* like the teeth of two gears. The Delaunay property determines, at each */
+/* step, whether the next "tooth" is a bounding triangle of the left hull */
+/* or the right. When a bounding triangle becomes real, its apex is */
+/* changed from NULL to a real point. */
+/* */
+/* Only two new triangles need to be allocated. These become new bounding */
+/* triangles at the top and bottom of the seam. They are used to connect */
+/* the remaining bounding triangles (those that have not been converted */
+/* into real triangles) into a single fan. */
+/* */
+/* On entry, `farleft' and `innerleft' are bounding triangles of the left */
+/* triangulation. The origin of `farleft' is the leftmost vertex, and */
+/* the destination of `innerleft' is the rightmost vertex of the */
+/* triangulation. Similarly, `innerright' and `farright' are bounding */
+/* triangles of the right triangulation. The origin of `innerright' and */
+/* destination of `farright' are the leftmost and rightmost vertices. */
+/* */
+/* On completion, the origin of `farleft' is the leftmost vertex of the */
+/* merged triangulation, and the destination of `farright' is the rightmost */
+/* vertex. */
+/* */
+/*****************************************************************************/
+
+void mergehulls(farleft, innerleft, innerright, farright, axis)
+struct triedge *farleft;
+struct triedge *innerleft;
+struct triedge *innerright;
+struct triedge *farright;
+int axis;
+{
+ struct triedge leftcand, rightcand;
+ struct triedge baseedge;
+ struct triedge nextedge;
+ struct triedge sidecasing, topcasing, outercasing;
+ struct triedge checkedge;
+ point innerleftdest;
+ point innerrightorg;
+ point innerleftapex, innerrightapex;
+ point farleftpt, farrightpt;
+ point farleftapex, farrightapex;
+ point lowerleft, lowerright;
+ point upperleft, upperright;
+ point nextapex;
+ point checkvertex;
+ int changemade;
+ int badedge;
+ int leftfinished, rightfinished;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ dest(*innerleft, innerleftdest);
+ apex(*innerleft, innerleftapex);
+ org(*innerright, innerrightorg);
+ apex(*innerright, innerrightapex);
+ /* Special treatment for horizontal cuts. */
+ if (dwyer && (axis == 1)) {
+ org(*farleft, farleftpt);
+ apex(*farleft, farleftapex);
+ dest(*farright, farrightpt);
+ apex(*farright, farrightapex);
+ /* The pointers to the extremal points are shifted to point to the */
+ /* topmost and bottommost point of each hull, rather than the */
+ /* leftmost and rightmost points. */
+ while (farleftapex[1] < farleftpt[1]) {
+ lnextself(*farleft);
+ symself(*farleft);
+ farleftpt = farleftapex;
+ apex(*farleft, farleftapex);
+ }
+ sym(*innerleft, checkedge);
+ apex(checkedge, checkvertex);
+ while (checkvertex[1] > innerleftdest[1]) {
+ lnext(checkedge, *innerleft);
+ innerleftapex = innerleftdest;
+ innerleftdest = checkvertex;
+ sym(*innerleft, checkedge);
+ apex(checkedge, checkvertex);
+ }
+ while (innerrightapex[1] < innerrightorg[1]) {
+ lnextself(*innerright);
+ symself(*innerright);
+ innerrightorg = innerrightapex;
+ apex(*innerright, innerrightapex);
+ }
+ sym(*farright, checkedge);
+ apex(checkedge, checkvertex);
+ while (checkvertex[1] > farrightpt[1]) {
+ lnext(checkedge, *farright);
+ /*farrightapex = farrightpt;*/
+ farrightpt = checkvertex;
+ sym(*farright, checkedge);
+ apex(checkedge, checkvertex);
+ }
+ }
+ /* Find a line tangent to and below both hulls. */
+ do {
+ changemade = 0;
+ /* Make innerleftdest the "bottommost" point of the left hull. */
+ if (counterclockwise(innerleftdest, innerleftapex, innerrightorg) > 0.0) {
+ lprevself(*innerleft);
+ symself(*innerleft);
+ innerleftdest = innerleftapex;
+ apex(*innerleft, innerleftapex);
+ changemade = 1;
+ }
+ /* Make innerrightorg the "bottommost" point of the right hull. */
+ if (counterclockwise(innerrightapex, innerrightorg, innerleftdest) > 0.0) {
+ lnextself(*innerright);
+ symself(*innerright);
+ innerrightorg = innerrightapex;
+ apex(*innerright, innerrightapex);
+ changemade = 1;
+ }
+ } while (changemade);
+ /* Find the two candidates to be the next "gear tooth". */
+ sym(*innerleft, leftcand);
+ sym(*innerright, rightcand);
+ /* Create the bottom new bounding triangle. */
+ maketriangle(&baseedge);
+ /* Connect it to the bounding boxes of the left and right triangulations. */
+ bond(baseedge, *innerleft);
+ lnextself(baseedge);
+ bond(baseedge, *innerright);
+ lnextself(baseedge);
+ setorg(baseedge, innerrightorg);
+ setdest(baseedge, innerleftdest);
+ /* Apex is intentionally left NULL. */
+ if (verbose > 2) {
+ printf(" Creating base bounding ");
+ printtriangle(&baseedge);
+ }
+ /* Fix the extreme triangles if necessary. */
+ org(*farleft, farleftpt);
+ if (innerleftdest == farleftpt) {
+ lnext(baseedge, *farleft);
+ }
+ dest(*farright, farrightpt);
+ if (innerrightorg == farrightpt) {
+ lprev(baseedge, *farright);
+ }
+ /* The vertices of the current knitting edge. */
+ lowerleft = innerleftdest;
+ lowerright = innerrightorg;
+ /* The candidate vertices for knitting. */
+ apex(leftcand, upperleft);
+ apex(rightcand, upperright);
+ /* Walk up the gap between the two triangulations, knitting them together. */
+ while (1) {
+ /* Have we reached the top? (This isn't quite the right question, */
+ /* because even though the left triangulation might seem finished now, */
+ /* moving up on the right triangulation might reveal a new point of */
+ /* the left triangulation. And vice-versa.) */
+ leftfinished = counterclockwise(upperleft, lowerleft, lowerright) <= 0.0;
+ rightfinished = counterclockwise(upperright, lowerleft, lowerright) <= 0.0;
+ if (leftfinished && rightfinished) {
+ /* Create the top new bounding triangle. */
+ maketriangle(&nextedge);
+ setorg(nextedge, lowerleft);
+ setdest(nextedge, lowerright);
+ /* Apex is intentionally left NULL. */
+ /* Connect it to the bounding boxes of the two triangulations. */
+ bond(nextedge, baseedge);
+ lnextself(nextedge);
+ bond(nextedge, rightcand);
+ lnextself(nextedge);
+ bond(nextedge, leftcand);
+ if (verbose > 2) {
+ printf(" Creating top bounding ");
+ printtriangle(&baseedge);
+ }
+ /* Special treatment for horizontal cuts. */
+ if (dwyer && (axis == 1)) {
+ org(*farleft, farleftpt);
+ apex(*farleft, farleftapex);
+ dest(*farright, farrightpt);
+ apex(*farright, farrightapex);
+ sym(*farleft, checkedge);
+ apex(checkedge, checkvertex);
+ /* The pointers to the extremal points are restored to the leftmost */
+ /* and rightmost points (rather than topmost and bottommost). */
+ while (checkvertex[0] < farleftpt[0]) {
+ lprev(checkedge, *farleft);
+ /*farleftapex = farleftpt;*/
+ farleftpt = checkvertex;
+ sym(*farleft, checkedge);
+ apex(checkedge, checkvertex);
+ }
+ while (farrightapex[0] > farrightpt[0]) {
+ lprevself(*farright);
+ symself(*farright);
+ farrightpt = farrightapex;
+ apex(*farright, farrightapex);
+ }
+ }
+ return;
+ }
+ /* Consider eliminating edges from the left triangulation. */
+ if (!leftfinished) {
+ /* What vertex would be exposed if an edge were deleted? */
+ lprev(leftcand, nextedge);
+ symself(nextedge);
+ apex(nextedge, nextapex);
+ /* If nextapex is NULL, then no vertex would be exposed; the */
+ /* triangulation would have been eaten right through. */
+ if (nextapex != (point) NULL) {
+ /* Check whether the edge is Delaunay. */
+ badedge = incircle(lowerleft, lowerright, upperleft, nextapex) > 0.0;
+ while (badedge) {
+ /* Eliminate the edge with an edge flip. As a result, the */
+ /* left triangulation will have one more boundary triangle. */
+ lnextself(nextedge);
+ sym(nextedge, topcasing);
+ lnextself(nextedge);
+ sym(nextedge, sidecasing);
+ bond(nextedge, topcasing);
+ bond(leftcand, sidecasing);
+ lnextself(leftcand);
+ sym(leftcand, outercasing);
+ lprevself(nextedge);
+ bond(nextedge, outercasing);
+ /* Correct the vertices to reflect the edge flip. */
+ setorg(leftcand, lowerleft);
+ setdest(leftcand, NULL);
+ setapex(leftcand, nextapex);
+ setorg(nextedge, NULL);
+ setdest(nextedge, upperleft);
+ setapex(nextedge, nextapex);
+ /* Consider the newly exposed vertex. */
+ upperleft = nextapex;
+ /* What vertex would be exposed if another edge were deleted? */
+ triedgecopy(sidecasing, nextedge);
+ apex(nextedge, nextapex);
+ if (nextapex != (point) NULL) {
+ /* Check whether the edge is Delaunay. */
+ badedge = incircle(lowerleft, lowerright, upperleft, nextapex)
+ > 0.0;
+ } else {
+ /* Avoid eating right through the triangulation. */
+ badedge = 0;
+ }
+ }
+ }
+ }
+ /* Consider eliminating edges from the right triangulation. */
+ if (!rightfinished) {
+ /* What vertex would be exposed if an edge were deleted? */
+ lnext(rightcand, nextedge);
+ symself(nextedge);
+ apex(nextedge, nextapex);
+ /* If nextapex is NULL, then no vertex would be exposed; the */
+ /* triangulation would have been eaten right through. */
+ if (nextapex != (point) NULL) {
+ /* Check whether the edge is Delaunay. */
+ badedge = incircle(lowerleft, lowerright, upperright, nextapex) > 0.0;
+ while (badedge) {
+ /* Eliminate the edge with an edge flip. As a result, the */
+ /* right triangulation will have one more boundary triangle. */
+ lprevself(nextedge);
+ sym(nextedge, topcasing);
+ lprevself(nextedge);
+ sym(nextedge, sidecasing);
+ bond(nextedge, topcasing);
+ bond(rightcand, sidecasing);
+ lprevself(rightcand);
+ sym(rightcand, outercasing);
+ lnextself(nextedge);
+ bond(nextedge, outercasing);
+ /* Correct the vertices to reflect the edge flip. */
+ setorg(rightcand, NULL);
+ setdest(rightcand, lowerright);
+ setapex(rightcand, nextapex);
+ setorg(nextedge, upperright);
+ setdest(nextedge, NULL);
+ setapex(nextedge, nextapex);
+ /* Consider the newly exposed vertex. */
+ upperright = nextapex;
+ /* What vertex would be exposed if another edge were deleted? */
+ triedgecopy(sidecasing, nextedge);
+ apex(nextedge, nextapex);
+ if (nextapex != (point) NULL) {
+ /* Check whether the edge is Delaunay. */
+ badedge = incircle(lowerleft, lowerright, upperright, nextapex)
+ > 0.0;
+ } else {
+ /* Avoid eating right through the triangulation. */
+ badedge = 0;
+ }
+ }
+ }
+ }
+ if (leftfinished || (!rightfinished &&
+ (incircle(upperleft, lowerleft, lowerright, upperright) > 0.0))) {
+ /* Knit the triangulations, adding an edge from `lowerleft' */
+ /* to `upperright'. */
+ bond(baseedge, rightcand);
+ lprev(rightcand, baseedge);
+ setdest(baseedge, lowerleft);
+ lowerright = upperright;
+ sym(baseedge, rightcand);
+ apex(rightcand, upperright);
+ } else {
+ /* Knit the triangulations, adding an edge from `upperleft' */
+ /* to `lowerright'. */
+ bond(baseedge, leftcand);
+ lnext(leftcand, baseedge);
+ setorg(baseedge, lowerright);
+ lowerleft = upperleft;
+ sym(baseedge, leftcand);
+ apex(leftcand, upperleft);
+ }
+ if (verbose > 2) {
+ printf(" Connecting ");
+ printtriangle(&baseedge);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* divconqrecurse() Recursively form a Delaunay triangulation by the */
+/* divide-and-conquer method. */
+/* */
+/* Recursively breaks down the problem into smaller pieces, which are */
+/* knitted together by mergehulls(). The base cases (problems of two or */
+/* three points) are handled specially here. */
+/* */
+/* On completion, `farleft' and `farright' are bounding triangles such that */
+/* the origin of `farleft' is the leftmost vertex (breaking ties by */
+/* choosing the highest leftmost vertex), and the destination of */
+/* `farright' is the rightmost vertex (breaking ties by choosing the */
+/* lowest rightmost vertex). */
+/* */
+/*****************************************************************************/
+
+void divconqrecurse(sortarray, vertices, axis, farleft, farright)
+point *sortarray;
+int vertices;
+int axis;
+struct triedge *farleft;
+struct triedge *farright;
+{
+ struct triedge midtri, tri1, tri2, tri3;
+ struct triedge innerleft, innerright;
+ REAL area;
+ int divider;
+
+ if (verbose > 2) {
+ printf(" Triangulating %d points.\n", vertices);
+ }
+ if (vertices == 2) {
+ /* The triangulation of two vertices is an edge. An edge is */
+ /* represented by two bounding triangles. */
+ maketriangle(farleft);
+ setorg(*farleft, sortarray[0]);
+ setdest(*farleft, sortarray[1]);
+ /* The apex is intentionally left NULL. */
+ maketriangle(farright);
+ setorg(*farright, sortarray[1]);
+ setdest(*farright, sortarray[0]);
+ /* The apex is intentionally left NULL. */
+ bond(*farleft, *farright);
+ lprevself(*farleft);
+ lnextself(*farright);
+ bond(*farleft, *farright);
+ lprevself(*farleft);
+ lnextself(*farright);
+ bond(*farleft, *farright);
+ if (verbose > 2) {
+ printf(" Creating ");
+ printtriangle(farleft);
+ printf(" Creating ");
+ printtriangle(farright);
+ }
+ /* Ensure that the origin of `farleft' is sortarray[0]. */
+ lprev(*farright, *farleft);
+ return;
+ } else if (vertices == 3) {
+ /* The triangulation of three vertices is either a triangle (with */
+ /* three bounding triangles) or two edges (with four bounding */
+ /* triangles). In either case, four triangles are created. */
+ maketriangle(&midtri);
+ maketriangle(&tri1);
+ maketriangle(&tri2);
+ maketriangle(&tri3);
+ area = counterclockwise(sortarray[0], sortarray[1], sortarray[2]);
+ if (area == 0.0) {
+ /* Three collinear points; the triangulation is two edges. */
+ setorg(midtri, sortarray[0]);
+ setdest(midtri, sortarray[1]);
+ setorg(tri1, sortarray[1]);
+ setdest(tri1, sortarray[0]);
+ setorg(tri2, sortarray[2]);
+ setdest(tri2, sortarray[1]);
+ setorg(tri3, sortarray[1]);
+ setdest(tri3, sortarray[2]);
+ /* All apices are intentionally left NULL. */
+ bond(midtri, tri1);
+ bond(tri2, tri3);
+ lnextself(midtri);
+ lprevself(tri1);
+ lnextself(tri2);
+ lprevself(tri3);
+ bond(midtri, tri3);
+ bond(tri1, tri2);
+ lnextself(midtri);
+ lprevself(tri1);
+ lnextself(tri2);
+ lprevself(tri3);
+ bond(midtri, tri1);
+ bond(tri2, tri3);
+ /* Ensure that the origin of `farleft' is sortarray[0]. */
+ triedgecopy(tri1, *farleft);
+ /* Ensure that the destination of `farright' is sortarray[2]. */
+ triedgecopy(tri2, *farright);
+ } else {
+ /* The three points are not collinear; the triangulation is one */
+ /* triangle, namely `midtri'. */
+ setorg(midtri, sortarray[0]);
+ setdest(tri1, sortarray[0]);
+ setorg(tri3, sortarray[0]);
+ /* Apices of tri1, tri2, and tri3 are left NULL. */
+ if (area > 0.0) {
+ /* The vertices are in counterclockwise order. */
+ setdest(midtri, sortarray[1]);
+ setorg(tri1, sortarray[1]);
+ setdest(tri2, sortarray[1]);
+ setapex(midtri, sortarray[2]);
+ setorg(tri2, sortarray[2]);
+ setdest(tri3, sortarray[2]);
+ } else {
+ /* The vertices are in clockwise order. */
+ setdest(midtri, sortarray[2]);
+ setorg(tri1, sortarray[2]);
+ setdest(tri2, sortarray[2]);
+ setapex(midtri, sortarray[1]);
+ setorg(tri2, sortarray[1]);
+ setdest(tri3, sortarray[1]);
+ }
+ /* The topology does not depend on how the vertices are ordered. */
+ bond(midtri, tri1);
+ lnextself(midtri);
+ bond(midtri, tri2);
+ lnextself(midtri);
+ bond(midtri, tri3);
+ lprevself(tri1);
+ lnextself(tri2);
+ bond(tri1, tri2);
+ lprevself(tri1);
+ lprevself(tri3);
+ bond(tri1, tri3);
+ lnextself(tri2);
+ lprevself(tri3);
+ bond(tri2, tri3);
+ /* Ensure that the origin of `farleft' is sortarray[0]. */
+ triedgecopy(tri1, *farleft);
+ /* Ensure that the destination of `farright' is sortarray[2]. */
+ if (area > 0.0) {
+ triedgecopy(tri2, *farright);
+ } else {
+ lnext(*farleft, *farright);
+ }
+ }
+ if (verbose > 2) {
+ printf(" Creating ");
+ printtriangle(&midtri);
+ printf(" Creating ");
+ printtriangle(&tri1);
+ printf(" Creating ");
+ printtriangle(&tri2);
+ printf(" Creating ");
+ printtriangle(&tri3);
+ }
+ return;
+ } else {
+ /* Split the vertices in half. */
+ divider = vertices >> 1;
+ /* Recursively triangulate each half. */
+ divconqrecurse(sortarray, divider, 1 - axis, farleft, &innerleft);
+ divconqrecurse(&sortarray[divider], vertices - divider, 1 - axis,
+ &innerright, farright);
+ if (verbose > 1) {
+ printf(" Joining triangulations with %d and %d vertices.\n", divider,
+ vertices - divider);
+ }
+ /* Merge the two triangulations into one. */
+ mergehulls(farleft, &innerleft, &innerright, farright, axis);
+ }
+}
+
+long removeghosts(startghost)
+struct triedge *startghost;
+{
+ struct triedge searchedge;
+ struct triedge dissolveedge;
+ struct triedge deadtri;
+ point markorg;
+ long hullsize;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (verbose) {
+ printf(" Removing ghost triangles.\n");
+ }
+ /* Find an edge on the convex hull to start point location from. */
+ lprev(*startghost, searchedge);
+ symself(searchedge);
+ dummytri[0] = encode(searchedge);
+ /* Remove the bounding box and count the convex hull edges. */
+ triedgecopy(*startghost, dissolveedge);
+ hullsize = 0;
+ do {
+ hullsize++;
+ lnext(dissolveedge, deadtri);
+ lprevself(dissolveedge);
+ symself(dissolveedge);
+ /* If no PSLG is involved, set the boundary markers of all the points */
+ /* on the convex hull. If a PSLG is used, this step is done later. */
+ if (!poly) {
+ /* Watch out for the case where all the input points are collinear. */
+ if (dissolveedge.tri != dummytri) {
+ org(dissolveedge, markorg);
+ if (pointmark(markorg) == 0) {
+ setpointmark(markorg, 1);
+ }
+ }
+ }
+ /* Remove a bounding triangle from a convex hull triangle. */
+ dissolve(dissolveedge);
+ /* Find the next bounding triangle. */
+ sym(deadtri, dissolveedge);
+ /* Delete the bounding triangle. */
+ triangledealloc(deadtri.tri);
+ } while (!triedgeequal(dissolveedge, *startghost));
+ return hullsize;
+}
+
+/*****************************************************************************/
+/* */
+/* divconqdelaunay() Form a Delaunay triangulation by the divide-and- */
+/* conquer method. */
+/* */
+/* Sorts the points, calls a recursive procedure to triangulate them, and */
+/* removes the bounding box, setting boundary markers as appropriate. */
+/* */
+/*****************************************************************************/
+
+long divconqdelaunay()
+{
+ point *sortarray;
+ struct triedge hullleft, hullright;
+ int divider;
+ int i, j;
+
+ /* Allocate an array of pointers to points for sorting. */
+ sortarray = (point *) malloc(inpoints * sizeof(point));
+ if (sortarray == (point *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ traversalinit(&points);
+ for (i = 0; i < inpoints; i++) {
+ sortarray[i] = pointtraverse();
+ }
+ if (verbose) {
+ printf(" Sorting points.\n");
+ }
+ /* Sort the points. */
+ pointsort(sortarray, inpoints);
+ /* Discard duplicate points, which can really mess up the algorithm. */
+ i = 0;
+ for (j = 1; j < inpoints; j++) {
+ if ((sortarray[i][0] == sortarray[j][0])
+ && (sortarray[i][1] == sortarray[j][1])) {
+ if (!quiet) {
+ printf("Warning: A duplicate point at (%.12g, %.12g) appeared and was ignored.\n",
+ sortarray[j][0], sortarray[j][1]);
+ }
+/* Commented out - would eliminate point from output .node file, but causes
+ a failure if some segment has this point as an endpoint.
+ setpointmark(sortarray[j], DEADPOINT);
+*/
+ } else {
+ i++;
+ sortarray[i] = sortarray[j];
+ }
+ }
+ i++;
+ if (dwyer) {
+ /* Re-sort the array of points to accommodate alternating cuts. */
+ divider = i >> 1;
+ if (i - divider >= 2) {
+ if (divider >= 2) {
+ alternateaxes(sortarray, divider, 1);
+ }
+ alternateaxes(&sortarray[divider], i - divider, 1);
+ }
+ }
+ if (verbose) {
+ printf(" Forming triangulation.\n");
+ }
+ /* Form the Delaunay triangulation. */
+ divconqrecurse(sortarray, i, 0, &hullleft, &hullright);
+ free(sortarray);
+
+ return removeghosts(&hullleft);
+}
+
+/** **/
+/** **/
+/********* Divide-and-conquer Delaunay triangulation ends here *********/
+
+/********* Incremental Delaunay triangulation begins here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* boundingbox() Form an "infinite" bounding triangle to insert points */
+/* into. */
+/* */
+/* The points at "infinity" are assigned finite coordinates, which are used */
+/* by the point location routines, but (mostly) ignored by the Delaunay */
+/* edge flip routines. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+
+void boundingbox()
+{
+ struct triedge inftri; /* Handle for the triangular bounding box. */
+ REAL width;
+
+ if (verbose) {
+ printf(" Creating triangular bounding box.\n");
+ }
+ /* Find the width (or height, whichever is larger) of the triangulation. */
+ width = xmax - xmin;
+ if (ymax - ymin > width) {
+ width = ymax - ymin;
+ }
+ if (width == 0.0) {
+ width = 1.0;
+ }
+ /* Create the vertices of the bounding box. */
+ infpoint1 = (point) malloc(points.itembytes);
+ infpoint2 = (point) malloc(points.itembytes);
+ infpoint3 = (point) malloc(points.itembytes);
+ if ((infpoint1 == (point) NULL) || (infpoint2 == (point) NULL)
+ || (infpoint3 == (point) NULL)) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ infpoint1[0] = xmin - 50.0 * width;
+ infpoint1[1] = ymin - 40.0 * width;
+ infpoint2[0] = xmax + 50.0 * width;
+ infpoint2[1] = ymin - 40.0 * width;
+ infpoint3[0] = 0.5 * (xmin + xmax);
+ infpoint3[1] = ymax + 60.0 * width;
+
+ /* Create the bounding box. */
+ maketriangle(&inftri);
+ setorg(inftri, infpoint1);
+ setdest(inftri, infpoint2);
+ setapex(inftri, infpoint3);
+ /* Link dummytri to the bounding box so we can always find an */
+ /* edge to begin searching (point location) from. */
+ dummytri[0] = (triangle) inftri.tri;
+ if (verbose > 2) {
+ printf(" Creating ");
+ printtriangle(&inftri);
+ }
+}
+
+#endif /* not REDUCED */
+
+/*****************************************************************************/
+/* */
+/* removebox() Remove the "infinite" bounding triangle, setting boundary */
+/* markers as appropriate. */
+/* */
+/* The triangular bounding box has three boundary triangles (one for each */
+/* side of the bounding box), and a bunch of triangles fanning out from */
+/* the three bounding box vertices (one triangle for each edge of the */
+/* convex hull of the inner mesh). This routine removes these triangles. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+
+long removebox()
+{
+ struct triedge deadtri;
+ struct triedge searchedge;
+ struct triedge checkedge;
+ struct triedge nextedge, finaledge, dissolveedge;
+ point markorg;
+ long hullsize;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (verbose) {
+ printf(" Removing triangular bounding box.\n");
+ }
+ /* Find a boundary triangle. */
+ nextedge.tri = dummytri;
+ nextedge.orient = 0;
+ symself(nextedge);
+ /* Mark a place to stop. */
+ lprev(nextedge, finaledge);
+ lnextself(nextedge);
+ symself(nextedge);
+ /* Find a triangle (on the boundary of the point set) that isn't */
+ /* a bounding box triangle. */
+ lprev(nextedge, searchedge);
+ symself(searchedge);
+ /* Check whether nextedge is another boundary triangle */
+ /* adjacent to the first one. */
+ lnext(nextedge, checkedge);
+ symself(checkedge);
+ if (checkedge.tri == dummytri) {
+ /* Go on to the next triangle. There are only three boundary */
+ /* triangles, and this next triangle cannot be the third one, */
+ /* so it's safe to stop here. */
+ lprevself(searchedge);
+ symself(searchedge);
+ }
+ /* Find a new boundary edge to search from, as the current search */
+ /* edge lies on a bounding box triangle and will be deleted. */
+ dummytri[0] = encode(searchedge);
+ hullsize = -2l;
+ while (!triedgeequal(nextedge, finaledge)) {
+ hullsize++;
+ lprev(nextedge, dissolveedge);
+ symself(dissolveedge);
+ /* If not using a PSLG, the vertices should be marked now. */
+ /* (If using a PSLG, markhull() will do the job.) */
+ if (!poly) {
+ /* Be careful! One must check for the case where all the input */
+ /* points are collinear, and thus all the triangles are part of */
+ /* the bounding box. Otherwise, the setpointmark() call below */
+ /* will cause a bad pointer reference. */
+ if (dissolveedge.tri != dummytri) {
+ org(dissolveedge, markorg);
+ if (pointmark(markorg) == 0) {
+ setpointmark(markorg, 1);
+ }
+ }
+ }
+ /* Disconnect the bounding box triangle from the mesh triangle. */
+ dissolve(dissolveedge);
+ lnext(nextedge, deadtri);
+ sym(deadtri, nextedge);
+ /* Get rid of the bounding box triangle. */
+ triangledealloc(deadtri.tri);
+ /* Do we need to turn the corner? */
+ if (nextedge.tri == dummytri) {
+ /* Turn the corner. */
+ triedgecopy(dissolveedge, nextedge);
+ }
+ }
+ triangledealloc(finaledge.tri);
+
+ free(infpoint1); /* Deallocate the bounding box vertices. */
+ free(infpoint2);
+ free(infpoint3);
+
+ return hullsize;
+}
+
+#endif /* not REDUCED */
+
+/*****************************************************************************/
+/* */
+/* incrementaldelaunay() Form a Delaunay triangulation by incrementally */
+/* adding vertices. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+
+long incrementaldelaunay()
+{
+ struct triedge starttri;
+ point pointloop;
+
+ /* Create a triangular bounding box. */
+ boundingbox();
+ if (verbose) {
+ printf(" Incrementally inserting points.\n");
+ }
+ traversalinit(&points);
+ pointloop = pointtraverse();
+ while (pointloop != (point) NULL) {
+ /* Find a boundary triangle to search from. */
+ starttri.tri = (triangle *) NULL;
+ if (insertsite(pointloop, &starttri, (struct edge *) NULL, 0, 0) ==
+ DUPLICATEPOINT) {
+ if (!quiet) {
+ printf("Warning: A duplicate point at (%.12g, %.12g) appeared and was ignored.\n",
+ pointloop[0], pointloop[1]);
+ }
+/* Commented out - would eliminate point from output .node file.
+ setpointmark(pointloop, DEADPOINT);
+*/
+ }
+ pointloop = pointtraverse();
+ }
+ /* Remove the bounding box. */
+ return removebox();
+}
+
+#endif /* not REDUCED */
+
+/** **/
+/** **/
+/********* Incremental Delaunay triangulation ends here *********/
+
+/********* Sweepline Delaunay triangulation begins here *********/
+/** **/
+/** **/
+
+#ifndef REDUCED
+
+void eventheapinsert(heap, heapsize, newevent)
+struct event **heap;
+int heapsize;
+struct event *newevent;
+{
+ REAL eventx, eventy;
+ int eventnum;
+ int parent;
+ int notdone;
+
+ eventx = newevent->xkey;
+ eventy = newevent->ykey;
+ eventnum = heapsize;
+ notdone = eventnum > 0;
+ while (notdone) {
+ parent = (eventnum - 1) >> 1;
+ if ((heap[parent]->ykey < eventy) ||
+ ((heap[parent]->ykey == eventy)
+ && (heap[parent]->xkey <= eventx))) {
+ notdone = 0;
+ } else {
+ heap[eventnum] = heap[parent];
+ heap[eventnum]->heapposition = eventnum;
+
+ eventnum = parent;
+ notdone = eventnum > 0;
+ }
+ }
+ heap[eventnum] = newevent;
+ newevent->heapposition = eventnum;
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+void eventheapify(heap, heapsize, eventnum)
+struct event **heap;
+int heapsize;
+int eventnum;
+{
+ struct event *thisevent;
+ REAL eventx, eventy;
+ int leftchild, rightchild;
+ int smallest;
+ int notdone;
+
+ thisevent = heap[eventnum];
+ eventx = thisevent->xkey;
+ eventy = thisevent->ykey;
+ leftchild = 2 * eventnum + 1;
+ notdone = leftchild < heapsize;
+ while (notdone) {
+ if ((heap[leftchild]->ykey < eventy) ||
+ ((heap[leftchild]->ykey == eventy)
+ && (heap[leftchild]->xkey < eventx))) {
+ smallest = leftchild;
+ } else {
+ smallest = eventnum;
+ }
+ rightchild = leftchild + 1;
+ if (rightchild < heapsize) {
+ if ((heap[rightchild]->ykey < heap[smallest]->ykey) ||
+ ((heap[rightchild]->ykey == heap[smallest]->ykey)
+ && (heap[rightchild]->xkey < heap[smallest]->xkey))) {
+ smallest = rightchild;
+ }
+ }
+ if (smallest == eventnum) {
+ notdone = 0;
+ } else {
+ heap[eventnum] = heap[smallest];
+ heap[eventnum]->heapposition = eventnum;
+ heap[smallest] = thisevent;
+ thisevent->heapposition = smallest;
+
+ eventnum = smallest;
+ leftchild = 2 * eventnum + 1;
+ notdone = leftchild < heapsize;
+ }
+ }
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+void eventheapdelete(heap, heapsize, eventnum)
+struct event **heap;
+int heapsize;
+int eventnum;
+{
+ struct event *moveevent;
+ REAL eventx, eventy;
+ int parent;
+ int notdone;
+
+ moveevent = heap[heapsize - 1];
+ if (eventnum > 0) {
+ eventx = moveevent->xkey;
+ eventy = moveevent->ykey;
+ do {
+ parent = (eventnum - 1) >> 1;
+ if ((heap[parent]->ykey < eventy) ||
+ ((heap[parent]->ykey == eventy)
+ && (heap[parent]->xkey <= eventx))) {
+ notdone = 0;
+ } else {
+ heap[eventnum] = heap[parent];
+ heap[eventnum]->heapposition = eventnum;
+
+ eventnum = parent;
+ notdone = eventnum > 0;
+ }
+ } while (notdone);
+ }
+ heap[eventnum] = moveevent;
+ moveevent->heapposition = eventnum;
+ eventheapify(heap, heapsize - 1, eventnum);
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+void createeventheap(eventheap, events, freeevents)
+struct event ***eventheap;
+struct event **events;
+struct event **freeevents;
+{
+ point thispoint;
+ int maxevents;
+ int i;
+
+ maxevents = (3 * inpoints) / 2;
+ *eventheap = (struct event **) malloc(maxevents * sizeof(struct event *));
+ if (*eventheap == (struct event **) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ *events = (struct event *) malloc(maxevents * sizeof(struct event));
+ if (*events == (struct event *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ traversalinit(&points);
+ for (i = 0; i < inpoints; i++) {
+ thispoint = pointtraverse();
+ (*events)[i].eventptr = (VOID *) thispoint;
+ (*events)[i].xkey = thispoint[0];
+ (*events)[i].ykey = thispoint[1];
+ eventheapinsert(*eventheap, i, *events + i);
+ }
+ *freeevents = (struct event *) NULL;
+ for (i = maxevents - 1; i >= inpoints; i--) {
+ (*events)[i].eventptr = (VOID *) *freeevents;
+ *freeevents = *events + i;
+ }
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+int rightofhyperbola(fronttri, newsite)
+struct triedge *fronttri;
+point newsite;
+{
+ point leftpoint, rightpoint;
+ REAL dxa, dya, dxb, dyb;
+
+ hyperbolacount++;
+
+ dest(*fronttri, leftpoint);
+ apex(*fronttri, rightpoint);
+ if ((leftpoint[1] < rightpoint[1])
+ || ((leftpoint[1] == rightpoint[1]) && (leftpoint[0] < rightpoint[0]))) {
+ if (newsite[0] >= rightpoint[0]) {
+ return 1;
+ }
+ } else {
+ if (newsite[0] <= leftpoint[0]) {
+ return 0;
+ }
+ }
+ dxa = leftpoint[0] - newsite[0];
+ dya = leftpoint[1] - newsite[1];
+ dxb = rightpoint[0] - newsite[0];
+ dyb = rightpoint[1] - newsite[1];
+ return dya * (dxb * dxb + dyb * dyb) > dyb * (dxa * dxa + dya * dya);
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+REAL circletop(pa, pb, pc, ccwabc)
+point pa;
+point pb;
+point pc;
+REAL ccwabc;
+{
+ REAL xac, yac, xbc, ybc, xab, yab;
+ REAL aclen2, bclen2, ablen2;
+
+ circletopcount++;
+
+ xac = pa[0] - pc[0];
+ yac = pa[1] - pc[1];
+ xbc = pb[0] - pc[0];
+ ybc = pb[1] - pc[1];
+ xab = pa[0] - pb[0];
+ yab = pa[1] - pb[1];
+ aclen2 = xac * xac + yac * yac;
+ bclen2 = xbc * xbc + ybc * ybc;
+ ablen2 = xab * xab + yab * yab;
+ return pc[1] + (xac * bclen2 - xbc * aclen2 + sqrt(aclen2 * bclen2 * ablen2))
+ / (2.0 * ccwabc);
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+void check4deadevent(checktri, freeevents, eventheap, heapsize)
+struct triedge *checktri;
+struct event **freeevents;
+struct event **eventheap;
+int *heapsize;
+{
+ struct event *deadevent;
+ point eventpoint;
+ int eventnum;
+
+ org(*checktri, eventpoint);
+ if (eventpoint != (point) NULL) {
+ deadevent = (struct event *) eventpoint;
+ eventnum = deadevent->heapposition;
+ deadevent->eventptr = (VOID *) *freeevents;
+ *freeevents = deadevent;
+ eventheapdelete(eventheap, *heapsize, eventnum);
+ (*heapsize)--;
+ setorg(*checktri, NULL);
+ }
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+struct splaynode *splay(splaytree, searchpoint, searchtri)
+struct splaynode *splaytree;
+point searchpoint;
+struct triedge *searchtri;
+{
+ struct splaynode *child, *grandchild;
+ struct splaynode *lefttree, *righttree;
+ struct splaynode *leftright;
+ point checkpoint;
+ int rightofroot, rightofchild;
+
+ if (splaytree == (struct splaynode *) NULL) {
+ return (struct splaynode *) NULL;
+ }
+ dest(splaytree->keyedge, checkpoint);
+ if (checkpoint == splaytree->keydest) {
+ rightofroot = rightofhyperbola(&splaytree->keyedge, searchpoint);
+ if (rightofroot) {
+ triedgecopy(splaytree->keyedge, *searchtri);
+ child = splaytree->rchild;
+ } else {
+ child = splaytree->lchild;
+ }
+ if (child == (struct splaynode *) NULL) {
+ return splaytree;
+ }
+ dest(child->keyedge, checkpoint);
+ if (checkpoint != child->keydest) {
+ child = splay(child, searchpoint, searchtri);
+ if (child == (struct splaynode *) NULL) {
+ if (rightofroot) {
+ splaytree->rchild = (struct splaynode *) NULL;
+ } else {
+ splaytree->lchild = (struct splaynode *) NULL;
+ }
+ return splaytree;
+ }
+ }
+ rightofchild = rightofhyperbola(&child->keyedge, searchpoint);
+ if (rightofchild) {
+ triedgecopy(child->keyedge, *searchtri);
+ grandchild = splay(child->rchild, searchpoint, searchtri);
+ child->rchild = grandchild;
+ } else {
+ grandchild = splay(child->lchild, searchpoint, searchtri);
+ child->lchild = grandchild;
+ }
+ if (grandchild == (struct splaynode *) NULL) {
+ if (rightofroot) {
+ splaytree->rchild = child->lchild;
+ child->lchild = splaytree;
+ } else {
+ splaytree->lchild = child->rchild;
+ child->rchild = splaytree;
+ }
+ return child;
+ }
+ if (rightofchild) {
+ if (rightofroot) {
+ splaytree->rchild = child->lchild;
+ child->lchild = splaytree;
+ } else {
+ splaytree->lchild = grandchild->rchild;
+ grandchild->rchild = splaytree;
+ }
+ child->rchild = grandchild->lchild;
+ grandchild->lchild = child;
+ } else {
+ if (rightofroot) {
+ splaytree->rchild = grandchild->lchild;
+ grandchild->lchild = splaytree;
+ } else {
+ splaytree->lchild = child->rchild;
+ child->rchild = splaytree;
+ }
+ child->lchild = grandchild->rchild;
+ grandchild->rchild = child;
+ }
+ return grandchild;
+ } else {
+ lefttree = splay(splaytree->lchild, searchpoint, searchtri);
+ righttree = splay(splaytree->rchild, searchpoint, searchtri);
+
+ pooldealloc(&splaynodes, (VOID *) splaytree);
+ if (lefttree == (struct splaynode *) NULL) {
+ return righttree;
+ } else if (righttree == (struct splaynode *) NULL) {
+ return lefttree;
+ } else if (lefttree->rchild == (struct splaynode *) NULL) {
+ lefttree->rchild = righttree->lchild;
+ righttree->lchild = lefttree;
+ return righttree;
+ } else if (righttree->lchild == (struct splaynode *) NULL) {
+ righttree->lchild = lefttree->rchild;
+ lefttree->rchild = righttree;
+ return lefttree;
+ } else {
+/* printf("Holy Toledo!!!\n"); */
+ leftright = lefttree->rchild;
+ while (leftright->rchild != (struct splaynode *) NULL) {
+ leftright = leftright->rchild;
+ }
+ leftright->rchild = righttree;
+ return lefttree;
+ }
+ }
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+struct splaynode *splayinsert(splayroot, newkey, searchpoint)
+struct splaynode *splayroot;
+struct triedge *newkey;
+point searchpoint;
+{
+ struct splaynode *newsplaynode;
+
+ newsplaynode = (struct splaynode *) poolalloc(&splaynodes);
+ triedgecopy(*newkey, newsplaynode->keyedge);
+ dest(*newkey, newsplaynode->keydest);
+ if (splayroot == (struct splaynode *) NULL) {
+ newsplaynode->lchild = (struct splaynode *) NULL;
+ newsplaynode->rchild = (struct splaynode *) NULL;
+ } else if (rightofhyperbola(&splayroot->keyedge, searchpoint)) {
+ newsplaynode->lchild = splayroot;
+ newsplaynode->rchild = splayroot->rchild;
+ splayroot->rchild = (struct splaynode *) NULL;
+ } else {
+ newsplaynode->lchild = splayroot->lchild;
+ newsplaynode->rchild = splayroot;
+ splayroot->lchild = (struct splaynode *) NULL;
+ }
+ return newsplaynode;
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+struct splaynode *circletopinsert(splayroot, newkey, pa, pb, pc, topy)
+struct splaynode *splayroot;
+struct triedge *newkey;
+point pa;
+point pb;
+point pc;
+REAL topy;
+{
+ REAL ccwabc;
+ REAL xac, yac, xbc, ybc;
+ REAL aclen2, bclen2;
+ REAL searchpoint[2];
+ struct triedge dummytri;
+
+ ccwabc = counterclockwise(pa, pb, pc);
+ xac = pa[0] - pc[0];
+ yac = pa[1] - pc[1];
+ xbc = pb[0] - pc[0];
+ ybc = pb[1] - pc[1];
+ aclen2 = xac * xac + yac * yac;
+ bclen2 = xbc * xbc + ybc * ybc;
+ searchpoint[0] = pc[0] - (yac * bclen2 - ybc * aclen2) / (2.0 * ccwabc);
+ searchpoint[1] = topy;
+ return splayinsert(splay(splayroot, (point) searchpoint, &dummytri), newkey,
+ (point) searchpoint);
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+struct splaynode *frontlocate(splayroot, bottommost, searchpoint, searchtri, farright)
+struct splaynode *splayroot;
+struct triedge *bottommost;
+point searchpoint;
+struct triedge *searchtri;
+int *farright;
+{
+ int farrightflag;
+ triangle ptr; /* Temporary variable used by onext(). */
+
+ triedgecopy(*bottommost, *searchtri);
+ splayroot = splay(splayroot, searchpoint, searchtri);
+
+ farrightflag = 0;
+ while (!farrightflag && rightofhyperbola(searchtri, searchpoint)) {
+ onextself(*searchtri);
+ farrightflag = triedgeequal(*searchtri, *bottommost);
+ }
+ *farright = farrightflag;
+ return splayroot;
+}
+
+#endif /* not REDUCED */
+
+#ifndef REDUCED
+
+long sweeplinedelaunay()
+{
+ struct event **eventheap;
+ struct event *events;
+ struct event *freeevents;
+ struct event *nextevent;
+ struct event *newevent;
+ struct splaynode *splayroot;
+ struct triedge bottommost;
+ struct triedge searchtri;
+ struct triedge fliptri;
+ struct triedge lefttri, righttri, farlefttri, farrighttri;
+ struct triedge inserttri;
+ point firstpoint, secondpoint;
+ point nextpoint, lastpoint;
+ point connectpoint;
+ point leftpoint, midpoint, rightpoint;
+ REAL lefttest, righttest;
+ int heapsize;
+ int check4events, farrightflag;
+ triangle ptr; /* Temporary variable used by sym(), onext(), and oprev(). */
+
+ poolinit(&splaynodes, sizeof(struct splaynode), SPLAYNODEPERBLOCK, POINTER,
+ 0);
+ splayroot = (struct splaynode *) NULL;
+
+ if (verbose) {
+ printf(" Placing points in event heap.\n");
+ }
+ createeventheap(&eventheap, &events, &freeevents);
+ heapsize = inpoints;
+
+ if (verbose) {
+ printf(" Forming triangulation.\n");
+ }
+ maketriangle(&lefttri);
+ maketriangle(&righttri);
+ bond(lefttri, righttri);
+ lnextself(lefttri);
+ lprevself(righttri);
+ bond(lefttri, righttri);
+ lnextself(lefttri);
+ lprevself(righttri);
+ bond(lefttri, righttri);
+ firstpoint = (point) eventheap[0]->eventptr;
+ eventheap[0]->eventptr = (VOID *) freeevents;
+ freeevents = eventheap[0];
+ eventheapdelete(eventheap, heapsize, 0);
+ heapsize--;
+ do {
+ if (heapsize == 0) {
+ printf("Error: Input points are all identical.\n");
+ exit(1);
+ }
+ secondpoint = (point) eventheap[0]->eventptr;
+ eventheap[0]->eventptr = (VOID *) freeevents;
+ freeevents = eventheap[0];
+ eventheapdelete(eventheap, heapsize, 0);
+ heapsize--;
+ if ((firstpoint[0] == secondpoint[0])
+ && (firstpoint[1] == secondpoint[1])) {
+ printf("Warning: A duplicate point at (%.12g, %.12g) appeared and was ignored.\n",
+ secondpoint[0], secondpoint[1]);
+/* Commented out - would eliminate point from output .node file.
+ setpointmark(secondpoint, DEADPOINT);
+*/
+ }
+ } while ((firstpoint[0] == secondpoint[0])
+ && (firstpoint[1] == secondpoint[1]));
+ setorg(lefttri, firstpoint);
+ setdest(lefttri, secondpoint);
+ setorg(righttri, secondpoint);
+ setdest(righttri, firstpoint);
+ lprev(lefttri, bottommost);
+ lastpoint = secondpoint;
+ while (heapsize > 0) {
+ nextevent = eventheap[0];
+ eventheapdelete(eventheap, heapsize, 0);
+ heapsize--;
+ check4events = 1;
+ if (nextevent->xkey < xmin) {
+ decode(nextevent->eventptr, fliptri);
+ oprev(fliptri, farlefttri);
+ check4deadevent(&farlefttri, &freeevents, eventheap, &heapsize);
+ onext(fliptri, farrighttri);
+ check4deadevent(&farrighttri, &freeevents, eventheap, &heapsize);
+
+ if (triedgeequal(farlefttri, bottommost)) {
+ lprev(fliptri, bottommost);
+ }
+ flip(&fliptri);
+ setapex(fliptri, NULL);
+ lprev(fliptri, lefttri);
+ lnext(fliptri, righttri);
+ sym(lefttri, farlefttri);
+
+ if (randomnation(SAMPLERATE) == 0) {
+ symself(fliptri);
+ dest(fliptri, leftpoint);
+ apex(fliptri, midpoint);
+ org(fliptri, rightpoint);
+ splayroot = circletopinsert(splayroot, &lefttri, leftpoint, midpoint,
+ rightpoint, nextevent->ykey);
+ }
+ } else {
+ nextpoint = (point) nextevent->eventptr;
+ if ((nextpoint[0] == lastpoint[0]) && (nextpoint[1] == lastpoint[1])) {
+ printf("Warning: A duplicate point at (%.12g, %.12g) appeared and was ignored.\n",
+ nextpoint[0], nextpoint[1]);
+/* Commented out - would eliminate point from output .node file.
+ setpointmark(nextpoint, DEADPOINT);
+*/
+ check4events = 0;
+ } else {
+ lastpoint = nextpoint;
+
+ splayroot = frontlocate(splayroot, &bottommost, nextpoint, &searchtri,
+ &farrightflag);
+/*
+ triedgecopy(bottommost, searchtri);
+ farrightflag = 0;
+ while (!farrightflag && rightofhyperbola(&searchtri, nextpoint)) {
+ onextself(searchtri);
+ farrightflag = triedgeequal(searchtri, bottommost);
+ }
+*/
+
+ check4deadevent(&searchtri, &freeevents, eventheap, &heapsize);
+
+ triedgecopy(searchtri, farrighttri);
+ sym(searchtri, farlefttri);
+ maketriangle(&lefttri);
+ maketriangle(&righttri);
+ dest(farrighttri, connectpoint);
+ setorg(lefttri, connectpoint);
+ setdest(lefttri, nextpoint);
+ setorg(righttri, nextpoint);
+ setdest(righttri, connectpoint);
+ bond(lefttri, righttri);
+ lnextself(lefttri);
+ lprevself(righttri);
+ bond(lefttri, righttri);
+ lnextself(lefttri);
+ lprevself(righttri);
+ bond(lefttri, farlefttri);
+ bond(righttri, farrighttri);
+ if (!farrightflag && triedgeequal(farrighttri, bottommost)) {
+ triedgecopy(lefttri, bottommost);
+ }
+
+ if (randomnation(SAMPLERATE) == 0) {
+ splayroot = splayinsert(splayroot, &lefttri, nextpoint);
+ } else if (randomnation(SAMPLERATE) == 0) {
+ lnext(righttri, inserttri);
+ splayroot = splayinsert(splayroot, &inserttri, nextpoint);
+ }
+ }
+ }
+ nextevent->eventptr = (VOID *) freeevents;
+ freeevents = nextevent;
+
+ if (check4events) {
+ apex(farlefttri, leftpoint);
+ dest(lefttri, midpoint);
+ apex(lefttri, rightpoint);
+ lefttest = counterclockwise(leftpoint, midpoint, rightpoint);
+ if (lefttest > 0.0) {
+ newevent = freeevents;
+ freeevents = (struct event *) freeevents->eventptr;
+ newevent->xkey = xminextreme;
+ newevent->ykey = circletop(leftpoint, midpoint, rightpoint, lefttest);
+ newevent->eventptr = (VOID *) encode(lefttri);
+ eventheapinsert(eventheap, heapsize, newevent);
+ heapsize++;
+ setorg(lefttri, newevent);
+ }
+ apex(righttri, leftpoint);
+ org(righttri, midpoint);
+ apex(farrighttri, rightpoint);
+ righttest = counterclockwise(leftpoint, midpoint, rightpoint);
+ if (righttest > 0.0) {
+ newevent = freeevents;
+ freeevents = (struct event *) freeevents->eventptr;
+ newevent->xkey = xminextreme;
+ newevent->ykey = circletop(leftpoint, midpoint, rightpoint, righttest);
+ newevent->eventptr = (VOID *) encode(farrighttri);
+ eventheapinsert(eventheap, heapsize, newevent);
+ heapsize++;
+ setorg(farrighttri, newevent);
+ }
+ }
+ }
+
+ pooldeinit(&splaynodes);
+ lprevself(bottommost);
+ return removeghosts(&bottommost);
+}
+
+#endif /* not REDUCED */
+
+/** **/
+/** **/
+/********* Sweepline Delaunay triangulation ends here *********/
+
+/********* General mesh construction routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* delaunay() Form a Delaunay triangulation. */
+/* */
+/*****************************************************************************/
+
+long delaunay()
+{
+ eextras = 0;
+ initializetrisegpools();
+
+#ifdef REDUCED
+ if (!quiet) {
+ printf("Constructing Delaunay triangulation by divide-and-conquer method.\n");
+ }
+ return divconqdelaunay();
+#else /* not REDUCED */
+ if (!quiet) {
+ printf("Constructing Delaunay triangulation ");
+ if (incremental) {
+ printf("by incremental method.\n");
+ } else if (sweepline) {
+ printf("by sweepline method.\n");
+ } else {
+ printf("by divide-and-conquer method.\n");
+ }
+ }
+ if (incremental) {
+ return incrementaldelaunay();
+ } else if (sweepline) {
+ return sweeplinedelaunay();
+ } else {
+ return divconqdelaunay();
+ }
+#endif /* not REDUCED */
+}
+
+/*****************************************************************************/
+/* */
+/* reconstruct() Reconstruct a triangulation from its .ele (and possibly */
+/* .poly) file. Used when the -r switch is used. */
+/* */
+/* Reads an .ele file and reconstructs the original mesh. If the -p switch */
+/* is used, this procedure will also read a .poly file and reconstruct the */
+/* shell edges of the original mesh. If the -a switch is used, this */
+/* procedure will also read an .area file and set a maximum area constraint */
+/* on each triangle. */
+/* */
+/* Points that are not corners of triangles, such as nodes on edges of */
+/* subparametric elements, are discarded. */
+/* */
+/* This routine finds the adjacencies between triangles (and shell edges) */
+/* by forming one stack of triangles for each vertex. Each triangle is on */
+/* three different stacks simultaneously. Each triangle's shell edge */
+/* pointers are used to link the items in each stack. This memory-saving */
+/* feature makes the code harder to read. The most important thing to keep */
+/* in mind is that each triangle is removed from a stack precisely when */
+/* the corresponding pointer is adjusted to refer to a shell edge rather */
+/* than the next triangle of the stack. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+#ifdef TRILIBRARY
+
+int reconstruct(trianglelist, triangleattriblist, trianglearealist, elements,
+ corners, attribs, segmentlist, segmentmarkerlist,
+ numberofsegments)
+int *trianglelist;
+REAL *triangleattriblist;
+REAL *trianglearealist;
+int elements;
+int corners;
+int attribs;
+int *segmentlist;
+int *segmentmarkerlist;
+int numberofsegments;
+
+#else /* not TRILIBRARY */
+
+long reconstruct(elefilename, areafilename, polyfilename, polyfile)
+char *elefilename;
+char *areafilename;
+char *polyfilename;
+FILE *polyfile;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ int pointindex;
+ int attribindex;
+#else /* not TRILIBRARY */
+ FILE *elefile;
+ FILE *areafile;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int areaelements;
+#endif /* not TRILIBRARY */
+ struct triedge triangleloop;
+ struct triedge triangleleft;
+ struct triedge checktri;
+ struct triedge checkleft;
+ struct triedge checkneighbor;
+ struct edge shelleloop;
+ triangle *vertexarray;
+ triangle *prevlink;
+ triangle nexttri;
+ point tdest, tapex;
+ point checkdest, checkapex;
+ point shorg;
+ point killpoint;
+ REAL area;
+ int corner[3];
+ int end[2];
+ int killpointindex;
+ int incorners;
+ int segmentmarkers=0;
+ int boundmarker;
+ int aroundpoint;
+ long hullsize;
+ int notfound;
+ int elementnumber, segmentnumber;
+ int i, j;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+#ifdef TRILIBRARY
+ inelements = elements;
+ incorners = corners;
+ if (incorners < 3) {
+ printf("Error: Triangles must have at least 3 points.\n");
+ exit(1);
+ }
+ eextras = attribs;
+#else /* not TRILIBRARY */
+ /* Read the triangles from an .ele file. */
+ if (!quiet) {
+ printf("Opening %s.\n", elefilename);
+ }
+ elefile = fopen(elefilename, "r");
+ if (elefile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", elefilename);
+ exit(1);
+ }
+ /* Read number of triangles, number of points per triangle, and */
+ /* number of triangle attributes from .ele file. */
+ stringptr = readline(inputline, elefile, elefilename);
+ inelements = (int) strtol (stringptr, &stringptr, 0);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ incorners = 3;
+ } else {
+ incorners = (int) strtol (stringptr, &stringptr, 0);
+ if (incorners < 3) {
+ printf("Error: Triangles in %s must have at least 3 points.\n",
+ elefilename);
+ exit(1);
+ }
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ eextras = 0;
+ } else {
+ eextras = (int) strtol (stringptr, &stringptr, 0);
+ }
+#endif /* not TRILIBRARY */
+
+ initializetrisegpools();
+
+ /* Create the triangles. */
+ for (elementnumber = 1; elementnumber <= inelements; elementnumber++) {
+ maketriangle(&triangleloop);
+ /* Mark the triangle as living. */
+ triangleloop.tri[3] = (triangle) triangleloop.tri;
+ }
+
+ if (poly) {
+#ifdef TRILIBRARY
+ insegments = numberofsegments;
+ segmentmarkers = segmentmarkerlist != (int *) NULL;
+#else /* not TRILIBRARY */
+ /* Read number of segments and number of segment */
+ /* boundary markers from .poly file. */
+ stringptr = readline(inputline, polyfile, inpolyfilename);
+ insegments = (int) strtol (stringptr, &stringptr, 0);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ segmentmarkers = 0;
+ } else {
+ segmentmarkers = (int) strtol (stringptr, &stringptr, 0);
+ }
+#endif /* not TRILIBRARY */
+
+ /* Create the shell edges. */
+ for (segmentnumber = 1; segmentnumber <= insegments; segmentnumber++) {
+ makeshelle(&shelleloop);
+ /* Mark the shell edge as living. */
+ shelleloop.sh[2] = (shelle) shelleloop.sh;
+ }
+ }
+
+#ifdef TRILIBRARY
+ pointindex = 0;
+ attribindex = 0;
+#else /* not TRILIBRARY */
+ if (vararea) {
+ /* Open an .area file, check for consistency with the .ele file. */
+ if (!quiet) {
+ printf("Opening %s.\n", areafilename);
+ }
+ areafile = fopen(areafilename, "r");
+ if (areafile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", areafilename);
+ exit(1);
+ }
+ stringptr = readline(inputline, areafile, areafilename);
+ areaelements = (int) strtol (stringptr, &stringptr, 0);
+ if (areaelements != inelements) {
+ printf("Error: %s and %s disagree on number of triangles.\n",
+ elefilename, areafilename);
+ exit(1);
+ }
+ }
+#endif /* not TRILIBRARY */
+
+ if (!quiet) {
+ printf("Reconstructing mesh.\n");
+ }
+ /* Allocate a temporary array that maps each point to some adjacent */
+ /* triangle. I took care to allocate all the permanent memory for */
+ /* triangles and shell edges first. */
+ vertexarray = (triangle *) malloc(points.items * sizeof(triangle));
+ if (vertexarray == (triangle *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ /* Each point is initially unrepresented. */
+ for (i = 0; i < points.items; i++) {
+ vertexarray[i] = (triangle) dummytri;
+ }
+
+ if (verbose) {
+ printf(" Assembling triangles.\n");
+ }
+ /* Read the triangles from the .ele file, and link */
+ /* together those that share an edge. */
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ elementnumber = firstnumber;
+ while (triangleloop.tri != (triangle *) NULL) {
+#ifdef TRILIBRARY
+ /* Copy the triangle's three corners. */
+ for (j = 0; j < 3; j++) {
+ corner[j] = trianglelist[pointindex++];
+ if ((corner[j] < firstnumber) || (corner[j] >= firstnumber + inpoints)) {
+ printf("Error: Triangle %d has an invalid vertex index.\n",
+ elementnumber);
+ exit(1);
+ }
+ }
+#else /* not TRILIBRARY */
+ /* Read triangle number and the triangle's three corners. */
+ stringptr = readline(inputline, elefile, elefilename);
+ for (j = 0; j < 3; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Triangle %d is missing point %d in %s.\n",
+ elementnumber, j + 1, elefilename);
+ exit(1);
+ } else {
+ corner[j] = (int) strtol (stringptr, &stringptr, 0);
+ if ((corner[j] < firstnumber) ||
+ (corner[j] >= firstnumber + inpoints)) {
+ printf("Error: Triangle %d has an invalid vertex index.\n",
+ elementnumber);
+ exit(1);
+ }
+ }
+ }
+#endif /* not TRILIBRARY */
+
+ /* Find out about (and throw away) extra nodes. */
+ for (j = 3; j < incorners; j++) {
+#ifdef TRILIBRARY
+ killpointindex = trianglelist[pointindex++];
+#else /* not TRILIBRARY */
+ stringptr = findfield(stringptr);
+ if (*stringptr != '\0') {
+ killpointindex = (int) strtol (stringptr, &stringptr, 0);
+#endif /* not TRILIBRARY */
+ if ((killpointindex >= firstnumber) &&
+ (killpointindex < firstnumber + inpoints)) {
+ /* Delete the non-corner point if it's not already deleted. */
+ killpoint = getpoint(killpointindex);
+ if (pointmark(killpoint) != DEADPOINT) {
+ pointdealloc(killpoint);
+ }
+ }
+#ifndef TRILIBRARY
+ }
+#endif /* not TRILIBRARY */
+ }
+
+ /* Read the triangle's attributes. */
+ for (j = 0; j < eextras; j++) {
+#ifdef TRILIBRARY
+ setelemattribute(triangleloop, j, triangleattriblist[attribindex++]);
+#else /* not TRILIBRARY */
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ setelemattribute(triangleloop, j, 0);
+ } else {
+ setelemattribute(triangleloop, j,
+ (REAL) strtod (stringptr, &stringptr));
+ }
+#endif /* not TRILIBRARY */
+ }
+
+ if (vararea) {
+#ifdef TRILIBRARY
+ area = trianglearealist[elementnumber - firstnumber];
+#else /* not TRILIBRARY */
+ /* Read an area constraint from the .area file. */
+ stringptr = readline(inputline, areafile, areafilename);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ area = -1.0; /* No constraint on this triangle. */
+ } else {
+ area = (REAL) strtod(stringptr, &stringptr);
+ }
+#endif /* not TRILIBRARY */
+ setareabound(triangleloop, area);
+ }
+
+ /* Set the triangle's vertices. */
+ triangleloop.orient = 0;
+ setorg(triangleloop, getpoint(corner[0]));
+ setdest(triangleloop, getpoint(corner[1]));
+ setapex(triangleloop, getpoint(corner[2]));
+ /* Try linking the triangle to others that share these vertices. */
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ /* Take the number for the origin of triangleloop. */
+ aroundpoint = corner[triangleloop.orient];
+ /* Look for other triangles having this vertex. */
+ nexttri = vertexarray[aroundpoint - firstnumber];
+ /* Link the current triangle to the next one in the stack. */
+ triangleloop.tri[6 + triangleloop.orient] = nexttri;
+ /* Push the current triangle onto the stack. */
+ vertexarray[aroundpoint - firstnumber] = encode(triangleloop);
+ decode(nexttri, checktri);
+ if (checktri.tri != dummytri) {
+ dest(triangleloop, tdest);
+ apex(triangleloop, tapex);
+ /* Look for other triangles that share an edge. */
+ do {
+ dest(checktri, checkdest);
+ apex(checktri, checkapex);
+ if (tapex == checkdest) {
+ /* The two triangles share an edge; bond them together. */
+ lprev(triangleloop, triangleleft);
+ bond(triangleleft, checktri);
+ }
+ if (tdest == checkapex) {
+ /* The two triangles share an edge; bond them together. */
+ lprev(checktri, checkleft);
+ bond(triangleloop, checkleft);
+ }
+ /* Find the next triangle in the stack. */
+ nexttri = checktri.tri[6 + checktri.orient];
+ decode(nexttri, checktri);
+ } while (checktri.tri != dummytri);
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ elementnumber++;
+ }
+
+#ifdef TRILIBRARY
+ pointindex = 0;
+#else /* not TRILIBRARY */
+ fclose(elefile);
+ if (vararea) {
+ fclose(areafile);
+ }
+#endif /* not TRILIBRARY */
+
+ hullsize = 0; /* Prepare to count the boundary edges. */
+ if (poly) {
+ if (verbose) {
+ printf(" Marking segments in triangulation.\n");
+ }
+ /* Read the segments from the .poly file, and link them */
+ /* to their neighboring triangles. */
+ boundmarker = 0;
+ traversalinit(&shelles);
+ shelleloop.sh = shelletraverse();
+ segmentnumber = firstnumber;
+ while (shelleloop.sh != (shelle *) NULL) {
+#ifdef TRILIBRARY
+ end[0] = segmentlist[pointindex++];
+ end[1] = segmentlist[pointindex++];
+ if (segmentmarkers) {
+ boundmarker = segmentmarkerlist[segmentnumber - firstnumber];
+ }
+#else /* not TRILIBRARY */
+ /* Read the endpoints of each segment, and possibly a boundary marker. */
+ stringptr = readline(inputline, polyfile, inpolyfilename);
+ /* Skip the first (segment number) field. */
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d has no endpoints in %s.\n", segmentnumber,
+ polyfilename);
+ exit(1);
+ } else {
+ end[0] = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d is missing its second endpoint in %s.\n",
+ segmentnumber, polyfilename);
+ exit(1);
+ } else {
+ end[1] = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (segmentmarkers) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ boundmarker = 0;
+ } else {
+ boundmarker = (int) strtol (stringptr, &stringptr, 0);
+ }
+ }
+#endif /* not TRILIBRARY */
+ for (j = 0; j < 2; j++) {
+ if ((end[j] < firstnumber) || (end[j] >= firstnumber + inpoints)) {
+ printf("Error: Segment %d has an invalid vertex index.\n",
+ segmentnumber);
+ exit(1);
+ }
+ }
+
+ /* set the shell edge's vertices. */
+ shelleloop.shorient = 0;
+ setsorg(shelleloop, getpoint(end[0]));
+ setsdest(shelleloop, getpoint(end[1]));
+ setmark(shelleloop, boundmarker);
+ /* Try linking the shell edge to triangles that share these vertices. */
+ for (shelleloop.shorient = 0; shelleloop.shorient < 2;
+ shelleloop.shorient++) {
+ /* Take the number for the destination of shelleloop. */
+ aroundpoint = end[1 - shelleloop.shorient];
+ /* Look for triangles having this vertex. */
+ prevlink = &vertexarray[aroundpoint - firstnumber];
+ nexttri = vertexarray[aroundpoint - firstnumber];
+ decode(nexttri, checktri);
+ sorg(shelleloop, shorg);
+ notfound = 1;
+ /* Look for triangles having this edge. Note that I'm only */
+ /* comparing each triangle's destination with the shell edge; */
+ /* each triangle's apex is handled through a different vertex. */
+ /* Because each triangle appears on three vertices' lists, each */
+ /* occurrence of a triangle on a list can (and does) represent */
+ /* an edge. In this way, most edges are represented twice, and */
+ /* every triangle-segment bond is represented once. */
+ while (notfound && (checktri.tri != dummytri)) {
+ dest(checktri, checkdest);
+ if (shorg == checkdest) {
+ /* We have a match. Remove this triangle from the list. */
+ *prevlink = checktri.tri[6 + checktri.orient];
+ /* Bond the shell edge to the triangle. */
+ tsbond(checktri, shelleloop);
+ /* Check if this is a boundary edge. */
+ sym(checktri, checkneighbor);
+ if (checkneighbor.tri == dummytri) {
+ /* The next line doesn't insert a shell edge (because there's */
+ /* already one there), but it sets the boundary markers of */
+ /* the existing shell edge and its vertices. */
+ insertshelle(&checktri, 1);
+ hullsize++;
+ }
+ notfound = 0;
+ }
+ /* Find the next triangle in the stack. */
+ prevlink = &checktri.tri[6 + checktri.orient];
+ nexttri = checktri.tri[6 + checktri.orient];
+ decode(nexttri, checktri);
+ }
+ }
+ shelleloop.sh = shelletraverse();
+ segmentnumber++;
+ }
+ }
+
+ /* Mark the remaining edges as not being attached to any shell edge. */
+ /* Also, count the (yet uncounted) boundary edges. */
+ for (i = 0; i < points.items; i++) {
+ /* Search the stack of triangles adjacent to a point. */
+ nexttri = vertexarray[i];
+ decode(nexttri, checktri);
+ while (checktri.tri != dummytri) {
+ /* Find the next triangle in the stack before this */
+ /* information gets overwritten. */
+ nexttri = checktri.tri[6 + checktri.orient];
+ /* No adjacent shell edge. (This overwrites the stack info.) */
+ tsdissolve(checktri);
+ sym(checktri, checkneighbor);
+ if (checkneighbor.tri == dummytri) {
+ insertshelle(&checktri, 1);
+ hullsize++;
+ }
+ decode(nexttri, checktri);
+ }
+ }
+
+ free(vertexarray);
+ return hullsize;
+}
+
+#endif /* not CDT_ONLY */
+
+/** **/
+/** **/
+/********* General mesh construction routines end here *********/
+
+/********* Segment (shell edge) insertion begins here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* finddirection() Find the first triangle on the path from one point */
+/* to another. */
+/* */
+/* Finds the triangle that intersects a line segment drawn from the */
+/* origin of `searchtri' to the point `endpoint', and returns the result */
+/* in `searchtri'. The origin of `searchtri' does not change, even though */
+/* the triangle returned may differ from the one passed in. This routine */
+/* is used to find the direction to move in to get from one point to */
+/* another. */
+/* */
+/* The return value notes whether the destination or apex of the found */
+/* triangle is collinear with the two points in question. */
+/* */
+/*****************************************************************************/
+
+enum finddirectionresult finddirection(searchtri, endpoint)
+struct triedge *searchtri;
+point endpoint;
+{
+ struct triedge checktri;
+ point startpoint;
+ point leftpoint, rightpoint;
+ REAL leftccw, rightccw;
+ int leftflag, rightflag;
+ triangle ptr; /* Temporary variable used by onext() and oprev(). */
+
+ org(*searchtri, startpoint);
+ dest(*searchtri, rightpoint);
+ apex(*searchtri, leftpoint);
+ /* Is `endpoint' to the left? */
+ leftccw = counterclockwise(endpoint, startpoint, leftpoint);
+ leftflag = leftccw > 0.0;
+ /* Is `endpoint' to the right? */
+ rightccw = counterclockwise(startpoint, endpoint, rightpoint);
+ rightflag = rightccw > 0.0;
+ if (leftflag && rightflag) {
+ /* `searchtri' faces directly away from `endpoint'. We could go */
+ /* left or right. Ask whether it's a triangle or a boundary */
+ /* on the left. */
+ onext(*searchtri, checktri);
+ if (checktri.tri == dummytri) {
+ leftflag = 0;
+ } else {
+ rightflag = 0;
+ }
+ }
+ while (leftflag) {
+ /* Turn left until satisfied. */
+ onextself(*searchtri);
+ if (searchtri->tri == dummytri) {
+ printf("Internal error in finddirection(): Unable to find a\n");
+ printf(" triangle leading from (%.12g, %.12g) to", startpoint[0],
+ startpoint[1]);
+ printf(" (%.12g, %.12g).\n", endpoint[0], endpoint[1]);
+ internalerror();
+ }
+ apex(*searchtri, leftpoint);
+ rightccw = leftccw;
+ leftccw = counterclockwise(endpoint, startpoint, leftpoint);
+ leftflag = leftccw > 0.0;
+ }
+ while (rightflag) {
+ /* Turn right until satisfied. */
+ oprevself(*searchtri);
+ if (searchtri->tri == dummytri) {
+ printf("Internal error in finddirection(): Unable to find a\n");
+ printf(" triangle leading from (%.12g, %.12g) to", startpoint[0],
+ startpoint[1]);
+ printf(" (%.12g, %.12g).\n", endpoint[0], endpoint[1]);
+ internalerror();
+ }
+ dest(*searchtri, rightpoint);
+ leftccw = rightccw;
+ rightccw = counterclockwise(startpoint, endpoint, rightpoint);
+ rightflag = rightccw > 0.0;
+ }
+ if (leftccw == 0.0) {
+ return LEFTCOLLINEAR;
+ } else if (rightccw == 0.0) {
+ return RIGHTCOLLINEAR;
+ } else {
+ return WITHIN;
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* segmentintersection() Find the intersection of an existing segment */
+/* and a segment that is being inserted. Insert */
+/* a point at the intersection, splitting an */
+/* existing shell edge. */
+/* */
+/* The segment being inserted connects the apex of splittri to endpoint2. */
+/* splitshelle is the shell edge being split, and MUST be opposite */
+/* splittri. Hence, the edge being split connects the origin and */
+/* destination of splittri. */
+/* */
+/* On completion, splittri is a handle having the newly inserted */
+/* intersection point as its origin, and endpoint1 as its destination. */
+/* */
+/*****************************************************************************/
+
+void segmentintersection(splittri, splitshelle, endpoint2)
+struct triedge *splittri;
+struct edge *splitshelle;
+point endpoint2;
+{
+ point endpoint1;
+ point torg, tdest;
+ point leftpoint, rightpoint;
+ point newpoint;
+ enum insertsiteresult success;
+ /*enum finddirectionresult collinear;*/
+ REAL ex, ey;
+ REAL tx, ty;
+ REAL etx, ety;
+ REAL split, denom;
+ int i;
+ triangle ptr; /* Temporary variable used by onext(). */
+
+ /* Find the other three segment endpoints. */
+ apex(*splittri, endpoint1);
+ org(*splittri, torg);
+ dest(*splittri, tdest);
+ /* Segment intersection formulae; see the Antonio reference. */
+ tx = tdest[0] - torg[0];
+ ty = tdest[1] - torg[1];
+ ex = endpoint2[0] - endpoint1[0];
+ ey = endpoint2[1] - endpoint1[1];
+ etx = torg[0] - endpoint2[0];
+ ety = torg[1] - endpoint2[1];
+ denom = ty * ex - tx * ey;
+ if (denom == 0.0) {
+ printf("Internal error in segmentintersection():");
+ printf(" Attempt to find intersection of parallel segments.\n");
+ internalerror();
+ }
+ split = (ey * etx - ex * ety) / denom;
+ /* Create the new point. */
+ newpoint = (point) poolalloc(&points);
+ /* Interpolate its coordinate and attributes. */
+ for (i = 0; i < 2 + nextras; i++) {
+ newpoint[i] = torg[i] + split * (tdest[i] - torg[i]);
+ }
+ setpointmark(newpoint, mark(*splitshelle));
+ if (verbose > 1) {
+ printf(" Splitting edge (%.12g, %.12g) (%.12g, %.12g) at (%.12g, %.12g).\n",
+ torg[0], torg[1], tdest[0], tdest[1], newpoint[0], newpoint[1]);
+ }
+ /* Insert the intersection point. This should always succeed. */
+ success = insertsite(newpoint, splittri, splitshelle, 0, 0);
+ if (success != SUCCESSFULPOINT) {
+ printf("Internal error in segmentintersection():\n");
+ printf(" Failure to split a segment.\n");
+ internalerror();
+ }
+ if (steinerleft > 0) {
+ steinerleft--;
+ }
+ /* Inserting the point may have caused edge flips. We wish to rediscover */
+ /* the edge connecting endpoint1 to the new intersection point. */
+ /*collinear =*/ finddirection(splittri, endpoint1);
+ dest(*splittri, rightpoint);
+ apex(*splittri, leftpoint);
+ if ((leftpoint[0] == endpoint1[0]) && (leftpoint[1] == endpoint1[1])) {
+ onextself(*splittri);
+ } else if ((rightpoint[0] != endpoint1[0]) ||
+ (rightpoint[1] != endpoint1[1])) {
+ printf("Internal error in segmentintersection():\n");
+ printf(" Topological inconsistency after splitting a segment.\n");
+ internalerror();
+ }
+ /* `splittri' should have destination endpoint1. */
+}
+
+/*****************************************************************************/
+/* */
+/* scoutsegment() Scout the first triangle on the path from one endpoint */
+/* to another, and check for completion (reaching the */
+/* second endpoint), a collinear point, and the */
+/* intersection of two segments. */
+/* */
+/* Returns one if the entire segment is successfully inserted, and zero if */
+/* the job must be finished by conformingedge() or constrainededge(). */
+/* */
+/* If the first triangle on the path has the second endpoint as its */
+/* destination or apex, a shell edge is inserted and the job is done. */
+/* */
+/* If the first triangle on the path has a destination or apex that lies on */
+/* the segment, a shell edge is inserted connecting the first endpoint to */
+/* the collinear point, and the search is continued from the collinear */
+/* point. */
+/* */
+/* If the first triangle on the path has a shell edge opposite its origin, */
+/* then there is a segment that intersects the segment being inserted. */
+/* Their intersection point is inserted, splitting the shell edge. */
+/* */
+/* Otherwise, return zero. */
+/* */
+/*****************************************************************************/
+
+int scoutsegment(searchtri, endpoint2, newmark)
+struct triedge *searchtri;
+point endpoint2;
+int newmark;
+{
+ struct triedge crosstri;
+ struct edge crossedge;
+ point leftpoint, rightpoint;
+ /*point endpoint1;*/
+ enum finddirectionresult collinear;
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ collinear = finddirection(searchtri, endpoint2);
+ dest(*searchtri, rightpoint);
+ apex(*searchtri, leftpoint);
+ if (((leftpoint[0] == endpoint2[0]) && (leftpoint[1] == endpoint2[1])) ||
+ ((rightpoint[0] == endpoint2[0]) && (rightpoint[1] == endpoint2[1]))) {
+ /* The segment is already an edge in the mesh. */
+ if ((leftpoint[0] == endpoint2[0]) && (leftpoint[1] == endpoint2[1])) {
+ lprevself(*searchtri);
+ }
+ /* Insert a shell edge, if there isn't already one there. */
+ insertshelle(searchtri, newmark);
+ return 1;
+ } else if (collinear == LEFTCOLLINEAR) {
+ /* We've collided with a point between the segment's endpoints. */
+ /* Make the collinear point be the triangle's origin. */
+ lprevself(*searchtri);
+ insertshelle(searchtri, newmark);
+ /* Insert the remainder of the segment. */
+ return scoutsegment(searchtri, endpoint2, newmark);
+ } else if (collinear == RIGHTCOLLINEAR) {
+ /* We've collided with a point between the segment's endpoints. */
+ insertshelle(searchtri, newmark);
+ /* Make the collinear point be the triangle's origin. */
+ lnextself(*searchtri);
+ /* Insert the remainder of the segment. */
+ return scoutsegment(searchtri, endpoint2, newmark);
+ } else {
+ lnext(*searchtri, crosstri);
+ tspivot(crosstri, crossedge);
+ /* Check for a crossing segment. */
+ if (crossedge.sh == dummysh) {
+ return 0;
+ } else {
+ /*org(*searchtri, endpoint1);*/
+ /* Insert a point at the intersection. */
+ segmentintersection(&crosstri, &crossedge, endpoint2);
+ triedgecopy(crosstri, *searchtri);
+ insertshelle(searchtri, newmark);
+ /* Insert the remainder of the segment. */
+ return scoutsegment(searchtri, endpoint2, newmark);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* conformingedge() Force a segment into a conforming Delaunay */
+/* triangulation by inserting a point at its midpoint, */
+/* and recursively forcing in the two half-segments if */
+/* necessary. */
+/* */
+/* Generates a sequence of edges connecting `endpoint1' to `endpoint2'. */
+/* `newmark' is the boundary marker of the segment, assigned to each new */
+/* splitting point and shell edge. */
+/* */
+/* Note that conformingedge() does not always maintain the conforming */
+/* Delaunay property. Once inserted, segments are locked into place; */
+/* points inserted later (to force other segments in) may render these */
+/* fixed segments non-Delaunay. The conforming Delaunay property will be */
+/* restored by enforcequality() by splitting encroached segments. */
+/* */
+/*****************************************************************************/
+
+#ifndef REDUCED
+#ifndef CDT_ONLY
+
+void conformingedge(endpoint1, endpoint2, newmark)
+point endpoint1;
+point endpoint2;
+int newmark;
+{
+ struct triedge searchtri1, searchtri2;
+ struct edge brokenshelle;
+ point newpoint;
+ point midpoint1, midpoint2;
+ enum insertsiteresult success;
+ int result1, result2;
+ int i;
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ if (verbose > 2) {
+ printf("Forcing segment into triangulation by recursive splitting:\n");
+ printf(" (%.12g, %.12g) (%.12g, %.12g)\n", endpoint1[0], endpoint1[1],
+ endpoint2[0], endpoint2[1]);
+ }
+ /* Create a new point to insert in the middle of the segment. */
+ newpoint = (point) poolalloc(&points);
+ /* Interpolate coordinates and attributes. */
+ for (i = 0; i < 2 + nextras; i++) {
+ newpoint[i] = 0.5 * (endpoint1[i] + endpoint2[i]);
+ }
+ setpointmark(newpoint, newmark);
+ /* Find a boundary triangle to search from. */
+ searchtri1.tri = (triangle *) NULL;
+ /* Attempt to insert the new point. */
+ success = insertsite(newpoint, &searchtri1, (struct edge *) NULL, 0, 0);
+ if (success == DUPLICATEPOINT) {
+ if (verbose > 2) {
+ printf(" Segment intersects existing point (%.12g, %.12g).\n",
+ newpoint[0], newpoint[1]);
+ }
+ /* Use the point that's already there. */
+ pointdealloc(newpoint);
+ /*org(searchtri1, newpoint);*/
+ } else {
+ if (success == VIOLATINGPOINT) {
+ if (verbose > 2) {
+ printf(" Two segments intersect at (%.12g, %.12g).\n",
+ newpoint[0], newpoint[1]);
+ }
+ /* By fluke, we've landed right on another segment. Split it. */
+ tspivot(searchtri1, brokenshelle);
+ success = insertsite(newpoint, &searchtri1, &brokenshelle, 0, 0);
+ if (success != SUCCESSFULPOINT) {
+ printf("Internal error in conformingedge():\n");
+ printf(" Failure to split a segment.\n");
+ internalerror();
+ }
+ }
+ /* The point has been inserted successfully. */
+ if (steinerleft > 0) {
+ steinerleft--;
+ }
+ }
+ triedgecopy(searchtri1, searchtri2);
+ result1 = scoutsegment(&searchtri1, endpoint1, newmark);
+ result2 = scoutsegment(&searchtri2, endpoint2, newmark);
+ if (!result1) {
+ /* The origin of searchtri1 may have changed if a collision with an */
+ /* intervening vertex on the segment occurred. */
+ org(searchtri1, midpoint1);
+ conformingedge(midpoint1, endpoint1, newmark);
+ }
+ if (!result2) {
+ /* The origin of searchtri2 may have changed if a collision with an */
+ /* intervening vertex on the segment occurred. */
+ org(searchtri2, midpoint2);
+ conformingedge(midpoint2, endpoint2, newmark);
+ }
+}
+
+#endif /* not CDT_ONLY */
+#endif /* not REDUCED */
+
+/*****************************************************************************/
+/* */
+/* delaunayfixup() Enforce the Delaunay condition at an edge, fanning out */
+/* recursively from an existing point. Pay special */
+/* attention to stacking inverted triangles. */
+/* */
+/* This is a support routine for inserting segments into a constrained */
+/* Delaunay triangulation. */
+/* */
+/* The origin of fixuptri is treated as if it has just been inserted, and */
+/* the local Delaunay condition needs to be enforced. It is only enforced */
+/* in one sector, however, that being the angular range defined by */
+/* fixuptri. */
+/* */
+/* This routine also needs to make decisions regarding the "stacking" of */
+/* triangles. (Read the description of constrainededge() below before */
+/* reading on here, so you understand the algorithm.) If the position of */
+/* the new point (the origin of fixuptri) indicates that the vertex before */
+/* it on the polygon is a reflex vertex, then "stack" the triangle by */
+/* doing nothing. (fixuptri is an inverted triangle, which is how stacked */
+/* triangles are identified.) */
+/* */
+/* Otherwise, check whether the vertex before that was a reflex vertex. */
+/* If so, perform an edge flip, thereby eliminating an inverted triangle */
+/* (popping it off the stack). The edge flip may result in the creation */
+/* of a new inverted triangle, depending on whether or not the new vertex */
+/* is visible to the vertex three edges behind on the polygon. */
+/* */
+/* If neither of the two vertices behind the new vertex are reflex */
+/* vertices, fixuptri and fartri, the triangle opposite it, are not */
+/* inverted; hence, ensure that the edge between them is locally Delaunay. */
+/* */
+/* `leftside' indicates whether or not fixuptri is to the left of the */
+/* segment being inserted. (Imagine that the segment is pointing up from */
+/* endpoint1 to endpoint2.) */
+/* */
+/*****************************************************************************/
+
+void delaunayfixup(fixuptri, leftside)
+struct triedge *fixuptri;
+int leftside;
+{
+ struct triedge neartri;
+ struct triedge fartri;
+ struct edge faredge;
+ point nearpoint, leftpoint, rightpoint, farpoint;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ lnext(*fixuptri, neartri);
+ sym(neartri, fartri);
+ /* Check if the edge opposite the origin of fixuptri can be flipped. */
+ if (fartri.tri == dummytri) {
+ return;
+ }
+ tspivot(neartri, faredge);
+ if (faredge.sh != dummysh) {
+ return;
+ }
+ /* Find all the relevant vertices. */
+ apex(neartri, nearpoint);
+ org(neartri, leftpoint);
+ dest(neartri, rightpoint);
+ apex(fartri, farpoint);
+ /* Check whether the previous polygon vertex is a reflex vertex. */
+ if (leftside) {
+ if (counterclockwise(nearpoint, leftpoint, farpoint) <= 0.0) {
+ /* leftpoint is a reflex vertex too. Nothing can */
+ /* be done until a convex section is found. */
+ return;
+ }
+ } else {
+ if (counterclockwise(farpoint, rightpoint, nearpoint) <= 0.0) {
+ /* rightpoint is a reflex vertex too. Nothing can */
+ /* be done until a convex section is found. */
+ return;
+ }
+ }
+ if (counterclockwise(rightpoint, leftpoint, farpoint) > 0.0) {
+ /* fartri is not an inverted triangle, and farpoint is not a reflex */
+ /* vertex. As there are no reflex vertices, fixuptri isn't an */
+ /* inverted triangle, either. Hence, test the edge between the */
+ /* triangles to ensure it is locally Delaunay. */
+ if (incircle(leftpoint, farpoint, rightpoint, nearpoint) <= 0.0) {
+ return;
+ }
+ /* Not locally Delaunay; go on to an edge flip. */
+ } /* else fartri is inverted; remove it from the stack by flipping. */
+ flip(&neartri);
+ lprevself(*fixuptri); /* Restore the origin of fixuptri after the flip. */
+ /* Recursively process the two triangles that result from the flip. */
+ delaunayfixup(fixuptri, leftside);
+ delaunayfixup(&fartri, leftside);
+}
+
+/*****************************************************************************/
+/* */
+/* constrainededge() Force a segment into a constrained Delaunay */
+/* triangulation by deleting the triangles it */
+/* intersects, and triangulating the polygons that */
+/* form on each side of it. */
+/* */
+/* Generates a single edge connecting `endpoint1' to `endpoint2'. The */
+/* triangle `starttri' has `endpoint1' as its origin. `newmark' is the */
+/* boundary marker of the segment. */
+/* */
+/* To insert a segment, every triangle whose interior intersects the */
+/* segment is deleted. The union of these deleted triangles is a polygon */
+/* (which is not necessarily monotone, but is close enough), which is */
+/* divided into two polygons by the new segment. This routine's task is */
+/* to generate the Delaunay triangulation of these two polygons. */
+/* */
+/* You might think of this routine's behavior as a two-step process. The */
+/* first step is to walk from endpoint1 to endpoint2, flipping each edge */
+/* encountered. This step creates a fan of edges connected to endpoint1, */
+/* including the desired edge to endpoint2. The second step enforces the */
+/* Delaunay condition on each side of the segment in an incremental manner: */
+/* proceeding along the polygon from endpoint1 to endpoint2 (this is done */
+/* independently on each side of the segment), each vertex is "enforced" */
+/* as if it had just been inserted, but affecting only the previous */
+/* vertices. The result is the same as if the vertices had been inserted */
+/* in the order they appear on the polygon, so the result is Delaunay. */
+/* */
+/* In truth, constrainededge() interleaves these two steps. The procedure */
+/* walks from endpoint1 to endpoint2, and each time an edge is encountered */
+/* and flipped, the newly exposed vertex (at the far end of the flipped */
+/* edge) is "enforced" upon the previously flipped edges, usually affecting */
+/* only one side of the polygon (depending upon which side of the segment */
+/* the vertex falls on). */
+/* */
+/* The algorithm is complicated by the need to handle polygons that are not */
+/* convex. Although the polygon is not necessarily monotone, it can be */
+/* triangulated in a manner similar to the stack-based algorithms for */
+/* monotone polygons. For each reflex vertex (local concavity) of the */
+/* polygon, there will be an inverted triangle formed by one of the edge */
+/* flips. (An inverted triangle is one with negative area - that is, its */
+/* vertices are arranged in clockwise order - and is best thought of as a */
+/* wrinkle in the fabric of the mesh.) Each inverted triangle can be */
+/* thought of as a reflex vertex pushed on the stack, waiting to be fixed */
+/* later. */
+/* */
+/* A reflex vertex is popped from the stack when a vertex is inserted that */
+/* is visible to the reflex vertex. (However, if the vertex behind the */
+/* reflex vertex is not visible to the reflex vertex, a new inverted */
+/* triangle will take its place on the stack.) These details are handled */
+/* by the delaunayfixup() routine above. */
+/* */
+/*****************************************************************************/
+
+void constrainededge(starttri, endpoint2, newmark)
+struct triedge *starttri;
+point endpoint2;
+int newmark;
+{
+ struct triedge fixuptri, fixuptri2;
+ struct edge fixupedge;
+ point endpoint1;
+ point farpoint;
+ REAL area;
+ int collision;
+ int done;
+ triangle ptr; /* Temporary variable used by sym() and oprev(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ org(*starttri, endpoint1);
+ lnext(*starttri, fixuptri);
+ flip(&fixuptri);
+ /* `collision' indicates whether we have found a point directly */
+ /* between endpoint1 and endpoint2. */
+ collision = 0;
+ done = 0;
+ do {
+ org(fixuptri, farpoint);
+ /* `farpoint' is the extreme point of the polygon we are "digging" */
+ /* to get from endpoint1 to endpoint2. */
+ if ((farpoint[0] == endpoint2[0]) && (farpoint[1] == endpoint2[1])) {
+ oprev(fixuptri, fixuptri2);
+ /* Enforce the Delaunay condition around endpoint2. */
+ delaunayfixup(&fixuptri, 0);
+ delaunayfixup(&fixuptri2, 1);
+ done = 1;
+ } else {
+ /* Check whether farpoint is to the left or right of the segment */
+ /* being inserted, to decide which edge of fixuptri to dig */
+ /* through next. */
+ area = counterclockwise(endpoint1, endpoint2, farpoint);
+ if (area == 0.0) {
+ /* We've collided with a point between endpoint1 and endpoint2. */
+ collision = 1;
+ oprev(fixuptri, fixuptri2);
+ /* Enforce the Delaunay condition around farpoint. */
+ delaunayfixup(&fixuptri, 0);
+ delaunayfixup(&fixuptri2, 1);
+ done = 1;
+ } else {
+ if (area > 0.0) { /* farpoint is to the left of the segment. */
+ oprev(fixuptri, fixuptri2);
+ /* Enforce the Delaunay condition around farpoint, on the */
+ /* left side of the segment only. */
+ delaunayfixup(&fixuptri2, 1);
+ /* Flip the edge that crosses the segment. After the edge is */
+ /* flipped, one of its endpoints is the fan vertex, and the */
+ /* destination of fixuptri is the fan vertex. */
+ lprevself(fixuptri);
+ } else { /* farpoint is to the right of the segment. */
+ delaunayfixup(&fixuptri, 0);
+ /* Flip the edge that crosses the segment. After the edge is */
+ /* flipped, one of its endpoints is the fan vertex, and the */
+ /* destination of fixuptri is the fan vertex. */
+ oprevself(fixuptri);
+ }
+ /* Check for two intersecting segments. */
+ tspivot(fixuptri, fixupedge);
+ if (fixupedge.sh == dummysh) {
+ flip(&fixuptri); /* May create an inverted triangle on the left. */
+ } else {
+ /* We've collided with a segment between endpoint1 and endpoint2. */
+ collision = 1;
+ /* Insert a point at the intersection. */
+ segmentintersection(&fixuptri, &fixupedge, endpoint2);
+ done = 1;
+ }
+ }
+ }
+ } while (!done);
+ /* Insert a shell edge to make the segment permanent. */
+ insertshelle(&fixuptri, newmark);
+ /* If there was a collision with an interceding vertex, install another */
+ /* segment connecting that vertex with endpoint2. */
+ if (collision) {
+ /* Insert the remainder of the segment. */
+ if (!scoutsegment(&fixuptri, endpoint2, newmark)) {
+ constrainededge(&fixuptri, endpoint2, newmark);
+ }
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* insertsegment() Insert a PSLG segment into a triangulation. */
+/* */
+/*****************************************************************************/
+
+void insertsegment(endpoint1, endpoint2, newmark)
+point endpoint1;
+point endpoint2;
+int newmark;
+{
+ struct triedge searchtri1, searchtri2;
+ triangle encodedtri;
+ point checkpoint;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (verbose > 1) {
+ printf(" Connecting (%.12g, %.12g) to (%.12g, %.12g).\n",
+ endpoint1[0], endpoint1[1], endpoint2[0], endpoint2[1]);
+ }
+
+ /* Find a triangle whose origin is the segment's first endpoint. */
+ checkpoint = (point) NULL;
+ encodedtri = point2tri(endpoint1);
+ if (encodedtri != (triangle) NULL) {
+ decode(encodedtri, searchtri1);
+ org(searchtri1, checkpoint);
+ }
+ if (checkpoint != endpoint1) {
+ /* Find a boundary triangle to search from. */
+ searchtri1.tri = dummytri;
+ searchtri1.orient = 0;
+ symself(searchtri1);
+ /* Search for the segment's first endpoint by point location. */
+ if (locate(endpoint1, &searchtri1) != ONVERTEX) {
+ printf("Internal error in insertsegment(): Unable to locate PSLG point\n");
+ printf(" (%.12g, %.12g) in triangulation.\n",
+ endpoint1[0], endpoint1[1]);
+ internalerror();
+ }
+ }
+ /* Remember this triangle to improve subsequent point location. */
+ triedgecopy(searchtri1, recenttri);
+ /* Scout the beginnings of a path from the first endpoint */
+ /* toward the second. */
+ if (scoutsegment(&searchtri1, endpoint2, newmark)) {
+ /* The segment was easily inserted. */
+ return;
+ }
+ /* The first endpoint may have changed if a collision with an intervening */
+ /* vertex on the segment occurred. */
+ org(searchtri1, endpoint1);
+
+ /* Find a triangle whose origin is the segment's second endpoint. */
+ checkpoint = (point) NULL;
+ encodedtri = point2tri(endpoint2);
+ if (encodedtri != (triangle) NULL) {
+ decode(encodedtri, searchtri2);
+ org(searchtri2, checkpoint);
+ }
+ if (checkpoint != endpoint2) {
+ /* Find a boundary triangle to search from. */
+ searchtri2.tri = dummytri;
+ searchtri2.orient = 0;
+ symself(searchtri2);
+ /* Search for the segment's second endpoint by point location. */
+ if (locate(endpoint2, &searchtri2) != ONVERTEX) {
+ printf("Internal error in insertsegment(): Unable to locate PSLG point\n");
+ printf(" (%.12g, %.12g) in triangulation.\n",
+ endpoint2[0], endpoint2[1]);
+ internalerror();
+ }
+ }
+ /* Remember this triangle to improve subsequent point location. */
+ triedgecopy(searchtri2, recenttri);
+ /* Scout the beginnings of a path from the second endpoint */
+ /* toward the first. */
+ if (scoutsegment(&searchtri2, endpoint1, newmark)) {
+ /* The segment was easily inserted. */
+ return;
+ }
+ /* The second endpoint may have changed if a collision with an intervening */
+ /* vertex on the segment occurred. */
+ org(searchtri2, endpoint2);
+
+#ifndef REDUCED
+#ifndef CDT_ONLY
+ if (splitseg) {
+ /* Insert vertices to force the segment into the triangulation. */
+ conformingedge(endpoint1, endpoint2, newmark);
+ } else {
+#endif /* not CDT_ONLY */
+#endif /* not REDUCED */
+ /* Insert the segment directly into the triangulation. */
+ constrainededge(&searchtri1, endpoint2, newmark);
+#ifndef REDUCED
+#ifndef CDT_ONLY
+ }
+#endif /* not CDT_ONLY */
+#endif /* not REDUCED */
+}
+
+/*****************************************************************************/
+/* */
+/* markhull() Cover the convex hull of a triangulation with shell edges. */
+/* */
+/*****************************************************************************/
+
+void markhull()
+{
+ struct triedge hulltri;
+ struct triedge nexttri;
+ struct triedge starttri;
+ triangle ptr; /* Temporary variable used by sym() and oprev(). */
+
+ /* Find a triangle handle on the hull. */
+ hulltri.tri = dummytri;
+ hulltri.orient = 0;
+ symself(hulltri);
+ /* Remember where we started so we know when to stop. */
+ triedgecopy(hulltri, starttri);
+ /* Go once counterclockwise around the convex hull. */
+ do {
+ /* Create a shell edge if there isn't already one here. */
+ insertshelle(&hulltri, 1);
+ /* To find the next hull edge, go clockwise around the next vertex. */
+ lnextself(hulltri);
+ oprev(hulltri, nexttri);
+ while (nexttri.tri != dummytri) {
+ triedgecopy(nexttri, hulltri);
+ oprev(hulltri, nexttri);
+ }
+ } while (!triedgeequal(hulltri, starttri));
+}
+
+/*****************************************************************************/
+/* */
+/* formskeleton() Create the shell edges of a triangulation, including */
+/* PSLG edges and edges on the convex hull. */
+/* */
+/* The PSLG edges are read from a .poly file. The return value is the */
+/* number of segments in the file. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+int formskeleton(segmentlist, segmentmarkerlist, numberofsegments)
+int *segmentlist;
+int *segmentmarkerlist;
+int numberofsegments;
+
+#else /* not TRILIBRARY */
+
+int formskeleton(polyfile, polyfilename)
+FILE *polyfile;
+char *polyfilename;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ char polyfilename[6];
+ int index;
+#else /* not TRILIBRARY */
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+#endif /* not TRILIBRARY */
+ point endpoint1, endpoint2;
+ int segments;
+ int segmentmarkers;
+ int end1, end2;
+ int boundmarker;
+ int i;
+
+ if (poly) {
+ if (!quiet) {
+ printf("Inserting segments into Delaunay triangulation.\n");
+ }
+#ifdef TRILIBRARY
+ strcpy(polyfilename, "input");
+ segments = numberofsegments;
+ segmentmarkers = segmentmarkerlist != (int *) NULL;
+ index = 0;
+#else /* not TRILIBRARY */
+ /* Read the segments from a .poly file. */
+ /* Read number of segments and number of boundary markers. */
+ stringptr = readline(inputline, polyfile, polyfilename);
+ segments = (int) strtol (stringptr, &stringptr, 0);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ segmentmarkers = 0;
+ } else {
+ segmentmarkers = (int) strtol (stringptr, &stringptr, 0);
+ }
+#endif /* not TRILIBRARY */
+ /* If segments are to be inserted, compute a mapping */
+ /* from points to triangles. */
+ if (segments > 0) {
+ if (verbose) {
+ printf(" Inserting PSLG segments.\n");
+ }
+ makepointmap();
+ }
+
+ boundmarker = 0;
+ /* Read and insert the segments. */
+ for (i = 1; i <= segments; i++) {
+#ifdef TRILIBRARY
+ end1 = segmentlist[index++];
+ end2 = segmentlist[index++];
+ if (segmentmarkers) {
+ boundmarker = segmentmarkerlist[i - 1];
+ }
+#else /* not TRILIBRARY */
+ stringptr = readline(inputline, polyfile, inpolyfilename);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d has no endpoints in %s.\n", i,
+ polyfilename);
+ exit(1);
+ } else {
+ end1 = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Segment %d is missing its second endpoint in %s.\n", i,
+ polyfilename);
+ exit(1);
+ } else {
+ end2 = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (segmentmarkers) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ boundmarker = 0;
+ } else {
+ boundmarker = (int) strtol (stringptr, &stringptr, 0);
+ }
+ }
+#endif /* not TRILIBRARY */
+ if ((end1 < firstnumber) || (end1 >= firstnumber + inpoints)) {
+ if (!quiet) {
+ printf("Warning: Invalid first endpoint of segment %d in %s.\n", i,
+ polyfilename);
+ }
+ } else if ((end2 < firstnumber) || (end2 >= firstnumber + inpoints)) {
+ if (!quiet) {
+ printf("Warning: Invalid second endpoint of segment %d in %s.\n", i,
+ polyfilename);
+ }
+ } else {
+ endpoint1 = getpoint(end1);
+ endpoint2 = getpoint(end2);
+ if ((endpoint1[0] == endpoint2[0]) && (endpoint1[1] == endpoint2[1])) {
+ if (!quiet) {
+ printf("Warning: Endpoints of segment %d are coincident in %s.\n",
+ i, polyfilename);
+ }
+ } else {
+ insertsegment(endpoint1, endpoint2, boundmarker);
+ }
+ }
+ }
+ } else {
+ segments = 0;
+ }
+ if (convex || !poly) {
+ /* Enclose the convex hull with shell edges. */
+ if (verbose) {
+ printf(" Enclosing convex hull with segments.\n");
+ }
+ markhull();
+ }
+ return segments;
+}
+
+/** **/
+/** **/
+/********* Segment (shell edge) insertion ends here *********/
+
+/********* Carving out holes and concavities begins here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* infecthull() Virally infect all of the triangles of the convex hull */
+/* that are not protected by shell edges. Where there are */
+/* shell edges, set boundary markers as appropriate. */
+/* */
+/*****************************************************************************/
+
+void infecthull()
+{
+ struct triedge hulltri;
+ struct triedge nexttri;
+ struct triedge starttri;
+ struct edge hulledge;
+ triangle **deadtri;
+ point horg, hdest;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ if (verbose) {
+ printf(" Marking concavities (external triangles) for elimination.\n");
+ }
+ /* Find a triangle handle on the hull. */
+ hulltri.tri = dummytri;
+ hulltri.orient = 0;
+ symself(hulltri);
+ /* Remember where we started so we know when to stop. */
+ triedgecopy(hulltri, starttri);
+ /* Go once counterclockwise around the convex hull. */
+ do {
+ /* Ignore triangles that are already infected. */
+ if (!infected(hulltri)) {
+ /* Is the triangle protected by a shell edge? */
+ tspivot(hulltri, hulledge);
+ if (hulledge.sh == dummysh) {
+ /* The triangle is not protected; infect it. */
+ infect(hulltri);
+ deadtri = (triangle **) poolalloc(&viri);
+ *deadtri = hulltri.tri;
+ } else {
+ /* The triangle is protected; set boundary markers if appropriate. */
+ if (mark(hulledge) == 0) {
+ setmark(hulledge, 1);
+ org(hulltri, horg);
+ dest(hulltri, hdest);
+ if (pointmark(horg) == 0) {
+ setpointmark(horg, 1);
+ }
+ if (pointmark(hdest) == 0) {
+ setpointmark(hdest, 1);
+ }
+ }
+ }
+ }
+ /* To find the next hull edge, go clockwise around the next vertex. */
+ lnextself(hulltri);
+ oprev(hulltri, nexttri);
+ while (nexttri.tri != dummytri) {
+ triedgecopy(nexttri, hulltri);
+ oprev(hulltri, nexttri);
+ }
+ } while (!triedgeequal(hulltri, starttri));
+}
+
+/*****************************************************************************/
+/* */
+/* plague() Spread the virus from all infected triangles to any neighbors */
+/* not protected by shell edges. Delete all infected triangles. */
+/* */
+/* This is the procedure that actually creates holes and concavities. */
+/* */
+/* This procedure operates in two phases. The first phase identifies all */
+/* the triangles that will die, and marks them as infected. They are */
+/* marked to ensure that each triangle is added to the virus pool only */
+/* once, so the procedure will terminate. */
+/* */
+/* The second phase actually eliminates the infected triangles. It also */
+/* eliminates orphaned points. */
+/* */
+/*****************************************************************************/
+
+void plague()
+{
+ struct triedge testtri;
+ struct triedge neighbor;
+ triangle **virusloop;
+ triangle **deadtri;
+ struct edge neighborshelle;
+ point testpoint;
+ point norg, ndest;
+ point deadorg, deaddest, deadapex;
+ int killorg;
+ triangle ptr; /* Temporary variable used by sym() and onext(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ if (verbose) {
+ printf(" Marking neighbors of marked triangles.\n");
+ }
+ /* Loop through all the infected triangles, spreading the virus to */
+ /* their neighbors, then to their neighbors' neighbors. */
+ traversalinit(&viri);
+ virusloop = (triangle **) traverse(&viri);
+ while (virusloop != (triangle **) NULL) {
+ testtri.tri = *virusloop;
+ /* A triangle is marked as infected by messing with one of its shell */
+ /* edges, setting it to an illegal value. Hence, we have to */
+ /* temporarily uninfect this triangle so that we can examine its */
+ /* adjacent shell edges. */
+ uninfect(testtri);
+ if (verbose > 2) {
+ /* Assign the triangle an orientation for convenience in */
+ /* checking its points. */
+ testtri.orient = 0;
+ org(testtri, deadorg);
+ dest(testtri, deaddest);
+ apex(testtri, deadapex);
+ printf(" Checking (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ deadorg[0], deadorg[1], deaddest[0], deaddest[1],
+ deadapex[0], deadapex[1]);
+ }
+ /* Check each of the triangle's three neighbors. */
+ for (testtri.orient = 0; testtri.orient < 3; testtri.orient++) {
+ /* Find the neighbor. */
+ sym(testtri, neighbor);
+ /* Check for a shell between the triangle and its neighbor. */
+ tspivot(testtri, neighborshelle);
+ /* Check if the neighbor is nonexistent or already infected. */
+ if ((neighbor.tri == dummytri) || infected(neighbor)) {
+ if (neighborshelle.sh != dummysh) {
+ /* There is a shell edge separating the triangle from its */
+ /* neighbor, but both triangles are dying, so the shell */
+ /* edge dies too. */
+ shelledealloc(neighborshelle.sh);
+ if (neighbor.tri != dummytri) {
+ /* Make sure the shell edge doesn't get deallocated again */
+ /* later when the infected neighbor is visited. */
+ uninfect(neighbor);
+ tsdissolve(neighbor);
+ infect(neighbor);
+ }
+ }
+ } else { /* The neighbor exists and is not infected. */
+ if (neighborshelle.sh == dummysh) {
+ /* There is no shell edge protecting the neighbor, so */
+ /* the neighbor becomes infected. */
+ if (verbose > 2) {
+ org(neighbor, deadorg);
+ dest(neighbor, deaddest);
+ apex(neighbor, deadapex);
+ printf(" Marking (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ deadorg[0], deadorg[1], deaddest[0], deaddest[1],
+ deadapex[0], deadapex[1]);
+ }
+ infect(neighbor);
+ /* Ensure that the neighbor's neighbors will be infected. */
+ deadtri = (triangle **) poolalloc(&viri);
+ *deadtri = neighbor.tri;
+ } else { /* The neighbor is protected by a shell edge. */
+ /* Remove this triangle from the shell edge. */
+ stdissolve(neighborshelle);
+ /* The shell edge becomes a boundary. Set markers accordingly. */
+ if (mark(neighborshelle) == 0) {
+ setmark(neighborshelle, 1);
+ }
+ org(neighbor, norg);
+ dest(neighbor, ndest);
+ if (pointmark(norg) == 0) {
+ setpointmark(norg, 1);
+ }
+ if (pointmark(ndest) == 0) {
+ setpointmark(ndest, 1);
+ }
+ }
+ }
+ }
+ /* Remark the triangle as infected, so it doesn't get added to the */
+ /* virus pool again. */
+ infect(testtri);
+ virusloop = (triangle **) traverse(&viri);
+ }
+
+ if (verbose) {
+ printf(" Deleting marked triangles.\n");
+ }
+ traversalinit(&viri);
+ virusloop = (triangle **) traverse(&viri);
+ while (virusloop != (triangle **) NULL) {
+ testtri.tri = *virusloop;
+
+ /* Check each of the three corners of the triangle for elimination. */
+ /* This is done by walking around each point, checking if it is */
+ /* still connected to at least one live triangle. */
+ for (testtri.orient = 0; testtri.orient < 3; testtri.orient++) {
+ org(testtri, testpoint);
+ /* Check if the point has already been tested. */
+ if (testpoint != (point) NULL) {
+ killorg = 1;
+ /* Mark the corner of the triangle as having been tested. */
+ setorg(testtri, NULL);
+ /* Walk counterclockwise about the point. */
+ onext(testtri, neighbor);
+ /* Stop upon reaching a boundary or the starting triangle. */
+ while ((neighbor.tri != dummytri)
+ && (!triedgeequal(neighbor, testtri))) {
+ if (infected(neighbor)) {
+ /* Mark the corner of this triangle as having been tested. */
+ setorg(neighbor, NULL);
+ } else {
+ /* A live triangle. The point survives. */
+ killorg = 0;
+ }
+ /* Walk counterclockwise about the point. */
+ onextself(neighbor);
+ }
+ /* If we reached a boundary, we must walk clockwise as well. */
+ if (neighbor.tri == dummytri) {
+ /* Walk clockwise about the point. */
+ oprev(testtri, neighbor);
+ /* Stop upon reaching a boundary. */
+ while (neighbor.tri != dummytri) {
+ if (infected(neighbor)) {
+ /* Mark the corner of this triangle as having been tested. */
+ setorg(neighbor, NULL);
+ } else {
+ /* A live triangle. The point survives. */
+ killorg = 0;
+ }
+ /* Walk clockwise about the point. */
+ oprevself(neighbor);
+ }
+ }
+ if (killorg) {
+ if (verbose > 1) {
+ printf(" Deleting point (%.12g, %.12g)\n",
+ testpoint[0], testpoint[1]);
+ }
+ pointdealloc(testpoint);
+ }
+ }
+ }
+
+ /* Record changes in the number of boundary edges, and disconnect */
+ /* dead triangles from their neighbors. */
+ for (testtri.orient = 0; testtri.orient < 3; testtri.orient++) {
+ sym(testtri, neighbor);
+ if (neighbor.tri == dummytri) {
+ /* There is no neighboring triangle on this edge, so this edge */
+ /* is a boundary edge. This triangle is being deleted, so this */
+ /* boundary edge is deleted. */
+ hullsize--;
+ } else {
+ /* Disconnect the triangle from its neighbor. */
+ dissolve(neighbor);
+ /* There is a neighboring triangle on this edge, so this edge */
+ /* becomes a boundary edge when this triangle is deleted. */
+ hullsize++;
+ }
+ }
+ /* Return the dead triangle to the pool of triangles. */
+ triangledealloc(testtri.tri);
+ virusloop = (triangle **) traverse(&viri);
+ }
+ /* Empty the virus pool. */
+ poolrestart(&viri);
+}
+
+/*****************************************************************************/
+/* */
+/* regionplague() Spread regional attributes and/or area constraints */
+/* (from a .poly file) throughout the mesh. */
+/* */
+/* This procedure operates in two phases. The first phase spreads an */
+/* attribute and/or an area constraint through a (segment-bounded) region. */
+/* The triangles are marked to ensure that each triangle is added to the */
+/* virus pool only once, so the procedure will terminate. */
+/* */
+/* The second phase uninfects all infected triangles, returning them to */
+/* normal. */
+/* */
+/*****************************************************************************/
+
+void regionplague(attribute, area)
+REAL attribute;
+REAL area;
+{
+ struct triedge testtri;
+ struct triedge neighbor;
+ triangle **virusloop;
+ triangle **regiontri;
+ struct edge neighborshelle;
+ point regionorg, regiondest, regionapex;
+ triangle ptr; /* Temporary variable used by sym() and onext(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ if (verbose > 1) {
+ printf(" Marking neighbors of marked triangles.\n");
+ }
+ /* Loop through all the infected triangles, spreading the attribute */
+ /* and/or area constraint to their neighbors, then to their neighbors' */
+ /* neighbors. */
+ traversalinit(&viri);
+ virusloop = (triangle **) traverse(&viri);
+ while (virusloop != (triangle **) NULL) {
+ testtri.tri = *virusloop;
+ /* A triangle is marked as infected by messing with one of its shell */
+ /* edges, setting it to an illegal value. Hence, we have to */
+ /* temporarily uninfect this triangle so that we can examine its */
+ /* adjacent shell edges. */
+ uninfect(testtri);
+ if (regionattrib) {
+ /* Set an attribute. */
+ setelemattribute(testtri, eextras, attribute);
+ }
+ if (vararea) {
+ /* Set an area constraint. */
+ setareabound(testtri, area);
+ }
+ if (verbose > 2) {
+ /* Assign the triangle an orientation for convenience in */
+ /* checking its points. */
+ testtri.orient = 0;
+ org(testtri, regionorg);
+ dest(testtri, regiondest);
+ apex(testtri, regionapex);
+ printf(" Checking (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ regionorg[0], regionorg[1], regiondest[0], regiondest[1],
+ regionapex[0], regionapex[1]);
+ }
+ /* Check each of the triangle's three neighbors. */
+ for (testtri.orient = 0; testtri.orient < 3; testtri.orient++) {
+ /* Find the neighbor. */
+ sym(testtri, neighbor);
+ /* Check for a shell between the triangle and its neighbor. */
+ tspivot(testtri, neighborshelle);
+ /* Make sure the neighbor exists, is not already infected, and */
+ /* isn't protected by a shell edge. */
+ if ((neighbor.tri != dummytri) && !infected(neighbor)
+ && (neighborshelle.sh == dummysh)) {
+ if (verbose > 2) {
+ org(neighbor, regionorg);
+ dest(neighbor, regiondest);
+ apex(neighbor, regionapex);
+ printf(" Marking (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ regionorg[0], regionorg[1], regiondest[0], regiondest[1],
+ regionapex[0], regionapex[1]);
+ }
+ /* Infect the neighbor. */
+ infect(neighbor);
+ /* Ensure that the neighbor's neighbors will be infected. */
+ regiontri = (triangle **) poolalloc(&viri);
+ *regiontri = neighbor.tri;
+ }
+ }
+ /* Remark the triangle as infected, so it doesn't get added to the */
+ /* virus pool again. */
+ infect(testtri);
+ virusloop = (triangle **) traverse(&viri);
+ }
+
+ /* Uninfect all triangles. */
+ if (verbose > 1) {
+ printf(" Unmarking marked triangles.\n");
+ }
+ traversalinit(&viri);
+ virusloop = (triangle **) traverse(&viri);
+ while (virusloop != (triangle **) NULL) {
+ testtri.tri = *virusloop;
+ uninfect(testtri);
+ virusloop = (triangle **) traverse(&viri);
+ }
+ /* Empty the virus pool. */
+ poolrestart(&viri);
+}
+
+/*****************************************************************************/
+/* */
+/* carveholes() Find the holes and infect them. Find the area */
+/* constraints and infect them. Infect the convex hull. */
+/* Spread the infection and kill triangles. Spread the */
+/* area constraints. */
+/* */
+/* This routine mainly calls other routines to carry out all these */
+/* functions. */
+/* */
+/*****************************************************************************/
+
+void carveholes(holelist, holes, regionlist, regions)
+REAL *holelist;
+int holes;
+REAL *regionlist;
+int regions;
+{
+ struct triedge searchtri;
+ struct triedge triangleloop;
+ struct triedge *regiontris=0;
+ triangle **holetri;
+ triangle **regiontri;
+ point searchorg, searchdest;
+ enum locateresult intersect;
+ int i;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+ if (!(quiet || (noholes && convex))) {
+ printf("Removing unwanted triangles.\n");
+ if (verbose && (holes > 0)) {
+ printf(" Marking holes for elimination.\n");
+ }
+ }
+
+ if (regions > 0) {
+ /* Allocate storage for the triangles in which region points fall. */
+ regiontris = (struct triedge *) malloc(regions * sizeof(struct triedge));
+ if (regiontris == (struct triedge *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+
+ if (((holes > 0) && !noholes) || !convex || (regions > 0)) {
+ /* Initialize a pool of viri to be used for holes, concavities, */
+ /* regional attributes, and/or regional area constraints. */
+ poolinit(&viri, sizeof(triangle *), VIRUSPERBLOCK, POINTER, 0);
+ }
+
+ if (!convex) {
+ /* Mark as infected any unprotected triangles on the boundary. */
+ /* This is one way by which concavities are created. */
+ infecthull();
+ }
+
+ if ((holes > 0) && !noholes) {
+ /* Infect each triangle in which a hole lies. */
+ for (i = 0; i < 2 * holes; i += 2) {
+ /* Ignore holes that aren't within the bounds of the mesh. */
+ if ((holelist[i] >= xmin) && (holelist[i] <= xmax)
+ && (holelist[i + 1] >= ymin) && (holelist[i + 1] <= ymax)) {
+ /* Start searching from some triangle on the outer boundary. */
+ searchtri.tri = dummytri;
+ searchtri.orient = 0;
+ symself(searchtri);
+ /* Ensure that the hole is to the left of this boundary edge; */
+ /* otherwise, locate() will falsely report that the hole */
+ /* falls within the starting triangle. */
+ org(searchtri, searchorg);
+ dest(searchtri, searchdest);
+ if (counterclockwise(searchorg, searchdest, &holelist[i]) > 0.0) {
+ /* Find a triangle that contains the hole. */
+ intersect = locate(&holelist[i], &searchtri);
+ if ((intersect != OUTSIDE) && (!infected(searchtri))) {
+ /* Infect the triangle. This is done by marking the triangle */
+ /* as infect and including the triangle in the virus pool. */
+ infect(searchtri);
+ holetri = (triangle **) poolalloc(&viri);
+ *holetri = searchtri.tri;
+ }
+ }
+ }
+ }
+ }
+
+ /* Now, we have to find all the regions BEFORE we carve the holes, because */
+ /* locate() won't work when the triangulation is no longer convex. */
+ /* (Incidentally, this is the reason why regional attributes and area */
+ /* constraints can't be used when refining a preexisting mesh, which */
+ /* might not be convex; they can only be used with a freshly */
+ /* triangulated PSLG.) */
+ if (regions > 0) {
+ /* Find the starting triangle for each region. */
+ for (i = 0; i < regions; i++) {
+ regiontris[i].tri = dummytri;
+ /* Ignore region points that aren't within the bounds of the mesh. */
+ if ((regionlist[4 * i] >= xmin) && (regionlist[4 * i] <= xmax) &&
+ (regionlist[4 * i + 1] >= ymin) && (regionlist[4 * i + 1] <= ymax)) {
+ /* Start searching from some triangle on the outer boundary. */
+ searchtri.tri = dummytri;
+ searchtri.orient = 0;
+ symself(searchtri);
+ /* Ensure that the region point is to the left of this boundary */
+ /* edge; otherwise, locate() will falsely report that the */
+ /* region point falls within the starting triangle. */
+ org(searchtri, searchorg);
+ dest(searchtri, searchdest);
+ if (counterclockwise(searchorg, searchdest, ®ionlist[4 * i]) >
+ 0.0) {
+ /* Find a triangle that contains the region point. */
+ intersect = locate(®ionlist[4 * i], &searchtri);
+ if ((intersect != OUTSIDE) && (!infected(searchtri))) {
+ /* Record the triangle for processing after the */
+ /* holes have been carved. */
+ triedgecopy(searchtri, regiontris[i]);
+ }
+ }
+ }
+ }
+ }
+
+ if (viri.items > 0) {
+ /* Carve the holes and concavities. */
+ plague();
+ }
+ /* The virus pool should be empty now. */
+
+ if (regions > 0) {
+ if (!quiet) {
+ if (regionattrib) {
+ if (vararea) {
+ printf("Spreading regional attributes and area constraints.\n");
+ } else {
+ printf("Spreading regional attributes.\n");
+ }
+ } else {
+ printf("Spreading regional area constraints.\n");
+ }
+ }
+ if (regionattrib && !refine) {
+ /* Assign every triangle a regional attribute of zero. */
+ traversalinit(&triangles);
+ triangleloop.orient = 0;
+ triangleloop.tri = triangletraverse();
+ while (triangleloop.tri != (triangle *) NULL) {
+ setelemattribute(triangleloop, eextras, 0.0);
+ triangleloop.tri = triangletraverse();
+ }
+ }
+ for (i = 0; i < regions; i++) {
+ if (regiontris[i].tri != dummytri) {
+ /* Make sure the triangle under consideration still exists. */
+ /* It may have been eaten by the virus. */
+ if (regiontris[i].tri[3] != (triangle) NULL) {
+ /* Put one triangle in the virus pool. */
+ infect(regiontris[i]);
+ regiontri = (triangle **) poolalloc(&viri);
+ *regiontri = regiontris[i].tri;
+ /* Apply one region's attribute and/or area constraint. */
+ regionplague(regionlist[4 * i + 2], regionlist[4 * i + 3]);
+ /* The virus pool should be empty now. */
+ }
+ }
+ }
+ if (regionattrib && !refine) {
+ /* Note the fact that each triangle has an additional attribute. */
+ eextras++;
+ }
+ }
+
+ /* Free up memory. */
+ if (((holes > 0) && !noholes) || !convex || (regions > 0)) {
+ pooldeinit(&viri);
+ }
+ if (regions > 0) {
+ free(regiontris);
+ }
+}
+
+/** **/
+/** **/
+/********* Carving out holes and concavities ends here *********/
+
+/********* Mesh quality maintenance begins here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* tallyencs() Traverse the entire list of shell edges, check each edge */
+/* to see if it is encroached. If so, add it to the list. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void tallyencs()
+{
+ struct edge edgeloop;
+
+ traversalinit(&shelles);
+ edgeloop.shorient = 0;
+ edgeloop.sh = shelletraverse();
+ while (edgeloop.sh != (shelle *) NULL) {
+ /* If the segment is encroached, add it to the list. */
+ /* dummy = */ checkedge4encroach(&edgeloop);
+ edgeloop.sh = shelletraverse();
+ }
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* precisionerror() Print an error message for precision problems. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void precisionerror()
+{
+ printf("Try increasing the area criterion and/or reducing the minimum\n");
+ printf(" allowable angle so that tiny triangles are not created.\n");
+#ifdef SINGLE
+ printf("Alternatively, try recompiling me with double precision\n");
+ printf(" arithmetic (by removing \"#define SINGLE\" from the\n");
+ printf(" source file or \"-DSINGLE\" from the makefile).\n");
+#endif /* SINGLE */
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* repairencs() Find and repair all the encroached segments. */
+/* */
+/* Encroached segments are repaired by splitting them by inserting a point */
+/* at or near their centers. */
+/* */
+/* `flaws' is a flag that specifies whether one should take note of new */
+/* encroached segments and bad triangles that result from inserting points */
+/* to repair existing encroached segments. */
+/* */
+/* When a segment is split, the two resulting subsegments are always */
+/* tested to see if they are encroached upon, regardless of the value */
+/* of `flaws'. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void repairencs(flaws)
+int flaws;
+{
+ struct triedge enctri;
+ struct triedge testtri;
+ struct edge *encloop;
+ struct edge testsh;
+ point eorg, edest;
+ point newpoint;
+ enum insertsiteresult success;
+ REAL segmentlength, nearestpoweroftwo;
+ REAL split;
+ int acuteorg, acutedest;
+ int i;
+ triangle ptr; /* Temporary variable used by stpivot(). */
+ shelle sptr; /* Temporary variable used by snext(). */
+
+ while ((badsegments.items > 0) && (steinerleft != 0)) {
+ traversalinit(&badsegments);
+ encloop = badsegmenttraverse();
+ while ((encloop != (struct edge *) NULL) && (steinerleft != 0)) {
+ /* To decide where to split a segment, we need to know if the */
+ /* segment shares an endpoint with an adjacent segment. */
+ /* The concern is that, if we simply split every encroached */
+ /* segment in its center, two adjacent segments with a small */
+ /* angle between them might lead to an infinite loop; each */
+ /* point added to split one segment will encroach upon the */
+ /* other segment, which must then be split with a point that */
+ /* will encroach upon the first segment, and so on forever. */
+ /* To avoid this, imagine a set of concentric circles, whose */
+ /* radii are powers of two, about each segment endpoint. */
+ /* These concentric circles determine where the segment is */
+ /* split. (If both endpoints are shared with adjacent */
+ /* segments, split the segment in the middle, and apply the */
+ /* concentric shells for later splittings.) */
+
+ /* Is the origin shared with another segment? */
+ stpivot(*encloop, enctri);
+ lnext(enctri, testtri);
+ tspivot(testtri, testsh);
+ acuteorg = testsh.sh != dummysh;
+ /* Is the destination shared with another segment? */
+ lnextself(testtri);
+ tspivot(testtri, testsh);
+ acutedest = testsh.sh != dummysh;
+ /* Now, check the other side of the segment, if there's a triangle */
+ /* there. */
+ sym(enctri, testtri);
+ if (testtri.tri != dummytri) {
+ /* Is the destination shared with another segment? */
+ lnextself(testtri);
+ tspivot(testtri, testsh);
+ acutedest = acutedest || (testsh.sh != dummysh);
+ /* Is the origin shared with another segment? */
+ lnextself(testtri);
+ tspivot(testtri, testsh);
+ acuteorg = acuteorg || (testsh.sh != dummysh);
+ }
+
+ sorg(*encloop, eorg);
+ sdest(*encloop, edest);
+ /* Use the concentric circles if exactly one endpoint is shared */
+ /* with another adjacent segment. */
+ if (acuteorg ^ acutedest) {
+ segmentlength = sqrt((edest[0] - eorg[0]) * (edest[0] - eorg[0])
+ + (edest[1] - eorg[1]) * (edest[1] - eorg[1]));
+ /* Find the power of two nearest the segment's length. */
+ nearestpoweroftwo = 1.0;
+ while (segmentlength > SQUAREROOTTWO * nearestpoweroftwo) {
+ nearestpoweroftwo *= 2.0;
+ }
+ while (segmentlength < (0.5 * SQUAREROOTTWO) * nearestpoweroftwo) {
+ nearestpoweroftwo *= 0.5;
+ }
+ /* Where do we split the segment? */
+ split = 0.5 * nearestpoweroftwo / segmentlength;
+ if (acutedest) {
+ split = 1.0 - split;
+ }
+ } else {
+ /* If we're not worried about adjacent segments, split */
+ /* this segment in the middle. */
+ split = 0.5;
+ }
+
+ /* Create the new point. */
+ newpoint = (point) poolalloc(&points);
+ /* Interpolate its coordinate and attributes. */
+ for (i = 0; i < 2 + nextras; i++) {
+ newpoint[i] = (1.0 - split) * eorg[i] + split * edest[i];
+ }
+ setpointmark(newpoint, mark(*encloop));
+ if (verbose > 1) {
+ printf(" Splitting edge (%.12g, %.12g) (%.12g, %.12g) at (%.12g, %.12g).\n",
+ eorg[0], eorg[1], edest[0], edest[1], newpoint[0], newpoint[1]);
+ }
+ /* Check whether the new point lies on an endpoint. */
+ if (((newpoint[0] == eorg[0]) && (newpoint[1] == eorg[1]))
+ || ((newpoint[0] == edest[0]) && (newpoint[1] == edest[1]))) {
+ printf("Error: Ran out of precision at (%.12g, %.12g).\n",
+ newpoint[0], newpoint[1]);
+ printf("I attempted to split a segment to a smaller size than can\n");
+ printf(" be accommodated by the finite precision of floating point\n");
+ printf(" arithmetic.\n");
+ precisionerror();
+ exit(1);
+ }
+ /* Insert the splitting point. This should always succeed. */
+ success = insertsite(newpoint, &enctri, encloop, flaws, flaws);
+ if ((success != SUCCESSFULPOINT) && (success != ENCROACHINGPOINT)) {
+ printf("Internal error in repairencs():\n");
+ printf(" Failure to split a segment.\n");
+ internalerror();
+ }
+ if (steinerleft > 0) {
+ steinerleft--;
+ }
+ /* Check the two new subsegments to see if they're encroached. */
+ /* dummy = */ checkedge4encroach(encloop);
+ snextself(*encloop);
+ /* dummy = */ checkedge4encroach(encloop);
+
+ badsegmentdealloc(encloop);
+ encloop = badsegmenttraverse();
+ }
+ }
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* tallyfaces() Test every triangle in the mesh for quality measures. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void tallyfaces()
+{
+ struct triedge triangleloop;
+
+ if (verbose) {
+ printf(" Making a list of bad triangles.\n");
+ }
+ traversalinit(&triangles);
+ triangleloop.orient = 0;
+ triangleloop.tri = triangletraverse();
+ while (triangleloop.tri != (triangle *) NULL) {
+ /* If the triangle is bad, enqueue it. */
+ testtriangle(&triangleloop);
+ triangleloop.tri = triangletraverse();
+ }
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* findcircumcenter() Find the circumcenter of a triangle. */
+/* */
+/* The result is returned both in terms of x-y coordinates and xi-eta */
+/* coordinates. The xi-eta coordinate system is defined in terms of the */
+/* triangle: the origin of the triangle is the origin of the coordinate */
+/* system; the destination of the triangle is one unit along the xi axis; */
+/* and the apex of the triangle is one unit along the eta axis. */
+/* */
+/* The return value indicates which edge of the triangle is shortest. */
+/* */
+/*****************************************************************************/
+
+enum circumcenterresult findcircumcenter(torg, tdest, tapex, circumcenter, xi, eta)
+point torg;
+point tdest;
+point tapex;
+point circumcenter;
+REAL *xi;
+REAL *eta;
+{
+ REAL xdo, ydo, xao, yao, xad, yad;
+ REAL dodist, aodist, addist;
+ REAL denominator;
+ REAL dx, dy;
+
+ circumcentercount++;
+
+ /* Compute the circumcenter of the triangle. */
+ xdo = tdest[0] - torg[0];
+ ydo = tdest[1] - torg[1];
+ xao = tapex[0] - torg[0];
+ yao = tapex[1] - torg[1];
+ dodist = xdo * xdo + ydo * ydo;
+ aodist = xao * xao + yao * yao;
+ if (noexact) {
+ denominator = 0.5 / (xdo * yao - xao * ydo);
+ } else {
+ /* Use the counterclockwise() routine to ensure a positive (and */
+ /* reasonably accurate) result, avoiding any possibility of */
+ /* division by zero. */
+ denominator = 0.5 / counterclockwise(tdest, tapex, torg);
+ /* Don't count the above as an orientation test. */
+ counterclockcount--;
+ }
+ circumcenter[0] = torg[0] - (ydo * aodist - yao * dodist) * denominator;
+ circumcenter[1] = torg[1] + (xdo * aodist - xao * dodist) * denominator;
+
+ /* To interpolate point attributes for the new point inserted at */
+ /* the circumcenter, define a coordinate system with a xi-axis, */
+ /* directed from the triangle's origin to its destination, and */
+ /* an eta-axis, directed from its origin to its apex. */
+ /* Calculate the xi and eta coordinates of the circumcenter. */
+ dx = circumcenter[0] - torg[0];
+ dy = circumcenter[1] - torg[1];
+ *xi = (dx * yao - xao * dy) * (2.0 * denominator);
+ *eta = (xdo * dy - dx * ydo) * (2.0 * denominator);
+
+ xad = tapex[0] - tdest[0];
+ yad = tapex[1] - tdest[1];
+ addist = xad * xad + yad * yad;
+ if ((addist < dodist) && (addist < aodist)) {
+ return OPPOSITEORG;
+ } else if (dodist < aodist) {
+ return OPPOSITEAPEX;
+ } else {
+ return OPPOSITEDEST;
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* splittriangle() Inserts a point at the circumcenter of a triangle. */
+/* Deletes the newly inserted point if it encroaches upon */
+/* a segment. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void splittriangle(badtri)
+struct badface *badtri;
+{
+ point borg, bdest, bapex;
+ point newpoint;
+ REAL xi, eta;
+ enum insertsiteresult success;
+ enum circumcenterresult shortedge;
+ int errorflag;
+ int i;
+
+ org(badtri->badfacetri, borg);
+ dest(badtri->badfacetri, bdest);
+ apex(badtri->badfacetri, bapex);
+ /* Make sure that this triangle is still the same triangle it was */
+ /* when it was tested and determined to be of bad quality. */
+ /* Subsequent transformations may have made it a different triangle. */
+ if ((borg == badtri->faceorg) && (bdest == badtri->facedest) &&
+ (bapex == badtri->faceapex)) {
+ if (verbose > 1) {
+ printf(" Splitting this triangle at its circumcenter:\n");
+ printf(" (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n", borg[0],
+ borg[1], bdest[0], bdest[1], bapex[0], bapex[1]);
+ }
+ errorflag = 0;
+ /* Create a new point at the triangle's circumcenter. */
+ newpoint = (point) poolalloc(&points);
+ shortedge = findcircumcenter(borg, bdest, bapex, newpoint, &xi, &eta);
+ /* Check whether the new point lies on a triangle vertex. */
+ if (((newpoint[0] == borg[0]) && (newpoint[1] == borg[1]))
+ || ((newpoint[0] == bdest[0]) && (newpoint[1] == bdest[1]))
+ || ((newpoint[0] == bapex[0]) && (newpoint[1] == bapex[1]))) {
+ if (!quiet) {
+ printf("Warning: New point (%.12g, %.12g) falls on existing vertex.\n"
+ , newpoint[0], newpoint[1]);
+ errorflag = 1;
+ }
+ pointdealloc(newpoint);
+ } else {
+ for (i = 2; i < 2 + nextras; i++) {
+ /* Interpolate the point attributes at the circumcenter. */
+ newpoint[i] = borg[i] + xi * (bdest[i] - borg[i])
+ + eta * (bapex[i] - borg[i]);
+ }
+ /* The new point must be in the interior, and have a marker of zero. */
+ setpointmark(newpoint, 0);
+ /* Ensure that the handle `badtri->badfacetri' represents the shortest */
+ /* edge of the triangle. This ensures that the circumcenter must */
+ /* fall to the left of this edge, so point location will work. */
+ if (shortedge == OPPOSITEORG) {
+ lnextself(badtri->badfacetri);
+ } else if (shortedge == OPPOSITEDEST) {
+ lprevself(badtri->badfacetri);
+ }
+ /* Insert the circumcenter, searching from the edge of the triangle, */
+ /* and maintain the Delaunay property of the triangulation. */
+ success = insertsite(newpoint, &(badtri->badfacetri),
+ (struct edge *) NULL, 1, 1);
+ if (success == SUCCESSFULPOINT) {
+ if (steinerleft > 0) {
+ steinerleft--;
+ }
+ } else if (success == ENCROACHINGPOINT) {
+ /* If the newly inserted point encroaches upon a segment, delete it. */
+ deletesite(&(badtri->badfacetri));
+ } else if (success == VIOLATINGPOINT) {
+ /* Failed to insert the new point, but some segment was */
+ /* marked as being encroached. */
+ pointdealloc(newpoint);
+ } else { /* success == DUPLICATEPOINT */
+ /* Failed to insert the new point because a vertex is already there. */
+ if (!quiet) {
+ printf("Warning: New point (%.12g, %.12g) falls on existing vertex.\n",
+ newpoint[0], newpoint[1]);
+ errorflag = 1;
+ }
+ pointdealloc(newpoint);
+ }
+ }
+ if (errorflag) {
+ if (verbose) {
+ printf(" The new point is at the circumcenter of triangle\n");
+ printf(" (%.12g, %.12g) (%.12g, %.12g) (%.12g, %.12g)\n",
+ borg[0], borg[1], bdest[0], bdest[1], bapex[0], bapex[1]);
+ }
+ printf("This probably means that I am trying to refine triangles\n");
+ printf(" to a smaller size than can be accommodated by the finite\n");
+ printf(" precision of floating point arithmetic. (You can be\n");
+ printf(" sure of this if I fail to terminate.)\n");
+ precisionerror();
+ }
+ }
+ /* Return the bad triangle to the pool. */
+ pooldealloc(&badtriangles, (VOID *) badtri);
+}
+
+#endif /* not CDT_ONLY */
+
+/*****************************************************************************/
+/* */
+/* enforcequality() Remove all the encroached edges and bad triangles */
+/* from the triangulation. */
+/* */
+/*****************************************************************************/
+
+#ifndef CDT_ONLY
+
+void enforcequality()
+{
+ int i;
+
+ if (!quiet) {
+ printf("Adding Steiner points to enforce quality.\n");
+ }
+ /* Initialize the pool of encroached segments. */
+ poolinit(&badsegments, sizeof(struct edge), BADSEGMENTPERBLOCK, POINTER, 0);
+ if (verbose) {
+ printf(" Looking for encroached segments.\n");
+ }
+ /* Test all segments to see if they're encroached. */
+ tallyencs();
+ if (verbose && (badsegments.items > 0)) {
+ printf(" Splitting encroached segments.\n");
+ }
+ /* Note that steinerleft == -1 if an unlimited number */
+ /* of Steiner points is allowed. */
+ while ((badsegments.items > 0) && (steinerleft != 0)) {
+ /* Fix the segments without noting newly encroached segments or */
+ /* bad triangles. The reason we don't want to note newly */
+ /* encroached segments is because some encroached segments are */
+ /* likely to be noted multiple times, and would then be blindly */
+ /* split multiple times. I should fix that some time. */
+ repairencs(0);
+ /* Now, find all the segments that became encroached while adding */
+ /* points to split encroached segments. */
+ tallyencs();
+ }
+ /* At this point, if we haven't run out of Steiner points, the */
+ /* triangulation should be (conforming) Delaunay. */
+
+ /* Next, we worry about enforcing triangle quality. */
+ if ((minangle > 0.0) || vararea || fixedarea) {
+ /* Initialize the pool of bad triangles. */
+ poolinit(&badtriangles, sizeof(struct badface), BADTRIPERBLOCK, POINTER,
+ 0);
+ /* Initialize the queues of bad triangles. */
+ for (i = 0; i < 64; i++) {
+ queuefront[i] = (struct badface *) NULL;
+ queuetail[i] = &queuefront[i];
+ }
+ /* Test all triangles to see if they're bad. */
+ tallyfaces();
+ if (verbose) {
+ printf(" Splitting bad triangles.\n");
+ }
+ while ((badtriangles.items > 0) && (steinerleft != 0)) {
+ /* Fix one bad triangle by inserting a point at its circumcenter. */
+ splittriangle(dequeuebadtri());
+ /* Fix any encroached segments that may have resulted. Record */
+ /* any new bad triangles or encroached segments that result. */
+ if (badsegments.items > 0) {
+ repairencs(1);
+ }
+ }
+ }
+ /* At this point, if we haven't run out of Steiner points, the */
+ /* triangulation should be (conforming) Delaunay and have no */
+ /* low-quality triangles. */
+
+ /* Might we have run out of Steiner points too soon? */
+ if (!quiet && (badsegments.items > 0) && (steinerleft == 0)) {
+ printf("\nWarning: I ran out of Steiner points, but the mesh has\n");
+ if (badsegments.items == 1) {
+ printf(" an encroached segment, and therefore might not be truly\n");
+ } else {
+ printf(" %ld encroached segments, and therefore might not be truly\n",
+ badsegments.items);
+ }
+ printf(" Delaunay. If the Delaunay property is important to you,\n");
+ printf(" try increasing the number of Steiner points (controlled by\n");
+ printf(" the -S switch) slightly and try again.\n\n");
+ }
+}
+
+#endif /* not CDT_ONLY */
+
+/** **/
+/** **/
+/********* Mesh quality maintenance ends here *********/
+
+/*****************************************************************************/
+/* */
+/* highorder() Create extra nodes for quadratic subparametric elements. */
+/* */
+/*****************************************************************************/
+
+void highorder()
+{
+ struct triedge triangleloop, trisym;
+ struct edge checkmark;
+ point newpoint;
+ point torg, tdest;
+ int i;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+ if (!quiet) {
+ printf("Adding vertices for second-order triangles.\n");
+ }
+ /* The following line ensures that dead items in the pool of nodes */
+ /* cannot be allocated for the extra nodes associated with high */
+ /* order elements. This ensures that the primary nodes (at the */
+ /* corners of elements) will occur earlier in the output files, and */
+ /* have lower indices, than the extra nodes. */
+ points.deaditemstack = (VOID *) NULL;
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ /* To loop over the set of edges, loop over all triangles, and look at */
+ /* the three edges of each triangle. If there isn't another triangle */
+ /* adjacent to the edge, operate on the edge. If there is another */
+ /* adjacent triangle, operate on the edge only if the current triangle */
+ /* has a smaller pointer than its neighbor. This way, each edge is */
+ /* considered only once. */
+ while (triangleloop.tri != (triangle *) NULL) {
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ sym(triangleloop, trisym);
+ if ((triangleloop.tri < trisym.tri) || (trisym.tri == dummytri)) {
+ org(triangleloop, torg);
+ dest(triangleloop, tdest);
+ /* Create a new node in the middle of the edge. Interpolate */
+ /* its attributes. */
+ newpoint = (point) poolalloc(&points);
+ for (i = 0; i < 2 + nextras; i++) {
+ newpoint[i] = 0.5 * (torg[i] + tdest[i]);
+ }
+ /* Set the new node's marker to zero or one, depending on */
+ /* whether it lies on a boundary. */
+ setpointmark(newpoint, trisym.tri == dummytri);
+ if (useshelles) {
+ tspivot(triangleloop, checkmark);
+ /* If this edge is a segment, transfer the marker to the new node. */
+ if (checkmark.sh != dummysh) {
+ setpointmark(newpoint, mark(checkmark));
+ }
+ }
+ if (verbose > 1) {
+ printf(" Creating (%.12g, %.12g).\n", newpoint[0], newpoint[1]);
+ }
+ /* Record the new node in the (one or two) adjacent elements. */
+ triangleloop.tri[highorderindex + triangleloop.orient] =
+ (triangle) newpoint;
+ if (trisym.tri != dummytri) {
+ trisym.tri[highorderindex + trisym.orient] = (triangle) newpoint;
+ }
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+}
+
+/********* File I/O routines begin here *********/
+/** **/
+/** **/
+
+/*****************************************************************************/
+/* */
+/* readline() Read a nonempty line from a file. */
+/* */
+/* A line is considered "nonempty" if it contains something that looks like */
+/* a number. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+char *readline(string, infile, infilename)
+char *string;
+FILE *infile;
+char *infilename;
+{
+ char *result;
+
+ /* Search for something that looks like a number. */
+ do {
+ result = fgets(string, INPUTLINESIZE, infile);
+ if (result == (char *) NULL) {
+ printf(" Error: Unexpected end of file in %s.\n", infilename);
+ exit(1);
+ }
+ /* Skip anything that doesn't look like a number, a comment, */
+ /* or the end of a line. */
+ while ((*result != '\0') && (*result != '#')
+ && (*result != '.') && (*result != '+') && (*result != '-')
+ && ((*result < '0') || (*result > '9'))) {
+ result++;
+ }
+ /* If it's a comment or end of line, read another line and try again. */
+ } while ((*result == '#') || (*result == '\0'));
+ return result;
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* findfield() Find the next field of a string. */
+/* */
+/* Jumps past the current field by searching for whitespace, then jumps */
+/* past the whitespace to find the next field. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+char *findfield(string)
+char *string;
+{
+ char *result;
+
+ result = string;
+ /* Skip the current field. Stop upon reaching whitespace. */
+ while ((*result != '\0') && (*result != '#')
+ && (*result != ' ') && (*result != '\t')) {
+ result++;
+ }
+ /* Now skip the whitespace and anything else that doesn't look like a */
+ /* number, a comment, or the end of a line. */
+ while ((*result != '\0') && (*result != '#')
+ && (*result != '.') && (*result != '+') && (*result != '-')
+ && ((*result < '0') || (*result > '9'))) {
+ result++;
+ }
+ /* Check for a comment (prefixed with `#'). */
+ if (*result == '#') {
+ *result = '\0';
+ }
+ return result;
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* readnodes() Read the points from a file, which may be a .node or .poly */
+/* file. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void readnodes(nodefilename, polyfilename, polyfile)
+char *nodefilename;
+char *polyfilename;
+FILE **polyfile;
+{
+ FILE *infile;
+ point pointloop;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ char *infilename;
+ REAL x, y;
+ int firstnode;
+ int nodemarkers;
+ int currentmarker;
+ int i, j;
+
+ if (poly) {
+ /* Read the points from a .poly file. */
+ if (!quiet) {
+ printf("Opening %s.\n", polyfilename);
+ }
+ *polyfile = fopen(polyfilename, "r");
+ if (*polyfile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", polyfilename);
+ exit(1);
+ }
+ /* Read number of points, number of dimensions, number of point */
+ /* attributes, and number of boundary markers. */
+ stringptr = readline(inputline, *polyfile, polyfilename);
+ inpoints = (int) strtol (stringptr, &stringptr, 0);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ mesh_dim = 2;
+ } else {
+ mesh_dim = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nextras = 0;
+ } else {
+ nextras = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nodemarkers = 0;
+ } else {
+ nodemarkers = (int) strtol (stringptr, &stringptr, 0);
+ }
+ if (inpoints > 0) {
+ infile = *polyfile;
+ infilename = polyfilename;
+ readnodefile = 0;
+ } else {
+ /* If the .poly file claims there are zero points, that means that */
+ /* the points should be read from a separate .node file. */
+ readnodefile = 1;
+ infilename = innodefilename;
+ }
+ } else {
+ readnodefile = 1;
+ infilename = innodefilename;
+ *polyfile = (FILE *) NULL;
+ }
+
+ if (readnodefile) {
+ /* Read the points from a .node file. */
+ if (!quiet) {
+ printf("Opening %s.\n", innodefilename);
+ }
+ infile = fopen(innodefilename, "r");
+ if (infile == (FILE *) NULL) {
+ printf(" Error: Cannot access file %s.\n", innodefilename);
+ exit(1);
+ }
+ /* Read number of points, number of dimensions, number of point */
+ /* attributes, and number of boundary markers. */
+ stringptr = readline(inputline, infile, innodefilename);
+ inpoints = (int) strtol (stringptr, &stringptr, 0);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ mesh_dim = 2;
+ } else {
+ mesh_dim = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nextras = 0;
+ } else {
+ nextras = (int) strtol (stringptr, &stringptr, 0);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ nodemarkers = 0;
+ } else {
+ nodemarkers = (int) strtol (stringptr, &stringptr, 0);
+ }
+ }
+
+ if (inpoints < 3) {
+ printf("Error: Input must have at least three input points.\n");
+ exit(1);
+ }
+ if (mesh_dim != 2) {
+ printf("Error: Triangle only works with two-dimensional meshes.\n");
+ exit(1);
+ }
+
+ initializepointpool();
+
+ /* Read the points. */
+ for (i = 0; i < inpoints; i++) {
+ pointloop = (point) poolalloc(&points);
+ stringptr = readline(inputline, infile, infilename);
+ if (i == 0) {
+ firstnode = (int) strtol (stringptr, &stringptr, 0);
+ if ((firstnode == 0) || (firstnode == 1)) {
+ firstnumber = firstnode;
+ }
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Point %d has no x coordinate.\n", firstnumber + i);
+ exit(1);
+ }
+ x = (REAL) strtod(stringptr, &stringptr);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Point %d has no y coordinate.\n", firstnumber + i);
+ exit(1);
+ }
+ y = (REAL) strtod(stringptr, &stringptr);
+ pointloop[0] = x;
+ pointloop[1] = y;
+ /* Read the point attributes. */
+ for (j = 2; j < 2 + nextras; j++) {
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ pointloop[j] = 0.0;
+ } else {
+ pointloop[j] = (REAL) strtod(stringptr, &stringptr);
+ }
+ }
+ if (nodemarkers) {
+ /* Read a point marker. */
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ setpointmark(pointloop, 0);
+ } else {
+ currentmarker = (int) strtol (stringptr, &stringptr, 0);
+ setpointmark(pointloop, currentmarker);
+ }
+ } else {
+ /* If no markers are specified in the file, they default to zero. */
+ setpointmark(pointloop, 0);
+ }
+ /* Determine the smallest and largest x and y coordinates. */
+ if (i == 0) {
+ xmin = xmax = x;
+ ymin = ymax = y;
+ } else {
+ xmin = (x < xmin) ? x : xmin;
+ xmax = (x > xmax) ? x : xmax;
+ ymin = (y < ymin) ? y : ymin;
+ ymax = (y > ymax) ? y : ymax;
+ }
+ }
+ if (readnodefile) {
+ fclose(infile);
+ }
+
+ /* Nonexistent x value used as a flag to mark circle events in sweepline */
+ /* Delaunay algorithm. */
+ xminextreme = 10 * xmin - 9 * xmax;
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* transfernodes() Read the points from memory. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void transfernodes(pointlist, pointattriblist, pointmarkerlist, numberofpoints,
+ numberofpointattribs)
+REAL *pointlist;
+REAL *pointattriblist;
+int *pointmarkerlist;
+int numberofpoints;
+int numberofpointattribs;
+{
+ point pointloop;
+ REAL x, y;
+ int i, j;
+ int coordindex;
+ int attribindex;
+
+ inpoints = numberofpoints;
+ mesh_dim = 2;
+ nextras = numberofpointattribs;
+ readnodefile = 0;
+ if (inpoints < 3) {
+ printf("Error: Input must have at least three input points.\n");
+ exit(1);
+ }
+
+ initializepointpool();
+
+ /* Read the points. */
+ coordindex = 0;
+ attribindex = 0;
+ for (i = 0; i < inpoints; i++) {
+ pointloop = (point) poolalloc(&points);
+ /* Read the point coordinates. */
+ pointloop[0] = pointlist[coordindex++];
+ pointloop[1] = pointlist[coordindex++];
+ /* Read the point attributes. */
+ for (j = 0; j < numberofpointattribs; j++) {
+ pointloop[2 + j] = pointattriblist[attribindex++];
+ }
+ if (pointmarkerlist != (int *) NULL) {
+ /* Read a point marker. */
+ setpointmark(pointloop, pointmarkerlist[i]);
+ } else {
+ /* If no markers are specified, they default to zero. */
+ setpointmark(pointloop, 0);
+ }
+ x = pointloop[0];
+ y = pointloop[1];
+ /* Determine the smallest and largest x and y coordinates. */
+ if (i == 0) {
+ xmin = xmax = x;
+ ymin = ymax = y;
+ } else {
+ xmin = (x < xmin) ? x : xmin;
+ xmax = (x > xmax) ? x : xmax;
+ ymin = (y < ymin) ? y : ymin;
+ ymax = (y > ymax) ? y : ymax;
+ }
+ }
+
+ /* Nonexistent x value used as a flag to mark circle events in sweepline */
+ /* Delaunay algorithm. */
+ xminextreme = 10 * xmin - 9 * xmax;
+}
+
+#endif /* TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* readholes() Read the holes, and possibly regional attributes and area */
+/* constraints, from a .poly file. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void readholes(polyfile, polyfilename, hlist, holes, rlist, regions)
+FILE *polyfile;
+char *polyfilename;
+REAL **hlist;
+int *holes;
+REAL **rlist;
+int *regions;
+{
+ REAL *holelist;
+ REAL *regionlist;
+ char inputline[INPUTLINESIZE];
+ char *stringptr;
+ int index;
+ int i;
+
+ /* Read the holes. */
+ stringptr = readline(inputline, polyfile, polyfilename);
+ *holes = (int) strtol (stringptr, &stringptr, 0);
+ if (*holes > 0) {
+ holelist = (REAL *) malloc(2 * *holes * sizeof(REAL));
+ *hlist = holelist;
+ if (holelist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ for (i = 0; i < 2 * *holes; i += 2) {
+ stringptr = readline(inputline, polyfile, polyfilename);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Hole %d has no x coordinate.\n", firstnumber + (i >> 1));
+ exit(1);
+ } else {
+ holelist[i] = (REAL) strtod(stringptr, &stringptr);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Hole %d has no y coordinate.\n", firstnumber + (i >> 1));
+ exit(1);
+ } else {
+ holelist[i + 1] = (REAL) strtod(stringptr, &stringptr);
+ }
+ }
+ } else {
+ *hlist = (REAL *) NULL;
+ }
+
+#ifndef CDT_ONLY
+ if ((regionattrib || vararea) && !refine) {
+ /* Read the area constraints. */
+ stringptr = readline(inputline, polyfile, polyfilename);
+ *regions = (int) strtol (stringptr, &stringptr, 0);
+ if (*regions > 0) {
+ regionlist = (REAL *) malloc(4 * *regions * sizeof(REAL));
+ *rlist = regionlist;
+ if (regionlist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ index = 0;
+ for (i = 0; i < *regions; i++) {
+ stringptr = readline(inputline, polyfile, polyfilename);
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Region %d has no x coordinate.\n", firstnumber + i);
+ exit(1);
+ } else {
+ regionlist[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Region %d has no y coordinate.\n", firstnumber + i);
+ exit(1);
+ } else {
+ regionlist[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ printf("Error: Region %d has no region attribute or area constraint.\n",
+ firstnumber + i);
+ exit(1);
+ } else {
+ regionlist[index++] = (REAL) strtod(stringptr, &stringptr);
+ }
+ stringptr = findfield(stringptr);
+ if (*stringptr == '\0') {
+ regionlist[index] = regionlist[index - 1];
+ } else {
+ regionlist[index] = (REAL) strtod(stringptr, &stringptr);
+ }
+ index++;
+ }
+ }
+ } else {
+ /* Set `*regions' to zero to avoid an accidental free() later. */
+ *regions = 0;
+ *rlist = (REAL *) NULL;
+ }
+#endif /* not CDT_ONLY */
+
+ fclose(polyfile);
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* finishfile() Write the command line to the output file so the user */
+/* can remember how the file was generated. Close the file. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void finishfile(outfile, argc, argv)
+FILE *outfile;
+int argc;
+char **argv;
+{
+ int i;
+
+ fprintf(outfile, "# Generated by");
+ for (i = 0; i < argc; i++) {
+ fprintf(outfile, " ");
+ fputs(argv[i], outfile);
+ }
+ fprintf(outfile, "\n");
+ fclose(outfile);
+}
+
+#endif /* not TRILIBRARY */
+
+/*****************************************************************************/
+/* */
+/* writenodes() Number the points and write them to a .node file. */
+/* */
+/* To save memory, the point numbers are written over the shell markers */
+/* after the points are written to a file. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void writenodes(pointlist, pointattriblist, pointmarkerlist)
+REAL **pointlist;
+REAL **pointattriblist;
+int **pointmarkerlist;
+
+#else /* not TRILIBRARY */
+
+void writenodes(nodefilename, argc, argv)
+char *nodefilename;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ REAL *plist;
+ REAL *palist;
+ int *pmlist;
+ int coordindex;
+ int attribindex;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+#endif /* not TRILIBRARY */
+ point pointloop;
+ int pointnumber;
+ int i;
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing points.\n");
+ }
+ /* Allocate memory for output points if necessary. */
+ if (*pointlist == (REAL *) NULL) {
+ *pointlist = (REAL *) malloc(points.items * 2 * sizeof(REAL));
+ if (*pointlist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for output point attributes if necessary. */
+ if ((nextras > 0) && (*pointattriblist == (REAL *) NULL)) {
+ *pointattriblist = (REAL *) malloc(points.items * nextras * sizeof(REAL));
+ if (*pointattriblist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for output point markers if necessary. */
+ if (!nobound && (*pointmarkerlist == (int *) NULL)) {
+ *pointmarkerlist = (int *) malloc(points.items * sizeof(int));
+ if (*pointmarkerlist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ plist = *pointlist;
+ palist = *pointattriblist;
+ pmlist = *pointmarkerlist;
+ coordindex = 0;
+ attribindex = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", nodefilename);
+ }
+ outfile = fopen(nodefilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", nodefilename);
+ exit(1);
+ }
+ /* Number of points, number of dimensions, number of point attributes, */
+ /* and number of boundary markers (zero or one). */
+ fprintf(outfile, "%ld %d %d %d\n", points.items, mesh_dim, nextras,
+ 1 - nobound);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&points);
+ pointloop = pointtraverse();
+ pointnumber = firstnumber;
+ while (pointloop != (point) NULL) {
+#ifdef TRILIBRARY
+ /* X and y coordinates. */
+ plist[coordindex++] = pointloop[0];
+ plist[coordindex++] = pointloop[1];
+ /* Point attributes. */
+ for (i = 0; i < nextras; i++) {
+ palist[attribindex++] = pointloop[2 + i];
+ }
+ if (!nobound) {
+ /* Copy the boundary marker. */
+ pmlist[pointnumber - firstnumber] = pointmark(pointloop);
+ }
+#else /* not TRILIBRARY */
+ /* Point number, x and y coordinates. */
+ fprintf(outfile, "%4d %.17g %.17g", pointnumber, pointloop[0],
+ pointloop[1]);
+ for (i = 0; i < nextras; i++) {
+ /* Write an attribute. */
+ fprintf(outfile, " %.17g", pointloop[i + 2]);
+ }
+ if (nobound) {
+ fprintf(outfile, "\n");
+ } else {
+ /* Write the boundary marker. */
+ fprintf(outfile, " %d\n", pointmark(pointloop));
+ }
+#endif /* not TRILIBRARY */
+
+ setpointmark(pointloop, pointnumber);
+ pointloop = pointtraverse();
+ pointnumber++;
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+}
+
+/*****************************************************************************/
+/* */
+/* numbernodes() Number the points. */
+/* */
+/* Each point is assigned a marker equal to its number. */
+/* */
+/* Used when writenodes() is not called because no .node file is written. */
+/* */
+/*****************************************************************************/
+
+void numbernodes()
+{
+ point pointloop;
+ int pointnumber;
+
+ traversalinit(&points);
+ pointloop = pointtraverse();
+ pointnumber = firstnumber;
+ while (pointloop != (point) NULL) {
+ setpointmark(pointloop, pointnumber);
+ pointloop = pointtraverse();
+ pointnumber++;
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* writeelements() Write the triangles to an .ele file. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void writeelements(trianglelist, triangleattriblist)
+int **trianglelist;
+REAL **triangleattriblist;
+
+#else /* not TRILIBRARY */
+
+void writeelements(elefilename, argc, argv)
+char *elefilename;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ int *tlist;
+ REAL *talist;
+ int pointindex;
+ int attribindex;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+#endif /* not TRILIBRARY */
+ struct triedge triangleloop;
+ point p1, p2, p3;
+ point mid1, mid2, mid3;
+ int elementnumber;
+ int i;
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing triangles.\n");
+ }
+ /* Allocate memory for output triangles if necessary. */
+ if (*trianglelist == (int *) NULL) {
+ *trianglelist = (int *) malloc(triangles.items *
+ ((order + 1) * (order + 2) / 2) * sizeof(int));
+ if (*trianglelist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for output triangle attributes if necessary. */
+ if ((eextras > 0) && (*triangleattriblist == (REAL *) NULL)) {
+ *triangleattriblist = (REAL *) malloc(triangles.items * eextras *
+ sizeof(REAL));
+ if (*triangleattriblist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ tlist = *trianglelist;
+ talist = *triangleattriblist;
+ pointindex = 0;
+ attribindex = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", elefilename);
+ }
+ outfile = fopen(elefilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", elefilename);
+ exit(1);
+ }
+ /* Number of triangles, points per triangle, attributes per triangle. */
+ fprintf(outfile, "%ld %d %d\n", triangles.items,
+ (order + 1) * (order + 2) / 2, eextras);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ triangleloop.orient = 0;
+ elementnumber = firstnumber;
+ while (triangleloop.tri != (triangle *) NULL) {
+ org(triangleloop, p1);
+ dest(triangleloop, p2);
+ apex(triangleloop, p3);
+ if (order == 1) {
+#ifdef TRILIBRARY
+ tlist[pointindex++] = pointmark(p1);
+ tlist[pointindex++] = pointmark(p2);
+ tlist[pointindex++] = pointmark(p3);
+#else /* not TRILIBRARY */
+ /* Triangle number, indices for three points. */
+ fprintf(outfile, "%4d %4d %4d %4d", elementnumber,
+ pointmark(p1), pointmark(p2), pointmark(p3));
+#endif /* not TRILIBRARY */
+ } else {
+ mid1 = (point) triangleloop.tri[highorderindex + 1];
+ mid2 = (point) triangleloop.tri[highorderindex + 2];
+ mid3 = (point) triangleloop.tri[highorderindex];
+#ifdef TRILIBRARY
+ tlist[pointindex++] = pointmark(p1);
+ tlist[pointindex++] = pointmark(p2);
+ tlist[pointindex++] = pointmark(p3);
+ tlist[pointindex++] = pointmark(mid1);
+ tlist[pointindex++] = pointmark(mid2);
+ tlist[pointindex++] = pointmark(mid3);
+#else /* not TRILIBRARY */
+ /* Triangle number, indices for six points. */
+ fprintf(outfile, "%4d %4d %4d %4d %4d %4d %4d", elementnumber,
+ pointmark(p1), pointmark(p2), pointmark(p3), pointmark(mid1),
+ pointmark(mid2), pointmark(mid3));
+#endif /* not TRILIBRARY */
+ }
+
+#ifdef TRILIBRARY
+ for (i = 0; i < eextras; i++) {
+ talist[attribindex++] = elemattribute(triangleloop, i);
+ }
+#else /* not TRILIBRARY */
+ for (i = 0; i < eextras; i++) {
+ fprintf(outfile, " %.17g", elemattribute(triangleloop, i));
+ }
+ fprintf(outfile, "\n");
+#endif /* not TRILIBRARY */
+
+ triangleloop.tri = triangletraverse();
+#ifndef TRILIBRARY
+ elementnumber++;
+#endif /* not TRILIBRARY */
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+}
+
+/*****************************************************************************/
+/* */
+/* writepoly() Write the segments and holes to a .poly file. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void writepoly(segmentlist, segmentmarkerlist)
+int **segmentlist;
+int **segmentmarkerlist;
+
+#else /* not TRILIBRARY */
+
+void writepoly(polyfilename, holelist, holes, regionlist, regions, argc, argv)
+char *polyfilename;
+REAL *holelist;
+int holes;
+REAL *regionlist;
+int regions;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ int *slist;
+ int *smlist;
+ int index;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+ int i;
+#endif /* not TRILIBRARY */
+ struct edge shelleloop;
+ point endpoint1, endpoint2;
+ int shellenumber;
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing segments.\n");
+ }
+ /* Allocate memory for output segments if necessary. */
+ if (*segmentlist == (int *) NULL) {
+ *segmentlist = (int *) malloc(shelles.items * 2 * sizeof(int));
+ if (*segmentlist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for output segment markers if necessary. */
+ if (!nobound && (*segmentmarkerlist == (int *) NULL)) {
+ *segmentmarkerlist = (int *) malloc(shelles.items * sizeof(int));
+ if (*segmentmarkerlist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ slist = *segmentlist;
+ smlist = *segmentmarkerlist;
+ index = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", polyfilename);
+ }
+ outfile = fopen(polyfilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", polyfilename);
+ exit(1);
+ }
+ /* The zero indicates that the points are in a separate .node file. */
+ /* Followed by number of dimensions, number of point attributes, */
+ /* and number of boundary markers (zero or one). */
+ fprintf(outfile, "%d %d %d %d\n", 0, mesh_dim, nextras, 1 - nobound);
+ /* Number of segments, number of boundary markers (zero or one). */
+ fprintf(outfile, "%ld %d\n", shelles.items, 1 - nobound);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&shelles);
+ shelleloop.sh = shelletraverse();
+ shelleloop.shorient = 0;
+ shellenumber = firstnumber;
+ while (shelleloop.sh != (shelle *) NULL) {
+ sorg(shelleloop, endpoint1);
+ sdest(shelleloop, endpoint2);
+#ifdef TRILIBRARY
+ /* Copy indices of the segment's two endpoints. */
+ slist[index++] = pointmark(endpoint1);
+ slist[index++] = pointmark(endpoint2);
+ if (!nobound) {
+ /* Copy the boundary marker. */
+ smlist[shellenumber - firstnumber] = mark(shelleloop);
+ }
+#else /* not TRILIBRARY */
+ /* Segment number, indices of its two endpoints, and possibly a marker. */
+ if (nobound) {
+ fprintf(outfile, "%4d %4d %4d\n", shellenumber,
+ pointmark(endpoint1), pointmark(endpoint2));
+ } else {
+ fprintf(outfile, "%4d %4d %4d %4d\n", shellenumber,
+ pointmark(endpoint1), pointmark(endpoint2), mark(shelleloop));
+ }
+#endif /* not TRILIBRARY */
+
+ shelleloop.sh = shelletraverse();
+ shellenumber++;
+ }
+
+#ifndef TRILIBRARY
+#ifndef CDT_ONLY
+ fprintf(outfile, "%d\n", holes);
+ if (holes > 0) {
+ for (i = 0; i < holes; i++) {
+ /* Hole number, x and y coordinates. */
+ fprintf(outfile, "%4d %.17g %.17g\n", firstnumber + i,
+ holelist[2 * i], holelist[2 * i + 1]);
+ }
+ }
+ if (regions > 0) {
+ fprintf(outfile, "%d\n", regions);
+ for (i = 0; i < regions; i++) {
+ /* Region number, x and y coordinates, attribute, maximum area. */
+ fprintf(outfile, "%4d %.17g %.17g %.17g %.17g\n", firstnumber + i,
+ regionlist[4 * i], regionlist[4 * i + 1],
+ regionlist[4 * i + 2], regionlist[4 * i + 3]);
+ }
+ }
+#endif /* not CDT_ONLY */
+
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+}
+
+/*****************************************************************************/
+/* */
+/* writeedges() Write the edges to a .edge file. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void writeedges(edgelist, edgemarkerlist)
+int **edgelist;
+int **edgemarkerlist;
+
+#else /* not TRILIBRARY */
+
+void writeedges(edgefilename, argc, argv)
+char *edgefilename;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ int *elist;
+ int *emlist;
+ int index;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+#endif /* not TRILIBRARY */
+ struct triedge triangleloop, trisym;
+ struct edge checkmark;
+ point p1, p2;
+ int edgenumber;
+ triangle ptr; /* Temporary variable used by sym(). */
+ shelle sptr; /* Temporary variable used by tspivot(). */
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing edges.\n");
+ }
+ /* Allocate memory for edges if necessary. */
+ if (*edgelist == (int *) NULL) {
+ *edgelist = (int *) malloc(edges * 2 * sizeof(int));
+ if (*edgelist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for edge markers if necessary. */
+ if (!nobound && (*edgemarkerlist == (int *) NULL)) {
+ *edgemarkerlist = (int *) malloc(edges * sizeof(int));
+ if (*edgemarkerlist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ elist = *edgelist;
+ emlist = *edgemarkerlist;
+ index = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", edgefilename);
+ }
+ outfile = fopen(edgefilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", edgefilename);
+ exit(1);
+ }
+ /* Number of edges, number of boundary markers (zero or one). */
+ fprintf(outfile, "%ld %d\n", edges, 1 - nobound);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ edgenumber = firstnumber;
+ /* To loop over the set of edges, loop over all triangles, and look at */
+ /* the three edges of each triangle. If there isn't another triangle */
+ /* adjacent to the edge, operate on the edge. If there is another */
+ /* adjacent triangle, operate on the edge only if the current triangle */
+ /* has a smaller pointer than its neighbor. This way, each edge is */
+ /* considered only once. */
+ while (triangleloop.tri != (triangle *) NULL) {
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ sym(triangleloop, trisym);
+ if ((triangleloop.tri < trisym.tri) || (trisym.tri == dummytri)) {
+ org(triangleloop, p1);
+ dest(triangleloop, p2);
+#ifdef TRILIBRARY
+ elist[index++] = pointmark(p1);
+ elist[index++] = pointmark(p2);
+#endif /* TRILIBRARY */
+ if (nobound) {
+#ifndef TRILIBRARY
+ /* Edge number, indices of two endpoints. */
+ fprintf(outfile, "%4d %d %d\n", edgenumber,
+ pointmark(p1), pointmark(p2));
+#endif /* not TRILIBRARY */
+ } else {
+ /* Edge number, indices of two endpoints, and a boundary marker. */
+ /* If there's no shell edge, the boundary marker is zero. */
+ if (useshelles) {
+ tspivot(triangleloop, checkmark);
+ if (checkmark.sh == dummysh) {
+#ifdef TRILIBRARY
+ emlist[edgenumber - firstnumber] = 0;
+#else /* not TRILIBRARY */
+ fprintf(outfile, "%4d %d %d %d\n", edgenumber,
+ pointmark(p1), pointmark(p2), 0);
+#endif /* not TRILIBRARY */
+ } else {
+#ifdef TRILIBRARY
+ emlist[edgenumber - firstnumber] = mark(checkmark);
+#else /* not TRILIBRARY */
+ fprintf(outfile, "%4d %d %d %d\n", edgenumber,
+ pointmark(p1), pointmark(p2), mark(checkmark));
+#endif /* not TRILIBRARY */
+ }
+ } else {
+#ifdef TRILIBRARY
+ emlist[edgenumber - firstnumber] = trisym.tri == dummytri;
+#else /* not TRILIBRARY */
+ fprintf(outfile, "%4d %d %d %d\n", edgenumber,
+ pointmark(p1), pointmark(p2), trisym.tri == dummytri);
+#endif /* not TRILIBRARY */
+ }
+ }
+ edgenumber++;
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+}
+
+/*****************************************************************************/
+/* */
+/* writevoronoi() Write the Voronoi diagram to a .v.node and .v.edge */
+/* file. */
+/* */
+/* The Voronoi diagram is the geometric dual of the Delaunay triangulation. */
+/* Hence, the Voronoi vertices are listed by traversing the Delaunay */
+/* triangles, and the Voronoi edges are listed by traversing the Delaunay */
+/* edges. */
+/* */
+/* WARNING: In order to assign numbers to the Voronoi vertices, this */
+/* procedure messes up the shell edges or the extra nodes of every */
+/* element. Hence, you should call this procedure last. */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void writevoronoi(vpointlist, vpointattriblist, vpointmarkerlist, vedgelist,
+ vedgemarkerlist, vnormlist)
+REAL **vpointlist;
+REAL **vpointattriblist;
+int **vpointmarkerlist;
+int **vedgelist;
+int **vedgemarkerlist;
+REAL **vnormlist;
+
+#else /* not TRILIBRARY */
+
+void writevoronoi(vnodefilename, vedgefilename, argc, argv)
+char *vnodefilename;
+char *vedgefilename;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ REAL *plist;
+ REAL *palist;
+ int *elist;
+ REAL *normlist;
+ int coordindex;
+ int attribindex;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+#endif /* not TRILIBRARY */
+ struct triedge triangleloop, trisym;
+ point torg, tdest, tapex;
+ REAL circumcenter[2];
+ REAL xi, eta;
+ int vnodenumber, vedgenumber;
+ int p1, p2;
+ int i;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing Voronoi vertices.\n");
+ }
+ /* Allocate memory for Voronoi vertices if necessary. */
+ if (*vpointlist == (REAL *) NULL) {
+ *vpointlist = (REAL *) malloc(triangles.items * 2 * sizeof(REAL));
+ if (*vpointlist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ /* Allocate memory for Voronoi vertex attributes if necessary. */
+ if (*vpointattriblist == (REAL *) NULL) {
+ *vpointattriblist = (REAL *) malloc(triangles.items * nextras *
+ sizeof(REAL));
+ if (*vpointattriblist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ *vpointmarkerlist = (int *) NULL;
+ plist = *vpointlist;
+ palist = *vpointattriblist;
+ coordindex = 0;
+ attribindex = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", vnodefilename);
+ }
+ outfile = fopen(vnodefilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", vnodefilename);
+ exit(1);
+ }
+ /* Number of triangles, two dimensions, number of point attributes, */
+ /* zero markers. */
+ fprintf(outfile, "%ld %d %d %d\n", triangles.items, 2, nextras, 0);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ triangleloop.orient = 0;
+ vnodenumber = firstnumber;
+ while (triangleloop.tri != (triangle *) NULL) {
+ org(triangleloop, torg);
+ dest(triangleloop, tdest);
+ apex(triangleloop, tapex);
+ findcircumcenter(torg, tdest, tapex, circumcenter, &xi, &eta);
+#ifdef TRILIBRARY
+ /* X and y coordinates. */
+ plist[coordindex++] = circumcenter[0];
+ plist[coordindex++] = circumcenter[1];
+ for (i = 2; i < 2 + nextras; i++) {
+ /* Interpolate the point attributes at the circumcenter. */
+ palist[attribindex++] = torg[i] + xi * (tdest[i] - torg[i])
+ + eta * (tapex[i] - torg[i]);
+ }
+#else /* not TRILIBRARY */
+ /* Voronoi vertex number, x and y coordinates. */
+ fprintf(outfile, "%4d %.17g %.17g",
+ vnodenumber, circumcenter[0], circumcenter[1]);
+ for (i = 2; i < 2 + nextras; i++) {
+ /* Interpolate the point attributes at the circumcenter. */
+ fprintf(outfile, " %.17g", torg[i] + xi * (tdest[i] - torg[i])
+ + eta * (tapex[i] - torg[i]));
+ }
+ fprintf(outfile, "\n");
+#endif /* not TRILIBRARY */
+
+ * (int *) (triangleloop.tri + 6) = vnodenumber;
+ triangleloop.tri = triangletraverse();
+ vnodenumber++;
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing Voronoi edges.\n");
+ }
+ /* Allocate memory for output Voronoi edges if necessary. */
+ if (*vedgelist == (int *) NULL) {
+ *vedgelist = (int *) malloc(edges * 2 * sizeof(int));
+ if (*vedgelist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ *vedgemarkerlist = (int *) NULL;
+ /* Allocate memory for output Voronoi norms if necessary. */
+ if (*vnormlist == (REAL *) NULL) {
+ *vnormlist = (REAL *) malloc(edges * 2 * sizeof(REAL));
+ if (*vnormlist == (REAL *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ elist = *vedgelist;
+ normlist = *vnormlist;
+ coordindex = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", vedgefilename);
+ }
+ outfile = fopen(vedgefilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", vedgefilename);
+ exit(1);
+ }
+ /* Number of edges, zero boundary markers. */
+ fprintf(outfile, "%ld %d\n", edges, 0);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ vedgenumber = firstnumber;
+ /* To loop over the set of edges, loop over all triangles, and look at */
+ /* the three edges of each triangle. If there isn't another triangle */
+ /* adjacent to the edge, operate on the edge. If there is another */
+ /* adjacent triangle, operate on the edge only if the current triangle */
+ /* has a smaller pointer than its neighbor. This way, each edge is */
+ /* considered only once. */
+ while (triangleloop.tri != (triangle *) NULL) {
+ for (triangleloop.orient = 0; triangleloop.orient < 3; triangleloop.orient++) {
+ sym(triangleloop, trisym);
+ if ((triangleloop.tri < trisym.tri) || (trisym.tri == dummytri)) {
+ /* Find the number of this triangle (and Voronoi vertex). */
+ p1 = * (int *) (triangleloop.tri + 6);
+ if (trisym.tri == dummytri) {
+ org(triangleloop, torg);
+ dest(triangleloop, tdest);
+#ifdef TRILIBRARY
+ /* Copy an infinite ray. Index of one endpoint, and -1. */
+ elist[coordindex] = p1;
+ normlist[coordindex++] = tdest[1] - torg[1];
+ elist[coordindex] = -1;
+ normlist[coordindex++] = torg[0] - tdest[0];
+#else /* not TRILIBRARY */
+ /* Write an infinite ray. Edge number, index of one endpoint, -1, */
+ /* and x and y coordinates of a vector representing the */
+ /* direction of the ray. */
+ fprintf(outfile, "%4d %d %d %.17g %.17g\n", vedgenumber,
+ p1, -1, tdest[1] - torg[1], torg[0] - tdest[0]);
+#endif /* not TRILIBRARY */
+ } else {
+ /* Find the number of the adjacent triangle (and Voronoi vertex). */
+ p2 = * (int *) (trisym.tri + 6);
+ /* Finite edge. Write indices of two endpoints. */
+#ifdef TRILIBRARY
+ elist[coordindex] = p1;
+ normlist[coordindex++] = 0.0;
+ elist[coordindex] = p2;
+ normlist[coordindex++] = 0.0;
+#else /* not TRILIBRARY */
+ fprintf(outfile, "%4d %d %d\n", vedgenumber, p1, p2);
+#endif /* not TRILIBRARY */
+ }
+#ifndef TRILIBRARY
+ vedgenumber++;
+#endif /* not TRILIBRARY */
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* not TRILIBRARY */
+}
+
+#ifdef TRILIBRARY
+
+void writeneighbors(neighborlist)
+int **neighborlist;
+
+#else /* not TRILIBRARY */
+
+void writeneighbors(neighborfilename, argc, argv)
+char *neighborfilename;
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+#ifdef TRILIBRARY
+ int *nlist;
+ int index;
+#else /* not TRILIBRARY */
+ FILE *outfile;
+#endif /* not TRILIBRARY */
+ struct triedge triangleloop, trisym;
+ int elementnumber;
+ int neighbor1, neighbor2, neighbor3;
+ triangle ptr; /* Temporary variable used by sym(). */
+
+#ifdef TRILIBRARY
+ if (!quiet) {
+ printf("Writing neighbors.\n");
+ }
+ /* Allocate memory for neighbors if necessary. */
+ if (*neighborlist == (int *) NULL) {
+ *neighborlist = (int *) malloc(triangles.items * 3 * sizeof(int));
+ if (*neighborlist == (int *) NULL) {
+ printf("Error: Out of memory.\n");
+ exit(1);
+ }
+ }
+ nlist = *neighborlist;
+ index = 0;
+#else /* not TRILIBRARY */
+ if (!quiet) {
+ printf("Writing %s.\n", neighborfilename);
+ }
+ outfile = fopen(neighborfilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", neighborfilename);
+ exit(1);
+ }
+ /* Number of triangles, three edges per triangle. */
+ fprintf(outfile, "%ld %d\n", triangles.items, 3);
+#endif /* not TRILIBRARY */
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ triangleloop.orient = 0;
+ elementnumber = firstnumber;
+ while (triangleloop.tri != (triangle *) NULL) {
+ * (int *) (triangleloop.tri + 6) = elementnumber;
+ triangleloop.tri = triangletraverse();
+ elementnumber++;
+ }
+ * (int *) (dummytri + 6) = -1;
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ elementnumber = firstnumber;
+ while (triangleloop.tri != (triangle *) NULL) {
+ triangleloop.orient = 1;
+ sym(triangleloop, trisym);
+ neighbor1 = * (int *) (trisym.tri + 6);
+ triangleloop.orient = 2;
+ sym(triangleloop, trisym);
+ neighbor2 = * (int *) (trisym.tri + 6);
+ triangleloop.orient = 0;
+ sym(triangleloop, trisym);
+ neighbor3 = * (int *) (trisym.tri + 6);
+#ifdef TRILIBRARY
+ nlist[index++] = neighbor1;
+ nlist[index++] = neighbor2;
+ nlist[index++] = neighbor3;
+#else /* not TRILIBRARY */
+ /* Triangle number, neighboring triangle numbers. */
+ fprintf(outfile, "%4d %d %d %d\n", elementnumber,
+ neighbor1, neighbor2, neighbor3);
+#endif /* not TRILIBRARY */
+
+ triangleloop.tri = triangletraverse();
+#ifndef TRILIBRARY
+ elementnumber++;
+#endif /* not TRILIBRARY */
+ }
+
+#ifndef TRILIBRARY
+ finishfile(outfile, argc, argv);
+#endif /* TRILIBRARY */
+}
+
+/*****************************************************************************/
+/* */
+/* writeoff() Write the triangulation to an .off file. */
+/* */
+/* OFF stands for the Object File Format, a format used by the Geometry */
+/* Center's Geomview package. */
+/* */
+/*****************************************************************************/
+
+#ifndef TRILIBRARY
+
+void writeoff(offfilename, argc, argv)
+char *offfilename;
+int argc;
+char **argv;
+{
+ FILE *outfile;
+ struct triedge triangleloop;
+ point pointloop;
+ point p1, p2, p3;
+
+ if (!quiet) {
+ printf("Writing %s.\n", offfilename);
+ }
+ outfile = fopen(offfilename, "w");
+ if (outfile == (FILE *) NULL) {
+ printf(" Error: Cannot create file %s.\n", offfilename);
+ exit(1);
+ }
+ /* Number of points, triangles, and edges. */
+ fprintf(outfile, "OFF\n%ld %ld %ld\n", points.items, triangles.items, edges);
+
+ /* Write the points. */
+ traversalinit(&points);
+ pointloop = pointtraverse();
+ while (pointloop != (point) NULL) {
+ /* The "0.0" is here because the OFF format uses 3D coordinates. */
+ fprintf(outfile, " %.17g %.17g %.17g\n", pointloop[0], pointloop[1], 0.0);
+ pointloop = pointtraverse();
+ }
+
+ /* Write the triangles. */
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ triangleloop.orient = 0;
+ while (triangleloop.tri != (triangle *) NULL) {
+ org(triangleloop, p1);
+ dest(triangleloop, p2);
+ apex(triangleloop, p3);
+ /* The "3" means a three-vertex polygon. */
+ fprintf(outfile, " 3 %4d %4d %4d\n", pointmark(p1) - 1,
+ pointmark(p2) - 1, pointmark(p3) - 1);
+ triangleloop.tri = triangletraverse();
+ }
+ finishfile(outfile, argc, argv);
+}
+
+#endif /* not TRILIBRARY */
+
+/** **/
+/** **/
+/********* File I/O routines end here *********/
+
+/*****************************************************************************/
+/* */
+/* quality_statistics() Print statistics about the quality of the mesh. */
+/* */
+/*****************************************************************************/
+
+void quality_statistics()
+{
+ struct triedge triangleloop;
+ point p[3];
+ REAL cossquaretable[8];
+ REAL ratiotable[16];
+ REAL dx[3], dy[3];
+ REAL edgelength[3];
+ REAL dotproduct;
+ REAL cossquare;
+ REAL triarea;
+ REAL shortest, longest;
+ REAL trilongest2;
+ REAL smallestarea, biggestarea;
+ REAL triminaltitude2;
+ REAL minaltitude;
+ REAL triaspect2;
+ REAL worstaspect;
+ REAL smallestangle, biggestangle;
+ REAL radconst, degconst;
+ int angletable[18];
+ int aspecttable[16];
+ int aspectindex;
+ int tendegree;
+ int acutebiggest;
+ int i, ii, j, k;
+
+ printf("Mesh quality statistics:\n\n");
+ radconst = PI / 18.0;
+ degconst = 180.0 / PI;
+ for (i = 0; i < 8; i++) {
+ cossquaretable[i] = cos(radconst * (REAL) (i + 1));
+ cossquaretable[i] = cossquaretable[i] * cossquaretable[i];
+ }
+ for (i = 0; i < 18; i++) {
+ angletable[i] = 0;
+ }
+
+ ratiotable[0] = 1.5; ratiotable[1] = 2.0;
+ ratiotable[2] = 2.5; ratiotable[3] = 3.0;
+ ratiotable[4] = 4.0; ratiotable[5] = 6.0;
+ ratiotable[6] = 10.0; ratiotable[7] = 15.0;
+ ratiotable[8] = 25.0; ratiotable[9] = 50.0;
+ ratiotable[10] = 100.0; ratiotable[11] = 300.0;
+ ratiotable[12] = 1000.0; ratiotable[13] = 10000.0;
+ ratiotable[14] = 100000.0; ratiotable[15] = 0.0;
+ for (i = 0; i < 16; i++) {
+ aspecttable[i] = 0;
+ }
+
+ worstaspect = 0.0;
+ minaltitude = xmax - xmin + ymax - ymin;
+ minaltitude = minaltitude * minaltitude;
+ shortest = minaltitude;
+ longest = 0.0;
+ smallestarea = minaltitude;
+ biggestarea = 0.0;
+ smallestangle = 0.0;
+ biggestangle = 2.0;
+ acutebiggest = 1;
+
+ traversalinit(&triangles);
+ triangleloop.tri = triangletraverse();
+ triangleloop.orient = 0;
+ while (triangleloop.tri != (triangle *) NULL) {
+ org(triangleloop, p[0]);
+ dest(triangleloop, p[1]);
+ apex(triangleloop, p[2]);
+ trilongest2 = 0.0;
+
+ for (i = 0; i < 3; i++) {
+ j = plus1mod3[i];
+ k = minus1mod3[i];
+ dx[i] = p[j][0] - p[k][0];
+ dy[i] = p[j][1] - p[k][1];
+ edgelength[i] = dx[i] * dx[i] + dy[i] * dy[i];
+ if (edgelength[i] > trilongest2) {
+ trilongest2 = edgelength[i];
+ }
+ if (edgelength[i] > longest) {
+ longest = edgelength[i];
+ }
+ if (edgelength[i] < shortest) {
+ shortest = edgelength[i];
+ }
+ }
+
+ triarea = counterclockwise(p[0], p[1], p[2]);
+ if (triarea < smallestarea) {
+ smallestarea = triarea;
+ }
+ if (triarea > biggestarea) {
+ biggestarea = triarea;
+ }
+ triminaltitude2 = triarea * triarea / trilongest2;
+ if (triminaltitude2 < minaltitude) {
+ minaltitude = triminaltitude2;
+ }
+ triaspect2 = trilongest2 / triminaltitude2;
+ if (triaspect2 > worstaspect) {
+ worstaspect = triaspect2;
+ }
+ aspectindex = 0;
+ while ((triaspect2 > ratiotable[aspectindex] * ratiotable[aspectindex])
+ && (aspectindex < 15)) {
+ aspectindex++;
+ }
+ aspecttable[aspectindex]++;
+
+ for (i = 0; i < 3; i++) {
+ j = plus1mod3[i];
+ k = minus1mod3[i];
+ dotproduct = dx[j] * dx[k] + dy[j] * dy[k];
+ cossquare = dotproduct * dotproduct / (edgelength[j] * edgelength[k]);
+ tendegree = 8;
+ for (ii = 7; ii >= 0; ii--) {
+ if (cossquare > cossquaretable[ii]) {
+ tendegree = ii;
+ }
+ }
+ if (dotproduct <= 0.0) {
+ angletable[tendegree]++;
+ if (cossquare > smallestangle) {
+ smallestangle = cossquare;
+ }
+ if (acutebiggest && (cossquare < biggestangle)) {
+ biggestangle = cossquare;
+ }
+ } else {
+ angletable[17 - tendegree]++;
+ if (acutebiggest || (cossquare > biggestangle)) {
+ biggestangle = cossquare;
+ acutebiggest = 0;
+ }
+ }
+ }
+ triangleloop.tri = triangletraverse();
+ }
+
+ shortest = sqrt(shortest);
+ longest = sqrt(longest);
+ minaltitude = sqrt(minaltitude);
+ worstaspect = sqrt(worstaspect);
+ smallestarea *= 2.0;
+ biggestarea *= 2.0;
+ if (smallestangle >= 1.0) {
+ smallestangle = 0.0;
+ } else {
+ smallestangle = degconst * acos(sqrt(smallestangle));
+ }
+ if (biggestangle >= 1.0) {
+ biggestangle = 180.0;
+ } else {
+ if (acutebiggest) {
+ biggestangle = degconst * acos(sqrt(biggestangle));
+ } else {
+ biggestangle = 180.0 - degconst * acos(sqrt(biggestangle));
+ }
+ }
+
+ printf(" Smallest area: %16.5g | Largest area: %16.5g\n", smallestarea, biggestarea);
+ printf(" Shortest edge: %16.5g | Longest edge: %16.5g\n", shortest, longest);
+ printf(" Shortest altitude: %12.5g | Largest aspect ratio: %8.5g\n\n", minaltitude, worstaspect);
+ printf(" Aspect ratio histogram:\n");
+ printf(" 1.1547 - %-6.6g : %8d | %6.6g - %-6.6g : %8d\n",
+ ratiotable[0], aspecttable[0], ratiotable[7], ratiotable[8], aspecttable[8]);
+ for (i = 1; i < 7; i++) {
+ printf(" %6.6g - %-6.6g : %8d | %6.6g - %-6.6g : %8d\n",
+ ratiotable[i - 1], ratiotable[i], aspecttable[i], ratiotable[i + 7], ratiotable[i + 8], aspecttable[i + 8]);
+ }
+ printf(" %6.6g - %-6.6g : %8d | %6.6g - : %8d\n",
+ ratiotable[6], ratiotable[7], aspecttable[7], ratiotable[14], aspecttable[15]);
+ printf(" (Triangle aspect ratio is longest edge divided by shortest altitude)\n\n");
+ printf(" Smallest angle: %15.5g | Largest angle: %15.5g\n\n", smallestangle, biggestangle);
+ printf(" Angle histogram:\n");
+ for (i = 0; i < 9; i++) {
+ printf(" %3d - %3d degrees: %8d | %3d - %3d degrees: %8d\n",
+ i * 10, i * 10 + 10, angletable[i], i * 10 + 90, i * 10 + 100, angletable[i + 9]);
+ }
+ printf("\n");
+}
+
+/*****************************************************************************/
+/* */
+/* statistics() Print all sorts of cool facts. */
+/* */
+/*****************************************************************************/
+
+void statistics()
+{
+ printf("\nStatistics:\n\n");
+ printf(" Input points: %d\n", inpoints);
+ if (refine) {
+ printf(" Input triangles: %d\n", inelements);
+ }
+ if (poly) {
+ printf(" Input segments: %d\n", insegments);
+ if (!refine) {
+ printf(" Input holes: %d\n", holes);
+ }
+ }
+
+ printf("\n Mesh points: %ld\n", points.items);
+ printf(" Mesh triangles: %ld\n", triangles.items);
+ printf(" Mesh edges: %ld\n", edges);
+ if (poly || refine) {
+ printf(" Mesh boundary edges: %ld\n", hullsize);
+ printf(" Mesh segments: %ld\n\n", shelles.items);
+ } else {
+ printf(" Mesh convex hull edges: %ld\n\n", hullsize);
+ }
+ if (verbose) {
+ quality_statistics();
+ printf("Memory allocation statistics:\n\n");
+ printf(" Maximum number of points: %ld\n", points.maxitems);
+ printf(" Maximum number of triangles: %ld\n", triangles.maxitems);
+ if (shelles.maxitems > 0) {
+ printf(" Maximum number of segments: %ld\n", shelles.maxitems);
+ }
+ if (viri.maxitems > 0) {
+ printf(" Maximum number of viri: %ld\n", viri.maxitems);
+ }
+ if (badsegments.maxitems > 0) {
+ printf(" Maximum number of encroached segments: %ld\n",
+ badsegments.maxitems);
+ }
+ if (badtriangles.maxitems > 0) {
+ printf(" Maximum number of bad triangles: %ld\n",
+ badtriangles.maxitems);
+ }
+ if (splaynodes.maxitems > 0) {
+ printf(" Maximum number of splay tree nodes: %ld\n",
+ splaynodes.maxitems);
+ }
+ printf(" Approximate heap memory use (bytes): %ld\n\n",
+ points.maxitems * points.itembytes
+ + triangles.maxitems * triangles.itembytes
+ + shelles.maxitems * shelles.itembytes
+ + viri.maxitems * viri.itembytes
+ + badsegments.maxitems * badsegments.itembytes
+ + badtriangles.maxitems * badtriangles.itembytes
+ + splaynodes.maxitems * splaynodes.itembytes);
+
+ printf("Algorithmic statistics:\n\n");
+ printf(" Number of incircle tests: %ld\n", incirclecount);
+ printf(" Number of orientation tests: %ld\n", counterclockcount);
+ if (hyperbolacount > 0) {
+ printf(" Number of right-of-hyperbola tests: %ld\n",
+ hyperbolacount);
+ }
+ if (circumcentercount > 0) {
+ printf(" Number of circumcenter computations: %ld\n",
+ circumcentercount);
+ }
+ if (circletopcount > 0) {
+ printf(" Number of circle top computations: %ld\n",
+ circletopcount);
+ }
+ printf("\n");
+ }
+}
+
+/*****************************************************************************/
+/* */
+/* main() or triangulate() Gosh, do everything. */
+/* */
+/* The sequence is roughly as follows. Many of these steps can be skipped, */
+/* depending on the command line switches. */
+/* */
+/* - Initialize constants and parse the command line. */
+/* - Read the points from a file and either */
+/* - triangulate them (no -r), or */
+/* - read an old mesh from files and reconstruct it (-r). */
+/* - Insert the PSLG segments (-p), and possibly segments on the convex */
+/* hull (-c). */
+/* - Read the holes (-p), regional attributes (-pA), and regional area */
+/* constraints (-pa). Carve the holes and concavities, and spread the */
+/* regional attributes and area constraints. */
+/* - Enforce the constraints on minimum angle (-q) and maximum area (-a). */
+/* Also enforce the conforming Delaunay property (-q and -a). */
+/* - Compute the number of edges in the resulting mesh. */
+/* - Promote the mesh's linear triangles to higher order elements (-o). */
+/* - Write the output files and print the statistics. */
+/* - Check the consistency and Delaunay property of the mesh (-C). */
+/* */
+/*****************************************************************************/
+
+#ifdef TRILIBRARY
+
+void triangulate(triswitches, in, out, vorout)
+const char *triswitches;
+struct triangulateio *in;
+struct triangulateio *out;
+struct triangulateio *vorout;
+
+#else /* not TRILIBRARY */
+
+int main(argc, argv)
+int argc;
+char **argv;
+
+#endif /* not TRILIBRARY */
+
+{
+ REAL *holearray; /* Array of holes. */
+ REAL *regionarray; /* Array of regional attributes and area constraints. */
+#ifndef TRILIBRARY
+ FILE *polyfile;
+#endif /* not TRILIBRARY */
+#ifndef NO_TIMER
+ /* Variables for timing the performance of Triangle. The types are */
+ /* defined in sys/time.h. */
+ struct timeval tv0, tv1, tv2, tv3, tv4, tv5, tv6;
+ struct timezone tz;
+#endif /* NO_TIMER */
+
+#ifndef NO_TIMER
+ gettimeofday(&tv0, &tz);
+#endif /* NO_TIMER */
+
+ triangleinit();
+#ifdef TRILIBRARY
+ parsecommandline(1, &triswitches);
+#else /* not TRILIBRARY */
+ parsecommandline(argc, argv);
+#endif /* not TRILIBRARY */
+
+#ifdef TRILIBRARY
+ transfernodes(in->pointlist, in->pointattributelist, in->pointmarkerlist,
+ in->numberofpoints, in->numberofpointattributes);
+#else /* not TRILIBRARY */
+ readnodes(innodefilename, inpolyfilename, &polyfile);
+#endif /* not TRILIBRARY */
+
+#ifndef NO_TIMER
+ if (!quiet) {
+ gettimeofday(&tv1, &tz);
+ }
+#endif /* NO_TIMER */
+
+#ifdef CDT_ONLY
+ hullsize = delaunay(); /* Triangulate the points. */
+#else /* not CDT_ONLY */
+ if (refine) {
+ /* Read and reconstruct a mesh. */
+#ifdef TRILIBRARY
+ hullsize = reconstruct(in->trianglelist, in->triangleattributelist,
+ in->trianglearealist, in->numberoftriangles,
+ in->numberofcorners, in->numberoftriangleattributes,
+ in->segmentlist, in->segmentmarkerlist,
+ in->numberofsegments);
+#else /* not TRILIBRARY */
+ hullsize = reconstruct(inelefilename, areafilename, inpolyfilename,
+ polyfile);
+#endif /* not TRILIBRARY */
+ } else {
+ hullsize = delaunay(); /* Triangulate the points. */
+ }
+#endif /* not CDT_ONLY */
+
+#ifndef NO_TIMER
+ if (!quiet) {
+ gettimeofday(&tv2, &tz);
+ if (refine) {
+ printf("Mesh reconstruction");
+ } else {
+ printf("Delaunay");
+ }
+ printf(" milliseconds: %ld\n", 1000l * (tv2.tv_sec - tv1.tv_sec)
+ + (tv2.tv_usec - tv1.tv_usec) / 1000l);
+ }
+#endif /* NO_TIMER */
+
+ /* Ensure that no point can be mistaken for a triangular bounding */
+ /* box point in insertsite(). */
+ infpoint1 = (point) NULL;
+ infpoint2 = (point) NULL;
+ infpoint3 = (point) NULL;
+
+ if (useshelles) {
+ checksegments = 1; /* Segments will be introduced next. */
+ if (!refine) {
+ /* Insert PSLG segments and/or convex hull segments. */
+#ifdef TRILIBRARY
+ insegments = formskeleton(in->segmentlist, in->segmentmarkerlist,
+ in->numberofsegments);
+#else /* not TRILIBRARY */
+ insegments = formskeleton(polyfile, inpolyfilename);
+#endif /* not TRILIBRARY */
+ }
+ }
+
+#ifndef NO_TIMER
+ if (!quiet) {
+ gettimeofday(&tv3, &tz);
+ if (useshelles && !refine) {
+ printf("Segment milliseconds: %ld\n",
+ 1000l * (tv3.tv_sec - tv2.tv_sec) + (tv3.tv_usec - tv2.tv_usec) / 1000l);
+ }
+ }
+#endif /* NO_TIMER */
+
+ if (poly) {
+#ifdef TRILIBRARY
+ holearray = in->holelist;
+ holes = in->numberofholes;
+ regionarray = in->regionlist;
+ regions = in->numberofregions;
+#else /* not TRILIBRARY */
+ readholes(polyfile, inpolyfilename, &holearray, &holes,
+ ®ionarray, ®ions);
+#endif /* not TRILIBRARY */
+ if (!refine) {
+ /* Carve out holes and concavities. */
+ carveholes(holearray, holes, regionarray, regions);
+ }
+ } else {
+ /* Without a PSLG, there can be no holes or regional attributes */
+ /* or area constraints. The following are set to zero to avoid */
+ /* an accidental free() later. */
+ holes = 0;
+ regions = 0;
+ }
+
+#ifndef NO_TIMER
+ if (!quiet) {
+ gettimeofday(&tv4, &tz);
+ if (poly && !refine) {
+ printf("Hole milliseconds: %ld\n", 1000l * (tv4.tv_sec - tv3.tv_sec)
+ + (tv4.tv_usec - tv3.tv_usec) / 1000l);
+ }
+ }
+#endif /* NO_TIMER */
+
+#ifndef CDT_ONLY
+ if (quality) {
+ enforcequality(); /* Enforce angle and area constraints. */
+ }
+#endif /* not CDT_ONLY */
+
+#ifndef NO_TIMER
+ if (!quiet) {
+ gettimeofday(&tv5, &tz);
+#ifndef CDT_ONLY
+ if (quality) {
+ printf("Quality milliseconds: %ld\n",
+ 1000l * (tv5.tv_sec - tv4.tv_sec) + (tv5.tv_usec - tv4.tv_usec) / 1000l);
+ }
+#endif /* not CDT_ONLY */
+ }
+#endif /* NO_TIMER */
+
+ /* Compute the number of edges. */
+ edges = (3l * triangles.items + hullsize) / 2l;
+
+ if (order > 1) {
+ highorder(); /* Promote elements to higher polynomial order. */
+ }
+ if (!quiet) {
+ printf("\n");
+ }
+
+#ifdef TRILIBRARY
+ out->numberofpoints = points.items;
+ out->numberofpointattributes = nextras;
+ out->numberoftriangles = triangles.items;
+ out->numberofcorners = (order + 1) * (order + 2) / 2;
+ out->numberoftriangleattributes = eextras;
+ out->numberofedges = edges;
+ if (useshelles) {
+ out->numberofsegments = shelles.items;
+ } else {
+ out->numberofsegments = hullsize;
+ }
+ if (vorout != (struct triangulateio *) NULL) {
+ vorout->numberofpoints = triangles.items;
+ vorout->numberofpointattributes = nextras;
+ vorout->numberofedges = edges;
+ }
+#endif /* TRILIBRARY */
+ /* If not using iteration numbers, don't write a .node file if one was */
+ /* read, because the original one would be overwritten! */
+ if (nonodewritten || (noiterationnum && readnodefile)) {
+ if (!quiet) {
+#ifdef TRILIBRARY
+ printf("NOT writing points.\n");
+#else /* not TRILIBRARY */
+ printf("NOT writing a .node file.\n");
+#endif /* not TRILIBRARY */
+ }
+ numbernodes(); /* We must remember to number the points. */
+ } else {
+#ifdef TRILIBRARY
+ writenodes(&out->pointlist, &out->pointattributelist,
+ &out->pointmarkerlist);
+#else /* not TRILIBRARY */
+ writenodes(outnodefilename, argc, argv); /* Numbers the points too. */
+#endif /* TRILIBRARY */
+ }
+ if (noelewritten) {
+ if (!quiet) {
+#ifdef TRILIBRARY
+ printf("NOT writing triangles.\n");
+#else /* not TRILIBRARY */
+ printf("NOT writing an .ele file.\n");
+#endif /* not TRILIBRARY */
+ }
+ } else {
+#ifdef TRILIBRARY
+ writeelements(&out->trianglelist, &out->triangleattributelist);
+#else /* not TRILIBRARY */
+ writeelements(outelefilename, argc, argv);
+#endif /* not TRILIBRARY */
+ }
+ /* The -c switch (convex switch) causes a PSLG to be written */
+ /* even if none was read. */
+ if (poly || convex) {
+ /* If not using iteration numbers, don't overwrite the .poly file. */
+ if (nopolywritten || noiterationnum) {
+ if (!quiet) {
+#ifdef TRILIBRARY
+ printf("NOT writing segments.\n");
+#else /* not TRILIBRARY */
+ printf("NOT writing a .poly file.\n");
+#endif /* not TRILIBRARY */
+ }
+ } else {
+#ifdef TRILIBRARY
+ writepoly(&out->segmentlist, &out->segmentmarkerlist);
+ out->numberofholes = holes;
+ out->numberofregions = regions;
+ if (poly) {
+ out->holelist = in->holelist;
+ out->regionlist = in->regionlist;
+ } else {
+ out->holelist = (REAL *) NULL;
+ out->regionlist = (REAL *) NULL;
+ }
+#else /* not TRILIBRARY */
+ writepoly(outpolyfilename, holearray, holes, regionarray, regions, argc, argv);
+#endif /* not TRILIBRARY */
+ }
+ }
+#ifndef TRILIBRARY
+#ifndef CDT_ONLY
+ if (regions > 0) {
+ free(regionarray);
+ }
+#endif /* not CDT_ONLY */
+ if (holes > 0) {
+ free(holearray);
+ }
+ if (geomview) {
+ writeoff(offfilename, argc, argv);
+ }
+#endif /* not TRILIBRARY */
+ if (edgesout) {
+#ifdef TRILIBRARY
+ writeedges(&out->edgelist, &out->edgemarkerlist);
+#else /* not TRILIBRARY */
+ writeedges(edgefilename, argc, argv);
+#endif /* not TRILIBRARY */
+ }
+ if (voronoi) {
+#ifdef TRILIBRARY
+ writevoronoi(&vorout->pointlist, &vorout->pointattributelist,
+ &vorout->pointmarkerlist, &vorout->edgelist,
+ &vorout->edgemarkerlist, &vorout->normlist);
+#else /* not TRILIBRARY */
+ writevoronoi(vnodefilename, vedgefilename, argc, argv);
+#endif /* not TRILIBRARY */
+ }
+ if (neighbors) {
+#ifdef TRILIBRARY
+ writeneighbors(&out->neighborlist);
+#else /* not TRILIBRARY */
+ writeneighbors(neighborfilename, argc, argv);
+#endif /* not TRILIBRARY */
+ }
+
+ if (!quiet) {
+#ifndef NO_TIMER
+ gettimeofday(&tv6, &tz);
+ printf("\nOutput milliseconds: %ld\n",
+ 1000l * (tv6.tv_sec - tv5.tv_sec) + (tv6.tv_usec - tv5.tv_usec) / 1000l);
+ printf("Total running milliseconds: %ld\n",
+ 1000l * (tv6.tv_sec - tv0.tv_sec) + (tv6.tv_usec - tv0.tv_usec) / 1000l);
+#endif /* NO_TIMER */
+
+ statistics();
+ }
+
+#ifndef REDUCED
+ if (docheck) {
+ checkmesh();
+ checkdelaunay();
+ }
+#endif /* not REDUCED */
+
+ triangledeinit();
+#ifndef TRILIBRARY
+ return 0;
+#endif /* not TRILIBRARY */
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.h b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.h
new file mode 100644
index 0000000000000000000000000000000000000000..b58929943326a18f4a9891fa3d9b482815820637
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/triangle.h
@@ -0,0 +1,291 @@
+#ifndef netlib_triangle_h_
+#define netlib_triangle_h_
+/*****************************************************************************/
+/* */
+/* (triangle.h) */
+/* */
+/* Include file for programs that call Triangle. */
+/* */
+/* Accompanies Triangle Version 1.3 */
+/* July 19, 1996 */
+/* */
+/* Copyright 1996 */
+/* Jonathan Richard Shewchuk */
+/* School of Computer Science */
+/* Carnegie Mellon University */
+/* 5000 Forbes Avenue */
+/* Pittsburgh, Pennsylvania 15213-3891 */
+/* jrs@cs.cmu.edu */
+/* */
+/*****************************************************************************/
+
+/*****************************************************************************/
+/* */
+/* How to call Triangle from another program */
+/* */
+/* */
+/* If you haven't read Triangle's instructions (run "triangle -h" to read */
+/* them), you won't understand what follows. */
+/* */
+/* Triangle must be compiled into an object file (triangle.o) with the */
+/* TRILIBRARY symbol defined (preferably by using the -DTRILIBRARY compiler */
+/* switch). The makefile included with Triangle will do this for you if */
+/* you run "make trilibrary". The resulting object file can be called via */
+/* the procedure triangulate(). */
+/* */
+/* If the size of the object file is important to you, you may wish to */
+/* generate a reduced version of triangle.o. The REDUCED symbol gets rid */
+/* of all features that are primarily of research interest. Specifically, */
+/* the -DREDUCED switch eliminates Triangle's -i, -F, -s, and -C switches. */
+/* The CDT_ONLY symbol gets rid of all meshing algorithms above and beyond */
+/* constrained Delaunay triangulation. Specifically, the -DCDT_ONLY switch */
+/* eliminates Triangle's -r, -q, -a, -S, and -s switches. */
+/* */
+/* IMPORTANT: These definitions (TRILIBRARY, REDUCED, CDT_ONLY) must be */
+/* made in the makefile or in triangle.c itself. Putting these definitions */
+/* in this file will not create the desired effect. */
+/* */
+/* */
+/* The calling convention for triangulate() follows. */
+/* */
+/* void triangulate(triswitches, in, out, vorout) */
+/* char *triswitches; */
+/* struct triangulateio *in; */
+/* struct triangulateio *out; */
+/* struct triangulateio *vorout; */
+/* */
+/* `triswitches' is a string containing the command line switches you wish */
+/* to invoke. No initial dash is required. Some suggestions: */
+/* */
+/* - You'll probably find it convenient to use the `z' switch so that */
+/* points (and other items) are numbered from zero. This simplifies */
+/* indexing, because the first item of any type always starts at index */
+/* [0] of the corresponding array, whether that item's number is zero or */
+/* one. */
+/* - You'll probably want to use the `Q' (quiet) switch in your final code, */
+/* but you can take advantage of Triangle's printed output (including the */
+/* `V' switch) while debugging. */
+/* - If you are not using the `q' or `a' switches, then the output points */
+/* will be identical to the input points, except possibly for the */
+/* boundary markers. If you don't need the boundary markers, you should */
+/* use the `N' (no nodes output) switch to save memory. (If you do need */
+/* boundary markers, but need to save memory, a good nasty trick is to */
+/* set out->pointlist equal to in->pointlist before calling triangulate(),*/
+/* so that Triangle overwrites the input points with identical copies.) */
+/* - The `I' (no iteration numbers) and `g' (.off file output) switches */
+/* have no effect when Triangle is compiled with TRILIBRARY defined. */
+/* */
+/* `in', `out', and `vorout' are descriptions of the input, the output, */
+/* and the Voronoi output. If the `v' (Voronoi output) switch is not used, */
+/* `vorout' may be NULL. `in' and `out' may never be NULL. */
+/* */
+/* Certain fields of the input and output structures must be initialized, */
+/* as described below. */
+/* */
+/*****************************************************************************/
+
+/*****************************************************************************/
+/* */
+/* The `triangulateio' structure. */
+/* */
+/* Used to pass data into and out of the triangulate() procedure. */
+/* */
+/* */
+/* Arrays are used to store points, triangles, markers, and so forth. In */
+/* all cases, the first item in any array is stored starting at index [0]. */
+/* However, that item is item number `1' unless the `z' switch is used, in */
+/* which case it is item number `0'. Hence, you may find it easier to */
+/* index points (and triangles in the neighbor list) if you use the `z' */
+/* switch. Unless, of course, you're calling Triangle from a Fortran */
+/* program. */
+/* */
+/* Description of fields (except the `numberof' fields, which are obvious): */
+/* */
+/* `pointlist': An array of point coordinates. The first point's x */
+/* coordinate is at index [0] and its y coordinate at index [1], followed */
+/* by the coordinates of the remaining points. Each point occupies two */
+/* REALs. */
+/* `pointattributelist': An array of point attributes. Each point's */
+/* attributes occupy `numberofpointattributes' REALs. */
+/* `pointmarkerlist': An array of point markers; one int per point. */
+/* */
+/* `trianglelist': An array of triangle corners. The first triangle's */
+/* first corner is at index [0], followed by its other two corners in */
+/* counterclockwise order, followed by any other nodes if the triangle */
+/* represents a nonlinear element. Each triangle occupies */
+/* `numberofcorners' ints. */
+/* `triangleattributelist': An array of triangle attributes. Each */
+/* triangle's attributes occupy `numberoftriangleattributes' REALs. */
+/* `trianglearealist': An array of triangle area constraints; one REAL per */
+/* triangle. Input only. */
+/* `neighborlist': An array of triangle neighbors; three ints per */
+/* triangle. Output only. */
+/* */
+/* `segmentlist': An array of segment endpoints. The first segment's */
+/* endpoints are at indices [0] and [1], followed by the remaining */
+/* segments. Two ints per segment. */
+/* `segmentmarkerlist': An array of segment markers; one int per segment. */
+/* */
+/* `holelist': An array of holes. The first hole's x and y coordinates */
+/* are at indices [0] and [1], followed by the remaining holes. Two */
+/* REALs per hole. Input only, although the pointer is copied to the */
+/* output structure for your convenience. */
+/* */
+/* `regionlist': An array of regional attributes and area constraints. */
+/* The first constraint's x and y coordinates are at indices [0] and [1], */
+/* followed by the regional attribute and index [2], followed by the */
+/* maximum area at index [3], followed by the remaining area constraints. */
+/* Four REALs per area constraint. Note that each regional attribute is */
+/* used only if you select the `A' switch, and each area constraint is */
+/* used only if you select the `a' switch (with no number following), but */
+/* omitting one of these switches does not change the memory layout. */
+/* Input only, although the pointer is copied to the output structure for */
+/* your convenience. */
+/* */
+/* `edgelist': An array of edge endpoints. The first edge's endpoints are */
+/* at indices [0] and [1], followed by the remaining edges. Two ints per */
+/* edge. Output only. */
+/* `edgemarkerlist': An array of edge markers; one int per edge. Output */
+/* only. */
+/* `normlist': An array of normal vectors, used for infinite rays in */
+/* Voronoi diagrams. The first normal vector's x and y magnitudes are */
+/* at indices [0] and [1], followed by the remaining vectors. For each */
+/* finite edge in a Voronoi diagram, the normal vector written is the */
+/* zero vector. Two REALs per edge. Output only. */
+/* */
+/* */
+/* Any input fields that Triangle will examine must be initialized. */
+/* Furthermore, for each output array that Triangle will write to, you */
+/* must either provide space by setting the appropriate pointer to point */
+/* to the space you want the data written to, or you must initialize the */
+/* pointer to NULL, which tells Triangle to allocate space for the results. */
+/* The latter option is preferable, because Triangle always knows exactly */
+/* how much space to allocate. The former option is provided mainly for */
+/* people who need to call Triangle from Fortran code, though it also makes */
+/* possible some nasty space-saving tricks, like writing the output to the */
+/* same arrays as the input. */
+/* */
+/* Triangle will not free() any input or output arrays, including those it */
+/* allocates itself; that's up to you. */
+/* */
+/* Here's a guide to help you decide which fields you must initialize */
+/* before you call triangulate(). */
+/* */
+/* `in': */
+/* */
+/* - `pointlist' must always point to a list of points; `numberofpoints' */
+/* and `numberofpointattributes' must be properly set. */
+/* `pointmarkerlist' must either be set to NULL (in which case all */
+/* markers default to zero), or must point to a list of markers. If */
+/* `numberofpointattributes' is not zero, `pointattributelist' must */
+/* point to a list of point attributes. */
+/* - If the `r' switch is used, `trianglelist' must point to a list of */
+/* triangles, and `numberoftriangles', `numberofcorners', and */
+/* `numberoftriangleattributes' must be properly set. If */
+/* `numberoftriangleattributes' is not zero, `triangleattributelist' */
+/* must point to a list of triangle attributes. If the `a' switch is */
+/* used (with no number following), `trianglearealist' must point to a */
+/* list of triangle area constraints. `neighborlist' may be ignored. */
+/* - If the `p' switch is used, `segmentlist' must point to a list of */
+/* segments, `numberofsegments' must be properly set, and */
+/* `segmentmarkerlist' must either be set to NULL (in which case all */
+/* markers default to zero), or must point to a list of markers. */
+/* - If the `p' switch is used without the `r' switch, then */
+/* `numberofholes' and `numberofregions' must be properly set. If */
+/* `numberofholes' is not zero, `holelist' must point to a list of */
+/* holes. If `numberofregions' is not zero, `regionlist' must point to */
+/* a list of region constraints. */
+/* - If the `p' switch is used, `holelist', `numberofholes', */
+/* `regionlist', and `numberofregions' is copied to `out'. (You can */
+/* nonetheless get away with not initializing them if the `r' switch is */
+/* used.) */
+/* - `edgelist', `edgemarkerlist', `normlist', and `numberofedges' may be */
+/* ignored. */
+/* */
+/* `out': */
+/* */
+/* - `pointlist' must be initialized (NULL or pointing to memory) unless */
+/* the `N' switch is used. `pointmarkerlist' must be initialized */
+/* unless the `N' or `B' switch is used. If `N' is not used and */
+/* `in->numberofpointattributes' is not zero, `pointattributelist' must */
+/* be initialized. */
+/* - `trianglelist' must be initialized unless the `E' switch is used. */
+/* `neighborlist' must be initialized if the `n' switch is used. If */
+/* the `E' switch is not used and (`in->numberofelementattributes' is */
+/* not zero or the `A' switch is used), `elementattributelist' must be */
+/* initialized. `trianglearealist' may be ignored. */
+/* - `segmentlist' must be initialized if the `p' or `c' switch is used, */
+/* and the `P' switch is not used. `segmentmarkerlist' must also be */
+/* initialized under these circumstances unless the `B' switch is used. */
+/* - `edgelist' must be initialized if the `e' switch is used. */
+/* `edgemarkerlist' must be initialized if the `e' switch is used and */
+/* the `B' switch is not. */
+/* - `holelist', `regionlist', `normlist', and all scalars may be ignored.*/
+/* */
+/* `vorout' (only needed if `v' switch is used): */
+/* */
+/* - `pointlist' must be initialized. If `in->numberofpointattributes' */
+/* is not zero, `pointattributelist' must be initialized. */
+/* `pointmarkerlist' may be ignored. */
+/* - `edgelist' and `normlist' must both be initialized. */
+/* `edgemarkerlist' may be ignored. */
+/* - Everything else may be ignored. */
+/* */
+/* After a call to triangulate(), the valid fields of `out' and `vorout' */
+/* will depend, in an obvious way, on the choice of switches used. Note */
+/* that when the `p' switch is used, the pointers `holelist' and */
+/* `regionlist' are copied from `in' to `out', but no new space is */
+/* allocated; be careful that you don't free() the same array twice. On */
+/* the other hand, Triangle will never copy the `pointlist' pointer (or any */
+/* others); new space is allocated for `out->pointlist', or if the `N' */
+/* switch is used, `out->pointlist' remains uninitialized. */
+/* */
+/* All of the meaningful `numberof' fields will be properly set; for */
+/* instance, `numberofedges' will represent the number of edges in the */
+/* triangulation whether or not the edges were written. If segments are */
+/* not used, `numberofsegments' will indicate the number of boundary edges. */
+/* */
+/*****************************************************************************/
+
+#undef REAL
+#ifdef SINGLE
+#define REAL float
+#else /* not SINGLE */
+#define REAL double
+#endif /* not SINGLE */
+
+struct triangulateio {
+ REAL *pointlist; /* In / out */
+ REAL *pointattributelist; /* In / out */
+ int *pointmarkerlist; /* In / out */
+ int numberofpoints; /* In / out */
+ int numberofpointattributes; /* In / out */
+
+ int *trianglelist; /* In / out */
+ REAL *triangleattributelist; /* In / out */
+ REAL *trianglearealist; /* In only */
+ int *neighborlist; /* Out only */
+ int numberoftriangles; /* In / out */
+ int numberofcorners; /* In / out */
+ int numberoftriangleattributes; /* In / out */
+
+ int *segmentlist; /* In / out */
+ int *segmentmarkerlist; /* In / out */
+ int numberofsegments; /* In / out */
+
+ REAL *holelist; /* In / pointer to array copied out */
+ int numberofholes; /* In / copied out */
+
+ REAL *regionlist; /* In / pointer to array copied out */
+ int numberofregions; /* In / copied out */
+
+ int *edgelist; /* Out only */
+ int *edgemarkerlist; /* Not used with Voronoi diagram; out only */
+ REAL *normlist; /* Used only with Voronoi diagram; out only */
+ int numberofedges; /* Out only */
+};
+
+void triangulate(const char *, struct triangulateio *, struct triangulateio *,
+ struct triangulateio *);
+
+#endif /* netlib_triangle_h_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/urand.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/urand.c
new file mode 100644
index 0000000000000000000000000000000000000000..46bb9590ddd7e313d5ff0ab95392232b8dc38e84
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/urand.c
@@ -0,0 +1,78 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double atan(double), sqrt(double); /* #include <math.h> */
+
+doublereal urand_(iy)
+integer *iy;
+{
+ /* Initialized data */
+
+ static integer m2 = 0;
+ static integer itwo = 2;
+
+ /* Local variables */
+ static integer m;
+ static real s;
+ static doublereal halfm;
+ static integer ia, ic, mic;
+
+/* URAND IS A UNIFORM RANDOM NUMBER GENERATOR BASED ON THEORY AND */
+/* SUGGESTIONS GIVEN IN D.E. KNUTH (1969), VOL 2. THE INTEGER IY */
+/* SHOULD BE INITIALIZED TO AN ARBITRARY INTEGER PRIOR TO THE FIRST CALL */
+/* TO URAND. THE CALLING PROGRAM SHOULD NOT ALTER THE VALUE OF IY */
+/* BETWEEN SUBSEQUENT CALLS TO URAND. VALUES OF URAND WILL BE RETURNED */
+/* IN THE INTERVAL (0,1). */
+
+ if (m2 != 0) {
+ goto L20;
+ }
+
+/* IF FIRST ENTRY, COMPUTE MACHINE INTEGER WORD LENGTH */
+
+ m = 1;
+ do {
+ m2 = m;
+ m = itwo * m2;
+ } while (m > m2);
+
+ halfm = (doublereal) m2;
+
+/* COMPUTE MULTIPLIER AND INCREMENT FOR LINEAR CONGRUENTIAL METHOD */
+
+ ia = ((integer) (halfm * atan(1.) / 8.) << 3) + 5;
+ ic = ((integer) (halfm * (.5 - sqrt(3.) / 6.)) << 1) + 1;
+ mic = m2 - ic + m2;
+
+/* S IS THE SCALE FACTOR FOR CONVERTING TO FLOATING POINT */
+
+ s = .5f / m2;
+
+/* COMPUTE NEXT RANDOM NUMBER */
+
+L20:
+ *iy *= ia;
+
+/* THE FOLLOWING STATEMENT IS FOR COMPUTERS WHICH DO NOT ALLOW */
+/* INTEGER OVERFLOW ON ADDITION */
+
+ if (*iy > mic) {
+ *iy = *iy - m2 - m2;
+ }
+
+ *iy += ic;
+
+/* THE FOLLOWING STATEMENT IS FOR COMPUTERS WHERE THE */
+/* WORD LENGTH FOR ADDITION IS GREATER THAN FOR MULTIPLICATION */
+
+ if (*iy / 2 > m2) {
+ *iy = *iy - m2 - m2;
+ }
+
+/* THE FOLLOWING STATEMENT IS FOR COMPUTERS WHERE INTEGER */
+/* OVERFLOW AFFECTS THE SIGN BIT */
+
+ if (*iy < 0) {
+ *iy = *iy + m2 + m2;
+ }
+ return (real) (*iy) * s;
+} /* urand_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.c
new file mode 100644
index 0000000000000000000000000000000000000000..1c7b8b3abde94caa7814af78feaf6dfc00899f3b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.c
@@ -0,0 +1,37 @@
+#include "f2c.h"
+#include "netlib.h"
+#include <stdio.h>
+
+/* Subroutine */ void xerbla_(const char *srname, integer *info)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+ Purpose
+ =======
+
+ XERBLA is an error handler for the LAPACK routines.
+ It is called by an LAPACK routine if an input parameter has an
+ invalid value. A message is printed and execution stops.
+
+ Installers may consider modifying the STOP statement in order to
+ call system-specific exception-handling facilities.
+
+ Arguments
+ =========
+
+ SRNAME (input) CHARACTER*6
+ The name of the routine which called XERBLA.
+
+ INFO (input) INTEGER
+ The position of the invalid parameter in the parameter list
+
+ of the calling routine.
+
+ =====================================================================
+*/
+
+ printf("** On entry to %6s, parameter number %2i had an illegal value\n", srname, *info);
+} /* xerbla_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.f
new file mode 100644
index 0000000000000000000000000000000000000000..618dfcf97135e421193ccd4a61cd86025c7b7c3e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/xerbla.f
@@ -0,0 +1,46 @@
+ SUBROUTINE XERBLA( SRNAME, INFO )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER*6 SRNAME
+ INTEGER INFO
+* ..
+*
+* Purpose
+* =======
+*
+* XERBLA is an error handler for the LAPACK routines.
+* It is called by an LAPACK routine if an input parameter has an
+* invalid value. A message is printed and execution stops.
+*
+* Installers may consider modifying the STOP statement in order to
+* call system-specific exception-handling facilities.
+*
+* Arguments
+* =========
+*
+* SRNAME (input) CHARACTER*6
+* The name of the routine which called XERBLA.
+*
+* INFO (input) INTEGER
+* The position of the invalid parameter in the parameter list
+* of the calling routine.
+*
+* =====================================================================
+*
+* .. Executable Statements ..
+*
+ WRITE( *, FMT = 9999 )SRNAME, INFO
+*
+ STOP
+*
+ 9999 FORMAT( ' ** On entry to ', A6, ' parameter number ', I2, ' had ',
+ $ 'an illegal value' )
+*
+* End of XERBLA
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/z_abs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_abs.c
new file mode 100644
index 0000000000000000000000000000000000000000..7e607bc04b1d7844f5e497292e04036e314eae15
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_abs.c
@@ -0,0 +1,11 @@
+#include "f2c.h"
+#include "netlib.h"
+
+#ifdef KR_headers
+double z_abs(z) const doublecomplex *z;
+#else
+double z_abs(const doublecomplex *z)
+#endif
+{
+ return( f__cabs( z->r, z->i ) );
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/z_div.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_div.c
new file mode 100644
index 0000000000000000000000000000000000000000..31b8feac212b854ea2f5f52e0edc3fabdc777c05
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_div.c
@@ -0,0 +1,36 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001, to allow c being equal to a or b */
+
+#ifdef KR_headers
+VOID z_div(c, a, b) doublecomplex *c, const doublecomplex *a, *b;
+#else
+void z_div(doublecomplex *c, const doublecomplex *a, const doublecomplex *b)
+#endif
+{
+ double ratio, den;
+ double abr, abi;
+ double ar = a->r, ai = a->i;
+
+ if ( (abr = b->r) < 0.)
+ abr = - abr;
+ if ( (abi = b->i) < 0.)
+ abi = - abi;
+ if ( abr <= abi ) {
+ if (abi == 0) {
+ sig_die("complex division by zero", 1);
+ }
+ ratio = (double)b->r / b->i ;
+ den = b->i * (1 + ratio*ratio);
+ c->r = (ar*ratio + ai) / den;
+ c->i = (ai*ratio - ar) / den;
+ }
+
+ else {
+ ratio = (double)b->i / b->r ;
+ den = b->r * (1 + ratio*ratio);
+ c->r = (ar + ai*ratio) / den;
+ c->i = (ai - ar*ratio) / den;
+ }
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/z_sqrt.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_sqrt.c
new file mode 100644
index 0000000000000000000000000000000000000000..7e2dbeec1cee86161e517428416664f883ef8238
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/z_sqrt.c
@@ -0,0 +1,34 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* A slightly more efficient implementation for complex square roots, */
+/* which does not use any of hypot(), atan2(), cos(), sin(). */
+/* Author: Peter Vanroose, June 2001. */
+
+/* Note that the imaginary part of the returned value will never be negative. */
+/* The other complex square root is just minus the one returned here. */
+
+void z_sqrt(doublecomplex *ret_value, const doublecomplex *z)
+{
+ doublereal w = z_abs(z);
+
+ ret_value->r = sqrt((w+z->r)/2.);
+ ret_value->i = sqrt((w-z->r)/2.);
+ if (z->i < 0.)
+ ret_value->r = - ret_value->r;
+ return;
+
+#if 0
+ /* was: (fsm) */
+ doublereal a = z->r;
+ doublereal b = z->i;
+ doublereal r = hypot(a,b);
+ doublereal theta = atan2(b,a);
+ theta *= 0.5;
+ r = sqrt(r);
+ ret_value->r = r * cos(theta);
+ ret_value->i = r * sin(theta);
+#endif
+}
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zaxpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zaxpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..55d4936dd51418df83e3bdeb1e4ea3e6a631eec6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zaxpy.c
@@ -0,0 +1,52 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved out of zsvdc.c to separate file */
+
+/* Subroutine */ void zaxpy_(n, za, zx, incx, zy, incy)
+const integer *n;
+const doublecomplex *za, *zx;
+const integer *incx;
+doublecomplex *zy;
+const integer *incy;
+{
+ /* System generated locals */
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* constant times a vector plus a vector. */
+/* jack dongarra, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (za->r == 0. && za->i == 0.) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ z__1.r = za->r * zx[i].r - za->i * zx[i].i,
+ z__1.i = za->r * zx[i].i + za->i * zx[i].r;
+ zy[i].r += z__1.r, zy[i].i += z__1.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ z__1.r = za->r * zx[ix].r - za->i * zx[ix].i,
+ z__1.i = za->r * zx[ix].i + za->i * zx[ix].r;
+ zy[iy].r += z__1.r, zy[iy].i += z__1.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* zaxpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.c
new file mode 100644
index 0000000000000000000000000000000000000000..1b145e4f12f93f6fca35e84c04f45bdb2b520fb4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.c
@@ -0,0 +1,41 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zcopy_(n, zx, incx, zy, incy)
+const integer *n;
+const doublecomplex *zx;
+const integer *incx;
+doublecomplex *zy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i, ix, iy;
+
+/* copies a vector, x, to a vector, y. */
+/* jack dongarra, linpack, 4/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ zy[i].r = zx[i].r, zy[i].i = zx[i].i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ zy[iy].r = zx[ix].r, zy[iy].i = zx[ix].i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* zcopy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.f
new file mode 100644
index 0000000000000000000000000000000000000000..9ccfa880fca4aff4e73376439db8caa6d7689974
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zcopy.f
@@ -0,0 +1,33 @@
+ subroutine zcopy(n,zx,incx,zy,incy)
+c
+c copies a vector, x, to a vector, y.
+c jack dongarra, linpack, 4/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*),zy(*)
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ zy(iy) = zx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ zy(i) = zx(i)
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotc.c
new file mode 100644
index 0000000000000000000000000000000000000000..e548912e22dbd66a46a946f3c2e5f2f0781f9f56
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotc.c
@@ -0,0 +1,53 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved out of zsvdc.c to separate file */
+
+/* Double Complex */ void zdotc_(ret_val, n, zx, incx, zy, incy)
+doublecomplex *ret_val;
+const integer *n;
+const doublecomplex *zx;
+const integer *incx;
+const doublecomplex *zy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i;
+ static doublecomplex ztemp;
+ static integer ix, iy;
+
+/* forms the dot product of two vectors, conjugating the first vector */
+/* */
+/* jack dongarra, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ ret_val->r = 0., ret_val->i = 0.;
+ return;
+ }
+ ztemp.r = 0., ztemp.i = 0.;
+
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ztemp.r += zx[i].r * zy[i].r + zx[i].i * zy[i].i,
+ ztemp.i += zx[i].r * zy[i].i - zx[i].i * zy[i].r;
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ztemp.r += zx[ix].r * zy[iy].r + zx[ix].i * zy[iy].i,
+ ztemp.i += zx[ix].r * zy[iy].i - zx[ix].i * zy[iy].r;
+ ix += *incx; iy += *incy;
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ }
+} /* zdotc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.c
new file mode 100644
index 0000000000000000000000000000000000000000..99ba05d7a78d9a4d144d8ec28759d2b667a57f16
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.c
@@ -0,0 +1,50 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Double Complex */ void zdotu_(ret_val, n, zx, incx, zy, incy)
+doublecomplex *ret_val;
+const integer *n;
+const doublecomplex *zx;
+const integer *incx;
+const doublecomplex *zy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i;
+ static integer ix, iy;
+
+/* forms the dot product of two vectors. */
+/* jack dongarra, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ ret_val->r = 0., ret_val->i = 0.;
+ if (*n <= 0) {
+ return ;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ret_val->r += zx[i].r * zy[i].r - zx[i].i * zy[i].i,
+ ret_val->i += zx[i].r * zy[i].i + zx[i].i * zy[i].r;
+ }
+ }
+ else
+ {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ret_val->r += zx[ix].r * zy[iy].r - zx[ix].i * zy[iy].i,
+ ret_val->i += zx[ix].r * zy[iy].i + zx[ix].i * zy[iy].r;
+ ix += *incx; iy += *incy;
+ }
+ }
+
+ return;
+} /* zdotu_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.f
new file mode 100644
index 0000000000000000000000000000000000000000..329e98855c8aa50195ec51dd6705466bb22cf194
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdotu.f
@@ -0,0 +1,36 @@
+ double complex function zdotu(n,zx,incx,zy,incy)
+c
+c forms the dot product of two vectors.
+c jack dongarra, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*),zy(*),ztemp
+ integer i,incx,incy,ix,iy,n
+ ztemp = (0.0d0,0.0d0)
+ zdotu = (0.0d0,0.0d0)
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ztemp = ztemp + zx(ix)*zy(iy)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ zdotu = ztemp
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ ztemp = ztemp + zx(i)*zy(i)
+ 30 continue
+ zdotu = ztemp
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdrot.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdrot.c
new file mode 100644
index 0000000000000000000000000000000000000000..8f22812eaee211648cf00a66bd57f6ead578b8f4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdrot.c
@@ -0,0 +1,53 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved out of zsvdc.c to separate file */
+
+/* Subroutine */ void zdrot_(n, zx, incx, zy, incy, c, s)
+const integer *n;
+doublecomplex *zx;
+const integer *incx;
+doublecomplex *zy;
+const integer *incy;
+const doublereal *c, *s;
+{
+ /* Local variables */
+ static integer i;
+ static doublecomplex ztemp;
+ static integer ix, iy;
+
+/* applies a plane rotation, where the cos and sin (c and s) are */
+/* double precision and the vectors zx and zy are double complex. */
+/* jack dongarra, linpack, 3/11/78. */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ztemp.r = *c * zx[i].r + *s * zy[i].r,
+ ztemp.i = *c * zx[i].i + *s * zy[i].i;
+ zy[i].r = *c * zy[i].r - *s * zx[i].r,
+ zy[i].i = *c * zy[i].i - *s * zx[i].i;
+ zx[i].r = ztemp.r, zx[i].i = ztemp.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ztemp.r = *c * zx[ix].r + *s * zy[iy].r,
+ ztemp.i = *c * zx[ix].i + *s * zy[iy].i;
+ zy[iy].r = *c * zy[iy].r - *s * zx[ix].r,
+ zy[iy].i = *c * zy[iy].i - *s * zx[ix].i;
+ zx[ix].r = ztemp.r, zx[ix].i = ztemp.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* zdrot_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.c
new file mode 100644
index 0000000000000000000000000000000000000000..1368afbe731e8c747b9c0fd105a07a90621f61d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.c
@@ -0,0 +1,35 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zdscal_(n, da, zx, incx)
+const integer *n;
+const doublereal *da;
+doublecomplex *zx;
+const integer *incx;
+{
+ /* Local variables */
+ static integer i, ix;
+
+/* scales a vector by a constant. */
+/* jack dongarra, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0 || *incx <= 0) {
+ return;
+ }
+ if (*incx == 1) {
+ for (i = 0; i < *n; ++i) {
+ zx[i].r *= *da, zx[i].i *= *da;
+ }
+ }
+ else {
+ ix = 0;
+ for (i = 0; i < *n; ++i) {
+ zx[ix].r *= *da, zx[ix].i *= *da;
+ ix += *incx;
+ }
+ }
+} /* zdscal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.f
new file mode 100644
index 0000000000000000000000000000000000000000..8123424de47a49860900ce71490b96e0ad36f1eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zdscal.f
@@ -0,0 +1,30 @@
+ subroutine zdscal(n,da,zx,incx)
+c
+c scales a vector by a constant.
+c jack dongarra, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*)
+ double precision da
+ integer i,incx,ix,n
+c
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ do 10 i = 1,n
+ zx(ix) = dcmplx(da,0.0d0)*zx(ix)
+ ix = ix + incx
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 do 30 i = 1,n
+ zx(i) = dcmplx(da,0.0d0)*zx(i)
+ 30 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.c
new file mode 100644
index 0000000000000000000000000000000000000000..8c523c4b4d1a50fa40d53a13d9ff42c4d5a58d4c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.c
@@ -0,0 +1,199 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Subroutine */ void zgebak_(job, side, n, ilo, ihi, scale, m, v, ldv, info)
+const char *job, *side;
+const integer *n;
+integer *ilo, *ihi;
+doublereal *scale;
+const integer *m;
+doublecomplex *v;
+const integer *ldv;
+integer *info;
+{
+ /* System generated locals */
+ integer v_dim1, v_offset, i__1;
+
+ /* Local variables */
+ static integer i, k;
+ static doublereal s;
+ static logical leftv;
+ static integer ii;
+ static logical rightv;
+
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEBAK forms the right or left eigenvectors of a complex general */
+/* matrix by backward transformation on the computed eigenvectors of the */
+/* balanced matrix output by ZGEBAL. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOB (input) CHARACTER*1 */
+/* Specifies the type of backward transformation required: */
+/* = 'N', do nothing, return immediately; */
+/* = 'P', do backward transformation for permutation only; */
+/* = 'S', do backward transformation for scaling only; */
+/* = 'B', do backward transformations for both permutation and */
+/* scaling. */
+/* JOB must be the same as the argument JOB supplied to ZGEBAL. */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'R': V contains right eigenvectors; */
+/* = 'L': V contains left eigenvectors. */
+/* */
+/* N (input) INTEGER */
+/* The number of rows of the matrix V. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* The integers ILO and IHI determined by ZGEBAL. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+/* */
+/* SCALE (input) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutation and scaling factors, as returned */
+/* by ZGEBAL. */
+/* */
+/* M (input) INTEGER */
+/* The number of columns of the matrix V. M >= 0. */
+/* */
+/* V (input/output) COMPLEX*16 array, dimension (LDV,M) */
+/* On entry, the matrix of right or left eigenvectors to be */
+/* transformed, as returned by ZHSEIN or ZTREVC. */
+/* On exit, V is overwritten by the transformed eigenvectors. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. LDV >= max(1,N). */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* ===================================================================== */
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = v_dim1 + 1;
+ v -= v_offset;
+ --scale;
+
+/* Decode and Test the input parameters */
+
+ rightv = lsame_(side, "R");
+ leftv = lsame_(side, "L");
+
+ *info = 0;
+ if (! lsame_(job, "N") && ! lsame_(job, "P") && ! lsame_(job, "S") && ! lsame_(job, "B")) {
+ *info = -1;
+ } else if (! rightv && ! leftv) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*m < 0) {
+ *info = -7;
+ } else if (*ldv < max(1,*n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBAK", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+ if (*m == 0) {
+ return;
+ }
+ if (lsame_(job, "N")) {
+ return;
+ }
+
+ if (*ilo == *ihi) {
+ goto L30;
+ }
+
+/* Backward balance */
+
+ if (lsame_(job, "S") || lsame_(job, "B")) {
+
+ if (rightv) {
+ i__1 = *ihi;
+ for (i = *ilo; i <= i__1; ++i) {
+ s = scale[i];
+ zdscal_(m, &s, &v[i + v_dim1], ldv);
+ }
+ }
+
+ if (leftv) {
+ i__1 = *ihi;
+ for (i = *ilo; i <= i__1; ++i) {
+ s = 1. / scale[i];
+ zdscal_(m, &s, &v[i + v_dim1], ldv);
+ }
+ }
+ }
+
+/* Backward permutation */
+
+/* For I = ILO-1 step -1 until 1, */
+/* IHI+1 step 1 until N do -- */
+
+L30:
+ if (lsame_(job, "P") || lsame_(job, "B")) {
+ if (rightv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i = ii;
+ if (i >= *ilo && i <= *ihi) {
+ goto L40;
+ }
+ if (i < *ilo) {
+ i = *ilo - ii;
+ }
+ k = (integer) scale[i];
+ if (k == i) {
+ goto L40;
+ }
+ zswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+L40:
+ ;
+ }
+ }
+
+ if (leftv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i = ii;
+ if (i >= *ilo && i <= *ihi) {
+ goto L50;
+ }
+ if (i < *ilo) {
+ i = *ilo - ii;
+ }
+ k = (integer) scale[i];
+ if (k == i) {
+ goto L50;
+ }
+ zswap_(m, &v[i + v_dim1], ldv, &v[k + v_dim1], ldv);
+L50:
+ ;
+ }
+ }
+ }
+} /* zgebak_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.f
new file mode 100644
index 0000000000000000000000000000000000000000..55997fb86c0b2db2d6e7b43d6f35a80767f8e8d1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebak.f
@@ -0,0 +1,190 @@
+ SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
+ $ INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOB, SIDE
+ INTEGER IHI, ILO, INFO, LDV, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION SCALE( * )
+ COMPLEX*16 V( LDV, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEBAK forms the right or left eigenvectors of a complex general
+* matrix by backward transformation on the computed eigenvectors of the
+* balanced matrix output by ZGEBAL.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* Specifies the type of backward transformation required:
+* = 'N', do nothing, return immediately;
+* = 'P', do backward transformation for permutation only;
+* = 'S', do backward transformation for scaling only;
+* = 'B', do backward transformations for both permutation and
+* scaling.
+* JOB must be the same as the argument JOB supplied to ZGEBAL.
+*
+* SIDE (input) CHARACTER*1
+* = 'R': V contains right eigenvectors;
+* = 'L': V contains left eigenvectors.
+*
+* N (input) INTEGER
+* The number of rows of the matrix V. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* The integers ILO and IHI determined by ZGEBAL.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* SCALE (input) DOUBLE PRECISION array, dimension (N)
+* Details of the permutation and scaling factors, as returned
+* by ZGEBAL.
+*
+* M (input) INTEGER
+* The number of columns of the matrix V. M >= 0.
+*
+* V (input/output) COMPLEX*16 array, dimension (LDV,M)
+* On entry, the matrix of right or left eigenvectors to be
+* transformed, as returned by ZHSEIN or ZTREVC.
+* On exit, V is overwritten by the transformed eigenvectors.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V. LDV >= max(1,N).
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE
+ PARAMETER ( ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LEFTV, RIGHTV
+ INTEGER I, II, K
+ DOUBLE PRECISION S
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZDSCAL, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Decode and Test the input parameters
+*
+ RIGHTV = LSAME( SIDE, 'R' )
+ LEFTV = LSAME( SIDE, 'L' )
+*
+ INFO = 0
+ IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+ $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
+ INFO = -5
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -7
+ ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
+ INFO = -9
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEBAK', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+ IF( M.EQ.0 )
+ $ RETURN
+ IF( LSAME( JOB, 'N' ) )
+ $ RETURN
+*
+ IF( ILO.EQ.IHI )
+ $ GO TO 30
+*
+* Backward balance
+*
+ IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
+*
+ IF( RIGHTV ) THEN
+ DO 10 I = ILO, IHI
+ S = SCALE( I )
+ CALL ZDSCAL( M, S, V( I, 1 ), LDV )
+ 10 CONTINUE
+ END IF
+*
+ IF( LEFTV ) THEN
+ DO 20 I = ILO, IHI
+ S = ONE / SCALE( I )
+ CALL ZDSCAL( M, S, V( I, 1 ), LDV )
+ 20 CONTINUE
+ END IF
+*
+ END IF
+*
+* Backward permutation
+*
+* For I = ILO-1 step -1 until 1,
+* IHI+1 step 1 until N do --
+*
+ 30 CONTINUE
+ IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
+ IF( RIGHTV ) THEN
+ DO 40 II = 1, N
+ I = II
+ IF( I.GE.ILO .AND. I.LE.IHI )
+ $ GO TO 40
+ IF( I.LT.ILO )
+ $ I = ILO - II
+ K = SCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 40
+ CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 40 CONTINUE
+ END IF
+*
+ IF( LEFTV ) THEN
+ DO 50 II = 1, N
+ I = II
+ IF( I.GE.ILO .AND. I.LE.IHI )
+ $ GO TO 50
+ IF( I.LT.ILO )
+ $ I = ILO - II
+ K = SCALE( I )
+ IF( K.EQ.I )
+ $ GO TO 50
+ CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
+ 50 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZGEBAK
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.c
new file mode 100644
index 0000000000000000000000000000000000000000..c8f6e4344e72925b6915c91c8067138502eeec3f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.c
@@ -0,0 +1,323 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void zgebal_(job, n, a, lda, ilo, ihi, scale, info)
+const char *job;
+const integer *n;
+doublecomplex *a;
+const integer *lda;
+integer *ilo, *ihi;
+doublereal *scale;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer iexc;
+ static doublereal c, f, g;
+ static integer i, j, k, l, m;
+ static doublereal r, s;
+ static doublereal sfmin1, sfmin2, sfmax1, sfmax2, ca, ra;
+ static logical noconv;
+ static integer ica, ira;
+
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEBAL balances a general complex matrix A. This involves, first, */
+/* permuting A by a similarity transformation to isolate eigenvalues */
+/* in the first 1 to ILO-1 and last IHI+1 to N elements on the */
+/* diagonal; and second, applying a diagonal similarity transformation */
+/* to rows and columns ILO to IHI to make the rows and columns as */
+/* close in norm as possible. Both steps are optional. */
+/* */
+/* Balancing may reduce the 1-norm of the matrix, and improve the */
+/* accuracy of the computed eigenvalues and/or eigenvectors. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOB (input) CHARACTER*1 */
+/* Specifies the operations to be performed on A: */
+/* = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0 */
+/* for i = 1,...,N; */
+/* = 'P': permute only; */
+/* = 'S': scale only; */
+/* = 'B': both permute and scale. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the input matrix A. */
+/* On exit, A is overwritten by the balanced matrix. */
+/* If JOB = 'N', A is not referenced. */
+/* See Further Details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* ILO (output) INTEGER */
+/* IHI (output) INTEGER */
+/* ILO and IHI are set to integers such that on exit */
+/* A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N. */
+/* If JOB = 'N' or 'S', ILO = 1 and IHI = N. */
+/* */
+/* SCALE (output) DOUBLE PRECISION array, dimension (N) */
+/* Details of the permutations and scaling factors applied to */
+/* A. If P(j) is the index of the row and column interchanged */
+/* with row and column j and D(j) is the scaling factor */
+/* applied to row and column j, then */
+/* SCALE(j) = P(j) for j = 1,...,ILO-1 */
+/* = D(j) for j = ILO,...,IHI */
+/* = P(j) for j = IHI+1,...,N. */
+/* The order in which the interchanges are made is N to IHI+1, */
+/* then 1 to ILO-1. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit. */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The permutations consist of row and column interchanges which put */
+/* the matrix in the form */
+/* */
+/* ( T1 X Y ) */
+/* P A P = ( 0 B Z ) */
+/* ( 0 0 T2 ) */
+/* */
+/* where T1 and T2 are upper triangular matrices whose eigenvalues lie */
+/* along the diagonal. The column indices ILO and IHI mark the starting */
+/* and ending columns of the submatrix B. Balancing consists of applying */
+/* a diagonal similarity transformation inv(D) * B * D to make the */
+/* 1-norms of each row of B and its corresponding column nearly equal. */
+/* The output matrix is */
+/* */
+/* ( T1 X*D Y ) */
+/* ( 0 inv(D)*B*D inv(D)*Z ). */
+/* ( 0 0 T2 ) */
+/* */
+/* Information about the permutations P and the diagonal matrix D is */
+/* returned in the vector SCALE. */
+/* */
+/* This subroutine is based on the EISPACK routine CBAL. */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (! lsame_(job, "N") && ! lsame_(job, "P") && ! lsame_(job, "S") && ! lsame_(job, "B")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBAL", &i__1);
+ return;
+ }
+
+ k = 0;
+ l = *n;
+
+ if (*n == 0) {
+ goto L210;
+ }
+
+ if (lsame_(job, "N")) {
+ for (i = 0; i < *n; ++i) {
+ scale[i] = 1.;
+ }
+ goto L210;
+ }
+
+ if (lsame_(job, "S")) {
+ goto L120;
+ }
+
+/* Permutation to isolate eigenvalues if possible */
+
+ goto L50;
+
+/* Row and column exchange. */
+
+L20:
+ scale[m] = (doublereal) j+1;
+ if (j == m) {
+ goto L30;
+ }
+
+ zswap_(&l, &a[j * *lda], &c__1, &a[m * *lda], &c__1);
+ i__1 = *n - k;
+ zswap_(&i__1, &a[j + k * *lda], lda, &a[m + k * *lda], lda);
+
+L30:
+ switch ((int)iexc) {
+ case 1: goto L40;
+ case 2: goto L80;
+ }
+
+/* Search for rows isolating an eigenvalue and push them down. */
+
+L40:
+ if (l == 1) {
+ goto L210;
+ }
+ --l;
+
+L50:
+ for (j = l-1; j >= 0; --j) {
+ for (i = 0; i < l; ++i) {
+ if (i == j) {
+ continue; /* next i */
+ }
+ i__1 = j + i * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ goto L70; /* next j */
+ }
+ }
+ m = l-1;
+ iexc = 1;
+ goto L20;
+L70:
+ ;
+ }
+
+ goto L90;
+
+/* Search for columns isolating an eigenvalue and push them left. */
+
+L80:
+ ++k;
+
+L90:
+ for (j = k; j < l; ++j) {
+ for (i = k; i < l; ++i) {
+ if (i == j) {
+ continue; /* next i */
+ }
+ i__1 = i + j * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ goto L110; /* next j */
+ }
+ }
+ m = k;
+ iexc = 2;
+ goto L20;
+L110:
+ ;
+ }
+
+L120:
+ for (i = k; i < l; ++i) {
+ scale[i] = 1.;
+ }
+
+ if (lsame_(job, "P")) {
+ goto L210;
+ }
+
+/* Balance the submatrix in rows K to L. */
+
+/* Iterative loop for norm reduction */
+
+ sfmin1 = dlamch_("S") / dlamch_("P");
+ sfmax1 = 1. / sfmin1;
+ sfmin2 = sfmin1 * 10.;
+ sfmax2 = 1. / sfmin2;
+L140:
+ noconv = FALSE_;
+
+ for (i = k; i < l; ++i) {
+ c = 0.; r = 0.;
+
+ for (j = k; j < l; ++j) {
+ if (j == i) {
+ continue; /* next j */
+ }
+ i__1 = j + i * *lda;
+ c += abs(a[i__1].r) + abs(a[i__1].i);
+ i__1 = i + j * *lda;
+ r += abs(a[i__1].r) + abs(a[i__1].i);
+ }
+ ica = izamax_(&l, &a[i * *lda], &c__1) - 1;
+ ca = z_abs(&a[ica + i * *lda]);
+ i__1 = *n - k;
+ ira = izamax_(&i__1, &a[i + k * *lda], lda) - 1;
+ ra = z_abs(&a[i + (ira + k) * *lda]);
+
+/* Guard against zero C or R due to underflow. */
+
+ if (c == 0. || r == 0.) {
+ continue; /* next i */
+ }
+ g = r / 10.; f = 1.;
+ s = c + r;
+L160:
+ if (c >= g || max(max(f,c),ca) >= sfmax2 || min(min(r,g),ra) <= sfmin2) {
+ goto L170;
+ }
+ f *= 10.; c *= 10.; ca *= 10.;
+ r /= 10.; g /= 10.; ra /= 10.;
+ goto L160;
+
+L170:
+ g = c / 10.;
+L180:
+ if (g < r || max(r,ra) >= sfmax2 || min(min(min(f,c),g),ca) <= sfmin2) {
+ goto L190;
+ }
+ f /= 10.; c /= 10.; g /= 10.; ca /= 10.;
+ r *= 10.; ra *= 10.;
+ goto L180;
+
+/* Now balance. */
+
+L190:
+ if (c + r >= s * .95) {
+ continue; /* next i */
+ }
+ if (f < 1. && scale[i] < 1.) {
+ if (f * scale[i] <= sfmin1) {
+ continue; /* next i */
+ }
+ }
+ if (f > 1. && scale[i] > 1.) {
+ if (scale[i] >= sfmax1 / f) {
+ continue; /* next i */
+ }
+ }
+ g = 1. / f;
+ scale[i] *= f;
+ noconv = TRUE_;
+
+ i__1 = *n - k;
+ zdscal_(&i__1, &g, &a[i + k * *lda], lda);
+ zdscal_(&l, &f, &a[i * *lda], &c__1);
+ }
+
+ if (noconv) {
+ goto L140;
+ }
+
+L210:
+ *ilo = k+1;
+ *ihi = l;
+} /* zgebal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.f
new file mode 100644
index 0000000000000000000000000000000000000000..a09cc3b49e703690bcbf0d36622b66aa7d51ae11
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgebal.f
@@ -0,0 +1,328 @@
+ SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOB
+ INTEGER IHI, ILO, INFO, LDA, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION SCALE( * )
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEBAL balances a general complex matrix A. This involves, first,
+* permuting A by a similarity transformation to isolate eigenvalues
+* in the first 1 to ILO-1 and last IHI+1 to N elements on the
+* diagonal; and second, applying a diagonal similarity transformation
+* to rows and columns ILO to IHI to make the rows and columns as
+* close in norm as possible. Both steps are optional.
+*
+* Balancing may reduce the 1-norm of the matrix, and improve the
+* accuracy of the computed eigenvalues and/or eigenvectors.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* Specifies the operations to be performed on A:
+* = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+* for i = 1,...,N;
+* = 'P': permute only;
+* = 'S': scale only;
+* = 'B': both permute and scale.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the input matrix A.
+* On exit, A is overwritten by the balanced matrix.
+* If JOB = 'N', A is not referenced.
+* See Further Details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* ILO (output) INTEGER
+* IHI (output) INTEGER
+* ILO and IHI are set to integers such that on exit
+* A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+* If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+*
+* SCALE (output) DOUBLE PRECISION array, dimension (N)
+* Details of the permutations and scaling factors applied to
+* A. If P(j) is the index of the row and column interchanged
+* with row and column j and D(j) is the scaling factor
+* applied to row and column j, then
+* SCALE(j) = P(j) for j = 1,...,ILO-1
+* = D(j) for j = ILO,...,IHI
+* = P(j) for j = IHI+1,...,N.
+* The order in which the interchanges are made is N to IHI+1,
+* then 1 to ILO-1.
+*
+* INFO (output) INTEGER
+* = 0: successful exit.
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* The permutations consist of row and column interchanges which put
+* the matrix in the form
+*
+* ( T1 X Y )
+* P A P = ( 0 B Z )
+* ( 0 0 T2 )
+*
+* where T1 and T2 are upper triangular matrices whose eigenvalues lie
+* along the diagonal. The column indices ILO and IHI mark the starting
+* and ending columns of the submatrix B. Balancing consists of applying
+* a diagonal similarity transformation inv(D) * B * D to make the
+* 1-norms of each row of B and its corresponding column nearly equal.
+* The output matrix is
+*
+* ( T1 X*D Y )
+* ( 0 inv(D)*B*D inv(D)*Z ).
+* ( 0 0 T2 )
+*
+* Information about the permutations P and the diagonal matrix D is
+* returned in the vector SCALE.
+*
+* This subroutine is based on the EISPACK routine CBAL.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ DOUBLE PRECISION SCLFAC
+ PARAMETER ( SCLFAC = 1.0D+1 )
+ DOUBLE PRECISION FACTOR
+ PARAMETER ( FACTOR = 0.95D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL NOCONV
+ INTEGER I, ICA, IEXC, IRA, J, K, L, M
+ DOUBLE PRECISION C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
+ $ SFMIN2
+ COMPLEX*16 CDUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IZAMAX
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL LSAME, IZAMAX, DLAMCH
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZDSCAL, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DIMAG, MAX, MIN
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1
+* ..
+* .. Statement Function definitions ..
+ CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
+ $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -4
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEBAL', -INFO )
+ RETURN
+ END IF
+*
+ K = 1
+ L = N
+*
+ IF( N.EQ.0 )
+ $ GO TO 210
+*
+ IF( LSAME( JOB, 'N' ) ) THEN
+ DO 10 I = 1, N
+ SCALE( I ) = ONE
+ 10 CONTINUE
+ GO TO 210
+ END IF
+*
+ IF( LSAME( JOB, 'S' ) )
+ $ GO TO 120
+*
+* Permutation to isolate eigenvalues if possible
+*
+ GO TO 50
+*
+* Row and column exchange.
+*
+ 20 CONTINUE
+ SCALE( M ) = J
+ IF( J.EQ.M )
+ $ GO TO 30
+*
+ CALL ZSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
+ CALL ZSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
+*
+ 30 CONTINUE
+ GO TO ( 40, 80 )IEXC
+*
+* Search for rows isolating an eigenvalue and push them down.
+*
+ 40 CONTINUE
+ IF( L.EQ.1 )
+ $ GO TO 210
+ L = L - 1
+*
+ 50 CONTINUE
+ DO 70 J = L, 1, -1
+*
+ DO 60 I = 1, L
+ IF( I.EQ.J )
+ $ GO TO 60
+ IF( DBLE( A( J, I ) ).NE.ZERO .OR. DIMAG( A( J, I ) ).NE.
+ $ ZERO )GO TO 70
+ 60 CONTINUE
+*
+ M = L
+ IEXC = 1
+ GO TO 20
+ 70 CONTINUE
+*
+ GO TO 90
+*
+* Search for columns isolating an eigenvalue and push them left.
+*
+ 80 CONTINUE
+ K = K + 1
+*
+ 90 CONTINUE
+ DO 110 J = K, L
+*
+ DO 100 I = K, L
+ IF( I.EQ.J )
+ $ GO TO 100
+ IF( DBLE( A( I, J ) ).NE.ZERO .OR. DIMAG( A( I, J ) ).NE.
+ $ ZERO )GO TO 110
+ 100 CONTINUE
+*
+ M = K
+ IEXC = 2
+ GO TO 20
+ 110 CONTINUE
+*
+ 120 CONTINUE
+ DO 130 I = K, L
+ SCALE( I ) = ONE
+ 130 CONTINUE
+*
+ IF( LSAME( JOB, 'P' ) )
+ $ GO TO 210
+*
+* Balance the submatrix in rows K to L.
+*
+* Iterative loop for norm reduction
+*
+ SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
+ SFMAX1 = ONE / SFMIN1
+ SFMIN2 = SFMIN1*SCLFAC
+ SFMAX2 = ONE / SFMIN2
+ 140 CONTINUE
+ NOCONV = .FALSE.
+*
+ DO 200 I = K, L
+ C = ZERO
+ R = ZERO
+*
+ DO 150 J = K, L
+ IF( J.EQ.I )
+ $ GO TO 150
+ C = C + CABS1( A( J, I ) )
+ R = R + CABS1( A( I, J ) )
+ 150 CONTINUE
+ ICA = IZAMAX( L, A( 1, I ), 1 )
+ CA = ABS( A( ICA, I ) )
+ IRA = IZAMAX( N-K+1, A( I, K ), LDA )
+ RA = ABS( A( I, IRA+K-1 ) )
+*
+* Guard against zero C or R due to underflow.
+*
+ IF( C.EQ.ZERO .OR. R.EQ.ZERO )
+ $ GO TO 200
+ G = R / SCLFAC
+ F = ONE
+ S = C + R
+ 160 CONTINUE
+ IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
+ $ MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
+ F = F*SCLFAC
+ C = C*SCLFAC
+ CA = CA*SCLFAC
+ R = R / SCLFAC
+ G = G / SCLFAC
+ RA = RA / SCLFAC
+ GO TO 160
+*
+ 170 CONTINUE
+ G = C / SCLFAC
+ 180 CONTINUE
+ IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
+ $ MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
+ F = F / SCLFAC
+ C = C / SCLFAC
+ G = G / SCLFAC
+ CA = CA / SCLFAC
+ R = R*SCLFAC
+ RA = RA*SCLFAC
+ GO TO 180
+*
+* Now balance.
+*
+ 190 CONTINUE
+ IF( ( C+R ).GE.FACTOR*S )
+ $ GO TO 200
+ IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
+ IF( F*SCALE( I ).LE.SFMIN1 )
+ $ GO TO 200
+ END IF
+ IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
+ IF( SCALE( I ).GE.SFMAX1 / F )
+ $ GO TO 200
+ END IF
+ G = ONE / F
+ SCALE( I ) = SCALE( I )*F
+ NOCONV = .TRUE.
+*
+ CALL ZDSCAL( N-K+1, G, A( I, K ), LDA )
+ CALL ZDSCAL( L, F, A( 1, I ), 1 )
+*
+ 200 CONTINUE
+*
+ IF( NOCONV )
+ $ GO TO 140
+*
+ 210 CONTINUE
+ ILO = K
+ IHI = L
+*
+ RETURN
+*
+* End of ZGEBAL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.c
new file mode 100644
index 0000000000000000000000000000000000000000..6c462b2afb95b0ccc9a320384f4d9c810d4fab74
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.c
@@ -0,0 +1,398 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c__8 = 8;
+static integer c_n1 = -1;
+static integer c__4 = 4;
+
+/* Subroutine */ void zgeev_(jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, work, lwork, rwork, info)
+const char *jobvl, *jobvr;
+const integer *n;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *w, *vl;
+const integer *ldvl;
+doublecomplex *vr;
+const integer *ldvr;
+doublecomplex *work;
+integer *lwork;
+doublereal *rwork;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer ibal;
+ static char side[1];
+ static integer maxb;
+ static doublereal anrm;
+ static integer ierr, itau, iwrk, nout, i, k;
+ static logical scalea;
+ static doublereal cscale;
+ static logical select[1];
+ static doublereal bignum;
+ static integer minwrk, maxwrk;
+ static logical wantvl;
+ static doublereal smlnum;
+ static integer hswork, irwork;
+ static logical wantvr;
+ static integer ihi;
+ static doublereal scl;
+ static integer ilo;
+ static doublereal dum[1], eps;
+ static doublecomplex tmp;
+
+
+/* -- LAPACK driver routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the */
+/* eigenvalues and, optionally, the left and/or right eigenvectors. */
+/* */
+/* The right eigenvector v(j) of A satisfies */
+/* A * v(j) = lambda(j) * v(j) */
+/* where lambda(j) is its eigenvalue. */
+/* The left eigenvector u(j) of A satisfies */
+/* u(j)**H * A = lambda(j) * u(j)**H */
+/* where u(j)**H denotes the conjugate transpose of u(j). */
+/* */
+/* The computed eigenvectors are normalized to have Euclidean norm */
+/* equal to 1 and largest component real. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOBVL (input) CHARACTER*1 */
+/* = 'N': left eigenvectors of A are not computed; */
+/* = 'V': left eigenvectors of are computed. */
+/* */
+/* JOBVR (input) CHARACTER*1 */
+/* = 'N': right eigenvectors of A are not computed; */
+/* = 'V': right eigenvectors of A are computed. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the N-by-N matrix A. */
+/* On exit, A has been overwritten. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* W (output) COMPLEX*16 array, dimension (N) */
+/* W contains the computed eigenvalues. */
+/* */
+/* VL (output) COMPLEX*16 array, dimension (LDVL,N) */
+/* If JOBVL = 'V', the left eigenvectors u(j) are stored one */
+/* after another in the columns of VL, in the same order */
+/* as their eigenvalues. */
+/* If JOBVL = 'N', VL is not referenced. */
+/* u(j) = VL(:,j), the j-th column of VL. */
+/* */
+/* LDVL (input) INTEGER */
+/* The leading dimension of the array VL. LDVL >= 1; if */
+/* JOBVL = 'V', LDVL >= N. */
+/* */
+/* VR (output) COMPLEX*16 array, dimension (LDVR,N) */
+/* If JOBVR = 'V', the right eigenvectors v(j) are stored one */
+/* after another in the columns of VR, in the same order */
+/* as their eigenvalues. */
+/* If JOBVR = 'N', VR is not referenced. */
+/* v(j) = VR(:,j), the j-th column of VR. */
+/* */
+/* LDVR (input) INTEGER */
+/* The leading dimension of the array VR. LDVR >= 1; if */
+/* JOBVR = 'V', LDVR >= N. */
+/* */
+/* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,2*N). */
+/* For good performance, LWORK must generally be larger. */
+/* */
+/* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* > 0: if INFO = i, the QR algorithm failed to compute all the */
+/* eigenvalues, and no eigenvectors have been computed; */
+/* elements and i+1:N of W contain eigenvalues which have */
+/* converged. */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ wantvl = lsame_(jobvl, "V");
+ wantvr = lsame_(jobvr, "V");
+ if (! wantvl && ! lsame_(jobvl, "N")) {
+ *info = -1;
+ } else if (! wantvr && ! lsame_(jobvr, "N")) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldvl < 1 || (wantvl && *ldvl < *n)) {
+ *info = -8;
+ } else if (*ldvr < 1 || (wantvr && *ldvr < *n)) {
+ *info = -10;
+ }
+
+/* Compute workspace */
+/* (Note: Comments in the code beginning "Workspace:" describe the */
+/* minimal amount of workspace needed at that point in the code, */
+/* as well as the preferred amount for good performance. */
+/* CWorkspace refers to complex workspace, and RWorkspace to real */
+/* workspace. NB refers to the optimal block size for the */
+/* immediately following subroutine, as returned by ILAENV. */
+/* HSWORK refers to the workspace preferred by ZHSEQR, as */
+/* calculated below. HSWORK is computed assuming ILO=1 and IHI=N, */
+/* the worst case.) */
+
+ minwrk = 1;
+ if (*info == 0 && *lwork >= 1) {
+ maxwrk = *n + *n * ilaenv_(&c__1, "ZGEHRD", " ", n, &c__1, n, &c__0);
+ if (! wantvl && ! wantvr) {
+ minwrk = max(1,(*n<<1));
+ maxb = ilaenv_(&c__8, "ZHSEQR", "EN", n, &c__1, n, &c_n1);
+ maxb = max(maxb,2);
+ k = ilaenv_(&c__4, "ZHSEQR", "EN", n, &c__1, n, &c_n1);
+ k = min(min(maxb,*n),max(2,k));
+ hswork = max(k * (k + 2),(*n<<1));
+ maxwrk = max(maxwrk,hswork);
+ } else {
+ minwrk = max(1,(*n<<1));
+ i__1 = *n + (*n - 1) * ilaenv_(&c__1, "ZUNGHR", " ", n, &c__1, n, &c_n1);
+ maxwrk = max(maxwrk,i__1);
+ maxb = ilaenv_(&c__8, "ZHSEQR", "SV", n, &c__1, n, &c_n1);
+ maxb = max(maxb,2);
+ k = ilaenv_(&c__4, "ZHSEQR", "SV", n, &c__1, n, &c_n1);
+ k = min(min(maxb,*n),max(2,k));
+ hswork = max(k * (k + 2),(*n<<1));
+ maxwrk = max(max(maxwrk,hswork),(*n<<1));
+ }
+ work[0].r = (doublereal) maxwrk, work[0].i = 0.;
+ }
+ if (*lwork < minwrk) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEEV ", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+
+/* Get machine constants */
+
+ eps = dlamch_("P");
+ smlnum = dlamch_("S");
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+ smlnum = sqrt(smlnum) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = zlange_("M", n, n, a, lda, dum);
+ scalea = FALSE_;
+ if (anrm > 0. && anrm < smlnum) {
+ scalea = TRUE_;
+ cscale = smlnum;
+ } else if (anrm > bignum) {
+ scalea = TRUE_;
+ cscale = bignum;
+ }
+ if (scalea) {
+ zlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, a, lda, &ierr);
+ }
+
+/* Balance the matrix */
+/* (CWorkspace: none) */
+/* (RWorkspace: need N) */
+
+ ibal = 0;
+ zgebal_("B", n, a, lda, &ilo, &ihi, &rwork[ibal], &ierr);
+
+/* Reduce to upper Hessenberg form */
+/* (CWorkspace: need 2*N, prefer N+N*NB) */
+/* (RWorkspace: none) */
+
+ itau = 0;
+ iwrk = itau + *n;
+ i__1 = *lwork - iwrk;
+ zgehrd_(n, &ilo, &ihi, a, lda, &work[itau], &work[iwrk], &i__1, &ierr);
+
+ if (wantvl) {
+
+/* Want left eigenvectors */
+/* Copy Householder vectors to VL */
+
+ *side = 'L';
+ zlacpy_("L", n, n, a, lda, vl, ldvl);
+
+/* Generate unitary matrix in VL */
+/* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) */
+/* (RWorkspace: none) */
+
+ i__1 = *lwork - iwrk;
+ zunghr_(n, &ilo, &ihi, vl, ldvl, &work[itau], &work[iwrk], &i__1, &ierr);
+
+/* Perform QR iteration, accumulating Schur vectors in VL */
+/* (CWorkspace: need 1, prefer HSWORK (see comments) ) */
+/* (RWorkspace: none) */
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk;
+ zhseqr_("S", "V", n, &ilo, &ihi, a, lda, w, vl, ldvl, &work[iwrk], &i__1, info);
+
+ if (wantvr) {
+
+/* Want left and right eigenvectors */
+/* Copy Schur vectors to VR */
+
+ *side = 'B';
+ zlacpy_("F", n, n, vl, ldvl, vr, ldvr);
+ }
+
+ } else if (wantvr) {
+
+/* Want right eigenvectors */
+/* Copy Householder vectors to VR */
+
+ *side = 'R';
+ zlacpy_("L", n, n, a, lda, vr, ldvr);
+
+/* Generate unitary matrix in VR */
+/* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) */
+/* (RWorkspace: none) */
+
+ i__1 = *lwork - iwrk;
+ zunghr_(n, &ilo, &ihi, vr, ldvr, &work[itau], &work[iwrk], &i__1, &ierr);
+
+/* Perform QR iteration, accumulating Schur vectors in VR */
+/* (CWorkspace: need 1, prefer HSWORK (see comments) ) */
+/* (RWorkspace: none) */
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk;
+ zhseqr_("S", "V", n, &ilo, &ihi, a, lda, w, vr, ldvr, &work[iwrk], &i__1, info);
+
+ } else {
+
+/* Compute eigenvalues only */
+/* (CWorkspace: need 1, prefer HSWORK (see comments) ) */
+/* (RWorkspace: none) */
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk;
+ zhseqr_("E", "N", n, &ilo, &ihi, a, lda, w, vr, ldvr, &work[iwrk], &i__1, info);
+ }
+
+/* If INFO > 0 from ZHSEQR, then quit */
+
+ if (*info > 0) {
+ goto L50;
+ }
+
+ if (wantvl || wantvr) {
+
+/* Compute left and/or right eigenvectors */
+/* (CWorkspace: need 2*N) */
+/* (RWorkspace: need 2*N) */
+
+ irwork = ibal + *n;
+ ztrevc_(side, "B", select, n, a, lda, vl, ldvl, vr, ldvr, n, &nout, &work[iwrk], &rwork[irwork], &ierr);
+ }
+
+ if (wantvl) {
+
+/* Undo balancing of left eigenvectors */
+/* (CWorkspace: none) */
+/* (RWorkspace: need N) */
+
+ zgebak_("B", "L", n, &ilo, &ihi, &rwork[ibal], n, vl, ldvl, &ierr);
+
+/* Normalize left eigenvectors and make largest component real */
+
+ for (i = 0; i < *n; ++i) {
+ scl = 1. / dznrm2_(n, &vl[i * *ldvl], &c__1);
+ zdscal_(n, &scl, &vl[i * *ldvl], &c__1);
+ for (k = 0; k < *n; ++k) {
+ i__1 = k + i * *ldvl; /* index [k,i] */
+ rwork[irwork + k] = vl[i__1].r * vl[i__1].r + vl[i__1].i * vl[i__1].i;
+ }
+ k = idamax_(n, &rwork[irwork], &c__1) - 1;
+ d_cnjg(&tmp, &vl[k + i * *ldvl]);
+ d__1 = sqrt(rwork[irwork + k]);
+ tmp.r /= d__1, tmp.i /= d__1;
+ zscal_(n, &tmp, &vl[i * *ldvl], &c__1);
+ vl[k + i * *ldvl].i = 0.;
+ }
+ }
+
+ if (wantvr) {
+
+/* Undo balancing of right eigenvectors */
+/* (CWorkspace: none) */
+/* (RWorkspace: need N) */
+
+ zgebak_("B", "R", n, &ilo, &ihi, &rwork[ibal], n, vr, ldvr, &ierr);
+
+/* Normalize right eigenvectors and make largest component real */
+
+ for (i = 0; i < *n; ++i) {
+ scl = 1. / dznrm2_(n, &vr[i * *ldvr], &c__1);
+ zdscal_(n, &scl, &vr[i * *ldvr], &c__1);
+ for (k = 0; k < *n; ++k) {
+ i__1 = k + i * *ldvr; /* index [k,i] */
+ rwork[irwork + k] = vr[i__1].r * vr[i__1].r + vr[i__1].i * vr[i__1].i;
+ }
+ k = idamax_(n, &rwork[irwork], &c__1) - 1;
+ d_cnjg(&tmp, &vr[k + i * *ldvr]);
+ d__1 = sqrt(rwork[irwork + k]);
+ tmp.r /= d__1, tmp.i /= d__1;
+ zscal_(n, &tmp, &vr[i * *ldvr], &c__1);
+ vr[k + i * *ldvr].i = 0.;
+ }
+ }
+
+/* Undo scaling if necessary */
+
+L50:
+ if (scalea) {
+ i__1 = *n - *info;
+ i__2 = max(i__1, 1);
+ zlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &w[*info], &i__2, &ierr);
+ if (*info > 0) {
+ i__1 = ilo - 1;
+ zlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, w, n, &ierr);
+ }
+ }
+
+ work[0].r = (doublereal) maxwrk, work[0].i = 0.;
+
+} /* zgeev_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.f
new file mode 100644
index 0000000000000000000000000000000000000000..4ccc8e04b7009d64f5b34e204c2c0493f60f3bf3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgeev.f
@@ -0,0 +1,383 @@
+ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
+ $ WORK, LWORK, RWORK, INFO )
+*
+* -- LAPACK driver routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER JOBVL, JOBVR
+ INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
+ $ W( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
+* eigenvalues and, optionally, the left and/or right eigenvectors.
+*
+* The right eigenvector v(j) of A satisfies
+* A * v(j) = lambda(j) * v(j)
+* where lambda(j) is its eigenvalue.
+* The left eigenvector u(j) of A satisfies
+* u(j)**H * A = lambda(j) * u(j)**H
+* where u(j)**H denotes the conjugate transpose of u(j).
+*
+* The computed eigenvectors are normalized to have Euclidean norm
+* equal to 1 and largest component real.
+*
+* Arguments
+* =========
+*
+* JOBVL (input) CHARACTER*1
+* = 'N': left eigenvectors of A are not computed;
+* = 'V': left eigenvectors of are computed.
+*
+* JOBVR (input) CHARACTER*1
+* = 'N': right eigenvectors of A are not computed;
+* = 'V': right eigenvectors of A are computed.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the N-by-N matrix A.
+* On exit, A has been overwritten.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* W (output) COMPLEX*16 array, dimension (N)
+* W contains the computed eigenvalues.
+*
+* VL (output) COMPLEX*16 array, dimension (LDVL,N)
+* If JOBVL = 'V', the left eigenvectors u(j) are stored one
+* after another in the columns of VL, in the same order
+* as their eigenvalues.
+* If JOBVL = 'N', VL is not referenced.
+* u(j) = VL(:,j), the j-th column of VL.
+*
+* LDVL (input) INTEGER
+* The leading dimension of the array VL. LDVL >= 1; if
+* JOBVL = 'V', LDVL >= N.
+*
+* VR (output) COMPLEX*16 array, dimension (LDVR,N)
+* If JOBVR = 'V', the right eigenvectors v(j) are stored one
+* after another in the columns of VR, in the same order
+* as their eigenvalues.
+* If JOBVR = 'N', VR is not referenced.
+* v(j) = VR(:,j), the j-th column of VR.
+*
+* LDVR (input) INTEGER
+* The leading dimension of the array VR. LDVR >= 1; if
+* JOBVR = 'V', LDVR >= N.
+*
+* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= max(1,2*N).
+* For good performance, LWORK must generally be larger.
+*
+* RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+* > 0: if INFO = i, the QR algorithm failed to compute all the
+* eigenvalues, and no eigenvectors have been computed;
+* elements and i+1:N of W contain eigenvalues which have
+* converged.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL SCALEA, WANTVL, WANTVR
+ CHARACTER SIDE
+ INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
+ $ IWRK, K, MAXB, MAXWRK, MINWRK, NOUT
+ DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
+ COMPLEX*16 TMP
+* ..
+* .. Local Arrays ..
+ LOGICAL SELECT( 1 )
+ DOUBLE PRECISION DUM( 1 )
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD,
+ $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IDAMAX, ILAENV
+ DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE
+ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ WANTVL = LSAME( JOBVL, 'V' )
+ WANTVR = LSAME( JOBVR, 'V' )
+ IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
+ INFO = -1
+ ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
+ INFO = -8
+ ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
+ INFO = -10
+ END IF
+*
+* Compute workspace
+* (Note: Comments in the code beginning "Workspace:" describe the
+* minimal amount of workspace needed at that point in the code,
+* as well as the preferred amount for good performance.
+* CWorkspace refers to complex workspace, and RWorkspace to real
+* workspace. NB refers to the optimal block size for the
+* immediately following subroutine, as returned by ILAENV.
+* HSWORK refers to the workspace preferred by ZHSEQR, as
+* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
+* the worst case.)
+*
+ MINWRK = 1
+ IF( INFO.EQ.0 .AND. LWORK.GE.1 ) THEN
+ MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 )
+ IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
+ MINWRK = MAX( 1, 2*N )
+ MAXB = MAX( ILAENV( 8, 'ZHSEQR', 'EN', N, 1, N, -1 ), 2 )
+ K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'ZHSEQR', 'EN', N, 1,
+ $ N, -1 ) ) )
+ HSWORK = MAX( K*( K+2 ), 2*N )
+ MAXWRK = MAX( MAXWRK, HSWORK )
+ ELSE
+ MINWRK = MAX( 1, 2*N )
+ MAXWRK = MAX( MAXWRK, N+( N-1 )*
+ $ ILAENV( 1, 'ZUNGHR', ' ', N, 1, N, -1 ) )
+ MAXB = MAX( ILAENV( 8, 'ZHSEQR', 'SV', N, 1, N, -1 ), 2 )
+ K = MIN( MAXB, N, MAX( 2, ILAENV( 4, 'ZHSEQR', 'SV', N, 1,
+ $ N, -1 ) ) )
+ HSWORK = MAX( K*( K+2 ), 2*N )
+ MAXWRK = MAX( MAXWRK, HSWORK, 2*N )
+ END IF
+ WORK( 1 ) = MAXWRK
+ END IF
+ IF( LWORK.LT.MINWRK ) THEN
+ INFO = -12
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEEV ', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* Get machine constants
+*
+ EPS = DLAMCH( 'P' )
+ SMLNUM = DLAMCH( 'S' )
+ BIGNUM = ONE / SMLNUM
+ CALL DLABAD( SMLNUM, BIGNUM )
+ SMLNUM = SQRT( SMLNUM ) / EPS
+ BIGNUM = ONE / SMLNUM
+*
+* Scale A if max element outside range [SMLNUM,BIGNUM]
+*
+ ANRM = ZLANGE( 'M', N, N, A, LDA, DUM )
+ SCALEA = .FALSE.
+ IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+ SCALEA = .TRUE.
+ CSCALE = SMLNUM
+ ELSE IF( ANRM.GT.BIGNUM ) THEN
+ SCALEA = .TRUE.
+ CSCALE = BIGNUM
+ END IF
+ IF( SCALEA )
+ $ CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
+*
+* Balance the matrix
+* (CWorkspace: none)
+* (RWorkspace: need N)
+*
+ IBAL = 1
+ CALL ZGEBAL( 'B', N, A, LDA, ILO, IHI, RWORK( IBAL ), IERR )
+*
+* Reduce to upper Hessenberg form
+* (CWorkspace: need 2*N, prefer N+N*NB)
+* (RWorkspace: none)
+*
+ ITAU = 1
+ IWRK = ITAU + N
+ CALL ZGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
+ $ LWORK-IWRK+1, IERR )
+*
+ IF( WANTVL ) THEN
+*
+* Want left eigenvectors
+* Copy Householder vectors to VL
+*
+ SIDE = 'L'
+ CALL ZLACPY( 'L', N, N, A, LDA, VL, LDVL )
+*
+* Generate unitary matrix in VL
+* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
+* (RWorkspace: none)
+*
+ CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ),
+ $ LWORK-IWRK+1, IERR )
+*
+* Perform QR iteration, accumulating Schur vectors in VL
+* (CWorkspace: need 1, prefer HSWORK (see comments) )
+* (RWorkspace: none)
+*
+ IWRK = ITAU
+ CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VL, LDVL,
+ $ WORK( IWRK ), LWORK-IWRK+1, INFO )
+*
+ IF( WANTVR ) THEN
+*
+* Want left and right eigenvectors
+* Copy Schur vectors to VR
+*
+ SIDE = 'B'
+ CALL ZLACPY( 'F', N, N, VL, LDVL, VR, LDVR )
+ END IF
+*
+ ELSE IF( WANTVR ) THEN
+*
+* Want right eigenvectors
+* Copy Householder vectors to VR
+*
+ SIDE = 'R'
+ CALL ZLACPY( 'L', N, N, A, LDA, VR, LDVR )
+*
+* Generate unitary matrix in VR
+* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
+* (RWorkspace: none)
+*
+ CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ),
+ $ LWORK-IWRK+1, IERR )
+*
+* Perform QR iteration, accumulating Schur vectors in VR
+* (CWorkspace: need 1, prefer HSWORK (see comments) )
+* (RWorkspace: none)
+*
+ IWRK = ITAU
+ CALL ZHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, W, VR, LDVR,
+ $ WORK( IWRK ), LWORK-IWRK+1, INFO )
+*
+ ELSE
+*
+* Compute eigenvalues only
+* (CWorkspace: need 1, prefer HSWORK (see comments) )
+* (RWorkspace: none)
+*
+ IWRK = ITAU
+ CALL ZHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, W, VR, LDVR,
+ $ WORK( IWRK ), LWORK-IWRK+1, INFO )
+ END IF
+*
+* If INFO > 0 from ZHSEQR, then quit
+*
+ IF( INFO.GT.0 )
+ $ GO TO 50
+*
+ IF( WANTVL .OR. WANTVR ) THEN
+*
+* Compute left and/or right eigenvectors
+* (CWorkspace: need 2*N)
+* (RWorkspace: need 2*N)
+*
+ IRWORK = IBAL + N
+ CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
+ $ N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR )
+ END IF
+*
+ IF( WANTVL ) THEN
+*
+* Undo balancing of left eigenvectors
+* (CWorkspace: none)
+* (RWorkspace: need N)
+*
+ CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, LDVL,
+ $ IERR )
+*
+* Normalize left eigenvectors and make largest component real
+*
+ DO 20 I = 1, N
+ SCL = ONE / DZNRM2( N, VL( 1, I ), 1 )
+ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 )
+ DO 10 K = 1, N
+ RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 +
+ $ DIMAG( VL( K, I ) )**2
+ 10 CONTINUE
+ K = IDAMAX( N, RWORK( IRWORK ), 1 )
+ TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
+ CALL ZSCAL( N, TMP, VL( 1, I ), 1 )
+ VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO )
+ 20 CONTINUE
+ END IF
+*
+ IF( WANTVR ) THEN
+*
+* Undo balancing of right eigenvectors
+* (CWorkspace: none)
+* (RWorkspace: need N)
+*
+ CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, LDVR,
+ $ IERR )
+*
+* Normalize right eigenvectors and make largest component real
+*
+ DO 40 I = 1, N
+ SCL = ONE / DZNRM2( N, VR( 1, I ), 1 )
+ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 )
+ DO 30 K = 1, N
+ RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 +
+ $ DIMAG( VR( K, I ) )**2
+ 30 CONTINUE
+ K = IDAMAX( N, RWORK( IRWORK ), 1 )
+ TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) )
+ CALL ZSCAL( N, TMP, VR( 1, I ), 1 )
+ VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO )
+ 40 CONTINUE
+ END IF
+*
+* Undo scaling if necessary
+*
+ 50 CONTINUE
+ IF( SCALEA ) THEN
+ CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ),
+ $ MAX( N-INFO, 1 ), IERR )
+ IF( INFO.GT.0 ) THEN
+ CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR )
+ END IF
+ END IF
+*
+ WORK( 1 ) = MAXWRK
+ RETURN
+*
+* End of ZGEEV
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.c
new file mode 100644
index 0000000000000000000000000000000000000000..7e74e7dd1be83bf8e55a6e395b98c92105520183
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.c
@@ -0,0 +1,145 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void zgehd2_(n, ilo, ihi, a, lda, tau, work, info)
+const integer *n, *ilo, *ihi;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *tau, *work;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i;
+ static doublecomplex alpha;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H */
+/* by a unitary similarity transformation: Q' * A * Q = H . */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that A is already upper triangular in rows */
+/* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally */
+/* set by a previous call to ZGEBAL; otherwise they should be */
+/* set to 1 and N respectively. See Further Details. */
+/* 1 <= ILO <= IHI <= max(1,N). */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the n by n general matrix to be reduced. */
+/* On exit, the upper triangle and the first subdiagonal of A */
+/* are overwritten with the upper Hessenberg matrix H, and the */
+/* elements below the first subdiagonal, with the array TAU, */
+/* represent the unitary matrix Q as a product of elementary */
+/* reflectors. See Further Details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* TAU (output) COMPLEX*16 array, dimension (N-1) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of (ihi-ilo) elementary */
+/* reflectors */
+/* */
+/* Q = H(ilo) H(ilo+1) . . . H(ihi-1). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a complex scalar, and v is a complex vector with */
+/* v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on */
+/* exit in A(i+2:ihi,i), and tau in TAU(i). */
+/* */
+/* The contents of A are illustrated by the following example, with */
+/* n = 7, ilo = 2 and ihi = 6: */
+/* */
+/* on entry, on exit, */
+/* */
+/* ( a a a a a a a ) ( a a h h h h a ) */
+/* ( a a a a a a ) ( a h h h h a ) */
+/* ( a a a a a a ) ( h h h h h h ) */
+/* ( a a a a a a ) ( v2 h h h h h ) */
+/* ( a a a a a a ) ( v2 v3 h h h h ) */
+/* ( a a a a a a ) ( v2 v3 v4 h h h ) */
+/* ( a ) ( a ) */
+/* */
+/* where a denotes an element of the original matrix A, h denotes a */
+/* modified element of the upper Hessenberg matrix H, and vi denotes an */
+/* element of the vector defining H(i). */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEHD2", &i__1);
+ return;
+ }
+
+ for (i = *ilo - 1; i < *ihi - 1; ++i) {
+
+/* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) */
+
+ i__1 = 1+i*(*lda+1);
+ alpha.r = a[i__1].r, alpha.i = a[i__1].i;
+ i__2 = *ihi - i - 1;
+ zlarfg_(&i__2, &alpha, &a[min(1,*n-i-2)+i__1], &c__1, &tau[i]);
+ a[i__1].r = 1., a[i__1].i = 0.;
+
+/* Apply H(i) to A(1:ihi,i+1:ihi) from the right */
+
+ zlarf_("Right", ihi, &i__2, &a[i__1], &c__1, &tau[i], &a[(i+1)*(*lda)], lda, work);
+
+/* Apply H(i)' to A(i+1:ihi,i+1:n) from the left */
+
+ d_cnjg(&z__1, &tau[i]);
+ i__3 = *n - i - 1;
+ zlarf_("Left", &i__2, &i__3, &a[i__1], &c__1, &z__1, &a[(i+1)*(*lda+1)], lda, work);
+
+ a[i__1].r = alpha.r, a[i__1].i = alpha.i;
+ }
+} /* zgehd2_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.f
new file mode 100644
index 0000000000000000000000000000000000000000..f7745cab005fcffaaacc7b4290ae69723e045e67
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehd2.f
@@ -0,0 +1,149 @@
+ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER IHI, ILO, INFO, LDA, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H
+* by a unitary similarity transformation: Q' * A * Q = H .
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that A is already upper triangular in rows
+* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+* set by a previous call to ZGEBAL; otherwise they should be
+* set to 1 and N respectively. See Further Details.
+* 1 <= ILO <= IHI <= max(1,N).
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the n by n general matrix to be reduced.
+* On exit, the upper triangle and the first subdiagonal of A
+* are overwritten with the upper Hessenberg matrix H, and the
+* elements below the first subdiagonal, with the array TAU,
+* represent the unitary matrix Q as a product of elementary
+* reflectors. See Further Details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* TAU (output) COMPLEX*16 array, dimension (N-1)
+* The scalar factors of the elementary reflectors (see Further
+* Details).
+*
+* WORK (workspace) COMPLEX*16 array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of (ihi-ilo) elementary
+* reflectors
+*
+* Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a complex scalar, and v is a complex vector with
+* v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+* exit in A(i+2:ihi,i), and tau in TAU(i).
+*
+* The contents of A are illustrated by the following example, with
+* n = 7, ilo = 2 and ihi = 6:
+*
+* on entry, on exit,
+*
+* ( a a a a a a a ) ( a a h h h h a )
+* ( a a a a a a ) ( a h h h h a )
+* ( a a a a a a ) ( h h h h h h )
+* ( a a a a a a ) ( v2 h h h h h )
+* ( a a a a a a ) ( v2 v3 h h h h )
+* ( a a a a a a ) ( v2 v3 v4 h h h )
+* ( a ) ( a )
+*
+* where a denotes an element of the original matrix A, h denotes a
+* modified element of the upper Hessenberg matrix H, and vi denotes an
+* element of the vector defining H(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+ COMPLEX*16 ALPHA
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARF, ZLARFG
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ IF( N.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
+ INFO = -2
+ ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEHD2', -INFO )
+ RETURN
+ END IF
+*
+ DO 10 I = ILO, IHI - 1
+*
+* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
+*
+ ALPHA = A( I+1, I )
+ CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) )
+ A( I+1, I ) = ONE
+*
+* Apply H(i) to A(1:ihi,i+1:ihi) from the right
+*
+ CALL ZLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
+ $ A( 1, I+1 ), LDA, WORK )
+*
+* Apply H(i)' to A(i+1:ihi,i+1:n) from the left
+*
+ CALL ZLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
+ $ DCONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
+*
+ A( I+1, I ) = ALPHA
+ 10 CONTINUE
+*
+ RETURN
+*
+* End of ZGEHD2
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..f36b5007391c240688f9f38ffd9aa3bbcae298fa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.c
@@ -0,0 +1,247 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+static integer c__65 = 65;
+static doublecomplex c_b21 = {1.,0.};
+static doublecomplex c_b24 = {-1.,0.};
+
+/* Subroutine */ void zgehrd_(n, ilo, ihi, a, lda, tau, work, lwork, info)
+const integer *n;
+integer *ilo, *ihi;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *tau, *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i;
+ static doublecomplex t[4160] /* was [65][64] */;
+ static integer nbmin, iinfo;
+ static integer ib;
+ static doublecomplex ei;
+ static integer nb, nh, nx;
+ static integer ldwork, iws;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEHRD reduces a complex general matrix A to upper Hessenberg form H */
+/* by a unitary similarity transformation: Q' * A * Q = H . */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that A is already upper triangular in rows */
+/* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally */
+/* set by a previous call to ZGEBAL; otherwise they should be */
+/* set to 1 and N respectively. See Further Details. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the N-by-N general matrix to be reduced. */
+/* On exit, the upper triangle and the first subdiagonal of A */
+/* are overwritten with the upper Hessenberg matrix H, and the */
+/* elements below the first subdiagonal, with the array TAU, */
+/* represent the unitary matrix Q as a product of elementary */
+/* reflectors. See Further Details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* TAU (output) COMPLEX*16 array, dimension (N-1) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to */
+/* zero. */
+/* */
+/* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The length of the array WORK. LWORK >= max(1,N). */
+/* For optimum performance LWORK >= N*NB, where NB is the */
+/* optimal blocksize. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of (ihi-ilo) elementary */
+/* reflectors */
+/* */
+/* Q = H(ilo) H(ilo+1) . . . H(ihi-1). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a complex scalar, and v is a complex vector with */
+/* v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on */
+/* exit in A(i+2:ihi,i), and tau in TAU(i). */
+/* */
+/* The contents of A are illustrated by the following example, with */
+/* n = 7, ilo = 2 and ihi = 6: */
+/* */
+/* on entry, on exit, */
+/* */
+/* ( a a a a a a a ) ( a a h h h h a ) */
+/* ( a a a a a a ) ( a h h h h a ) */
+/* ( a a a a a a ) ( h h h h h h ) */
+/* ( a a a a a a ) ( v2 h h h h h ) */
+/* ( a a a a a a ) ( v2 v3 h h h h ) */
+/* ( a a a a a a ) ( v2 v3 v4 h h h ) */
+/* ( a ) ( a ) */
+/* */
+/* where a denotes an element of the original matrix A, h denotes a */
+/* modified element of the upper Hessenberg matrix H, and vi denotes an */
+/* element of the vector defining H(i). */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*lwork < max(1,*n)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEHRD", &i__1);
+ return;
+ }
+
+/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */
+
+ for (i = 0; i < *ilo-1; ++i) {
+ tau[i].r = 0., tau[i].i = 0.;
+ }
+ for (i = max(0,*ihi-1); i < *n-1; ++i) {
+ tau[i].r = 0., tau[i].i = 0.;
+ }
+
+/* Quick return if possible */
+
+ nh = *ihi - *ilo + 1;
+ if (nh <= 1) {
+ work[0].r = 1., work[0].i = 0.;
+ return;
+ }
+
+/* Determine the block size. */
+
+ i__2 = ilaenv_(&c__1, "ZGEHRD", " ", n, ilo, ihi, &c_n1);
+ nb = min(64,i__2);
+ nbmin = 2;
+ iws = 1;
+ if (nb > 1 && nb < nh) {
+
+/* Determine when to cross over from blocked to unblocked code */
+/* (last block is always handled by unblocked code). */
+
+ i__2 = ilaenv_(&c__3, "ZGEHRD", " ", n, ilo, ihi, &c_n1);
+ nx = max(nb,i__2);
+ if (nx < nh) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ iws = *n * nb;
+ if (*lwork < iws) {
+
+/* Not enough workspace to use optimal NB: determine the */
+/* minimum value of NB, and reduce NB or force use of */
+/* unblocked code. */
+
+ i__2 = ilaenv_(&c__2, "ZGEHRD", " ", n, ilo, ihi, &c_n1);
+ nbmin = max(2,i__2);
+ if (*lwork >= *n * nbmin) {
+ nb = *lwork / *n;
+ } else {
+ nb = 1;
+ }
+ }
+ }
+ }
+ ldwork = *n;
+
+ if (nb < nbmin || nb >= nh) {
+
+/* Use unblocked code below */
+
+ i = *ilo-1;
+
+ } else {
+
+/* Use blocked code */
+
+ i__1 = *ihi - 2 - nx;
+ for (i = *ilo-1; nb < 0 ? i >= i__1 : i <= i__1; i += nb) {
+ i__4 = *ihi-1 - i;
+ ib = min(nb,i__4);
+
+/* Reduce columns i:i+ib-1 to Hessenberg form, returning the */
+/* matrices V and T of the block reflector H = I - V*T*V' */
+/* which performs the reduction, and also the matrix Y = A*V*T */
+
+ i__1 = i + 1;
+ zlahrd_(ihi, &i__1, &ib, &a[i * *lda], lda, &tau[i], t, &c__65, work, &ldwork);
+
+/* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the right, */
+/* computing A := A - Y * V'. V(i+ib,ib-1) must be set to 1. */
+
+ i__3 = i + ib + (i + ib - 1) * *lda;
+ ei.r = a[i__3].r, ei.i = a[i__3].i;
+ a[i__3].r = 1., a[i__3].i = 0.;
+ i__3 = *ihi - i - ib;
+ zgemm_("No transpose", "Conjugate transpose", ihi, &i__3, &ib, &c_b24, work,
+ &ldwork, &a[i+ib + i * *lda], lda, &c_b21, &a[(i+ib) * *lda], lda);
+ i__3 = i + ib + (i + ib - 1) * *lda;
+ a[i__3].r = ei.r, a[i__3].i = ei.i;
+
+/* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the left */
+
+ i__3 = *ihi-1 - i;
+ i__4 = *n - i - ib;
+ zlarfb_("Left", "Conjugate transpose", "Forward", "Columnwise",
+ &i__3, &i__4, &ib, &a[i+1 + i * *lda], lda, t, &c__65,
+ &a[i+1 + (i + ib) * *lda], lda, work, &ldwork);
+ }
+ }
+
+/* Use unblocked code to reduce the rest of the matrix */
+
+ i__1 = i + 1;
+ zgehd2_(n, &i__1, ihi, a, lda, tau, work, &iinfo);
+ work[0].r = (doublereal) iws, work[0].i = 0.;
+
+ return;
+} /* zgehrd_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.f
new file mode 100644
index 0000000000000000000000000000000000000000..c5f7e558ad78a1505d0dbbe2863a9522ddb0c407
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgehrd.f
@@ -0,0 +1,244 @@
+ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER IHI, ILO, INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( LWORK )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEHRD reduces a complex general matrix A to upper Hessenberg form H
+* by a unitary similarity transformation: Q' * A * Q = H .
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that A is already upper triangular in rows
+* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+* set by a previous call to ZGEBAL; otherwise they should be
+* set to 1 and N respectively. See Further Details.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the N-by-N general matrix to be reduced.
+* On exit, the upper triangle and the first subdiagonal of A
+* are overwritten with the upper Hessenberg matrix H, and the
+* elements below the first subdiagonal, with the array TAU,
+* represent the unitary matrix Q as a product of elementary
+* reflectors. See Further Details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* TAU (output) COMPLEX*16 array, dimension (N-1)
+* The scalar factors of the elementary reflectors (see Further
+* Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+* zero.
+*
+* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The length of the array WORK. LWORK >= max(1,N).
+* For optimum performance LWORK >= N*NB, where NB is the
+* optimal blocksize.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value.
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of (ihi-ilo) elementary
+* reflectors
+*
+* Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a complex scalar, and v is a complex vector with
+* v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+* exit in A(i+2:ihi,i), and tau in TAU(i).
+*
+* The contents of A are illustrated by the following example, with
+* n = 7, ilo = 2 and ihi = 6:
+*
+* on entry, on exit,
+*
+* ( a a a a a a a ) ( a a h h h h a )
+* ( a a a a a a ) ( a h h h h a )
+* ( a a a a a a ) ( h h h h h h )
+* ( a a a a a a ) ( v2 h h h h h )
+* ( a a a a a a ) ( v2 v3 h h h h )
+* ( a a a a a a ) ( v2 v3 v4 h h h )
+* ( a ) ( a )
+*
+* where a denotes an element of the original matrix A, h denotes a
+* modified element of the upper Hessenberg matrix H, and vi denotes an
+* element of the vector defining H(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER NBMAX, LDT
+ PARAMETER ( NBMAX = 64, LDT = NBMAX+1 )
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, IB, IINFO, IWS, LDWORK, NB, NBMIN, NH, NX
+ COMPLEX*16 EI
+* ..
+* .. Local Arrays ..
+ COMPLEX*16 T( LDT, NBMAX )
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZGEHD2, ZGEMM, ZLAHRD, ZLARFB
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters
+*
+ INFO = 0
+ IF( N.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
+ INFO = -2
+ ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+ INFO = -8
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEHRD', -INFO )
+ RETURN
+ END IF
+*
+* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero
+*
+ DO 10 I = 1, ILO - 1
+ TAU( I ) = ZERO
+ 10 CONTINUE
+ DO 20 I = MAX( 1, IHI ), N - 1
+ TAU( I ) = ZERO
+ 20 CONTINUE
+*
+* Quick return if possible
+*
+ NH = IHI - ILO + 1
+ IF( NH.LE.1 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+* Determine the block size.
+*
+ NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
+ NBMIN = 2
+ IWS = 1
+ IF( NB.GT.1 .AND. NB.LT.NH ) THEN
+*
+* Determine when to cross over from blocked to unblocked code
+* (last block is always handled by unblocked code).
+*
+ NX = MAX( NB, ILAENV( 3, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) )
+ IF( NX.LT.NH ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ IWS = N*NB
+ IF( LWORK.LT.IWS ) THEN
+*
+* Not enough workspace to use optimal NB: determine the
+* minimum value of NB, and reduce NB or force use of
+* unblocked code.
+*
+ NBMIN = MAX( 2, ILAENV( 2, 'ZGEHRD', ' ', N, ILO, IHI,
+ $ -1 ) )
+ IF( LWORK.GE.N*NBMIN ) THEN
+ NB = LWORK / N
+ ELSE
+ NB = 1
+ END IF
+ END IF
+ END IF
+ END IF
+ LDWORK = N
+*
+ IF( NB.LT.NBMIN .OR. NB.GE.NH ) THEN
+*
+* Use unblocked code below
+*
+ I = ILO
+*
+ ELSE
+*
+* Use blocked code
+*
+ DO 30 I = ILO, IHI - 1 - NX, NB
+ IB = MIN( NB, IHI-I )
+*
+* Reduce columns i:i+ib-1 to Hessenberg form, returning the
+* matrices V and T of the block reflector H = I - V*T*V'
+* which performs the reduction, and also the matrix Y = A*V*T
+*
+ CALL ZLAHRD( IHI, I, IB, A( 1, I ), LDA, TAU( I ), T, LDT,
+ $ WORK, LDWORK )
+*
+* Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
+* right, computing A := A - Y * V'. V(i+ib,ib-1) must be set
+* to 1.
+*
+ EI = A( I+IB, I+IB-1 )
+ A( I+IB, I+IB-1 ) = ONE
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose', IHI,
+ $ IHI-I-IB+1, IB, -ONE, WORK, LDWORK,
+ $ A( I+IB, I ), LDA, ONE, A( 1, I+IB ), LDA )
+ A( I+IB, I+IB-1 ) = EI
+*
+* Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
+* left
+*
+ CALL ZLARFB( 'Left', 'Conjugate transpose', 'Forward',
+ $ 'Columnwise', IHI-I, N-I-IB+1, IB, A( I+1, I ),
+ $ LDA, T, LDT, A( I+1, I+IB ), LDA, WORK,
+ $ LDWORK )
+ 30 CONTINUE
+ END IF
+*
+* Use unblocked code to reduce the rest of the matrix
+*
+ CALL ZGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO )
+ WORK( 1 ) = IWS
+*
+ RETURN
+*
+* End of ZGEHRD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.c
new file mode 100644
index 0000000000000000000000000000000000000000..1cdd6006a63657ef60d6dfc270ad5735fde8b4b5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.c
@@ -0,0 +1,495 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zgemm_(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
+const char *transa, *transb;
+const integer *m, *n, *k;
+doublecomplex *alpha, *a;
+const integer *lda;
+doublecomplex *b;
+const integer *ldb;
+doublecomplex *beta, *c;
+const integer *ldc;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer info;
+ static logical nota, notb;
+ static doublecomplex temp;
+ static integer i, j, l;
+ static logical conja, conjb;
+/* static integer ncola; */
+ static integer nrowa, nrowb;
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEMM performs one of the matrix-matrix operations */
+/* */
+/* C := alpha*op( A )*op( B ) + beta*C, */
+/* */
+/* where op( X ) is one of */
+/* */
+/* op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ), */
+/* */
+/* alpha and beta are scalars, and A, B and C are matrices, with op( A ) */
+/* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+/* */
+/* TRANSA = 'N' or 'n', op( A ) = A. */
+/* */
+/* TRANSA = 'T' or 't', op( A ) = A'. */
+/* */
+/* TRANSA = 'C' or 'c', op( A ) = conjg( A' ). */
+/* */
+/* Unchanged on exit. */
+/* */
+/* TRANSB - CHARACTER*1. */
+/* On entry, TRANSB specifies the form of op( B ) to be used in */
+/* the matrix multiplication as follows: */
+/* */
+/* TRANSB = 'N' or 'n', op( B ) = B. */
+/* */
+/* TRANSB = 'T' or 't', op( B ) = B'. */
+/* */
+/* TRANSB = 'C' or 'c', op( B ) = conjg( B' ). */
+/* */
+/* Unchanged on exit. */
+/* */
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix */
+/* op( A ) and of the matrix C. M must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix */
+/* op( B ) and the number of columns of the matrix C. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+/* */
+/* K - INTEGER. */
+/* On entry, K specifies the number of columns of the matrix */
+/* op( A ) and the number of rows of the matrix op( B ). K must */
+/* be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* ALPHA - COMPLEX*16 . */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is */
+/* k when TRANSA = 'N' or 'n', and is m otherwise. */
+/* Before entry with TRANSA = 'N' or 'n', the leading m by k */
+/* part of the array A must contain the matrix A, otherwise */
+/* the leading k by m part of the array A must contain the */
+/* matrix A. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When TRANSA = 'N' or 'n' then */
+/* LDA must be at least max( 1, m ), otherwise LDA must be at */
+/* least max( 1, k ). */
+/* Unchanged on exit. */
+/* */
+/* B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is */
+/* n when TRANSB = 'N' or 'n', and is k otherwise. */
+/* Before entry with TRANSB = 'N' or 'n', the leading k by n */
+/* part of the array B must contain the matrix B, otherwise */
+/* the leading n by k part of the array B must contain the */
+/* matrix B. */
+/* Unchanged on exit. */
+/* */
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. When TRANSB = 'N' or 'n' then */
+/* LDB must be at least max( 1, k ), otherwise LDB must be at */
+/* least max( 1, n ). */
+/* Unchanged on exit. */
+/* */
+/* BETA - COMPLEX*16 . */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then C need not be set on input. */
+/* Unchanged on exit. */
+/* */
+/* C - COMPLEX*16 array of DIMENSION ( LDC, n ). */
+/* Before entry, the leading m by n part of the array C must */
+/* contain the matrix C, except when beta is zero, in which */
+/* case C need not be set on entry. */
+/* On exit, the array C is overwritten by the m by n matrix */
+/* ( alpha*op( A )*op( B ) + beta*C ). */
+/* */
+/* LDC - INTEGER. */
+/* On entry, LDC specifies the first dimension of C as declared */
+/* in the calling (sub) program. LDC must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+/* */
+/* ===================================================================== */
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+/* Set NOTA and NOTB as true if A and B respectively are not */
+/* conjugated or transposed, set CONJA and CONJB as true if A and */
+/* B respectively are to be transposed but not conjugated and set */
+/* NROWA, NCOLA and NROWB as the number of rows and columns of A */
+/* and the number of rows of B respectively. */
+
+ nota = lsame_(transa, "N");
+ notb = lsame_(transb, "N");
+ conja = lsame_(transa, "C");
+ conjb = lsame_(transb, "C");
+ if (nota) {
+ nrowa = *m;
+/* ncola = *k; */
+ } else {
+ nrowa = *k;
+/* ncola = *m; */
+ }
+ if (notb) {
+ nrowb = *k;
+ } else {
+ nrowb = *n;
+ }
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (! nota && ! conja && ! lsame_(transa, "T")) {
+ info = 1;
+ } else if (! notb && ! conjb && ! lsame_(transb, "T")) {
+ info = 2;
+ } else if (*m < 0) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < max(1,nrowa)) {
+ info = 8;
+ } else if (*ldb < max(1,nrowb)) {
+ info = 10;
+ } else if (*ldc < max(1,*m)) {
+ info = 13;
+ }
+ if (info != 0) {
+ xerbla_("ZGEMM ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 ||
+ (((alpha->r == 0. && alpha->i == 0.) || *k == 0) && (beta->r == 1. && beta->i == 0.))) {
+ return;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (alpha->r == 0. && alpha->i == 0.) {
+ if (beta->r == 0. && beta->i == 0.) {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = 0., c[i__1].i = 0.;
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ }
+ }
+ return;
+ }
+
+/* Start the operations. */
+
+ if (notb) {
+ if (nota) {
+
+/* Form C := alpha*A*B + beta*C. */
+
+ for (j = 0; j < *n; ++j) {
+ if (beta->r == 0. && beta->i == 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = 0., c[i__1].i = 0.;
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ }
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + j * *ldb;
+ if (b[i__1].r != 0. || b[i__1].i != 0.) {
+ temp.r = alpha->r * b[i__1].r - alpha->i * b[i__1].i,
+ temp.i = alpha->r * b[i__1].i + alpha->i * b[i__1].r;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ i__2 = i + l * *lda;
+ c[i__1].r += temp.r * a[i__2].r - temp.i * a[i__2].i,
+ c[i__1].i += temp.r * a[i__2].i + temp.i * a[i__2].r;
+ }
+ }
+ }
+ }
+ } else if (conja) {
+
+/* Form C := alpha*conjg( A' )*B + beta*C. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = l + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r + a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i - a[i__1].i * b[i__2].r;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r + alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = z__1.i + alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*B + beta*C */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = l + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r - a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i + a[i__1].i * b[i__2].r;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r + alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = z__1.i + alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ }
+ } else if (nota) {
+ if (conjb) {
+
+/* Form C := alpha*A*conjg( B' ) + beta*C. */
+
+ for (j = 0; j < *n; ++j) {
+ if (beta->r == 0. && beta->i == 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = 0., c[i__1].i = 0.;
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ }
+ for (l = 0; l < *k; ++l) {
+ i__1 = j + l * *ldb;
+ if (b[i__1].r != 0. || b[i__1].i != 0.) {
+ i__1 = j + l * *ldb;
+ temp.r = alpha->r * b[i__1].r + alpha->i * b[i__1].i,
+ temp.i = alpha->i * b[i__1].r - alpha->r * b[i__1].i;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ i__2 = i + l * *lda;
+ c[i__1].r += temp.r * a[i__2].r - temp.i * a[i__2].i,
+ c[i__1].i += temp.r * a[i__2].i + temp.i * a[i__2].r;
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*A*B' + beta*C */
+
+ for (j = 0; j < *n; ++j) {
+ if (beta->r == 0. && beta->i == 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = 0., c[i__1].i = 0.;
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ }
+ for (l = 0; l < *k; ++l) {
+ i__1 = j + l * *ldb;
+ if (b[i__1].r != 0. || b[i__1].i != 0.) {
+ i__1 = j + l * *ldb;
+ temp.r = alpha->r * b[i__1].r - alpha->i * b[i__1].i,
+ temp.i = alpha->r * b[i__1].i + alpha->i * b[i__1].r;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ i__2 = i + l * *lda;
+ c[i__1].r += temp.r * a[i__2].r - temp.i * a[i__2].i,
+ c[i__1].i += temp.r * a[i__2].i + temp.i * a[i__2].r;
+ }
+ }
+ }
+ }
+ }
+ } else if (conja) {
+ if (conjb) {
+
+/* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = j + l * *ldb;
+ temp.r += a[i__1].r * b[i__2].r - a[i__1].i * b[i__2].i,
+ temp.i += - a[i__1].r * b[i__2].i - a[i__1].i * b[i__2].r;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r + alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = z__1.i + alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*conjg( A' )*B' + beta*C */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = j + l * *ldb;
+ temp.r += a[i__1].r * b[i__2].r + a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i - a[i__1].i * b[i__2].r;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r + alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = z__1.i + alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ }
+ } else {
+ if (conjb) {
+
+/* Form C := alpha*A'*conjg( B' ) + beta*C */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = j + l * *ldb;
+ temp.r += a[i__1].r * b[i__2].r + a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].i * b[i__2].r - a[i__1].r * b[i__2].i;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i = beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r + alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = z__1.i + alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*B' + beta*C */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ temp.r = 0., temp.i = 0.;
+ for (l = 0; l < *k; ++l) {
+ i__1 = l + i * *lda;
+ i__2 = j + l * *ldb;
+ temp.r += a[i__1].r * b[i__2].r - a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i + a[i__1].i * b[i__2].r;
+ }
+ if (beta->r == 0. && beta->i == 0.) {
+ i__1 = i + j * *ldc;
+ c[i__1].r = alpha->r * temp.r - alpha->i * temp.i,
+ c[i__1].i = alpha->r * temp.i + alpha->i * temp.r;
+ } else {
+ i__1 = i + j * *ldc;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i * temp.r;
+ z__1.r += beta->r * c[i__1].r - beta->i * c[i__1].i,
+ z__1.i += beta->r * c[i__1].i + beta->i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ }
+ }
+ }
+ }
+} /* zgemm_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.f
new file mode 100644
index 0000000000000000000000000000000000000000..09cd151ee075387e0f128c181e7c400a7752fc74
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemm.f
@@ -0,0 +1,415 @@
+ SUBROUTINE ZGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
+ $ BETA, C, LDC )
+* .. Scalar Arguments ..
+ CHARACTER*1 TRANSA, TRANSB
+ INTEGER M, N, K, LDA, LDB, LDC
+ COMPLEX*16 ALPHA, BETA
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEMM performs one of the matrix-matrix operations
+*
+* C := alpha*op( A )*op( B ) + beta*C,
+*
+* where op( X ) is one of
+*
+* op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ),
+*
+* alpha and beta are scalars, and A, B and C are matrices, with op( A )
+* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+*
+* Parameters
+* ==========
+*
+* TRANSA - CHARACTER*1.
+* On entry, TRANSA specifies the form of op( A ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSA = 'N' or 'n', op( A ) = A.
+*
+* TRANSA = 'T' or 't', op( A ) = A'.
+*
+* TRANSA = 'C' or 'c', op( A ) = conjg( A' ).
+*
+* Unchanged on exit.
+*
+* TRANSB - CHARACTER*1.
+* On entry, TRANSB specifies the form of op( B ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSB = 'N' or 'n', op( B ) = B.
+*
+* TRANSB = 'T' or 't', op( B ) = B'.
+*
+* TRANSB = 'C' or 'c', op( B ) = conjg( B' ).
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix
+* op( A ) and of the matrix C. M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix
+* op( B ) and the number of columns of the matrix C. N must be
+* at least zero.
+* Unchanged on exit.
+*
+* K - INTEGER.
+* On entry, K specifies the number of columns of the matrix
+* op( A ) and the number of rows of the matrix op( B ). K must
+* be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - COMPLEX*16 .
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+* k when TRANSA = 'N' or 'n', and is m otherwise.
+* Before entry with TRANSA = 'N' or 'n', the leading m by k
+* part of the array A must contain the matrix A, otherwise
+* the leading k by m part of the array A must contain the
+* matrix A.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. When TRANSA = 'N' or 'n' then
+* LDA must be at least max( 1, m ), otherwise LDA must be at
+* least max( 1, k ).
+* Unchanged on exit.
+*
+* B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+* n when TRANSB = 'N' or 'n', and is k otherwise.
+* Before entry with TRANSB = 'N' or 'n', the leading k by n
+* part of the array B must contain the matrix B, otherwise
+* the leading n by k part of the array B must contain the
+* matrix B.
+* Unchanged on exit.
+*
+* LDB - INTEGER.
+* On entry, LDB specifies the first dimension of B as declared
+* in the calling (sub) program. When TRANSB = 'N' or 'n' then
+* LDB must be at least max( 1, k ), otherwise LDB must be at
+* least max( 1, n ).
+* Unchanged on exit.
+*
+* BETA - COMPLEX*16 .
+* On entry, BETA specifies the scalar beta. When BETA is
+* supplied as zero then C need not be set on input.
+* Unchanged on exit.
+*
+* C - COMPLEX*16 array of DIMENSION ( LDC, n ).
+* Before entry, the leading m by n part of the array C must
+* contain the matrix C, except when beta is zero, in which
+* case C need not be set on entry.
+* On exit, the array C is overwritten by the m by n matrix
+* ( alpha*op( A )*op( B ) + beta*C ).
+*
+* LDC - INTEGER.
+* On entry, LDC specifies the first dimension of C as declared
+* in the calling (sub) program. LDC must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 3 Blas routine.
+*
+* -- Written on 8-February-1989.
+* Jack Dongarra, Argonne National Laboratory.
+* Iain Duff, AERE Harwell.
+* Jeremy Du Croz, Numerical Algorithms Group Ltd.
+* Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* .. Local Scalars ..
+ LOGICAL CONJA, CONJB, NOTA, NOTB
+ INTEGER I, INFO, J, L, NCOLA, NROWA, NROWB
+ COMPLEX*16 TEMP
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Executable Statements ..
+*
+* Set NOTA and NOTB as true if A and B respectively are not
+* conjugated or transposed, set CONJA and CONJB as true if A and
+* B respectively are to be transposed but not conjugated and set
+* NROWA, NCOLA and NROWB as the number of rows and columns of A
+* and the number of rows of B respectively.
+*
+ NOTA = LSAME( TRANSA, 'N' )
+ NOTB = LSAME( TRANSB, 'N' )
+ CONJA = LSAME( TRANSA, 'C' )
+ CONJB = LSAME( TRANSB, 'C' )
+ IF( NOTA )THEN
+ NROWA = M
+ NCOLA = K
+ ELSE
+ NROWA = K
+ NCOLA = M
+ END IF
+ IF( NOTB )THEN
+ NROWB = K
+ ELSE
+ NROWB = N
+ END IF
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF( ( .NOT.NOTA ).AND.
+ $ ( .NOT.CONJA ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'T' ) ) )THEN
+ INFO = 1
+ ELSE IF( ( .NOT.NOTB ).AND.
+ $ ( .NOT.CONJB ).AND.
+ $ ( .NOT.LSAME( TRANSB, 'T' ) ) )THEN
+ INFO = 2
+ ELSE IF( M .LT.0 )THEN
+ INFO = 3
+ ELSE IF( N .LT.0 )THEN
+ INFO = 4
+ ELSE IF( K .LT.0 )THEN
+ INFO = 5
+ ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+ INFO = 8
+ ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
+ INFO = 10
+ ELSE IF( LDC.LT.MAX( 1, M ) )THEN
+ INFO = 13
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZGEMM ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+ $ ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) )
+ $ RETURN
+*
+* And when alpha.eq.zero.
+*
+ IF( ALPHA.EQ.ZERO )THEN
+ IF( BETA.EQ.ZERO )THEN
+ DO 20, J = 1, N
+ DO 10, I = 1, M
+ C( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ DO 40, J = 1, N
+ DO 30, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 30 CONTINUE
+ 40 CONTINUE
+ END IF
+ RETURN
+ END IF
+*
+* Start the operations.
+*
+ IF( NOTB )THEN
+ IF( NOTA )THEN
+*
+* Form C := alpha*A*B + beta*C.
+*
+ DO 90, J = 1, N
+ IF( BETA.EQ.ZERO )THEN
+ DO 50, I = 1, M
+ C( I, J ) = ZERO
+ 50 CONTINUE
+ ELSE IF( BETA.NE.ONE )THEN
+ DO 60, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 60 CONTINUE
+ END IF
+ DO 80, L = 1, K
+ IF( B( L, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( L, J )
+ DO 70, I = 1, M
+ C( I, J ) = C( I, J ) + TEMP*A( I, L )
+ 70 CONTINUE
+ END IF
+ 80 CONTINUE
+ 90 CONTINUE
+ ELSE IF( CONJA )THEN
+*
+* Form C := alpha*conjg( A' )*B + beta*C.
+*
+ DO 120, J = 1, N
+ DO 110, I = 1, M
+ TEMP = ZERO
+ DO 100, L = 1, K
+ TEMP = TEMP + DCONJG( A( L, I ) )*B( L, J )
+ 100 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 110 CONTINUE
+ 120 CONTINUE
+ ELSE
+*
+* Form C := alpha*A'*B + beta*C
+*
+ DO 150, J = 1, N
+ DO 140, I = 1, M
+ TEMP = ZERO
+ DO 130, L = 1, K
+ TEMP = TEMP + A( L, I )*B( L, J )
+ 130 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 140 CONTINUE
+ 150 CONTINUE
+ END IF
+ ELSE IF( NOTA )THEN
+ IF( CONJB )THEN
+*
+* Form C := alpha*A*conjg( B' ) + beta*C.
+*
+ DO 200, J = 1, N
+ IF( BETA.EQ.ZERO )THEN
+ DO 160, I = 1, M
+ C( I, J ) = ZERO
+ 160 CONTINUE
+ ELSE IF( BETA.NE.ONE )THEN
+ DO 170, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 170 CONTINUE
+ END IF
+ DO 190, L = 1, K
+ IF( B( J, L ).NE.ZERO )THEN
+ TEMP = ALPHA*DCONJG( B( J, L ) )
+ DO 180, I = 1, M
+ C( I, J ) = C( I, J ) + TEMP*A( I, L )
+ 180 CONTINUE
+ END IF
+ 190 CONTINUE
+ 200 CONTINUE
+ ELSE
+*
+* Form C := alpha*A*B' + beta*C
+*
+ DO 250, J = 1, N
+ IF( BETA.EQ.ZERO )THEN
+ DO 210, I = 1, M
+ C( I, J ) = ZERO
+ 210 CONTINUE
+ ELSE IF( BETA.NE.ONE )THEN
+ DO 220, I = 1, M
+ C( I, J ) = BETA*C( I, J )
+ 220 CONTINUE
+ END IF
+ DO 240, L = 1, K
+ IF( B( J, L ).NE.ZERO )THEN
+ TEMP = ALPHA*B( J, L )
+ DO 230, I = 1, M
+ C( I, J ) = C( I, J ) + TEMP*A( I, L )
+ 230 CONTINUE
+ END IF
+ 240 CONTINUE
+ 250 CONTINUE
+ END IF
+ ELSE IF( CONJA )THEN
+ IF( CONJB )THEN
+*
+* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C.
+*
+ DO 280, J = 1, N
+ DO 270, I = 1, M
+ TEMP = ZERO
+ DO 260, L = 1, K
+ TEMP = TEMP +
+ $ DCONJG( A( L, I ) )*DCONJG( B( J, L ) )
+ 260 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 270 CONTINUE
+ 280 CONTINUE
+ ELSE
+*
+* Form C := alpha*conjg( A' )*B' + beta*C
+*
+ DO 310, J = 1, N
+ DO 300, I = 1, M
+ TEMP = ZERO
+ DO 290, L = 1, K
+ TEMP = TEMP + DCONJG( A( L, I ) )*B( J, L )
+ 290 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 300 CONTINUE
+ 310 CONTINUE
+ END IF
+ ELSE
+ IF( CONJB )THEN
+*
+* Form C := alpha*A'*conjg( B' ) + beta*C
+*
+ DO 340, J = 1, N
+ DO 330, I = 1, M
+ TEMP = ZERO
+ DO 320, L = 1, K
+ TEMP = TEMP + A( L, I )*DCONJG( B( J, L ) )
+ 320 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 330 CONTINUE
+ 340 CONTINUE
+ ELSE
+*
+* Form C := alpha*A'*B' + beta*C
+*
+ DO 370, J = 1, N
+ DO 360, I = 1, M
+ TEMP = ZERO
+ DO 350, L = 1, K
+ TEMP = TEMP + A( L, I )*B( J, L )
+ 350 CONTINUE
+ IF( BETA.EQ.ZERO )THEN
+ C( I, J ) = ALPHA*TEMP
+ ELSE
+ C( I, J ) = ALPHA*TEMP + BETA*C( I, J )
+ END IF
+ 360 CONTINUE
+ 370 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZGEMM .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.c
new file mode 100644
index 0000000000000000000000000000000000000000..6773784d9d51193e5ce41314703de410e44bc3d2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.c
@@ -0,0 +1,290 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zgemv_(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
+const char *trans;
+const integer *m, *n;
+doublecomplex *alpha, *a;
+const integer *lda;
+doublecomplex *x;
+const integer *incx;
+doublecomplex *beta, *y;
+const integer *incy;
+{
+ /* System generated locals */
+ integer i__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer info;
+ static doublecomplex temp;
+ static integer lenx, leny, i, j;
+ static integer ix, iy, jx, jy, kx, ky;
+ static logical noconj;
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGEMV performs one of the matrix-vector operations */
+/* */
+/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or */
+/* */
+/* y := alpha*conjg( A' )*x + beta*y, */
+/* */
+/* where alpha and beta are scalars, x and y are vectors and A is an */
+/* m by n matrix. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the operation to be performed as */
+/* follows: */
+/* */
+/* TRANS = 'N' or 'n' y := alpha*A*x + beta*y. */
+/* */
+/* TRANS = 'T' or 't' y := alpha*A'*x + beta*y. */
+/* */
+/* TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix A. */
+/* M must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* ALPHA - COMPLEX*16 . */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+/* Before entry, the leading m by n part of the array A must */
+/* contain the matrix of coefficients. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+/* */
+/* X - COMPLEX*16 array of DIMENSION at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' */
+/* and at least */
+/* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. */
+/* Before entry, the incremented array X must contain the */
+/* vector x. */
+/* Unchanged on exit. */
+/* */
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+/* */
+/* BETA - COMPLEX*16 . */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then Y need not be set on input. */
+/* Unchanged on exit. */
+/* */
+/* Y - COMPLEX*16 array of DIMENSION at least */
+/* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' */
+/* and at least */
+/* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. */
+/* Before entry with BETA non-zero, the incremented array Y */
+/* must contain the vector y. On exit, Y is overwritten by the */
+/* updated vector y. */
+/* */
+/* INCY - INTEGER. */
+/* On entry, INCY specifies the increment for the elements of */
+/* Y. INCY must not be zero. */
+/* Unchanged on exit. */
+/* */
+/* ===================================================================== */
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+ info = 0;
+ if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZGEMV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0. && beta->r == 1. && beta->i == 0.)) {
+ return;
+ }
+
+ noconj = lsame_(trans, "T");
+
+/* Set LENX and LENY, the lengths of the vectors x and y, and set */
+/* up the start points in X and Y. */
+
+ if (lsame_(trans, "N")) {
+ lenx = *n;
+ leny = *m;
+ } else {
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = (1-lenx) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 0;
+ } else {
+ ky = (1-leny) * *incy;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+/* First form y := beta*y. */
+
+ if (beta->r != 1. || beta->i != 0.) {
+ if (*incy == 1) {
+ if (beta->r == 0. && beta->i == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[i].r = 0., y[i].i = 0.;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ z__1.r = beta->r * y[i].r - beta->i * y[i].i,
+ z__1.i = beta->r * y[i].i + beta->i * y[i].r;
+ y[i].r = z__1.r, y[i].i = z__1.i;
+ }
+ }
+ } else {
+ iy = ky;
+ if (beta->r == 0. && beta->i == 0.) {
+ for (i = 0; i < leny; ++i) {
+ y[iy].r = 0., y[iy].i = 0.;
+ iy += *incy;
+ }
+ } else {
+ for (i = 0; i < leny; ++i) {
+ z__1.r = beta->r * y[iy].r - beta->i * y[iy].i,
+ z__1.i = beta->r * y[iy].i + beta->i * y[iy].r;
+ y[iy].r = z__1.r, y[iy].i = z__1.i;
+ iy += *incy;
+ }
+ }
+ }
+ }
+ if (alpha->r == 0. && alpha->i == 0.) {
+ return;
+ }
+ if (lsame_(trans, "N")) {
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ temp.r = alpha->r * x[jx].r - alpha->i * x[jx].i,
+ temp.i = alpha->r * x[jx].i + alpha->i * x[jx].r;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ y[i].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ y[i].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ jx += *incx;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ temp.r = alpha->r * x[jx].r - alpha->i * x[jx].i,
+ temp.i = alpha->r * x[jx].i + alpha->i * x[jx].r;
+ iy = ky;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ y[iy].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ y[iy].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ iy += *incy;
+ }
+ }
+ jx += *incx;
+ }
+ }
+ } else {
+
+/* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ temp.r = 0., temp.i = 0.;
+ if (noconj) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ temp.r += a[i__1].r * x[i].r - a[i__1].i * x[i].i,
+ temp.i += a[i__1].r * x[i].i + a[i__1].i * x[i].r;
+ }
+ } else {
+ for (i = 0; i < *m; ++i) {
+ temp.r += a[i + j * *lda].r * x[i].r + a[i + j * *lda].i * x[i].i,
+ temp.i += a[i + j * *lda].r * x[i].i - a[i + j * *lda].i * x[i].r;
+ }
+ }
+ y[jy].r += alpha->r * temp.r - alpha->i * temp.i,
+ y[jy].i += alpha->r * temp.i + alpha->i * temp.r;
+ jy += *incy;
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ temp.r = 0., temp.i = 0.;
+ ix = kx;
+ if (noconj) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ temp.r += a[i__1].r * x[ix].r - a[i__1].i * x[ix].i,
+ temp.i += a[i__1].r * x[ix].i + a[i__1].i * x[ix].r;
+ ix += *incx;
+ }
+ } else {
+ for (i = 0; i < *m; ++i) {
+ temp.r += a[i + j * *lda].r * x[ix].r + a[i + j * *lda].i * x[ix].i,
+ temp.i += a[i + j * *lda].r * x[ix].i - a[i + j * *lda].i * x[ix].r;
+ ix += *incx;
+ }
+ }
+ y[jy].r += alpha->r * temp.r - alpha->i * temp.i,
+ y[jy].i += alpha->r * temp.i + alpha->i * temp.r;
+ jy += *incy;
+ }
+ }
+ }
+} /* zgemv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.f
new file mode 100644
index 0000000000000000000000000000000000000000..014a5e02ba12dd554cf6df6ce29d1888e812bd1e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgemv.f
@@ -0,0 +1,281 @@
+ SUBROUTINE ZGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
+ $ BETA, Y, INCY )
+* .. Scalar Arguments ..
+ COMPLEX*16 ALPHA, BETA
+ INTEGER INCX, INCY, LDA, M, N
+ CHARACTER*1 TRANS
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGEMV performs one of the matrix-vector operations
+*
+* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or
+*
+* y := alpha*conjg( A' )*x + beta*y,
+*
+* where alpha and beta are scalars, x and y are vectors and A is an
+* m by n matrix.
+*
+* Parameters
+* ==========
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the operation to be performed as
+* follows:
+*
+* TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+*
+* TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+*
+* TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y.
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix A.
+* M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - COMPLEX*16 .
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+* Before entry, the leading m by n part of the array A must
+* contain the matrix of coefficients.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+* X - COMPLEX*16 array of DIMENSION at least
+* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+* and at least
+* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+* Before entry, the incremented array X must contain the
+* vector x.
+* Unchanged on exit.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+* BETA - COMPLEX*16 .
+* On entry, BETA specifies the scalar beta. When BETA is
+* supplied as zero then Y need not be set on input.
+* Unchanged on exit.
+*
+* Y - COMPLEX*16 array of DIMENSION at least
+* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+* and at least
+* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+* Before entry with BETA non-zero, the incremented array Y
+* must contain the vector y. On exit, Y is overwritten by the
+* updated vector y.
+*
+* INCY - INTEGER.
+* On entry, INCY specifies the increment for the elements of
+* Y. INCY must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
+ LOGICAL NOCONJ
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 1
+ ELSE IF( M.LT.0 )THEN
+ INFO = 2
+ ELSE IF( N.LT.0 )THEN
+ INFO = 3
+ ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ ELSE IF( INCY.EQ.0 )THEN
+ INFO = 11
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZGEMV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
+ $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
+ $ RETURN
+*
+ NOCONJ = LSAME( TRANS, 'T' )
+*
+* Set LENX and LENY, the lengths of the vectors x and y, and set
+* up the start points in X and Y.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+ LENX = N
+ LENY = M
+ ELSE
+ LENX = M
+ LENY = N
+ END IF
+ IF( INCX.GT.0 )THEN
+ KX = 1
+ ELSE
+ KX = 1 - ( LENX - 1 )*INCX
+ END IF
+ IF( INCY.GT.0 )THEN
+ KY = 1
+ ELSE
+ KY = 1 - ( LENY - 1 )*INCY
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+* First form y := beta*y.
+*
+ IF( BETA.NE.ONE )THEN
+ IF( INCY.EQ.1 )THEN
+ IF( BETA.EQ.ZERO )THEN
+ DO 10, I = 1, LENY
+ Y( I ) = ZERO
+ 10 CONTINUE
+ ELSE
+ DO 20, I = 1, LENY
+ Y( I ) = BETA*Y( I )
+ 20 CONTINUE
+ END IF
+ ELSE
+ IY = KY
+ IF( BETA.EQ.ZERO )THEN
+ DO 30, I = 1, LENY
+ Y( IY ) = ZERO
+ IY = IY + INCY
+ 30 CONTINUE
+ ELSE
+ DO 40, I = 1, LENY
+ Y( IY ) = BETA*Y( IY )
+ IY = IY + INCY
+ 40 CONTINUE
+ END IF
+ END IF
+ END IF
+ IF( ALPHA.EQ.ZERO )
+ $ RETURN
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form y := alpha*A*x + y.
+*
+ JX = KX
+ IF( INCY.EQ.1 )THEN
+ DO 60, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = ALPHA*X( JX )
+ DO 50, I = 1, M
+ Y( I ) = Y( I ) + TEMP*A( I, J )
+ 50 CONTINUE
+ END IF
+ JX = JX + INCX
+ 60 CONTINUE
+ ELSE
+ DO 80, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = ALPHA*X( JX )
+ IY = KY
+ DO 70, I = 1, M
+ Y( IY ) = Y( IY ) + TEMP*A( I, J )
+ IY = IY + INCY
+ 70 CONTINUE
+ END IF
+ JX = JX + INCX
+ 80 CONTINUE
+ END IF
+ ELSE
+*
+* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y.
+*
+ JY = KY
+ IF( INCX.EQ.1 )THEN
+ DO 110, J = 1, N
+ TEMP = ZERO
+ IF( NOCONJ )THEN
+ DO 90, I = 1, M
+ TEMP = TEMP + A( I, J )*X( I )
+ 90 CONTINUE
+ ELSE
+ DO 100, I = 1, M
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+ 100 CONTINUE
+ END IF
+ Y( JY ) = Y( JY ) + ALPHA*TEMP
+ JY = JY + INCY
+ 110 CONTINUE
+ ELSE
+ DO 140, J = 1, N
+ TEMP = ZERO
+ IX = KX
+ IF( NOCONJ )THEN
+ DO 120, I = 1, M
+ TEMP = TEMP + A( I, J )*X( IX )
+ IX = IX + INCX
+ 120 CONTINUE
+ ELSE
+ DO 130, I = 1, M
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+ IX = IX + INCX
+ 130 CONTINUE
+ END IF
+ Y( JY ) = Y( JY ) + ALPHA*TEMP
+ JY = JY + INCY
+ 140 CONTINUE
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZGEMV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.c
new file mode 100644
index 0000000000000000000000000000000000000000..de2743bcf64ddbc55f77e76a37b3b41e22b5201f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.c
@@ -0,0 +1,159 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zgerc_(m, n, alpha, x, incx, y, incy, a, lda)
+const integer *m, *n;
+doublecomplex *alpha, *x;
+const integer *incx;
+doublecomplex *y;
+const integer *incy;
+doublecomplex *a;
+const integer *lda;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer info;
+ static doublecomplex temp;
+ static integer i, j, ix, jy, kx;
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZGERC performs the rank 1 operation */
+/* */
+/* A := alpha*x*conjg( y' ) + A, */
+/* */
+/* where alpha is a scalar, x is an m element vector, y is an n element */
+/* vector and A is an m by n matrix. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix A. */
+/* M must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* ALPHA - COMPLEX*16 . */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+/* */
+/* X - COMPLEX*16 array of dimension at least */
+/* ( 1 + ( m - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the m */
+/* element vector x. */
+/* Unchanged on exit. */
+/* */
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+/* */
+/* Y - COMPLEX*16 array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCY ) ). */
+/* Before entry, the incremented array Y must contain the n */
+/* element vector y. */
+/* Unchanged on exit. */
+/* */
+/* INCY - INTEGER. */
+/* On entry, INCY specifies the increment for the elements of */
+/* Y. INCY must not be zero. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+/* Before entry, the leading m by n part of the array A must */
+/* contain the matrix of coefficients. On exit, A is */
+/* overwritten by the updated matrix. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+/* */
+/* ===================================================================== */
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZGERC ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+ if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
+ return;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (*incy > 0) {
+ jy = 0;
+ } else {
+ jy = (1 - *n) * *incy;
+ }
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (y[jy].r != 0. || y[jy].i != 0.) {
+ temp.r = alpha->r * y[jy].r + alpha->i * y[jy].i,
+ temp.i = alpha->i * y[jy].r - alpha->r * y[jy].i;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r += x[i].r * temp.r - x[i].i * temp.i,
+ a[i__1].i += x[i].r * temp.i + x[i].i * temp.r;
+ }
+ }
+ jy += *incy;
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 0;
+ } else {
+ kx = (1 - *m) * *incx;
+ }
+ for (j = 0; j < *n; ++j) {
+ if (y[jy].r != 0. || y[jy].i != 0.) {
+ temp.r = alpha->r * y[jy].r + alpha->i * y[jy].i,
+ temp.i = alpha->i * y[jy].r - alpha->r * y[jy].i;
+ ix = kx;
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r += x[ix].r * temp.r - x[ix].i * temp.i,
+ a[i__1].i += x[ix].r * temp.i + x[ix].i * temp.r;
+ ix += *incx;
+ }
+ }
+ jy += *incy;
+ }
+ }
+} /* zgerc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.f
new file mode 100644
index 0000000000000000000000000000000000000000..968c5b472d8ff38f28f5714ded006a16cf1cb49c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zgerc.f
@@ -0,0 +1,157 @@
+ SUBROUTINE ZGERC ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+* .. Scalar Arguments ..
+ COMPLEX*16 ALPHA
+ INTEGER INCX, INCY, LDA, M, N
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), X( * ), Y( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZGERC performs the rank 1 operation
+*
+* A := alpha*x*conjg( y' ) + A,
+*
+* where alpha is a scalar, x is an m element vector, y is an n element
+* vector and A is an m by n matrix.
+*
+* Parameters
+* ==========
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of the matrix A.
+* M must be at least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* ALPHA - COMPLEX*16 .
+* On entry, ALPHA specifies the scalar alpha.
+* Unchanged on exit.
+*
+* X - COMPLEX*16 array of dimension at least
+* ( 1 + ( m - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the m
+* element vector x.
+* Unchanged on exit.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+* Y - COMPLEX*16 array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCY ) ).
+* Before entry, the incremented array Y must contain the n
+* element vector y.
+* Unchanged on exit.
+*
+* INCY - INTEGER.
+* On entry, INCY specifies the increment for the elements of
+* Y. INCY must not be zero.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+* Before entry, the leading m by n part of the array A must
+* contain the matrix of coefficients. On exit, A is
+* overwritten by the updated matrix.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I, INFO, IX, J, JY, KX
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( M.LT.0 )THEN
+ INFO = 1
+ ELSE IF( N.LT.0 )THEN
+ INFO = 2
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 5
+ ELSE IF( INCY.EQ.0 )THEN
+ INFO = 7
+ ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+ INFO = 9
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZGERC ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
+ $ RETURN
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( INCY.GT.0 )THEN
+ JY = 1
+ ELSE
+ JY = 1 - ( N - 1 )*INCY
+ END IF
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = 1, N
+ IF( Y( JY ).NE.ZERO )THEN
+ TEMP = ALPHA*DCONJG( Y( JY ) )
+ DO 10, I = 1, M
+ A( I, J ) = A( I, J ) + X( I )*TEMP
+ 10 CONTINUE
+ END IF
+ JY = JY + INCY
+ 20 CONTINUE
+ ELSE
+ IF( INCX.GT.0 )THEN
+ KX = 1
+ ELSE
+ KX = 1 - ( M - 1 )*INCX
+ END IF
+ DO 40, J = 1, N
+ IF( Y( JY ).NE.ZERO )THEN
+ TEMP = ALPHA*DCONJG( Y( JY ) )
+ IX = KX
+ DO 30, I = 1, M
+ A( I, J ) = A( I, J ) + X( IX )*TEMP
+ IX = IX + INCX
+ 30 CONTINUE
+ END IF
+ JY = JY + INCY
+ 40 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZGERC .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..997ab7fff030f4177da5a6775c64de2649b60d26
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.c
@@ -0,0 +1,505 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b9 = {0.,0.};
+static doublecomplex c_b10 = {1.,0.};
+static integer c__1 = 1;
+static integer c__4 = 4;
+static integer c_n1 = -1;
+static ftnlen c__2 = 2;
+static integer c__8 = 8;
+static integer c__15 = 15;
+static integer c__0 = 0;
+
+/* Subroutine */ void zhseqr_(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
+const char *job, *compz;
+const integer *n;
+integer *ilo, *ihi;
+doublecomplex *h;
+const integer *ldh;
+doublecomplex *w, *z;
+const integer *ldz;
+doublecomplex *work;
+integer *lwork, *info;
+{
+ /* System generated locals */
+ address a__1[2];
+ integer i__1, i__2;
+ ftnlen ii__4[2];
+ doublereal d__1;
+ doublecomplex z__1;
+ char ch__1[2];
+
+ /* Local variables */
+ static integer maxb, ierr;
+ static doublereal unfl;
+ static doublecomplex temp;
+ static doublereal ovfl;
+ static integer i, j, k, l;
+ static doublecomplex s[225] /* was [15][15] */, v[16];
+ static integer itemp;
+ static doublereal rtemp;
+ static integer i1, i2;
+ static logical initz, wantt, wantz;
+ static doublereal rwork[1];
+ static integer ii, nh;
+ static integer nr, ns, nv;
+ static doublecomplex vv[16];
+ static doublereal smlnum;
+ static integer itn;
+ static doublecomplex tau;
+ static integer its;
+ static doublereal ulp, tst1;
+
+ (void)lwork;
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZHSEQR computes the eigenvalues of a complex upper Hessenberg */
+/* matrix H, and, optionally, the matrices T and Z from the Schur */
+/* decomposition H = Z T Z**H, where T is an upper triangular matrix */
+/* (the Schur form), and Z is the unitary matrix of Schur vectors. */
+/* */
+/* Optionally Z may be postmultiplied into an input unitary matrix Q, */
+/* so that this routine can give the Schur factorization of a matrix A */
+/* which has been reduced to the Hessenberg form H by the unitary */
+/* matrix Q: A = Q*H*Q**H = (QZ)*T*(QZ)**H. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* JOB (input) CHARACTER*1 */
+/* = 'E': compute eigenvalues only; */
+/* = 'S': compute eigenvalues and the Schur form T. */
+/* */
+/* COMPZ (input) CHARACTER*1 */
+/* = 'N': no Schur vectors are computed; */
+/* = 'I': Z is initialized to the unit matrix and the matrix Z */
+/* of Schur vectors of H is returned; */
+/* = 'V': Z must contain an unitary matrix Q on entry, and */
+/* the product Q*Z is returned. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix H. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that H is already upper triangular in rows */
+/* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally */
+/* set by a previous call to ZGEBAL, and then passed to CGEHRD */
+/* when the matrix output by ZGEBAL is reduced to Hessenberg */
+/* form. Otherwise ILO and IHI should be set to 1 and N */
+/* respectively. */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+/* */
+/* H (input/output) COMPLEX*16 array, dimension (LDH,N) */
+/* On entry, the upper Hessenberg matrix H. */
+/* On exit, if JOB = 'S', H contains the upper triangular matrix */
+/* T from the Schur decomposition (the Schur form). If */
+/* JOB = 'E', the contents of H are unspecified on exit. */
+/* */
+/* LDH (input) INTEGER */
+/* The leading dimension of the array H. LDH >= max(1,N). */
+/* */
+/* W (output) COMPLEX*16 array, dimension (N) */
+/* The computed eigenvalues. If JOB = 'S', the eigenvalues are */
+/* stored in the same order as on the diagonal of the Schur form */
+/* returned in H, with W(i) = H(i,i). */
+/* */
+/* Z (input/output) COMPLEX*16 array, dimension (LDZ,N) */
+/* If COMPZ = 'N': Z is not referenced. */
+/* If COMPZ = 'I': on entry, Z need not be set, and on exit, Z */
+/* contains the unitary matrix Z of the Schur vectors of H. */
+/* If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q, */
+/* which is assumed to be equal to the unit matrix except for */
+/* the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z. */
+/* Normally Q is the unitary matrix generated by ZUNGHR after */
+/* the call to ZGEHRD which formed the Hessenberg matrix H. */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. */
+/* LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise. */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (N) */
+/* */
+/* LWORK (input) INTEGER */
+/* This argument is currently redundant. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, ZHSEQR failed to compute all the */
+/* eigenvalues in a total of 30*(IHI-ILO+1) iterations; */
+/* elements 1:ilo-1 and i+1:n of W contain those */
+/* eigenvalues which have been successfully computed. */
+/* */
+/* ===================================================================== */
+
+ wantt = lsame_(job, "S");
+ initz = lsame_(compz, "I");
+ wantz = initz || lsame_(compz, "V");
+
+ *info = 0;
+ if (! lsame_(job, "E") && ! wantt) {
+ *info = -1;
+ } else if (! lsame_(compz, "N") && ! wantz) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*ldh < max(1,*n)) {
+ *info = -7;
+ } else if (*ldz < 1 || (wantz && *ldz < max(1,*n))) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZHSEQR", &i__1);
+ return;
+ }
+
+/* Initialize Z, if necessary */
+
+ if (initz) {
+ zlaset_("Full", n, n, &c_b9, &c_b10, z, ldz);
+ }
+
+/* Store the eigenvalues isolated by ZGEBAL. */
+
+ for (i = 0; i < *ilo - 1; ++i) {
+ i__1 = i + i * *ldh; /* index [i,i] */
+ w[i].r = h[i__1].r, w[i].i = h[i__1].i;
+ }
+ for (i = *ihi; i < *n; ++i) {
+ i__1 = i + i * *ldh; /* index [i,i] */
+ w[i].r = h[i__1].r, w[i].i = h[i__1].i;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+ if (*ilo == *ihi) {
+ i__1 = (*ilo-1) + (*ilo-1) * *ldh; /* index [*ilo-1,*ilo-1] */
+ w[*ilo-1].r = h[i__1].r, w[*ilo-1].i = h[i__1].i;
+ return;
+ }
+
+/* Set rows and columns ILO to IHI to zero below the first */
+/* subdiagonal. */
+
+ for (j = *ilo-1; j < *ihi - 2; ++j) {
+ for (i = j + 2; i < *n; ++i) {
+ i__1 = i + j * *ldh; /* index [i,j] */
+ h[i__1].r = 0., h[i__1].i = 0.;
+ }
+ }
+ nh = *ihi - *ilo + 1;
+
+/* I1 and I2 are the indices of the first row and last column of H */
+/* to which transformations must be applied. If eigenvalues only are */
+/* being computed, I1 and I2 are re-set inside the main loop. */
+
+ if (wantt) {
+ i1 = 0;
+ i2 = *n-1;
+ } else {
+ i1 = *ilo-1;
+ i2 = *ihi-1;
+ }
+
+/* Ensure that the subdiagonal elements are real. */
+
+ for (i = *ilo; i < *ihi; ++i) {
+ i__1 = i + (i - 1) * *ldh; /* index [i,i-1] */
+ temp.r = h[i__1].r, temp.i = h[i__1].i;
+ if (temp.i != 0.) {
+ rtemp = dlapy2_(&(temp.r), &(temp.i));
+ i__1 = i + (i - 1) * *ldh; /* index [i,i-1] */
+ h[i__1].r = rtemp, h[i__1].i = 0.;
+ temp.r /= rtemp, temp.i /= rtemp;
+ if (i2 > i) {
+ i__1 = i2 - i;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__1, &z__1, &h[i + (i + 1) * *ldh], ldh);
+ }
+ i__1 = i - i1;
+ zscal_(&i__1, &temp, &h[i1 + i * *ldh], &c__1);
+ if (i < *ihi-1) {
+ i__1 = i + 1 + i * *ldh; /* index [i+1,i] */
+ z__1.r = temp.r * h[i__1].r - temp.i * h[i__1].i,
+ z__1.i = temp.r * h[i__1].i + temp.i * h[i__1].r;
+ h[i__1].r = z__1.r, h[i__1].i = z__1.i;
+ }
+ if (wantz) {
+ zscal_(&nh, &temp, &z[*ilo-1 + i * *ldz], &c__1);
+ }
+ }
+ }
+
+/* Determine the order of the multi-shift QR algorithm to be used. */
+
+/* Writing concatenation */
+ ii__4[0] = 1, a__1[0] = job;
+ ii__4[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, ii__4, &c__2, 2L);
+ ns = ilaenv_(&c__4, "ZHSEQR", ch__1, n, ilo, ihi, &c_n1) - 1;
+/* Writing concatenation */
+ ii__4[0] = 1, a__1[0] = job;
+ ii__4[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, ii__4, &c__2, 2L);
+ maxb = ilaenv_(&c__8, "ZHSEQR", ch__1, n, ilo, ihi, &c_n1);
+ if (ns <= 0 || ns >= nh || maxb >= nh) {
+
+/* Use the standard double-shift algorithm */
+
+ zlahqr_(&wantt, &wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z, ldz, info);
+ return;
+ }
+ maxb = max(2,maxb);
+ ns = min(min(ns,maxb-1),14);
+
+/* Now 1 < NS <= MAXB < NH. */
+
+/* Set machine-dependent constants for the stopping criterion. */
+/* If norm(H) <= sqrt(OVFL), overflow should not occur. */
+
+ unfl = dlamch_("Safe minimum");
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = dlamch_("Precision");
+ smlnum = unfl * (nh / ulp);
+
+/* ITN is the total number of multiple-shift QR iterations allowed. */
+
+ itn = nh * 30;
+
+/* The main loop begins here. I is the loop index and decreases from */
+/* IHI to ILO in steps of at most MAXB. Each iteration of the loop */
+/* works with the active submatrix in rows and columns L to I. */
+/* Eigenvalues I+1 to IHI have already converged. Either L = ILO, or */
+/* H(L,L-1) is negligible so that the matrix splits. */
+
+ i = *ihi-1;
+L60:
+ if (i < *ilo-1) {
+ return; /* exit from zhseqr_ */
+ }
+
+/* Perform multiple-shift QR iterations on rows and columns ILO to I */
+/* until a submatrix of order at most MAXB splits off at the bottom */
+/* because a subdiagonal element has become negligible. */
+
+ l = *ilo-1;
+ for (its = 0; its <= itn; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ for (k = i; k > l; --k) {
+ i__1 = (k - 1) * (*ldh + 1); /* index [k-1,k-1] */
+ i__2 = k + k * *ldh; /* index [k,k] */
+ tst1 = abs(h[i__1].r) + abs(h[i__1].i) + abs(h[i__2].r) + abs(h[i__2].i);
+ if (tst1 == 0.) {
+ i__1 = i - l + 1;
+ tst1 = zlanhs_("1", &i__1, &h[l + l * *ldh], ldh, rwork);
+ }
+ if (abs(h[k + (k - 1) * *ldh].r) <= max(ulp*tst1, smlnum)) {
+ break;
+ }
+ }
+ l = k;
+ if (l > *ilo-1) {
+
+/* H(L,L-1) is negligible. */
+
+ i__1 = l + (l - 1) * *ldh; /* index [l,l-1] */
+ h[i__1].r = 0., h[i__1].i = 0.;
+ }
+
+/* Exit from loop if a submatrix of order <= MAXB has split off. */
+
+ if (l > i - maxb) {
+ goto L170;
+ }
+
+/* Now the active submatrix is in rows and columns L to I. If */
+/* eigenvalues only are being computed, only the active submatrix */
+/* need be transformed. */
+
+ if (! wantt) {
+ i1 = l;
+ i2 = i;
+ }
+
+ if (its == 20 || its == 30) {
+
+/* Exceptional shifts. */
+
+ for (ii = i - ns; ii <= i; ++ii) {
+ w[ii].r = (abs(h[ii + (ii - 1) * *ldh].r) + abs(h[ii + ii * *ldh].r)) * 1.5,
+ w[ii].i = 0.;
+ }
+ } else {
+
+/* Use eigenvalues of trailing submatrix of order NS as shifts. */
+
+ i__1 = ns + 1;
+ zlacpy_("Full", &i__1, &i__1, &h[i - ns + (i - ns) * *ldh], ldh, s, &c__15);
+ zlahqr_(&c__0, &c__0, &i__1, &c__1, &i__1, s, &c__15, &w[i - ns], &c__1, &i__1, z, ldz, &ierr);
+
+ if (ierr > 0) {
+
+/* If ZLAHQR failed to compute all NS eigenvalues, use the */
+/* unconverged diagonal elements as the remaining shifts. */
+
+ for (ii = 0; ii < ierr; ++ii) {
+ i__1 = i - ns + ii;
+ i__2 = ii + ii * 15;
+ w[i__1].r = s[i__2].r, w[i__1].i = s[i__2].i;
+ }
+ }
+ }
+
+/* Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) */
+/* where G is the Hessenberg submatrix H(L:I,L:I) and w is */
+/* the vector of shifts (stored in W). The result is */
+/* stored in the local array V. */
+
+ v[0].r = 1., v[0].i = 0.;
+ for (ii = 1; ii <= ns+1; ++ii) {
+ v[ii].r = 0., v[ii].i = 0.;
+ }
+ nv = 1;
+ for (j = i - ns; j <= i; ++j) {
+ i__1 = nv + 1;
+ zcopy_(&i__1, v, &c__1, vv, &c__1);
+ z__1.r = -w[j].r, z__1.i = -w[j].i;
+ zgemv_("No transpose", &i__1, &nv, &c_b10, &h[l + l * *ldh], ldh, vv, &c__1, &z__1, v, &c__1);
+ ++nv;
+
+/* Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero, */
+/* reset it to the unit vector. */
+
+ itemp = izamax_(&nv, v, &c__1);
+ i__1 = itemp - 1;
+ rtemp = abs(v[i__1].r) + abs(v[i__1].i);
+ if (rtemp == 0.) {
+ v[0].r = 1., v[0].i = 0.;
+ for (ii = 1; ii < nv; ++ii) {
+ v[ii].r = 0., v[ii].i = 0.;
+ }
+ } else {
+ rtemp = max(rtemp,smlnum);
+ d__1 = 1. / rtemp;
+ zdscal_(&nv, &d__1, v, &c__1);
+ }
+ }
+
+/* Multiple-shift QR step */
+
+ for (k = l; k < i; ++k) {
+
+/* The first iteration of this loop determines a reflection G */
+/* from the vector V and applies it from left and right to H, */
+/* thus creating a nonzero bulge below the subdiagonal. */
+
+/* Each subsequent iteration determines a reflection G to */
+/* restore the Hessenberg form in the (K-1)th column, and thus */
+/* chases the bulge one step toward the bottom of the active */
+/* submatrix. NR is the order of G. */
+
+ nr = min(ns+2, i-k+1);
+ if (k > l) {
+ zcopy_(&nr, &h[k + (k - 1) * *ldh], &c__1, v, &c__1);
+ }
+ zlarfg_(&nr, v, &v[1], &c__1, &tau);
+ if (k > l) {
+ i__1 = k + (k - 1) * *ldh; /* index [k,k-1] */
+ h[i__1].r = v[0].r, h[i__1].i = v[0].i;
+ for (ii = k+1; ii <= i; ++ii) {
+ i__1 = ii + (k - 1) * *ldh; /* index [ii,k-1] */
+ h[i__1].r = 0., h[i__1].i = 0.;
+ }
+ }
+ v[0].r = 1., v[0].i = 0.;
+
+/* Apply G' from the left to transform the rows of the matrix */
+/* in columns K to I2. */
+
+ i__1 = i2 - k + 1;
+ d_cnjg(&z__1, &tau);
+ zlarfx_("Left", &nr, &i__1, v, &z__1, &h[k + k * *ldh], ldh, work);
+
+/* Apply G from the right to transform the columns of the */
+/* matrix in rows I1 to min(K+NR,I). */
+
+ i__1 = min(k+nr,i) - i1 + 1;
+ zlarfx_("Right", &i__1, &nr, v, &tau, &h[i1 + k * *ldh], ldh, work);
+
+ if (wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ zlarfx_("Right", &nh, &nr, v, &tau, &z[*ilo-1 + k * *ldz], ldz, work);
+ }
+ }
+
+/* Ensure that H(I,I-1) is real. */
+
+ i__1 = i + (i - 1) * *ldh; /* index [i,i-1] */
+ temp.r = h[i__1].r, temp.i = h[i__1].i;
+ if (temp.i != 0.) {
+ rtemp = dlapy2_(&(temp.r), &(temp.i));
+ i__1 = i + (i - 1) * *ldh; /* index [i,i-1] */
+ h[i__1].r = rtemp, h[i__1].i = 0.;
+ temp.r /= rtemp, temp.i /= rtemp;
+ if (i2 > i) {
+ i__1 = i2 - i;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__1, &z__1, &h[i + (i + 1) * *ldh], ldh);
+ }
+ i__1 = i - i1;
+ zscal_(&i__1, &temp, &h[i1 + i * *ldh], &c__1);
+ if (wantz) {
+ zscal_(&nh, &temp, &z[*ilo-1 + i * *ldz], &c__1);
+ }
+ }
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i+1;
+ return;
+
+L170:
+
+/* A submatrix of order <= MAXB in rows and columns L to I has split */
+/* off. Use the double-shift QR algorithm to handle it. */
+
+ i__1 = l+1; i__2 = i+1;
+ zlahqr_(&wantt, &wantz, n, &i__1, &i__2, h, ldh, w, ilo, ihi, z, ldz, info);
+ if (*info > 0) {
+ return;
+ }
+
+/* Decrement number of remaining iterations, and return to start of */
+/* the main loop with a new value of I. */
+
+ itn -= its;
+ i = l-1;
+ goto L60;
+} /* zhseqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..eb0c1a8581a2ac19dac65786cf0ec093b4097a95
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zhseqr.f
@@ -0,0 +1,461 @@
+ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
+ $ WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER COMPZ, JOB
+ INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZHSEQR computes the eigenvalues of a complex upper Hessenberg
+* matrix H, and, optionally, the matrices T and Z from the Schur
+* decomposition H = Z T Z**H, where T is an upper triangular matrix
+* (the Schur form), and Z is the unitary matrix of Schur vectors.
+*
+* Optionally Z may be postmultiplied into an input unitary matrix Q,
+* so that this routine can give the Schur factorization of a matrix A
+* which has been reduced to the Hessenberg form H by the unitary
+* matrix Q: A = Q*H*Q**H = (QZ)*T*(QZ)**H.
+*
+* Arguments
+* =========
+*
+* JOB (input) CHARACTER*1
+* = 'E': compute eigenvalues only;
+* = 'S': compute eigenvalues and the Schur form T.
+*
+* COMPZ (input) CHARACTER*1
+* = 'N': no Schur vectors are computed;
+* = 'I': Z is initialized to the unit matrix and the matrix Z
+* of Schur vectors of H is returned;
+* = 'V': Z must contain an unitary matrix Q on entry, and
+* the product Q*Z is returned.
+*
+* N (input) INTEGER
+* The order of the matrix H. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that H is already upper triangular in rows
+* and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+* set by a previous call to ZGEBAL, and then passed to CGEHRD
+* when the matrix output by ZGEBAL is reduced to Hessenberg
+* form. Otherwise ILO and IHI should be set to 1 and N
+* respectively.
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* H (input/output) COMPLEX*16 array, dimension (LDH,N)
+* On entry, the upper Hessenberg matrix H.
+* On exit, if JOB = 'S', H contains the upper triangular matrix
+* T from the Schur decomposition (the Schur form). If
+* JOB = 'E', the contents of H are unspecified on exit.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max(1,N).
+*
+* W (output) COMPLEX*16 array, dimension (N)
+* The computed eigenvalues. If JOB = 'S', the eigenvalues are
+* stored in the same order as on the diagonal of the Schur form
+* returned in H, with W(i) = H(i,i).
+*
+* Z (input/output) COMPLEX*16 array, dimension (LDZ,N)
+* If COMPZ = 'N': Z is not referenced.
+* If COMPZ = 'I': on entry, Z need not be set, and on exit, Z
+* contains the unitary matrix Z of the Schur vectors of H.
+* If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q,
+* which is assumed to be equal to the unit matrix except for
+* the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z.
+* Normally Q is the unitary matrix generated by ZUNGHR after
+* the call to ZGEHRD which formed the Hessenberg matrix H.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z.
+* LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise.
+*
+* WORK (workspace) COMPLEX*16 array, dimension (N)
+*
+* LWORK (input) INTEGER
+* This argument is currently redundant.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+* > 0: if INFO = i, ZHSEQR failed to compute all the
+* eigenvalues in a total of 30*(IHI-ILO+1) iterations;
+* elements 1:ilo-1 and i+1:n of W contain those
+* eigenvalues which have been successfully computed.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+ DOUBLE PRECISION RZERO, RONE, CONST
+ PARAMETER ( RZERO = 0.0D+0, RONE = 1.0D+0,
+ $ CONST = 1.5D+0 )
+ INTEGER NSMAX, LDS
+ PARAMETER ( NSMAX = 15, LDS = NSMAX )
+* ..
+* .. Local Scalars ..
+ LOGICAL INITZ, WANTT, WANTZ
+ INTEGER I, I1, I2, IERR, II, ITEMP, ITN, ITS, J, K, L,
+ $ MAXB, NH, NR, NS, NV
+ DOUBLE PRECISION OVFL, RTEMP, SMLNUM, TST1, ULP, UNFL
+ COMPLEX*16 CDUM, TAU, TEMP
+* ..
+* .. Local Arrays ..
+ DOUBLE PRECISION RWORK( 1 )
+ COMPLEX*16 S( LDS, NSMAX ), V( NSMAX+1 ), VV( NSMAX+1 )
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER ILAENV, IZAMAX
+ DOUBLE PRECISION DLAMCH, DLAPY2, ZLANHS
+ EXTERNAL LSAME, ILAENV, IZAMAX, DLAMCH, DLAPY2, ZLANHS
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLABAD, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLACPY,
+ $ ZLAHQR, ZLARFG, ZLARFX, ZLASET, ZSCAL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1
+* ..
+* .. Statement Function definitions ..
+ CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
+* ..
+* .. Executable Statements ..
+*
+* Decode and test the input parameters
+*
+ WANTT = LSAME( JOB, 'S' )
+ INITZ = LSAME( COMPZ, 'I' )
+ WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
+*
+ INFO = 0
+ IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
+ INFO = -1
+ ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
+ INFO = -4
+ ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
+ INFO = -5
+ ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. LDZ.LT.MAX( 1, N ) ) THEN
+ INFO = -10
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZHSEQR', -INFO )
+ RETURN
+ END IF
+*
+* Initialize Z, if necessary
+*
+ IF( INITZ )
+ $ CALL ZLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
+*
+* Store the eigenvalues isolated by ZGEBAL.
+*
+ DO 10 I = 1, ILO - 1
+ W( I ) = H( I, I )
+ 10 CONTINUE
+ DO 20 I = IHI + 1, N
+ W( I ) = H( I, I )
+ 20 CONTINUE
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+ IF( ILO.EQ.IHI ) THEN
+ W( ILO ) = H( ILO, ILO )
+ RETURN
+ END IF
+*
+* Set rows and columns ILO to IHI to zero below the first
+* subdiagonal.
+*
+ DO 40 J = ILO, IHI - 2
+ DO 30 I = J + 2, N
+ H( I, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ NH = IHI - ILO + 1
+*
+* I1 and I2 are the indices of the first row and last column of H
+* to which transformations must be applied. If eigenvalues only are
+* being computed, I1 and I2 are re-set inside the main loop.
+*
+ IF( WANTT ) THEN
+ I1 = 1
+ I2 = N
+ ELSE
+ I1 = ILO
+ I2 = IHI
+ END IF
+*
+* Ensure that the subdiagonal elements are real.
+*
+ DO 50 I = ILO + 1, IHI
+ TEMP = H( I, I-1 )
+ IF( DIMAG( TEMP ).NE.RZERO ) THEN
+ RTEMP = DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+ H( I, I-1 ) = RTEMP
+ TEMP = TEMP / RTEMP
+ IF( I2.GT.I )
+ $ CALL ZSCAL( I2-I, DCONJG( TEMP ), H( I, I+1 ), LDH )
+ CALL ZSCAL( I-I1, TEMP, H( I1, I ), 1 )
+ IF( I.LT.IHI )
+ $ H( I+1, I ) = TEMP*H( I+1, I )
+ IF( WANTZ )
+ $ CALL ZSCAL( NH, TEMP, Z( ILO, I ), 1 )
+ END IF
+ 50 CONTINUE
+*
+* Determine the order of the multi-shift QR algorithm to be used.
+*
+ NS = ILAENV( 4, 'ZHSEQR', JOB // COMPZ, N, ILO, IHI, -1 )
+ MAXB = ILAENV( 8, 'ZHSEQR', JOB // COMPZ, N, ILO, IHI, -1 )
+ IF( NS.LE.1 .OR. NS.GT.NH .OR. MAXB.GE.NH ) THEN
+*
+* Use the standard double-shift algorithm
+*
+ CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z,
+ $ LDZ, INFO )
+ RETURN
+ END IF
+ MAXB = MAX( 2, MAXB )
+ NS = MIN( NS, MAXB, NSMAX )
+*
+* Now 1 < NS <= MAXB < NH.
+*
+* Set machine-dependent constants for the stopping criterion.
+* If norm(H) <= sqrt(OVFL), overflow should not occur.
+*
+ UNFL = DLAMCH( 'Safe minimum' )
+ OVFL = RONE / UNFL
+ CALL DLABAD( UNFL, OVFL )
+ ULP = DLAMCH( 'Precision' )
+ SMLNUM = UNFL*( NH / ULP )
+*
+* ITN is the total number of multiple-shift QR iterations allowed.
+*
+ ITN = 30*NH
+*
+* The main loop begins here. I is the loop index and decreases from
+* IHI to ILO in steps of at most MAXB. Each iteration of the loop
+* works with the active submatrix in rows and columns L to I.
+* Eigenvalues I+1 to IHI have already converged. Either L = ILO, or
+* H(L,L-1) is negligible so that the matrix splits.
+*
+ I = IHI
+ 60 CONTINUE
+ IF( I.LT.ILO )
+ $ GO TO 180
+*
+* Perform multiple-shift QR iterations on rows and columns ILO to I
+* until a submatrix of order at most MAXB splits off at the bottom
+* because a subdiagonal element has become negligible.
+*
+ L = ILO
+ DO 160 ITS = 0, ITN
+*
+* Look for a single small subdiagonal element.
+*
+ DO 70 K = I, L + 1, -1
+ TST1 = CABS1( H( K-1, K-1 ) ) + CABS1( H( K, K ) )
+ IF( TST1.EQ.RZERO )
+ $ TST1 = ZLANHS( '1', I-L+1, H( L, L ), LDH, RWORK )
+ IF( ABS( DBLE( H( K, K-1 ) ) ).LE.MAX( ULP*TST1, SMLNUM ) )
+ $ GO TO 80
+ 70 CONTINUE
+ 80 CONTINUE
+ L = K
+ IF( L.GT.ILO ) THEN
+*
+* H(L,L-1) is negligible.
+*
+ H( L, L-1 ) = ZERO
+ END IF
+*
+* Exit from loop if a submatrix of order <= MAXB has split off.
+*
+ IF( L.GE.I-MAXB+1 )
+ $ GO TO 170
+*
+* Now the active submatrix is in rows and columns L to I. If
+* eigenvalues only are being computed, only the active submatrix
+* need be transformed.
+*
+ IF( .NOT.WANTT ) THEN
+ I1 = L
+ I2 = I
+ END IF
+*
+ IF( ITS.EQ.20 .OR. ITS.EQ.30 ) THEN
+*
+* Exceptional shifts.
+*
+ DO 90 II = I - NS + 1, I
+ W( II ) = CONST*( ABS( DBLE( H( II, II-1 ) ) )+
+ $ ABS( DBLE( H( II, II ) ) ) )
+ 90 CONTINUE
+ ELSE
+*
+* Use eigenvalues of trailing submatrix of order NS as shifts.
+*
+ CALL ZLACPY( 'Full', NS, NS, H( I-NS+1, I-NS+1 ), LDH, S,
+ $ LDS )
+ CALL ZLAHQR( .FALSE., .FALSE., NS, 1, NS, S, LDS,
+ $ W( I-NS+1 ), 1, NS, Z, LDZ, IERR )
+ IF( IERR.GT.0 ) THEN
+*
+* If ZLAHQR failed to compute all NS eigenvalues, use the
+* unconverged diagonal elements as the remaining shifts.
+*
+ DO 100 II = 1, IERR
+ W( I-NS+II ) = S( II, II )
+ 100 CONTINUE
+ END IF
+ END IF
+*
+* Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
+* where G is the Hessenberg submatrix H(L:I,L:I) and w is
+* the vector of shifts (stored in W). The result is
+* stored in the local array V.
+*
+ V( 1 ) = ONE
+ DO 110 II = 2, NS + 1
+ V( II ) = ZERO
+ 110 CONTINUE
+ NV = 1
+ DO 130 J = I - NS + 1, I
+ CALL ZCOPY( NV+1, V, 1, VV, 1 )
+ CALL ZGEMV( 'No transpose', NV+1, NV, ONE, H( L, L ), LDH,
+ $ VV, 1, -W( J ), V, 1 )
+ NV = NV + 1
+*
+* Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
+* reset it to the unit vector.
+*
+ ITEMP = IZAMAX( NV, V, 1 )
+ RTEMP = CABS1( V( ITEMP ) )
+ IF( RTEMP.EQ.RZERO ) THEN
+ V( 1 ) = ONE
+ DO 120 II = 2, NV
+ V( II ) = ZERO
+ 120 CONTINUE
+ ELSE
+ RTEMP = MAX( RTEMP, SMLNUM )
+ CALL ZDSCAL( NV, RONE / RTEMP, V, 1 )
+ END IF
+ 130 CONTINUE
+*
+* Multiple-shift QR step
+*
+ DO 150 K = L, I - 1
+*
+* The first iteration of this loop determines a reflection G
+* from the vector V and applies it from left and right to H,
+* thus creating a nonzero bulge below the subdiagonal.
+*
+* Each subsequent iteration determines a reflection G to
+* restore the Hessenberg form in the (K-1)th column, and thus
+* chases the bulge one step toward the bottom of the active
+* submatrix. NR is the order of G.
+*
+ NR = MIN( NS+1, I-K+1 )
+ IF( K.GT.L )
+ $ CALL ZCOPY( NR, H( K, K-1 ), 1, V, 1 )
+ CALL ZLARFG( NR, V( 1 ), V( 2 ), 1, TAU )
+ IF( K.GT.L ) THEN
+ H( K, K-1 ) = V( 1 )
+ DO 140 II = K + 1, I
+ H( II, K-1 ) = ZERO
+ 140 CONTINUE
+ END IF
+ V( 1 ) = ONE
+*
+* Apply G' from the left to transform the rows of the matrix
+* in columns K to I2.
+*
+ CALL ZLARFX( 'Left', NR, I2-K+1, V, DCONJG( TAU ),
+ $ H( K, K ), LDH, WORK )
+*
+* Apply G from the right to transform the columns of the
+* matrix in rows I1 to min(K+NR,I).
+*
+ CALL ZLARFX( 'Right', MIN( K+NR, I )-I1+1, NR, V, TAU,
+ $ H( I1, K ), LDH, WORK )
+*
+ IF( WANTZ ) THEN
+*
+* Accumulate transformations in the matrix Z
+*
+ CALL ZLARFX( 'Right', NH, NR, V, TAU, Z( ILO, K ), LDZ,
+ $ WORK )
+ END IF
+ 150 CONTINUE
+*
+* Ensure that H(I,I-1) is real.
+*
+ TEMP = H( I, I-1 )
+ IF( DIMAG( TEMP ).NE.RZERO ) THEN
+ RTEMP = DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+ H( I, I-1 ) = RTEMP
+ TEMP = TEMP / RTEMP
+ IF( I2.GT.I )
+ $ CALL ZSCAL( I2-I, DCONJG( TEMP ), H( I, I+1 ), LDH )
+ CALL ZSCAL( I-I1, TEMP, H( I1, I ), 1 )
+ IF( WANTZ ) THEN
+ CALL ZSCAL( NH, TEMP, Z( ILO, I ), 1 )
+ END IF
+ END IF
+*
+ 160 CONTINUE
+*
+* Failure to converge in remaining number of iterations
+*
+ INFO = I
+ RETURN
+*
+ 170 CONTINUE
+*
+* A submatrix of order <= MAXB in rows and columns L to I has split
+* off. Use the double-shift QR algorithm to handle it.
+*
+ CALL ZLAHQR( WANTT, WANTZ, N, L, I, H, LDH, W, ILO, IHI, Z, LDZ,
+ $ INFO )
+ IF( INFO.GT.0 )
+ $ RETURN
+*
+* Decrement number of remaining iterations, and return to start of
+* the main loop with a new value of I.
+*
+ ITN = ITN - ITS
+ I = L - 1
+ GO TO 60
+*
+ 180 CONTINUE
+ RETURN
+*
+* End of ZHSEQR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.c
new file mode 100644
index 0000000000000000000000000000000000000000..f18a9d2b78a088c1eafeb39feefc209821774b48
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.c
@@ -0,0 +1,56 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zlacgv_(n, x, incx)
+const integer *n;
+doublecomplex *x;
+const integer *incx;
+{
+ /* Local variables */
+ static integer ioff, i;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLACGV conjugates a complex vector of length N. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The length of the vector X. N >= 0. */
+/* */
+/* X (input/output) COMPLEX*16 array, dimension */
+/* (1+(N-1)*abs(INCX)) */
+/* On entry, the vector of length N to be conjugated. */
+/* On exit, X is overwritten with conjg(X). */
+/* */
+/* INCX (input) INTEGER */
+/* The spacing between successive elements of X. */
+/* */
+/* ===================================================================== */
+
+ if (*incx == 1) {
+ for (i = 0; i < *n; ++i) {
+ x[i].i = -x[i].i; /* d_cnjg(&x[i], &x[i]); */
+ }
+ } else {
+ ioff = 0;
+ if (*incx < 0) {
+ ioff = (1-(*n)) * *incx;
+ }
+ for (i = 0; i < *n; ++i) {
+ x[ioff].i = -x[ioff].i; /* d_cnjg(&x[ioff], &x[ioff]); */
+ ioff += *incx;
+ }
+ }
+} /* zlacgv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.f
new file mode 100644
index 0000000000000000000000000000000000000000..e0d37e22703a1290ee0c82308de902c43ec1932c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacgv.f
@@ -0,0 +1,61 @@
+ SUBROUTINE ZLACGV( N, X, INCX )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLACGV conjugates a complex vector of length N.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The length of the vector X. N >= 0.
+*
+* X (input/output) COMPLEX*16 array, dimension
+* (1+(N-1)*abs(INCX))
+* On entry, the vector of length N to be conjugated.
+* On exit, X is overwritten with conjg(X).
+*
+* INCX (input) INTEGER
+* The spacing between successive elements of X.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, IOFF
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+ IF( INCX.EQ.1 ) THEN
+ DO 10 I = 1, N
+ X( I ) = DCONJG( X( I ) )
+ 10 CONTINUE
+ ELSE
+ IOFF = 1
+ IF( INCX.LT.0 )
+ $ IOFF = 1 - ( N-1 )*INCX
+ DO 20 I = 1, N
+ X( IOFF ) = DCONJG( X( IOFF ) )
+ IOFF = IOFF + INCX
+ 20 CONTINUE
+ END IF
+ RETURN
+*
+* End of ZLACGV
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.c
new file mode 100644
index 0000000000000000000000000000000000000000..38f71f51cb7c87119a9bebd5801b3d8f4dc97a1a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.c
@@ -0,0 +1,92 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zlacpy_(uplo, m, n, a, lda, b, ldb)
+const char *uplo;
+const integer *m, *n;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *b;
+const integer *ldb;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, j;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLACPY copies all or part of a two-dimensional matrix A to another */
+/* matrix B. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be copied to B. */
+/* = 'U': Upper triangular part */
+/* = 'L': Lower triangular part */
+/* Otherwise: All of the matrix A */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input) COMPLEX*16 array, dimension (LDA,N) */
+/* The m by n matrix A. If UPLO = 'U', only the upper trapezium */
+/* is accessed; if UPLO = 'L', only the lower trapezium is */
+/* accessed. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* B (output) COMPLEX*16 array, dimension (LDB,N) */
+/* On exit, B = A in the locations specified by UPLO. */
+/* */
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j && i < *m; ++i) {
+ i__1 = i + j * *ldb;
+ i__2 = i + j * *lda;
+ b[i__1].r = a[i__2].r, b[i__1].i = a[i__2].i;
+ }
+ }
+
+ } else if (lsame_(uplo, "L")) {
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *m; ++i) {
+ i__1 = i + j * *ldb;
+ i__2 = i + j * *lda;
+ b[i__1].r = a[i__2].r, b[i__1].i = a[i__2].i;
+ }
+ }
+
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldb;
+ i__2 = i + j * *lda;
+ b[i__1].r = a[i__2].r, b[i__1].i = a[i__2].i;
+ }
+ }
+ }
+} /* zlacpy_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.f
new file mode 100644
index 0000000000000000000000000000000000000000..35530009daceaa1fbdf3ade52b4bbcaa9a053319
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlacpy.f
@@ -0,0 +1,91 @@
+ SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, LDB, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLACPY copies all or part of a two-dimensional matrix A to another
+* matrix B.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be copied to B.
+* = 'U': Upper triangular part
+* = 'L': Lower triangular part
+* Otherwise: All of the matrix A
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input) COMPLEX*16 array, dimension (LDA,N)
+* The m by n matrix A. If UPLO = 'U', only the upper trapezium
+* is accessed; if UPLO = 'L', only the lower trapezium is
+* accessed.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* B (output) COMPLEX*16 array, dimension (LDB,N)
+* On exit, B = A in the locations specified by UPLO.
+*
+* LDB (input) INTEGER
+* The leading dimension of the array B. LDB >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+ DO 20 J = 1, N
+ DO 10 I = 1, MIN( J, M )
+ B( I, J ) = A( I, J )
+ 10 CONTINUE
+ 20 CONTINUE
+*
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+ DO 40 J = 1, N
+ DO 30 I = J, M
+ B( I, J ) = A( I, J )
+ 30 CONTINUE
+ 40 CONTINUE
+*
+ ELSE
+ DO 60 J = 1, N
+ DO 50 I = 1, M
+ B( I, J ) = A( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLACPY
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.c
new file mode 100644
index 0000000000000000000000000000000000000000..76b6965c6ee60953f79fcbf025687c37d0234ad9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.c
@@ -0,0 +1,36 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Double Complex */ void zladiv_( ret_val, x, y)
+doublecomplex * ret_val;
+const doublecomplex *x, *y;
+{
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLADIV := X / Y, where X and Y are complex. The computation of X / Y */
+/* will not overflow on an intermediary step unless the results */
+/* overflows. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* X (input) COMPLEX*16 */
+/* Y (input) COMPLEX*16 */
+/* The complex scalars X and Y. */
+/* */
+/* ===================================================================== */
+
+ dladiv_(&(x->r), &(x->i), &(y->r), &(y->i), &(ret_val->r), &(ret_val->i));
+ return;
+} /* zladiv_ */
+
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.f
new file mode 100644
index 0000000000000000000000000000000000000000..690fb30fe4f227d3f83674d416b728d82d877c65
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zladiv.f
@@ -0,0 +1,47 @@
+ DOUBLE COMPLEX FUNCTION ZLADIV( X, Y )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ COMPLEX*16 X, Y
+* ..
+*
+* Purpose
+* =======
+*
+* ZLADIV := X / Y, where X and Y are complex. The computation of X / Y
+* will not overflow on an intermediary step unless the results
+* overflows.
+*
+* Arguments
+* =========
+*
+* X (input) COMPLEX*16
+* Y (input) COMPLEX*16
+* The complex scalars X and Y.
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ DOUBLE PRECISION ZI, ZR
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, DCMPLX, DIMAG
+* ..
+* .. Executable Statements ..
+*
+ CALL DLADIV( DBLE( X ), DIMAG( X ), DBLE( Y ), DIMAG( Y ), ZR,
+ $ ZI )
+ ZLADIV = DCMPLX( ZR, ZI )
+*
+ RETURN
+*
+* End of ZLADIV
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..66063f85f02de22bb647e3c2aec924540de94735
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.c
@@ -0,0 +1,436 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__2 = 2;
+static integer c__1 = 1;
+
+/* Subroutine */ void zlahqr_(wantt, wantz, n, ilo, ihi, h, ldh, w, iloz, ihiz, z, ldz, info)
+const logical *wantt, *wantz;
+const integer *n, *ilo, *ihi;
+doublecomplex *h;
+const integer *ldh;
+doublecomplex *w;
+integer *iloz, *ihiz;
+doublecomplex *z;
+const integer *ldz;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1, d__2;
+ doublecomplex z__1, z__2;
+
+ /* Local variables */
+ static doublereal unfl, ovfl;
+ static doublecomplex temp;
+ static integer i, j, k, l, m;
+ static doublereal s;
+ static doublecomplex t, u, v[2], x, y;
+ static doublereal rtemp;
+ static integer i1, i2;
+ static doublereal rwork[1];
+ static doublecomplex t1;
+ static doublereal t2;
+ static doublecomplex v2;
+ static doublereal h10;
+ static doublecomplex h11;
+ static doublereal h21;
+ static doublecomplex h22;
+ static integer nh;
+ static integer nz;
+ static doublereal smlnum;
+ static doublecomplex h11s;
+ static integer itn, its;
+ static doublereal ulp;
+ static doublecomplex sum;
+ static doublereal tst1;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLAHQR is an auxiliary routine called by ZHSEQR to update the */
+/* eigenvalues and Schur decomposition already computed by ZHSEQR, by */
+/* dealing with the Hessenberg submatrix in rows and columns ILO to IHI. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* WANTT (input) LOGICAL */
+/* = .TRUE. : the full Schur form T is required; */
+/* = .FALSE.: only eigenvalues are required. */
+/* */
+/* WANTZ (input) LOGICAL */
+/* = .TRUE. : the matrix of Schur vectors Z is required; */
+/* = .FALSE.: Schur vectors are not required. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix H. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that H is already upper triangular in rows and */
+/* columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless ILO = 1). */
+/* ZLAHQR works primarily with the Hessenberg submatrix in rows */
+/* and columns ILO to IHI, but applies transformations to all of */
+/* H if WANTT is .TRUE.. */
+/* 1 <= ILO <= max(1,IHI); IHI <= N. */
+/* */
+/* H (input/output) COMPLEX*16 array, dimension (LDH,N) */
+/* On entry, the upper Hessenberg matrix H. */
+/* On exit, if WANTT is .TRUE., H is upper triangular in rows */
+/* and columns ILO:IHI, with any 2-by-2 diagonal blocks in */
+/* standard form. If WANTT is .FALSE., the contents of H are */
+/* unspecified on exit. */
+/* */
+/* LDH (input) INTEGER */
+/* The leading dimension of the array H. LDH >= max(1,N). */
+/* */
+/* W (output) COMPLEX*16 array, dimension (N) */
+/* The computed eigenvalues ILO to IHI are stored in the */
+/* corresponding elements of W. If WANTT is .TRUE., the */
+/* eigenvalues are stored in the same order as on the diagonal */
+/* of the Schur form returned in H, with W(i) = H(i,i). */
+/* */
+/* ILOZ (input) INTEGER */
+/* IHIZ (input) INTEGER */
+/* Specify the rows of Z to which transformations must be */
+/* applied if WANTZ is .TRUE.. */
+/* 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. */
+/* */
+/* Z (input/output) COMPLEX*16 array, dimension (LDZ,N) */
+/* If WANTZ is .TRUE., on entry Z must contain the current */
+/* matrix Z of transformations accumulated by ZHSEQR, and on */
+/* exit Z has been updated; transformations are applied only to */
+/* the submatrix Z(ILOZ:IHIZ,ILO:IHI). */
+/* If WANTZ is .FALSE., Z is not referenced. */
+/* */
+/* LDZ (input) INTEGER */
+/* The leading dimension of the array Z. LDZ >= max(1,N). */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* > 0: if INFO = i, ZLAHQR failed to compute all the */
+/* eigenvalues ILO to IHI in a total of 30*(IHI-ILO+1) */
+/* iterations; elements i+1:ihi of W contain those */
+/* eigenvalues which have been successfully computed. */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+ if (*ilo == *ihi) {
+ i__1 = *ilo-1 + (*ilo-1) * *ldh;
+ w[*ilo-1].r = h[i__1].r, w[*ilo-1].i = h[i__1].i;
+ return;
+ }
+
+ nh = *ihi - *ilo + 1;
+ nz = *ihiz - *iloz + 1;
+
+/* Set machine-dependent constants for the stopping criterion. */
+/* If norm(H) <= sqrt(OVFL), overflow should not occur. */
+
+ unfl = dlamch_("Safe minimum");
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = dlamch_("Precision");
+ smlnum = unfl * (nh / ulp);
+
+/* I1 and I2 are the indices of the first row and last column of H */
+/* to which transformations must be applied. If eigenvalues only are */
+/* being computed, I1 and I2 are set inside the main loop. */
+
+ if (*wantt) {
+ i1 = 0;
+ i2 = *n-1;
+ }
+
+/* ITN is the total number of QR iterations allowed. */
+
+ itn = nh * 30;
+
+/* The main loop begins here. I is the loop index and decreases from */
+/* IHI to ILO in steps of 1. Each iteration of the loop works */
+/* with the active submatrix in rows and columns L to I. */
+/* Eigenvalues I+1 to IHI have already converged. Either L = ILO, or */
+/* H(L,L-1) is negligible so that the matrix splits. */
+
+ i = *ihi-1;
+L10:
+ if (i < *ilo-1) {
+ return; /* exit from zlahqr_ */
+ }
+
+/* Perform QR iterations on rows and columns ILO to I until a */
+/* submatrix of order 1 splits off at the bottom because a */
+/* subdiagonal element has become negligible. */
+
+ l = *ilo-1;
+ for (its = 0; /*fsm*/ 1 /*its <= itn*/; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ for (k = i; k > l; --k) {
+ i__1 = k - 1 + (k - 1) * *ldh;
+ i__2 = k + k * *ldh;
+ tst1 = abs(h[i__1].r) + abs(h[i__1].i) + abs(h[i__2].r) + abs(h[i__2].i);
+ if (tst1 == 0.) {
+ i__1 = i - l + 1;
+ tst1 = zlanhs_("1", &i__1, &h[l + l * *ldh], ldh, rwork);
+ }
+ if (abs(h[k + (k - 1) * *ldh].r) <= max(ulp * tst1,smlnum)) {
+ break;
+ }
+ }
+ l = k;
+ if (l > *ilo-1) {
+
+/* H(L,L-1) is negligible */
+
+ i__1 = l + (l - 1) * *ldh;
+ h[i__1].r = h[i__1].i = 0.;
+ }
+
+/* Exit from loop if a submatrix of order 1 has split off. */
+
+ if (l >= i) {
+/* H(I,I-1) is negligible: one eigenvalue has converged. */
+
+ i__1 = i + i * *ldh;
+ w[i].r = h[i__1].r, w[i].i = h[i__1].i;
+
+/* Decrement number of remaining iterations, and return to start of */
+/* the main loop with new value of I. */
+
+ itn -= its;
+ i = l - 1;
+ goto L10;
+ }
+
+/* Now the active submatrix is in rows and columns L to I. If */
+/* eigenvalues only are being computed, only the active submatrix */
+/* need be transformed. */
+
+ if (! (*wantt)) {
+ i1 = l;
+ i2 = i;
+ }
+
+ if (its == 10 || its == 20) {
+
+/* Exceptional shift. */
+
+ t.r = abs(h[i + (i - 1) * *ldh].r)
+ + abs(h[i - 1 + (i - 2) * *ldh].r);
+ t.i = 0.;
+ } else {
+
+/* Wilkinson's shift. */
+
+ i__1 = i + i * *ldh;
+ t.r = h[i__1].r, t.i = h[i__1].i;
+ d__1 = h[i + (i - 1) * *ldh].r;
+ u.r = d__1 * h[i__1].r, u.i = d__1 * h[i__1].i;
+ if (u.r != 0. || u.i != 0.) {
+ i__1 = i - 1 + (i - 1) * *ldh;
+ x.r = .5 * (h[i__1].r - t.r),
+ x.i = .5 * (h[i__1].i - t.i);
+ z__2.r = u.r + x.r * x.r - x.i * x.i,
+ z__2.i = u.i + x.r * x.i + x.i * x.r;
+ z_sqrt(&z__1, &z__2);
+ y.r = z__1.r, y.i = z__1.i;
+ if (x.r * y.r + x.i * y.i < 0.) {
+ y.r = -y.r, y.i = -y.i;
+ }
+ z__2.r = x.r + y.r, z__2.i = x.i + y.i;
+ zladiv_(&z__1, &u, &z__2);
+ t.r -= z__1.r, t.i -= z__1.i;
+ }
+ }
+
+/* Look for two consecutive small subdiagonal elements. */
+
+ for (m = i - 1; m >= l; --m) {
+
+/* Determine the effect of starting the single-shift QR */
+/* iteration at row M, and see if this would make H(M,M-1) */
+/* negligible. */
+
+ i__1 = m + m * *ldh;
+ h11.r = h[i__1].r, h11.i = h[i__1].i;
+ i__1 = m + 1 + (m + 1) * *ldh;
+ h22.r = h[i__1].r, h22.i = h[i__1].i;
+ h11s.r = h11.r - t.r, h11s.i = h11.i - t.i;
+ h21 = h[m + 1 + m * *ldh].r;
+ s = abs(h11s.r) + abs(h11s.i) + abs(h21);
+ h11s.r /= s, h11s.i /= s;
+ h21 /= s;
+ v[0].r = h11s.r, v[0].i = h11s.i;
+ v[1].r = h21, v[1].i = 0.;
+ if (m == l) {
+ break;
+ }
+ h10 = h[m + (m - 1) * *ldh].r;
+ tst1 = (abs(h11s.r) + abs(h11s.i)) * (abs(h11.r) + abs(h11.i) + abs(h22.r) + abs(h22.i));
+ if (abs(h10 * h21) <= ulp * tst1) {
+ break;
+ }
+ }
+
+/* Single-shift QR step */
+
+ for (k = m; k < i; ++k) {
+
+/* The first iteration of this loop determines a reflection G */
+/* from the vector V and applies it from left and right to H, */
+/* thus creating a nonzero bulge below the subdiagonal. */
+
+/* Each subsequent iteration determines a reflection G to */
+/* restore the Hessenberg form in the (K-1)th column, and thus */
+/* chases the bulge one step toward the bottom of the active */
+/* submatrix. */
+
+/* V(2) is always real before the call to ZLARFG, and hence */
+/* after the call T2 ( = T1*V(2) ) is also real. */
+
+ if (k > m) {
+ zcopy_(&c__2, &h[k + (k - 1) * *ldh], &c__1, v, &c__1);
+ }
+ zlarfg_(&c__2, v, &v[1], &c__1, &t1);
+ if (k > m) {
+ i__1 = k + (k - 1) * *ldh;
+ h[i__1].r = v[0].r, h[i__1].i = v[0].i;
+ i__1 = k + 1 + (k - 1) * *ldh;
+ h[i__1].r = 0., h[i__1].i = 0.;
+ }
+ v2.r = v[1].r, v2.i = v[1].i;
+ t2 = t1.r * v2.r - t1.i * v2.i;
+
+/* Apply G from the left to transform the rows of the matrix */
+/* in columns K to I2. */
+
+ for (j = k; j <= i2; ++j) {
+ d_cnjg(&z__1, &t1);
+ i__1 = k + j * *ldh;
+ i__2 = k + 1 + j * *ldh;
+ sum.r = t2 * h[i__2].r + z__1.r * h[i__1].r - z__1.i * h[i__1].i,
+ sum.i = t2 * h[i__2].i + z__1.r * h[i__1].i + z__1.i * h[i__1].r;
+ h[i__1].r -= sum.r,
+ h[i__1].i -= sum.i;
+ h[i__2].r -= sum.r * v2.r - sum.i * v2.i,
+ h[i__2].i -= sum.r * v2.i + sum.i * v2.r;
+ }
+
+/* Apply G from the right to transform the columns of the */
+/* matrix in rows I1 to min(K+2,I). */
+
+ for (j = i1; j <= k+2 && j <= i; ++j) {
+ i__1 = j + k * *ldh;
+ i__2 = j + (k + 1) * *ldh;
+ sum.r = t2 * h[i__2].r + t1.r * h[i__1].r - t1.i * h[i__1].i,
+ sum.i = t2 * h[i__2].i + t1.r * h[i__1].i + t1.i * h[i__1].r;
+ h[i__1].r -= sum.r,
+ h[i__1].i -= sum.i;
+ h[i__2].r -= sum.r * v2.r + sum.i * v2.i,
+ h[i__2].i -= - sum.r * v2.i + sum.i * v2.r;
+ }
+
+
+/* Accumulate transformations in the matrix Z */
+
+ if (*wantz)
+ for (j = *iloz-1; j < *ihiz; ++j) {
+ i__1 = j + k * *ldz;
+ i__2 = j + (k + 1) * *ldz;
+ sum.r = t2 * z[i__2].r + t1.r * z[i__1].r - t1.i * z[i__1].i,
+ sum.i = t2 * z[i__2].i + t1.r * z[i__1].i + t1.i * z[i__1].r;
+ z[i__1].r -= sum.r,
+ z[i__1].i -= sum.i;
+ z[i__2].r -= sum.r * v2.r + sum.i * v2.i,
+ z[i__2].i -= - sum.r * v2.i + sum.i * v2.r;
+ }
+
+ if (k == m && m > l) {
+
+/* If the QR step was started at row M > L because two */
+/* consecutive small subdiagonals were found, the n extra */
+/* scaling must be performed to ensure that H(M,M-1) remains */
+/* real. */
+
+ temp.r = 1. - t1.r, temp.i = 0. - t1.i;
+ d__1 = dlapy2_(&(temp.r), &(temp.i));
+ temp.r /= d__1, temp.i /= d__1;
+ i__1 = m + 1 + m * *ldh;
+ d_cnjg(&z__2, &temp);
+ z__1.r = h[i__1].r * z__2.r - h[i__1].i * z__2.i,
+ z__1.i = h[i__1].r * z__2.i + h[i__1].i * z__2.r;
+ h[i__1].r = z__1.r, h[i__1].i = z__1.i;
+ if (m + 2 <= i) {
+ i__1 = m + 2 + (m + 1) * *ldh;
+ z__1.r = h[i__1].r * temp.r - h[i__1].i * temp.i,
+ z__1.i = h[i__1].r * temp.i + h[i__1].i * temp.r;
+ h[i__1].r = z__1.r, h[i__1].i = z__1.i;
+ }
+ for (j = m; j <= i; ++j) {
+ if (j != m + 1) {
+ if (i2 > j) {
+ i__1 = i2 - j;
+ zscal_(&i__1, &temp, &h[j + (j + 1) * *ldh], ldh);
+ }
+ i__1 = j - i1;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__1, &z__1, &h[i1 + j * *ldh], &c__1);
+ if (*wantz) {
+ d_cnjg(&z__1, &temp);
+ zscal_(&nz, &z__1, &z[*iloz-1 + j * *ldz], &c__1);
+ }
+ }
+ }
+ }
+ }
+
+/* Ensure that H(I,I-1) is real. */
+
+ i__1 = i + (i - 1) * *ldh;
+ temp.r = h[i__1].r, temp.i = h[i__1].i;
+ if (temp.i != 0.) {
+ d__1 = temp.r;
+ d__2 = temp.i;
+ rtemp = dlapy2_(&d__1, &d__2);
+ i__1 = i + (i - 1) * *ldh;
+ h[i__1].r = rtemp, h[i__1].i = 0.;
+ temp.r /= rtemp, temp.i /= rtemp;
+ if (i2 > i) {
+ i__1 = i2 - i;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__1, &z__1, &h[i + (i + 1) * *ldh], ldh);
+ }
+ i__1 = i - i1;
+ zscal_(&i__1, &temp, &h[i1 + i * *ldh], &c__1);
+ if (*wantz) {
+ zscal_(&nz, &temp, &z[*iloz-1 + i * *ldz], &c__1);
+ }
+ }
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i+1;
+
+} /* zlahqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..ca3eada7b5ef6d0deb40b4d06c4627e42495f70c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahqr.f
@@ -0,0 +1,380 @@
+ SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ,
+ $ IHIZ, Z, LDZ, INFO )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ LOGICAL WANTT, WANTZ
+ INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 H( LDH, * ), W( * ), Z( LDZ, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLAHQR is an auxiliary routine called by ZHSEQR to update the
+* eigenvalues and Schur decomposition already computed by ZHSEQR, by
+* dealing with the Hessenberg submatrix in rows and columns ILO to IHI.
+*
+* Arguments
+* =========
+*
+* WANTT (input) LOGICAL
+* = .TRUE. : the full Schur form T is required;
+* = .FALSE.: only eigenvalues are required.
+*
+* WANTZ (input) LOGICAL
+* = .TRUE. : the matrix of Schur vectors Z is required;
+* = .FALSE.: Schur vectors are not required.
+*
+* N (input) INTEGER
+* The order of the matrix H. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* It is assumed that H is already upper triangular in rows and
+* columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless ILO = 1).
+* ZLAHQR works primarily with the Hessenberg submatrix in rows
+* and columns ILO to IHI, but applies transformations to all of
+* H if WANTT is .TRUE..
+* 1 <= ILO <= max(1,IHI); IHI <= N.
+*
+* H (input/output) COMPLEX*16 array, dimension (LDH,N)
+* On entry, the upper Hessenberg matrix H.
+* On exit, if WANTT is .TRUE., H is upper triangular in rows
+* and columns ILO:IHI, with any 2-by-2 diagonal blocks in
+* standard form. If WANTT is .FALSE., the contents of H are
+* unspecified on exit.
+*
+* LDH (input) INTEGER
+* The leading dimension of the array H. LDH >= max(1,N).
+*
+* W (output) COMPLEX*16 array, dimension (N)
+* The computed eigenvalues ILO to IHI are stored in the
+* corresponding elements of W. If WANTT is .TRUE., the
+* eigenvalues are stored in the same order as on the diagonal
+* of the Schur form returned in H, with W(i) = H(i,i).
+*
+* ILOZ (input) INTEGER
+* IHIZ (input) INTEGER
+* Specify the rows of Z to which transformations must be
+* applied if WANTZ is .TRUE..
+* 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+*
+* Z (input/output) COMPLEX*16 array, dimension (LDZ,N)
+* If WANTZ is .TRUE., on entry Z must contain the current
+* matrix Z of transformations accumulated by ZHSEQR, and on
+* exit Z has been updated; transformations are applied only to
+* the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+* If WANTZ is .FALSE., Z is not referenced.
+*
+* LDZ (input) INTEGER
+* The leading dimension of the array Z. LDZ >= max(1,N).
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* > 0: if INFO = i, ZLAHQR failed to compute all the
+* eigenvalues ILO to IHI in a total of 30*(IHI-ILO+1)
+* iterations; elements i+1:ihi of W contain those
+* eigenvalues which have been successfully computed.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+ DOUBLE PRECISION RZERO, RONE, HALF
+ PARAMETER ( RZERO = 0.0D+0, RONE = 1.0D+0,
+ $ HALF = 0.5D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, I1, I2, ITN, ITS, J, K, L, M, NH, NZ
+ DOUBLE PRECISION H10, H21, OVFL, RTEMP, S, SMLNUM, T2, TST1,
+ $ ULP, UNFL
+ COMPLEX*16 CDUM, H11, H11S, H22, SUM, T, T1, TEMP, U, V2,
+ $ X, Y
+* ..
+* .. Local Arrays ..
+ DOUBLE PRECISION RWORK( 1 )
+ COMPLEX*16 V( 2 )
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY2, ZLANHS
+ COMPLEX*16 ZLADIV
+ EXTERNAL DLAMCH, DLAPY2, ZLANHS, ZLADIV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLABAD, ZCOPY, ZLARFG, ZSCAL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1
+* ..
+* .. Statement Function definitions ..
+ CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+ IF( ILO.EQ.IHI ) THEN
+ W( ILO ) = H( ILO, ILO )
+ RETURN
+ END IF
+*
+ NH = IHI - ILO + 1
+ NZ = IHIZ - ILOZ + 1
+*
+* Set machine-dependent constants for the stopping criterion.
+* If norm(H) <= sqrt(OVFL), overflow should not occur.
+*
+ UNFL = DLAMCH( 'Safe minimum' )
+ OVFL = RONE / UNFL
+ CALL DLABAD( UNFL, OVFL )
+ ULP = DLAMCH( 'Precision' )
+ SMLNUM = UNFL*( NH / ULP )
+*
+* I1 and I2 are the indices of the first row and last column of H
+* to which transformations must be applied. If eigenvalues only are
+* being computed, I1 and I2 are set inside the main loop.
+*
+ IF( WANTT ) THEN
+ I1 = 1
+ I2 = N
+ END IF
+*
+* ITN is the total number of QR iterations allowed.
+*
+ ITN = 30*NH
+*
+* The main loop begins here. I is the loop index and decreases from
+* IHI to ILO in steps of 1. Each iteration of the loop works
+* with the active submatrix in rows and columns L to I.
+* Eigenvalues I+1 to IHI have already converged. Either L = ILO, or
+* H(L,L-1) is negligible so that the matrix splits.
+*
+ I = IHI
+ 10 CONTINUE
+ IF( I.LT.ILO )
+ $ GO TO 130
+*
+* Perform QR iterations on rows and columns ILO to I until a
+* submatrix of order 1 splits off at the bottom because a
+* subdiagonal element has become negligible.
+*
+ L = ILO
+ DO 110 ITS = 0, ITN
+*
+* Look for a single small subdiagonal element.
+*
+ DO 20 K = I, L + 1, -1
+ TST1 = CABS1( H( K-1, K-1 ) ) + CABS1( H( K, K ) )
+ IF( TST1.EQ.RZERO )
+ $ TST1 = ZLANHS( '1', I-L+1, H( L, L ), LDH, RWORK )
+ IF( ABS( DBLE( H( K, K-1 ) ) ).LE.MAX( ULP*TST1, SMLNUM ) )
+ $ GO TO 30
+ 20 CONTINUE
+ 30 CONTINUE
+ L = K
+ IF( L.GT.ILO ) THEN
+*
+* H(L,L-1) is negligible
+*
+ H( L, L-1 ) = ZERO
+ END IF
+*
+* Exit from loop if a submatrix of order 1 has split off.
+*
+ IF( L.GE.I )
+ $ GO TO 120
+*
+* Now the active submatrix is in rows and columns L to I. If
+* eigenvalues only are being computed, only the active submatrix
+* need be transformed.
+*
+ IF( .NOT.WANTT ) THEN
+ I1 = L
+ I2 = I
+ END IF
+*
+ IF( ITS.EQ.10 .OR. ITS.EQ.20 ) THEN
+*
+* Exceptional shift.
+*
+ T = ABS( DBLE( H( I, I-1 ) ) ) +
+ $ ABS( DBLE( H( I-1, I-2 ) ) )
+ ELSE
+*
+* Wilkinson's shift.
+*
+ T = H( I, I )
+ U = H( I-1, I )*DBLE( H( I, I-1 ) )
+ IF( U.NE.ZERO ) THEN
+ X = HALF*( H( I-1, I-1 )-T )
+ Y = SQRT( X*X+U )
+ IF( DBLE( X )*DBLE( Y )+DIMAG( X )*DIMAG( Y ).LT.RZERO )
+ $ Y = -Y
+ T = T - ZLADIV( U, ( X+Y ) )
+ END IF
+ END IF
+*
+* Look for two consecutive small subdiagonal elements.
+*
+ DO 40 M = I - 1, L, -1
+*
+* Determine the effect of starting the single-shift QR
+* iteration at row M, and see if this would make H(M,M-1)
+* negligible.
+*
+ H11 = H( M, M )
+ H22 = H( M+1, M+1 )
+ H11S = H11 - T
+ H21 = H( M+1, M )
+ S = CABS1( H11S ) + ABS( H21 )
+ H11S = H11S / S
+ H21 = H21 / S
+ V( 1 ) = H11S
+ V( 2 ) = H21
+ IF( M.EQ.L )
+ $ GO TO 50
+ H10 = H( M, M-1 )
+ TST1 = CABS1( H11S )*( CABS1( H11 )+CABS1( H22 ) )
+ IF( ABS( H10*H21 ).LE.ULP*TST1 )
+ $ GO TO 50
+ 40 CONTINUE
+ 50 CONTINUE
+*
+* Single-shift QR step
+*
+ DO 100 K = M, I - 1
+*
+* The first iteration of this loop determines a reflection G
+* from the vector V and applies it from left and right to H,
+* thus creating a nonzero bulge below the subdiagonal.
+*
+* Each subsequent iteration determines a reflection G to
+* restore the Hessenberg form in the (K-1)th column, and thus
+* chases the bulge one step toward the bottom of the active
+* submatrix.
+*
+* V(2) is always real before the call to ZLARFG, and hence
+* after the call T2 ( = T1*V(2) ) is also real.
+*
+ IF( K.GT.M )
+ $ CALL ZCOPY( 2, H( K, K-1 ), 1, V, 1 )
+ CALL ZLARFG( 2, V( 1 ), V( 2 ), 1, T1 )
+ IF( K.GT.M ) THEN
+ H( K, K-1 ) = V( 1 )
+ H( K+1, K-1 ) = ZERO
+ END IF
+ V2 = V( 2 )
+ T2 = DBLE( T1*V2 )
+*
+* Apply G from the left to transform the rows of the matrix
+* in columns K to I2.
+*
+ DO 60 J = K, I2
+ SUM = DCONJG( T1 )*H( K, J ) + T2*H( K+1, J )
+ H( K, J ) = H( K, J ) - SUM
+ H( K+1, J ) = H( K+1, J ) - SUM*V2
+ 60 CONTINUE
+*
+* Apply G from the right to transform the columns of the
+* matrix in rows I1 to min(K+2,I).
+*
+ DO 70 J = I1, MIN( K+2, I )
+ SUM = T1*H( J, K ) + T2*H( J, K+1 )
+ H( J, K ) = H( J, K ) - SUM
+ H( J, K+1 ) = H( J, K+1 ) - SUM*DCONJG( V2 )
+ 70 CONTINUE
+*
+ IF( WANTZ ) THEN
+*
+* Accumulate transformations in the matrix Z
+*
+ DO 80 J = ILOZ, IHIZ
+ SUM = T1*Z( J, K ) + T2*Z( J, K+1 )
+ Z( J, K ) = Z( J, K ) - SUM
+ Z( J, K+1 ) = Z( J, K+1 ) - SUM*DCONJG( V2 )
+ 80 CONTINUE
+ END IF
+*
+ IF( K.EQ.M .AND. M.GT.L ) THEN
+*
+* If the QR step was started at row M > L because two
+* consecutive small subdiagonals were found, then extra
+* scaling must be performed to ensure that H(M,M-1) remains
+* real.
+*
+ TEMP = ONE - T1
+ TEMP = TEMP / DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+ H( M+1, M ) = H( M+1, M )*DCONJG( TEMP )
+ IF( M+2.LE.I )
+ $ H( M+2, M+1 ) = H( M+2, M+1 )*TEMP
+ DO 90 J = M, I
+ IF( J.NE.M+1 ) THEN
+ IF( I2.GT.J )
+ $ CALL ZSCAL( I2-J, TEMP, H( J, J+1 ), LDH )
+ CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), 1 )
+ IF( WANTZ ) THEN
+ CALL ZSCAL( NZ, DCONJG( TEMP ), Z( ILOZ, J ),
+ $ 1 )
+ END IF
+ END IF
+ 90 CONTINUE
+ END IF
+ 100 CONTINUE
+*
+* Ensure that H(I,I-1) is real.
+*
+ TEMP = H( I, I-1 )
+ IF( DIMAG( TEMP ).NE.RZERO ) THEN
+ RTEMP = DLAPY2( DBLE( TEMP ), DIMAG( TEMP ) )
+ H( I, I-1 ) = RTEMP
+ TEMP = TEMP / RTEMP
+ IF( I2.GT.I )
+ $ CALL ZSCAL( I2-I, DCONJG( TEMP ), H( I, I+1 ), LDH )
+ CALL ZSCAL( I-I1, TEMP, H( I1, I ), 1 )
+ IF( WANTZ ) THEN
+ CALL ZSCAL( NZ, TEMP, Z( ILOZ, I ), 1 )
+ END IF
+ END IF
+*
+ 110 CONTINUE
+*
+* Failure to converge in remaining number of iterations
+*
+ INFO = I
+ RETURN
+*
+ 120 CONTINUE
+*
+* H(I,I-1) is negligible: one eigenvalue has converged.
+*
+ W( I ) = H( I, I )
+*
+* Decrement number of remaining iterations, and return to start of
+* the main loop with new value of I.
+*
+ ITN = ITN - ITS
+ I = L - 1
+ GO TO 10
+*
+ 130 CONTINUE
+ RETURN
+*
+* End of ZLAHQR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.c
new file mode 100644
index 0000000000000000000000000000000000000000..85ac8c3b039dffdd706142804507cade0933e023
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.c
@@ -0,0 +1,213 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b4 = {-1.,0.};
+static doublecomplex c_b5 = {1.,0.};
+static integer c__1 = 1;
+static doublecomplex c_b39 = {0.,0.};
+
+/* Subroutine */ void zlahrd_(n, k, nb, a, lda, tau, t, ldt, y, ldy)
+const integer *n, *k, *nb;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *tau, *t;
+const integer *ldt;
+doublecomplex *y;
+const integer *ldy;
+{
+ /* System generated locals */
+ integer i__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i;
+ static doublecomplex ei;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLAHRD reduces the first NB columns of a complex general n-by-(n-k+1) */
+/* matrix A so that elements below the k-th subdiagonal are zero. The */
+/* reduction is performed by a unitary similarity transformation */
+/* Q' * A * Q. The routine returns the matrices V and T which determine */
+/* Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T. */
+/* */
+/* This is an auxiliary routine called by ZGEHRD. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. */
+/* */
+/* K (input) INTEGER */
+/* The offset for the reduction. Elements below the k-th */
+/* subdiagonal in the first NB columns are reduced to zero. */
+/* */
+/* NB (input) INTEGER */
+/* The number of columns to be reduced. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N-K+1) */
+/* On entry, the n-by-(n-k+1) general matrix A. */
+/* On exit, the elements on and above the k-th subdiagonal in */
+/* the first NB columns are overwritten with the corresponding */
+/* elements of the reduced matrix; the elements below the k-th */
+/* subdiagonal, with the array TAU, represent the matrix Q as a */
+/* product of elementary reflectors. The other columns of A are */
+/* unchanged. See Further Details. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* TAU (output) COMPLEX*16 array, dimension (NB) */
+/* The scalar factors of the elementary reflectors. See Further */
+/* Details. */
+/* */
+/* T (output) COMPLEX*16 array, dimension (NB,NB) */
+/* The upper triangular matrix T. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= NB. */
+/* */
+/* Y (output) COMPLEX*16 array, dimension (LDY,NB) */
+/* The n-by-nb matrix Y. */
+/* */
+/* LDY (input) INTEGER */
+/* The leading dimension of the array Y. LDY >= max(1,N). */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The matrix Q is represented as a product of nb elementary reflectors */
+/* */
+/* Q = H(1) H(2) . . . H(nb). */
+/* */
+/* Each H(i) has the form */
+/* */
+/* H(i) = I - tau * v * v' */
+/* */
+/* where tau is a complex scalar, and v is a complex vector with */
+/* v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in */
+/* A(i+k+1:n,i), and tau in TAU(i). */
+/* */
+/* The elements of the vectors v together form the (n-k+1)-by-nb matrix */
+/* V which is needed, with T and Y, to apply the transformation to the */
+/* unreduced part of the matrix, using an update of the form: */
+/* A := (I - V*T*V') * (A - Y*V'). */
+/* */
+/* The contents of A on exit are illustrated by the following example */
+/* with n = 7, k = 3 and nb = 2: */
+/* */
+/* ( a h a a a ) */
+/* ( a h a a a ) */
+/* ( a h a a a ) */
+/* ( h h a a a ) */
+/* ( v1 h a a a ) */
+/* ( v1 v2 a a a ) */
+/* ( v1 v2 a a a ) */
+/* */
+/* where a denotes an element of the original matrix A, h denotes a */
+/* modified element of the upper Hessenberg matrix H, and vi denotes an */
+/* element of the vector defining H(i). */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ return;
+ }
+
+ for (i = 0; i < *nb; ++i) {
+ if (i > 0) {
+
+/* Update A(1:n,i) */
+
+/* Compute i-th column of A - Y * V' */
+
+ zlacgv_(&i, &a[*k + i - 1], lda);
+ zgemv_("No transpose", n, &i, &c_b4, y, ldy,
+ &a[*k + i - 1], lda, &c_b5, &a[i * *lda], &c__1);
+ zlacgv_(&i, &a[*k + i - 1], lda);
+
+/* Apply I - V * T' * V' to this column (call it b) from the */
+/* left, using the last column of T as workspace */
+
+/* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows) */
+/* ( V2 ) ( b2 ) */
+
+/* where V1 is unit lower triangular */
+
+/* w := V1' * b1 */
+
+ zcopy_(&i, &a[*k+i* *lda], &c__1, &t[(*nb-1)* *ldt], &c__1);
+ ztrmv_("Lower", "Conjugate transpose", "Unit", &i, &a[*k], lda, &t[(*nb-1) * *ldt], &c__1);
+
+/* w := w + V2'*b2 */
+
+ i__1 = *n - *k - i;
+ zgemv_("Conjugate transpose", &i__1, &i, &c_b5,
+ &a[*k-1+i+*lda], lda, &a[*k+i+i* *lda], &c__1,
+ &c_b5, &t[(*nb-1) * *ldt], &c__1);
+
+/* w := T'*w */
+
+ ztrmv_("Upper", "Conjugate transpose", "Non-unit", &i, t, ldt, &t[(*nb-1) * *ldt], &c__1);
+
+/* b2 := b2 - V2*w */
+
+ i__1 = *n - *k - i;
+ zgemv_("No transpose", &i__1, &i, &c_b4, &a[*k-1+i+ *lda], lda,
+ &t[(*nb-1)* *ldt], &c__1, &c_b5, &a[*k+i+i* *lda], &c__1);
+
+/* b1 := b1 - V1*w */
+
+ ztrmv_("Lower", "No transpose", "Unit", &i, &a[*k], lda, &t[(*nb-1) * *ldt], &c__1);
+ zaxpy_(&i, &c_b4, &t[(*nb-1) * *ldt], &c__1, &a[*k+i* *lda], &c__1);
+
+ i__1 = *k + i - 1 + (i - 1) * *lda;
+ a[i__1].r = ei.r, a[i__1].i = ei.i;
+ }
+
+/* Generate the elementary reflector H(i) to annihilate */
+/* A(k+i+1:n,i) */
+
+ i__1 = *k + i + i * *lda;
+ ei.r = a[i__1].r, ei.i = a[i__1].i;
+ i__1 = *n - *k - i;
+ zlarfg_(&i__1, &ei, &a[min(*k+i+1, *n-1)+i* *lda], &c__1, &tau[i]);
+ i__1 = *k + i + i * *lda;
+ a[i__1].r = 1., a[i__1].i = 0.;
+
+/* Compute Y(1:n,i) */
+
+ i__1 = *n - *k - i;
+ zgemv_("No transpose", n, &i__1, &c_b5, &a[(i+1) * *lda], lda,
+ &a[*k+i+i* *lda], &c__1, &c_b39, &y[i* *ldy], &c__1);
+ zgemv_("Conjugate transpose", &i__1, &i, &c_b5, &a[*k+i],
+ lda, &a[*k+i+i* *lda], &c__1, &c_b39, &t[i* *ldt], &c__1);
+ zgemv_("No transpose", n, &i, &c_b4, y, ldy, &t[i* *ldt],
+ &c__1, &c_b5, &y[i* *ldy], &c__1);
+ zscal_(n, &tau[i], &y[i* *ldy], &c__1);
+
+/* Compute T(1:i,i) */
+
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ zscal_(&i, &z__1, &t[i* *ldt], &c__1);
+ ztrmv_("Upper", "No transpose", "Non-unit", &i, t, ldt, &t[i* *ldt], &c__1);
+ i__1 = i + i * *ldt;
+ t[i__1].r = tau[i].r, t[i__1].i = tau[i].i;
+ }
+ i__1 = *k + (*nb-1) + (*nb-1) * *lda;
+ a[i__1].r = ei.r, a[i__1].i = ei.i;
+} /* zlahrd_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.f
new file mode 100644
index 0000000000000000000000000000000000000000..190134ab05b4a7c08a5022ee565b0eeacf4057e0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlahrd.f
@@ -0,0 +1,212 @@
+ SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER K, LDA, LDT, LDY, N, NB
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), T( LDT, NB ), TAU( NB ),
+ $ Y( LDY, NB )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLAHRD reduces the first NB columns of a complex general n-by-(n-k+1)
+* matrix A so that elements below the k-th subdiagonal are zero. The
+* reduction is performed by a unitary similarity transformation
+* Q' * A * Q. The routine returns the matrices V and T which determine
+* Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+*
+* This is an auxiliary routine called by ZGEHRD.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix A.
+*
+* K (input) INTEGER
+* The offset for the reduction. Elements below the k-th
+* subdiagonal in the first NB columns are reduced to zero.
+*
+* NB (input) INTEGER
+* The number of columns to be reduced.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N-K+1)
+* On entry, the n-by-(n-k+1) general matrix A.
+* On exit, the elements on and above the k-th subdiagonal in
+* the first NB columns are overwritten with the corresponding
+* elements of the reduced matrix; the elements below the k-th
+* subdiagonal, with the array TAU, represent the matrix Q as a
+* product of elementary reflectors. The other columns of A are
+* unchanged. See Further Details.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* TAU (output) COMPLEX*16 array, dimension (NB)
+* The scalar factors of the elementary reflectors. See Further
+* Details.
+*
+* T (output) COMPLEX*16 array, dimension (NB,NB)
+* The upper triangular matrix T.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= NB.
+*
+* Y (output) COMPLEX*16 array, dimension (LDY,NB)
+* The n-by-nb matrix Y.
+*
+* LDY (input) INTEGER
+* The leading dimension of the array Y. LDY >= max(1,N).
+*
+* Further Details
+* ===============
+*
+* The matrix Q is represented as a product of nb elementary reflectors
+*
+* Q = H(1) H(2) . . . H(nb).
+*
+* Each H(i) has the form
+*
+* H(i) = I - tau * v * v'
+*
+* where tau is a complex scalar, and v is a complex vector with
+* v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+* A(i+k+1:n,i), and tau in TAU(i).
+*
+* The elements of the vectors v together form the (n-k+1)-by-nb matrix
+* V which is needed, with T and Y, to apply the transformation to the
+* unreduced part of the matrix, using an update of the form:
+* A := (I - V*T*V') * (A - Y*V').
+*
+* The contents of A on exit are illustrated by the following example
+* with n = 7, k = 3 and nb = 2:
+*
+* ( a h a a a )
+* ( a h a a a )
+* ( a h a a a )
+* ( h h a a a )
+* ( v1 h a a a )
+* ( v1 v2 a a a )
+* ( v1 v2 a a a )
+*
+* where a denotes an element of the original matrix A, h denotes a
+* modified element of the upper Hessenberg matrix H, and vi denotes an
+* element of the vector defining H(i).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I
+ COMPLEX*16 EI
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZLACGV, ZLARFG, ZSCAL,
+ $ ZTRMV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.LE.1 )
+ $ RETURN
+*
+ DO 10 I = 1, NB
+ IF( I.GT.1 ) THEN
+*
+* Update A(1:n,i)
+*
+* Compute i-th column of A - Y * V'
+*
+ CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
+ CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
+ $ A( K+I-1, 1 ), LDA, ONE, A( 1, I ), 1 )
+ CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA )
+*
+* Apply I - V * T' * V' to this column (call it b) from the
+* left, using the last column of T as workspace
+*
+* Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
+* ( V2 ) ( b2 )
+*
+* where V1 is unit lower triangular
+*
+* w := V1' * b1
+*
+ CALL ZCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
+ CALL ZTRMV( 'Lower', 'Conjugate transpose', 'Unit', I-1,
+ $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
+*
+* w := w + V2'*b2
+*
+ CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
+ $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ONE,
+ $ T( 1, NB ), 1 )
+*
+* w := T'*w
+*
+ CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1,
+ $ T, LDT, T( 1, NB ), 1 )
+*
+* b2 := b2 - V2*w
+*
+ CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
+ $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
+*
+* b1 := b1 - V1*w
+*
+ CALL ZTRMV( 'Lower', 'No transpose', 'Unit', I-1,
+ $ A( K+1, 1 ), LDA, T( 1, NB ), 1 )
+ CALL ZAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 )
+*
+ A( K+I-1, I-1 ) = EI
+ END IF
+*
+* Generate the elementary reflector H(i) to annihilate
+* A(k+i+1:n,i)
+*
+ EI = A( K+I, I )
+ CALL ZLARFG( N-K-I+1, EI, A( MIN( K+I+1, N ), I ), 1,
+ $ TAU( I ) )
+ A( K+I, I ) = ONE
+*
+* Compute Y(1:n,i)
+*
+ CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
+ $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
+ CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
+ $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ),
+ $ 1 )
+ CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
+ $ ONE, Y( 1, I ), 1 )
+ CALL ZSCAL( N, TAU( I ), Y( 1, I ), 1 )
+*
+* Compute T(1:i,i)
+*
+ CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
+ CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
+ $ T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+*
+ 10 CONTINUE
+ A( K+NB, NB ) = EI
+*
+ RETURN
+*
+* End of ZLAHRD
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.c
new file mode 100644
index 0000000000000000000000000000000000000000..9922544f63e9826dd2f626d984dca1c778cf15ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.c
@@ -0,0 +1,136 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+doublereal zlange_(norm, m, n, a, lda, work)
+const char *norm;
+const integer *m, *n;
+doublecomplex *a;
+const integer *lda;
+doublereal *work;
+{
+ /* Local variables */
+ static integer i, j;
+ static doublereal scale;
+ static doublereal value;
+ static doublereal sum;
+
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLANGE returns the value of the one norm, or the Frobenius norm, or*/
+/* the infinity norm, or the element of largest absolute value of a*/
+/* complex matrix A. */
+/* */
+/* Description */
+/* =========== */
+/* */
+/* ZLANGE returns the value */
+/* */
+/* ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+/* */
+/* where norm1 denotes the one norm of a matrix (maximum column sum), */
+/* normI denotes the infinity norm of a matrix (maximum row sum) and */
+/* normF denotes the Frobenius norm of a matrix (square root of sum of */
+/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in ZLANGE as described */
+/* above. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. When M = 0, */
+/* ZLANGE is set to zero. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. When N = 0, */
+/* ZLANGE is set to zero. */
+/* */
+/* A (input) COMPLEX*16 array, dimension (LDA,N) */
+/* The m by n matrix A. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(M,1). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK), */
+/* where LWORK >= M when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+/* */
+/* ===================================================================== */
+
+ if (min(*m,*n) == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ value = max(value, z_abs(&a[i + j * *lda]));
+ }
+ }
+ } else if (lsame_(norm, "O") || *norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ for (i = 0; i < *m; ++i) {
+ sum += z_abs(&a[i + j * *lda]);
+ }
+ value = max(value,sum);
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ for (i = 0; i < *m; ++i) {
+ work[i] = 0.;
+ }
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ work[i] += z_abs(&a[i + j * *lda]);
+ }
+ }
+ value = 0.;
+ for (i = 0; i < *m; ++i) {
+ value = max(value, work[i]);
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ for (j = 0; j < *n; ++j) {
+ zlassq_(m, &a[j * *lda], &c__1, &scale, &sum);
+ }
+ value = scale * sqrt(sum);
+ }
+
+ return value;
+} /* zlange_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.f
new file mode 100644
index 0000000000000000000000000000000000000000..b8db12f6184a222618c0422ad3478cbe6204384d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlange.f
@@ -0,0 +1,146 @@
+ DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER LDA, M, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION WORK( * )
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLANGE returns the value of the one norm, or the Frobenius norm, or
+* the infinity norm, or the element of largest absolute value of a
+* complex matrix A.
+*
+* Description
+* ===========
+*
+* ZLANGE returns the value
+*
+* ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+* (
+* ( norm1(A), NORM = '1', 'O' or 'o'
+* (
+* ( normI(A), NORM = 'I' or 'i'
+* (
+* ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+*
+* where norm1 denotes the one norm of a matrix (maximum column sum),
+* normI denotes the infinity norm of a matrix (maximum row sum) and
+* normF denotes the Frobenius norm of a matrix (square root of sum of
+* squares). Note that max(abs(A(i,j))) is not a matrix norm.
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies the value to be returned in ZLANGE as described
+* above.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0. When M = 0,
+* ZLANGE is set to zero.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0. When N = 0,
+* ZLANGE is set to zero.
+*
+* A (input) COMPLEX*16 array, dimension (LDA,N)
+* The m by n matrix A.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(M,1).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+* where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+* referenced.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION SCALE, SUM, VALUE
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLASSQ
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( MIN( M, N ).EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ DO 20 J = 1, N
+ DO 10 I = 1, M
+ VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+* Find norm1(A).
+*
+ VALUE = ZERO
+ DO 40 J = 1, N
+ SUM = ZERO
+ DO 30 I = 1, M
+ SUM = SUM + ABS( A( I, J ) )
+ 30 CONTINUE
+ VALUE = MAX( VALUE, SUM )
+ 40 CONTINUE
+ ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+* Find normI(A).
+*
+ DO 50 I = 1, M
+ WORK( I ) = ZERO
+ 50 CONTINUE
+ DO 70 J = 1, N
+ DO 60 I = 1, M
+ WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+ 60 CONTINUE
+ 70 CONTINUE
+ VALUE = ZERO
+ DO 80 I = 1, M
+ VALUE = MAX( VALUE, WORK( I ) )
+ 80 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ DO 90 J = 1, N
+ CALL ZLASSQ( M, A( 1, J ), 1, SCALE, SUM )
+ 90 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ ZLANGE = VALUE
+ RETURN
+*
+* End of ZLANGE
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.c
new file mode 100644
index 0000000000000000000000000000000000000000..1e1f650e87687bebd40d396256b9849630d67558
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.c
@@ -0,0 +1,136 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+doublereal zlanhs_(norm, n, a, lda, work)
+const char *norm;
+const integer *n;
+doublecomplex *a;
+const integer *lda;
+doublereal *work;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i, j;
+ static doublereal scale;
+ static doublereal value;
+ static doublereal sum;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLANHS returns the value of the one norm, or the Frobenius norm, or */
+/* the infinity norm, or the element of largest absolute value of a */
+/* Hessenberg matrix A. */
+/* */
+/* Description */
+/* =========== */
+/* */
+/* ZLANHS returns the value */
+/* */
+/* ZLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+/* */
+/* where norm1 denotes the one norm of a matrix (maximum column sum), */
+/* normI denotes the infinity norm of a matrix (maximum row sum) and */
+/* normF denotes the Frobenius norm of a matrix (square root of sum of */
+/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in ZLANHS as described */
+/* above. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. When N = 0, ZLANHS is */
+/* set to zero. */
+/* */
+/* A (input) COMPLEX*16 array, dimension (LDA,N) */
+/* The n by n upper Hessenberg matrix A; the part of A below */
+/* the first sub-diagonal is not referenced. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(N,1). */
+/* */
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK), */
+/* where LWORK >= N when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+/* */
+/* ===================================================================== */
+
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *n && i <= j + 1; ++i) {
+ value = max(value, z_abs(&a[i + j * *lda]));
+ }
+ }
+ } else if (lsame_(norm, "O") || *norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ for (j = 0; j < *n; ++j) {
+ sum = 0.;
+ for (i = 0; i < *n && i <= j + 1; ++i) {
+ sum += z_abs(&a[i + j * *lda]);
+ }
+ value = max(value,sum);
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ for (i = 0; i < *n; ++i) {
+ work[i] = 0.;
+ }
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *n && i <= j + 1; ++i) {
+ work[i] += z_abs(&a[i + j * *lda]);
+ }
+ }
+ value = 0.;
+ for (i = 0; i < *n; ++i) {
+ value = max(value, work[i]);
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ for (j = 0; j < *n; ++j) {
+ i__1 = min(*n, j+2);
+ zlassq_(&i__1, &a[j * *lda], &c__1, &scale, &sum);
+ }
+ value = scale * sqrt(sum);
+ }
+
+ return value;
+} /* zlanhs_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.f
new file mode 100644
index 0000000000000000000000000000000000000000..8480238c36887d30200fc1b6b9110a0c8bfaf067
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlanhs.f
@@ -0,0 +1,143 @@
+ DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER NORM
+ INTEGER LDA, N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION WORK( * )
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLANHS returns the value of the one norm, or the Frobenius norm, or
+* the infinity norm, or the element of largest absolute value of a
+* Hessenberg matrix A.
+*
+* Description
+* ===========
+*
+* ZLANHS returns the value
+*
+* ZLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+* (
+* ( norm1(A), NORM = '1', 'O' or 'o'
+* (
+* ( normI(A), NORM = 'I' or 'i'
+* (
+* ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+*
+* where norm1 denotes the one norm of a matrix (maximum column sum),
+* normI denotes the infinity norm of a matrix (maximum row sum) and
+* normF denotes the Frobenius norm of a matrix (square root of sum of
+* squares). Note that max(abs(A(i,j))) is not a matrix norm.
+*
+* Arguments
+* =========
+*
+* NORM (input) CHARACTER*1
+* Specifies the value to be returned in ZLANHS as described
+* above.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0. When N = 0, ZLANHS is
+* set to zero.
+*
+* A (input) COMPLEX*16 array, dimension (LDA,N)
+* The n by n upper Hessenberg matrix A; the part of A below the
+* first sub-diagonal is not referenced.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(N,1).
+*
+* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+* where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+* referenced.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ DOUBLE PRECISION SCALE, SUM, VALUE
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLASSQ
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. Executable Statements ..
+*
+ IF( N.EQ.0 ) THEN
+ VALUE = ZERO
+ ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+* Find max(abs(A(i,j))).
+*
+ VALUE = ZERO
+ DO 20 J = 1, N
+ DO 10 I = 1, MIN( N, J+1 )
+ VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+* Find norm1(A).
+*
+ VALUE = ZERO
+ DO 40 J = 1, N
+ SUM = ZERO
+ DO 30 I = 1, MIN( N, J+1 )
+ SUM = SUM + ABS( A( I, J ) )
+ 30 CONTINUE
+ VALUE = MAX( VALUE, SUM )
+ 40 CONTINUE
+ ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+* Find normI(A).
+*
+ DO 50 I = 1, N
+ WORK( I ) = ZERO
+ 50 CONTINUE
+ DO 70 J = 1, N
+ DO 60 I = 1, MIN( N, J+1 )
+ WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+ 60 CONTINUE
+ 70 CONTINUE
+ VALUE = ZERO
+ DO 80 I = 1, N
+ VALUE = MAX( VALUE, WORK( I ) )
+ 80 CONTINUE
+ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+* Find normF(A).
+*
+ SCALE = ZERO
+ SUM = ONE
+ DO 90 J = 1, N
+ CALL ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
+ 90 CONTINUE
+ VALUE = SCALE*SQRT( SUM )
+ END IF
+*
+ ZLANHS = VALUE
+ RETURN
+*
+* End of ZLANHS
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.c
new file mode 100644
index 0000000000000000000000000000000000000000..aa7854c672105695c16a4666eba017376c8cab35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.c
@@ -0,0 +1,117 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b3 = {0.,0.};
+static doublecomplex c_b5 = {1.,0.};
+static integer c__1 = 1;
+
+/* Subroutine */ void zlarf_(side, m, n, v, incv, tau, c, ldc, work)
+const char *side;
+const integer *m, *n;
+doublecomplex *v;
+const integer *incv;
+const doublecomplex *tau;
+doublecomplex *c;
+const integer *ldc;
+doublecomplex *work;
+{
+ /* System generated locals */
+ doublecomplex z__1;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLARF applies a complex elementary reflector H to a complex M-by-N */
+/* matrix C, from either the left or the right. H is represented in the */
+/* form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a complex scalar and v is a complex vector. */
+/* */
+/* If tau = 0, then H is taken to be the unit matrix. */
+/* */
+/* To apply H' (the conjugate transpose of H), supply conjg(tau) instead */
+/* tau. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': form H * C */
+/* = 'R': form C * H */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* V (input) COMPLEX*16 array, dimension */
+/* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
+/* or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
+/* The vector v in the representation of H. V is not used if */
+/* TAU = 0. */
+/* */
+/* INCV (input) INTEGER */
+/* The increment between elements of v. INCV <> 0. */
+/* */
+/* TAU (input) COMPLEX*16 */
+/* The value tau in the representation of H. */
+/* */
+/* C (input/output) COMPLEX*16 array, dimension (LDC,N) */
+/* On entry, the M-by-N matrix C. */
+/* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
+/* or C * H if SIDE = 'R'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension */
+/* (N) if SIDE = 'L' */
+/* or (M) if SIDE = 'R' */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C */
+
+ if (tau->r != 0. || tau->i != 0.) {
+
+/* w := C' * v */
+
+ zgemv_("Conjugate transpose", m, n, &c_b5, c, ldc, v, incv, &c_b3, work, &c__1);
+
+/* C := C - v * w' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, v, incv, work, &c__1, c, ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (tau->r != 0. || tau->i != 0.) {
+
+/* w := C * v */
+
+ zgemv_("No transpose", m, n, &c_b5, c, ldc, v, incv, &c_b3, work, &c__1);
+
+/* C := C - w * v' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, work, &c__1, v, incv, c, ldc);
+ }
+ }
+} /* zlarf_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.f
new file mode 100644
index 0000000000000000000000000000000000000000..56936845c56f1e540274b4029cbd02343655f2f8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarf.f
@@ -0,0 +1,121 @@
+ SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER INCV, LDC, M, N
+ COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLARF applies a complex elementary reflector H to a complex M-by-N
+* matrix C, from either the left or the right. H is represented in the
+* form
+*
+* H = I - tau * v * v'
+*
+* where tau is a complex scalar and v is a complex vector.
+*
+* If tau = 0, then H is taken to be the unit matrix.
+*
+* To apply H' (the conjugate transpose of H), supply conjg(tau) instead
+* tau.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': form H * C
+* = 'R': form C * H
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* V (input) COMPLEX*16 array, dimension
+* (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+* or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+* The vector v in the representation of H. V is not used if
+* TAU = 0.
+*
+* INCV (input) INTEGER
+* The increment between elements of v. INCV <> 0.
+*
+* TAU (input) COMPLEX*16
+* The value tau in the representation of H.
+*
+* C (input/output) COMPLEX*16 array, dimension (LDC,N)
+* On entry, the M-by-N matrix C.
+* On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+* or C * H if SIDE = 'R'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) COMPLEX*16 array, dimension
+* (N) if SIDE = 'L'
+* or (M) if SIDE = 'R'
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZGERC
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C' * v
+*
+ CALL ZGEMV( 'Conjugate transpose', M, N, ONE, C, LDC, V,
+ $ INCV, ZERO, WORK, 1 )
+*
+* C := C - v * w'
+*
+ CALL ZGERC( M, N, -TAU, V, INCV, WORK, 1, C, LDC )
+ END IF
+ ELSE
+*
+* Form C * H
+*
+ IF( TAU.NE.ZERO ) THEN
+*
+* w := C * v
+*
+ CALL ZGEMV( 'No transpose', M, N, ONE, C, LDC, V, INCV,
+ $ ZERO, WORK, 1 )
+*
+* C := C - w * v'
+*
+ CALL ZGERC( M, N, -TAU, WORK, 1, V, INCV, C, LDC )
+ END IF
+ END IF
+ RETURN
+*
+* End of ZLARF
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.c
new file mode 100644
index 0000000000000000000000000000000000000000..1f1b16e687c4c4f4ab6930f617d219153978ddc9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.c
@@ -0,0 +1,586 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublecomplex c_b15 = {1.,0.};
+static doublecomplex c_b26 = {-1.,0.};
+
+/* Subroutine */ void zlarfb_(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
+const char *side, *trans, *direct, *storev;
+const integer *m, *n, *k;
+doublecomplex *v;
+const integer *ldv;
+doublecomplex *t;
+const integer *ldt;
+doublecomplex *c;
+const integer *ldc;
+doublecomplex *work;
+const integer *ldwork;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, j;
+ static char transt[1];
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLARFB applies a complex block reflector H or its transpose H' to a */
+/* complex M-by-N matrix C, from either the left or the right. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply H or H' from the Left */
+/* = 'R': apply H or H' from the Right */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply H (No transpose) */
+/* = 'C': apply H' (Conjugate transpose) */
+/* */
+/* DIRECT (input) CHARACTER*1 */
+/* Indicates how H is formed from a product of elementary */
+/* reflectors */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+/* */
+/* STOREV (input) CHARACTER*1 */
+/* Indicates how the vectors which define the elementary */
+/* reflectors are stored: */
+/* = 'C': Columnwise */
+/* = 'R': Rowwise */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* K (input) INTEGER */
+/* The order of the matrix T (= the number of elementary */
+/* reflectors whose product defines the block reflector). */
+/* */
+/* V (input) COMPLEX*16 array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,M) if STOREV = 'R' and SIDE = 'L' */
+/* (LDV,N) if STOREV = 'R' and SIDE = 'R' */
+/* The matrix V. See further details. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); */
+/* if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); */
+/* if STOREV = 'R', LDV >= K. */
+/* */
+/* T (input) COMPLEX*16 array, dimension (LDT,K) */
+/* The triangular K-by-K matrix T in the representation of the */
+/* block reflector. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+/* */
+/* C (input/output) COMPLEX*16 array, dimension (LDC,N) */
+/* On entry, the M-by-N matrix C. */
+/* On exit, C is overwritten by H*C or H'*C or C*H or C*H'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (LDWORK,K) */
+/* */
+/* LDWORK (input) INTEGER */
+/* The leading dimension of the array WORK. */
+/* If SIDE = 'L', LDWORK >= max(1,N); */
+/* if SIDE = 'R', LDWORK >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+ if (*m <= 0 || *n <= 0) {
+ return;
+ }
+
+ if (lsame_(trans, "N")) {
+ *transt = 'C';
+ } else {
+ *transt = 'N';
+ }
+
+ if (lsame_(storev, "C")) {
+
+ if (lsame_(direct, "F")) {
+
+/* Let V = ( V1 ) (first K rows) */
+/* ( V2 ) */
+/* where V1 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C1' */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(n, &c[j], ldc, &work[j* *ldwork], &c__1);
+ zlacgv_(n, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b15, v, ldv, work, ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2 */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "No transpose", n, k, &i__1,
+ &c_b15, &c[*k], ldc, &v[*k], ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2 * W' */
+
+ i__1 = *m - *k;
+ zgemm_("No transpose", "Conjugate transpose", &i__1, n, k,
+ &c_b26, &v[*k], ldv, work, ldwork, &c_b15, &c[*k], ldc);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", n, k, &c_b15, v, ldv, work, ldwork);
+
+/* C1 := C1 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = j + i * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i += work[i__2].i;
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C1 */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(m, &c[j* *ldc], &c__1, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b15, v, ldv, work, ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, k, &i__1,
+ &c_b15, &c[*k * *ldc], ldc, &v[*k], ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, &i__1, k,
+ &c_b26, work, ldwork, &v[*k], ldv, &c_b15, &c[*k * *ldc], ldc);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", m, k, &c_b15, v, ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i -= work[i__2].i;
+ }
+ }
+ }
+
+ } else {
+
+/* Let V = ( V1 ) */
+/* ( V2 ) (last K rows) */
+/* where V2 is unit upper triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C2' */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(n, &c[*m - *k + j], ldc, &work[j* *ldwork], &c__1);
+ zlacgv_(n, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b15, &v[*m - *k], ldv, work, ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1 */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "No transpose", n, k, &i__1,
+ &c_b15, c, ldc, v, ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1 * W' */
+
+ i__1 = *m - *k;
+ zgemm_("No transpose", "Conjugate transpose", &i__1, n, k,
+ &c_b26, v, ldv, work, ldwork, &c_b15, c, ldc);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", n, k, &c_b15, &v[*m - *k], ldv, work, ldwork);
+
+/* C2 := C2 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = *m - *k + j + i * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i += work[i__2].i;
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C2 */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(m, &c[(*n - *k + j) * *ldc], &c__1, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b15, &v[*n - *k], ldv, work, ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, k, &i__1, &c_b15,
+ c, ldc, v, ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, &i__1, k,
+ &c_b26, work, ldwork, v, ldv, &c_b15, c, ldc);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", m, k, &c_b15, &v[*n - *k], ldv, work, ldwork);
+
+/* C2 := C2 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + (*n - *k + j) * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i -= work[i__2].i;
+ }
+ }
+ }
+ }
+
+ } else if (lsame_(storev, "R")) {
+
+ if (lsame_(direct, "F")) {
+
+/* Let V = ( V1 V2 ) (V1: first K columns) */
+/* where V1 is unit upper triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C1' */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(n, &c[j], ldc, &work[j* *ldwork], &c__1);
+ zlacgv_(n, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", n, k, &c_b15, v, ldv, work, ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose", n, k,
+ &i__1, &c_b15, &c[*k], ldc, &v[*k * *ldv], ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2' * W' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose", &i__1,
+ n, k, &c_b26, &v[*k * *ldv], ldv, work, ldwork, &c_b15, &c[*k], ldc);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b15, v, ldv, work, ldwork);
+
+/* C1 := C1 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = j + i * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i += work[i__2].i;
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C1 */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(m, &c[j * *ldc], &c__1, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", m, k, &c_b15, v, ldv, work, ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, k, &i__1,
+ &c_b15, &c[*k * *ldc], ldc, &v[*k * *ldv], ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, &i__1, k, &c_b26,
+ work, ldwork, &v[*k * *ldv], ldv, &c_b15, &c[*k * *ldc], ldc);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b15, v, ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i -= work[i__2].i;
+ }
+ }
+ }
+
+ } else {
+
+/* Let V = ( V1 V2 ) (V2: last K columns) */
+/* where V2 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C2' */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(n, &c[*m - *k + j], ldc, &work[j* *ldwork], &c__1);
+ zlacgv_(n, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", n, k, &c_b15, &v[(*m - *k) * *ldv], ldv, work, ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose", n, k,
+ &i__1, &c_b15, c, ldc, v, ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1' * W' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose",
+ &i__1, n, k, &c_b26, v, ldv, work, ldwork, &c_b15, c, ldc);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b15, &v[(*m - *k) * *ldv], ldv, work, ldwork);
+
+/* C2 := C2 - W' */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = *m - *k + j + i * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i += work[i__2].i;
+ }
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C2 */
+
+ for (j = 0; j < *k; ++j) {
+ zcopy_(m, &c[(*n - *k + j) * *ldc], &c__1, &work[j* *ldwork], &c__1);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", m, k, &c_b15, &v[(*n - *k) * *ldv], ldv, work, ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, k, &i__1,
+ &c_b15, c, ldc, v, ldv, &c_b15, work, ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b15, t, ldt, work, ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, &i__1, k,
+ &c_b26, work, ldwork, v, ldv, &c_b15, c, ldc);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b15, &v[(*n - *k) * *ldv], ldv, work, ldwork);
+
+/* C1 := C1 - W */
+
+ for (j = 0; j < *k; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + (*n - *k + j) * *ldc;
+ i__2 = i + j * *ldwork;
+ c[i__1].r -= work[i__2].r, c[i__1].i -= work[i__2].i;
+ }
+ }
+ }
+ }
+ }
+} /* zlarfb_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.f
new file mode 100644
index 0000000000000000000000000000000000000000..a9dbe3b08d93e870a42f7ddb311b08cc1ab54bf4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfb.f
@@ -0,0 +1,609 @@
+ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+ $ T, LDT, C, LDC, WORK, LDWORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, SIDE, STOREV, TRANS
+ INTEGER K, LDC, LDT, LDV, LDWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
+ $ WORK( LDWORK, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLARFB applies a complex block reflector H or its transpose H' to a
+* complex M-by-N matrix C, from either the left or the right.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': apply H or H' from the Left
+* = 'R': apply H or H' from the Right
+*
+* TRANS (input) CHARACTER*1
+* = 'N': apply H (No transpose)
+* = 'C': apply H' (Conjugate transpose)
+*
+* DIRECT (input) CHARACTER*1
+* Indicates how H is formed from a product of elementary
+* reflectors
+* = 'F': H = H(1) H(2) . . . H(k) (Forward)
+* = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*
+* STOREV (input) CHARACTER*1
+* Indicates how the vectors which define the elementary
+* reflectors are stored:
+* = 'C': Columnwise
+* = 'R': Rowwise
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* K (input) INTEGER
+* The order of the matrix T (= the number of elementary
+* reflectors whose product defines the block reflector).
+*
+* V (input) COMPLEX*16 array, dimension
+* (LDV,K) if STOREV = 'C'
+* (LDV,M) if STOREV = 'R' and SIDE = 'L'
+* (LDV,N) if STOREV = 'R' and SIDE = 'R'
+* The matrix V. See further details.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V.
+* If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+* if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+* if STOREV = 'R', LDV >= K.
+*
+* T (input) COMPLEX*16 array, dimension (LDT,K)
+* The triangular K-by-K matrix T in the representation of the
+* block reflector.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= K.
+*
+* C (input/output) COMPLEX*16 array, dimension (LDC,N)
+* On entry, the M-by-N matrix C.
+* On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDC >= max(1,M).
+*
+* WORK (workspace) COMPLEX*16 array, dimension (LDWORK,K)
+*
+* LDWORK (input) INTEGER
+* The leading dimension of the array WORK.
+* If SIDE = 'L', LDWORK >= max(1,N);
+* if SIDE = 'R', LDWORK >= max(1,M).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ CHARACTER TRANST
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZCOPY, ZGEMM, ZLACGV, ZTRMM
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( M.LE.0 .OR. N.LE.0 )
+ $ RETURN
+*
+ IF( LSAME( TRANS, 'N' ) ) THEN
+ TRANST = 'C'
+ ELSE
+ TRANST = 'N'
+ END IF
+*
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 ) (first K rows)
+* ( V2 )
+* where V1 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+*
+* W := C1'
+*
+ DO 10 J = 1, K
+ CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( N, WORK( 1, J ), 1 )
+ 10 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C2'*V2
+*
+ CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
+ $ K, M-K, ONE, C( K+1, 1 ), LDC,
+ $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2 * W'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-K, N, K, -ONE, V( K+1, 1 ), LDV, WORK,
+ $ LDWORK, ONE, C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1'
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', N, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W'
+*
+ DO 30 J = 1, K
+ DO 20 I = 1, N
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C1
+*
+ DO 40 J = 1, K
+ CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 40 CONTINUE
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C2 * V2
+*
+ CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
+ $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+ $ ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V'
+*
+ IF( N.GT.K ) THEN
+*
+* C2 := C2 - W * V2'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+ $ N-K, K, -ONE, WORK, LDWORK, V( K+1, 1 ),
+ $ LDV, ONE, C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1'
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', M, K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 60 J = 1, K
+ DO 50 I = 1, M
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 50 CONTINUE
+ 60 CONTINUE
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 )
+* ( V2 ) (last K rows)
+* where V2 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+*
+* W := C2'
+*
+ DO 70 J = 1, K
+ CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( N, WORK( 1, J ), 1 )
+ 70 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+ $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1'*V1
+*
+ CALL ZGEMM( 'Conjugate transpose', 'No transpose', N,
+ $ K, M-K, ONE, C, LDC, V, LDV, ONE, WORK,
+ $ LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1 * W'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-K, N, K, -ONE, V, LDV, WORK, LDWORK,
+ $ ONE, C, LDC )
+ END IF
+*
+* W := W * V2'
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', N, K, ONE, V( M-K+1, 1 ), LDV, WORK,
+ $ LDWORK )
+*
+* C2 := C2 - W'
+*
+ DO 90 J = 1, K
+ DO 80 I = 1, N
+ C( M-K+J, I ) = C( M-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+*
+* W := C2
+*
+ DO 100 J = 1, K
+ CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 100 CONTINUE
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+ $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K,
+ $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V'
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+ $ N-K, K, -ONE, WORK, LDWORK, V, LDV, ONE,
+ $ C, LDC )
+ END IF
+*
+* W := W * V2'
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', M, K, ONE, V( N-K+1, 1 ), LDV, WORK,
+ $ LDWORK )
+*
+* C2 := C2 - W
+*
+ DO 120 J = 1, K
+ DO 110 I = 1, M
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
+ 110 CONTINUE
+ 120 CONTINUE
+ END IF
+ END IF
+*
+ ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+* Let V = ( V1 V2 ) (V1: first K columns)
+* where V1 is unit upper triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+*
+* W := C1'
+*
+ DO 130 J = 1, K
+ CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( N, WORK( 1, J ), 1 )
+ 130 CONTINUE
+*
+* W := W * V1'
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', N, K, ONE, V, LDV, WORK, LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C2'*V2'
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', N, K, M-K, ONE,
+ $ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
+ $ WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V' * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C2 := C2 - V2' * W'
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', M-K, N, K, -ONE,
+ $ V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
+ $ C( K+1, 1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W'
+*
+ DO 150 J = 1, K
+ DO 140 I = 1, N
+ C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+*
+* W := C1
+*
+ DO 160 J = 1, K
+ CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
+ 160 CONTINUE
+*
+* W := W * V1'
+*
+ CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
+ $ 'Unit', M, K, ONE, V, LDV, WORK, LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C2 * V2'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+ $ K, N-K, ONE, C( 1, K+1 ), LDC,
+ $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( N.GT.K ) THEN
+*
+* C2 := C2 - W * V2
+*
+ CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
+ $ C( 1, K+1 ), LDC )
+ END IF
+*
+* W := W * V1
+*
+ CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
+ $ K, ONE, V, LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 180 J = 1, K
+ DO 170 I = 1, M
+ C( I, J ) = C( I, J ) - WORK( I, J )
+ 170 CONTINUE
+ 180 CONTINUE
+*
+ END IF
+*
+ ELSE
+*
+* Let V = ( V1 V2 ) (V2: last K columns)
+* where V2 is unit lower triangular.
+*
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C or H' * C where C = ( C1 )
+* ( C2 )
+*
+* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+*
+* W := C2'
+*
+ DO 190 J = 1, K
+ CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
+ CALL ZLACGV( N, WORK( 1, J ), 1 )
+ 190 CONTINUE
+*
+* W := W * V2'
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', N, K, ONE, V( 1, M-K+1 ), LDV, WORK,
+ $ LDWORK )
+ IF( M.GT.K ) THEN
+*
+* W := W + C1'*V1'
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', N, K, M-K, ONE, C,
+ $ LDC, V, LDV, ONE, WORK, LDWORK )
+ END IF
+*
+* W := W * T' or W * T
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - V' * W'
+*
+ IF( M.GT.K ) THEN
+*
+* C1 := C1 - V1' * W'
+*
+ CALL ZGEMM( 'Conjugate transpose',
+ $ 'Conjugate transpose', M-K, N, K, -ONE, V,
+ $ LDV, WORK, LDWORK, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
+ $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
+*
+* C2 := C2 - W'
+*
+ DO 210 J = 1, K
+ DO 200 I = 1, N
+ C( M-K+J, I ) = C( M-K+J, I ) -
+ $ DCONJG( WORK( I, J ) )
+ 200 CONTINUE
+ 210 CONTINUE
+*
+ ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+* Form C * H or C * H' where C = ( C1 C2 )
+*
+* W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+*
+* W := C2
+*
+ DO 220 J = 1, K
+ CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+ 220 CONTINUE
+*
+* W := W * V2'
+*
+ CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
+ $ 'Unit', M, K, ONE, V( 1, N-K+1 ), LDV, WORK,
+ $ LDWORK )
+ IF( N.GT.K ) THEN
+*
+* W := W + C1 * V1'
+*
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose', M,
+ $ K, N-K, ONE, C, LDC, V, LDV, ONE, WORK,
+ $ LDWORK )
+ END IF
+*
+* W := W * T or W * T'
+*
+ CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
+ $ ONE, T, LDT, WORK, LDWORK )
+*
+* C := C - W * V
+*
+ IF( N.GT.K ) THEN
+*
+* C1 := C1 - W * V1
+*
+ CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K,
+ $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
+ END IF
+*
+* W := W * V2
+*
+ CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
+ $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
+*
+* C1 := C1 - W
+*
+ DO 240 J = 1, K
+ DO 230 I = 1, M
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
+ 230 CONTINUE
+ 240 CONTINUE
+*
+ END IF
+*
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZLARFB
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.c
new file mode 100644
index 0000000000000000000000000000000000000000..4e0e8889a0d01aa75f25e055c74d3af6d7459956
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.c
@@ -0,0 +1,150 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b5 = {1.,0.};
+
+/* Subroutine */ void zlarfg_(n, alpha, x, incx, tau)
+const integer *n;
+doublecomplex *alpha, *x;
+const integer *incx;
+doublecomplex *tau;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static doublereal beta;
+ static integer j;
+ static doublereal alphi, alphr;
+ static doublereal xnorm;
+ static doublereal safmin;
+ static doublereal rsafmn;
+ static integer knt;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLARFG generates a complex elementary reflector H of order n, such */
+/* that */
+/* */
+/* H' * ( alpha ) = ( beta ), H' * H = I. */
+/* ( x ) ( 0 ) */
+/* */
+/* where alpha and beta are scalars, with beta real, and x is an */
+/* (n-1)-element complex vector. H is represented in the form */
+/* */
+/* H = I - tau * ( 1 ) * ( 1 v' ) , */
+/* ( v ) */
+/* */
+/* where tau is a complex scalar and v is a complex (n-1)-element */
+/* vector. Note that H is not hermitian. */
+/* */
+/* If the elements of x are all zero and alpha is real, then tau = 0 */
+/* and H is taken to be the unit matrix. */
+/* */
+/* Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 . */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the elementary reflector. */
+/* */
+/* ALPHA (input/output) COMPLEX*16 */
+/* On entry, the value alpha. */
+/* On exit, it is overwritten with the value beta. */
+/* */
+/* X (input/output) COMPLEX*16 array, dimension */
+/* (1+(N-2)*abs(INCX)) */
+/* On entry, the vector x. */
+/* On exit, it is overwritten with the vector v. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between elements of X. INCX > 0. */
+/* */
+/* TAU (output) COMPLEX*16 */
+/* The value tau. */
+/* */
+/* ===================================================================== */
+
+ if (*n <= 0) {
+ tau->r = 0., tau->i = 0.;
+ return;
+ }
+
+ i__1 = *n - 1;
+ xnorm = dznrm2_(&i__1, x, incx);
+ alphr = alpha->r;
+ alphi = alpha->i;
+
+ if (xnorm == 0. && alphi == 0.) {
+
+/* H = I */
+
+ tau->r = 0., tau->i = 0.;
+ } else {
+
+/* general case */
+
+ d__1 = dlapy3_(&alphr, &alphi, &xnorm);
+ beta = -d_sign(&d__1, &alphr);
+ safmin = dlamch_("S") / dlamch_("E");
+ rsafmn = 1. / safmin;
+
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ knt = 0;
+L10:
+ ++knt;
+ i__1 = *n - 1;
+ zdscal_(&i__1, &rsafmn, x, incx);
+ beta *= rsafmn;
+ alphi *= rsafmn;
+ alphr *= rsafmn;
+ if (abs(beta) < safmin) {
+ goto L10;
+ }
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ i__1 = *n - 1;
+ xnorm = dznrm2_(&i__1, x, incx);
+ alpha->r = alphr, alpha->i = alphi;
+ d__1 = dlapy3_(&alphr, &alphi, &xnorm);
+ beta = -d_sign(&d__1, &alphr);
+ tau->r = (beta - alphr) / beta, tau->i = -alphi / beta;
+ z__1.r = alpha->r - beta, z__1.i = alpha->i;
+ zladiv_(alpha, &c_b5, &z__1);
+ i__1 = *n - 1;
+ zscal_(&i__1, alpha, x, incx);
+
+/* If ALPHA is subnormal, it may lose relative accuracy */
+
+ alpha->r = beta, alpha->i = 0.;
+ for (j = 1; j <= knt; ++j) {
+ alpha->r *= safmin, alpha->i *= safmin;
+ }
+ } else {
+ tau->r = (beta - alphr) / beta, tau->i = -alphi / beta;
+ z__1.r = alpha->r - beta, z__1.i = alpha->i;
+ zladiv_(alpha, &c_b5, &z__1);
+ i__1 = *n - 1;
+ zscal_(&i__1, alpha, x, incx);
+ alpha->r = beta, alpha->i = 0.;
+ }
+ }
+} /* zlarfg_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.f
new file mode 100644
index 0000000000000000000000000000000000000000..eb7968dd59ad31739536e2ce457e15353cbd445d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfg.f
@@ -0,0 +1,146 @@
+ SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ COMPLEX*16 ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLARFG generates a complex elementary reflector H of order n, such
+* that
+*
+* H' * ( alpha ) = ( beta ), H' * H = I.
+* ( x ) ( 0 )
+*
+* where alpha and beta are scalars, with beta real, and x is an
+* (n-1)-element complex vector. H is represented in the form
+*
+* H = I - tau * ( 1 ) * ( 1 v' ) ,
+* ( v )
+*
+* where tau is a complex scalar and v is a complex (n-1)-element
+* vector. Note that H is not hermitian.
+*
+* If the elements of x are all zero and alpha is real, then tau = 0
+* and H is taken to be the unit matrix.
+*
+* Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the elementary reflector.
+*
+* ALPHA (input/output) COMPLEX*16
+* On entry, the value alpha.
+* On exit, it is overwritten with the value beta.
+*
+* X (input/output) COMPLEX*16 array, dimension
+* (1+(N-2)*abs(INCX))
+* On entry, the vector x.
+* On exit, it is overwritten with the vector v.
+*
+* INCX (input) INTEGER
+* The increment between elements of X. INCX > 0.
+*
+* TAU (output) COMPLEX*16
+* The value tau.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE, ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ DOUBLE PRECISION DLAMCH, DLAPY3, DZNRM2
+ COMPLEX*16 ZLADIV
+ EXTERNAL DLAMCH, DLAPY3, DZNRM2, ZLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZDSCAL, ZSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.0 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHR = DBLE( ALPHA )
+ ALPHI = DIMAG( ALPHA )
+*
+ IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
+ RSAFMN = ONE / SAFMIN
+*
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ KNT = 0
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL ZDSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHI = ALPHI*RSAFMN
+ ALPHR = ALPHR*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = DZNRM2( N-1, X, INCX )
+ ALPHA = DCMPLX( ALPHR, ALPHI )
+ BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
+ CALL ZSCAL( N-1, ALPHA, X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ ALPHA = BETA
+ DO 20 J = 1, KNT
+ ALPHA = ALPHA*SAFMIN
+ 20 CONTINUE
+ ELSE
+ TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
+ CALL ZSCAL( N-1, ALPHA, X, INCX )
+ ALPHA = BETA
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZLARFG
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.c
new file mode 100644
index 0000000000000000000000000000000000000000..4c9db37ce81aca3fa5a055e673ecea5f22e23beb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.c
@@ -0,0 +1,247 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b4 = {0.,0.};
+static integer c__1 = 1;
+
+/* Subroutine */ void zlarft_(direct, storev, n, k, v, ldv, tau, t, ldt)
+const char *direct, *storev;
+const integer *n, *k;
+doublecomplex *v;
+const integer *ldv;
+const doublecomplex *tau;
+doublecomplex *t;
+integer *ldt;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i, j;
+ static doublecomplex vii;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLARFT forms the triangular factor T of a complex block reflector H */
+/* of order n, which is defined as a product of k elementary reflectors. */
+/* */
+/* If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; */
+/* */
+/* If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. */
+/* */
+/* If STOREV = 'C', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th column of the array V, and */
+/* */
+/* H = I - V * T * V' */
+/* */
+/* If STOREV = 'R', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th row of the array V, and */
+/* */
+/* H = I - V' * T * V */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* DIRECT (input) CHARACTER*1 */
+/* Specifies the order in which the elementary reflectors are */
+/* multiplied to form the block reflector: */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+/* */
+/* STOREV (input) CHARACTER*1 */
+/* Specifies how the vectors which define the elementary */
+/* reflectors are stored (see also Further Details): */
+/* = 'C': columnwise */
+/* = 'R': rowwise */
+/* */
+/* N (input) INTEGER */
+/* The order of the block reflector H. N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The order of the triangular factor T (= the number of */
+/* elementary reflectors). K >= 1. */
+/* */
+/* V (input/output) COMPLEX*16 array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,N) if STOREV = 'R' */
+/* The matrix V. See further details. */
+/* */
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. */
+/* */
+/* TAU (input) COMPLEX*16 array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i). */
+/* */
+/* T (output) COMPLEX*16 array, dimension (LDT,K) */
+/* The k by k triangular factor T of the block reflector. */
+/* If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is */
+/* lower triangular. The rest of the array is not used. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The shape of the matrix V and the storage of the vectors which define */
+/* the H(i) is best illustrated by the following example with n = 5 and */
+/* k = 3. The elements equal to 1 are not stored; the corresponding */
+/* array elements are modified but restored on exit. The rest of the */
+/* array is not used. */
+/* */
+/* DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': */
+/* */
+/* V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) */
+/* ( v1 1 ) ( 1 v2 v2 v2 ) */
+/* ( v1 v2 1 ) ( 1 v3 v3 ) */
+/* ( v1 v2 v3 ) */
+/* ( v1 v2 v3 ) */
+/* */
+/* DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': */
+/* */
+/* V = ( v1 v2 v3 ) V = ( v1 v1 1 ) */
+/* ( v1 v2 v3 ) ( v2 v2 v2 1 ) */
+/* ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) */
+/* ( 1 v3 ) */
+/* ( 1 ) */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+ if (*n == 0) {
+ return;
+ }
+
+ if (lsame_(direct, "F")) {
+ for (i = 0; i < *k; ++i) {
+ if (tau[i].r == 0. && tau[i].i == 0.) {
+
+/* H(i) = I */
+
+ for (j = 0; j <= i; ++j) {
+ i__1 = j + i * *ldt;
+ t[i__1].r = 0., t[i__1].i = 0.;
+ }
+ } else {
+
+/* general case */
+
+ i__2 = i + i * *ldv;
+ vii.r = v[i__2].r, vii.i = v[i__2].i;
+ i__2 = i + i * *ldv;
+ v[i__2].r = 1., v[i__2].i = 0.;
+ if (lsame_(storev, "C")) {
+
+/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */
+
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ i__1 = *n - i;
+ zgemv_("Conjugate transpose", &i__1, &i, &z__1,
+ &v[i], ldv, &v[i + i * *ldv], &c__1, &c_b4,
+ &t[i * *ldt], &c__1);
+ } else {
+
+/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */
+
+ if (i < *n-1) {
+ i__2 = *n-1 - i;
+ zlacgv_(&i__2, &v[i + (i + 1) * *ldv], ldv);
+ }
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ i__2 = *n - i;
+ zgemv_("No transpose", &i, &i__2, &z__1, &v[i* *ldv], ldv,
+ &v[i+i* *ldv], ldv, &c_b4, &t[i* *ldt], &c__1);
+ if (i < *n-1) {
+ i__2 = *n-1 - i;
+ zlacgv_(&i__2, &v[i + (i + 1) * *ldv], ldv);
+ }
+ }
+ i__2 = i + i * *ldv;
+ v[i__2].r = vii.r, v[i__2].i = vii.i;
+
+/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */
+
+ ztrmv_("Upper", "No transpose", "Non-unit", &i, t, ldt, &t[i * *ldt], &c__1);
+ i__2 = i + i * *ldt;
+ t[i__2].r = tau[i].r, t[i__2].i = tau[i].i;
+ }
+ }
+ } else {
+ for (i = *k-1; i >= 0; --i) {
+ if (tau[i].r == 0. && tau[i].i == 0.) {
+
+/* H(i) = I */
+
+ for (j = i; j < *k; ++j) {
+ i__2 = j + i * *ldt;
+ t[i__2].r = 0., t[i__2].i = 0.;
+ }
+ } else {
+
+/* general case */
+
+ if (i < *k-1) {
+ if (lsame_(storev, "C")) {
+ i__1 = *n - *k + i + i * *ldv;
+ vii.r = v[i__1].r, vii.i = v[i__1].i;
+ v[i__1].r = 1., v[i__1].i = 0.;
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i) */
+
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ i__1 = *n - *k + i + 1;
+ i__2 = *k - i - 1;
+ zgemv_("Conjugate transpose", &i__1, &i__2, &z__1,
+ &v[(i + 1) * *ldv], ldv, &v[i * *ldv], &c__1,
+ &c_b4, &t[i + 1 + i * *ldt], &c__1);
+ i__1 = *n - *k + i + i * *ldv;
+ v[i__1].r = vii.r, v[i__1].i = vii.i;
+ } else {
+ i__1 = i + (*n - *k + i) * *ldv;
+ vii.r = v[i__1].r, vii.i = v[i__1].i;
+ v[i__1].r = 1., v[i__1].i = 0.;
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)' */
+
+ i__1 = *n - *k + i;
+ zlacgv_(&i__1, &v[i], ldv);
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ i__1 = *k - i - 1;
+ i__2 = *n - *k + i + 1;
+ zgemv_("No transpose", &i__1, &i__2, &z__1, &v[i+1], ldv,
+ &v[i], ldv, &c_b4, &t[i+1 + i* *ldt], &c__1);
+ i__1 = *n - *k + i;
+ zlacgv_(&i__1, &v[i], ldv);
+ i__1 = i + (*n - *k + i) * *ldv;
+ v[i__1].r = vii.r, v[i__1].i = vii.i;
+ }
+
+/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */
+
+ i__1 = *k - i - 1;
+ ztrmv_("Lower", "No transpose", "Non-unit", &i__1,
+ &t[i + 1 + (i + 1) * *ldt], ldt,
+ &t[i + 1 + i * *ldt], &c__1);
+ }
+ i__1 = i + i * *ldt;
+ t[i__1].r = tau[i].r, t[i__1].i = tau[i].i;
+ }
+ }
+ }
+} /* zlarft_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.f
new file mode 100644
index 0000000000000000000000000000000000000000..d109a93a66c574b5e08de138eb3e05b07f0f2924
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarft.f
@@ -0,0 +1,225 @@
+ SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER DIRECT, STOREV
+ INTEGER K, LDT, LDV, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLARFT forms the triangular factor T of a complex block reflector H
+* of order n, which is defined as a product of k elementary reflectors.
+*
+* If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*
+* If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*
+* If STOREV = 'C', the vector which defines the elementary reflector
+* H(i) is stored in the i-th column of the array V, and
+*
+* H = I - V * T * V'
+*
+* If STOREV = 'R', the vector which defines the elementary reflector
+* H(i) is stored in the i-th row of the array V, and
+*
+* H = I - V' * T * V
+*
+* Arguments
+* =========
+*
+* DIRECT (input) CHARACTER*1
+* Specifies the order in which the elementary reflectors are
+* multiplied to form the block reflector:
+* = 'F': H = H(1) H(2) . . . H(k) (Forward)
+* = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*
+* STOREV (input) CHARACTER*1
+* Specifies how the vectors which define the elementary
+* reflectors are stored (see also Further Details):
+* = 'C': columnwise
+* = 'R': rowwise
+*
+* N (input) INTEGER
+* The order of the block reflector H. N >= 0.
+*
+* K (input) INTEGER
+* The order of the triangular factor T (= the number of
+* elementary reflectors). K >= 1.
+*
+* V (input/output) COMPLEX*16 array, dimension
+* (LDV,K) if STOREV = 'C'
+* (LDV,N) if STOREV = 'R'
+* The matrix V. See further details.
+*
+* LDV (input) INTEGER
+* The leading dimension of the array V.
+* If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*
+* TAU (input) COMPLEX*16 array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i).
+*
+* T (output) COMPLEX*16 array, dimension (LDT,K)
+* The k by k triangular factor T of the block reflector.
+* If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+* lower triangular. The rest of the array is not used.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= K.
+*
+* Further Details
+* ===============
+*
+* The shape of the matrix V and the storage of the vectors which define
+* the H(i) is best illustrated by the following example with n = 5 and
+* k = 3. The elements equal to 1 are not stored; the corresponding
+* array elements are modified but restored on exit. The rest of the
+* array is not used.
+*
+* DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+*
+* V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+* ( v1 1 ) ( 1 v2 v2 v2 )
+* ( v1 v2 1 ) ( 1 v3 v3 )
+* ( v1 v2 v3 )
+* ( v1 v2 v3 )
+*
+* DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+*
+* V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+* ( v1 v2 v3 ) ( v2 v2 v2 1 )
+* ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+* ( 1 v3 )
+* ( 1 )
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J
+ COMPLEX*16 VII
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZLACGV, ZTRMV
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Executable Statements ..
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ IF( LSAME( DIRECT, 'F' ) ) THEN
+ DO 20 I = 1, K
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO 10 J = 1, I
+ T( J, I ) = ZERO
+ 10 CONTINUE
+ ELSE
+*
+* general case
+*
+ VII = V( I, I )
+ V( I, I ) = ONE
+ IF( LSAME( STOREV, 'C' ) ) THEN
+*
+* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i)
+*
+ CALL ZGEMV( 'Conjugate transpose', N-I+1, I-1,
+ $ -TAU( I ), V( I, 1 ), LDV, V( I, I ), 1,
+ $ ZERO, T( 1, I ), 1 )
+ ELSE
+*
+* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)'
+*
+ IF( I.LT.N )
+ $ CALL ZLACGV( N-I, V( I, I+1 ), LDV )
+ CALL ZGEMV( 'No transpose', I-1, N-I+1, -TAU( I ),
+ $ V( 1, I ), LDV, V( I, I ), LDV, ZERO,
+ $ T( 1, I ), 1 )
+ IF( I.LT.N )
+ $ CALL ZLACGV( N-I, V( I, I+1 ), LDV )
+ END IF
+ V( I, I ) = VII
+*
+* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+ CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+ $ LDT, T( 1, I ), 1 )
+ T( I, I ) = TAU( I )
+ END IF
+ 20 CONTINUE
+ ELSE
+ DO 40 I = K, 1, -1
+ IF( TAU( I ).EQ.ZERO ) THEN
+*
+* H(i) = I
+*
+ DO 30 J = I, K
+ T( J, I ) = ZERO
+ 30 CONTINUE
+ ELSE
+*
+* general case
+*
+ IF( I.LT.K ) THEN
+ IF( LSAME( STOREV, 'C' ) ) THEN
+ VII = V( N-K+I, I )
+ V( N-K+I, I ) = ONE
+*
+* T(i+1:k,i) :=
+* - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
+*
+ CALL ZGEMV( 'Conjugate transpose', N-K+I, K-I,
+ $ -TAU( I ), V( 1, I+1 ), LDV, V( 1, I ),
+ $ 1, ZERO, T( I+1, I ), 1 )
+ V( N-K+I, I ) = VII
+ ELSE
+ VII = V( I, N-K+I )
+ V( I, N-K+I ) = ONE
+*
+* T(i+1:k,i) :=
+* - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
+*
+ CALL ZLACGV( N-K+I-1, V( I, 1 ), LDV )
+ CALL ZGEMV( 'No transpose', K-I, N-K+I, -TAU( I ),
+ $ V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
+ $ T( I+1, I ), 1 )
+ CALL ZLACGV( N-K+I-1, V( I, 1 ), LDV )
+ V( I, N-K+I ) = VII
+ END IF
+*
+* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+ CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+ $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+ END IF
+ T( I, I ) = TAU( I )
+ END IF
+ 40 CONTINUE
+ END IF
+ RETURN
+*
+* End of ZLARFT
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.c
new file mode 100644
index 0000000000000000000000000000000000000000..8b7601dc6f4d297fed3ceb5b10afff9fed2b5434
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.c
@@ -0,0 +1,1164 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static doublecomplex c_b2 = {0.,0.};
+static doublecomplex c_b15 = {1.,0.};
+static integer c__1 = 1;
+
+/* Subroutine */ void zlarfx_(side, m, n, v, tau, c, ldc, work)
+const char *side;
+const integer *m, *n;
+doublecomplex *v, *tau, *c;
+const integer *ldc;
+doublecomplex *work;
+{
+ /* System generated locals */
+ integer i__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer j;
+ static doublecomplex t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, sum;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLARFX applies a complex elementary reflector H to a complex m by n */
+/* matrix C, from either the left or the right. H is represented in the */
+/* form */
+/* */
+/* H = I - tau * v * v' */
+/* */
+/* where tau is a complex scalar and v is a complex vector. */
+/* */
+/* If tau = 0, then H is taken to be the unit matrix */
+/* */
+/* This version uses inline code if H has order < 11. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': form H * C */
+/* = 'R': form C * H */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+/* */
+/* V (input) COMPLEX*16 array, dimension (M) if SIDE = 'L' */
+/* or (N) if SIDE = 'R' */
+/* The vector v in the representation of H. */
+/* */
+/* TAU (input) COMPLEX*16 */
+/* The value tau in the representation of H. */
+/* */
+/* C (input/output) COMPLEX*16 array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
+/* or C * H if SIDE = 'R'. */
+/* */
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDA >= max(1,M). */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (N) if SIDE = 'L' */
+/* or (M) if SIDE = 'R' */
+/* WORK is not referenced if H has order < 11. */
+/* */
+/* ===================================================================== */
+
+/* Quick return if possible */
+ if (tau->r == 0. && tau->i == 0.) {
+ return;
+ }
+ if (lsame_(side, "L")) {
+
+/* Form H * C, where H has order m. */
+
+ switch ((int)*m) {
+ case 1: goto L10;
+ case 2: goto L30;
+ case 3: goto L50;
+ case 4: goto L70;
+ case 5: goto L90;
+ case 6: goto L110;
+ case 7: goto L130;
+ case 8: goto L150;
+ case 9: goto L170;
+ case 10: goto L190;
+ }
+
+/* Code for general M */
+
+/* w := C'*v */
+
+ zgemv_("Conjugate transpose", m, n, &c_b15, c, ldc, v, &c__1, &c_b2, work, &c__1);
+
+/* C := C - tau * v * w' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, v, &c__1, work, &c__1, c, ldc);
+ return; /* exit zlarfx */
+L10:
+
+/* Special code for 1 x 1 Householder */
+
+ z__1.r = tau->r * v[0].r - tau->i * v[0].i,
+ z__1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t1.r = 1. - z__1.r * v[0].r - z__1.i * v[0].i,
+ t1.i = 0. + z__1.r * v[0].i - z__1.i * v[0].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ z__1.r = t1.r * c[i__1].r - t1.i * c[i__1].i,
+ z__1.i = t1.r * c[i__1].i + t1.i * c[i__1].r;
+ c[i__1].r = z__1.r, c[i__1].i = z__1.i;
+ }
+ return; /* exit zlarfx */
+L30:
+
+/* Special code for 2 x 2 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ }
+ return; /* exit zlarfx */
+L50:
+
+/* Special code for 3 x 3 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ }
+ return; /* exit zlarfx */
+L70:
+
+/* Special code for 4 x 4 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ }
+ return; /* exit zlarfx */
+L90:
+
+/* Special code for 5 x 5 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ }
+ return; /* exit zlarfx */
+L110:
+
+/* Special code for 6 x 6 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r - tau->i * v[5].i,
+ t6.i = tau->r * v[5].i + tau->i * v[5].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[5].r * c[i__1].r + v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i - v[5].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ }
+ return; /* exit zlarfx */
+L130:
+
+/* Special code for 7 x 7 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r - tau->i * v[5].i,
+ t6.i = tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r - tau->i * v[6].i,
+ t7.i = tau->r * v[6].i + tau->i * v[6].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[5].r * c[i__1].r + v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i - v[5].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[6].r * c[i__1].r + v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i - v[6].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ }
+ return; /* exit zlarfx */
+L150:
+
+/* Special code for 8 x 8 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r - tau->i * v[5].i,
+ t6.i = tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r - tau->i * v[6].i,
+ t7.i = tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r - tau->i * v[7].i,
+ t8.i = tau->r * v[7].i + tau->i * v[7].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[5].r * c[i__1].r + v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i - v[5].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[6].r * c[i__1].r + v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i - v[6].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[7].r * c[i__1].r + v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i - v[7].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ }
+ return; /* exit zlarfx */
+L170:
+
+/* Special code for 9 x 9 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r - tau->i * v[5].i,
+ t6.i = tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r - tau->i * v[6].i,
+ t7.i = tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r - tau->i * v[7].i,
+ t8.i = tau->r * v[7].i + tau->i * v[7].r;
+ t9.r = tau->r * v[8].r - tau->i * v[8].i,
+ t9.i = tau->r * v[8].i + tau->i * v[8].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[5].r * c[i__1].r + v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i - v[5].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[6].r * c[i__1].r + v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i - v[6].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[7].r * c[i__1].r + v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i - v[7].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[8].r * c[i__1].r + v[8].i * c[i__1].i,
+ sum.i += v[8].r * c[i__1].i - v[8].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t9.r - sum.i * t9.i,
+ c[i__1].i -= sum.r * t9.i + sum.i * t9.r;
+ }
+ return; /* exit zlarfx */
+L190:
+
+/* Special code for 10 x 10 Householder */
+
+ t1.r = tau->r * v[0].r - tau->i * v[0].i,
+ t1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r - tau->i * v[1].i,
+ t2.i = tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r - tau->i * v[2].i,
+ t3.i = tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r - tau->i * v[3].i,
+ t4.i = tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r - tau->i * v[4].i,
+ t5.i = tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r - tau->i * v[5].i,
+ t6.i = tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r - tau->i * v[6].i,
+ t7.i = tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r - tau->i * v[7].i,
+ t8.i = tau->r * v[7].i + tau->i * v[7].r;
+ t9.r = tau->r * v[8].r - tau->i * v[8].i,
+ t9.i = tau->r * v[8].i + tau->i * v[8].r;
+ t10.r = tau->r * v[9].r - tau->i * v[9].i,
+ t10.i = tau->r * v[9].i + tau->i * v[9].r;
+ for (j = 0; j < *n; ++j) {
+ i__1 = j * *ldc;
+ sum.r = v[0].r * c[i__1].r + v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i - v[0].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[1].r * c[i__1].r + v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i - v[1].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[2].r * c[i__1].r + v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i - v[2].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[3].r * c[i__1].r + v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i - v[3].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[4].r * c[i__1].r + v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i - v[4].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[5].r * c[i__1].r + v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i - v[5].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[6].r * c[i__1].r + v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i - v[6].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[7].r * c[i__1].r + v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i - v[7].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[8].r * c[i__1].r + v[8].i * c[i__1].i,
+ sum.i += v[8].r * c[i__1].i - v[8].i * c[i__1].r;
+ ++i__1;
+ sum.r += v[9].r * c[i__1].r + v[9].i * c[i__1].i,
+ sum.i += v[9].r * c[i__1].i - v[9].i * c[i__1].r;
+ i__1 = j * *ldc;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t9.r - sum.i * t9.i,
+ c[i__1].i -= sum.r * t9.i + sum.i * t9.r;
+ ++i__1;
+ c[i__1].r -= sum.r * t10.r - sum.i * t10.i,
+ c[i__1].i -= sum.r * t10.i + sum.i * t10.r;
+ }
+ return; /* exit zlarfx */
+ } else {
+
+/* Form C * H, where H has order n. */
+
+ switch ((int)*n) {
+ case 1: goto L210;
+ case 2: goto L230;
+ case 3: goto L250;
+ case 4: goto L270;
+ case 5: goto L290;
+ case 6: goto L310;
+ case 7: goto L330;
+ case 8: goto L350;
+ case 9: goto L370;
+ case 10: goto L390;
+ }
+
+/* Code for general N */
+
+/* w := C * v */
+
+ zgemv_("No transpose", m, n, &c_b15, c, ldc, v, &c__1, &c_b2, work, &c__1);
+
+/* C := C - tau * w * v' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, work, &c__1, v, &c__1, c, ldc);
+ return; /* exit zlarfx */
+L210:
+
+/* Special code for 1 x 1 Householder */
+
+ z__1.r = tau->r * v[0].r - tau->i * v[0].i,
+ z__1.i = tau->r * v[0].i + tau->i * v[0].r;
+ t1.r = 1. - z__1.r * v[0].r - z__1.i * v[0].i,
+ t1.i = 0. + z__1.r * v[0].i - z__1.i * v[0].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ z__1.r = t1.r * c[i__1].r - t1.i * c[i__1].i,
+ z__1.i = t1.r * c[i__1].i + t1.i * c[i__1].r;
+ c[i__1].r = z__1.r,
+ c[i__1].i = z__1.i;
+ }
+ return; /* exit zlarfx */
+L230:
+
+/* Special code for 2 x 2 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ }
+ return; /* exit zlarfx */
+L250:
+
+/* Special code for 3 x 3 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ }
+ return; /* exit zlarfx */
+L270:
+
+/* Special code for 4 x 4 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ }
+ return; /* exit zlarfx */
+L290:
+
+/* Special code for 5 x 5 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ }
+ return; /* exit zlarfx */
+L310:
+
+/* Special code for 6 x 6 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r + tau->i * v[5].i,
+ t6.i = - tau->r * v[5].i + tau->i * v[5].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[5].r * c[i__1].r - v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i + v[5].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ }
+ return; /* exit zlarfx */
+L330:
+
+/* Special code for 7 x 7 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r + tau->i * v[5].i,
+ t6.i = - tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r + tau->i * v[6].i,
+ t7.i = - tau->r * v[6].i + tau->i * v[6].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[5].r * c[i__1].r - v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i + v[5].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[6].r * c[i__1].r - v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i + v[6].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ }
+ return; /* exit zlarfx */
+L350:
+
+/* Special code for 8 x 8 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r + tau->i * v[5].i,
+ t6.i = - tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r + tau->i * v[6].i,
+ t7.i = - tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r + tau->i * v[7].i,
+ t8.i = - tau->r * v[7].i + tau->i * v[7].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[5].r * c[i__1].r - v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i + v[5].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[6].r * c[i__1].r - v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i + v[6].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[7].r * c[i__1].r - v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i + v[7].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ }
+ return; /* exit zlarfx */
+L370:
+
+/* Special code for 9 x 9 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r + tau->i * v[5].i,
+ t6.i = - tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r + tau->i * v[6].i,
+ t7.i = - tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r + tau->i * v[7].i,
+ t8.i = - tau->r * v[7].i + tau->i * v[7].r;
+ t9.r = tau->r * v[8].r + tau->i * v[8].i,
+ t9.i = - tau->r * v[8].i + tau->i * v[8].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[5].r * c[i__1].r - v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i + v[5].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[6].r * c[i__1].r - v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i + v[6].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[7].r * c[i__1].r - v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i + v[7].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[8].r * c[i__1].r - v[8].i * c[i__1].i,
+ sum.i += v[8].r * c[i__1].i + v[8].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t9.r - sum.i * t9.i,
+ c[i__1].i -= sum.r * t9.i + sum.i * t9.r;
+ }
+ return; /* exit zlarfx */
+L390:
+
+/* Special code for 10 x 10 Householder */
+
+ t1.r = tau->r * v[0].r + tau->i * v[0].i,
+ t1.i = - tau->r * v[0].i + tau->i * v[0].r;
+ t2.r = tau->r * v[1].r + tau->i * v[1].i,
+ t2.i = - tau->r * v[1].i + tau->i * v[1].r;
+ t3.r = tau->r * v[2].r + tau->i * v[2].i,
+ t3.i = - tau->r * v[2].i + tau->i * v[2].r;
+ t4.r = tau->r * v[3].r + tau->i * v[3].i,
+ t4.i = - tau->r * v[3].i + tau->i * v[3].r;
+ t5.r = tau->r * v[4].r + tau->i * v[4].i,
+ t5.i = - tau->r * v[4].i + tau->i * v[4].r;
+ t6.r = tau->r * v[5].r + tau->i * v[5].i,
+ t6.i = - tau->r * v[5].i + tau->i * v[5].r;
+ t7.r = tau->r * v[6].r + tau->i * v[6].i,
+ t7.i = - tau->r * v[6].i + tau->i * v[6].r;
+ t8.r = tau->r * v[7].r + tau->i * v[7].i,
+ t8.i = - tau->r * v[7].i + tau->i * v[7].r;
+ t9.r = tau->r * v[8].r + tau->i * v[8].i,
+ t9.i = - tau->r * v[8].i + tau->i * v[8].r;
+ t10.r = tau->r * v[9].r + tau->i * v[9].i,
+ t10.i = - tau->r * v[9].i + tau->i * v[9].r;
+ for (j = 0; j < *m; ++j) {
+ i__1 = j;
+ sum.r = v[0].r * c[i__1].r - v[0].i * c[i__1].i,
+ sum.i = v[0].r * c[i__1].i + v[0].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[1].r * c[i__1].r - v[1].i * c[i__1].i,
+ sum.i += v[1].r * c[i__1].i + v[1].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[2].r * c[i__1].r - v[2].i * c[i__1].i,
+ sum.i += v[2].r * c[i__1].i + v[2].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[3].r * c[i__1].r - v[3].i * c[i__1].i,
+ sum.i += v[3].r * c[i__1].i + v[3].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[4].r * c[i__1].r - v[4].i * c[i__1].i,
+ sum.i += v[4].r * c[i__1].i + v[4].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[5].r * c[i__1].r - v[5].i * c[i__1].i,
+ sum.i += v[5].r * c[i__1].i + v[5].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[6].r * c[i__1].r - v[6].i * c[i__1].i,
+ sum.i += v[6].r * c[i__1].i + v[6].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[7].r * c[i__1].r - v[7].i * c[i__1].i,
+ sum.i += v[7].r * c[i__1].i + v[7].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[8].r * c[i__1].r - v[8].i * c[i__1].i,
+ sum.i += v[8].r * c[i__1].i + v[8].i * c[i__1].r;
+ i__1 += *ldc;
+ sum.r += v[9].r * c[i__1].r - v[9].i * c[i__1].i,
+ sum.i += v[9].r * c[i__1].i + v[9].i * c[i__1].r;
+ i__1 = j;
+ c[i__1].r -= sum.r * t1.r - sum.i * t1.i,
+ c[i__1].i -= sum.r * t1.i + sum.i * t1.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t2.r - sum.i * t2.i,
+ c[i__1].i -= sum.r * t2.i + sum.i * t2.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t3.r - sum.i * t3.i,
+ c[i__1].i -= sum.r * t3.i + sum.i * t3.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t4.r - sum.i * t4.i,
+ c[i__1].i -= sum.r * t4.i + sum.i * t4.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t5.r - sum.i * t5.i,
+ c[i__1].i -= sum.r * t5.i + sum.i * t5.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t6.r - sum.i * t6.i,
+ c[i__1].i -= sum.r * t6.i + sum.i * t6.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t7.r - sum.i * t7.i,
+ c[i__1].i -= sum.r * t7.i + sum.i * t7.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t8.r - sum.i * t8.i,
+ c[i__1].i -= sum.r * t8.i + sum.i * t8.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t9.r - sum.i * t9.i,
+ c[i__1].i -= sum.r * t9.i + sum.i * t9.r;
+ i__1 += *ldc;
+ c[i__1].r -= sum.r * t10.r - sum.i * t10.i,
+ c[i__1].i -= sum.r * t10.i + sum.i * t10.r;
+ }
+ return; /* exit zlarfx */
+ }
+} /* zlarfx_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.f
new file mode 100644
index 0000000000000000000000000000000000000000..f364ba13901f341d2acc54bd9affd1b2ccea5142
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlarfx.f
@@ -0,0 +1,642 @@
+ SUBROUTINE ZLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER SIDE
+ INTEGER LDC, M, N
+ COMPLEX*16 TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLARFX applies a complex elementary reflector H to a complex m by n
+* matrix C, from either the left or the right. H is represented in the
+* form
+*
+* H = I - tau * v * v'
+*
+* where tau is a complex scalar and v is a complex vector.
+*
+* If tau = 0, then H is taken to be the unit matrix
+*
+* This version uses inline code if H has order < 11.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'L': form H * C
+* = 'R': form C * H
+*
+* M (input) INTEGER
+* The number of rows of the matrix C.
+*
+* N (input) INTEGER
+* The number of columns of the matrix C.
+*
+* V (input) COMPLEX*16 array, dimension (M) if SIDE = 'L'
+* or (N) if SIDE = 'R'
+* The vector v in the representation of H.
+*
+* TAU (input) COMPLEX*16
+* The value tau in the representation of H.
+*
+* C (input/output) COMPLEX*16 array, dimension (LDC,N)
+* On entry, the m by n matrix C.
+* On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+* or C * H if SIDE = 'R'.
+*
+* LDC (input) INTEGER
+* The leading dimension of the array C. LDA >= max(1,M).
+*
+* WORK (workspace) COMPLEX*16 array, dimension (N) if SIDE = 'L'
+* or (M) if SIDE = 'R'
+* WORK is not referenced if H has order < 11.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER J
+ COMPLEX*16 SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
+ $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMV, ZGERC
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG
+* ..
+* .. Executable Statements ..
+*
+ IF( TAU.EQ.ZERO )
+ $ RETURN
+ IF( LSAME( SIDE, 'L' ) ) THEN
+*
+* Form H * C, where H has order m.
+*
+ GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
+ $ 170, 190 )M
+*
+* Code for general M
+*
+* w := C'*v
+*
+ CALL ZGEMV( 'Conjugate transpose', M, N, ONE, C, LDC, V, 1,
+ $ ZERO, WORK, 1 )
+*
+* C := C - tau * v * w'
+*
+ CALL ZGERC( M, N, -TAU, V, 1, WORK, 1, C, LDC )
+ GO TO 410
+ 10 CONTINUE
+*
+* Special code for 1 x 1 Householder
+*
+ T1 = ONE - TAU*V( 1 )*DCONJG( V( 1 ) )
+ DO 20 J = 1, N
+ C( 1, J ) = T1*C( 1, J )
+ 20 CONTINUE
+ GO TO 410
+ 30 CONTINUE
+*
+* Special code for 2 x 2 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ DO 40 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ 40 CONTINUE
+ GO TO 410
+ 50 CONTINUE
+*
+* Special code for 3 x 3 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ DO 60 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ 60 CONTINUE
+ GO TO 410
+ 70 CONTINUE
+*
+* Special code for 4 x 4 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ DO 80 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ 80 CONTINUE
+ GO TO 410
+ 90 CONTINUE
+*
+* Special code for 5 x 5 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ DO 100 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ 100 CONTINUE
+ GO TO 410
+ 110 CONTINUE
+*
+* Special code for 6 x 6 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ V6 = DCONJG( V( 6 ) )
+ T6 = TAU*DCONJG( V6 )
+ DO 120 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ C( 6, J ) = C( 6, J ) - SUM*T6
+ 120 CONTINUE
+ GO TO 410
+ 130 CONTINUE
+*
+* Special code for 7 x 7 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ V6 = DCONJG( V( 6 ) )
+ T6 = TAU*DCONJG( V6 )
+ V7 = DCONJG( V( 7 ) )
+ T7 = TAU*DCONJG( V7 )
+ DO 140 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
+ $ V7*C( 7, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ C( 6, J ) = C( 6, J ) - SUM*T6
+ C( 7, J ) = C( 7, J ) - SUM*T7
+ 140 CONTINUE
+ GO TO 410
+ 150 CONTINUE
+*
+* Special code for 8 x 8 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ V6 = DCONJG( V( 6 ) )
+ T6 = TAU*DCONJG( V6 )
+ V7 = DCONJG( V( 7 ) )
+ T7 = TAU*DCONJG( V7 )
+ V8 = DCONJG( V( 8 ) )
+ T8 = TAU*DCONJG( V8 )
+ DO 160 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
+ $ V7*C( 7, J ) + V8*C( 8, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ C( 6, J ) = C( 6, J ) - SUM*T6
+ C( 7, J ) = C( 7, J ) - SUM*T7
+ C( 8, J ) = C( 8, J ) - SUM*T8
+ 160 CONTINUE
+ GO TO 410
+ 170 CONTINUE
+*
+* Special code for 9 x 9 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ V6 = DCONJG( V( 6 ) )
+ T6 = TAU*DCONJG( V6 )
+ V7 = DCONJG( V( 7 ) )
+ T7 = TAU*DCONJG( V7 )
+ V8 = DCONJG( V( 8 ) )
+ T8 = TAU*DCONJG( V8 )
+ V9 = DCONJG( V( 9 ) )
+ T9 = TAU*DCONJG( V9 )
+ DO 180 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
+ $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ C( 6, J ) = C( 6, J ) - SUM*T6
+ C( 7, J ) = C( 7, J ) - SUM*T7
+ C( 8, J ) = C( 8, J ) - SUM*T8
+ C( 9, J ) = C( 9, J ) - SUM*T9
+ 180 CONTINUE
+ GO TO 410
+ 190 CONTINUE
+*
+* Special code for 10 x 10 Householder
+*
+ V1 = DCONJG( V( 1 ) )
+ T1 = TAU*DCONJG( V1 )
+ V2 = DCONJG( V( 2 ) )
+ T2 = TAU*DCONJG( V2 )
+ V3 = DCONJG( V( 3 ) )
+ T3 = TAU*DCONJG( V3 )
+ V4 = DCONJG( V( 4 ) )
+ T4 = TAU*DCONJG( V4 )
+ V5 = DCONJG( V( 5 ) )
+ T5 = TAU*DCONJG( V5 )
+ V6 = DCONJG( V( 6 ) )
+ T6 = TAU*DCONJG( V6 )
+ V7 = DCONJG( V( 7 ) )
+ T7 = TAU*DCONJG( V7 )
+ V8 = DCONJG( V( 8 ) )
+ T8 = TAU*DCONJG( V8 )
+ V9 = DCONJG( V( 9 ) )
+ T9 = TAU*DCONJG( V9 )
+ V10 = DCONJG( V( 10 ) )
+ T10 = TAU*DCONJG( V10 )
+ DO 200 J = 1, N
+ SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
+ $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
+ $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
+ $ V10*C( 10, J )
+ C( 1, J ) = C( 1, J ) - SUM*T1
+ C( 2, J ) = C( 2, J ) - SUM*T2
+ C( 3, J ) = C( 3, J ) - SUM*T3
+ C( 4, J ) = C( 4, J ) - SUM*T4
+ C( 5, J ) = C( 5, J ) - SUM*T5
+ C( 6, J ) = C( 6, J ) - SUM*T6
+ C( 7, J ) = C( 7, J ) - SUM*T7
+ C( 8, J ) = C( 8, J ) - SUM*T8
+ C( 9, J ) = C( 9, J ) - SUM*T9
+ C( 10, J ) = C( 10, J ) - SUM*T10
+ 200 CONTINUE
+ GO TO 410
+ ELSE
+*
+* Form C * H, where H has order n.
+*
+ GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
+ $ 370, 390 )N
+*
+* Code for general N
+*
+* w := C * v
+*
+ CALL ZGEMV( 'No transpose', M, N, ONE, C, LDC, V, 1, ZERO,
+ $ WORK, 1 )
+*
+* C := C - tau * w * v'
+*
+ CALL ZGERC( M, N, -TAU, WORK, 1, V, 1, C, LDC )
+ GO TO 410
+ 210 CONTINUE
+*
+* Special code for 1 x 1 Householder
+*
+ T1 = ONE - TAU*V( 1 )*DCONJG( V( 1 ) )
+ DO 220 J = 1, M
+ C( J, 1 ) = T1*C( J, 1 )
+ 220 CONTINUE
+ GO TO 410
+ 230 CONTINUE
+*
+* Special code for 2 x 2 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ DO 240 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ 240 CONTINUE
+ GO TO 410
+ 250 CONTINUE
+*
+* Special code for 3 x 3 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ DO 260 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ 260 CONTINUE
+ GO TO 410
+ 270 CONTINUE
+*
+* Special code for 4 x 4 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ DO 280 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ 280 CONTINUE
+ GO TO 410
+ 290 CONTINUE
+*
+* Special code for 5 x 5 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ DO 300 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ 300 CONTINUE
+ GO TO 410
+ 310 CONTINUE
+*
+* Special code for 6 x 6 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ V6 = V( 6 )
+ T6 = TAU*DCONJG( V6 )
+ DO 320 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ C( J, 6 ) = C( J, 6 ) - SUM*T6
+ 320 CONTINUE
+ GO TO 410
+ 330 CONTINUE
+*
+* Special code for 7 x 7 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ V6 = V( 6 )
+ T6 = TAU*DCONJG( V6 )
+ V7 = V( 7 )
+ T7 = TAU*DCONJG( V7 )
+ DO 340 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
+ $ V7*C( J, 7 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ C( J, 6 ) = C( J, 6 ) - SUM*T6
+ C( J, 7 ) = C( J, 7 ) - SUM*T7
+ 340 CONTINUE
+ GO TO 410
+ 350 CONTINUE
+*
+* Special code for 8 x 8 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ V6 = V( 6 )
+ T6 = TAU*DCONJG( V6 )
+ V7 = V( 7 )
+ T7 = TAU*DCONJG( V7 )
+ V8 = V( 8 )
+ T8 = TAU*DCONJG( V8 )
+ DO 360 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
+ $ V7*C( J, 7 ) + V8*C( J, 8 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ C( J, 6 ) = C( J, 6 ) - SUM*T6
+ C( J, 7 ) = C( J, 7 ) - SUM*T7
+ C( J, 8 ) = C( J, 8 ) - SUM*T8
+ 360 CONTINUE
+ GO TO 410
+ 370 CONTINUE
+*
+* Special code for 9 x 9 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ V6 = V( 6 )
+ T6 = TAU*DCONJG( V6 )
+ V7 = V( 7 )
+ T7 = TAU*DCONJG( V7 )
+ V8 = V( 8 )
+ T8 = TAU*DCONJG( V8 )
+ V9 = V( 9 )
+ T9 = TAU*DCONJG( V9 )
+ DO 380 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
+ $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ C( J, 6 ) = C( J, 6 ) - SUM*T6
+ C( J, 7 ) = C( J, 7 ) - SUM*T7
+ C( J, 8 ) = C( J, 8 ) - SUM*T8
+ C( J, 9 ) = C( J, 9 ) - SUM*T9
+ 380 CONTINUE
+ GO TO 410
+ 390 CONTINUE
+*
+* Special code for 10 x 10 Householder
+*
+ V1 = V( 1 )
+ T1 = TAU*DCONJG( V1 )
+ V2 = V( 2 )
+ T2 = TAU*DCONJG( V2 )
+ V3 = V( 3 )
+ T3 = TAU*DCONJG( V3 )
+ V4 = V( 4 )
+ T4 = TAU*DCONJG( V4 )
+ V5 = V( 5 )
+ T5 = TAU*DCONJG( V5 )
+ V6 = V( 6 )
+ T6 = TAU*DCONJG( V6 )
+ V7 = V( 7 )
+ T7 = TAU*DCONJG( V7 )
+ V8 = V( 8 )
+ T8 = TAU*DCONJG( V8 )
+ V9 = V( 9 )
+ T9 = TAU*DCONJG( V9 )
+ V10 = V( 10 )
+ T10 = TAU*DCONJG( V10 )
+ DO 400 J = 1, M
+ SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
+ $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
+ $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
+ $ V10*C( J, 10 )
+ C( J, 1 ) = C( J, 1 ) - SUM*T1
+ C( J, 2 ) = C( J, 2 ) - SUM*T2
+ C( J, 3 ) = C( J, 3 ) - SUM*T3
+ C( J, 4 ) = C( J, 4 ) - SUM*T4
+ C( J, 5 ) = C( J, 5 ) - SUM*T5
+ C( J, 6 ) = C( J, 6 ) - SUM*T6
+ C( J, 7 ) = C( J, 7 ) - SUM*T7
+ C( J, 8 ) = C( J, 8 ) - SUM*T8
+ C( J, 9 ) = C( J, 9 ) - SUM*T9
+ C( J, 10 ) = C( J, 10 ) - SUM*T10
+ 400 CONTINUE
+ GO TO 410
+ END IF
+ 410 CONTINUE
+ RETURN
+*
+* End of ZLARFX
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.c
new file mode 100644
index 0000000000000000000000000000000000000000..7026b25fea56048216572c4963f9676885a73b4b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.c
@@ -0,0 +1,264 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zlascl_(type, kl, ku, cfrom, cto, m, n, a, lda, info)
+const char *type;
+const integer *kl, *ku;
+doublereal *cfrom, *cto;
+const integer *m, *n;
+doublecomplex *a;
+const integer *lda;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static logical done;
+ static doublereal ctoc;
+ static integer i, j;
+ static integer itype, k1, k2, k3, k4;
+ static doublereal cfrom1;
+ static doublereal cfromc;
+ static doublereal bignum, smlnum, mul, cto1;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* February 29, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLASCL multiplies the M by N complex matrix A by the real scalar */
+/* CTO/CFROM. This is done without over/underflow as long as the final */
+/* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that */
+/* A may be full, upper triangular, lower triangular, upper Hessenberg, */
+/* or banded. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* TYPE (input) CHARACTER*1 */
+/* TYPE indices the storage type of the input matrix. */
+/* = 'G': A is a full matrix. */
+/* = 'L': A is a lower triangular matrix. */
+/* = 'U': A is an upper triangular matrix. */
+/* = 'H': A is an upper Hessenberg matrix. */
+/* = 'B': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the lower */
+/* half stored. */
+/* = 'Q': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the upper */
+/* half stored. */
+/* = 'Z': A is a band matrix with lower bandwidth KL and upper */
+/* bandwidth KU. */
+/* */
+/* KL (input) INTEGER */
+/* The lower bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+/* */
+/* KU (input) INTEGER */
+/* The upper bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+/* */
+/* CFROM (input) DOUBLE PRECISION */
+/* CTO (input) DOUBLE PRECISION */
+/* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed */
+/* without over/underflow if the final result CTO*A(I,J)/CFROM */
+/* can be represented without over/underflow. CFROM must be */
+/* nonzero. */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,M) */
+/* The matrix to be multiplied by CTO/CFROM. See TYPE for the */
+/* storage type. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* INFO (output) INTEGER */
+/* 0 - successful exit */
+/* <0 - if INFO = -i, the i-th argument had an illegal value. */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+
+ if (lsame_(type, "G")) {
+ itype = 0;
+ } else if (lsame_(type, "L")) {
+ itype = 1;
+ } else if (lsame_(type, "U")) {
+ itype = 2;
+ } else if (lsame_(type, "H")) {
+ itype = 3;
+ } else if (lsame_(type, "B")) {
+ itype = 4;
+ } else if (lsame_(type, "Q")) {
+ itype = 5;
+ } else if (lsame_(type, "Z")) {
+ itype = 6;
+ } else {
+ itype = -1;
+ }
+
+ if (itype == -1) {
+ *info = -1;
+ } else if (*cfrom == 0.) {
+ *info = -4;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*n < 0 || (itype == 4 && *n != *m) || (itype == 5 && *n != *m) ) {
+ *info = -7;
+ } else if (itype <= 3 && *lda < max(1,*m)) {
+ *info = -9;
+ } else if (itype >= 4) {
+ if (*kl < 0 || *kl > max(*m - 1,0)) {
+ *info = -2;
+ } else /* if(complicated condition) */ {
+ if (*ku < 0 || *ku > max(*n - 1,0) || ( (itype == 4 || itype == 5) && *kl != *ku) ) {
+ *info = -3;
+ } else if ((itype == 4 && *lda < *kl + 1) ||
+ (itype == 5 && *lda < *ku + 1) ||
+ (itype == 6 && *lda < (*kl << 1) + *ku + 1)) {
+ *info = -9;
+ }
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLASCL", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *m == 0) {
+ return;
+ }
+
+/* Get machine parameters */
+
+ smlnum = dlamch_("S");
+ bignum = 1. / smlnum;
+
+ cfromc = *cfrom;
+ ctoc = *cto;
+
+L10:
+ cfrom1 = cfromc * smlnum;
+ cto1 = ctoc / bignum;
+ if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
+ mul = smlnum;
+ done = FALSE_;
+ cfromc = cfrom1;
+ } else if (abs(cto1) > abs(cfromc)) {
+ mul = bignum;
+ done = FALSE_;
+ ctoc = cto1;
+ } else {
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ }
+
+ if (itype == 0) {
+
+/* Full matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 1) {
+
+/* Lower triangular matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = j; i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 2) {
+
+/* Upper triangular matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j && i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 3) {
+
+/* Upper Hessenberg matrix */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= j + 1 && i < *m; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 4) {
+
+/* Lower half of a symmetric band matrix */
+
+ k3 = *kl;
+ k4 = *n;
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i <= k3 && i < k4 - j; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 5) {
+
+/* Upper half of a symmetric band matrix */
+
+ k1 = *ku;
+ k3 = *ku;
+ for (j = 0; j < *n; ++j) {
+ for (i = max(k1 - j,0); i <= k3; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+
+ } else if (itype == 6) {
+
+/* Band matrix */
+
+ k2 = *kl;
+ k1 = k2 + *ku;
+ k3 = k1 + *kl;
+ k4 = k1 + *m;
+ for (j = 0; j < *n; ++j) {
+ for (i = max(k1 - j,k2); i <= k3 && i < k4 - j; ++i) {
+ i__1 = i + j * *lda; /* index [i,j] */
+ a[i__1].r *= mul, a[i__1].i *= mul;
+ }
+ }
+ }
+
+ if (! done) {
+ goto L10;
+ }
+} /* zlascl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.f
new file mode 100644
index 0000000000000000000000000000000000000000..d96ff40ca51afba05e55c6a237e7f847906c81d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlascl.f
@@ -0,0 +1,268 @@
+ SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* February 29, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER TYPE
+ INTEGER INFO, KL, KU, LDA, M, N
+ DOUBLE PRECISION CFROM, CTO
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLASCL multiplies the M by N complex matrix A by the real scalar
+* CTO/CFROM. This is done without over/underflow as long as the final
+* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+* A may be full, upper triangular, lower triangular, upper Hessenberg,
+* or banded.
+*
+* Arguments
+* =========
+*
+* TYPE (input) CHARACTER*1
+* TYPE indices the storage type of the input matrix.
+* = 'G': A is a full matrix.
+* = 'L': A is a lower triangular matrix.
+* = 'U': A is an upper triangular matrix.
+* = 'H': A is an upper Hessenberg matrix.
+* = 'B': A is a symmetric band matrix with lower bandwidth KL
+* and upper bandwidth KU and with the only the lower
+* half stored.
+* = 'Q': A is a symmetric band matrix with lower bandwidth KL
+* and upper bandwidth KU and with the only the upper
+* half stored.
+* = 'Z': A is a band matrix with lower bandwidth KL and upper
+* bandwidth KU.
+*
+* KL (input) INTEGER
+* The lower bandwidth of A. Referenced only if TYPE = 'B',
+* 'Q' or 'Z'.
+*
+* KU (input) INTEGER
+* The upper bandwidth of A. Referenced only if TYPE = 'B',
+* 'Q' or 'Z'.
+*
+* CFROM (input) DOUBLE PRECISION
+* CTO (input) DOUBLE PRECISION
+* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+* without over/underflow if the final result CTO*A(I,J)/CFROM
+* can be represented without over/underflow. CFROM must be
+* nonzero.
+*
+* M (input) INTEGER
+* The number of rows of the matrix A. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix A. N >= 0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,M)
+* The matrix to be multiplied by CTO/CFROM. See TYPE for the
+* storage type.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* INFO (output) INTEGER
+* 0 - successful exit
+* <0 - if INFO = -i, the i-th argument had an illegal value.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL DONE
+ INTEGER I, ITYPE, J, K1, K2, K3, K4
+ DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ DOUBLE PRECISION DLAMCH
+ EXTERNAL LSAME, DLAMCH
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+*
+ IF( LSAME( TYPE, 'G' ) ) THEN
+ ITYPE = 0
+ ELSE IF( LSAME( TYPE, 'L' ) ) THEN
+ ITYPE = 1
+ ELSE IF( LSAME( TYPE, 'U' ) ) THEN
+ ITYPE = 2
+ ELSE IF( LSAME( TYPE, 'H' ) ) THEN
+ ITYPE = 3
+ ELSE IF( LSAME( TYPE, 'B' ) ) THEN
+ ITYPE = 4
+ ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
+ ITYPE = 5
+ ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
+ ITYPE = 6
+ ELSE
+ ITYPE = -1
+ END IF
+*
+ IF( ITYPE.EQ.-1 ) THEN
+ INFO = -1
+ ELSE IF( CFROM.EQ.ZERO ) THEN
+ INFO = -4
+ ELSE IF( M.LT.0 ) THEN
+ INFO = -6
+ ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
+ $ ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
+ INFO = -7
+ ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -9
+ ELSE IF( ITYPE.GE.4 ) THEN
+ IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
+ INFO = -2
+ ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
+ $ ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
+ $ THEN
+ INFO = -3
+ ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
+ $ ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
+ $ ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
+ INFO = -9
+ END IF
+ END IF
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZLASCL', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 .OR. M.EQ.0 )
+ $ RETURN
+*
+* Get machine parameters
+*
+ SMLNUM = DLAMCH( 'S' )
+ BIGNUM = ONE / SMLNUM
+*
+ CFROMC = CFROM
+ CTOC = CTO
+*
+ 10 CONTINUE
+ CFROM1 = CFROMC*SMLNUM
+ CTO1 = CTOC / BIGNUM
+ IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
+ MUL = SMLNUM
+ DONE = .FALSE.
+ CFROMC = CFROM1
+ ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
+ MUL = BIGNUM
+ DONE = .FALSE.
+ CTOC = CTO1
+ ELSE
+ MUL = CTOC / CFROMC
+ DONE = .TRUE.
+ END IF
+*
+ IF( ITYPE.EQ.0 ) THEN
+*
+* Full matrix
+*
+ DO 30 J = 1, N
+ DO 20 I = 1, M
+ A( I, J ) = A( I, J )*MUL
+ 20 CONTINUE
+ 30 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.1 ) THEN
+*
+* Lower triangular matrix
+*
+ DO 50 J = 1, N
+ DO 40 I = J, M
+ A( I, J ) = A( I, J )*MUL
+ 40 CONTINUE
+ 50 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.2 ) THEN
+*
+* Upper triangular matrix
+*
+ DO 70 J = 1, N
+ DO 60 I = 1, MIN( J, M )
+ A( I, J ) = A( I, J )*MUL
+ 60 CONTINUE
+ 70 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.3 ) THEN
+*
+* Upper Hessenberg matrix
+*
+ DO 90 J = 1, N
+ DO 80 I = 1, MIN( J+1, M )
+ A( I, J ) = A( I, J )*MUL
+ 80 CONTINUE
+ 90 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.4 ) THEN
+*
+* Lower half of a symmetric band matrix
+*
+ K3 = KL + 1
+ K4 = N + 1
+ DO 110 J = 1, N
+ DO 100 I = 1, MIN( K3, K4-J )
+ A( I, J ) = A( I, J )*MUL
+ 100 CONTINUE
+ 110 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.5 ) THEN
+*
+* Upper half of a symmetric band matrix
+*
+ K1 = KU + 2
+ K3 = KU + 1
+ DO 130 J = 1, N
+ DO 120 I = MAX( K1-J, 1 ), K3
+ A( I, J ) = A( I, J )*MUL
+ 120 CONTINUE
+ 130 CONTINUE
+*
+ ELSE IF( ITYPE.EQ.6 ) THEN
+*
+* Band matrix
+*
+ K1 = KL + KU + 2
+ K2 = KL + 1
+ K3 = 2*KL + KU + 1
+ K4 = KL + KU + 1 + M
+ DO 150 J = 1, N
+ DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
+ A( I, J ) = A( I, J )*MUL
+ 140 CONTINUE
+ 150 CONTINUE
+*
+ END IF
+*
+ IF( .NOT.DONE )
+ $ GO TO 10
+*
+ RETURN
+*
+* End of ZLASCL
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.c
new file mode 100644
index 0000000000000000000000000000000000000000..794bff26af935769694bc6c06a962ae7ec6f652c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.c
@@ -0,0 +1,110 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zlaset_(uplo, m, n, alpha, beta, a, lda)
+const char *uplo;
+const integer *m, *n;
+doublecomplex *alpha, *beta, *a;
+const integer *lda;
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i, j;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLASET initializes a 2-D array A to BETA on the diagonal and */
+/* ALPHA on the offdiagonals. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be set. */
+/* = 'U': Upper triangular part is set. The lower triangle */
+/* is unchanged. */
+/* = 'L': Lower triangular part is set. The upper triangle */
+/* is unchanged. */
+/* Otherwise: All of the matrix A is set. */
+/* */
+/* M (input) INTEGER */
+/* On entry, M specifies the number of rows of A. */
+/* */
+/* N (input) INTEGER */
+/* On entry, N specifies the number of columns of A. */
+/* */
+/* ALPHA (input) COMPLEX*16 */
+/* All the offdiagonal array elements are set to ALPHA. */
+/* */
+/* BETA (input) COMPLEX*16 */
+/* All the diagonal array elements are set to BETA. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j; */
+/* A(i,i) = BETA , 1 <= i <= min(m,n) */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+/* */
+/* ===================================================================== */
+
+ if (lsame_(uplo, "U")) {
+
+/* Set the diagonal to BETA and the strictly upper triangular */
+/* part of the array to ALPHA. */
+
+ for (j = 1; j < *n; ++j) {
+ for (i = 0; i < j && i < *m; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = alpha->r, a[i__1].i = alpha->i;
+ }
+ }
+ for (j = 0; j < *n && j < *m; ++j) {
+ i__1 = j + j * *lda;
+ a[i__1].r = beta->r, a[i__1].i = beta->i;
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/* Set the diagonal to BETA and the strictly lower triangular */
+/* part of the array to ALPHA. */
+
+ for (j = 0; j < *m && j < *n; ++j) {
+ for (i = j + 1; i < *m; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = alpha->r, a[i__1].i = alpha->i;
+ }
+ i__1 = j + j * *lda;
+ a[i__1].r = beta->r, a[i__1].i = beta->i;
+ }
+
+ } else {
+
+/* Set the array to BETA on the diagonal and ALPHA on the */
+/* offdiagonal. */
+
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = alpha->r, a[i__1].i = alpha->i;
+ }
+ }
+ for (j = 0; j < *m && j < *n; ++j) {
+ i__1 = j + j * *lda;
+ a[i__1].r = beta->r, a[i__1].i = beta->i;
+ }
+ }
+} /* zlaset_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.f
new file mode 100644
index 0000000000000000000000000000000000000000..595562d81ced5cafa84bc2e6d99724d492720a76
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlaset.f
@@ -0,0 +1,115 @@
+ SUBROUTINE ZLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER UPLO
+ INTEGER LDA, M, N
+ COMPLEX*16 ALPHA, BETA
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLASET initializes a 2-D array A to BETA on the diagonal and
+* ALPHA on the offdiagonals.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies the part of the matrix A to be set.
+* = 'U': Upper triangular part is set. The lower triangle
+* is unchanged.
+* = 'L': Lower triangular part is set. The upper triangle
+* is unchanged.
+* Otherwise: All of the matrix A is set.
+*
+* M (input) INTEGER
+* On entry, M specifies the number of rows of A.
+*
+* N (input) INTEGER
+* On entry, N specifies the number of columns of A.
+*
+* ALPHA (input) COMPLEX*16
+* All the offdiagonal array elements are set to ALPHA.
+*
+* BETA (input) COMPLEX*16
+* All the diagonal array elements are set to BETA.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the m by n matrix A.
+* On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
+* A(i,i) = BETA , 1 <= i <= min(m,n)
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,M).
+*
+* =====================================================================
+*
+* .. Local Scalars ..
+ INTEGER I, J
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MIN
+* ..
+* .. Executable Statements ..
+*
+ IF( LSAME( UPLO, 'U' ) ) THEN
+*
+* Set the diagonal to BETA and the strictly upper triangular
+* part of the array to ALPHA.
+*
+ DO 20 J = 2, N
+ DO 10 I = 1, MIN( J-1, M )
+ A( I, J ) = ALPHA
+ 10 CONTINUE
+ 20 CONTINUE
+ DO 30 I = 1, MIN( N, M )
+ A( I, I ) = BETA
+ 30 CONTINUE
+*
+ ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+*
+* Set the diagonal to BETA and the strictly lower triangular
+* part of the array to ALPHA.
+*
+ DO 50 J = 1, MIN( M, N )
+ DO 40 I = J + 1, M
+ A( I, J ) = ALPHA
+ 40 CONTINUE
+ 50 CONTINUE
+ DO 60 I = 1, MIN( N, M )
+ A( I, I ) = BETA
+ 60 CONTINUE
+*
+ ELSE
+*
+* Set the array to BETA on the diagonal and ALPHA on the
+* offdiagonal.
+*
+ DO 80 J = 1, N
+ DO 70 I = 1, M
+ A( I, J ) = ALPHA
+ 70 CONTINUE
+ 80 CONTINUE
+ DO 90 I = 1, MIN( M, N )
+ A( I, I ) = BETA
+ 90 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLASET
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.c
new file mode 100644
index 0000000000000000000000000000000000000000..fc1fac5cb6620253bb45878d5aece277a60eb9b8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.c
@@ -0,0 +1,100 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zlassq_(n, x, incx, scale, sumsq)
+const integer *n;
+const doublecomplex *x;
+const integer *incx;
+doublereal *scale, *sumsq;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static doublereal temp1;
+ static integer ix;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* October 31, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLASSQ returns the values scl and ssq such that */
+/* */
+/* ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, */
+/* */
+/* where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is */
+/* assumed to be at least unity and the value of ssq will then satisfy */
+/* */
+/* 1.0 .le. ssq .le. ( sumsq + 2*n ). */
+/* */
+/* scale is assumed to be non-negative and scl returns the value */
+/* */
+/* scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),*/
+/* i */
+/* */
+/* scale and sumsq must be supplied in SCALE and SUMSQ respectively. */
+/* SCALE and SUMSQ are overwritten by scl and ssq respectively. */
+/* */
+/* The routine makes only one pass through the vector X. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The number of elements to be used from the vector X. */
+/* */
+/* X (input) DOUBLE PRECISION */
+/* The vector x as described above. */
+/* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
+/* */
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector X. */
+/* INCX > 0. */
+/* */
+/* SCALE (input/output) DOUBLE PRECISION */
+/* On entry, the value scale in the equation above. */
+/* On exit, SCALE is overwritten with the value scl . */
+/* */
+/* SUMSQ (input/output) DOUBLE PRECISION */
+/* On entry, the value sumsq in the equation above. */
+/* On exit, SUMSQ is overwritten with the value ssq . */
+/* */
+/* ===================================================================== */
+
+ if (*n > 0) {
+ i__1 = (*n - 1) * *incx;
+ for (ix = 0; *incx < 0 ? ix >= i__1 : ix <= i__1; ix += *incx) {
+ if (x[ix].r != 0.) {
+ temp1 = abs(x[ix].r);
+ if (*scale < temp1) {
+ d__1 = *scale / temp1;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = temp1;
+ } else {
+ d__1 = temp1 / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+ if (x[ix].i != 0.) {
+ temp1 = abs(x[ix].i);
+ if (*scale < temp1) {
+ d__1 = *scale / temp1;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = temp1;
+ } else {
+ d__1 = temp1 / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+ }
+ }
+} /* zlassq_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.f
new file mode 100644
index 0000000000000000000000000000000000000000..d586be5a1a5d37732df5af5358419411b172089f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlassq.f
@@ -0,0 +1,102 @@
+ SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* October 31, 1992
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ DOUBLE PRECISION SCALE, SUMSQ
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLASSQ returns the values scl and ssq such that
+*
+* ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+*
+* where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
+* assumed to be at least unity and the value of ssq will then satisfy
+*
+* 1.0 .le. ssq .le. ( sumsq + 2*n ).
+*
+* scale is assumed to be non-negative and scl returns the value
+*
+* scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
+* i
+*
+* scale and sumsq must be supplied in SCALE and SUMSQ respectively.
+* SCALE and SUMSQ are overwritten by scl and ssq respectively.
+*
+* The routine makes only one pass through the vector X.
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The number of elements to be used from the vector X.
+*
+* X (input) DOUBLE PRECISION
+* The vector x as described above.
+* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+*
+* INCX (input) INTEGER
+* The increment between successive values of the vector X.
+* INCX > 0.
+*
+* SCALE (input/output) DOUBLE PRECISION
+* On entry, the value scale in the equation above.
+* On exit, SCALE is overwritten with the value scl .
+*
+* SUMSQ (input/output) DOUBLE PRECISION
+* On entry, the value sumsq in the equation above.
+* On exit, SUMSQ is overwritten with the value ssq .
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO
+ PARAMETER ( ZERO = 0.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER IX
+ DOUBLE PRECISION TEMP1
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DIMAG
+* ..
+* .. Executable Statements ..
+*
+ IF( N.GT.0 ) THEN
+ DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
+ IF( DBLE( X( IX ) ).NE.ZERO ) THEN
+ TEMP1 = ABS( DBLE( X( IX ) ) )
+ IF( SCALE.LT.TEMP1 ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
+ SCALE = TEMP1
+ ELSE
+ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
+ END IF
+ END IF
+ IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
+ TEMP1 = ABS( DIMAG( X( IX ) ) )
+ IF( SCALE.LT.TEMP1 ) THEN
+ SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
+ SCALE = TEMP1
+ ELSE
+ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZLASSQ
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.c
new file mode 100644
index 0000000000000000000000000000000000000000..fcfd957bb6a7fcd2f61d636c20469d7cfcc5bb5d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.c
@@ -0,0 +1,912 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublereal c_b36 = .5;
+
+/* Subroutine */ void zlatrs_(uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info)
+const char *uplo, *trans, *diag, *normin;
+const integer *n;
+const doublecomplex *a;
+const integer *lda;
+doublecomplex *x;
+doublereal *scale, *cnorm;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer jinc;
+ static doublereal xbnd;
+ static integer imax;
+ static doublereal tmax;
+ static doublecomplex tjjs;
+ static doublereal xmax, grow;
+ static integer i, j;
+ static doublereal tscal;
+ static doublecomplex uscal;
+ static integer jlast;
+ static doublecomplex csumj;
+ static logical upper;
+ static doublereal xj;
+ static doublereal bignum;
+ static logical notran;
+ static integer jfirst;
+ static doublereal smlnum;
+ static logical nounit;
+ static doublereal rec, tjj;
+
+/* -- LAPACK auxiliary routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* June 30, 1992 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZLATRS solves one of the triangular systems */
+/* */
+/* A * x = s*b, A**T * x = s*b, or A**H * x = s*b, */
+/* */
+/* with scaling to prevent overflow. Here A is an upper or lower */
+/* triangular matrix, A**T denotes the transpose of A, A**H denotes the */
+/* conjugate transpose of A, x and b are n-element vectors, and s is a */
+/* scaling factor, usually less than or equal to 1, chosen so that the */
+/* components of x will be less than the overflow threshold. If the */
+/* unscaled problem will not cause overflow, the Level 2 BLAS routine */
+/* ZTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j), */
+/* then s is set to 0 and a non-trivial solution to A*x = 0 is returned. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the matrix A is upper or lower triangular. */
+/* = 'U': Upper triangular */
+/* = 'L': Lower triangular */
+/* */
+/* TRANS (input) CHARACTER*1 */
+/* Specifies the operation applied to A. */
+/* = 'N': Solve A * x = s*b (No transpose) */
+/* = 'T': Solve A**T * x = s*b (Transpose) */
+/* = 'C': Solve A**H * x = s*b (Conjugate transpose) */
+/* */
+/* DIAG (input) CHARACTER*1 */
+/* Specifies whether or not the matrix A is unit triangular. */
+/* = 'N': Non-unit triangular */
+/* = 'U': Unit triangular */
+/* */
+/* NORMIN (input) CHARACTER*1 */
+/* Specifies whether CNORM has been set or not. */
+/* = 'Y': CNORM contains the column norms on entry */
+/* = 'N': CNORM is not set on entry. On exit, the norms will */
+/* be computed and stored in CNORM. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+/* */
+/* A (input) COMPLEX*16 array, dimension (LDA,N) */
+/* The triangular matrix A. If UPLO = 'U', the leading n by n */
+/* upper triangular part of the array A contains the upper */
+/* triangular matrix, and the strictly lower triangular part of */
+/* A is not referenced. If UPLO = 'L', the leading n by n lower */
+/* triangular part of the array A contains the lower triangular */
+/* matrix, and the strictly upper triangular part of A is not */
+/* referenced. If DIAG = 'U', the diagonal elements of A are */
+/* also not referenced and are assumed to be 1. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max (1,N). */
+/* */
+/* X (input/output) COMPLEX*16 array, dimension (N) */
+/* On entry, the right hand side b of the triangular system. */
+/* On exit, X is overwritten by the solution vector x. */
+/* */
+/* SCALE (output) DOUBLE PRECISION */
+/* The scaling factor s for the triangular system */
+/* A * x = s*b, A**T * x = s*b, or A**H * x = s*b. */
+/* If SCALE = 0, the matrix A is singular or badly scaled, and */
+/* the vector x is an exact or approximate solution to A*x = 0. */
+/* */
+/* CNORM (input or output) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* If NORMIN = 'Y', CNORM is an input argument and CNORM(j) */
+/* contains the norm of the off-diagonal part of the j-th column */
+/* of A. If TRANS = 'N', CNORM(j) must be greater than or equal */
+/* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j) */
+/* must be greater than or equal to the 1-norm. */
+/* */
+/* If NORMIN = 'N', CNORM is an output argument and CNORM(j) */
+/* returns the 1-norm of the offdiagonal part of the j-th column */
+/* of A. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -k, the k-th argument had an illegal value */
+/* */
+/* Further Details */
+/* ======= ======= */
+/* */
+/* A rough bound on x is computed; if that is less than overflow, ZTRSV */
+/* is called, otherwise, specific code is used which checks for possible */
+/* overflow or divide-by-zero at every operation. */
+/* */
+/* A columnwise scheme is used for solving A*x = b. The basic algorithm */
+/* if A is lower triangular is */
+/* */
+/* x[1:n] := b[1:n] */
+/* for j = 1, ..., n */
+/* x(j) := x(j) / A(j,j) */
+/* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j] */
+/* end */
+/* */
+/* Define bounds on the components of x after j iterations of the loop: */
+/* M(j) = bound on x[1:j] */
+/* G(j) = bound on x[j+1:n] */
+/* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}. */
+/* */
+/* Then for iteration j+1 we have */
+/* M(j+1) <= G(j) / | A(j+1,j+1) | */
+/* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] | */
+/* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | ) */
+/* */
+/* where CNORM(j+1) is greater than or equal to the infinity-norm of */
+/* column j+1 of A, not counting the diagonal. Hence */
+/* */
+/* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | ) */
+/* 1<=i<=j */
+/* and */
+/* */
+/* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| ) */
+/* 1<=i< j */
+/* */
+/* Since |x(j)| <= M(j), we use the Level 2 BLAS routine ZTRSV if the */
+/* reciprocal of the largest M(j), j=1,..,n, is larger than */
+/* max(underflow, 1/overflow). */
+/* */
+/* The bound on x(j) is also used to determine when a step in the */
+/* columnwise method can be performed without fear of overflow. If */
+/* the computed bound is greater than a large constant, x is scaled to */
+/* prevent overflow, but if the bound overflows, x is set to 0, x(j) to */
+/* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found. */
+/* */
+/* Similarly, a row-wise scheme is used to solve A**T *x = b or */
+/* A**H *x = b. The basic algorithm for A upper triangular is */
+/* */
+/* for j = 1, ..., n */
+/* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j) */
+/* end */
+/* */
+/* We simultaneously compute two bounds */
+/* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j */
+/* M(j) = bound on x(i), 1<=i<=j */
+/* */
+/* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we */
+/* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1. */
+/* Then the bound on x(j) is */
+/* */
+/* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) | */
+/* */
+/* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| ) */
+/* 1<=i<=j */
+/* */
+/* and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater */
+/* than max(underflow, 1/overflow). */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ notran = lsame_(trans, "N");
+ nounit = lsame_(diag, "N");
+
+/* Test the input parameters. */
+
+ if (! upper && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ *info = -2;
+ } else if (! nounit && ! lsame_(diag, "U")) {
+ *info = -3;
+ } else if (! lsame_(normin, "Y") && ! lsame_(normin, "N")) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,*n)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLATRS", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return;
+ }
+
+/* Determine machine dependent parameters to control overflow. */
+
+ smlnum = dlamch_("Safe minimum");
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+ smlnum /= dlamch_("Precision");
+ bignum = 1. / smlnum;
+ *scale = 1.;
+
+ if (lsame_(normin, "N")) {
+
+/* Compute the 1-norm of each column, not including the diagonal. */
+
+ if (upper) {
+
+/* A is upper triangular. */
+
+ for (j = 0; j < *n; ++j) {
+ cnorm[j] = dzasum_(&j, &a[j * *lda], &c__1);
+ }
+ } else {
+
+/* A is lower triangular. */
+
+ for (j = 0; j < *n - 1; ++j) {
+ i__1 = *n - j - 1;
+ cnorm[j] = dzasum_(&i__1, &a[j + 1 + j * *lda], &c__1);
+ }
+ cnorm[*n-1] = 0.;
+ }
+ }
+
+/* Scale the column norms by TSCAL if the maximum element in CNORM is */
+/* greater than BIGNUM/2. */
+
+ imax = idamax_(n, &cnorm[1], &c__1) - 1;
+ tmax = cnorm[imax];
+ if (tmax <= bignum * .5) {
+ tscal = 1.;
+ } else {
+ tscal = .5 / (smlnum * tmax);
+ dscal_(n, &tscal, cnorm, &c__1);
+ }
+
+/* Compute a bound on the computed solution vector to see if the */
+/* Level 2 BLAS routine ZTRSV can be used. */
+
+ xmax = 0.;
+ for (j = 0; j < *n; ++j) {
+ xmax = max(xmax, abs(x[j].r / 2.) + abs(x[j].i / 2.));
+ }
+ xbnd = xmax;
+
+ if (notran) {
+
+/* Compute the growth in A * x = b. */
+
+ if (upper) {
+ jfirst = *n - 1;
+ jlast = 0;
+ jinc = -1;
+ } else {
+ jfirst = 0;
+ jlast = *n - 1;
+ jinc = 1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L60;
+ }
+
+ if (nounit) {
+
+/* A is non-unit triangular. */
+
+/* Compute GROW = 1/G(j) and XBND = 1/M(j). */
+/* Initially, G(0) = max{x(i), i=1,...,n}. */
+
+ grow = .5 / max(xbnd,smlnum);
+ xbnd = grow;
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L60;
+ }
+
+ i__1 = j + j * *lda;
+ tjjs.r = a[i__1].r, tjjs.i = a[i__1].i;
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+
+ if (tjj >= smlnum) {
+
+/* M(j) = G(j-1) / abs(A(j,j)) */
+
+ xbnd = min(xbnd, min(1.,tjj) * grow);
+ } else {
+
+/* M(j) could overflow, set XBND to 0. */
+
+ xbnd = 0.;
+ }
+
+ if (tjj + cnorm[j] >= smlnum) {
+
+/* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) */
+
+ grow *= tjj / (tjj + cnorm[j]);
+ } else {
+
+/* G(j) could overflow, set GROW to 0. */
+
+ grow = 0.;
+ }
+ }
+ grow = xbnd;
+ } else {
+
+/* A is unit triangular. */
+
+/* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. */
+
+ grow = min(1., .5/max(xbnd,smlnum));
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L60;
+ }
+
+/* G(j) = G(j-1)*( 1 + CNORM(j) ) */
+
+ grow *= 1. / (cnorm[j] + 1.);
+ }
+ }
+L60:
+ ;
+ } else {
+
+/* Compute the growth in A**T * x = b or A**H * x = b. */
+
+ if (upper) {
+ jfirst = 0;
+ jlast = *n - 1;
+ jinc = 1;
+ } else {
+ jfirst = *n - 1;
+ jlast = 0;
+ jinc = -1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L90;
+ }
+
+ if (nounit) {
+
+/* A is non-unit triangular. */
+
+/* Compute GROW = 1/G(j) and XBND = 1/M(j). */
+/* Initially, M(0) = max{x(i), i=1,...,n}. */
+
+ grow = .5 / max(xbnd,smlnum);
+ xbnd = grow;
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L90;
+ }
+
+/* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) */
+
+ xj = cnorm[j] + 1.;
+ grow = min(grow,xbnd / xj);
+
+ i__1 = j + j * *lda;
+ tjjs.r = a[i__1].r, tjjs.i = a[i__1].i;
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+
+ if (tjj >= smlnum) {
+
+/* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) */
+
+ if (xj > tjj) {
+ xbnd *= tjj / xj;
+ }
+ } else {
+
+/* M(j) could overflow, set XBND to 0. */
+
+ xbnd = 0.;
+ }
+ }
+ grow = min(grow,xbnd);
+ } else {
+
+/* A is unit triangular. */
+
+/* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. */
+
+ grow = min(1., .5/max(xbnd,smlnum));
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L90;
+ }
+
+/* G(j) = ( 1 + CNORM(j) )*G(j-1) */
+
+ xj = cnorm[j] + 1.;
+ grow /= xj;
+ }
+ }
+L90:
+ ;
+ }
+
+ if (grow * tscal > smlnum) {
+
+/* Use the Level 2 BLAS solve if the reciprocal of the bound on */
+/* elements of X is not too small. */
+
+ ztrsv_(uplo, trans, diag, n, a, lda, x, &c__1);
+ } else {
+
+/* Use a Level 1 BLAS solve, scaling intermediate results. */
+
+ if (xmax > bignum * .5) {
+
+/* Scale X so that its components are less than or equal to */
+/* BIGNUM in absolute value. */
+
+ *scale = bignum * .5 / xmax;
+ zdscal_(n, scale, x, &c__1);
+ xmax = bignum;
+ } else {
+ xmax *= 2.;
+ }
+
+ if (notran) {
+
+/* Solve A * x = b */
+
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Compute x(j) = b(j) / A(j,j), scaling x if necessary. */
+
+ xj = abs(x[j].r) + abs(x[j].i);
+ if (nounit) {
+ i__1 = j + j * *lda;
+ tjjs.r = tscal * a[i__1].r, tjjs.i = tscal * a[i__1].i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L110;
+ }
+ }
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale x by 1/b(j). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ xj = abs(x[j].r) + abs(x[j].i );
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM */
+/* to avoid overflow when dividing by A(j,j). */
+
+ rec = tjj * bignum / xj;
+ if (cnorm[j] > 1.) {
+
+/* Scale by 1/CNORM(j) to avoid overflow when */
+/* multiplying x(j) times column j. */
+
+ rec /= cnorm[j];
+ }
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ xj = abs(x[j].r) + abs(x[j].i);
+ } else {
+
+/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
+/* scale = 0, and compute a solution to A*x = 0. */
+
+ for (i = 0; i < *n; ++i) {
+ x[i].r = 0., x[i].i = 0.;
+ }
+ x[j].r = 1., x[j].i = 0.;
+ xj = 1.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L110:
+
+/* Scale x if necessary to avoid overflow when adding a */
+/* multiple of column j of A. */
+
+ if (xj > 1.) {
+ rec = 1. / xj;
+ if (cnorm[j] > (bignum - xmax) * rec) {
+
+/* Scale x by 1/(2*abs(x(j))). */
+
+ rec *= .5;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ }
+ } else if (xj * cnorm[j] > bignum - xmax) {
+
+/* Scale x by 1/2. */
+
+ zdscal_(n, &c_b36, x, &c__1);
+ *scale *= .5;
+ }
+
+ if (upper) {
+ if (j > 0) {
+
+/* Compute the update */
+/* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) */
+
+ z__1.r = - tscal * x[j].r, z__1.i = - tscal * x[j].i;
+ zaxpy_(&j, &z__1, &a[j * *lda], &c__1, x, &c__1);
+ i = izamax_(&j, x, &c__1) - 1;
+ xmax = abs(x[i].r) + abs(x[i].i);
+ }
+ } else {
+ if (j < *n - 1) {
+
+/* Compute the update */
+/* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j) */
+
+ z__1.r = - tscal * x[j].r, z__1.i = - tscal * x[j].i;
+ i__1 = *n - j - 1;
+ zaxpy_(&i__1, &z__1, &a[j + 1 + j * *lda], &c__1, &x[j + 1], &c__1);
+ i = j + izamax_(&i__1, &x[j + 1], &c__1);
+ xmax = abs(x[i].r) + abs(x[i].i);
+ }
+ }
+ }
+
+ } else if (lsame_(trans, "T")) {
+
+/* Solve A**T * x = b */
+
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Compute x(j) = b(j) - sum A(k,j)*x(k). */
+/* k<>j */
+
+ xj = abs(x[j].r) + abs(x[j].i);
+ uscal.r = tscal, uscal.i = 0.;
+ rec = 1. / max(xmax,1.);
+ if (cnorm[j] > (bignum - xj) * rec) {
+
+/* If x(j) could overflow, scale x by 1/(2*XMAX). */
+
+ rec *= .5;
+ if (nounit) {
+ i__1 = j + j * *lda;
+ tjjs.r = tscal * a[i__1].r, tjjs.i = tscal * a[i__1].i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ }
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+ if (tjj > 1.) {
+
+/* Divide by A(j,j) when scaling x if A(j,j) > 1. */
+
+ rec = min(1., rec * tjj);
+ zladiv_(&uscal, &uscal, &tjjs);
+ }
+ if (rec < 1.) {
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+
+ csumj.r = 0., csumj.i = 0.;
+ if (uscal.r == 1. && uscal.i == 0.) {
+
+/* If the scaling needed for A in the dot product is 1, */
+/* call ZDOTU to perform the dot product. */
+
+ if (upper) {
+ zdotu_(&csumj, &j, &a[j * *lda], &c__1, x, &c__1);
+ } else if (j < *n - 1) {
+ i__1 = *n - j - 1;
+ zdotu_(&csumj, &i__1, &a[j + 1 + j * *lda], &c__1, &x[j + 1], &c__1);
+ }
+ } else {
+
+/* Otherwise, use in-line code for the dot product. */
+
+ if (upper) {
+ for (i = 0; i < j - 1; ++i) {
+ i__1 = i + j * *lda;
+ z__1.r = a[i__1].r * uscal.r - a[i__1].i * uscal.i,
+ z__1.i = a[i__1].r * uscal.i + a[i__1].i * uscal.r;
+ csumj.r += z__1.r * x[i].r - z__1.i * x[i].i,
+ csumj.i += z__1.r * x[i].i + z__1.i * x[i].r;
+ }
+ } else if (j < *n - 1) {
+ for (i = j + 1; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ z__1.r = a[i__1].r * uscal.r - a[i__1].i * uscal.i,
+ z__1.i = a[i__1].r * uscal.i + a[i__1].i * uscal.r;
+ csumj.r += z__1.r * x[i].r - z__1.i * x[i].i,
+ csumj.i += z__1.r * x[i].i + z__1.i * x[i].r;
+ }
+ }
+ }
+
+ if (uscal.r == tscal && uscal.i == 0.) {
+
+/* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) */
+/* was not used to scale the dotproduct. */
+
+ x[j].r = x[j].r - csumj.r, x[j].i = x[j].i - csumj.i;
+ xj = abs(x[j].r) + abs(x[j].i);
+ if (nounit) {
+ i__1 = j + j * *lda;
+ tjjs.r = tscal * a[i__1].r, tjjs.i = tscal * a[i__1].i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L160;
+ }
+ }
+
+/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
+
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale X by 1/abs(x(j)). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
+
+ rec = tjj * bignum / xj;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ } else {
+
+/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
+/* scale = 0 and compute a solution to A**T *x = 0. */
+
+ for (i = 0; i < *n; ++i) {
+ x[i].r = 0., x[i].i = 0.;
+ }
+ x[j].r = 1., x[j].i = 0.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L160:
+ ;
+ } else {
+
+/* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot */
+/* product has already been divided by 1/A(j,j). */
+
+ zladiv_(&x[j], &x[j], &tjjs);
+ }
+ xmax = max(xmax, abs(x[j].r) + abs(x[j].i));
+ }
+
+ } else {
+
+/* Solve A**H * x = b */
+
+ for (j = jfirst; j != jlast; j += jinc) {
+
+/* Compute x(j) = b(j) - sum A(k,j)*x(k). */
+/* k<>j */
+
+ xj = abs(x[j].r) + abs(x[j].i);
+ uscal.r = tscal, uscal.i = 0.;
+ rec = 1. / max(xmax,1.);
+ if (cnorm[j] > (bignum - xj) * rec) {
+
+/* If x(j) could overflow, scale x by 1/(2*XMAX). */
+
+ rec *= .5;
+ if (nounit) {
+ i__1 = j + j * *lda;
+ tjjs.r = tscal * a[i__1].r,
+ tjjs.i = - tscal * a[i__1].i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ }
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+ if (tjj > 1.) {
+
+/* Divide by A(j,j) when scaling x if A(j,j) > 1. */
+
+ rec = min(1., rec * tjj);
+ zladiv_(&uscal, &uscal, &tjjs);
+ }
+ if (rec < 1.) {
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+
+ csumj.r = 0., csumj.i = 0.;
+ if (uscal.r == 1. && uscal.i == 0.) {
+
+/* If the scaling needed for A in the dot product is 1, */
+/* call ZDOTC to perform the dot product. */
+
+ if (upper) {
+ zdotc_(&csumj, &j, &a[j**lda], &c__1, x, &c__1);
+ } else if (j < *n - 1) {
+ i__1 = *n - j - 1;
+ zdotc_(&csumj, &i__1, &a[j+1+j**lda], &c__1, &x[j+1], &c__1);
+ }
+ } else {
+
+/* Otherwise, use in-line code for the dot product. */
+
+ if (upper) {
+ for (i = 0; i < j - 1; ++i) {
+ i__1 = i + j * *lda;
+ z__1.r = a[i__1].r * uscal.r + a[i__1].i * uscal.i,
+ z__1.i = a[i__1].r * uscal.i - a[i__1].i * uscal.r;
+ csumj.r += z__1.r * x[i].r - z__1.i * x[i].i,
+ csumj.i += z__1.r * x[i].i + z__1.i * x[i].r;
+ }
+ } else if (j < *n - 1) {
+ for (i = j + 1; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ z__1.r = a[i__1].r * uscal.r + a[i__1].i * uscal.i,
+ z__1.i = a[i__1].r * uscal.i - a[i__1].i * uscal.r;
+ csumj.r += z__1.r * x[i].r - z__1.i * x[i].i,
+ csumj.i += z__1.r * x[i].i + z__1.i * x[i].r;
+ }
+ }
+ }
+
+ if (uscal.r == tscal && uscal.i == 0.) {
+
+/* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j) */
+/* was not used to scale the dotproduct. */
+
+ x[j].r = x[j].r - csumj.r, x[j].i = x[j].i - csumj.i;
+ xj = abs(x[j].r) + abs(x[j].i);
+ if (nounit) {
+ i__1 = j + j * *lda;
+ tjjs.r = tscal * a[i__1].r,
+ tjjs.i = - tscal * a[i__1].i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L210;
+ }
+ }
+
+/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
+
+ tjj = abs(tjjs.r) + abs(tjjs.i);
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale X by 1/abs(x(j)). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
+
+ rec = tjj * bignum / xj;
+ zdscal_(n, &rec, x, &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ zladiv_(&x[j], &x[j], &tjjs);
+ } else {
+
+/* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and */
+/* scale = 0 and compute a solution to A**H *x = 0. */
+
+ for (i = 0; i < *n; ++i) {
+ x[i].r = 0., x[i].i = 0.;
+ }
+ x[j].r = 1., x[j].i = 0.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L210:
+ ;
+ } else {
+
+/* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot */
+/* product has already been divided by 1/A(j,j). */
+
+ zladiv_(&x[j], &x[j], &tjjs);
+ x[j].r -= csumj.r, x[j].i -= csumj.i;
+ }
+ xmax = max(xmax, abs(x[j].r) + abs(x[j].i));
+ }
+ }
+ *scale /= tscal;
+ }
+
+/* Scale the column norms by 1/TSCAL for return. */
+
+ if (tscal != 1.) {
+ d__1 = 1. / tscal;
+ dscal_(n, &d__1, cnorm, &c__1);
+ }
+} /* zlatrs_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.f
new file mode 100644
index 0000000000000000000000000000000000000000..9ae6cc8db7f7b2d536bc03873af248af9cdac933
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zlatrs.f
@@ -0,0 +1,880 @@
+ SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE,
+ $ CNORM, INFO )
+*
+* -- LAPACK auxiliary routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* June 30, 1992
+*
+* .. Scalar Arguments ..
+ CHARACTER DIAG, NORMIN, TRANS, UPLO
+ INTEGER INFO, LDA, N
+ DOUBLE PRECISION SCALE
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION CNORM( * )
+ COMPLEX*16 A( LDA, * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZLATRS solves one of the triangular systems
+*
+* A * x = s*b, A**T * x = s*b, or A**H * x = s*b,
+*
+* with scaling to prevent overflow. Here A is an upper or lower
+* triangular matrix, A**T denotes the transpose of A, A**H denotes the
+* conjugate transpose of A, x and b are n-element vectors, and s is a
+* scaling factor, usually less than or equal to 1, chosen so that the
+* components of x will be less than the overflow threshold. If the
+* unscaled problem will not cause overflow, the Level 2 BLAS routine
+* ZTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+* then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies whether the matrix A is upper or lower triangular.
+* = 'U': Upper triangular
+* = 'L': Lower triangular
+*
+* TRANS (input) CHARACTER*1
+* Specifies the operation applied to A.
+* = 'N': Solve A * x = s*b (No transpose)
+* = 'T': Solve A**T * x = s*b (Transpose)
+* = 'C': Solve A**H * x = s*b (Conjugate transpose)
+*
+* DIAG (input) CHARACTER*1
+* Specifies whether or not the matrix A is unit triangular.
+* = 'N': Non-unit triangular
+* = 'U': Unit triangular
+*
+* NORMIN (input) CHARACTER*1
+* Specifies whether CNORM has been set or not.
+* = 'Y': CNORM contains the column norms on entry
+* = 'N': CNORM is not set on entry. On exit, the norms will
+* be computed and stored in CNORM.
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input) COMPLEX*16 array, dimension (LDA,N)
+* The triangular matrix A. If UPLO = 'U', the leading n by n
+* upper triangular part of the array A contains the upper
+* triangular matrix, and the strictly lower triangular part of
+* A is not referenced. If UPLO = 'L', the leading n by n lower
+* triangular part of the array A contains the lower triangular
+* matrix, and the strictly upper triangular part of A is not
+* referenced. If DIAG = 'U', the diagonal elements of A are
+* also not referenced and are assumed to be 1.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max (1,N).
+*
+* X (input/output) COMPLEX*16 array, dimension (N)
+* On entry, the right hand side b of the triangular system.
+* On exit, X is overwritten by the solution vector x.
+*
+* SCALE (output) DOUBLE PRECISION
+* The scaling factor s for the triangular system
+* A * x = s*b, A**T * x = s*b, or A**H * x = s*b.
+* If SCALE = 0, the matrix A is singular or badly scaled, and
+* the vector x is an exact or approximate solution to A*x = 0.
+*
+* CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+*
+* If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+* contains the norm of the off-diagonal part of the j-th column
+* of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+* to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+* must be greater than or equal to the 1-norm.
+*
+* If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+* returns the 1-norm of the offdiagonal part of the j-th column
+* of A.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -k, the k-th argument had an illegal value
+*
+* Further Details
+* ======= =======
+*
+* A rough bound on x is computed; if that is less than overflow, ZTRSV
+* is called, otherwise, specific code is used which checks for possible
+* overflow or divide-by-zero at every operation.
+*
+* A columnwise scheme is used for solving A*x = b. The basic algorithm
+* if A is lower triangular is
+*
+* x[1:n] := b[1:n]
+* for j = 1, ..., n
+* x(j) := x(j) / A(j,j)
+* x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+* end
+*
+* Define bounds on the components of x after j iterations of the loop:
+* M(j) = bound on x[1:j]
+* G(j) = bound on x[j+1:n]
+* Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+*
+* Then for iteration j+1 we have
+* M(j+1) <= G(j) / | A(j+1,j+1) |
+* G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+* <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+*
+* where CNORM(j+1) is greater than or equal to the infinity-norm of
+* column j+1 of A, not counting the diagonal. Hence
+*
+* G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+* 1<=i<=j
+* and
+*
+* |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+* 1<=i< j
+*
+* Since |x(j)| <= M(j), we use the Level 2 BLAS routine ZTRSV if the
+* reciprocal of the largest M(j), j=1,..,n, is larger than
+* max(underflow, 1/overflow).
+*
+* The bound on x(j) is also used to determine when a step in the
+* columnwise method can be performed without fear of overflow. If
+* the computed bound is greater than a large constant, x is scaled to
+* prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+* 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+*
+* Similarly, a row-wise scheme is used to solve A**T *x = b or
+* A**H *x = b. The basic algorithm for A upper triangular is
+*
+* for j = 1, ..., n
+* x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+* end
+*
+* We simultaneously compute two bounds
+* G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+* M(j) = bound on x(i), 1<=i<=j
+*
+* The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+* add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+* Then the bound on x(j) is
+*
+* M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+*
+* <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+* 1<=i<=j
+*
+* and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater
+* than max(underflow, 1/overflow).
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, HALF, ONE, TWO
+ PARAMETER ( ZERO = 0.0D+0, HALF = 0.5D+0, ONE = 1.0D+0,
+ $ TWO = 2.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL NOTRAN, NOUNIT, UPPER
+ INTEGER I, IMAX, J, JFIRST, JINC, JLAST
+ DOUBLE PRECISION BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
+ $ XBND, XJ, XMAX
+ COMPLEX*16 CSUMJ, TJJS, USCAL, ZDUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IDAMAX, IZAMAX
+ DOUBLE PRECISION DLAMCH, DZASUM
+ COMPLEX*16 ZDOTC, ZDOTU, ZLADIV
+ EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC,
+ $ ZDOTU, ZLADIV
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLABAD, DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1, CABS2
+* ..
+* .. Statement Function definitions ..
+ CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
+ CABS2( ZDUM ) = ABS( DBLE( ZDUM ) / 2.D0 ) +
+ $ ABS( DIMAG( ZDUM ) / 2.D0 )
+* ..
+* .. Executable Statements ..
+*
+ INFO = 0
+ UPPER = LSAME( UPLO, 'U' )
+ NOTRAN = LSAME( TRANS, 'N' )
+ NOUNIT = LSAME( DIAG, 'N' )
+*
+* Test the input parameters.
+*
+ IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
+ INFO = -1
+ ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
+ $ LSAME( TRANS, 'C' ) ) THEN
+ INFO = -2
+ ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
+ INFO = -3
+ ELSE IF( .NOT.LSAME( NORMIN, 'Y' ) .AND. .NOT.
+ $ LSAME( NORMIN, 'N' ) ) THEN
+ INFO = -4
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -5
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -7
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZLATRS', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* Determine machine dependent parameters to control overflow.
+*
+ SMLNUM = DLAMCH( 'Safe minimum' )
+ BIGNUM = ONE / SMLNUM
+ CALL DLABAD( SMLNUM, BIGNUM )
+ SMLNUM = SMLNUM / DLAMCH( 'Precision' )
+ BIGNUM = ONE / SMLNUM
+ SCALE = ONE
+*
+ IF( LSAME( NORMIN, 'N' ) ) THEN
+*
+* Compute the 1-norm of each column, not including the diagonal.
+*
+ IF( UPPER ) THEN
+*
+* A is upper triangular.
+*
+ DO 10 J = 1, N
+ CNORM( J ) = DZASUM( J-1, A( 1, J ), 1 )
+ 10 CONTINUE
+ ELSE
+*
+* A is lower triangular.
+*
+ DO 20 J = 1, N - 1
+ CNORM( J ) = DZASUM( N-J, A( J+1, J ), 1 )
+ 20 CONTINUE
+ CNORM( N ) = ZERO
+ END IF
+ END IF
+*
+* Scale the column norms by TSCAL if the maximum element in CNORM is
+* greater than BIGNUM/2.
+*
+ IMAX = IDAMAX( N, CNORM, 1 )
+ TMAX = CNORM( IMAX )
+ IF( TMAX.LE.BIGNUM*HALF ) THEN
+ TSCAL = ONE
+ ELSE
+ TSCAL = HALF / ( SMLNUM*TMAX )
+ CALL DSCAL( N, TSCAL, CNORM, 1 )
+ END IF
+*
+* Compute a bound on the computed solution vector to see if the
+* Level 2 BLAS routine ZTRSV can be used.
+*
+ XMAX = ZERO
+ DO 30 J = 1, N
+ XMAX = MAX( XMAX, CABS2( X( J ) ) )
+ 30 CONTINUE
+ XBND = XMAX
+*
+ IF( NOTRAN ) THEN
+*
+* Compute the growth in A * x = b.
+*
+ IF( UPPER ) THEN
+ JFIRST = N
+ JLAST = 1
+ JINC = -1
+ ELSE
+ JFIRST = 1
+ JLAST = N
+ JINC = 1
+ END IF
+*
+ IF( TSCAL.NE.ONE ) THEN
+ GROW = ZERO
+ GO TO 60
+ END IF
+*
+ IF( NOUNIT ) THEN
+*
+* A is non-unit triangular.
+*
+* Compute GROW = 1/G(j) and XBND = 1/M(j).
+* Initially, G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = HALF / MAX( XBND, SMLNUM )
+ XBND = GROW
+ DO 40 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 60
+*
+ TJJS = A( J, J )
+ TJJ = CABS1( TJJS )
+*
+ IF( TJJ.GE.SMLNUM ) THEN
+*
+* M(j) = G(j-1) / abs(A(j,j))
+*
+ XBND = MIN( XBND, MIN( ONE, TJJ )*GROW )
+ ELSE
+*
+* M(j) could overflow, set XBND to 0.
+*
+ XBND = ZERO
+ END IF
+*
+ IF( TJJ+CNORM( J ).GE.SMLNUM ) THEN
+*
+* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) )
+*
+ GROW = GROW*( TJJ / ( TJJ+CNORM( J ) ) )
+ ELSE
+*
+* G(j) could overflow, set GROW to 0.
+*
+ GROW = ZERO
+ END IF
+ 40 CONTINUE
+ GROW = XBND
+ ELSE
+*
+* A is unit triangular.
+*
+* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) )
+ DO 50 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 60
+*
+* G(j) = G(j-1)*( 1 + CNORM(j) )
+*
+ GROW = GROW*( ONE / ( ONE+CNORM( J ) ) )
+ 50 CONTINUE
+ END IF
+ 60 CONTINUE
+*
+ ELSE
+*
+* Compute the growth in A**T * x = b or A**H * x = b.
+*
+ IF( UPPER ) THEN
+ JFIRST = 1
+ JLAST = N
+ JINC = 1
+ ELSE
+ JFIRST = N
+ JLAST = 1
+ JINC = -1
+ END IF
+*
+ IF( TSCAL.NE.ONE ) THEN
+ GROW = ZERO
+ GO TO 90
+ END IF
+*
+ IF( NOUNIT ) THEN
+*
+* A is non-unit triangular.
+*
+* Compute GROW = 1/G(j) and XBND = 1/M(j).
+* Initially, M(0) = max{x(i), i=1,...,n}.
+*
+ GROW = HALF / MAX( XBND, SMLNUM )
+ XBND = GROW
+ DO 70 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 90
+*
+* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) )
+*
+ XJ = ONE + CNORM( J )
+ GROW = MIN( GROW, XBND / XJ )
+*
+ TJJS = A( J, J )
+ TJJ = CABS1( TJJS )
+*
+ IF( TJJ.GE.SMLNUM ) THEN
+*
+* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j))
+*
+ IF( XJ.GT.TJJ )
+ $ XBND = XBND*( TJJ / XJ )
+ ELSE
+*
+* M(j) could overflow, set XBND to 0.
+*
+ XBND = ZERO
+ END IF
+ 70 CONTINUE
+ GROW = MIN( GROW, XBND )
+ ELSE
+*
+* A is unit triangular.
+*
+* Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+*
+ GROW = MIN( ONE, HALF / MAX( XBND, SMLNUM ) )
+ DO 80 J = JFIRST, JLAST, JINC
+*
+* Exit the loop if the growth factor is too small.
+*
+ IF( GROW.LE.SMLNUM )
+ $ GO TO 90
+*
+* G(j) = ( 1 + CNORM(j) )*G(j-1)
+*
+ XJ = ONE + CNORM( J )
+ GROW = GROW / XJ
+ 80 CONTINUE
+ END IF
+ 90 CONTINUE
+ END IF
+*
+ IF( ( GROW*TSCAL ).GT.SMLNUM ) THEN
+*
+* Use the Level 2 BLAS solve if the reciprocal of the bound on
+* elements of X is not too small.
+*
+ CALL ZTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
+ ELSE
+*
+* Use a Level 1 BLAS solve, scaling intermediate results.
+*
+ IF( XMAX.GT.BIGNUM*HALF ) THEN
+*
+* Scale X so that its components are less than or equal to
+* BIGNUM in absolute value.
+*
+ SCALE = ( BIGNUM*HALF ) / XMAX
+ CALL ZDSCAL( N, SCALE, X, 1 )
+ XMAX = BIGNUM
+ ELSE
+ XMAX = XMAX*TWO
+ END IF
+*
+ IF( NOTRAN ) THEN
+*
+* Solve A * x = b
+*
+ DO 120 J = JFIRST, JLAST, JINC
+*
+* Compute x(j) = b(j) / A(j,j), scaling x if necessary.
+*
+ XJ = CABS1( X( J ) )
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ IF( TSCAL.EQ.ONE )
+ $ GO TO 110
+ END IF
+ TJJ = CABS1( TJJS )
+ IF( TJJ.GT.SMLNUM ) THEN
+*
+* abs(A(j,j)) > SMLNUM:
+*
+ IF( TJJ.LT.ONE ) THEN
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by 1/b(j).
+*
+ REC = ONE / XJ
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ XJ = CABS1( X( J ) )
+ ELSE IF( TJJ.GT.ZERO ) THEN
+*
+* 0 < abs(A(j,j)) <= SMLNUM:
+*
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
+* to avoid overflow when dividing by A(j,j).
+*
+ REC = ( TJJ*BIGNUM ) / XJ
+ IF( CNORM( J ).GT.ONE ) THEN
+*
+* Scale by 1/CNORM(j) to avoid overflow when
+* multiplying x(j) times column j.
+*
+ REC = REC / CNORM( J )
+ END IF
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ XJ = CABS1( X( J ) )
+ ELSE
+*
+* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+* scale = 0, and compute a solution to A*x = 0.
+*
+ DO 100 I = 1, N
+ X( I ) = ZERO
+ 100 CONTINUE
+ X( J ) = ONE
+ XJ = ONE
+ SCALE = ZERO
+ XMAX = ZERO
+ END IF
+ 110 CONTINUE
+*
+* Scale x if necessary to avoid overflow when adding a
+* multiple of column j of A.
+*
+ IF( XJ.GT.ONE ) THEN
+ REC = ONE / XJ
+ IF( CNORM( J ).GT.( BIGNUM-XMAX )*REC ) THEN
+*
+* Scale x by 1/(2*abs(x(j))).
+*
+ REC = REC*HALF
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ END IF
+ ELSE IF( XJ*CNORM( J ).GT.( BIGNUM-XMAX ) ) THEN
+*
+* Scale x by 1/2.
+*
+ CALL ZDSCAL( N, HALF, X, 1 )
+ SCALE = SCALE*HALF
+ END IF
+*
+ IF( UPPER ) THEN
+ IF( J.GT.1 ) THEN
+*
+* Compute the update
+* x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
+*
+ CALL ZAXPY( J-1, -X( J )*TSCAL, A( 1, J ), 1, X,
+ $ 1 )
+ I = IZAMAX( J-1, X, 1 )
+ XMAX = CABS1( X( I ) )
+ END IF
+ ELSE
+ IF( J.LT.N ) THEN
+*
+* Compute the update
+* x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
+*
+ CALL ZAXPY( N-J, -X( J )*TSCAL, A( J+1, J ), 1,
+ $ X( J+1 ), 1 )
+ I = J + IZAMAX( N-J, X( J+1 ), 1 )
+ XMAX = CABS1( X( I ) )
+ END IF
+ END IF
+ 120 CONTINUE
+*
+ ELSE IF( LSAME( TRANS, 'T' ) ) THEN
+*
+* Solve A**T * x = b
+*
+ DO 170 J = JFIRST, JLAST, JINC
+*
+* Compute x(j) = b(j) - sum A(k,j)*x(k).
+* k<>j
+*
+ XJ = CABS1( X( J ) )
+ USCAL = TSCAL
+ REC = ONE / MAX( XMAX, ONE )
+ IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
+*
+* If x(j) could overflow, scale x by 1/(2*XMAX).
+*
+ REC = REC*HALF
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ END IF
+ TJJ = CABS1( TJJS )
+ IF( TJJ.GT.ONE ) THEN
+*
+* Divide by A(j,j) when scaling x if A(j,j) > 1.
+*
+ REC = MIN( ONE, REC*TJJ )
+ USCAL = ZLADIV( USCAL, TJJS )
+ END IF
+ IF( REC.LT.ONE ) THEN
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+*
+ CSUMJ = ZERO
+ IF( USCAL.EQ.DCMPLX( ONE ) ) THEN
+*
+* If the scaling needed for A in the dot product is 1,
+* call ZDOTU to perform the dot product.
+*
+ IF( UPPER ) THEN
+ CSUMJ = ZDOTU( J-1, A( 1, J ), 1, X, 1 )
+ ELSE IF( J.LT.N ) THEN
+ CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
+ END IF
+ ELSE
+*
+* Otherwise, use in-line code for the dot product.
+*
+ IF( UPPER ) THEN
+ DO 130 I = 1, J - 1
+ CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I )
+ 130 CONTINUE
+ ELSE IF( J.LT.N ) THEN
+ DO 140 I = J + 1, N
+ CSUMJ = CSUMJ + ( A( I, J )*USCAL )*X( I )
+ 140 CONTINUE
+ END IF
+ END IF
+*
+ IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN
+*
+* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
+* was not used to scale the dotproduct.
+*
+ X( J ) = X( J ) - CSUMJ
+ XJ = CABS1( X( J ) )
+ IF( NOUNIT ) THEN
+ TJJS = A( J, J )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ IF( TSCAL.EQ.ONE )
+ $ GO TO 160
+ END IF
+*
+* Compute x(j) = x(j) / A(j,j), scaling if necessary.
+*
+ TJJ = CABS1( TJJS )
+ IF( TJJ.GT.SMLNUM ) THEN
+*
+* abs(A(j,j)) > SMLNUM:
+*
+ IF( TJJ.LT.ONE ) THEN
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale X by 1/abs(x(j)).
+*
+ REC = ONE / XJ
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ ELSE IF( TJJ.GT.ZERO ) THEN
+*
+* 0 < abs(A(j,j)) <= SMLNUM:
+*
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
+*
+ REC = ( TJJ*BIGNUM ) / XJ
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ ELSE
+*
+* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+* scale = 0 and compute a solution to A**T *x = 0.
+*
+ DO 150 I = 1, N
+ X( I ) = ZERO
+ 150 CONTINUE
+ X( J ) = ONE
+ SCALE = ZERO
+ XMAX = ZERO
+ END IF
+ 160 CONTINUE
+ ELSE
+*
+* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
+* product has already been divided by 1/A(j,j).
+*
+ X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ
+ END IF
+ XMAX = MAX( XMAX, CABS1( X( J ) ) )
+ 170 CONTINUE
+*
+ ELSE
+*
+* Solve A**H * x = b
+*
+ DO 220 J = JFIRST, JLAST, JINC
+*
+* Compute x(j) = b(j) - sum A(k,j)*x(k).
+* k<>j
+*
+ XJ = CABS1( X( J ) )
+ USCAL = TSCAL
+ REC = ONE / MAX( XMAX, ONE )
+ IF( CNORM( J ).GT.( BIGNUM-XJ )*REC ) THEN
+*
+* If x(j) could overflow, scale x by 1/(2*XMAX).
+*
+ REC = REC*HALF
+ IF( NOUNIT ) THEN
+ TJJS = DCONJG( A( J, J ) )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ END IF
+ TJJ = CABS1( TJJS )
+ IF( TJJ.GT.ONE ) THEN
+*
+* Divide by A(j,j) when scaling x if A(j,j) > 1.
+*
+ REC = MIN( ONE, REC*TJJ )
+ USCAL = ZLADIV( USCAL, TJJS )
+ END IF
+ IF( REC.LT.ONE ) THEN
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+*
+ CSUMJ = ZERO
+ IF( USCAL.EQ.DCMPLX( ONE ) ) THEN
+*
+* If the scaling needed for A in the dot product is 1,
+* call ZDOTC to perform the dot product.
+*
+ IF( UPPER ) THEN
+ CSUMJ = ZDOTC( J-1, A( 1, J ), 1, X, 1 )
+ ELSE IF( J.LT.N ) THEN
+ CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 )
+ END IF
+ ELSE
+*
+* Otherwise, use in-line code for the dot product.
+*
+ IF( UPPER ) THEN
+ DO 180 I = 1, J - 1
+ CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )*
+ $ X( I )
+ 180 CONTINUE
+ ELSE IF( J.LT.N ) THEN
+ DO 190 I = J + 1, N
+ CSUMJ = CSUMJ + ( DCONJG( A( I, J ) )*USCAL )*
+ $ X( I )
+ 190 CONTINUE
+ END IF
+ END IF
+*
+ IF( USCAL.EQ.DCMPLX( TSCAL ) ) THEN
+*
+* Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
+* was not used to scale the dotproduct.
+*
+ X( J ) = X( J ) - CSUMJ
+ XJ = CABS1( X( J ) )
+ IF( NOUNIT ) THEN
+ TJJS = DCONJG( A( J, J ) )*TSCAL
+ ELSE
+ TJJS = TSCAL
+ IF( TSCAL.EQ.ONE )
+ $ GO TO 210
+ END IF
+*
+* Compute x(j) = x(j) / A(j,j), scaling if necessary.
+*
+ TJJ = CABS1( TJJS )
+ IF( TJJ.GT.SMLNUM ) THEN
+*
+* abs(A(j,j)) > SMLNUM:
+*
+ IF( TJJ.LT.ONE ) THEN
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale X by 1/abs(x(j)).
+*
+ REC = ONE / XJ
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ ELSE IF( TJJ.GT.ZERO ) THEN
+*
+* 0 < abs(A(j,j)) <= SMLNUM:
+*
+ IF( XJ.GT.TJJ*BIGNUM ) THEN
+*
+* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM.
+*
+ REC = ( TJJ*BIGNUM ) / XJ
+ CALL ZDSCAL( N, REC, X, 1 )
+ SCALE = SCALE*REC
+ XMAX = XMAX*REC
+ END IF
+ X( J ) = ZLADIV( X( J ), TJJS )
+ ELSE
+*
+* A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+* scale = 0 and compute a solution to A**H *x = 0.
+*
+ DO 200 I = 1, N
+ X( I ) = ZERO
+ 200 CONTINUE
+ X( J ) = ONE
+ SCALE = ZERO
+ XMAX = ZERO
+ END IF
+ 210 CONTINUE
+ ELSE
+*
+* Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
+* product has already been divided by 1/A(j,j).
+*
+ X( J ) = ZLADIV( X( J ), TJJS ) - CSUMJ
+ END IF
+ XMAX = MAX( XMAX, CABS1( X( J ) ) )
+ 220 CONTINUE
+ END IF
+ SCALE = SCALE / TSCAL
+ END IF
+*
+* Scale the column norms by 1/TSCAL for return.
+*
+ IF( TSCAL.NE.ONE ) THEN
+ CALL DSCAL( N, ONE / TSCAL, CNORM, 1 )
+ END IF
+*
+ RETURN
+*
+* End of ZLATRS
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..a8a572026cf355e48200e9ad8ca552d5ff7bb296
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.c
@@ -0,0 +1,255 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublecomplex c_1 = {1.,0.};
+
+/* Subroutine */ void zqrdc_(x, ldx, n, p, qraux, jpvt, work, job)
+doublecomplex *x;
+const integer *ldx, *n, *p;
+doublecomplex *qraux;
+integer *jpvt;
+doublecomplex *work;
+const integer *job;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1, d__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static logical negj;
+ static integer maxj, j, l;
+ static doublecomplex t;
+ static logical swapj;
+ static doublecomplex nrmxl;
+ static integer jp, pl, pu;
+ static doublereal tt, maxnrm;
+
+/************************************************************************/
+/* */
+/* zqrdc uses householder transformations to compute the qr */
+/* factorization of an n by p matrix x. column pivoting */
+/* based on the 2-norms of the reduced columns may be */
+/* performed at the users option. */
+/* */
+/* on entry */
+/* */
+/* x complex*16(ldx,p), where ldx .ge. n. */
+/* x contains the matrix whose decomposition is to be */
+/* computed. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* jpvt integer(p). */
+/* jpvt contains integers that control the selection */
+/* of the pivot columns. the k-th column x(k) of x */
+/* is placed in one of three classes according to the */
+/* value of jpvt(k). */
+/* */
+/* if jpvt(k) .gt. 0, then x(k) is an initial */
+/* column. */
+/* */
+/* if jpvt(k) .eq. 0, then x(k) is a free column. */
+/* */
+/* if jpvt(k) .lt. 0, then x(k) is a final column. */
+/* */
+/* before the decomposition is computed, initial columns */
+/* are moved to the beginning of the array x and final */
+/* columns to the end. both initial and final columns */
+/* are frozen in place during the computation and only */
+/* free columns are moved. at the k-th stage of the */
+/* reduction, if x(k) is occupied by a free column */
+/* it is interchanged with the free column of largest */
+/* reduced norm. jpvt is not referenced if */
+/* job .eq. 0. */
+/* */
+/* work complex*16(p). */
+/* work is a work array. work is not referenced if */
+/* job .eq. 0. */
+/* */
+/* job integer. */
+/* job is an integer that initiates column pivoting. */
+/* if job .eq. 0, no pivoting is done. */
+/* if job .ne. 0, pivoting is done. */
+/* */
+/* on return */
+/* */
+/* x x contains in its upper triangle the upper */
+/* triangular matrix r of the qr factorization. */
+/* below its diagonal x contains information from */
+/* which the unitary part of the decomposition */
+/* can be recovered. note that if pivoting has */
+/* been requested, the decomposition is not that */
+/* of the original matrix x but that of x */
+/* with its columns permuted as described by jpvt. */
+/* */
+/* qraux complex*16(p). */
+/* qraux contains further information required to recover*/
+/* the unitary part of the decomposition. */
+/* */
+/* jpvt jpvt(k) contains the index of the column of the */
+/* original matrix that has been interchanged into */
+/* the k-th column, if pivoting was requested. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+/* */
+/* zqrdc uses the following functions and subprograms. */
+/* */
+/* blas zaxpy,zdotc,zscal,zswap,dznrm2 */
+/* fortran dmax1,cdabs,dcmplx,cdsqrt,min0 */
+/* */
+/************************************************************************/
+
+ pl = 0;
+ pu = -1;
+
+ if (*job != 0) {
+
+/* pivoting has been requested. rearrange the columns */
+/* according to jpvt. */
+
+ for (j = 0; j < *p; ++j) {
+ swapj = jpvt[j] > 0;
+ negj = jpvt[j] < 0;
+ jpvt[j] = j+1;
+ if (negj) {
+ jpvt[j] = -j-1;
+ }
+ if (! swapj) {
+ continue; /* next j */
+ }
+ if (j != pl) {
+ zswap_(n, &x[pl* *ldx], &c__1, &x[j* *ldx], &c__1);
+ }
+ jpvt[j] = jpvt[pl];
+ jpvt[pl] = j+1;
+ ++pl;
+ }
+ pu = *p - 1;
+ for (j = pu; j >= 0; --j) {
+ if (jpvt[j] >= 0) {
+ continue; /* next j */
+ }
+ jpvt[j] = -jpvt[j];
+ if (j == pu) {
+ --pu; continue; /* next j */
+ }
+ zswap_(n, &x[pu* *ldx], &c__1, &x[j* *ldx], &c__1);
+ jp = jpvt[pu];
+ jpvt[pu] = jpvt[j];
+ jpvt[j] = jp;
+ --pu;
+ }
+ }
+
+/* compute the norms of the free columns. */
+
+ for (j = pl; j <= pu; ++j) {
+ work[j].r = qraux[j].r = dznrm2_(n, &x[j* *ldx], &c__1),
+ work[j].i = qraux[j].i = 0.;
+ }
+
+/* perform the householder reduction of x. */
+
+ for (l = 0; l < *n && l < *p; ++l) {
+ if (l < pl || l >= pu) {
+ goto L120;
+ }
+
+/* locate the column of largest norm and bring it */
+/* into the pivot position. */
+
+ maxnrm = 0.;
+ maxj = l;
+ for (j = l; j <= pu; ++j) {
+ if (qraux[j].r > maxnrm) {
+ maxnrm = qraux[j].r;
+ maxj = j;
+ }
+ }
+ if (maxj != l) {
+ zswap_(n, &x[l* *ldx], &c__1, &x[maxj* *ldx], &c__1);
+ qraux[maxj].r = qraux[l].r, qraux[maxj].i = qraux[l].i;
+ work[maxj].r = work[l].r, work[maxj].i = work[l].i;
+ jp = jpvt[maxj];
+ jpvt[maxj] = jpvt[l];
+ jpvt[l] = jp;
+ }
+L120:
+ qraux[l].r = 0., qraux[l].i = 0.;
+ if (l+1 == *n) {
+ continue; /* next l */
+ }
+
+/* compute the householder transformation for column l. */
+
+ i__1 = *n - l;
+ i__2 = l + l * *ldx;
+ nrmxl.r = dznrm2_(&i__1, &x[i__2], &c__1), nrmxl.i = 0.;
+ if (nrmxl.r == 0.) {
+ continue; /* next l */
+ }
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ d__1 = z_abs(&nrmxl);
+ d__2 = z_abs(&x[i__2]);
+ nrmxl.r = d__1 * x[i__2].r / d__2,
+ nrmxl.i = d__1 * x[i__2].i / d__2;
+ }
+ z_div(&z__1, &c_1, &nrmxl);
+ zscal_(&i__1, &z__1, &x[i__2], &c__1);
+ x[i__2].r += 1.;
+
+/* apply the transformation to the remaining columns, */
+/* updating the norms. */
+
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l;
+ i__2 = l + l * *ldx;
+ zdotc_(&z__1, &i__1, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ z__1.r = -z__1.r, z__1.i = -z__1.i;
+ z_div(&t, &z__1, &x[i__2]);
+ zaxpy_(&i__1, &t, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ if (j < pl || j > pu) {
+ continue; /* next j */
+ }
+ if (qraux[j].r == 0. && qraux[j].i == 0.) {
+ continue; /* next j */
+ }
+ d__1 = z_abs(&x[l+j* *ldx]) / qraux[j].r;
+ tt = 1. - d__1 * d__1;
+ if (tt < 0.) tt = 0.;
+ t.r = tt, t.i = 0.;
+ d__1 = qraux[j].r / work[j].r;
+ tt = tt * .05 * (d__1 * d__1) + 1.;
+ if (tt == 1.) {
+ i__1 = *n - l - 1;
+ i__2 = l + 1 + j * *ldx;
+ work[j].r = qraux[j].r = dznrm2_(&i__1, &x[i__2], &c__1),
+ work[j].i = qraux[j].i = 0.;
+ }
+ else {
+ d__1 = sqrt(t.r);
+ qraux[j].r *= d__1, qraux[j].i *= d__1;
+ }
+ }
+
+/* save the transformation. */
+
+ i__1 = l + l * *ldx;
+ qraux[l].r = x[i__1].r, qraux[l].i = x[i__1].i;
+ x[i__1].r = -nrmxl.r, x[i__1].i = -nrmxl.i;
+ }
+} /* zqrdc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..fd81c52a99a8b2e3489a71f57625340d1837ea8c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrdc.f
@@ -0,0 +1,218 @@
+ subroutine zqrdc(x,ldx,n,p,qraux,jpvt,work,job)
+ integer ldx,n,p,job
+ integer jpvt(1)
+ complex*16 x(ldx,1),qraux(1),work(1)
+c
+c zqrdc uses householder transformations to compute the qr
+c factorization of an n by p matrix x. column pivoting
+c based on the 2-norms of the reduced columns may be
+c performed at the users option.
+c
+c on entry
+c
+c x complex*16(ldx,p), where ldx .ge. n.
+c x contains the matrix whose decomposition is to be
+c computed.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c jpvt integer(p).
+c jpvt contains integers that control the selection
+c of the pivot columns. the k-th column x(k) of x
+c is placed in one of three classes according to the
+c value of jpvt(k).
+c
+c if jpvt(k) .gt. 0, then x(k) is an initial
+c column.
+c
+c if jpvt(k) .eq. 0, then x(k) is a free column.
+c
+c if jpvt(k) .lt. 0, then x(k) is a final column.
+c
+c before the decomposition is computed, initial columns
+c are moved to the beginning of the array x and final
+c columns to the end. both initial and final columns
+c are frozen in place during the computation and only
+c free columns are moved. at the k-th stage of the
+c reduction, if x(k) is occupied by a free column
+c it is interchanged with the free column of largest
+c reduced norm. jpvt is not referenced if
+c job .eq. 0.
+c
+c work complex*16(p).
+c work is a work array. work is not referenced if
+c job .eq. 0.
+c
+c job integer.
+c job is an integer that initiates column pivoting.
+c if job .eq. 0, no pivoting is done.
+c if job .ne. 0, pivoting is done.
+c
+c on return
+c
+c x x contains in its upper triangle the upper
+c triangular matrix r of the qr factorization.
+c below its diagonal x contains information from
+c which the unitary part of the decomposition
+c can be recovered. note that if pivoting has
+c been requested, the decomposition is not that
+c of the original matrix x but that of x
+c with its columns permuted as described by jpvt.
+c
+c qraux complex*16(p).
+c qraux contains further information required to recover
+c the unitary part of the decomposition.
+c
+c jpvt jpvt(k) contains the index of the column of the
+c original matrix that has been interchanged into
+c the k-th column, if pivoting was requested.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c zqrdc uses the following functions and subprograms.
+c
+c blas zaxpy,zdotc,zscal,zswap,dznrm2
+c fortran dabs,dmax1,cdabs,dcmplx,cdsqrt,min0
+c
+c internal variables
+c
+ integer j,jp,l,lp1,lup,maxj,pl,pu
+ double precision maxnrm,dznrm2,tt
+ complex*16 zdotc,nrmxl,t
+ logical negj,swapj
+c
+ complex*16 csign,zdum,zdum1,zdum2
+ double precision cabs1
+ double precision dreal,dimag
+ complex*16 zdumr,zdumi
+ dreal(zdumr) = zdumr
+ dimag(zdumi) = (0.0d0,-1.0d0)*zdumi
+ csign(zdum1,zdum2) = cdabs(zdum1)*(zdum2/cdabs(zdum2))
+ cabs1(zdum) = dabs(dreal(zdum)) + dabs(dimag(zdum))
+c
+ pl = 1
+ pu = 0
+ if (job .eq. 0) go to 60
+c
+c pivoting has been requested. rearrange the columns
+c according to jpvt.
+c
+ do 20 j = 1, p
+ swapj = jpvt(j) .gt. 0
+ negj = jpvt(j) .lt. 0
+ jpvt(j) = j
+ if (negj) jpvt(j) = -j
+ if (.not.swapj) go to 10
+ if (j .ne. pl) call zswap(n,x(1,pl),1,x(1,j),1)
+ jpvt(j) = jpvt(pl)
+ jpvt(pl) = j
+ pl = pl + 1
+ 10 continue
+ 20 continue
+ pu = p
+ do 50 jj = 1, p
+ j = p - jj + 1
+ if (jpvt(j) .ge. 0) go to 40
+ jpvt(j) = -jpvt(j)
+ if (j .eq. pu) go to 30
+ call zswap(n,x(1,pu),1,x(1,j),1)
+ jp = jpvt(pu)
+ jpvt(pu) = jpvt(j)
+ jpvt(j) = jp
+ 30 continue
+ pu = pu - 1
+ 40 continue
+ 50 continue
+ 60 continue
+c
+c compute the norms of the free columns.
+c
+ if (pu .lt. pl) go to 80
+ do 70 j = pl, pu
+ qraux(j) = dcmplx(dznrm2(n,x(1,j),1),0.0d0)
+ work(j) = qraux(j)
+ 70 continue
+ 80 continue
+c
+c perform the householder reduction of x.
+c
+ lup = min0(n,p)
+ do 200 l = 1, lup
+ if (l .lt. pl .or. l .ge. pu) go to 120
+c
+c locate the column of largest norm and bring it
+c into the pivot position.
+c
+ maxnrm = 0.0d0
+ maxj = l
+ do 100 j = l, pu
+ if (dreal(qraux(j)) .le. maxnrm) go to 90
+ maxnrm = dreal(qraux(j))
+ maxj = j
+ 90 continue
+ 100 continue
+ if (maxj .eq. l) go to 110
+ call zswap(n,x(1,l),1,x(1,maxj),1)
+ qraux(maxj) = qraux(l)
+ work(maxj) = work(l)
+ jp = jpvt(maxj)
+ jpvt(maxj) = jpvt(l)
+ jpvt(l) = jp
+ 110 continue
+ 120 continue
+ qraux(l) = (0.0d0,0.0d0)
+ if (l .eq. n) go to 190
+c
+c compute the householder transformation for column l.
+c
+ nrmxl = dcmplx(dznrm2(n-l+1,x(l,l),1),0.0d0)
+ if (cabs1(nrmxl) .eq. 0.0d0) go to 180
+ if (cabs1(x(l,l)) .ne. 0.0d0)
+ * nrmxl = csign(nrmxl,x(l,l))
+ call zscal(n-l+1,(1.0d0,0.0d0)/nrmxl,x(l,l),1)
+ x(l,l) = (1.0d0,0.0d0) + x(l,l)
+c
+c apply the transformation to the remaining columns,
+c updating the norms.
+c
+ lp1 = l + 1
+ if (p .lt. lp1) go to 170
+ do 160 j = lp1, p
+ t = -zdotc(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call zaxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ if (j .lt. pl .or. j .gt. pu) go to 150
+ if (cabs1(qraux(j)) .eq. 0.0d0) go to 150
+ tt = 1.0d0 - (cdabs(x(l,j))/dreal(qraux(j)))**2
+ tt = dmax1(tt,0.0d0)
+ t = dcmplx(tt,0.0d0)
+ tt = 1.0d0
+ * + 0.05d0*tt
+ * *(dreal(qraux(j))/dreal(work(j)))**2
+ if (tt .eq. 1.0d0) go to 130
+ qraux(j) = qraux(j)*cdsqrt(t)
+ go to 140
+ 130 continue
+ qraux(j) = dcmplx(dznrm2(n-l,x(l+1,j),1),0.0d0)
+ work(j) = qraux(j)
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c save the transformation.
+c
+ qraux(l) = x(l,l)
+ x(l,l) = -nrmxl
+ 180 continue
+ 190 continue
+ 200 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.c
new file mode 100644
index 0000000000000000000000000000000000000000..68f85596274f0d165b8274acac72abe73e0e9949
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.c
@@ -0,0 +1,313 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void zqrsl_(x, ldx, n, k, qraux, y, qy, qty, b, rsd, xb, job, info)
+const doublecomplex *x;
+const integer *ldx, *n, *k;
+const doublecomplex *qraux, *y;
+doublecomplex *qy, *qty, *b, *rsd, *xb;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static doublecomplex temp;
+ static logical cqty;
+ static integer i, j;
+ static doublecomplex t;
+ static logical cb;
+ static logical cr;
+ static integer ju;
+ static logical cxb, cqy;
+
+/************************************************************************/
+/* */
+/* zqrsl applies the output of zqrdc to compute coordinate */
+/* transformations, projections, and least squares solutions. */
+/* for k .le. min(n,p), let xk be the matrix */
+/* */
+/* xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) */
+/* */
+/* formed from columns jpvt(1), ... ,jpvt(k) of the original */
+/* n x p matrix x that was input to zqrdc (if no pivoting was */
+/* done, xk consists of the first k columns of x in their */
+/* original order). zqrdc produces a factored unitary matrix q */
+/* and an upper triangular matrix r such that */
+/* */
+/* xk = q * (r) */
+/* (0) */
+/* */
+/* this information is contained in coded form in the arrays */
+/* x and qraux. */
+/* */
+/* on entry */
+/* */
+/* x complex*16(ldx,p). */
+/* x contains the output of zqrdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix xk. it must */
+/* have the same value as n in zqrdc. */
+/* */
+/* k integer. */
+/* k is the number of columns of the matrix xk. k */
+/* must not be greater than min(n,p), where p is the */
+/* same as in the calling sequence to zqrdc. */
+/* */
+/* qraux complex*16(p). */
+/* qraux contains the auxiliary output from zqrdc. */
+/* */
+/* y complex*16(n) */
+/* y contains an n-vector that is to be manipulated */
+/* by zqrsl. */
+/* */
+/* job integer. */
+/* job specifies what is to be computed. job has */
+/* the decimal expansion abcde, with the following */
+/* meaning. */
+/* */
+/* if a.ne.0, compute qy. */
+/* if b,c,d, or e .ne. 0, compute qty. */
+/* if c.ne.0, compute b. */
+/* if d.ne.0, compute rsd. */
+/* if e.ne.0, compute xb. */
+/* */
+/* note that a request to compute b, rsd, or xb */
+/* automatically triggers the computation of qty, */
+/* for which an array must be provided in the */
+/* calling sequence. */
+/* */
+/* on return */
+/* */
+/* qy complex*16(n). */
+/* qy contains q*y, if its computation has been */
+/* requested. */
+/* */
+/* qty complex*16(n). */
+/* qty contains ctrans(q)*y, if its computation has */
+/* been requested. here ctrans(q) is the conjugate */
+/* transpose of the matrix q. */
+/* */
+/* b complex*16(k) */
+/* b contains the solution of the least squares problem */
+/* */
+/* minimize norm2(y - xk*b), */
+/* */
+/* if its computation has been requested. (note that */
+/* if pivoting was requested in zqrdc, the j-th */
+/* component of b will be associated with column jpvt(j) */
+/* of the original matrix x that was input into zqrdc.) */
+/* */
+/* rsd complex*16(n). */
+/* rsd contains the least squares residual y - xk*b, */
+/* if its computation has been requested. rsd is */
+/* also the orthogonal projection of y onto the */
+/* orthogonal complement of the column space of xk. */
+/* */
+/* xb complex*16(n). */
+/* xb contains the least squares approximation xk*b, */
+/* if its computation has been requested. xb is also */
+/* the orthogonal projection of y onto the column space */
+/* of x. */
+/* */
+/* info integer. */
+/* info is zero unless the computation of b has */
+/* been requested and r is exactly singular. in */
+/* this case, info is the index of the first zero */
+/* diagonal element of r and b is left unaltered. */
+/* */
+/* the parameters qy, qty, b, rsd, and xb are not referenced */
+/* if their computation is not requested and in this case */
+/* can be replaced by dummy variables in the calling program. */
+/* to save storage, the user may in some cases use the same */
+/* array for different parameters in the calling sequence. a */
+/* frequently occurring example is when one wishes to compute */
+/* any of b, rsd, or xb and does not need y or qty. in this */
+/* case one may identify y, qty, and one of b, rsd, or xb, while */
+/* providing separate arrays for anything else that is to be */
+/* computed. thus the calling sequence */
+/* */
+/* call zqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info) */
+/* */
+/* will result in the computation of b and rsd, with rsd */
+/* overwriting y. more generally, each item in the following */
+/* list contains groups of permissible identifications for */
+/* a single callinng sequence. */
+/* */
+/* 1. (y,qty,b) (rsd) (xb) (qy) */
+/* 2. (y,qty,rsd) (b) (xb) (qy) */
+/* 3. (y,qty,xb) (b) (rsd) (qy) */
+/* 4. (y,qy) (qty,b) (rsd) (xb) */
+/* 5. (y,qy) (qty,rsd) (b) (xb) */
+/* 6. (y,qy) (qty,xb) (b) (rsd) */
+/* */
+/* in any group the value returned in the array allocated to */
+/* the group corresponds to the last member of the group. */
+/* */
+/* linpack. this version dated 08/14/78 . */
+/* g.w. stewart, university of maryland, argonne national lab. */
+/* */
+/* zqrsl uses the following functions and subprograms. */
+/* */
+/* blas zaxpy,zcopy,zdotc */
+/* fortran min0,mod */
+/* */
+/************************************************************************/
+
+/* set info flag. */
+ *info = 0;
+
+/* determine what is to be computed. */
+
+ cqy = *job / 10000 != 0;
+ cqty = *job % 10000 != 0;
+ cb = *job % 1000 / 100 != 0;
+ cr = *job % 100 / 10 != 0;
+ cxb = *job % 10 != 0;
+ ju = min(*k, *n - 1);
+
+/* special action when n=1. */
+
+ if (ju == 0) {
+ if (cqy) {
+ qy[0].r = y[0].r, qy[0].i = y[0].i;
+ }
+ if (cqty) {
+ qty[0].r = y[0].r, qty[0].i = y[0].i;
+ }
+ if (cxb) {
+ xb[0].r = y[0].r, xb[0].i = y[0].i;
+ }
+ if (cb) {
+ if (x[0].r == 0. && x[0].i == 0.) {
+ *info = 1;
+ }
+ else {
+ z_div(b, y, x);
+ }
+ }
+ if (cr) {
+ rsd[0].r = 0., rsd[0].i = 0.;
+ }
+ return;
+ }
+
+/* set up to compute qy or qty. */
+
+ if (cqy) {
+ zcopy_(n, y, &c__1, qy, &c__1);
+ }
+ if (cqty) {
+ zcopy_(n, y, &c__1, qty, &c__1);
+ }
+
+/* compute qy. */
+
+ if (cqy)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j].r == 0. && qraux[j].i == 0.) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((doublecomplex*)x)[i__1].r = qraux[j].r, ((doublecomplex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ zdotc_(&t, &i__2, &x[i__1], &c__1, &qy[j], &c__1);
+ z_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ zaxpy_(&i__2, &t, &x[i__1], &c__1, &qy[j], &c__1);
+ ((doublecomplex*)x)[i__1].r = temp.r, ((doublecomplex*)x)[i__1].i = temp.i; /* restore original */
+ }
+
+/* compute ctrans(q)*y. */
+
+ if (cqty)
+ for (j = 0; j < ju; ++j) {
+ if (qraux[j].r == 0. && qraux[j].i == 0.) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((doublecomplex*)x)[i__1].r = qraux[j].r, ((doublecomplex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ zdotc_(&t, &i__2, &x[i__1], &c__1, &qty[j], &c__1);
+ z_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ zaxpy_(&i__2, &t, &x[i__1], &c__1, &qty[j], &c__1);
+ ((doublecomplex*)x)[i__1].r = temp.r, ((doublecomplex*)x)[i__1].i = temp.i; /* restore original */
+ }
+
+/* set up to compute b, rsd, or xb. */
+
+ if (cb) {
+ zcopy_(k, qty, &c__1, b, &c__1);
+ }
+ if (cxb) {
+ zcopy_(k, qty, &c__1, xb, &c__1);
+ }
+ if (cr && *k < *n) {
+ i__2 = *n - *k;
+ zcopy_(&i__2, &qty[*k], &c__1, &rsd[*k], &c__1);
+ }
+ if (cxb && *k < *n)
+ for (i = *k; i < *n; ++i) {
+ xb[i].r = 0., xb[i].i = 0.;
+ }
+ if (cr)
+ for (i = 0; i < *k; ++i) {
+ rsd[i].r = 0., rsd[i].i = 0.;
+ }
+
+/* compute b. */
+
+ if (cb)
+ for (j = *k-1; j >= 0; --j) {
+ i__1 = j * *ldx + j; /* index [j,j] */
+ if (x[i__1].r == 0. && x[i__1].i == 0.) {
+ *info = j+1;
+ break; /* last j */
+ }
+ z_div(&b[j], &b[j], &x[i__1]);
+ if (j == 0) {
+ break; /* last j */
+ }
+ t.r = -b[j].r, t.i = -b[j].i;
+ zaxpy_(&j, &t, &x[j* *ldx], &c__1, b, &c__1);
+ }
+
+/* compute rsd or xb as required. */
+
+ if (cr || cxb)
+ for (j = ju-1; j >= 0; --j) {
+ if (qraux[j].r == 0. && qraux[j].i == 0.) {
+ continue; /* next j */
+ }
+ i__1 = j * *ldx + j; /* index [j,j] */
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ((doublecomplex*)x)[i__1].r = qraux[j].r, ((doublecomplex*)x)[i__1].i = qraux[j].i; /* temporarily */
+ i__2 = *n - j;
+ if (cr) {
+ zdotc_(&t, &i__2, &x[i__1], &c__1, &rsd[j], &c__1);
+ z_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ zaxpy_(&i__2, &t, &x[i__1], &c__1, &rsd[j], &c__1);
+ }
+ if (cxb) {
+ zdotc_(&t, &i__2, &x[i__1], &c__1, &xb[j], &c__1);
+ z_div(&t, &t, &x[i__1]);
+ t.r = -t.r, t.i = -t.i;
+ zaxpy_(&i__2, &t, &x[i__1], &c__1, &xb[j], &c__1);
+ }
+ ((doublecomplex*)x)[i__1].r = temp.r, ((doublecomplex*)x)[i__1].i = temp.i; /* restore original */
+ }
+} /* zqrsl_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.f
new file mode 100644
index 0000000000000000000000000000000000000000..7e03c073f9a856af2b488f4d625d6575b16f3b6e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zqrsl.f
@@ -0,0 +1,280 @@
+ subroutine zqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info)
+ integer ldx,n,k,job,info
+ complex*16 x(ldx,1),qraux(1),y(1),qy(1),qty(1),b(1),rsd(1),xb(1)
+c
+c zqrsl applies the output of zqrdc to compute coordinate
+c transformations, projections, and least squares solutions.
+c for k .le. min(n,p), let xk be the matrix
+c
+c xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k)))
+c
+c formed from columns jpvt(1), ... ,jpvt(k) of the original
+c n x p matrix x that was input to zqrdc (if no pivoting was
+c done, xk consists of the first k columns of x in their
+c original order). zqrdc produces a factored unitary matrix q
+c and an upper triangular matrix r such that
+c
+c xk = q * (r)
+c (0)
+c
+c this information is contained in coded form in the arrays
+c x and qraux.
+c
+c on entry
+c
+c x complex*16(ldx,p).
+c x contains the output of zqrdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix xk. it must
+c have the same value as n in zqrdc.
+c
+c k integer.
+c k is the number of columns of the matrix xk. k
+c must nnot be greater than min(n,p), where p is the
+c same as in the calling sequence to zqrdc.
+c
+c qraux complex*16(p).
+c qraux contains the auxiliary output from zqrdc.
+c
+c y complex*16(n)
+c y contains an n-vector that is to be manipulated
+c by zqrsl.
+c
+c job integer.
+c job specifies what is to be computed. job has
+c the decimal expansion abcde, with the following
+c meaning.
+c
+c if a.ne.0, compute qy.
+c if b,c,d, or e .ne. 0, compute qty.
+c if c.ne.0, compute b.
+c if d.ne.0, compute rsd.
+c if e.ne.0, compute xb.
+c
+c note that a request to compute b, rsd, or xb
+c automatically triggers the computation of qty, for
+c which an array must be provided in the calling
+c sequence.
+c
+c on return
+c
+c qy complex*16(n).
+c qy contains q*y, if its computation has been
+c requested.
+c
+c qty complex*16(n).
+c qty contains ctrans(q)*y, if its computation has
+c been requested. here ctrans(q) is the conjugate
+c transpose of the matrix q.
+c
+c b complex*16(k)
+c b contains the solution of the least squares problem
+c
+c minimize norm2(y - xk*b),
+c
+c if its computation has been requested. (note that
+c if pivoting was requested in zqrdc, the j-th
+c component of b will be associated with column jpvt(j)
+c of the original matrix x that was input into zqrdc.)
+c
+c rsd complex*16(n).
+c rsd contains the least squares residual y - xk*b,
+c if its computation has been requested. rsd is
+c also the orthogonal projection of y onto the
+c orthogonal complement of the column space of xk.
+c
+c xb complex*16(n).
+c xb contains the least squares approximation xk*b,
+c if its computation has been requested. xb is also
+c the orthogonal projection of y onto the column space
+c of x.
+c
+c info integer.
+c info is zero unless the computation of b has
+c been requested and r is exactly singular. in
+c this case, info is the index of the first zero
+c diagonal element of r and b is left unaltered.
+c
+c the parameters qy, qty, b, rsd, and xb are not referenced
+c if their computation is not requested and in this case
+c can be replaced by dummy variables in the calling program.
+c to save storage, the user may in some cases use the same
+c array for different parameters in the calling sequence. a
+c frequently occurring example is when one wishes to compute
+c any of b, rsd, or xb and does not need y or qty. in this
+c case one may identify y, qty, and one of b, rsd, or xb, while
+c providing separate arrays for anything else that is to be
+c computed. thus the calling sequence
+c
+c call zqrsl(x,ldx,n,k,qraux,y,dum,y,b,y,dum,110,info)
+c
+c will result in the computation of b and rsd, with rsd
+c overwriting y. more generally, each item in the following
+c list contains groups of permissible identifications for
+c a single callinng sequence.
+c
+c 1. (y,qty,b) (rsd) (xb) (qy)
+c
+c 2. (y,qty,rsd) (b) (xb) (qy)
+c
+c 3. (y,qty,xb) (b) (rsd) (qy)
+c
+c 4. (y,qy) (qty,b) (rsd) (xb)
+c
+c 5. (y,qy) (qty,rsd) (b) (xb)
+c
+c 6. (y,qy) (qty,xb) (b) (rsd)
+c
+c in any group the value returned in the array allocated to
+c the group corresponds to the last member of the group.
+c
+c linpack. this version dated 08/14/78 .
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c zqrsl uses the following functions and subprograms.
+c
+c blas zaxpy,zcopy,zdotc
+c fortran dabs,min0,mod
+c
+c internal variables
+c
+ integer i,j,jj,ju,kp1
+ complex*16 zdotc,t,temp
+ logical cb,cqy,cqty,cr,cxb
+c
+ complex*16 zdum
+ double precision cabs1
+ double precision dreal,dimag
+ complex*16 zdumr,zdumi
+ dreal(zdumr) = zdumr
+ dimag(zdumi) = (0.0d0,-1.0d0)*zdumi
+ cabs1(zdum) = dabs(dreal(zdum)) + dabs(dimag(zdum))
+c
+c set info flag.
+c
+ info = 0
+c
+c determine what is to be computed.
+c
+ cqy = job/10000 .ne. 0
+ cqty = mod(job,10000) .ne. 0
+ cb = mod(job,1000)/100 .ne. 0
+ cr = mod(job,100)/10 .ne. 0
+ cxb = mod(job,10) .ne. 0
+ ju = min0(k,n-1)
+c
+c special action when n=1.
+c
+ if (ju .ne. 0) go to 40
+ if (cqy) qy(1) = y(1)
+ if (cqty) qty(1) = y(1)
+ if (cxb) xb(1) = y(1)
+ if (.not.cb) go to 30
+ if (cabs1(x(1,1)) .ne. 0.0d0) go to 10
+ info = 1
+ go to 20
+ 10 continue
+ b(1) = y(1)/x(1,1)
+ 20 continue
+ 30 continue
+ if (cr) rsd(1) = (0.0d0,0.0d0)
+ go to 250
+ 40 continue
+c
+c set up to compute qy or qty.
+c
+ if (cqy) call zcopy(n,y,1,qy,1)
+ if (cqty) call zcopy(n,y,1,qty,1)
+ if (.not.cqy) go to 70
+c
+c compute qy.
+c
+ do 60 jj = 1, ju
+ j = ju - jj + 1
+ if (cabs1(qraux(j)) .eq. 0.0d0) go to 50
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -zdotc(n-j+1,x(j,j),1,qy(j),1)/x(j,j)
+ call zaxpy(n-j+1,t,x(j,j),1,qy(j),1)
+ x(j,j) = temp
+ 50 continue
+ 60 continue
+ 70 continue
+ if (.not.cqty) go to 100
+c
+c compute ctrans(q)*y.
+c
+ do 90 j = 1, ju
+ if (cabs1(qraux(j)) .eq. 0.0d0) go to 80
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ t = -zdotc(n-j+1,x(j,j),1,qty(j),1)/x(j,j)
+ call zaxpy(n-j+1,t,x(j,j),1,qty(j),1)
+ x(j,j) = temp
+ 80 continue
+ 90 continue
+ 100 continue
+c
+c set up to compute b, rsd, or xb.
+c
+ if (cb) call zcopy(k,qty,1,b,1)
+ kp1 = k + 1
+ if (cxb) call zcopy(k,qty,1,xb,1)
+ if (cr .and. k .lt. n) call zcopy(n-k,qty(kp1),1,rsd(kp1),1)
+ if (.not.cxb .or. kp1 .gt. n) go to 120
+ do 110 i = kp1, n
+ xb(i) = (0.0d0,0.0d0)
+ 110 continue
+ 120 continue
+ if (.not.cr) go to 140
+ do 130 i = 1, k
+ rsd(i) = (0.0d0,0.0d0)
+ 130 continue
+ 140 continue
+ if (.not.cb) go to 190
+c
+c compute b.
+c
+ do 170 jj = 1, k
+ j = k - jj + 1
+ if (cabs1(x(j,j)) .ne. 0.0d0) go to 150
+ info = j
+c ......exit
+ go to 180
+ 150 continue
+ b(j) = b(j)/x(j,j)
+ if (j .eq. 1) go to 160
+ t = -b(j)
+ call zaxpy(j-1,t,x(1,j),1,b,1)
+ 160 continue
+ 170 continue
+ 180 continue
+ 190 continue
+ if (.not.cr .and. .not.cxb) go to 240
+c
+c compute rsd or xb as required.
+c
+ do 230 jj = 1, ju
+ j = ju - jj + 1
+ if (cabs1(qraux(j)) .eq. 0.0d0) go to 220
+ temp = x(j,j)
+ x(j,j) = qraux(j)
+ if (.not.cr) go to 200
+ t = -zdotc(n-j+1,x(j,j),1,rsd(j),1)/x(j,j)
+ call zaxpy(n-j+1,t,x(j,j),1,rsd(j),1)
+ 200 continue
+ if (.not.cxb) go to 210
+ t = -zdotc(n-j+1,x(j,j),1,xb(j),1)/x(j,j)
+ call zaxpy(n-j+1,t,x(j,j),1,xb(j),1)
+ 210 continue
+ x(j,j) = temp
+ 220 continue
+ 230 continue
+ 240 continue
+ 250 continue
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zscal.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zscal.c
new file mode 100644
index 0000000000000000000000000000000000000000..7b088d59b1fea0af857b31bc8a4fd174d88d4a68
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zscal.c
@@ -0,0 +1,42 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved out of zsvdc.c to separate file */
+
+/* Subroutine */ void zscal_(n, za, zx, incx)
+const integer *n;
+const doublecomplex *za;
+doublecomplex *zx;
+const integer *incx;
+{
+ /* System generated locals */
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i, ix;
+
+/* scales a vector by a constant. */
+/* jack dongarra, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0 || *incx <= 0) {
+ return;
+ }
+
+ if (*incx == 1) {
+ for (i = 0; i < *n; ++i) {
+ z__1.r = za->r * zx[i].r - za->i * zx[i].i,
+ z__1.i = za->r * zx[i].i + za->i * zx[i].r;
+ zx[i].r = z__1.r, zx[i].i = z__1.i;
+ }
+ }
+ else {
+ for (i = ix = 0; i < *n; ++i, ix += *incx) {
+ z__1.r = za->r * zx[ix].r - za->i * zx[ix].i,
+ z__1.i = za->r * zx[ix].i + za->i * zx[ix].r;
+ zx[ix].r = z__1.r, zx[ix].i = z__1.i;
+ }
+ }
+} /* zscal_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.c
new file mode 100644
index 0000000000000000000000000000000000000000..b42c6017bc4debf416b17ccd39688a2766aa7182
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.c
@@ -0,0 +1,585 @@
+#include "f2c.h"
+#include "netlib.h"
+extern double sqrt(double); /* #include <math.h> */
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved zswap() zscal() zdrot() zdotc() zaxpy() to separate files */
+
+/*
+ * Calling this ensures that the operands are spilled to
+ * memory and thus avoids excessive precision when compiling
+ * for x86 with heavy optimization (gcc). It is better to do
+ * this than to turn on -ffloat-store.
+ */
+static int fsm_ieee_doubles_equal(const doublereal *x, const doublereal *y);
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublecomplex c_1 = {1.,0.};
+static doublecomplex c_m1 = {-1.,0.};
+
+/* ====================================================================== */
+/* NIST Guide to Available Math Software. */
+/* Fullsource for module ZSVDC from package LINPACK. */
+/* Retrieved from NETLIB on Fri May 9 10:03:02 1997. */
+/* ====================================================================== */
+/* Subroutine */ void zsvdc_(x, ldx, n, p, s, e, u, ldu, v, ldv, work, job, info)
+doublecomplex *x;
+const integer *ldx, *n, *p;
+doublecomplex *s, *e, *u;
+const integer *ldu;
+doublecomplex *v;
+const integer *ldv;
+doublecomplex *work;
+const integer *job;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1, d__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer jobu, iter;
+ static doublereal test;
+ static doublereal b, c;
+ static doublereal f, g;
+ static integer i, j, k, l, m;
+ static doublecomplex r, t;
+ static doublereal scale;
+ static doublereal shift;
+ static integer maxit;
+ static logical wantu, wantv;
+ static doublereal t1, ztest;
+ static doublereal el;
+ static doublereal cs;
+ static integer mm, ls;
+ static doublereal sl;
+ static integer lu;
+ static doublereal sm, sn;
+ static integer nct, ncu, nrt;
+ static doublereal emm1, smm1;
+
+/************************************************************************/
+/* */
+/* zsvdc is a subroutine to reduce a complex*16 nxp matrix x by */
+/* unitary transformations u and v to diagonal form. the */
+/* diagonal elements s(i) are the singular values of x. the */
+/* columns of u are the corresponding left singular vectors, */
+/* and the columns of v the right singular vectors. */
+/* */
+/* on entry */
+/* */
+/* x complex*16(ldx,p), where ldx.ge.n. */
+/* x contains the matrix whose singular value */
+/* decomposition is to be computed. x is */
+/* destroyed by zsvdc. */
+/* */
+/* ldx integer. */
+/* ldx is the leading dimension of the array x. */
+/* */
+/* n integer. */
+/* n is the number of rows of the matrix x. */
+/* */
+/* p integer. */
+/* p is the number of columns of the matrix x. */
+/* */
+/* ldu integer. */
+/* ldu is the leading dimension of the array u */
+/* (see below). */
+/* */
+/* ldv integer. */
+/* ldv is the leading dimension of the array v */
+/* (see below). */
+/* */
+/* work complex*16(n). */
+/* work is a scratch array. */
+/* */
+/* job integer. */
+/* job controls the computation of the singular */
+/* vectors. it has the decimal expansion ab */
+/* with the following meaning */
+/* */
+/* a.eq.0 do not compute the left singular */
+/* vectors. */
+/* a.eq.1 return the n left singular vectors */
+/* in u. */
+/* a.ge.2 returns the first min(n,p) */
+/* left singular vectors in u. */
+/* b.eq.0 do not compute the right singular */
+/* vectors. */
+/* b.eq.1 return the right singular vectors */
+/* in v. */
+/* */
+/* on return */
+/* */
+/* s complex*16(mm), where mm=min(n+1,p). */
+/* the first min(n,p) entries of s contain the */
+/* singular values of x arranged in descending */
+/* order of magnitude. */
+/* */
+/* e complex*16(p). */
+/* e ordinarily contains zeros. however see the */
+/* discussion of info for exceptions. */
+/* */
+/* u complex*16(ldu,k), where ldu.ge.n. if joba.eq.1 */
+/* then k.eq.n, if joba.ge.2 then */
+/* k.eq.min(n,p). */
+/* u contains the matrix of left singular vectors. */
+/* u is not referenced if joba.eq.0. if n.le.p */
+/* or if joba.gt.2, then u may be identified with x */
+/* in the subroutine call. */
+/* */
+/* v complex*16(ldv,p), where ldv.ge.p. */
+/* v contains the matrix of right singular vectors. */
+/* v is not referenced if jobb.eq.0. if p.le.n, */
+/* then v may be identified whth x in the */
+/* subroutine call. */
+/* */
+/* info integer. */
+/* the singular values (and their corresponding */
+/* singular vectors) s(info+1),s(info+2),...,s(m) */
+/* are correct (here m=min(n,p)). thus if */
+/* info.eq.0, all the singular values and their */
+/* vectors are correct. in any event, the matrix */
+/* b = ctrans(u)*x*v is the bidiagonal matrix */
+/* with the elements of s on its diagonal and the */
+/* elements of e on its super-diagonal (ctrans(u) */
+/* is the conjugate-transpose of u). thus the */
+/* singular values of x and b are the same. */
+/* */
+/************************************************************************/
+
+/* linpack. this version dated 03/19/79 . */
+/* correction to shift calculation made 2/85. */
+/* g.w. stewart, university of maryland, argonne national lab. */
+/* */
+/* zsvdc uses the following functions and subprograms. */
+/* */
+/* external zdrot */
+/* blas zaxpy,zdotc,zscal,zswap,dznrm2,drotg */
+/* fortran dmax1,zabs,dcmplx */
+/* fortran dconjg,max0,min0,mod,dsqrt */
+
+/* set the maximum number of iterations. */
+ maxit = 30;
+
+/* determine what is to be computed. */
+
+ wantu = FALSE_;
+ wantv = FALSE_;
+ jobu = *job % 100 / 10;
+ ncu = *n;
+ if (jobu > 1) {
+ ncu = min(*n,*p);
+ }
+ if (jobu != 0) {
+ wantu = TRUE_;
+ }
+ if (*job % 10 != 0) {
+ wantv = TRUE_;
+ }
+
+/* reduce x to bidiagonal form, storing the diagonal elements */
+/* in s and the super-diagonal elements in e. */
+
+ *info = 0;
+ nct = min(*n - 1, *p);
+ nrt = max(0, min(*p - 2, *n));
+ lu = max(nct,nrt);
+
+ for (l = 0; l < lu; ++l) {
+ if (l > nct-1) {
+ goto L20;
+ }
+
+/* compute the transformation for the l-th column and */
+/* place the l-th diagonal in s(l). */
+
+ i__1 = *n - l;
+ s[l].r = dznrm2_(&i__1, &x[l+l* *ldx], &c__1);
+ s[l].i = 0.;
+ if (s[l].r == 0.) {
+ goto L10;
+ }
+ i__2 = l + l * *ldx; /* index [l,l] */
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ d__1 = z_abs(&s[l]);
+ d__2 = z_abs(&x[i__2]);
+ s[l].r = d__1 * x[i__2].r / d__2,
+ s[l].i = d__1 * x[i__2].i / d__2;
+ }
+ z_div(&z__1, &c_1, &s[l]);
+ i__1 = *n - l;
+ zscal_(&i__1, &z__1, &x[i__2], &c__1);
+ x[i__2].r += 1.;
+L10:
+ s[l].r = -s[l].r, s[l].i = -s[l].i;
+L20:
+ for (j = l+1; j < *p; ++j) {
+
+/* apply the transformation. */
+
+ if (l < nct && (s[l].r != 0. || s[l].i != 0.)) {
+ i__1 = *n - l;
+ i__2 = l + l * *ldx; /* index [l,l] */
+ zdotc_(&t, &i__1, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ z_div(&t, &t, &x[i__2]);
+ zaxpy_(&i__1, &t, &x[i__2], &c__1, &x[l+j* *ldx], &c__1);
+ }
+
+/* place the l-th row of x into e for the */
+/* subsequent calculation of the row transformation. */
+
+ d_cnjg(&e[j], &x[l+j* *ldx]);
+ }
+
+/* place the transformation in u for subsequent back */
+/* multiplication. */
+
+ if (wantu && l < nct)
+ for (i = l; i < *n; ++i) {
+ i__1 = i + l * *ldu; /* index [i,l] */
+ i__2 = i + l * *ldx; /* index [i,l] */
+ u[i__1].r = x[i__2].r, u[i__1].i = x[i__2].i;
+ }
+
+ if (l >= nrt) {
+ continue; /* next l */
+ }
+
+/* compute the l-th row transformation and place the */
+/* l-th super-diagonal in e(l). */
+
+ i__1 = *p - l - 1;
+ e[l].r = dznrm2_(&i__1, &e[l+1], &c__1);
+ e[l].i = 0.;
+ if (e[l].r != 0.) {
+ if (e[l+1].r != 0. || e[l+1].i != 0.) {
+ d__1 = z_abs(&e[l]); d__2 = z_abs(&e[l+1]);
+ e[l].r = d__1 * e[l+1].r / d__2,
+ e[l].i = d__1 * e[l+1].i / d__2;
+ }
+ i__1 = *p - l - 1;
+ z_div(&z__1, &c_1, &e[l]);
+ zscal_(&i__1, &z__1, &e[l+1], &c__1);
+ e[l+1].r += 1.;
+ }
+ e[l].r = -e[l].r; /* e[l] = - conj(e[l]) */
+ if (l >= *n-1 || (e[l].r == 0. && e[l].i == 0.)) {
+ goto L120;
+ }
+
+/* apply the transformation. */
+
+ for (i = l+1; i < *n; ++i) {
+ work[i].r = 0., work[i].i = 0.;
+ }
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *n - l - 1;
+ zaxpy_(&i__1, &e[j], &x[l+1 +j* *ldx], &c__1, &work[l+1], &c__1);
+ }
+ for (j = l+1; j < *p; ++j) {
+ z__1.r = -e[j].r, z__1.i = -e[j].i;
+ z_div(&z__1, &z__1, &e[l+1]);
+ z__1.i = -z__1.i; /* d_cnjg(&z__1, &z__1); */
+ i__1 = *n - l - 1;
+ zaxpy_(&i__1, &z__1, &work[l+1], &c__1, &x[l+1 +j* *ldx], &c__1);
+ }
+
+/* place the transformation in v for subsequent */
+/* back multiplication. */
+
+L120:
+ if (wantv)
+ for (i = l+1; i < *p; ++i) {
+ i__1 = i + l * *ldv; /* index [i,l] */
+ v[i__1].r = e[i].r, v[i__1].i = e[i].i;
+ }
+ }
+
+/* set up the final bidiagonal matrix or order m. */
+
+ m = min(*p-1, *n);
+ if (nct < *p) {
+ i__1 = nct * (*ldx+1); /* index [nct,nct] */
+ s[nct].r = x[i__1].r, s[nct].i = x[i__1].i;
+ }
+ if (*n-1 < m) {
+ s[m].r = 0., s[m].i = 0.;
+ }
+ if (nrt < m) {
+ i__1 = nrt + m * *ldx; /* index [nrt,m] */
+ e[nrt].r = x[i__1].r, e[nrt].i = x[i__1].i;
+ }
+ e[m].r = 0., e[m].i = 0.;
+
+/* if required, generate u. */
+
+ if (wantu)
+ for (j = nct; j < ncu; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + j * *ldu; /* index [i,j] */
+ u[i__1].r = 0., u[i__1].i = 0.;
+ }
+ i__1 = j + j * *ldu; /* index [j,j] */
+ u[i__1].r = 1., u[i__1].i = 0.;
+ }
+ if (wantu)
+ for (l = nct-1; l >= 0; --l) {
+ if (s[l].r == 0. && s[l].i == 0.) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + l * *ldu; /* index [i,l] */
+ u[i__1].r = 0., u[i__1].i = 0.;
+ }
+ i__1 = l + l * *ldu; /* index [l,l] */
+ u[i__1].r = 1., u[i__1].i = 0.;
+ continue; /* next l */
+ }
+ i__1 = *n - l;
+ i__2 = l + l * *ldu; /* index [l,l] */
+ for (j = l+1; j < ncu; ++j) {
+ zdotc_(&t, &i__1, &u[i__2], &c__1, &u[l+j* *ldu], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ z_div(&t, &t, &u[i__2]);
+ zaxpy_(&i__1, &t, &u[i__2], &c__1, &u[l+j* *ldu], &c__1);
+ }
+ zscal_(&i__1, &c_m1, &u[i__2], &c__1);
+ u[i__2].r += 1.;
+ for (i = 0; i < l; ++i) {
+ i__1 = i + l * *ldu; /* index [i,l] */
+ u[i__1].r = 0., u[i__1].i = 0.;
+ }
+ }
+
+/* if it is required, generate v. */
+
+ if (wantv)
+ for (l = *p-1; l >= 0; --l) {
+ if (l < nrt && (e[l].r != 0. || e[l].i != 0.))
+ for (j = l+1; j < *p; ++j) {
+ i__1 = *p - l - 1;
+ i__2 = l+1 + l * *ldv; /* index [l+1,l] */
+ zdotc_(&t, &i__1, &v[i__2], &c__1, &v[l+1 +j* *ldv], &c__1);
+ t.r = -t.r, t.i = -t.i;
+ z_div(&t, &t, &v[i__2]);
+ zaxpy_(&i__1, &t, &v[i__2], &c__1, &v[l+1 +j* *ldv], &c__1);
+ }
+ for (i = 0; i < *p; ++i) {
+ i__1 = i + l * *ldv; /* index [i,l] */
+ v[i__1].r = 0., v[i__1].i = 0.;
+ }
+ i__1 = l + l * *ldv; /* index [l,l] */
+ v[i__1].r = 1., v[i__1].i = 0.;
+ }
+
+/* transform s and e so that they are double precision. */
+
+ for (i = 0; i <= m; ++i) {
+ if (s[i].r != 0. || s[i].i != 0.) {
+ t.r = z_abs(&s[i]), t.i = 0.;
+ z_div(&r, &s[i], &t);
+ s[i].r = t.r, s[i].i = t.i;
+ if (i < m) {
+ z_div(&e[i], &e[i], &r);
+ }
+ if (wantu) {
+ zscal_(n, &r, &u[i* *ldu], &c__1);
+ }
+ }
+ if (i == m) {
+ break; /* last i */
+ }
+ if (e[i].r == 0. && e[i].i == 0.) {
+ continue; /* next i */
+ }
+ t.r = z_abs(&e[i]), t.i = 0.;
+ z_div(&r, &t, &e[i]);
+ e[i].r = t.r, e[i].i = t.i;
+ z__1.r = s[i+1].r * r.r - s[i+1].i * r.i,
+ z__1.i = s[i+1].r * r.i + s[i+1].i * r.r;
+ s[i+1].r = z__1.r, s[i+1].i = z__1.i;
+ if (wantv) {
+ zscal_(p, &r, &v[(i+1)* *ldv], &c__1);
+ }
+ }
+
+/* main iteration loop for the singular values. */
+
+ mm = m;
+ iter = 0;
+
+/* quit if all the singular values have been found. */
+
+L400:
+ if (m == -1) {
+ return; /* exit from zsvdc */
+ }
+
+/* if too many iterations have been performed, set */
+/* flag and return. */
+
+ if (iter >= maxit) {
+ *info = m+1;
+ return; /* exit from zsvdc */
+ }
+
+/* this section of the program inspects for */
+/* negligible elements in the s and e arrays. on */
+/* completion the variables kase and l are set as follows. */
+
+/* kase = 1 if s(m) and e(l-1) are negligible and l.lt.m */
+/* kase = 2 if s(l) is negligible and l.lt.m */
+/* kase = 3 if e(l-1) is negligible, l.lt.m, and */
+/* s(l), ..., s(m) are not negligible (qr step). */
+/* kase = 4 if e(m-1) is negligible (convergence). */
+
+ for (l = m; l > 0; --l) {
+ test = z_abs(&s[l-1]) + z_abs(&s[l]);
+ ztest = test + z_abs(&e[l-1]);
+ if (fsm_ieee_doubles_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ e[l-1].r = 0., e[l-1].i = 0.;
+ break; /* last l */
+ }
+ }
+ if (l == m) { /* kase = 4 */ /* convergence. */
+
+/* make the singular value positive */
+
+ if (s[l].r < 0.) {
+ s[l].r = -s[l].r, s[l].i = -s[l].i;
+ if (wantv) {
+ zscal_(p, &c_m1, &v[l* *ldv], &c__1);
+ }
+ }
+
+/* order the singular value. */
+
+ while (l != mm && s[l].r < s[l+1].r) {
+ t.r = s[l].r, t.i = s[l].i;
+ s[l].r = s[l+1].r, s[l].i = s[l+1].i;
+ s[l+1].r = t.r, s[l+1].i = t.i;
+ if (wantv && l < *p-1) {
+ zswap_(p, &v[l* *ldv], &c__1, &v[(l+1)* *ldv], &c__1);
+ }
+ if (wantu && l < *n-1) {
+ zswap_(n, &u[l* *ldu], &c__1, &u[(l+1)* *ldu], &c__1);
+ }
+ ++l;
+ }
+ iter = 0;
+ --m;
+ goto L400;
+ }
+ for (ls = m; ls >= l; --ls) {
+ test = 0.;
+ if (ls != m) {
+ test += z_abs(&e[ls]);
+ }
+ if (ls != l) {
+ test += z_abs(&e[ls-1]);
+ }
+ ztest = test + z_abs(&s[ls]);
+ if (fsm_ieee_doubles_equal(&ztest, &test)) {
+/* WAS: if (ztest == test) { */
+ s[ls].r = 0., s[ls].i = 0.;
+ break; /* last ls */
+ }
+ }
+ if (ls == l-1) { /* kase = 3 */ /* perform one qr step. */
+
+/* calculate the shift. */
+
+ scale = z_abs(&s[m]),
+ scale = max(scale, z_abs(&s[m-1])),
+ scale = max(scale, z_abs(&e[m-1])),
+ scale = max(scale, z_abs(&s[l])),
+ scale = max(scale, z_abs(&e[l]));
+ sm = s[m].r / scale;
+ smm1 = s[m-1].r / scale;
+ emm1 = e[m-1].r / scale;
+ sl = s[l].r / scale;
+ el = e[l].r / scale;
+ b = ((smm1+sm) * (smm1-sm) + emm1*emm1) / 2.;
+ c = sm * emm1; c *= c;
+ shift = 0.;
+ if (b != 0. || c != 0.) {
+ shift = sqrt(b*b + c);
+ if (b < 0.) {
+ shift = -shift;
+ }
+ shift = c / (b + shift);
+ }
+ f = (sl + sm) * (sl - sm) + shift;
+ g = sl * el;
+
+/* chase zeros. */
+
+ for (k = l; k < m; ++k) {
+ drotg_(&f, &g, &cs, &sn);
+ if (k != l) {
+ e[k-1].r = f, e[k-1].i = 0.;
+ }
+ f = cs * s[k].r + sn * e[k].r;
+ e[k].r = cs * e[k].r - sn * s[k].r,
+ e[k].i = cs * e[k].i - sn * s[k].i;
+ g = sn * s[k+1].r;
+ s[k+1].r *= cs, s[k+1].i *= cs;
+ if (wantv) {
+ zdrot_(p, &v[k* *ldv], &c__1, &v[(k+1)* *ldv], &c__1, &cs, &sn);
+ }
+ drotg_(&f, &g, &cs, &sn);
+ s[k].r = f, s[k].i = 0.;
+ f = cs * e[k].r + sn * s[k+1].r;
+ s[k+1].r = -sn * e[k].r + cs * s[k+1].r,
+ s[k+1].i = -sn * e[k].i + cs * s[k+1].i;
+ g = sn * e[k+1].r;
+ e[k+1].r *= cs, e[k+1].i *= cs;
+ if (wantu && k < *n-1) {
+ zdrot_(n, &u[k* *ldu], &c__1, &u[(k+1)* *ldu], &c__1, &cs, &sn);
+ }
+ }
+ e[m-1].r = f, e[m-1].i = 0.;
+ ++iter;
+ }
+ else if (ls == m) { /* kase = 1 */ /* deflate negligible s(m). */
+ f = e[m-1].r;
+ e[m-1].r = 0., e[m-1].i = 0.;
+ for (k = m-1; k >= l; --k) {
+ t1 = s[k].r;
+ drotg_(&t1, &f, &cs, &sn);
+ s[k].r = t1, s[k].i = 0.;
+ if (k != l) {
+ f = -sn * e[k-1].r;
+ e[k-1].r *= cs, e[k-1].i *= cs;
+ }
+ if (wantv) {
+ zdrot_(p, &v[k* *ldv], &c__1, &v[m* *ldv], &c__1, &cs, &sn);
+ }
+ }
+ }
+ else { /* kase = 2 */ /* split at negligible s(l). */
+ /* l = ls + 1; */
+ f = e[ls].r;
+ e[ls].r = 0., e[ls].i = 0.;
+ for (k = ls+1; k <= m; ++k) {
+ t1 = s[k].r;
+ drotg_(&t1, &f, &cs, &sn);
+ s[k].r = t1, s[k].i = 0.;
+ f = -sn * e[k].r;
+ e[k].r *= cs, e[k].i *= cs;
+ if (wantu) {
+ zdrot_(n, &u[k* *ldu], &c__1, &u[ls* *ldu], &c__1, &cs, &sn);
+ }
+ }
+ }
+ goto L400;
+
+} /* zsvdc_ */
+
+static int fsm_ieee_doubles_equal(const double *x, const double *y)
+{
+ return *x == *y;
+}
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.f
new file mode 100644
index 0000000000000000000000000000000000000000..58afd30bb7651ef19ed04fc47f9b936a16a94a7a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zsvdc.f
@@ -0,0 +1,768 @@
+
+* ======================================================================
+* NIST Guide to Available Math Software.
+* Fullsource for module ZSVDC from package LINPACK.
+* Retrieved from NETLIB on Fri May 9 10:03:02 1997.
+* ======================================================================
+ subroutine zsvdc(x,ldx,n,p,s,e,u,ldu,v,ldv,work,job,info)
+ integer ldx,n,p,ldu,ldv,job,info
+ complex*16 x(ldx,1),s(1),e(1),u(ldu,1),v(ldv,1),work(1)
+c
+c
+c zsvdc is a subroutine to reduce a complex*16 nxp matrix x by
+c unitary transformations u and v to diagonal form. the
+c diagonal elements s(i) are the singular values of x. the
+c columns of u are the corresponding left singular vectors,
+c and the columns of v the right singular vectors.
+c
+c on entry
+c
+c x complex*16(ldx,p), where ldx.ge.n.
+c x contains the matrix whose singular value
+c decomposition is to be computed. x is
+c destroyed by zsvdc.
+c
+c ldx integer.
+c ldx is the leading dimension of the array x.
+c
+c n integer.
+c n is the number of rows of the matrix x.
+c
+c p integer.
+c p is the number of columns of the matrix x.
+c
+c ldu integer.
+c ldu is the leading dimension of the array u
+c (see below).
+c
+c ldv integer.
+c ldv is the leading dimension of the array v
+c (see below).
+c
+c work complex*16(n).
+c work is a scratch array.
+c
+c job integer.
+c job controls the computation of the singular
+c vectors. it has the decimal expansion ab
+c with the following meaning
+c
+c a.eq.0 do not compute the left singular
+c vectors.
+c a.eq.1 return the n left singular vectors
+c in u.
+c a.ge.2 returns the first min(n,p)
+c left singular vectors in u.
+c b.eq.0 do not compute the right singular
+c vectors.
+c b.eq.1 return the right singular vectors
+c in v.
+c
+c on return
+c
+c s complex*16(mm), where mm=min(n+1,p).
+c the first min(n,p) entries of s contain the
+c singular values of x arranged in descending
+c order of magnitude.
+c
+c e complex*16(p).
+c e ordinarily contains zeros. however see the
+c discussion of info for exceptions.
+c
+c u complex*16(ldu,k), where ldu.ge.n. if joba.eq.1
+c then k.eq.n, if joba.ge.2 then
+c
+c k.eq.min(n,p).
+c u contains the matrix of left singular vectors.
+c u is not referenced if joba.eq.0. if n.le.p
+c or if joba.gt.2, then u may be identified with x
+c in the subroutine call.
+c
+c v complex*16(ldv,p), where ldv.ge.p.
+c v contains the matrix of right singular vectors.
+c v is not referenced if jobb.eq.0. if p.le.n,
+c then v may be identified whth x in the
+c subroutine call.
+c
+c info integer.
+c the singular values (and their corresponding
+c singular vectors) s(info+1),s(info+2),...,s(m)
+c are correct (here m=min(n,p)). thus if
+c info.eq.0, all the singular values and their
+c vectors are correct. in any event, the matrix
+c b = ctrans(u)*x*v is the bidiagonal matrix
+c with the elements of s on its diagonal and the
+c elements of e on its super-diagonal (ctrans(u)
+c is the conjugate-transpose of u). thus the
+c singular values of x and b are the same.
+c
+c linpack. this version dated 03/19/79 .
+c correction to shift calculation made 2/85.
+c g.w. stewart, university of maryland, argonne national lab.
+c
+c zsvdc uses the following functions and subprograms.
+c
+c external zdrot
+c blas zaxpy,zdotc,zscal,zswap,dznrm2,drotg
+c fortran dabs,dmax1,zabs,dcmplx
+c fortran dconjg,max0,min0,mod,dsqrt
+c
+c internal variables
+c
+ integer i,iter,j,jobu,k,kase,kk,l,ll,lls,lm1,lp1,ls,lu,m,maxit,
+ * mm,mm1,mp1,nct,nctp1,ncu,nrt,nrtp1
+ complex*16 zdotc,t,r
+ double precision b,c,cs,el,emm1,f,g,dznrm2,scale,shift,sl,sm,sn,
+ * smm1,t1,test,ztest
+ logical wantu,wantv
+c
+ complex*16 csign,zdum,zdum1,zdum2
+ double precision cabs1
+ double precision dreal,dimag
+ complex*16 zdumr,zdumi
+ dreal(zdumr) = zdumr
+ dimag(zdumi) = (0.0d0,-1.0d0)*zdumi
+ cabs1(zdum) = dabs(dreal(zdum)) + dabs(dimag(zdum))
+ csign(zdum1,zdum2) = zabs(zdum1)*(zdum2/zabs(zdum2))
+c
+c set the maximum number of iterations.
+c
+ maxit = 30
+c
+c determine what is to be computed.
+c
+ wantu = .false.
+ wantv = .false.
+ jobu = mod(job,100)/10
+ ncu = n
+ if (jobu .gt. 1) ncu = min0(n,p)
+ if (jobu .ne. 0) wantu = .true.
+ if (mod(job,10) .ne. 0) wantv = .true.
+c
+c reduce x to bidiagonal form, storing the diagonal elements
+c in s and the super-diagonal elements in e.
+c
+ info = 0
+ nct = min0(n-1,p)
+ nrt = max0(0,min0(p-2,n))
+ lu = max0(nct,nrt)
+ if (lu .lt. 1) go to 170
+ do 160 l = 1, lu
+ lp1 = l + 1
+ if (l .gt. nct) go to 20
+c
+c compute the transformation for the l-th column and
+c place the l-th diagonal in s(l).
+c
+ s(l) = dcmplx(dznrm2(n-l+1,x(l,l),1),0.0d0)
+ if (cabs1(s(l)) .eq. 0.0d0) go to 10
+ if (cabs1(x(l,l)) .ne. 0.0d0) s(l) = csign(s(l),x(l,l))
+ call zscal(n-l+1,1.0d0/s(l),x(l,l),1)
+ x(l,l) = (1.0d0,0.0d0) + x(l,l)
+ 10 continue
+ s(l) = -s(l)
+ 20 continue
+ if (p .lt. lp1) go to 50
+ do 40 j = lp1, p
+ if (l .gt. nct) go to 30
+ if (cabs1(s(l)) .eq. 0.0d0) go to 30
+c
+c apply the transformation.
+c
+ t = -zdotc(n-l+1,x(l,l),1,x(l,j),1)/x(l,l)
+ call zaxpy(n-l+1,t,x(l,l),1,x(l,j),1)
+ 30 continue
+c
+c place the l-th row of x into e for the
+c subsequent calculation of the row transformation.
+c
+ e(j) = dconjg(x(l,j))
+ 40 continue
+ 50 continue
+ if (.not.wantu .or. l .gt. nct) go to 70
+c
+c place the transformation in u for subsequent back
+c multiplication.
+c
+ do 60 i = l, n
+ u(i,l) = x(i,l)
+ 60 continue
+ 70 continue
+ if (l .gt. nrt) go to 150
+c
+c compute the l-th row transformation and place the
+c l-th super-diagonal in e(l).
+c
+ e(l) = dcmplx(dznrm2(p-l,e(lp1),1),0.0d0)
+ if (cabs1(e(l)) .eq. 0.0d0) go to 80
+ if (cabs1(e(lp1)) .ne. 0.0d0) e(l) = csign(e(l),e(lp1))
+ call zscal(p-l,1.0d0/e(l),e(lp1),1)
+ e(lp1) = (1.0d0,0.0d0) + e(lp1)
+ 80 continue
+ e(l) = -dconjg(e(l))
+ if (lp1 .gt. n .or. cabs1(e(l)) .eq. 0.0d0) go to 120
+c
+c apply the transformation.
+c
+ do 90 i = lp1, n
+ work(i) = (0.0d0,0.0d0)
+ 90 continue
+ do 100 j = lp1, p
+ call zaxpy(n-l,e(j),x(lp1,j),1,work(lp1),1)
+ 100 continue
+ do 110 j = lp1, p
+ call zaxpy(n-l,dconjg(-e(j)/e(lp1)),work(lp1),1,
+ * x(lp1,j),1)
+ 110 continue
+ 120 continue
+ if (.not.wantv) go to 140
+c
+c place the transformation in v for subsequent
+c back multiplication.
+c
+ do 130 i = lp1, p
+ v(i,l) = e(i)
+ 130 continue
+ 140 continue
+ 150 continue
+ 160 continue
+ 170 continue
+c
+c set up the final bidiagonal matrix or order m.
+c
+ m = min0(p,n+1)
+ nctp1 = nct + 1
+ nrtp1 = nrt + 1
+ if (nct .lt. p) s(nctp1) = x(nctp1,nctp1)
+ if (n .lt. m) s(m) = (0.0d0,0.0d0)
+ if (nrtp1 .lt. m) e(nrtp1) = x(nrtp1,m)
+ e(m) = (0.0d0,0.0d0)
+c
+c if required, generate u.
+c
+ if (.not.wantu) go to 300
+ if (ncu .lt. nctp1) go to 200
+ do 190 j = nctp1, ncu
+ do 180 i = 1, n
+ u(i,j) = (0.0d0,0.0d0)
+ 180 continue
+ u(j,j) = (1.0d0,0.0d0)
+ 190 continue
+ 200 continue
+ if (nct .lt. 1) go to 290
+ do 280 ll = 1, nct
+ l = nct - ll + 1
+ if (cabs1(s(l)) .eq. 0.0d0) go to 250
+ lp1 = l + 1
+ if (ncu .lt. lp1) go to 220
+ do 210 j = lp1, ncu
+ t = -zdotc(n-l+1,u(l,l),1,u(l,j),1)/u(l,l)
+ call zaxpy(n-l+1,t,u(l,l),1,u(l,j),1)
+ 210 continue
+ 220 continue
+ call zscal(n-l+1,(-1.0d0,0.0d0),u(l,l),1)
+ u(l,l) = (1.0d0,0.0d0) + u(l,l)
+ lm1 = l - 1
+ if (lm1 .lt. 1) go to 240
+ do 230 i = 1, lm1
+ u(i,l) = (0.0d0,0.0d0)
+ 230 continue
+ 240 continue
+ go to 270
+ 250 continue
+ do 260 i = 1, n
+ u(i,l) = (0.0d0,0.0d0)
+ 260 continue
+ u(l,l) = (1.0d0,0.0d0)
+ 270 continue
+ 280 continue
+ 290 continue
+ 300 continue
+c
+c if it is required, generate v.
+c
+ if (.not.wantv) go to 350
+ do 340 ll = 1, p
+ l = p - ll + 1
+ lp1 = l + 1
+ if (l .gt. nrt) go to 320
+ if (cabs1(e(l)) .eq. 0.0d0) go to 320
+ do 310 j = lp1, p
+ t = -zdotc(p-l,v(lp1,l),1,v(lp1,j),1)/v(lp1,l)
+ call zaxpy(p-l,t,v(lp1,l),1,v(lp1,j),1)
+ 310 continue
+ 320 continue
+ do 330 i = 1, p
+ v(i,l) = (0.0d0,0.0d0)
+ 330 continue
+ v(l,l) = (1.0d0,0.0d0)
+ 340 continue
+ 350 continue
+c
+c transform s and e so that they are double precision.
+c
+ do 380 i = 1, m
+ if (cabs1(s(i)) .eq. 0.0d0) go to 360
+ t = dcmplx(zabs(s(i)),0.0d0)
+ r = s(i)/t
+ s(i) = t
+ if (i .lt. m) e(i) = e(i)/r
+ if (wantu) call zscal(n,r,u(1,i),1)
+ 360 continue
+c ...exit
+ if (i .eq. m) go to 390
+ if (cabs1(e(i)) .eq. 0.0d0) go to 370
+ t = dcmplx(zabs(e(i)),0.0d0)
+ r = t/e(i)
+ e(i) = t
+ s(i+1) = s(i+1)*r
+ if (wantv) call zscal(p,r,v(1,i+1),1)
+ 370 continue
+ 380 continue
+ 390 continue
+c
+c main iteration loop for the singular values.
+c
+ mm = m
+ iter = 0
+ 400 continue
+c
+c quit if all the singular values have been found.
+c
+c ...exit
+ if (m .eq. 0) go to 660
+c
+c if too many iterations have been performed, set
+c flag and return.
+c
+ if (iter .lt. maxit) go to 410
+ info = m
+c ......exit
+ go to 660
+ 410 continue
+c
+c this section of the program inspects for
+c negligible elements in the s and e arrays. on
+c completion the variables kase and l are set as follows.
+c
+c kase = 1 if s(m) and e(l-1) are negligible and l.lt.m
+c kase = 2 if s(l) is negligible and l.lt.m
+c kase = 3 if e(l-1) is negligible, l.lt.m, and
+c s(l), ..., s(m) are not negligible (qr step).
+c kase = 4 if e(m-1) is negligible (convergence).
+c
+ do 430 ll = 1, m
+ l = m - ll
+c ...exit
+ if (l .eq. 0) go to 440
+ test = zabs(s(l)) + zabs(s(l+1))
+ ztest = test + zabs(e(l))
+ if (ztest .ne. test) go to 420
+ e(l) = (0.0d0,0.0d0)
+c ......exit
+ go to 440
+ 420 continue
+ 430 continue
+ 440 continue
+ if (l .ne. m - 1) go to 450
+ kase = 4
+ go to 520
+ 450 continue
+ lp1 = l + 1
+ mp1 = m + 1
+ do 470 lls = lp1, mp1
+ ls = m - lls + lp1
+c ...exit
+ if (ls .eq. l) go to 480
+ test = 0.0d0
+ if (ls .ne. m) test = test + zabs(e(ls))
+ if (ls .ne. l + 1) test = test + zabs(e(ls-1))
+ ztest = test + zabs(s(ls))
+ if (ztest .ne. test) go to 460
+ s(ls) = (0.0d0,0.0d0)
+c ......exit
+ go to 480
+ 460 continue
+ 470 continue
+ 480 continue
+ if (ls .ne. l) go to 490
+ kase = 3
+ go to 510
+ 490 continue
+ if (ls .ne. m) go to 500
+ kase = 1
+ go to 510
+ 500 continue
+ kase = 2
+ l = ls
+ 510 continue
+ 520 continue
+ l = l + 1
+c
+c perform the task indicated by kase.
+c
+ go to (530, 560, 580, 610), kase
+c
+c deflate negligible s(m).
+c
+ 530 continue
+ mm1 = m - 1
+ f = dreal(e(m-1))
+ e(m-1) = (0.0d0,0.0d0)
+ do 550 kk = l, mm1
+ k = mm1 - kk + l
+ t1 = dreal(s(k))
+ call drotg(t1,f,cs,sn)
+ s(k) = dcmplx(t1,0.0d0)
+ if (k .eq. l) go to 540
+ f = -sn*dreal(e(k-1))
+ e(k-1) = cs*e(k-1)
+ 540 continue
+ if (wantv) call zdrot(p,v(1,k),1,v(1,m),1,cs,sn)
+ 550 continue
+ go to 650
+c
+c split at negligible s(l).
+c
+ 560 continue
+ f = dreal(e(l-1))
+ e(l-1) = (0.0d0,0.0d0)
+ do 570 k = l, m
+ t1 = dreal(s(k))
+ call drotg(t1,f,cs,sn)
+ s(k) = dcmplx(t1,0.0d0)
+ f = -sn*dreal(e(k))
+ e(k) = cs*e(k)
+ if (wantu) call zdrot(n,u(1,k),1,u(1,l-1),1,cs,sn)
+ 570 continue
+ go to 650
+c
+c perform one qr step.
+c
+ 580 continue
+c
+c calculate the shift.
+c
+ scale = dmax1(zabs(s(m)),zabs(s(m-1)),zabs(e(m-1)),
+ * zabs(s(l)),zabs(e(l)))
+ sm = dreal(s(m))/scale
+ smm1 = dreal(s(m-1))/scale
+ emm1 = dreal(e(m-1))/scale
+ sl = dreal(s(l))/scale
+ el = dreal(e(l))/scale
+ b = ((smm1 + sm)*(smm1 - sm) + emm1**2)/2.0d0
+ c = (sm*emm1)**2
+ shift = 0.0d0
+ if (b .eq. 0.0d0 .and. c .eq. 0.0d0) go to 590
+ shift = dsqrt(b**2+c)
+ if (b .lt. 0.0d0) shift = -shift
+ shift = c/(b + shift)
+ 590 continue
+ f = (sl + sm)*(sl - sm) + shift
+ g = sl*el
+c
+c chase zeros.
+c
+ mm1 = m - 1
+ do 600 k = l, mm1
+ call drotg(f,g,cs,sn)
+ if (k .ne. l) e(k-1) = dcmplx(f,0.0d0)
+ f = cs*dreal(s(k)) + sn*dreal(e(k))
+ e(k) = cs*e(k) - sn*s(k)
+ g = sn*dreal(s(k+1))
+ s(k+1) = cs*s(k+1)
+ if (wantv) call zdrot(p,v(1,k),1,v(1,k+1),1,cs,sn)
+ call drotg(f,g,cs,sn)
+ s(k) = dcmplx(f,0.0d0)
+ f = cs*dreal(e(k)) + sn*dreal(s(k+1))
+ s(k+1) = -sn*e(k) + cs*s(k+1)
+ g = sn*dreal(e(k+1))
+ e(k+1) = cs*e(k+1)
+ if (wantu .and. k .lt. n)
+ * call zdrot(n,u(1,k),1,u(1,k+1),1,cs,sn)
+ 600 continue
+ e(m-1) = dcmplx(f,0.0d0)
+ iter = iter + 1
+ go to 650
+c
+c convergence.
+c
+ 610 continue
+c
+c make the singular value positive
+c
+ if (dreal(s(l)) .ge. 0.0d0) go to 620
+ s(l) = -s(l)
+ if (wantv) call zscal(p,(-1.0d0,0.0d0),v(1,l),1)
+ 620 continue
+c
+c order the singular value.
+c
+ 630 if (l .eq. mm) go to 640
+c ...exit
+ if (dreal(s(l)) .ge. dreal(s(l+1))) go to 640
+ t = s(l)
+ s(l) = s(l+1)
+ s(l+1) = t
+ if (wantv .and. l .lt. p)
+ * call zswap(p,v(1,l),1,v(1,l+1),1)
+ if (wantu .and. l .lt. n)
+ * call zswap(n,u(1,l),1,u(1,l+1),1)
+ l = l + 1
+ go to 630
+ 640 continue
+ iter = 0
+ m = m - 1
+ 650 continue
+ go to 400
+ 660 continue
+ return
+ end
+ DOUBLE PRECISION FUNCTION DZNRM2( N, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+* .. Array Arguments ..
+ COMPLEX*16 X( * )
+* ..
+*
+* DZNRM2 returns the euclidean norm of a vector via the function
+* name, so that
+*
+* DZNRM2 := sqrt( conjg( x' )*x )
+*
+*
+*
+* -- This version written on 25-October-1982.
+* Modified on 14-October-1993 to inline the call to ZLASSQ.
+* Sven Hammarling, Nag Ltd.
+*
+*
+* .. Parameters ..
+ DOUBLE PRECISION ONE , ZERO
+ PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+* .. Local Scalars ..
+ INTEGER IX
+ DOUBLE PRECISION NORM, SCALE, SSQ, TEMP
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DIMAG, DBLE, SQRT
+* ..
+* .. Executable Statements ..
+ IF( N.LT.1 .OR. INCX.LT.1 )THEN
+ NORM = ZERO
+ ELSE
+ SCALE = ZERO
+ SSQ = ONE
+* The following loop is equivalent to this call to the LAPACK
+* auxiliary routine:
+* CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
+*
+ DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX
+ IF( DBLE( X( IX ) ).NE.ZERO )THEN
+ TEMP = ABS( DBLE( X( IX ) ) )
+ IF( SCALE.LT.TEMP )THEN
+ SSQ = ONE + SSQ*( SCALE/TEMP )**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + ( TEMP/SCALE )**2
+ END IF
+ END IF
+ IF( DIMAG( X( IX ) ).NE.ZERO )THEN
+ TEMP = ABS( DIMAG( X( IX ) ) )
+ IF( SCALE.LT.TEMP )THEN
+ SSQ = ONE + SSQ*( SCALE/TEMP )**2
+ SCALE = TEMP
+ ELSE
+ SSQ = SSQ + ( TEMP/SCALE )**2
+ END IF
+ END IF
+ 10 CONTINUE
+ NORM = SCALE * SQRT( SSQ )
+ END IF
+*
+ DZNRM2 = NORM
+ RETURN
+*
+* End of DZNRM2.
+*
+ END
+ subroutine zaxpy(n,za,zx,incx,zy,incy)
+c
+c constant times a vector plus a vector.
+c jack dongarra, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*),zy(*),za
+ integer i,incx,incy,ix,iy,n
+ double precision dcabs1
+ if(n.le.0)return
+ if (dcabs1(za) .eq. 0.0d0) return
+ if (incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ zy(iy) = zy(iy) + za*zx(ix)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ zy(i) = zy(i) + za*zx(i)
+ 30 continue
+ return
+ end
+ double complex function zdotc(n,zx,incx,zy,incy)
+c
+c forms the dot product of a vector.
+c jack dongarra, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*),zy(*),ztemp
+ integer i,incx,incy,ix,iy,n
+ ztemp = (0.0d0,0.0d0)
+ zdotc = (0.0d0,0.0d0)
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ztemp = ztemp + dconjg(zx(ix))*zy(iy)
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ zdotc = ztemp
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ ztemp = ztemp + dconjg(zx(i))*zy(i)
+ 30 continue
+ zdotc = ztemp
+ return
+ end
+ subroutine zdrot (n,zx,incx,zy,incy,c,s)
+c
+c applies a plane rotation, where the cos and sin (c and s) are
+c double precision and the vectors zx and zy are double complex.
+c jack dongarra, linpack, 3/11/78.
+c
+ double complex zx(1),zy(1),ztemp
+ double precision c,s
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ztemp = c*zx(ix) + s*zy(iy)
+ zy(iy) = c*zy(iy) - s*zx(ix)
+ zx(ix) = ztemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+ 20 do 30 i = 1,n
+ ztemp = c*zx(i) + s*zy(i)
+ zy(i) = c*zy(i) - s*zx(i)
+ zx(i) = ztemp
+ 30 continue
+ return
+ end
+ subroutine zscal(n,za,zx,incx)
+c
+c scales a vector by a constant.
+c jack dongarra, 3/11/78.
+c modified 3/93 to return if incx .le. 0.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex za,zx(*)
+ integer i,incx,ix,n
+c
+ if( n.le.0 .or. incx.le.0 )return
+ if(incx.eq.1)go to 20
+c
+c code for increment not equal to 1
+c
+ ix = 1
+ do 10 i = 1,n
+ zx(ix) = za*zx(ix)
+ ix = ix + incx
+ 10 continue
+ return
+c
+c code for increment equal to 1
+c
+ 20 do 30 i = 1,n
+ zx(i) = za*zx(i)
+ 30 continue
+ return
+ end
+ subroutine zswap (n,zx,incx,zy,incy)
+c
+c interchanges two vectors.
+c jack dongarra, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double complex zx(*),zy(*),ztemp
+ integer i,incx,incy,ix,iy,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ ztemp = zx(ix)
+ zx(ix) = zy(iy)
+ zy(iy) = ztemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+ 20 do 30 i = 1,n
+ ztemp = zx(i)
+ zx(i) = zy(i)
+ zy(i) = ztemp
+ 30 continue
+ return
+ end
+ double precision function dcabs1(z)
+ double complex z,zz
+ double precision t(2)
+ equivalence (zz,t(1))
+ zz = z
+ dcabs1 = dabs(t(1)) + dabs(t(2))
+ return
+ end
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zswap.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zswap.c
new file mode 100644
index 0000000000000000000000000000000000000000..c68c403688a401a5cc3869cfc374f2d0c974a4d9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zswap.c
@@ -0,0 +1,48 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+/* and moved out of zsvdc.c to separate file */
+
+/* Subroutine */ void zswap_(n, zx, incx, zy, incy)
+const integer *n;
+doublecomplex *zx;
+const integer *incx;
+doublecomplex *zy;
+const integer *incy;
+{
+ /* Local variables */
+ static integer i;
+ static doublecomplex ztemp;
+ static integer ix, iy;
+
+/* interchanges two vectors. */
+/* jack dongarra, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+ if (*n <= 0) {
+ return;
+ }
+ if (*incx == 1 && *incy == 1) {
+ for (i = 0; i < *n; ++i) {
+ ztemp.r = zx[i].r, ztemp.i = zx[i].i;
+ zx[i].r = zy[i].r, zx[i].i = zy[i].i;
+ zy[i].r = ztemp.r, zy[i].i = ztemp.i;
+ }
+ }
+ else {
+ ix = 0; iy = 0;
+ if (*incx < 0) {
+ ix = (1-(*n)) * *incx;
+ }
+ if (*incy < 0) {
+ iy = (1-(*n)) * *incy;
+ }
+ for (i = 0; i < *n; ++i) {
+ ztemp.r = zx[ix].r, ztemp.i = zx[ix].i;
+ zx[ix].r = zy[iy].r, zx[ix].i = zy[iy].i;
+ zy[iy].r = ztemp.r, zy[iy].i = ztemp.i;
+ ix += *incx; iy += *incy;
+ }
+ }
+} /* zswap_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.c
new file mode 100644
index 0000000000000000000000000000000000000000..d5ac48d5fd9dd65960caf77fd316622361a08077
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.c
@@ -0,0 +1,407 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static doublecomplex c_b17 = {1.,0.};
+
+/* Subroutine */ void ztrevc_(side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork, info)
+const char *side, *howmny;
+logical *select;
+const integer *n;
+doublecomplex *t;
+const integer *ldt;
+doublecomplex *vl;
+const integer *ldvl;
+doublecomplex *vr;
+const integer *ldvr;
+const integer *mm;
+integer *m;
+doublecomplex *work;
+doublereal *rwork;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static logical allv;
+ static doublereal unfl, ovfl, smin;
+ static logical over;
+ static integer i, j, k;
+ static doublereal scale;
+ static doublereal remax;
+ static logical leftv, bothv;
+ static logical somev;
+ static integer ii, ki;
+ static integer is;
+ static logical rightv;
+ static doublereal smlnum;
+ static doublereal ulp;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZTREVC computes some or all of the right and/or left eigenvectors of */
+/* a complex upper triangular matrix T. */
+/* */
+/* The right eigenvector x and the left eigenvector y of T corresponding */
+/* to an eigenvalue w are defined by: */
+/* */
+/* T*x = w*x, y'*T = w*y' */
+/* */
+/* where y' denotes the conjugate transpose of the vector y. */
+/* */
+/* If all eigenvectors are requested, the routine may either return the */
+/* matrices X and/or Y of right or left eigenvectors of T, or the */
+/* products Q*X and/or Q*Y, where Q is an input unitary */
+/* matrix. If T was obtained from the Schur factorization of an */
+/* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of */
+/* right or left eigenvectors of A. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* SIDE (input) CHARACTER*1 */
+/* = 'R': compute right eigenvectors only; */
+/* = 'L': compute left eigenvectors only; */
+/* = 'B': compute both right and left eigenvectors. */
+/* */
+/* HOWMNY (input) CHARACTER*1 */
+/* = 'A': compute all right and/or left eigenvectors; */
+/* = 'B': compute all right and/or left eigenvectors, */
+/* and backtransform them using the input matrices */
+/* supplied in VR and/or VL; */
+/* = 'S': compute selected right and/or left eigenvectors, */
+/* specified by the logical array SELECT. */
+/* */
+/* SELECT (input) LOGICAL array, dimension (N) */
+/* If HOWMNY = 'S', SELECT specifies the eigenvectors to be */
+/* computed. */
+/* If HOWMNY = 'A' or 'B', SELECT is not referenced. */
+/* To select the eigenvector corresponding to the j-th */
+/* eigenvalue, SELECT(j) must be set to .TRUE.. */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix T. N >= 0. */
+/* */
+/* T (input/output) COMPLEX*16 array, dimension (LDT,N) */
+/* The upper triangular matrix T. T is modified, but restored */
+/* on exit. */
+/* */
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= max(1,N). */
+/* */
+/* VL (input/output) COMPLEX*16 array, dimension (LDVL,MM) */
+/* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must */
+/* contain an N-by-N matrix Q (usually the unitary matrix Q of */
+/* Schur vectors returned by ZHSEQR). */
+/* On exit, if SIDE = 'L' or 'B', VL contains: */
+/* if HOWMNY = 'A', the matrix Y of left eigenvectors of T; */
+/* if HOWMNY = 'B', the matrix Q*Y; */
+/* if HOWMNY = 'S', the left eigenvectors of T specified by */
+/* SELECT, stored consecutively in the columns */
+/* of VL, in the same order as their */
+/* eigenvalues. */
+/* If SIDE = 'R', VL is not referenced. */
+/* */
+/* LDVL (input) INTEGER */
+/* The leading dimension of the array VL. LDVL >= max(1,N) if */
+/* SIDE = 'L' or 'B'; LDVL >= 1 otherwise. */
+/* */
+/* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM) */
+/* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must */
+/* contain an N-by-N matrix Q (usually the unitary matrix Q of */
+/* Schur vectors returned by ZHSEQR). */
+/* On exit, if SIDE = 'R' or 'B', VR contains: */
+/* if HOWMNY = 'A', the matrix X of right eigenvectors of T; */
+/* if HOWMNY = 'B', the matrix Q*X; */
+/* if HOWMNY = 'S', the right eigenvectors of T specified by */
+/* SELECT, stored consecutively in the columns */
+/* of VR, in the same order as their */
+/* eigenvalues. */
+/* If SIDE = 'L', VR is not referenced. */
+/* */
+/* LDVR (input) INTEGER */
+/* The leading dimension of the array VR. LDVR >= max(1,N) if */
+/* SIDE = 'R' or 'B'; LDVR >= 1 otherwise. */
+/* */
+/* MM (input) INTEGER */
+/* The number of columns in the arrays VL and/or VR. MM >= M. */
+/* */
+/* M (output) INTEGER */
+/* The number of columns in the arrays VL and/or VR actually */
+/* used to store the eigenvectors. If HOWMNY = 'A' or 'B', M */
+/* is set to N. Each selected eigenvector occupies one */
+/* column. */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (2*N) */
+/* */
+/* RWORK (workspace) DOUBLE PRECISION array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* Further Details */
+/* =============== */
+/* */
+/* The algorithm used in this program is basically backward (forward) */
+/* substitution, with scaling to make the the code robust against */
+/* possible overflow. */
+/* */
+/* Each eigenvector is normalized so that the element of largest */
+/* magnitude has magnitude 1; here the magnitude of a complex number */
+/* (x,y) is taken to be |x| + |y|. */
+/* */
+/* ===================================================================== */
+
+ bothv = lsame_(side, "B");
+ rightv = lsame_(side, "R") || bothv;
+ leftv = lsame_(side, "L") || bothv;
+
+ allv = lsame_(howmny, "A");
+ over = lsame_(howmny, "B") || lsame_(howmny, "O");
+ somev = lsame_(howmny, "S");
+
+/* Set M to the number of columns required to store the selected */
+/* eigenvectors. */
+
+ if (somev) {
+ *m = 0;
+ for (j = 0; j < *n; ++j) {
+ if (select[j]) {
+ ++(*m);
+ }
+ }
+ } else {
+ *m = *n;
+ }
+
+ *info = 0;
+ if (! rightv && ! leftv) {
+ *info = -1;
+ } else if (! allv && ! over && ! somev) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*ldt < max(1,*n)) {
+ *info = -6;
+ } else if (*ldvl < 1 || (leftv && *ldvl < *n)) {
+ *info = -8;
+ } else if (*ldvr < 1 || (rightv && *ldvr < *n)) {
+ *info = -10;
+ } else if (*mm < *m) {
+ *info = -11;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZTREVC", &i__1);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+/* Set the constants to control overflow. */
+
+ unfl = dlamch_("Safe minimum");
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = dlamch_("Precision");
+ smlnum = unfl * (*n / ulp);
+
+/* Store the diagonal elements of T in working array WORK. */
+
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + *n;
+ i__2 = i + i * *ldt; /* index [i,i] */
+ work[i__1].r = t[i__2].r, work[i__1].i = t[i__2].i;
+ }
+
+/* Compute 1-norm of each column of strictly upper triangular */
+/* part of T to control overflow in triangular solver. */
+
+ rwork[0] = 0.;
+ for (j = 1; j < *n; ++j) {
+ rwork[j] = dzasum_(&j, &t[j * *ldt], &c__1);
+ }
+
+ if (rightv) {
+
+/* Compute right eigenvectors. */
+
+ is = *m - 1;
+ for (ki = *n - 1; ki >= 0; --ki) {
+
+ if (somev) {
+ if (! select[ki]) {
+ continue; /* next ki */
+ }
+ }
+ i__1 = ki + ki * *ldt; /* index [ki,ki] */
+ smin = ulp * (abs(t[i__1].r) + abs(t[i__1].i));
+ smin = max(smin, smlnum);
+
+ work[0].r = 1., work[0].i = 0.;
+
+/* Form right-hand side. */
+
+ for (k = 0; k < ki; ++k) {
+ i__1 = k + ki * *ldt; /* index [k,ki] */
+ work[k].r = -t[i__1].r, work[k].i = -t[i__1].i;
+ }
+
+/* Solve the triangular system: */
+/* (T(1:KI-1,1:KI-1) - T(KI,KI))*X = SCALE*WORK. */
+
+ for (k = 0; k < ki; ++k) {
+ i__1 = k + k * *ldt; /* index [k,k] */
+ i__2 = ki + ki * *ldt; /* index [ki,ki] */
+ t[i__1].r -= t[i__2].r,
+ t[i__1].i -= t[i__2].i;
+ if (abs(t[i__1].r) + abs(t[i__1].i) < smin) {
+ t[i__1].r = smin, t[i__1].i = 0.;
+ }
+ }
+
+ if (ki > 0) {
+ zlatrs_("Upper", "No transpose", "Non-unit", "Y", &ki, t, ldt, work, &scale, rwork, info);
+ work[ki].r = scale, work[ki].i = 0.;
+ }
+
+/* Copy the vector x or Q*x to VR and normalize. */
+
+ if (! over) {
+ k = ki+1;
+ zcopy_(&k, work, &c__1, &vr[is * *ldvr], &c__1);
+
+ ii = izamax_(&k, &vr[is * *ldvr], &c__1);
+ i__1 = ii-1 + is * *ldvr; /* index [ii-1,is] */
+ remax = 1. / (abs(vr[i__1].r) + abs(vr[i__1].i));
+ zdscal_(&k, &remax, &vr[is * *ldvr], &c__1);
+
+ for (k = ki+1; k < *n; ++k) {
+ i__1 = k + is * *ldvr; /* index [k,is] */
+ vr[i__1].r = 0., vr[i__1].i = 0.;
+ }
+ } else {
+ if (ki > 0) {
+ z__1.r = scale, z__1.i = 0.;
+ zgemv_("N", n, &ki, &c_b17, vr, ldvr, work, &c__1, &z__1, &vr[ki * *ldvr], &c__1);
+ }
+
+ ii = izamax_(n, &vr[ki * *ldvr], &c__1);
+ i__1 = ii-1 + ki * *ldvr; /* index [ii-1,ki] */
+ remax = 1. / (abs(vr[i__1].r) + abs(vr[i__1].i));
+ zdscal_(n, &remax, &vr[ki * *ldvr], &c__1);
+ }
+
+/* Set back the original diagonal elements of T. */
+
+ for (k = 0; k < ki; ++k) {
+ i__1 = k + k * *ldt; /* index [k,k] */
+ i__2 = k + *n;
+ t[i__1].r = work[i__2].r, t[i__1].i = work[i__2].i;
+ }
+
+ --is;
+ }
+ }
+
+ if (leftv) {
+
+/* Compute left eigenvectors. */
+
+ is = 0;
+ for (ki = 0; ki < *n; ++ki) {
+ if (somev) {
+ if (! select[ki]) {
+ continue; /* next ki */
+ }
+ }
+ i__1 = ki + ki * *ldt; /* index [ki,ki] */
+ smin = ulp * (abs(t[i__1].r) + abs(t[i__1].i));
+ smin = max(smin, smlnum);
+ work[*n - 1].r = 1., work[*n - 1].i = 0.;
+
+/* Form right-hand side. */
+
+ for (k = ki+1; k < *n; ++k) {
+ work[k].r = -t[ki + k * *ldt].r, work[k].i = t[ki + k * *ldt].i;
+ }
+
+/* Solve the triangular system: */
+/* (T(KI+1:N,KI+1:N) - T(KI,KI))'*X = SCALE*WORK. */
+
+ for (k = ki+1; k < *n; ++k) {
+ i__1 = k + k * *ldt; /* index [k,k] */
+ i__2 = ki + ki * *ldt; /* index [ki,ki] */
+ t[i__1].r -= t[i__2].r,
+ t[i__1].i -= t[i__2].i;
+ if (abs(t[i__1].r) + abs(t[i__1].i) < smin) {
+ t[i__1].r = smin, t[i__1].i = 0.;
+ }
+ }
+
+ k = ki + 1;
+ if (k < *n) {
+ i__1 = *n - k;
+ zlatrs_("Upper", "Conjugate transpose", "Non-unit", "Y",
+ &i__1, &t[k + k * *ldt], ldt, &work[k], &scale, rwork, info);
+ work[ki].r = scale, work[ki].i = 0.;
+ }
+
+/* Copy the vector x or Q*x to VL and normalize. */
+
+ if (! over) {
+ i__1 = *n - ki;
+ zcopy_(&i__1, &work[ki], &c__1, &vl[ki + is * *ldvl], &c__1);
+ ii = izamax_(&i__1, &vl[ki + is * *ldvl], &c__1) + ki;
+ i__2 = ii-1 + is * *ldvl; /* index [ii-1,is] */
+ remax = 1. / (abs(vl[i__2].r) + abs(vl[i__2].i));
+ zdscal_(&i__1, &remax, &vl[ki + is * *ldvl], &c__1);
+
+ for (k = 0; k < ki; ++k) {
+ i__1 = k + is * *ldvl; /* index [k,is] */
+ vl[i__1].r = 0., vl[i__1].i = 0.;
+ }
+ } else {
+ k = ki + 1;
+ if (k < *n) {
+ i__1 = *n - k;
+ z__1.r = scale, z__1.i = 0.;
+ zgemv_("N", n, &i__1, &c_b17, &vl[k * *ldvl],
+ ldvl, &work[k], &c__1, &z__1, &vl[ki * *ldvl], &c__1);
+ }
+
+ ii = izamax_(n, &vl[ki * *ldvl], &c__1);
+ i__1 = ii-1 + ki * *ldvl; /* index [ii-1,ki] */
+ remax = 1. / (abs(vl[i__1].r) + abs(vl[i__1].i));
+ zdscal_(n, &remax, &vl[ki * *ldvl], &c__1);
+ }
+
+/* Set back the original diagonal elements of T. */
+
+ for (k = ki+1; k < *n; ++k) {
+ i__1 = k + k * *ldt; /* index [k,k] */
+ i__2 = k + *n;
+ t[i__1].r = work[i__2].r, t[i__1].i = work[i__2].i;
+ }
+ ++is;
+ }
+ }
+} /* ztrevc_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.f
new file mode 100644
index 0000000000000000000000000000000000000000..a376503d35d76f5de1a4c9b0ddfdeee14a8a6313
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrevc.f
@@ -0,0 +1,384 @@
+ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
+ $ LDVR, MM, M, WORK, RWORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ CHARACTER HOWMNY, SIDE
+ INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
+* ..
+* .. Array Arguments ..
+ LOGICAL SELECT( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
+ $ WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZTREVC computes some or all of the right and/or left eigenvectors of
+* a complex upper triangular matrix T.
+*
+* The right eigenvector x and the left eigenvector y of T corresponding
+* to an eigenvalue w are defined by:
+*
+* T*x = w*x, y'*T = w*y'
+*
+* where y' denotes the conjugate transpose of the vector y.
+*
+* If all eigenvectors are requested, the routine may either return the
+* matrices X and/or Y of right or left eigenvectors of T, or the
+* products Q*X and/or Q*Y, where Q is an input unitary
+* matrix. If T was obtained from the Schur factorization of an
+* original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
+* right or left eigenvectors of A.
+*
+* Arguments
+* =========
+*
+* SIDE (input) CHARACTER*1
+* = 'R': compute right eigenvectors only;
+* = 'L': compute left eigenvectors only;
+* = 'B': compute both right and left eigenvectors.
+*
+* HOWMNY (input) CHARACTER*1
+* = 'A': compute all right and/or left eigenvectors;
+* = 'B': compute all right and/or left eigenvectors,
+* and backtransform them using the input matrices
+* supplied in VR and/or VL;
+* = 'S': compute selected right and/or left eigenvectors,
+* specified by the logical array SELECT.
+*
+* SELECT (input) LOGICAL array, dimension (N)
+* If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+* computed.
+* If HOWMNY = 'A' or 'B', SELECT is not referenced.
+* To select the eigenvector corresponding to the j-th
+* eigenvalue, SELECT(j) must be set to .TRUE..
+*
+* N (input) INTEGER
+* The order of the matrix T. N >= 0.
+*
+* T (input/output) COMPLEX*16 array, dimension (LDT,N)
+* The upper triangular matrix T. T is modified, but restored
+* on exit.
+*
+* LDT (input) INTEGER
+* The leading dimension of the array T. LDT >= max(1,N).
+*
+* VL (input/output) COMPLEX*16 array, dimension (LDVL,MM)
+* On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+* contain an N-by-N matrix Q (usually the unitary matrix Q of
+* Schur vectors returned by ZHSEQR).
+* On exit, if SIDE = 'L' or 'B', VL contains:
+* if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+* if HOWMNY = 'B', the matrix Q*Y;
+* if HOWMNY = 'S', the left eigenvectors of T specified by
+* SELECT, stored consecutively in the columns
+* of VL, in the same order as their
+* eigenvalues.
+* If SIDE = 'R', VL is not referenced.
+*
+* LDVL (input) INTEGER
+* The leading dimension of the array VL. LDVL >= max(1,N) if
+* SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+*
+* VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
+* On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+* contain an N-by-N matrix Q (usually the unitary matrix Q of
+* Schur vectors returned by ZHSEQR).
+* On exit, if SIDE = 'R' or 'B', VR contains:
+* if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+* if HOWMNY = 'B', the matrix Q*X;
+* if HOWMNY = 'S', the right eigenvectors of T specified by
+* SELECT, stored consecutively in the columns
+* of VR, in the same order as their
+* eigenvalues.
+* If SIDE = 'L', VR is not referenced.
+*
+* LDVR (input) INTEGER
+* The leading dimension of the array VR. LDVR >= max(1,N) if
+* SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+*
+* MM (input) INTEGER
+* The number of columns in the arrays VL and/or VR. MM >= M.
+*
+* M (output) INTEGER
+* The number of columns in the arrays VL and/or VR actually
+* used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+* is set to N. Each selected eigenvector occupies one
+* column.
+*
+* WORK (workspace) COMPLEX*16 array, dimension (2*N)
+*
+* RWORK (workspace) DOUBLE PRECISION array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* Further Details
+* ===============
+*
+* The algorithm used in this program is basically backward (forward)
+* substitution, with scaling to make the the code robust against
+* possible overflow.
+*
+* Each eigenvector is normalized so that the element of largest
+* magnitude has magnitude 1; here the magnitude of a complex number
+* (x,y) is taken to be |x| + |y|.
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ COMPLEX*16 CMZERO, CMONE
+ PARAMETER ( CMZERO = ( 0.0D+0, 0.0D+0 ),
+ $ CMONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL ALLV, BOTHV, LEFTV, OVER, RIGHTV, SOMEV
+ INTEGER I, II, IS, J, K, KI
+ DOUBLE PRECISION OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL
+ COMPLEX*16 CDUM
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ INTEGER IZAMAX
+ DOUBLE PRECISION DLAMCH, DZASUM
+ EXTERNAL LSAME, IZAMAX, DLAMCH, DZASUM
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLABAD, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX
+* ..
+* .. Statement Functions ..
+ DOUBLE PRECISION CABS1
+* ..
+* .. Statement Function definitions ..
+ CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
+* ..
+* .. Executable Statements ..
+*
+* Decode and test the input parameters
+*
+ BOTHV = LSAME( SIDE, 'B' )
+ RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV
+ LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV
+*
+ ALLV = LSAME( HOWMNY, 'A' )
+ OVER = LSAME( HOWMNY, 'B' ) .OR. LSAME( HOWMNY, 'O' )
+ SOMEV = LSAME( HOWMNY, 'S' )
+*
+* Set M to the number of columns required to store the selected
+* eigenvectors.
+*
+ IF( SOMEV ) THEN
+ M = 0
+ DO 10 J = 1, N
+ IF( SELECT( J ) )
+ $ M = M + 1
+ 10 CONTINUE
+ ELSE
+ M = N
+ END IF
+*
+ INFO = 0
+ IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
+ INFO = -1
+ ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN
+ INFO = -2
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
+ INFO = -6
+ ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN
+ INFO = -8
+ ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN
+ INFO = -10
+ ELSE IF( MM.LT.M ) THEN
+ INFO = -11
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZTREVC', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* Set the constants to control overflow.
+*
+ UNFL = DLAMCH( 'Safe minimum' )
+ OVFL = ONE / UNFL
+ CALL DLABAD( UNFL, OVFL )
+ ULP = DLAMCH( 'Precision' )
+ SMLNUM = UNFL*( N / ULP )
+*
+* Store the diagonal elements of T in working array WORK.
+*
+ DO 20 I = 1, N
+ WORK( I+N ) = T( I, I )
+ 20 CONTINUE
+*
+* Compute 1-norm of each column of strictly upper triangular
+* part of T to control overflow in triangular solver.
+*
+ RWORK( 1 ) = ZERO
+ DO 30 J = 2, N
+ RWORK( J ) = DZASUM( J-1, T( 1, J ), 1 )
+ 30 CONTINUE
+*
+ IF( RIGHTV ) THEN
+*
+* Compute right eigenvectors.
+*
+ IS = M
+ DO 80 KI = N, 1, -1
+*
+ IF( SOMEV ) THEN
+ IF( .NOT.SELECT( KI ) )
+ $ GO TO 80
+ END IF
+ SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM )
+*
+ WORK( 1 ) = CMONE
+*
+* Form right-hand side.
+*
+ DO 40 K = 1, KI - 1
+ WORK( K ) = -T( K, KI )
+ 40 CONTINUE
+*
+* Solve the triangular system:
+* (T(1:KI-1,1:KI-1) - T(KI,KI))*X = SCALE*WORK.
+*
+ DO 50 K = 1, KI - 1
+ T( K, K ) = T( K, K ) - T( KI, KI )
+ IF( CABS1( T( K, K ) ).LT.SMIN )
+ $ T( K, K ) = SMIN
+ 50 CONTINUE
+*
+ IF( KI.GT.1 ) THEN
+ CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y',
+ $ KI-1, T, LDT, WORK( 1 ), SCALE, RWORK,
+ $ INFO )
+ WORK( KI ) = SCALE
+ END IF
+*
+* Copy the vector x or Q*x to VR and normalize.
+*
+ IF( .NOT.OVER ) THEN
+ CALL ZCOPY( KI, WORK( 1 ), 1, VR( 1, IS ), 1 )
+*
+ II = IZAMAX( KI, VR( 1, IS ), 1 )
+ REMAX = ONE / CABS1( VR( II, IS ) )
+ CALL ZDSCAL( KI, REMAX, VR( 1, IS ), 1 )
+*
+ DO 60 K = KI + 1, N
+ VR( K, IS ) = CMZERO
+ 60 CONTINUE
+ ELSE
+ IF( KI.GT.1 )
+ $ CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR, WORK( 1 ),
+ $ 1, DCMPLX( SCALE ), VR( 1, KI ), 1 )
+*
+ II = IZAMAX( N, VR( 1, KI ), 1 )
+ REMAX = ONE / CABS1( VR( II, KI ) )
+ CALL ZDSCAL( N, REMAX, VR( 1, KI ), 1 )
+ END IF
+*
+* Set back the original diagonal elements of T.
+*
+ DO 70 K = 1, KI - 1
+ T( K, K ) = WORK( K+N )
+ 70 CONTINUE
+*
+ IS = IS - 1
+ 80 CONTINUE
+ END IF
+*
+ IF( LEFTV ) THEN
+*
+* Compute left eigenvectors.
+*
+ IS = 1
+ DO 130 KI = 1, N
+*
+ IF( SOMEV ) THEN
+ IF( .NOT.SELECT( KI ) )
+ $ GO TO 130
+ END IF
+ SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM )
+*
+ WORK( N ) = CMONE
+*
+* Form right-hand side.
+*
+ DO 90 K = KI + 1, N
+ WORK( K ) = -DCONJG( T( KI, K ) )
+ 90 CONTINUE
+*
+* Solve the triangular system:
+* (T(KI+1:N,KI+1:N) - T(KI,KI))'*X = SCALE*WORK.
+*
+ DO 100 K = KI + 1, N
+ T( K, K ) = T( K, K ) - T( KI, KI )
+ IF( CABS1( T( K, K ) ).LT.SMIN )
+ $ T( K, K ) = SMIN
+ 100 CONTINUE
+*
+ IF( KI.LT.N ) THEN
+ CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit',
+ $ 'Y', N-KI, T( KI+1, KI+1 ), LDT,
+ $ WORK( KI+1 ), SCALE, RWORK, INFO )
+ WORK( KI ) = SCALE
+ END IF
+*
+* Copy the vector x or Q*x to VL and normalize.
+*
+ IF( .NOT.OVER ) THEN
+ CALL ZCOPY( N-KI+1, WORK( KI ), 1, VL( KI, IS ), 1 )
+*
+ II = IZAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1
+ REMAX = ONE / CABS1( VL( II, IS ) )
+ CALL ZDSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 )
+*
+ DO 110 K = 1, KI - 1
+ VL( K, IS ) = CMZERO
+ 110 CONTINUE
+ ELSE
+ IF( KI.LT.N )
+ $ CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), LDVL,
+ $ WORK( KI+1 ), 1, DCMPLX( SCALE ),
+ $ VL( 1, KI ), 1 )
+*
+ II = IZAMAX( N, VL( 1, KI ), 1 )
+ REMAX = ONE / CABS1( VL( II, KI ) )
+ CALL ZDSCAL( N, REMAX, VL( 1, KI ), 1 )
+ END IF
+*
+* Set back the original diagonal elements of T.
+*
+ DO 120 K = KI + 1, N
+ T( K, K ) = WORK( K+N )
+ 120 CONTINUE
+*
+ IS = IS + 1
+ 130 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZTREVC
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.c
new file mode 100644
index 0000000000000000000000000000000000000000..f9a22456f74bc397d803ef074d858064a3e1df97
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.c
@@ -0,0 +1,492 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void ztrmm_(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
+const char *side, *uplo, *transa, *diag;
+const integer *m, *n;
+doublecomplex *alpha, *a;
+const integer *lda;
+doublecomplex *b;
+const integer *ldb;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer info;
+ static doublecomplex temp;
+ static integer i, j, k;
+ static logical lside;
+ static integer nrowa;
+ static logical upper;
+ static logical noconj, nounit;
+
+/**************************************************************************/
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZTRMM performs one of the matrix-matrix operations */
+/* */
+/* B := alpha*op( A )*B, or B := alpha*B*op( A ) */
+/* */
+/* where alpha is a scalar, B is an m by n matrix, A is a unit, or */
+/* non-unit, upper or lower triangular matrix and op( A ) is one of */
+/* */
+/* op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ). */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* SIDE - CHARACTER*1. */
+/* On entry, SIDE specifies whether op( A ) multiplies B from */
+/* the left or right as follows: */
+/* */
+/* SIDE = 'L' or 'l' B := alpha*op( A )*B. */
+/* */
+/* SIDE = 'R' or 'r' B := alpha*B*op( A ). */
+/* */
+/* Unchanged on exit. */
+/* */
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix A is an upper or */
+/* lower triangular matrix as follows: */
+/* */
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+/* */
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+/* */
+/* TRANSA = 'N' or 'n' op( A ) = A. */
+/* */
+/* TRANSA = 'T' or 't' op( A ) = A'. */
+/* */
+/* TRANSA = 'C' or 'c' op( A ) = conjg( A' ). */
+/* */
+/* Unchanged on exit. */
+/* */
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit triangular */
+/* as follows: */
+/* */
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+/* */
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of B. M must be at */
+/* least zero. */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of B. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+/* */
+/* ALPHA - COMPLEX*16 . */
+/* On entry, ALPHA specifies the scalar alpha. When alpha is */
+/* zero then A is not referenced and B need not be set before */
+/* entry. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m */
+/* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. */
+/* Before entry with UPLO = 'U' or 'u', the leading k by k */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading k by k */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When SIDE = 'L' or 'l' then */
+/* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' */
+/* then LDA must be at least max( 1, n ). */
+/* Unchanged on exit. */
+/* */
+/* B - COMPLEX*16 array of DIMENSION ( LDB, n ). */
+/* Before entry, the leading m by n part of the array B must */
+/* contain the matrix B, and on exit is overwritten by the */
+/* transformed matrix. */
+/* */
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. LDB must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+/* */
+/**************************************************************************/
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ noconj = lsame_(transa, "T");
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if (! lside && ! lsame_(side, "R")) {
+ info = 1;
+ } else if (! upper && ! lsame_(uplo, "L")) {
+ info = 2;
+ } else if (! lsame_(transa, "N") && ! lsame_(transa, "T") && ! lsame_(transa, "C")) {
+ info = 3;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZTRMM ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (alpha->r == 0. && alpha->i == 0.) {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + j * *ldb;
+ b[i__2].r = 0., b[i__2].i = 0.;
+ }
+ }
+ return;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*A*B. */
+
+ if (upper) {
+ for (j = 0; j < *n; ++j) {
+ for (k = 0; k < *m; ++k) {
+ i__2 = k + j * *ldb;
+ if (b[i__2].r != 0. || b[i__2].i != 0.) {
+ temp.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,
+ temp.i = alpha->r * b[i__2].i + alpha->i * b[i__2].r;
+ for (i = 0; i < k; ++i) {
+ i__1 = i + k * *lda;
+ i__2 = i + j * *ldb;
+ b[i__2].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ b[i__2].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ if (nounit) {
+ i__1 = k + k * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = k + j * *ldb;
+ b[i__2].r = temp.r, b[i__2].i = temp.i;
+ }
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (k = *m - 1; k >= 0; --k) {
+ i__2 = k + j * *ldb;
+ if (b[i__2].r != 0. || b[i__2].i != 0.) {
+ temp.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,
+ temp.i = alpha->r * b[i__2].i + alpha->i * b[i__2].r;
+ b[i__2].r = temp.r, b[i__2].i = temp.i;
+ if (nounit) {
+ i__1 = k + k * *lda;
+ z__1.r = b[i__2].r * a[i__1].r - b[i__2].i * a[i__1].i,
+ z__1.i = b[i__2].r * a[i__1].i + b[i__2].i * a[i__1].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ for (i = k + 1; i < *m; ++i) {
+ i__1 = i + k * *lda;
+ i__2 = i + j * *ldb;
+ b[i__2].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ b[i__2].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A' or B := alpha*B*conjg( A' ). */
+
+ if (upper) {
+ for (j = 0; j < *n; ++j) {
+ for (i = *m - 1; i >= 0; --i) {
+ i__2 = i + j * *ldb;
+ temp.r = b[i__2].r, temp.i = b[i__2].i;
+ if (noconj) {
+ if (nounit) {
+ i__1 = i + i * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (k = 0; k < i; ++k) {
+ i__1 = k + i * *lda;
+ i__2 = k + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r - a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i + a[i__1].i * b[i__2].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = i + i * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (k = 0; k < i; ++k) {
+ i__1 = k + i * *lda;
+ i__2 = k + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r + a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i - a[i__1].i * b[i__2].r;
+ }
+ }
+ i__2 = i + j * *ldb;
+ b[i__2].r = alpha->r * temp.r - alpha->i * temp.i,
+ b[i__2].i = alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + j * *ldb;
+ temp.r = b[i__2].r, temp.i = b[i__2].i;
+ if (noconj) {
+ if (nounit) {
+ i__1 = i + i * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (k = i + 1; k < *m; ++k) {
+ i__1 = k + i * *lda;
+ i__2 = k + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r - a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i + a[i__1].i * b[i__2].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = i + i * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (k = i + 1; k < *m; ++k) {
+ i__1 = k + i * *lda;
+ i__2 = k + j * *ldb;
+ temp.r += a[i__1].r * b[i__2].r + a[i__1].i * b[i__2].i,
+ temp.i += a[i__1].r * b[i__2].i - a[i__1].i * b[i__2].r;
+ }
+ }
+ i__2 = i + j * *ldb;
+ b[i__2].r = alpha->r * temp.r - alpha->i * temp.i,
+ b[i__2].i = alpha->r * temp.i + alpha->i * temp.r;
+ }
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*A. */
+
+ if (upper) {
+ for (j = *n - 1; j >= 0; --j) {
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + j * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ for (k = 0; k < j; ++k) {
+ i__1 = k + j * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ temp.r = alpha->r * a[i__1].r - alpha->i * a[i__1].i,
+ temp.i = alpha->r * a[i__1].i + alpha->i * a[i__1].r;
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ i__2 = i + j * *ldb;
+ b[i__2].r += z__1.r, b[i__2].i += z__1.i;
+ }
+ }
+ }
+ }
+ } else {
+ for (j = 0; j < *n; ++j) {
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + j * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ for (k = j + 1; k < *n; ++k) {
+ i__1 = k + j * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ temp.r = alpha->r * a[i__1].r - alpha->i * a[i__1].i,
+ temp.i = alpha->r * a[i__1].i + alpha->i * a[i__1].r;
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ i__2 = i + j * *ldb;
+ b[i__2].r += z__1.r, b[i__2].i += z__1.i;
+ }
+ }
+ }
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A' or B := alpha*B*conjg( A' ). */
+
+ if (upper) {
+ for (k = 0; k < *n; ++k) {
+ for (j = 0; j < k; ++j) {
+ i__1 = j + k * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ if (noconj) {
+ temp.r = alpha->r * a[i__1].r - alpha->i * a[i__1].i,
+ temp.i = alpha->i * a[i__1].r + alpha->r * a[i__1].i;
+ } else {
+ temp.r = alpha->r * a[i__1].r + alpha->i * a[i__1].i,
+ temp.i = alpha->i * a[i__1].r - alpha->r * a[i__1].i;
+ }
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ i__2 = i + j * *ldb;
+ b[i__2].r += z__1.r, b[i__2].i += z__1.i;
+ }
+ }
+ }
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ if (noconj) {
+ i__1 = k + k * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ i__1 = k + k * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ if (temp.r != 1. || temp.i != 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ }
+ }
+ } else {
+ for (k = *n - 1; k >= 0; --k) {
+ for (j = k + 1; j < *n; ++j) {
+ i__1 = j + k * *lda;
+ if (a[i__1].r != 0. || a[i__1].i != 0.) {
+ if (noconj) {
+ temp.r = alpha->r * a[i__1].r - alpha->i * a[i__1].i,
+ temp.i = alpha->r * a[i__1].i + alpha->i * a[i__1].r;
+ } else {
+ temp.r = alpha->r * a[i__1].r + alpha->i * a[i__1].i,
+ temp.i = alpha->i * a[i__1].r - alpha->r * a[i__1].i;
+ }
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ i__2 = i + j * *ldb;
+ b[i__2].r += z__1.r, b[i__2].i += z__1.i;
+ }
+ }
+ }
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ if (noconj) {
+ i__1 = k + k * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r + temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ i__1 = k + k * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ if (temp.r != 1. || temp.i != 0.) {
+ for (i = 0; i < *m; ++i) {
+ i__2 = i + k * *ldb;
+ z__1.r = temp.r * b[i__2].r - temp.i * b[i__2].i,
+ z__1.i = temp.r * b[i__2].i + temp.i * b[i__2].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ }
+ }
+ }
+ }
+ }
+} /* ztrmm_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.f
new file mode 100644
index 0000000000000000000000000000000000000000..91a5fde4d77bd42e54c2b143a61308d32013c17e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmm.f
@@ -0,0 +1,392 @@
+ SUBROUTINE ZTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
+ $ B, LDB )
+* .. Scalar Arguments ..
+ CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
+ INTEGER M, N, LDA, LDB
+ COMPLEX*16 ALPHA
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), B( LDB, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZTRMM performs one of the matrix-matrix operations
+*
+* B := alpha*op( A )*B, or B := alpha*B*op( A )
+*
+* where alpha is a scalar, B is an m by n matrix, A is a unit, or
+* non-unit, upper or lower triangular matrix and op( A ) is one of
+*
+* op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).
+*
+* Parameters
+* ==========
+*
+* SIDE - CHARACTER*1.
+* On entry, SIDE specifies whether op( A ) multiplies B from
+* the left or right as follows:
+*
+* SIDE = 'L' or 'l' B := alpha*op( A )*B.
+*
+* SIDE = 'R' or 'r' B := alpha*B*op( A ).
+*
+* Unchanged on exit.
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix A is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANSA - CHARACTER*1.
+* On entry, TRANSA specifies the form of op( A ) to be used in
+* the matrix multiplication as follows:
+*
+* TRANSA = 'N' or 'n' op( A ) = A.
+*
+* TRANSA = 'T' or 't' op( A ) = A'.
+*
+* TRANSA = 'C' or 'c' op( A ) = conjg( A' ).
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit triangular
+* as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* M - INTEGER.
+* On entry, M specifies the number of rows of B. M must be at
+* least zero.
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the number of columns of B. N must be
+* at least zero.
+* Unchanged on exit.
+*
+* ALPHA - COMPLEX*16 .
+* On entry, ALPHA specifies the scalar alpha. When alpha is
+* zero then A is not referenced and B need not be set before
+* entry.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
+* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+* Before entry with UPLO = 'U' or 'u', the leading k by k
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading k by k
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. When SIDE = 'L' or 'l' then
+* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+* then LDA must be at least max( 1, n ).
+* Unchanged on exit.
+*
+* B - COMPLEX*16 array of DIMENSION ( LDB, n ).
+* Before entry, the leading m by n part of the array B must
+* contain the matrix B, and on exit is overwritten by the
+* transformed matrix.
+*
+* LDB - INTEGER.
+* On entry, LDB specifies the first dimension of B as declared
+* in the calling (sub) program. LDB must be at least
+* max( 1, m ).
+* Unchanged on exit.
+*
+*
+* Level 3 Blas routine.
+*
+* -- Written on 8-February-1989.
+* Jack Dongarra, Argonne National Laboratory.
+* Iain Duff, AERE Harwell.
+* Jeremy Du Croz, Numerical Algorithms Group Ltd.
+* Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* .. Local Scalars ..
+ LOGICAL LSIDE, NOCONJ, NOUNIT, UPPER
+ INTEGER I, INFO, J, K, NROWA
+ COMPLEX*16 TEMP
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ LSIDE = LSAME( SIDE , 'L' )
+ IF( LSIDE )THEN
+ NROWA = M
+ ELSE
+ NROWA = N
+ END IF
+ NOCONJ = LSAME( TRANSA, 'T' )
+ NOUNIT = LSAME( DIAG , 'N' )
+ UPPER = LSAME( UPLO , 'U' )
+*
+ INFO = 0
+ IF( ( .NOT.LSIDE ).AND.
+ $ ( .NOT.LSAME( SIDE , 'R' ) ) )THEN
+ INFO = 1
+ ELSE IF( ( .NOT.UPPER ).AND.
+ $ ( .NOT.LSAME( UPLO , 'L' ) ) )THEN
+ INFO = 2
+ ELSE IF( ( .NOT.LSAME( TRANSA, 'N' ) ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'T' ) ).AND.
+ $ ( .NOT.LSAME( TRANSA, 'C' ) ) )THEN
+ INFO = 3
+ ELSE IF( ( .NOT.LSAME( DIAG , 'U' ) ).AND.
+ $ ( .NOT.LSAME( DIAG , 'N' ) ) )THEN
+ INFO = 4
+ ELSE IF( M .LT.0 )THEN
+ INFO = 5
+ ELSE IF( N .LT.0 )THEN
+ INFO = 6
+ ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+ INFO = 9
+ ELSE IF( LDB.LT.MAX( 1, M ) )THEN
+ INFO = 11
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZTRMM ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+* And when alpha.eq.zero.
+*
+ IF( ALPHA.EQ.ZERO )THEN
+ DO 20, J = 1, N
+ DO 10, I = 1, M
+ B( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ RETURN
+ END IF
+*
+* Start the operations.
+*
+ IF( LSIDE )THEN
+ IF( LSAME( TRANSA, 'N' ) )THEN
+*
+* Form B := alpha*A*B.
+*
+ IF( UPPER )THEN
+ DO 50, J = 1, N
+ DO 40, K = 1, M
+ IF( B( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( K, J )
+ DO 30, I = 1, K - 1
+ B( I, J ) = B( I, J ) + TEMP*A( I, K )
+ 30 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( K, K )
+ B( K, J ) = TEMP
+ END IF
+ 40 CONTINUE
+ 50 CONTINUE
+ ELSE
+ DO 80, J = 1, N
+ DO 70 K = M, 1, -1
+ IF( B( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*B( K, J )
+ B( K, J ) = TEMP
+ IF( NOUNIT )
+ $ B( K, J ) = B( K, J )*A( K, K )
+ DO 60, I = K + 1, M
+ B( I, J ) = B( I, J ) + TEMP*A( I, K )
+ 60 CONTINUE
+ END IF
+ 70 CONTINUE
+ 80 CONTINUE
+ END IF
+ ELSE
+*
+* Form B := alpha*B*A' or B := alpha*B*conjg( A' ).
+*
+ IF( UPPER )THEN
+ DO 120, J = 1, N
+ DO 110, I = M, 1, -1
+ TEMP = B( I, J )
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( I, I )
+ DO 90, K = 1, I - 1
+ TEMP = TEMP + A( K, I )*B( K, J )
+ 90 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( I, I ) )
+ DO 100, K = 1, I - 1
+ TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
+ 100 CONTINUE
+ END IF
+ B( I, J ) = ALPHA*TEMP
+ 110 CONTINUE
+ 120 CONTINUE
+ ELSE
+ DO 160, J = 1, N
+ DO 150, I = 1, M
+ TEMP = B( I, J )
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( I, I )
+ DO 130, K = I + 1, M
+ TEMP = TEMP + A( K, I )*B( K, J )
+ 130 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( I, I ) )
+ DO 140, K = I + 1, M
+ TEMP = TEMP + DCONJG( A( K, I ) )*B( K, J )
+ 140 CONTINUE
+ END IF
+ B( I, J ) = ALPHA*TEMP
+ 150 CONTINUE
+ 160 CONTINUE
+ END IF
+ END IF
+ ELSE
+ IF( LSAME( TRANSA, 'N' ) )THEN
+*
+* Form B := alpha*B*A.
+*
+ IF( UPPER )THEN
+ DO 200, J = N, 1, -1
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 170, I = 1, M
+ B( I, J ) = TEMP*B( I, J )
+ 170 CONTINUE
+ DO 190, K = 1, J - 1
+ IF( A( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*A( K, J )
+ DO 180, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 180 CONTINUE
+ END IF
+ 190 CONTINUE
+ 200 CONTINUE
+ ELSE
+ DO 240, J = 1, N
+ TEMP = ALPHA
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 210, I = 1, M
+ B( I, J ) = TEMP*B( I, J )
+ 210 CONTINUE
+ DO 230, K = J + 1, N
+ IF( A( K, J ).NE.ZERO )THEN
+ TEMP = ALPHA*A( K, J )
+ DO 220, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 220 CONTINUE
+ END IF
+ 230 CONTINUE
+ 240 CONTINUE
+ END IF
+ ELSE
+*
+* Form B := alpha*B*A' or B := alpha*B*conjg( A' ).
+*
+ IF( UPPER )THEN
+ DO 280, K = 1, N
+ DO 260, J = 1, K - 1
+ IF( A( J, K ).NE.ZERO )THEN
+ IF( NOCONJ )THEN
+ TEMP = ALPHA*A( J, K )
+ ELSE
+ TEMP = ALPHA*DCONJG( A( J, K ) )
+ END IF
+ DO 250, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 250 CONTINUE
+ END IF
+ 260 CONTINUE
+ TEMP = ALPHA
+ IF( NOUNIT )THEN
+ IF( NOCONJ )THEN
+ TEMP = TEMP*A( K, K )
+ ELSE
+ TEMP = TEMP*DCONJG( A( K, K ) )
+ END IF
+ END IF
+ IF( TEMP.NE.ONE )THEN
+ DO 270, I = 1, M
+ B( I, K ) = TEMP*B( I, K )
+ 270 CONTINUE
+ END IF
+ 280 CONTINUE
+ ELSE
+ DO 320, K = N, 1, -1
+ DO 300, J = K + 1, N
+ IF( A( J, K ).NE.ZERO )THEN
+ IF( NOCONJ )THEN
+ TEMP = ALPHA*A( J, K )
+ ELSE
+ TEMP = ALPHA*DCONJG( A( J, K ) )
+ END IF
+ DO 290, I = 1, M
+ B( I, J ) = B( I, J ) + TEMP*B( I, K )
+ 290 CONTINUE
+ END IF
+ 300 CONTINUE
+ TEMP = ALPHA
+ IF( NOUNIT )THEN
+ IF( NOCONJ )THEN
+ TEMP = TEMP*A( K, K )
+ ELSE
+ TEMP = TEMP*DCONJG( A( K, K ) )
+ END IF
+ END IF
+ IF( TEMP.NE.ONE )THEN
+ DO 310, I = 1, M
+ B( I, K ) = TEMP*B( I, K )
+ 310 CONTINUE
+ END IF
+ 320 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZTRMM .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.c
new file mode 100644
index 0000000000000000000000000000000000000000..75b973a6f0138e164289f3626479d40f4b4ddd55
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.c
@@ -0,0 +1,390 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void ztrmv_(uplo, trans, diag, n, a, lda, x, incx)
+const char *uplo, *trans, *diag;
+const integer *n;
+doublecomplex *a;
+const integer *lda;
+doublecomplex *x;
+const integer *incx;
+{
+ /* System generated locals */
+ integer i__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer info;
+ static doublecomplex temp;
+ static integer i, j;
+ static integer ix, jx, kx;
+ static logical noconj, nounit;
+
+/************************************************************************/
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZTRMV performs one of the matrix-vector operations */
+/* */
+/* x := A*x, or x := A'*x, or x := conjg( A' )*x, */
+/* */
+/* where x is an n element vector and A is an n by n unit, or */
+/* non-unit, upper or lower triangular matrix. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix is an upper or */
+/* lower triangular matrix as follows: */
+/* */
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+/* */
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the operation to be performed as */
+/* follows: */
+/* */
+/* TRANS = 'N' or 'n' x := A*x. */
+/* */
+/* TRANS = 'T' or 't' x := A'*x. */
+/* */
+/* TRANS = 'C' or 'c' x := conjg( A' )*x. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit */
+/* triangular as follows: */
+/* */
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+/* */
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper*/
+/* triangular matrix and the strictly lower triangular part of*/
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower*/
+/* triangular matrix and the strictly upper triangular part of*/
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of*/
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as */
+/* declared in the calling (sub) program. LDA must be at */
+/* least max( 1, n ). */
+/* Unchanged on exit. */
+/* */
+/* X - COMPLEX*16 array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element vector x. On exit, X is overwritten with the */
+/* transformed vector x. */
+/* */
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+/* */
+/************************************************************************/
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 2;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("ZTRMV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+ noconj = lsame_(trans, "T");
+ nounit = lsame_(diag, "N");
+
+/* Set up the start point in X if the increment is not unity. This */
+/* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = (1 - *n) * *incx;
+ } else if (*incx != 1) {
+ kx = 0;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := A*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+
+ if (x[j].r != 0. || x[j].i != 0.) {
+
+ temp.r = x[j].r, temp.i = x[j].i;
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ x[i].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[i].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = x[j].r * a[i__1].r - x[j].i * a[i__1].i,
+ z__1.i = x[j].r * a[i__1].i + x[j].i * a[i__1].r;
+ x[j].r = z__1.r, x[j].i = z__1.i;
+ }
+ }
+ }
+ } else {
+ jx = kx;
+ for (j = 0; j < *n; ++j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = kx;
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ x[ix].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[ix].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ ix += *incx;
+ }
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = x[jx].r * a[i__1].r - x[jx].i * a[i__1].i,
+ z__1.i = x[jx].r * a[i__1].i + x[jx].i * a[i__1].r;
+ x[jx].r = z__1.r, x[jx].i = z__1.i;
+ }
+ }
+ jx += *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n - 1; j >= 0; --j) {
+
+ if (x[j].r != 0. || x[j].i != 0.) {
+
+ temp.r = x[j].r, temp.i = x[j].i;
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ x[i].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[i].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = x[j].r * a[i__1].r - x[j].i * a[i__1].i,
+ z__1.i = x[j].r * a[i__1].i + x[j].i * a[i__1].r;
+ x[j].r = z__1.r, x[j].i = z__1.i;
+ }
+ }
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n - 1; j >= 0; --j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = kx;
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ x[ix].r += temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[ix].i += temp.r * a[i__1].i + temp.i * a[i__1].r;
+ ix -= *incx;
+ }
+ if (nounit) {
+ i__1 = j + j * *lda;
+ x[jx].r = x[jx].r * a[i__1].r - x[jx].i * a[i__1].i,
+ x[jx].i = x[jx].r * a[i__1].i + x[jx].i * a[i__1].r;
+ }
+ }
+ jx -= *incx;
+ }
+ }
+ }
+ } else {
+
+/* Form x := A'*x or x := conjg( A' )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n - 1; j >= 0; --j) {
+
+ temp.r = x[j].r, temp.i = x[j].i;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r + temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j - 1; i >= 0; --i) {
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[i].r - a[i__1].i * x[i].i,
+ temp.i += a[i__1].r * x[i].i + a[i__1].i * x[i].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j - 1; i >= 0; --i) {
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[i].r + a[i__1].i * x[i].i,
+ temp.i += a[i__1].r * x[i].i - a[i__1].i * x[i].r;
+ }
+ }
+
+ x[j].r = temp.r, x[j].i = temp.i;
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n - 1; j >= 0; --j) {
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = jx;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r + temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j - 1; i >= 0; --i) {
+ ix -= *incx;
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[ix].r - a[i__1].i * x[ix].i,
+ temp.i += a[i__1].r * x[ix].i + a[i__1].i * x[ix].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j - 1; i >= 0; --i) {
+ ix -= *incx;
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[ix].r + a[i__1].i * x[ix].i,
+ temp.i += a[i__1].r * x[ix].i - a[i__1].i * x[ix].r;
+ }
+ }
+ x[jx].r = temp.r, x[jx].i = temp.i;
+ jx -= *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ temp.r = x[j].r, temp.i = x[j].i;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r + temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j + 1; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[i].r - a[i__1].i * x[i].i,
+ temp.i += a[i__1].r * x[i].i + a[i__1].i * x[i].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j + 1; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[i].r + a[i__1].i * x[i].i,
+ temp.i += a[i__1].r * x[i].i - a[i__1].i * x[i].r;
+ }
+ }
+
+ x[j].r = temp.r, x[j].i = temp.i;
+ }
+ } else {
+ jx = kx;
+ for (j = 0; j < *n; ++j) {
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = jx;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r + temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j + 1; i < *n; ++i) {
+ ix += *incx;
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[ix].r - a[i__1].i * x[ix].i,
+ temp.i += a[i__1].r * x[ix].i + a[i__1].i * x[ix].r;
+ }
+ } else {
+ if (nounit) {
+ i__1 = j + j * *lda;
+ z__1.r = temp.r * a[i__1].r + temp.i * a[i__1].i,
+ z__1.i = temp.i * a[i__1].r - temp.r * a[i__1].i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i = j + 1; i < *n; ++i) {
+ ix += *incx;
+ i__1 = i + j * *lda;
+ temp.r += a[i__1].r * x[ix].r + a[i__1].i * x[ix].i,
+ temp.i += a[i__1].r * x[ix].i - a[i__1].i * x[ix].r;
+ }
+ }
+ x[jx].r = temp.r, x[jx].i = temp.i;
+ jx += *incx;
+ }
+ }
+ }
+ }
+} /* ztrmv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.f
new file mode 100644
index 0000000000000000000000000000000000000000..10fb73bdbdb9b5f8891b1def34fce2c8b4ca0395
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrmv.f
@@ -0,0 +1,321 @@
+ SUBROUTINE ZTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, LDA, N
+ CHARACTER*1 DIAG, TRANS, UPLO
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZTRMV performs one of the matrix-vector operations
+*
+* x := A*x, or x := A'*x, or x := conjg( A' )*x,
+*
+* where x is an n element vector and A is an n by n unit, or non-unit,
+* upper or lower triangular matrix.
+*
+* Parameters
+* ==========
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the operation to be performed as
+* follows:
+*
+* TRANS = 'N' or 'n' x := A*x.
+*
+* TRANS = 'T' or 't' x := A'*x.
+*
+* TRANS = 'C' or 'c' x := conjg( A' )*x.
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit
+* triangular as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the order of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+* Before entry with UPLO = 'U' or 'u', the leading n by n
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading n by n
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, n ).
+* Unchanged on exit.
+*
+* X - COMPLEX*16 array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the n
+* element vector x. On exit, X is overwritten with the
+* transformed vector x.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I, INFO, IX, J, JX, KX
+ LOGICAL NOCONJ, NOUNIT
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( UPLO , 'U' ).AND.
+ $ .NOT.LSAME( UPLO , 'L' ) )THEN
+ INFO = 1
+ ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 2
+ ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+ $ .NOT.LSAME( DIAG , 'N' ) )THEN
+ INFO = 3
+ ELSE IF( N.LT.0 )THEN
+ INFO = 4
+ ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZTRMV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ NOCONJ = LSAME( TRANS, 'T' )
+ NOUNIT = LSAME( DIAG , 'N' )
+*
+* Set up the start point in X if the increment is not unity. This
+* will be ( N - 1 )*INCX too small for descending loops.
+*
+ IF( INCX.LE.0 )THEN
+ KX = 1 - ( N - 1 )*INCX
+ ELSE IF( INCX.NE.1 )THEN
+ KX = 1
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form x := A*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = 1, N
+ IF( X( J ).NE.ZERO )THEN
+ TEMP = X( J )
+ DO 10, I = 1, J - 1
+ X( I ) = X( I ) + TEMP*A( I, J )
+ 10 CONTINUE
+ IF( NOUNIT )
+ $ X( J ) = X( J )*A( J, J )
+ END IF
+ 20 CONTINUE
+ ELSE
+ JX = KX
+ DO 40, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = X( JX )
+ IX = KX
+ DO 30, I = 1, J - 1
+ X( IX ) = X( IX ) + TEMP*A( I, J )
+ IX = IX + INCX
+ 30 CONTINUE
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )*A( J, J )
+ END IF
+ JX = JX + INCX
+ 40 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 60, J = N, 1, -1
+ IF( X( J ).NE.ZERO )THEN
+ TEMP = X( J )
+ DO 50, I = N, J + 1, -1
+ X( I ) = X( I ) + TEMP*A( I, J )
+ 50 CONTINUE
+ IF( NOUNIT )
+ $ X( J ) = X( J )*A( J, J )
+ END IF
+ 60 CONTINUE
+ ELSE
+ KX = KX + ( N - 1 )*INCX
+ JX = KX
+ DO 80, J = N, 1, -1
+ IF( X( JX ).NE.ZERO )THEN
+ TEMP = X( JX )
+ IX = KX
+ DO 70, I = N, J + 1, -1
+ X( IX ) = X( IX ) + TEMP*A( I, J )
+ IX = IX - INCX
+ 70 CONTINUE
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )*A( J, J )
+ END IF
+ JX = JX - INCX
+ 80 CONTINUE
+ END IF
+ END IF
+ ELSE
+*
+* Form x := A'*x or x := conjg( A' )*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 110, J = N, 1, -1
+ TEMP = X( J )
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 90, I = J - 1, 1, -1
+ TEMP = TEMP + A( I, J )*X( I )
+ 90 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( J, J ) )
+ DO 100, I = J - 1, 1, -1
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+ 100 CONTINUE
+ END IF
+ X( J ) = TEMP
+ 110 CONTINUE
+ ELSE
+ JX = KX + ( N - 1 )*INCX
+ DO 140, J = N, 1, -1
+ TEMP = X( JX )
+ IX = JX
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 120, I = J - 1, 1, -1
+ IX = IX - INCX
+ TEMP = TEMP + A( I, J )*X( IX )
+ 120 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( J, J ) )
+ DO 130, I = J - 1, 1, -1
+ IX = IX - INCX
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+ 130 CONTINUE
+ END IF
+ X( JX ) = TEMP
+ JX = JX - INCX
+ 140 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 170, J = 1, N
+ TEMP = X( J )
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 150, I = J + 1, N
+ TEMP = TEMP + A( I, J )*X( I )
+ 150 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( J, J ) )
+ DO 160, I = J + 1, N
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( I )
+ 160 CONTINUE
+ END IF
+ X( J ) = TEMP
+ 170 CONTINUE
+ ELSE
+ JX = KX
+ DO 200, J = 1, N
+ TEMP = X( JX )
+ IX = JX
+ IF( NOCONJ )THEN
+ IF( NOUNIT )
+ $ TEMP = TEMP*A( J, J )
+ DO 180, I = J + 1, N
+ IX = IX + INCX
+ TEMP = TEMP + A( I, J )*X( IX )
+ 180 CONTINUE
+ ELSE
+ IF( NOUNIT )
+ $ TEMP = TEMP*DCONJG( A( J, J ) )
+ DO 190, I = J + 1, N
+ IX = IX + INCX
+ TEMP = TEMP + DCONJG( A( I, J ) )*X( IX )
+ 190 CONTINUE
+ END IF
+ X( JX ) = TEMP
+ JX = JX + INCX
+ 200 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZTRMV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.c
new file mode 100644
index 0000000000000000000000000000000000000000..5bd0c7ad21dd8be8922ce521e4b83ccd17238eaf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.c
@@ -0,0 +1,355 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void ztrsv_(uplo, trans, diag, n, a, lda, x, incx)
+const char *uplo, *trans, *diag;
+const integer *n;
+const doublecomplex *a;
+const integer *lda;
+doublecomplex *x;
+const integer *incx;
+{
+ /* System generated locals */
+ integer i__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer info;
+ static doublecomplex temp;
+ static integer i, j;
+ static integer ix, jx, kx;
+ static logical noconj, nounit;
+
+/************************************************************************/
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZTRSV solves one of the systems of equations */
+/* */
+/* A*x = b, or A'*x = b, or conjg( A' )*x = b, */
+/* */
+/* where b and x are n element vectors and A is an n by n unit, or */
+/* non-unit, upper or lower triangular matrix. */
+/* */
+/* No test for singularity or near-singularity is included in this */
+/* routine. Such tests must be performed before calling this routine. */
+/* */
+/* Parameters */
+/* ========== */
+/* */
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix is an upper or */
+/* lower triangular matrix as follows: */
+/* */
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+/* */
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the equations to be solved as */
+/* follows: */
+/* */
+/* TRANS = 'N' or 'n' A*x = b. */
+/* */
+/* TRANS = 'T' or 't' A'*x = b. */
+/* */
+/* TRANS = 'C' or 'c' conjg( A' )*x = b. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit */
+/* triangular as follows: */
+/* */
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+/* */
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+/* */
+/* Unchanged on exit. */
+/* */
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+/* */
+/* A - COMPLEX*16 array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper*/
+/* triangular matrix and the strictly lower triangular part of*/
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower*/
+/* triangular matrix and the strictly upper triangular part of*/
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of*/
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+/* */
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as */
+/* declared in the calling (sub) program. LDA must be at */
+/* least max( 1, n ). */
+/* Unchanged on exit. */
+/* */
+/* X - COMPLEX*16 array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element right-hand side vector b. On exit, X is overwritten*/
+/* with the solution vector x. */
+/* */
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+/* */
+/************************************************************************/
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")) {
+ info = 2;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag, "N")) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("ZTRSV ", &info);
+ return;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return;
+ }
+
+ noconj = lsame_(trans, "T");
+ nounit = lsame_(diag, "N");
+
+/* Set up the start point in X if the increment is not unity. This */
+/* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = (1 - *n) * *incx;
+ } else if (*incx != 1) {
+ kx = 0;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := inv( A )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n - 1; j >= 0; --j) {
+ if (x[j].r != 0. || x[j].i != 0.) {
+ if (nounit) {
+ z_div(&x[j], &x[j], &a[j + j * *lda]);
+ }
+ temp.r = x[j].r, temp.i = x[j].i;
+ for (i = j - 1; i >= 0; --i) {
+ i__1 = i + j * *lda;
+ x[i].r -= temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[i].i -= temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n - 1; j >= 0; --j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ if (nounit) {
+ z_div(&x[jx], &x[jx], &a[j + j * *lda]);
+ }
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = jx;
+ for (i = j - 1; i >= 0; --i) {
+ ix -= *incx;
+ i__1 = i + j * *lda;
+ x[ix].r -= temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[ix].i -= temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ jx -= *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ if (x[j].r != 0. || x[j].i != 0.) {
+ if (nounit) {
+ z_div(&x[j], &x[j], &a[j + j * *lda]);
+ }
+ temp.r = x[j].r, temp.i = x[j].i;
+ for (i = j + 1; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ x[i].r -= temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[i].i -= temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ }
+ } else {
+ jx = kx;
+ for (j = 0; j < *n; ++j) {
+ if (x[jx].r != 0. || x[jx].i != 0.) {
+ if (nounit) {
+ z_div(&x[jx], &x[jx], &a[j + j * *lda]);
+ }
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ ix = jx;
+ for (i = j + 1; i < *n; ++i) {
+ ix += *incx;
+ i__1 = i + j * *lda;
+ x[ix].r -= temp.r * a[i__1].r - temp.i * a[i__1].i,
+ x[ix].i -= temp.r * a[i__1].i + temp.i * a[i__1].r;
+ }
+ }
+ jx += *incx;
+ }
+ }
+ }
+ } else {
+
+/* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = 0; j < *n; ++j) {
+ temp.r = x[j].r, temp.i = x[j].i;
+ if (noconj) {
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[i].r - a[i__1].i * x[i].i,
+ temp.i -= a[i__1].r * x[i].i + a[i__1].i * x[i].r;
+ }
+ if (nounit) {
+ z_div(&temp, &temp, &a[j + j * *lda]);
+ }
+ } else {
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[i].r + a[i__1].i * x[i].i,
+ temp.i -= a[i__1].r * x[i].i - a[i__1].i * x[i].r;
+ }
+ if (nounit) {
+ d_cnjg(&z__1, &a[j + j * *lda]);
+ z_div(&temp, &temp, &z__1);
+ }
+ }
+ x[j].r = temp.r, x[j].i = temp.i;
+ }
+ } else {
+ jx = kx;
+ for (j = 0; j < *n; ++j) {
+ ix = kx;
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ if (noconj) {
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[ix].r - a[i__1].i * x[ix].i,
+ temp.i -= a[i__1].r * x[ix].i + a[i__1].i * x[ix].r;
+ ix += *incx;
+ }
+ if (nounit) {
+ z_div(&temp, &temp, &a[j + j * *lda]);
+ }
+ } else {
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[ix].r + a[i__1].i * x[ix].i,
+ temp.i -= a[i__1].r * x[ix].i - a[i__1].i * x[ix].r;
+ ix += *incx;
+ }
+ if (nounit) {
+ d_cnjg(&z__1, &a[j + j * *lda]);
+ z_div(&temp, &temp, &z__1);
+ }
+ }
+ x[jx].r = temp.r, x[jx].i = temp.i;
+ jx += *incx;
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n - 1; j >= 0; --j) {
+ temp.r = x[j].r, temp.i = x[j].i;
+ if (noconj) {
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[i].r - a[i__1].i * x[i].i,
+ temp.i -= a[i__1].r * x[i].i + a[i__1].i * x[i].r;
+ }
+ if (nounit) {
+ z_div(&temp, &temp, &a[j + j * *lda]);
+ }
+ } else {
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[i].r + a[i__1].i * x[i].i,
+ temp.i -= a[i__1].r * x[i].i - a[i__1].i * x[i].r;
+ }
+ if (nounit) {
+ d_cnjg(&z__1, &a[j + j * *lda]);
+ z_div(&temp, &temp, &z__1);
+ }
+ }
+ x[j].r = temp.r, x[j].i = temp.i;
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n - 1; j >= 0; --j) {
+ ix = kx;
+ temp.r = x[jx].r, temp.i = x[jx].i;
+ if (noconj) {
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[ix].r - a[i__1].i * x[ix].i,
+ temp.i -= a[i__1].r * x[ix].i + a[i__1].i * x[ix].r;
+ ix -= *incx;
+ }
+ if (nounit) {
+ z_div(&temp, &temp, &a[j + j * *lda]);
+ }
+ } else {
+ for (i = *n - 1; i > j; --i) {
+ i__1 = i + j * *lda;
+ temp.r -= a[i__1].r * x[ix].r + a[i__1].i * x[ix].i,
+ temp.i -= a[i__1].r * x[ix].i - a[i__1].i * x[ix].r;
+ ix -= *incx;
+ }
+ if (nounit) {
+ d_cnjg(&z__1, &a[j + j * *lda]);
+ z_div(&temp, &temp, &z__1);
+ }
+ }
+ x[jx].r = temp.r, x[jx].i = temp.i;
+ jx -= *incx;
+ }
+ }
+ }
+ }
+} /* ztrsv_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.f
new file mode 100644
index 0000000000000000000000000000000000000000..d0a57c44742cbec19d07d69ae6039264f55781bd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/ztrsv.f
@@ -0,0 +1,324 @@
+ SUBROUTINE ZTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+* .. Scalar Arguments ..
+ INTEGER INCX, LDA, N
+ CHARACTER*1 DIAG, TRANS, UPLO
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), X( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZTRSV solves one of the systems of equations
+*
+* A*x = b, or A'*x = b, or conjg( A' )*x = b,
+*
+* where b and x are n element vectors and A is an n by n unit, or
+* non-unit, upper or lower triangular matrix.
+*
+* No test for singularity or near-singularity is included in this
+* routine. Such tests must be performed before calling this routine.
+*
+* Parameters
+* ==========
+*
+* UPLO - CHARACTER*1.
+* On entry, UPLO specifies whether the matrix is an upper or
+* lower triangular matrix as follows:
+*
+* UPLO = 'U' or 'u' A is an upper triangular matrix.
+*
+* UPLO = 'L' or 'l' A is a lower triangular matrix.
+*
+* Unchanged on exit.
+*
+* TRANS - CHARACTER*1.
+* On entry, TRANS specifies the equations to be solved as
+* follows:
+*
+* TRANS = 'N' or 'n' A*x = b.
+*
+* TRANS = 'T' or 't' A'*x = b.
+*
+* TRANS = 'C' or 'c' conjg( A' )*x = b.
+*
+* Unchanged on exit.
+*
+* DIAG - CHARACTER*1.
+* On entry, DIAG specifies whether or not A is unit
+* triangular as follows:
+*
+* DIAG = 'U' or 'u' A is assumed to be unit triangular.
+*
+* DIAG = 'N' or 'n' A is not assumed to be unit
+* triangular.
+*
+* Unchanged on exit.
+*
+* N - INTEGER.
+* On entry, N specifies the order of the matrix A.
+* N must be at least zero.
+* Unchanged on exit.
+*
+* A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+* Before entry with UPLO = 'U' or 'u', the leading n by n
+* upper triangular part of the array A must contain the upper
+* triangular matrix and the strictly lower triangular part of
+* A is not referenced.
+* Before entry with UPLO = 'L' or 'l', the leading n by n
+* lower triangular part of the array A must contain the lower
+* triangular matrix and the strictly upper triangular part of
+* A is not referenced.
+* Note that when DIAG = 'U' or 'u', the diagonal elements of
+* A are not referenced either, but are assumed to be unity.
+* Unchanged on exit.
+*
+* LDA - INTEGER.
+* On entry, LDA specifies the first dimension of A as declared
+* in the calling (sub) program. LDA must be at least
+* max( 1, n ).
+* Unchanged on exit.
+*
+* X - COMPLEX*16 array of dimension at least
+* ( 1 + ( n - 1 )*abs( INCX ) ).
+* Before entry, the incremented array X must contain the n
+* element right-hand side vector b. On exit, X is overwritten
+* with the solution vector x.
+*
+* INCX - INTEGER.
+* On entry, INCX specifies the increment for the elements of
+* X. INCX must not be zero.
+* Unchanged on exit.
+*
+*
+* Level 2 Blas routine.
+*
+* -- Written on 22-October-1986.
+* Jack Dongarra, Argonne National Lab.
+* Jeremy Du Croz, Nag Central Office.
+* Sven Hammarling, Nag Central Office.
+* Richard Hanson, Sandia National Labs.
+*
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* .. Local Scalars ..
+ COMPLEX*16 TEMP
+ INTEGER I, INFO, IX, J, JX, KX
+ LOGICAL NOCONJ, NOUNIT
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* .. External Subroutines ..
+ EXTERNAL XERBLA
+* .. Intrinsic Functions ..
+ INTRINSIC DCONJG, MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input parameters.
+*
+ INFO = 0
+ IF ( .NOT.LSAME( UPLO , 'U' ).AND.
+ $ .NOT.LSAME( UPLO , 'L' ) )THEN
+ INFO = 1
+ ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.
+ $ .NOT.LSAME( TRANS, 'T' ).AND.
+ $ .NOT.LSAME( TRANS, 'C' ) )THEN
+ INFO = 2
+ ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.
+ $ .NOT.LSAME( DIAG , 'N' ) )THEN
+ INFO = 3
+ ELSE IF( N.LT.0 )THEN
+ INFO = 4
+ ELSE IF( LDA.LT.MAX( 1, N ) )THEN
+ INFO = 6
+ ELSE IF( INCX.EQ.0 )THEN
+ INFO = 8
+ END IF
+ IF( INFO.NE.0 )THEN
+ CALL XERBLA( 'ZTRSV ', INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible.
+*
+ IF( N.EQ.0 )
+ $ RETURN
+*
+ NOCONJ = LSAME( TRANS, 'T' )
+ NOUNIT = LSAME( DIAG , 'N' )
+*
+* Set up the start point in X if the increment is not unity. This
+* will be ( N - 1 )*INCX too small for descending loops.
+*
+ IF( INCX.LE.0 )THEN
+ KX = 1 - ( N - 1 )*INCX
+ ELSE IF( INCX.NE.1 )THEN
+ KX = 1
+ END IF
+*
+* Start the operations. In this version the elements of A are
+* accessed sequentially with one pass through A.
+*
+ IF( LSAME( TRANS, 'N' ) )THEN
+*
+* Form x := inv( A )*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 20, J = N, 1, -1
+ IF( X( J ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( J ) = X( J )/A( J, J )
+ TEMP = X( J )
+ DO 10, I = J - 1, 1, -1
+ X( I ) = X( I ) - TEMP*A( I, J )
+ 10 CONTINUE
+ END IF
+ 20 CONTINUE
+ ELSE
+ JX = KX + ( N - 1 )*INCX
+ DO 40, J = N, 1, -1
+ IF( X( JX ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )/A( J, J )
+ TEMP = X( JX )
+ IX = JX
+ DO 30, I = J - 1, 1, -1
+ IX = IX - INCX
+ X( IX ) = X( IX ) - TEMP*A( I, J )
+ 30 CONTINUE
+ END IF
+ JX = JX - INCX
+ 40 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 60, J = 1, N
+ IF( X( J ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( J ) = X( J )/A( J, J )
+ TEMP = X( J )
+ DO 50, I = J + 1, N
+ X( I ) = X( I ) - TEMP*A( I, J )
+ 50 CONTINUE
+ END IF
+ 60 CONTINUE
+ ELSE
+ JX = KX
+ DO 80, J = 1, N
+ IF( X( JX ).NE.ZERO )THEN
+ IF( NOUNIT )
+ $ X( JX ) = X( JX )/A( J, J )
+ TEMP = X( JX )
+ IX = JX
+ DO 70, I = J + 1, N
+ IX = IX + INCX
+ X( IX ) = X( IX ) - TEMP*A( I, J )
+ 70 CONTINUE
+ END IF
+ JX = JX + INCX
+ 80 CONTINUE
+ END IF
+ END IF
+ ELSE
+*
+* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x.
+*
+ IF( LSAME( UPLO, 'U' ) )THEN
+ IF( INCX.EQ.1 )THEN
+ DO 110, J = 1, N
+ TEMP = X( J )
+ IF( NOCONJ )THEN
+ DO 90, I = 1, J - 1
+ TEMP = TEMP - A( I, J )*X( I )
+ 90 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ ELSE
+ DO 100, I = 1, J - 1
+ TEMP = TEMP - DCONJG( A( I, J ) )*X( I )
+ 100 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/DCONJG( A( J, J ) )
+ END IF
+ X( J ) = TEMP
+ 110 CONTINUE
+ ELSE
+ JX = KX
+ DO 140, J = 1, N
+ IX = KX
+ TEMP = X( JX )
+ IF( NOCONJ )THEN
+ DO 120, I = 1, J - 1
+ TEMP = TEMP - A( I, J )*X( IX )
+ IX = IX + INCX
+ 120 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ ELSE
+ DO 130, I = 1, J - 1
+ TEMP = TEMP - DCONJG( A( I, J ) )*X( IX )
+ IX = IX + INCX
+ 130 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/DCONJG( A( J, J ) )
+ END IF
+ X( JX ) = TEMP
+ JX = JX + INCX
+ 140 CONTINUE
+ END IF
+ ELSE
+ IF( INCX.EQ.1 )THEN
+ DO 170, J = N, 1, -1
+ TEMP = X( J )
+ IF( NOCONJ )THEN
+ DO 150, I = N, J + 1, -1
+ TEMP = TEMP - A( I, J )*X( I )
+ 150 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ ELSE
+ DO 160, I = N, J + 1, -1
+ TEMP = TEMP - DCONJG( A( I, J ) )*X( I )
+ 160 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/DCONJG( A( J, J ) )
+ END IF
+ X( J ) = TEMP
+ 170 CONTINUE
+ ELSE
+ KX = KX + ( N - 1 )*INCX
+ JX = KX
+ DO 200, J = N, 1, -1
+ IX = KX
+ TEMP = X( JX )
+ IF( NOCONJ )THEN
+ DO 180, I = N, J + 1, -1
+ TEMP = TEMP - A( I, J )*X( IX )
+ IX = IX - INCX
+ 180 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/A( J, J )
+ ELSE
+ DO 190, I = N, J + 1, -1
+ TEMP = TEMP - DCONJG( A( I, J ) )*X( IX )
+ IX = IX - INCX
+ 190 CONTINUE
+ IF( NOUNIT )
+ $ TEMP = TEMP/DCONJG( A( J, J ) )
+ END IF
+ X( JX ) = TEMP
+ JX = JX - INCX
+ 200 CONTINUE
+ END IF
+ END IF
+ END IF
+*
+ RETURN
+*
+* End of ZTRSV .
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.c
new file mode 100644
index 0000000000000000000000000000000000000000..d45c8f63ec691de02a0c75cf07228738a2d351b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.c
@@ -0,0 +1,137 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+
+/* Subroutine */ void zung2r_(m, n, k, a, lda, tau, work, info)
+const integer *m, *n, *k;
+doublecomplex *a;
+const integer *lda;
+const doublecomplex *tau;
+doublecomplex *work;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i, j, l;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZUNG2R generates an m by n complex matrix Q with orthonormal columns, */
+/* which is defined as the first n columns of a product of k elementary */
+/* reflectors of order m */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by ZGEQRF. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. M >= N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. N >= K >= 0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the i-th column must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by ZGEQRF in the first k columns of its array */
+/* argument A. */
+/* On exit, the m by n matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (input) COMPLEX*16 array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by ZGEQRF. */
+/* */
+/* WORK (workspace) COMPLEX*16 array, dimension (N) */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNG2R", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return;
+ }
+
+/* Initialise columns k+1:n to columns of the unit matrix */
+
+ for (j = *k; j < *n; ++j) {
+ for (l = 0; l < *m; ++l) {
+ i__1 = l + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ i__1 = j + j * *lda;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ }
+
+ for (i = *k - 1; i >= 0; --i) {
+
+/* Apply H(i) to A(i:m,i:n) from the left */
+
+ if (i+1 < *n) {
+ i__1 = i + i * *lda;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ i__1 = *m - i;
+ i__2 = *n - i - 1;
+ zlarf_("Left", &i__1, &i__2, &a[i + i * *lda], &c__1, &tau[i], &a[i + (i+1) * *lda], lda, work);
+ }
+ if (i+1 < *m) {
+ i__1 = *m - i - 1;
+ z__1.r = -tau[i].r, z__1.i = -tau[i].i;
+ zscal_(&i__1, &z__1, &a[i + 1 + i * *lda], &c__1);
+ }
+ i__1 = i + i * *lda;
+ a[i__1].r = 1. - tau[i].r,
+ a[i__1].i = 0. - tau[i].i;
+
+/* Set A(1:i-1,i) to zero */
+
+ for (l = 0; l < i; ++l) {
+ i__1 = l + i * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ }
+} /* zung2r_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.f
new file mode 100644
index 0000000000000000000000000000000000000000..e9f52dff90561ed4f683dcc1422961c7c1fe07b8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zung2r.f
@@ -0,0 +1,131 @@
+ SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZUNG2R generates an m by n complex matrix Q with orthonormal columns,
+* which is defined as the first n columns of a product of k elementary
+* reflectors of order m
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by ZGEQRF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. M >= N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. N >= K >= 0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the i-th column must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by ZGEQRF in the first k columns of its array
+* argument A.
+* On exit, the m by n matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) COMPLEX*16 array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by ZGEQRF.
+*
+* WORK (workspace) COMPLEX*16 array, dimension (N)
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE, ZERO
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
+ $ ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, J, L
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARF, ZSCAL
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZUNG2R', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 )
+ $ RETURN
+*
+* Initialise columns k+1:n to columns of the unit matrix
+*
+ DO 20 J = K + 1, N
+ DO 10 L = 1, M
+ A( L, J ) = ZERO
+ 10 CONTINUE
+ A( J, J ) = ONE
+ 20 CONTINUE
+*
+ DO 40 I = K, 1, -1
+*
+* Apply H(i) to A(i:m,i:n) from the left
+*
+ IF( I.LT.N ) THEN
+ A( I, I ) = ONE
+ CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+ $ A( I, I+1 ), LDA, WORK )
+ END IF
+ IF( I.LT.M )
+ $ CALL ZSCAL( M-I, -TAU( I ), A( I+1, I ), 1 )
+ A( I, I ) = ONE - TAU( I )
+*
+* Set A(1:i-1,i) to zero
+*
+ DO 30 L = 1, I - 1
+ A( L, I ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ RETURN
+*
+* End of ZUNG2R
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.c
new file mode 100644
index 0000000000000000000000000000000000000000..ab4804ed21620f515db242b2b6489c8afd198090
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.c
@@ -0,0 +1,147 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Subroutine */ void zunghr_(n, ilo, ihi, a, lda, tau, work, lwork, info)
+const integer *n;
+integer *ilo, *ihi;
+doublecomplex *a;
+const integer *lda;
+const doublecomplex *tau;
+doublecomplex *work;
+const integer *lwork;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i, j, iinfo, nh;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZUNGHR generates a complex unitary matrix Q which is defined as the */
+/* product of IHI-ILO elementary reflectors of order N, as returned by */
+/* ZGEHRD: */
+/* */
+/* Q = H(ilo) H(ilo+1) . . . H(ihi-1). */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* N (input) INTEGER */
+/* The order of the matrix Q. N >= 0. */
+/* */
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* ILO and IHI must have the same values as in the previous call */
+/* of ZGEHRD. Q is equal to the unit matrix except in the */
+/* submatrix Q(ilo+1:ihi,ilo+1:ihi). */
+/* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the vectors which define the elementary reflectors, */
+/* as returned by ZGEHRD. */
+/* On exit, the N-by-N unitary matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+/* */
+/* TAU (input) COMPLEX*16 array, dimension (N-1) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by ZGEHRD. */
+/* */
+/* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= IHI-ILO. */
+/* For optimum performance LWORK >= (IHI-ILO)*NB, where NB is */
+/* the optimal blocksize. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else /* if(complicated condition) */ {
+ if (*lwork < max(1, *ihi - *ilo)) {
+ *info = -8;
+ }
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGHR", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ work[0].r = 1., work[0].i = 0.;
+ return;
+ }
+
+/* Shift the vectors which define the elementary reflectors one */
+/* column to the right, and set the first ilo and the last n-ihi */
+/* rows and columns to those of the unit matrix */
+
+ for (j = *ihi - 1; j >= *ilo; --j) {
+ for (i = 0; i < j; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ for (i = j + 1; i < *ihi; ++i) {
+ i__1 = i + j * *lda;
+ i__2 = i + (j-1) * *lda;
+ a[i__1].r = a[i__2].r, a[i__1].i = a[i__2].i;
+ }
+ for (i = *ihi; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ }
+ for (j = 0; j < *ilo; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ i__1 = j + j * *lda;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ }
+ for (j = *ihi; j < *n; ++j) {
+ for (i = 0; i < *n; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ i__1 = j + j * *lda;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ }
+
+ nh = *ihi - *ilo;
+ if (nh > 0) {
+
+/* Generate Q(ilo+1:ihi,ilo+1:ihi) */
+
+ zungqr_(&nh, &nh, &nh, &a[*ilo + *ilo * *lda], lda, &tau[*ilo-1], work, lwork, &iinfo);
+ }
+} /* zunghr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.f
new file mode 100644
index 0000000000000000000000000000000000000000..d49dae1913331307a0ba99962e7119e894394605
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zunghr.f
@@ -0,0 +1,145 @@
+ SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER IHI, ILO, INFO, LDA, LWORK, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( LWORK )
+* ..
+*
+* Purpose
+* =======
+*
+* ZUNGHR generates a complex unitary matrix Q which is defined as the
+* product of IHI-ILO elementary reflectors of order N, as returned by
+* ZGEHRD:
+*
+* Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+*
+* Arguments
+* =========
+*
+* N (input) INTEGER
+* The order of the matrix Q. N >= 0.
+*
+* ILO (input) INTEGER
+* IHI (input) INTEGER
+* ILO and IHI must have the same values as in the previous call
+* of ZGEHRD. Q is equal to the unit matrix except in the
+* submatrix Q(ilo+1:ihi,ilo+1:ihi).
+* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the vectors which define the elementary reflectors,
+* as returned by ZGEHRD.
+* On exit, the N-by-N unitary matrix Q.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* TAU (input) COMPLEX*16 array, dimension (N-1)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by ZGEHRD.
+*
+* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= IHI-ILO.
+* For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+* the optimal blocksize.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO, ONE
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
+ $ ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, IINFO, J, NH
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZUNGQR
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( N.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
+ INFO = -2
+ ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+ INFO = -5
+ ELSE IF( LWORK.LT.MAX( 1, IHI-ILO ) ) THEN
+ INFO = -8
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZUNGHR', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.EQ.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+* Shift the vectors which define the elementary reflectors one
+* column to the right, and set the first ilo and the last n-ihi
+* rows and columns to those of the unit matrix
+*
+ DO 40 J = IHI, ILO + 1, -1
+ DO 10 I = 1, J - 1
+ A( I, J ) = ZERO
+ 10 CONTINUE
+ DO 20 I = J + 1, IHI
+ A( I, J ) = A( I, J-1 )
+ 20 CONTINUE
+ DO 30 I = IHI + 1, N
+ A( I, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ DO 60 J = 1, ILO
+ DO 50 I = 1, N
+ A( I, J ) = ZERO
+ 50 CONTINUE
+ A( J, J ) = ONE
+ 60 CONTINUE
+ DO 80 J = IHI + 1, N
+ DO 70 I = 1, N
+ A( I, J ) = ZERO
+ 70 CONTINUE
+ A( J, J ) = ONE
+ 80 CONTINUE
+*
+ NH = IHI - ILO
+ IF( NH.GT.0 ) THEN
+*
+* Generate Q(ilo+1:ihi,ilo+1:ihi)
+*
+ CALL ZUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
+ $ WORK, LWORK, IINFO )
+ END IF
+ RETURN
+*
+* End of ZUNGHR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.c b/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.c
new file mode 100644
index 0000000000000000000000000000000000000000..e5d6606cdb60cd518ac94beb40116815d08fbdd0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.c
@@ -0,0 +1,213 @@
+#include "f2c.h"
+#include "netlib.h"
+
+/* Modified by Peter Vanroose, June 2001: manual optimisation and clean-up */
+
+/* Table of constant values */
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+
+/* Subroutine */ void zungqr_(m, n, k, a, lda, tau, work, lwork, info)
+const integer *m, *n, *k;
+doublecomplex *a;
+const integer *lda;
+const doublecomplex *tau;
+doublecomplex *work;
+const integer *lwork;
+integer *info;
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i, j, l, nbmin, iinfo, ib, nb, ki, kk;
+ static integer nx;
+ static integer ldwork;
+ static integer iws;
+
+/* -- LAPACK routine (version 2.0) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
+/* Courant Institute, Argonne National Lab, and Rice University */
+/* September 30, 1994 */
+
+/* ===================================================================== */
+/* */
+/* Purpose */
+/* ======= */
+/* */
+/* ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns, */
+/* which is defined as the first N columns of a product of K elementary */
+/* reflectors of order M */
+/* */
+/* Q = H(1) H(2) . . . H(k) */
+/* */
+/* as returned by ZGEQRF. */
+/* */
+/* Arguments */
+/* ========= */
+/* */
+/* M (input) INTEGER */
+/* The number of rows of the matrix Q. M >= 0. */
+/* */
+/* N (input) INTEGER */
+/* The number of columns of the matrix Q. M >= N >= 0. */
+/* */
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines the */
+/* matrix Q. N >= K >= 0. */
+/* */
+/* A (input/output) COMPLEX*16 array, dimension (LDA,N) */
+/* On entry, the i-th column must contain the vector which */
+/* defines the elementary reflector H(i), for i = 1,2,...,k, as */
+/* returned by ZGEQRF in the first k columns of its array */
+/* argument A. */
+/* On exit, the M-by-N matrix Q. */
+/* */
+/* LDA (input) INTEGER */
+/* The first dimension of the array A. LDA >= max(1,M). */
+/* */
+/* TAU (input) COMPLEX*16 array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by ZGEQRF. */
+/* */
+/* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+/* */
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* For optimum performance LWORK >= N*NB, where NB is the */
+/* optimal blocksize. */
+/* */
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument has an illegal value */
+/* */
+/* ===================================================================== */
+
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*lwork < max(1,*n)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGQR", &i__1);
+ return;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ work[0].r = 1., work[0].i = 0.;
+ return;
+ }
+
+/* Determine the block size. */
+
+ nb = ilaenv_(&c__1, "ZUNGQR", " ", m, n, k, &c_n1);
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if (nb > 1 && nb < *k) {
+
+/* Determine when to cross over from blocked to unblocked code. */
+
+ i__1 = ilaenv_(&c__3, "ZUNGQR", " ", m, n, k, &c_n1);
+ nx = max(0,i__1);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/* Not enough workspace to use optimal NB: reduce NB and */
+/* determine the minimum value of NB. */
+
+ nb = *lwork / ldwork;
+ i__1 = ilaenv_(&c__2, "ZUNGQR", " ", m, n, k, &c_n1);
+ nbmin = max(2,i__1);
+ }
+ }
+ }
+
+ if (nb >= nbmin && nb < *k && nx < *k) {
+
+/* Use blocked code after the last block. */
+/* The first kk columns are handled by the block method. */
+
+ ki = (*k - nx - 1) / nb * nb;
+ kk = min(*k, ki+nb);
+
+/* Set A(1:kk,kk+1:n) to zero. */
+
+ for (j = kk; j < *n; ++j) {
+ for (i = 0; i < kk; ++i) {
+ i__1 = i + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *n) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ zung2r_(&i__1, &i__2, &i__3, &a[kk+kk* *lda], lda, &tau[kk], work, &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ for (i = ki; nb > 0 ? i >= 0 : i <= 0; i -= nb) {
+ ib = min(nb, *k - i);
+ if (i+1 + ib <= *n) {
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__1 = *m - i;
+ zlarft_("Forward", "Columnwise", &i__1, &ib, &a[i+i* *lda], lda, &tau[i], work, &ldwork);
+
+/* Apply H to A(i:m,i+ib:n) from the left */
+
+ i__1 = *m - i;
+ i__2 = *n - i - ib;
+ zlarfb_("Left", "No transpose", "Forward", "Columnwise",
+ &i__1, &i__2, &ib, &a[i+i* *lda], lda, work, &ldwork,
+ &a[i+(i+ib)* *lda], lda, &work[ib], &ldwork);
+ }
+
+/* Apply H to rows i:m of current block */
+
+ i__1 = *m - i;
+ zung2r_(&i__1, &ib, &ib, &a[i+i* *lda], lda, &tau[i], work, &iinfo);
+
+/* Set rows 1:i-1 of current block to zero */
+
+ for (j = i; j < i + ib; ++j) {
+ for (l = 0; l < i; ++l) {
+ i__1 = l + j * *lda;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ }
+ }
+ }
+ }
+
+ work[0].r = (doublereal) iws, work[0].i = 0.;
+} /* zungqr_ */
diff --git a/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.f b/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.f
new file mode 100644
index 0000000000000000000000000000000000000000..9cbbfa09f7343affb281768ee9ccad0995d96ca1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/v3p/netlib/zungqr.f
@@ -0,0 +1,208 @@
+ SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
+*
+* -- LAPACK routine (version 2.0) --
+* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+* Courant Institute, Argonne National Lab, and Rice University
+* September 30, 1994
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, LDA, LWORK, M, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( LWORK )
+* ..
+*
+* Purpose
+* =======
+*
+* ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns,
+* which is defined as the first N columns of a product of K elementary
+* reflectors of order M
+*
+* Q = H(1) H(2) . . . H(k)
+*
+* as returned by ZGEQRF.
+*
+* Arguments
+* =========
+*
+* M (input) INTEGER
+* The number of rows of the matrix Q. M >= 0.
+*
+* N (input) INTEGER
+* The number of columns of the matrix Q. M >= N >= 0.
+*
+* K (input) INTEGER
+* The number of elementary reflectors whose product defines the
+* matrix Q. N >= K >= 0.
+*
+* A (input/output) COMPLEX*16 array, dimension (LDA,N)
+* On entry, the i-th column must contain the vector which
+* defines the elementary reflector H(i), for i = 1,2,...,k, as
+* returned by ZGEQRF in the first k columns of its array
+* argument A.
+* On exit, the M-by-N matrix Q.
+*
+* LDA (input) INTEGER
+* The first dimension of the array A. LDA >= max(1,M).
+*
+* TAU (input) COMPLEX*16 array, dimension (K)
+* TAU(i) must contain the scalar factor of the elementary
+* reflector H(i), as returned by ZGEQRF.
+*
+* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+* LWORK (input) INTEGER
+* The dimension of the array WORK. LWORK >= max(1,N).
+* For optimum performance LWORK >= N*NB, where NB is the
+* optimal blocksize.
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -i, the i-th argument has an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ZERO
+ PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK, NB,
+ $ NBMIN, NX
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNG2R
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MAX, MIN
+* ..
+* .. External Functions ..
+ INTEGER ILAENV
+ EXTERNAL ILAENV
+* ..
+* .. Executable Statements ..
+*
+* Test the input arguments
+*
+ INFO = 0
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 .OR. N.GT.M ) THEN
+ INFO = -2
+ ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
+ INFO = -3
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -5
+ ELSE IF( LWORK.LT.MAX( 1, N ) ) THEN
+ INFO = -8
+ END IF
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZUNGQR', -INFO )
+ RETURN
+ END IF
+*
+* Quick return if possible
+*
+ IF( N.LE.0 ) THEN
+ WORK( 1 ) = 1
+ RETURN
+ END IF
+*
+* Determine the block size.
+*
+ NB = ILAENV( 1, 'ZUNGQR', ' ', M, N, K, -1 )
+ NBMIN = 2
+ NX = 0
+ IWS = N
+ IF( NB.GT.1 .AND. NB.LT.K ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+*
+ NX = MAX( 0, ILAENV( 3, 'ZUNGQR', ' ', M, N, K, -1 ) )
+ IF( NX.LT.K ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ LDWORK = N
+ IWS = LDWORK*NB
+ IF( LWORK.LT.IWS ) THEN
+*
+* Not enough workspace to use optimal NB: reduce NB and
+* determine the minimum value of NB.
+*
+ NB = LWORK / LDWORK
+ NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K, -1 ) )
+ END IF
+ END IF
+ END IF
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
+*
+* Use blocked code after the last block.
+* The first kk columns are handled by the block method.
+*
+ KI = ( ( K-NX-1 ) / NB )*NB
+ KK = MIN( K, KI+NB )
+*
+* Set A(1:kk,kk+1:n) to zero.
+*
+ DO 20 J = KK + 1, N
+ DO 10 I = 1, KK
+ A( I, J ) = ZERO
+ 10 CONTINUE
+ 20 CONTINUE
+ ELSE
+ KK = 0
+ END IF
+*
+* Use unblocked code for the last or only block.
+*
+ IF( KK.LT.N )
+ $ CALL ZUNG2R( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
+ $ TAU( KK+1 ), WORK, IINFO )
+*
+ IF( KK.GT.0 ) THEN
+*
+* Use blocked code
+*
+ DO 50 I = KI + 1, 1, -NB
+ IB = MIN( NB, K-I+1 )
+ IF( I+IB.LE.N ) THEN
+*
+* Form the triangular factor of the block reflector
+* H = H(i) H(i+1) . . . H(i+ib-1)
+*
+ CALL ZLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+ $ A( I, I ), LDA, TAU( I ), WORK, LDWORK )
+*
+* Apply H to A(i:m,i+ib:n) from the left
+*
+ CALL ZLARFB( 'Left', 'No transpose', 'Forward',
+ $ 'Columnwise', M-I+1, N-I-IB+1, IB,
+ $ A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
+ $ LDA, WORK( IB+1 ), LDWORK )
+ END IF
+*
+* Apply H to rows i:m of current block
+*
+ CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
+ $ IINFO )
+*
+* Set rows 1:i-1 of current block to zero
+*
+ DO 40 J = I, I + IB - 1
+ DO 30 L = 1, I - 1
+ A( L, J ) = ZERO
+ 30 CONTINUE
+ 40 CONTINUE
+ 50 CONTINUE
+ END IF
+*
+ WORK( 1 ) = IWS
+ RETURN
+*
+* End of ZUNGQR
+*
+ END
diff --git a/Utilities/ITK/Utilities/vxl/vcl/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/vcl/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/vcl/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/vcl/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..51987cc8253d4e2016290e6692d010559528d7ae
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/CMakeLists.txt
@@ -0,0 +1,376 @@
+# vcl/CMakeLists.txt
+
+IF(WIN32)
+ # MSVC.NET produces lots of warnings like
+ # "warning LNK4221: no public symbols found; archive member will be inaccessible"
+ # that depend on subtle logic at compile time.
+ # This is a bit indescriminate, but it may be the only feasible way to suppress them.
+ IF (CMAKE_CXX_COMPILER MATCHES "^cl$")
+ SET ( CMAKE_MODULE_LINKER_FLAGS "${CMAKE_MODULE_LINKER_FLAGS} /WARN:0")
+ SET ( CMAKE_SHARED_LINKER_FLAGS "${CMAKE_SHARED_LINKER_FLAGS} /WARN:0")
+ ENDIF (CMAKE_CXX_COMPILER MATCHES "^cl$")
+ENDIF(WIN32)
+
+
+PROJECT( vcl )
+
+# Set up vcl_where_root_dir.h to have a macro set to $VCL_SOURCE_ROOT_DIR
+CONFIGURE_FILE(
+ ${vxl_SOURCE_DIR}/vcl/vcl_where_root_dir.h.in
+ ${vxl_BINARY_DIR}/vcl/vcl_where_root_dir.h ESCAPE_QUOTES
+)
+
+SET( vcl_sources
+ vcl_compiler.h
+ vcl_deprecated.cxx vcl_deprecated.h
+
+ vcl_where_root_dir.h.in
+ vcl_config_compiler.h.in
+ vcl_config_headers.h.in
+ vcl_config_manual.h.in
+
+ vcl_cmath.cxx vcl_cmath.h
+ vcl_cassert.cxx vcl_cassert.h
+ vcl_cstdlib.cxx vcl_cstdlib.h
+
+ vcl_algorithm.txx vcl_algorithm.h
+ vcl_bitset.h
+ vcl_cctype.h
+ vcl_cerrno.h
+ vcl_cfloat.h
+ vcl_ciso646.h
+ vcl_climits.h
+ vcl_clocale.h
+ vcl_complex.txx vcl_complex.h
+ vcl_complex_fwd.h
+ vcl_csetjmp.h
+ vcl_csignal.h
+ vcl_cstdarg.h
+ vcl_cstddef.h
+ vcl_cstdio.h
+ vcl_cstring.h
+ vcl_ctime.h
+ vcl_cwchar.h
+ vcl_cwctype.h
+ vcl_deprecated_header.h
+ vcl_deque.txx vcl_deque.h
+ vcl_exception.h
+ vcl_fstream.h
+ vcl_functional.txx vcl_functional.h
+ vcl_iomanip.h
+ vcl_ios.h
+ vcl_iosfwd.h
+ vcl_iostream.h
+ vcl_istream.h
+ vcl_iterator.txx vcl_iterator.h
+ vcl_limits.h
+ vcl_list.txx vcl_list.h
+ vcl_locale.h
+ vcl_map.txx vcl_map.h
+ vcl_memory.h
+ vcl_new.h
+ vcl_numeric.h
+ vcl_ostream.h
+ vcl_queue.txx vcl_queue.h
+ vcl_set.txx vcl_set.h
+ vcl_sstream.h
+ vcl_stack.txx vcl_stack.h
+ vcl_stdexcept.h
+ vcl_stlfwd.h
+ vcl_streambuf.h
+ vcl_string.txx vcl_string.h
+ vcl_typeinfo.h
+ vcl_utility.txx vcl_utility.h
+ vcl_valarray.h
+ vcl_vector.txx vcl_vector.h
+ vcl_sys/time.h
+ vcl_sys/types.h
+
+ generic/vcl_algorithm.h
+ generic/vcl_bitset.h
+ generic/vcl_blah.h
+ generic/vcl_cassert.h
+ generic/vcl_cctype.h
+ generic/vcl_cerrno.h
+ generic/vcl_cfloat.h
+ generic/vcl_ciso646.h
+ generic/vcl_climits.h
+ generic/vcl_clocale.h
+ generic/vcl_cmath.h
+ generic/vcl_complex.h
+ generic/vcl_csetjmp.h
+ generic/vcl_csignal.h
+ generic/vcl_cstdarg.h
+ generic/vcl_cstddef.h
+ generic/vcl_cstdio.h
+ generic/vcl_cstdlib.h
+ generic/vcl_cstring.h
+ generic/vcl_ctime.h
+ generic/vcl_cwchar.h
+ generic/vcl_cwctype.h
+ generic/vcl_deque.h
+ generic/vcl_exception.h
+ generic/vcl_fstream.h
+ generic/vcl_functional.h
+ generic/vcl_iomanip.h
+ generic/vcl_ios.h
+ generic/vcl_iosfwd.h
+ generic/vcl_iostream.h
+ generic/vcl_istream.h
+ generic/vcl_iterator.h
+ generic/vcl_limits.h
+ generic/vcl_list.h
+ generic/vcl_locale.h
+ generic/vcl_map.h
+ generic/vcl_memory.h
+ generic/vcl_numeric.h
+ generic/vcl_ostream.h
+ generic/vcl_queue.h
+ generic/vcl_set.h
+ generic/vcl_sstream.h
+ generic/vcl_stack.h
+ generic/vcl_stdexcept.h
+ generic/vcl_streambuf.h
+ generic/vcl_string.h
+ generic/vcl_typeinfo.h
+ generic/vcl_utility.h
+ generic/vcl_valarray.h
+ generic/vcl_vector.h
+
+ iso/vcl_algorithm.txx iso/vcl_algorithm.h
+ iso/vcl_complex.txx iso/vcl_complex.h
+ iso/vcl_deque.txx iso/vcl_deque.h
+ iso/vcl_functional.txx iso/vcl_functional.h
+ iso/vcl_iterator.txx iso/vcl_iterator.h
+ iso/vcl_list.txx iso/vcl_list.h
+ iso/vcl_map.txx iso/vcl_map.h
+ iso/vcl_queue.txx iso/vcl_queue.h
+ iso/vcl_set.txx iso/vcl_set.h
+ iso/vcl_stack.txx iso/vcl_stack.h
+ iso/vcl_string.txx iso/vcl_string.h
+ iso/vcl_utility.txx iso/vcl_utility.h
+ iso/vcl_vector.txx iso/vcl_vector.h
+ iso/vcl_bitset.h
+ iso/vcl_cassert.h
+ iso/vcl_cctype.h
+ iso/vcl_cerrno.h
+ iso/vcl_cfloat.h
+ iso/vcl_ciso646.h
+ iso/vcl_climits.h
+ iso/vcl_clocale.h
+ iso/vcl_cmath.h
+ iso/vcl_csetjmp.h
+ iso/vcl_csignal.h
+ iso/vcl_cstdarg.h
+ iso/vcl_cstddef.h
+ iso/vcl_cstdio.h
+ iso/vcl_cstdlib.h
+ iso/vcl_cstring.h
+ iso/vcl_ctime.h
+ iso/vcl_cwchar.h
+ iso/vcl_cwctype.h
+ iso/vcl_exception.h
+ iso/vcl_fstream.h
+ iso/vcl_iomanip.h
+ iso/vcl_ios.h
+ iso/vcl_iosfwd.h
+ iso/vcl_iostream.h
+ iso/vcl_istream.h
+ iso/vcl_limits.h
+ iso/vcl_locale.h
+ iso/vcl_memory.h
+ iso/vcl_new.h
+ iso/vcl_numeric.h
+ iso/vcl_ostream.h
+ iso/vcl_sstream.h
+ iso/vcl_stdexcept.h
+ iso/vcl_streambuf.h
+ iso/vcl_typeinfo.h
+ iso/vcl_valarray.h
+
+ emulation/vcl_limits.cxx emulation/vcl_limits.h
+ emulation/vcl_string_instances.cxx
+ emulation/vcl_rbtree_instances.cxx
+ emulation/vcl_hashtable.cxx emulation/vcl_hashtable.h
+ emulation/vcl_alloc.cxx emulation/vcl_alloc.h
+ emulation/vcl_algorithm.txx emulation/vcl_algorithm.h
+ emulation/vcl_complex.txx emulation/vcl_complex.h
+ emulation/vcl_deque.txx emulation/vcl_deque.h
+ emulation/vcl_functional.txx emulation/vcl_functional.h
+ emulation/vcl_hash.txx
+ emulation/vcl_hash_map.txx emulation/vcl_hash_map.h
+ emulation/vcl_iterator.txx emulation/vcl_iterator.h
+ emulation/vcl_list.txx emulation/vcl_list.h
+ emulation/vcl_map.txx emulation/vcl_map.h
+ emulation/vcl_multimap.txx emulation/vcl_multimap.h
+ emulation/vcl_rbtree.txx
+ emulation/vcl_set.txx emulation/vcl_set.h
+ emulation/vcl_utility.txx emulation/vcl_utility.h
+ emulation/vcl_vector.txx emulation/vcl_vector.h
+ emulation/vcl_algobase.h
+ emulation/vcl_bool.h
+ emulation/vcl_bvector.h
+ emulation/vcl_ciso646.h
+ emulation/vcl_defalloc.h
+ emulation/vcl_functionx.h
+ emulation/vcl_hash_set.h
+ emulation/vcl_heap.h
+ emulation/vcl_multiset.h
+ emulation/vcl_new.h
+ emulation/vcl_pair.h
+ emulation/vcl_rel_ops.h
+ emulation/vcl_stack.h
+ emulation/vcl_stlfwd.h
+ emulation/vcl_tempbuf.h
+ emulation/vcl_tree.h
+
+ emulation/vcl_stlconf.h
+ emulation/egcs-stlconf.h
+ emulation/gcc-272-stlconf.h
+ emulation/gcc-2800-stlconf.h
+ emulation/gcc-281-stlconf.h
+ emulation/gcc-295-stlconf.h
+ emulation/sgi-CC-stlconf.h
+ emulation/sun-CC4.1-stlconf.h
+ emulation/sun-CC5.0-stlconf.h
+ emulation/win32-vc50-stlconf.h
+ emulation/stlcomp.h
+
+ gcc/vcl_cmath.h
+ gcc/vcl_cstdlib.h
+ gcc-295/vcl_algorithm.txx
+ gcc-295/vcl_complex.h gcc-295/vcl_complex.txx
+ gcc-295/vcl_deque.txx
+ gcc-295/vcl_functional.txx
+ gcc-295/vcl_iterator.txx
+ gcc-295/vcl_list.txx
+ gcc-295/vcl_map.txx
+ gcc-295/vcl_memory.h
+ gcc-295/vcl_queue.txx
+ gcc-295/vcl_set.txx
+ gcc-295/vcl_string.txx
+ gcc-295/vcl_utility.txx
+ gcc-295/vcl_vector.txx
+ gcc-295/vcl_iomanip.h
+ gcc-295/vcl_ios.h
+ gcc-libstdcxx-v3/vcl_algorithm.txx
+ gcc-libstdcxx-v3/vcl_deque.txx
+ gcc-libstdcxx-v3/vcl_functional.txx
+ gcc-libstdcxx-v3/vcl_iterator.txx
+ gcc-libstdcxx-v3/vcl_list.txx
+ gcc-libstdcxx-v3/vcl_map.txx
+ gcc-libstdcxx-v3/vcl_set.txx
+ gcc-libstdcxx-v3/vcl_string.txx
+ gcc-libstdcxx-v3/vcl_utility.txx
+ gcc-libstdcxx-v3/vcl_vector.txx
+ egcs/vcl_algorithm.txx
+ egcs/vcl_complex.txx
+ egcs/vcl_deque.txx
+ egcs/vcl_functional.txx
+ egcs/vcl_iterator.txx
+ egcs/vcl_list.txx
+ egcs/vcl_map.txx
+ egcs/vcl_set.txx
+ egcs/vcl_string.txx
+ egcs/vcl_utility.txx
+ egcs/vcl_vector.txx
+
+ sgi/vcl_algorithm.txx
+ sgi/vcl_bitset.h
+ sgi/vcl_cmath.h
+ sgi/vcl_complex.txx sgi/vcl_complex.h
+ sgi/vcl_cstdlib.h
+ sgi/vcl_deque.txx
+ sgi/vcl_functional.txx
+ sgi/vcl_iomanip.h
+ sgi/vcl_ios.h
+ sgi/vcl_iostream.h
+ sgi/vcl_iterator.txx
+ sgi/vcl_list.txx
+ sgi/vcl_map.txx
+ sgi/vcl_set.txx
+ sgi/vcl_string.txx sgi/vcl_string.h
+ sgi/vcl_utility.txx
+ sgi/vcl_vector.txx
+
+ sunpro/vcl_algorithm.txx
+ sunpro/vcl_cmath.h
+ sunpro/vcl_complex.txx sunpro/vcl_complex.h
+ sunpro/vcl_cstdlib.h
+ sunpro/vcl_deque.txx
+ sunpro/vcl_functional.txx
+ sunpro/vcl_iterator.txx sunpro/vcl_iterator.h
+ sunpro/vcl_list.txx
+ sunpro/vcl_map.txx sunpro/vcl_map.h
+ sunpro/vcl_set.txx
+ sunpro/vcl_stack.txx
+ sunpro/vcl_utility.txx
+ sunpro/vcl_vector.txx sunpro/vcl_vector.h
+
+ win32-vc60/vcl_cmath.h
+ win32-vc60/vcl_complex.h
+ win32-vc60/vcl_cstdarg.h
+ win32-vc60/vcl_cstdlib.h
+ win32-vc60/vcl_memory.h
+ win32-vc60/vcl_string.h
+ win32-vc60/vcl_valarray.h
+
+ win32-vc70/vcl_cmath.h
+ win32-vc70/vcl_complex.h
+ win32-vc70/vcl_cstdlib.h
+ win32-vc70/vcl_valarray.h
+
+ borland55/vcl_cfloat.h
+ borland55/vcl_cmath.h
+ borland55/vcl_complex.h
+ borland55/vcl_cstdlib.h
+ borland55/vcl_memory.h
+ borland56/vcl_complex.h
+
+ mwerks/vcl_cmath.h
+ mwerks/vcl_complex.h
+ mwerks/vcl_cstdlib.h
+
+ stlport/vcl_cmath.h
+ stlport/vcl_complex.h
+ stlport/vcl_cstdlib.h
+)
+
+# We use implicit instantiation of the standard library now,
+# so we shouldn't be explicitly instantiating anything.
+# This also avoid trouble where the instantiation hack conflict
+# with modern, more compliant compilers.
+#AUX_SOURCE_DIRECTORY(Templates vcl_sources)
+
+
+ADD_LIBRARY(itkvcl ${vcl_sources})
+
+IF(WIN32)
+ IF(NOT CYGWIN)
+ ADD_DEFINITIONS( -DBUILDING_VCL_DLL )
+ ENDIF(NOT CYGWIN)
+ENDIF(WIN32)
+
+
+IF(UNIX)
+ TARGET_LINK_LIBRARIES( itkvcl m )
+ENDIF(UNIX)
+
+# INCLUDE( ${vxl_SOURCE_DIR}/vcl/LinkSTLPort.cmake )
+
+IF( BUILD_TESTING)
+ SUBDIRS(tests)
+ENDIF( BUILD_TESTING)
+
+INSTALL_TARGETS(/lib/InsightToolkit itkvcl)
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl "(\\.h|\\.txx)$")
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl ".h"
+ "vcl_config_compiler"
+ "vcl_config_headers"
+ "vcl_config_manual")
+
+SUBDIRS(borland55 borland56 egcs emulation gcc generic iso mwerks sgi
+ sunpro vcl_sys)
+IF(NOT BORLAND)
+ SUBDIRS(gcc-295 gcc-libstdcxx-v3 win32-vc60 win32-vc70)
+ENDIF(NOT BORLAND)
diff --git a/Utilities/ITK/Utilities/vxl/vcl/ERRORS.txt b/Utilities/ITK/Utilities/vxl/vcl/ERRORS.txt
new file mode 100644
index 0000000000000000000000000000000000000000..aec343a9773bfc616c947ff615365edc2668650a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/ERRORS.txt
@@ -0,0 +1,3 @@
+
+"hashfun cannot be used as a function:"
+ vcl_hash<type> needs to be declared.
diff --git a/Utilities/ITK/Utilities/vxl/vcl/README b/Utilities/ITK/Utilities/vxl/vcl/README
new file mode 100644
index 0000000000000000000000000000000000000000..4c57027438291eb099d35ef1813701a72fef1469
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/README
@@ -0,0 +1,54 @@
+header names
+------------
+There's a list of ISO headers in headers.iso; each ISO header <blah> becomes
+<vcl_blah.h> and there should not be any other headers here. Exceptions are:
+
+vcl_compiler.h
+ Every other header file in this directory should include this file.
+ That's a requirement and it's service which clients can rely on; thus
+ if you include <vcl_iostream.h> you *don't* need to include
+ <vcl_compiler.h> even if you need the macros defined in there.
+
+vcl_complex_fwd.h
+ This is deprecated
+
+vcl_rel_ops.h
+ This is the (deprecated) vcl form of the ISO incantation
+ #include <utility>
+ using std::rel_ops::operator!=;
+ using std::rel_ops::operator> ;
+ using std::rel_ops::operator<=;
+ using std::rel_ops::operator>=;
+
+vcl_rtti.h
+ Under construction. For rtti emulation with compilers that don't support
+ rtti.
+
+vcl_stlfwd.h
+ Forward declare the most commonly used parts of the STL, if possible.
+
+vcl_deprecated_header.h
+ Including this causes a preprocessor or compiler warning to be emitted. So
+ include <vcl_deprecated_header.h> in header files that are to be deprecated.
+
+
+tests directory
+---------------
+It is important to have a test program for every vcl feature as early
+detection of problems can save hours of recompilation time if a vcl
+header has to be modified.
+
+
+template files
+--------------
+This is the official codification of template file naming, as was proposed by
+Peter Vanroose.
+~ is for pointer (*)
++ is for < in templates
+- is for > in templates
+. is for the commas between template arguments
++- is for the :: in nested classes
+The abbreviations uchar, ushort, uint, ulong stand for unsigned versions of
+integer types. Use 's' as a prefix for signed versions. Beware that 'char'
+can be either signed or unsigned and may or may not be the same type as the
+qualified form.
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/.NoDartCoverage b/Utilities/ITK/Utilities/vxl/vcl/Templates/.NoDartCoverage
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/alloc-instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/Templates/alloc-instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..3a915bd66126e7032ff6c2d6cbe0036c69165d87
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/Templates/alloc-instances.cxx
@@ -0,0 +1,6 @@
+#include <vcl_compiler.h>
+#if defined(VCL_SGI_CC) && VCL_USE_NATIVE_STL
+#include <alloc.h>
+template class std::__default_alloc_template<true,0>;
+template class std::__malloc_alloc_template<0>;
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/complex-instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/Templates/complex-instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..dd243a08a8d5904873e1fe5d633505e735112b95
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/Templates/complex-instances.cxx
@@ -0,0 +1,133 @@
+// This file is supposed to define any template instances needed
+// to give a sensible complex type for float, double and long double.
+//
+// E.g. ensure that "operator/(complex<float>, float)" exists
+//
+// It is in Templates because it may need implicit templates to work properly
+//
+// Note to maintainers: the format of this file should be:
+// #if compiler_1
+// ...
+// #elif compiler_2
+// ...
+// ........
+// ...
+// #elif compiler_n
+// ..
+// #else // ISO
+//
+// #endif
+//
+// "Many sections style" is better than complex conditional logic.
+//
+// If you get problems with multiply defined symbols for static builds,
+// try to avoid breaking the shared builds by removing instantiations
+// it needs. With gcc, using #pragma weak may be an option.
+
+#include <vcl_iostream.h>
+#include <vcl_complex.txx>
+
+// this function will tickle implicit templates for
+// some compilers and detect missing instances for others.
+template <class T>
+vcl_complex<T> vcl_complex_instances_ticker(T *)
+{
+ vcl_complex<T> z(1, 2);
+ vcl_complex<T> x = vcl_arg(z);
+ x += vcl_conj(z);
+ x -= vcl_abs(z);
+ x *= vcl_polar(T(3), T(4));
+ x /= vcl_sqrt(z);
+ return x + vcl_norm(z);
+}
+template vcl_complex<float > vcl_complex_instances_ticker(float *);
+template vcl_complex<double> vcl_complex_instances_ticker(double *);
+template vcl_complex<long double> vcl_complex_instances_ticker(long double *);
+
+// macro to implement an operator>>, for compilers that need it.
+# define implement_rsh(T) \
+vcl_istream &operator>>(vcl_istream &is, vcl_complex<T > &z) { \
+ T r, i; \
+ is >> r >> i; \
+ z = vcl_complex<T >(r, i); \
+ return is; \
+}
+
+
+// ---------- emulation
+#if !VCL_USE_NATIVE_COMPLEX
+// ** make sure gcc 2.7 sees this **
+VCL_COMPLEX_INSTANTIATE(float);
+VCL_COMPLEX_INSTANTIATE(double);
+VCL_COMPLEX_INSTANTIATE(long double);
+
+// ---------- egcs
+# elif defined(VCL_EGCS)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+# define do_inlines(FLOAT) \
+template vcl_ostream& operator<<(vcl_ostream &, vcl_complex<FLOAT > const &); \
+template vcl_complex<FLOAT > vcl_sqrt (vcl_complex<FLOAT >const& x); \
+template vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&); \
+template vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,FLOAT); \
+implement_rsh(FLOAT)
+
+do_inlines(float);
+do_inlines(double);
+do_inlines(long double);
+# endif
+
+// ---------- gcc 2.95
+#elif defined(VCL_GCC_295) && !defined(GNU_LIBSTDCXX_V3)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+# define VCL_COMPLEX_INSTANTIATE_INLINE(x) template x
+# define do_inlines(FLOAT) \
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT vcl_imag(vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT vcl_real(vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_sqrt (vcl_complex<FLOAT >const& x));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_polar (FLOAT,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,int));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_exp (vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_log (vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT vcl_arg (vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT vcl_abs (vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT vcl_norm (vcl_complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(vcl_complex<FLOAT>& __doadv (vcl_complex<FLOAT>* ths, const vcl_complex<FLOAT>& y));\
+template vcl_ostream& operator<<(vcl_ostream &, vcl_complex<FLOAT > const &);\
+implement_rsh(FLOAT)
+
+do_inlines(float);
+do_inlines(double);
+do_inlines(long double);
+# endif
+
+// ---------- sunpro
+#elif defined(VCL_SUNPRO_CC)
+# define do_inlines(FLOAT) \
+template vcl_complex<FLOAT > vcl_conj<FLOAT >(vcl_complex<FLOAT > const &)
+
+do_inlines(float);
+do_inlines(double);
+do_inlines(long double);
+
+// ---------- ISO
+#else
+// ISO compilers are magic as far as instantiation goes.
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/fstream-instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/Templates/fstream-instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..7f26f50e95379232cce5bc4d9b7e9c153a3191e7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/Templates/fstream-instances.cxx
@@ -0,0 +1,5 @@
+#include <vcl_fstream.h>
+
+#if defined(GNU_LIBSTDCXX_V3) && !defined(__APPLE__)
+template class std::basic_ofstream<char, std::char_traits<char> >;
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/stream-instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/Templates/stream-instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..24a8d4d289b715776c9a091f0bb4f2c04f47c3f0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/Templates/stream-instances.cxx
@@ -0,0 +1,53 @@
+// This is vcl/Templates/stream-instances.cxx
+#include <vcl_iostream.h>
+#include <vcl_fstream.h>
+
+#if defined(VCL_EGCS)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+//template class smanip<int>;
+template vcl_ostream & operator<<(vcl_ostream &, smanip<int> const &);
+# endif
+#endif
+
+#if defined(VCL_GCC_295) && !defined(GNU_LIBSTDCXX_V3)
+# if !VCL_HAS_TEMPLATE_SYMBOLS
+//template class smanip<int>;
+template vcl_ostream & operator<<(vcl_ostream &, smanip<int> const &);
+# endif
+#endif
+
+#if 0 // not needed as of 2001/05/19
+#if defined(GNU_LIBSTDCXX_V3)
+# include <bits/sstream.tcc>
+# include <bits/istream.tcc>
+# include <bits/ostream.tcc>
+// for some reason these templates aren't in libstdc++ (yet).
+template class std::basic_fstream<char, std::char_traits<char> >;
+template class std::basic_ifstream<char, std::char_traits<char> >;
+//template class std::basic_ofstream<char, std::char_traits<char> >;
+namespace {
+ void tic(vcl_ostream &s, int x) { s << std::setw(14) << x; }
+ template std::basic_stringstream<char, std::char_traits<char>, std::allocator<char> >;
+}
+#endif
+#endif
+
+
+#if defined(VCL_SUNPRO_CC_50)
+vcl_ostream &operator<<(vcl_ostream &s, short x)
+{ return s << int(x); }
+
+# include <string>
+//void blah(vcl_istream &s1, std::string &s2) { s1 >> s2; }
+//
+#define type0 std::basic_istream<char,std::char_traits<char> >
+#define type1 std::basic_string<char,std::char_traits<char>,std::allocator<char> >
+#define type2 std::char_traits<char>
+
+template type0 & __rwstd::rw_extract_string<type0, type1, type2>(type0 &, type1 &, type2);
+
+#undef type0
+#undef type1
+#undef type2
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/Templates/string-instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/Templates/string-instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..1fa7dcc181991a8e5be3611c421a319827b19084
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/Templates/string-instances.cxx
@@ -0,0 +1,73 @@
+#include <vcl_string.txx>
+#include <vcl_iostream.h>
+
+VCL_BASIC_STRING_INSTANTIATE(char, vcl_char_traits<char> );
+
+#if defined(VCL_SUNPRO_CC)
+template class vcl_basic_string<char, vcl_char_traits<char> >;
+#endif
+
+// this should work for all compilers. by putting it in the
+// library we (a) get the implicit template instances it
+// needs and (b) make sure that it does work.
+static void vcl_string_instance_tickler(vcl_ostream &os, vcl_string::iterator i, char *a, char const *b)
+{
+ char ch;
+ vcl_char_traits<char>::eq(ch, ch);
+ vcl_string s(b, b);
+ os << s;
+ s.replace(i, i, a, a);
+ s.replace(i, i, b, b);
+ //s.find(i);
+ s.find(a);
+ s.find(b);
+
+ vcl_string(s.begin()+3, s.end()) == b;
+ s + s;
+ vcl_string_instance_tickler(os, i, a, b); // avoid "unused function" warning
+}
+
+
+#if defined(VCL_GCC_295) && !defined(GNU_LIBSTDCXX_V3)
+# if VCL_HAS_TEMPLATE_SYMBOLS
+# undef bs
+# define bs basic_string<char, string_char_traits<char>, __default_alloc_template<false, 0> >
+template bs &bs::replace<char*>(char *, char *, char *, char *);
+template bs &bs::replace<char const*>(char *, char *, char const *, char const *);
+# else
+// The following is needed when using -fguiding-decls.
+# undef inst
+# define inst \
+template class __default_alloc_template<true, 0>; \
+template bs &bs::replace(char *, char *, char *, char *); \
+template bs &bs::replace(char *, char *, char const *, char const *); \
+template bs &bs::replace(vcl_size_t, vcl_size_t, bs const &, vcl_size_t, vcl_size_t); \
+template bs &bs::replace(vcl_size_t, vcl_size_t, char const *, vcl_size_t); \
+template bs &bs::replace(vcl_size_t, vcl_size_t, vcl_size_t, char)
+
+# undef bs
+# define bs basic_string<char, string_char_traits<char>, __default_alloc_template<true , 0> >
+inst;
+# undef bs
+# define bs basic_string<char, string_char_traits<char>, __default_alloc_template<false, 0> >
+inst;
+# endif
+#endif
+
+#if defined(VCL_SGI_CC)
+# if VCL_USE_NATIVE_STL
+template class std::__string_base<char,std::__default_alloc_template<true,0> >;
+//template class std::basic_string<char,std::char_traits<char>,std::alloc>;
+template class std::basic_string<char,std::char_traits<char>,std::__default_alloc_template<true,0> >;
+template vcl_ostream& std::operator<<(vcl_ostream&,const std::basic_string<char,std::char_traits<char>,std::alloc>&);
+# else
+# undef bs
+# define bs vcl_basic_string<char, vcl_char_traits<char> >
+# if 0 // already explicitly instantiated elsewhere ?! but needed on julia?
+template bs &bs::replace(vcl_size_t, vcl_size_t, char const*, vcl_size_t);
+template bs &bs::replace(vcl_size_t, vcl_size_t, vcl_size_t, char);
+template int bs::compare(char const*, vcl_size_t, vcl_size_t) const;
+template int bs::compare(bs const&, vcl_size_t, vcl_size_t) const;
+# endif
+# endif
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/vcl/borland55/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..2823b9094b63c3e17d9cf0406ac38ca03d86b9ed
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/CMakeLists.txt
@@ -0,0 +1 @@
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl/borland55 "(\\.h|\\.txx)$")
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cfloat.h b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cfloat.h
new file mode 100644
index 0000000000000000000000000000000000000000..589bc6d15f4bb93ab5c361a8a5d38e79e2c2a172
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cfloat.h
@@ -0,0 +1,11 @@
+#ifndef vcl_borland55_cfloat_h_
+#define vcl_borland55_cfloat_h_
+
+// Borland C++ 5.6 defines macros like FLT_MAX to point at symbols,
+// but does not add the std:: namespace in the macro when it decides
+// to put the symbols in std (when the header is included as
+// <cfloat>). We just include it as <float.h> instead.
+
+#include <float.h>
+
+#endif // vcl_borland55_cfloat_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cmath.h b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cmath.h
new file mode 100644
index 0000000000000000000000000000000000000000..911ae1dbbbc46edac11b903d868ab7ddd53858b2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cmath.h
@@ -0,0 +1,24 @@
+#ifndef vcl_borland55_cmath_h_
+#define vcl_borland55_cmath_h_
+
+// This header's vcl_abs must be consistent with vcl_complex.h's version.
+
+// Standard version mostly works.
+#include "../iso/vcl_cmath.h"
+
+// Replace abs from standard version.
+#undef vcl_abs
+#define vcl_abs vcl_abs
+
+#define vcl_abs_define(T) inline T vcl_abs(T x) { return x >= 0 ? x : -x; }
+vcl_abs_define(long double)
+vcl_abs_define(double)
+vcl_abs_define(float)
+vcl_abs_define(char)
+vcl_abs_define(signed char)
+vcl_abs_define(short)
+vcl_abs_define(int)
+vcl_abs_define(long)
+#undef vcl_abs_define
+
+#endif // vcl_borland55_cmath_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_complex.h b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_complex.h
new file mode 100644
index 0000000000000000000000000000000000000000..a2c343d2fe1746db3c7a248a2f456b9493050d52
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_complex.h
@@ -0,0 +1,18 @@
+#ifndef vcl_borland55_complex_h_
+#define vcl_borland55_complex_h_
+
+// This header's vcl_abs must be consistent with vcl_cmath.h's version.
+
+// Standard version mostly works.
+#include "../iso/vcl_complex.h"
+
+// Replace abs from standard version.
+#undef vcl_abs
+#define vcl_abs vcl_abs
+
+inline long double vcl_abs(const vcl_complex<long double>& c)
+{ return ::std::abs(c); }
+inline double vcl_abs(const vcl_complex<double>& c) { return ::std::abs(c); }
+inline float vcl_abs(const vcl_complex<float>& c) { return ::std::abs(c); }
+
+#endif // vcl_borland55_complex_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cstdlib.h b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cstdlib.h
new file mode 100644
index 0000000000000000000000000000000000000000..03578191913d5401d2dd0528bfc86fa8c29fbdc4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_cstdlib.h
@@ -0,0 +1,59 @@
+#ifndef vcl_borland_cstdlib_h_
+#define vcl_borland_cstdlib_h_
+// This is a first attempt at a <cstdlib> for the Borland compiler - PVr,Dec.2003.
+#include <cstdlib>
+
+// If we define vcl_abs, for example, to ::abs, we have conflicts
+// with std::abs(std::complex<T>) which *is* declared in the
+// std namespace. To avoid these issues, we inject the math
+// functions into the std namespace.
+
+namespace std {
+ //inline int abs(int x) { return x >= 0 ? x : -x; }
+ inline long abs(long x) { return x >= 0 ? x : -x; }
+ inline long labs(long x) { return x >= 0 ? x : -x; }
+ // where do these functions live with the Borland compiler?
+ void abort();
+ void qsort(void*, size_t, size_t, int(*)(const void*, const void*));
+ void* malloc(size_t);
+ void* calloc(size_t, size_t);
+ void* realloc(void*, size_t);
+ void free(void*);
+}
+
+#ifndef vcl_abs
+#define vcl_abs std::abs
+#endif
+#ifndef vcl_labs
+#define vcl_labs std::labs
+#endif
+#ifndef vcl_div
+#define vcl_div std::div
+#endif
+#ifndef vcl_ldiv
+#define vcl_ldiv std::ldiv
+#endif
+#ifndef vcl_abort
+#define vcl_abort ::abort
+#endif
+#ifndef vcl_qsort
+#define vcl_qsort ::qsort
+#endif
+#ifndef vcl_malloc
+#define vcl_malloc ::malloc
+#endif
+#ifndef vcl_calloc
+#define vcl_calloc ::calloc
+#endif
+#ifndef vcl_realloc
+#define vcl_realloc ::realloc
+#endif
+#ifndef vcl_free
+#define vcl_free ::free
+#endif
+
+#define vcl_generic_cstdlib_STD
+
+#include "../generic/vcl_cstdlib.h"
+
+#endif // vcl_borland_cstdlib_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_memory.h b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_memory.h
new file mode 100644
index 0000000000000000000000000000000000000000..bfe2631ebc6150b5a5ac29332fdbcf43dc45bcef
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland55/vcl_memory.h
@@ -0,0 +1,48 @@
+#ifndef vcl_borland55_memory_h_
+#define vcl_borland55_memory_h_
+
+#include "../iso/vcl_memory.h"
+
+#undef vcl_auto_ptr
+
+// borland55 does not provide a correct implementation of
+// auto_ptr. This implementation is copied from Brad King's
+// version in vcl/win32-vc60 -- Ian Scott
+
+// C++98 Standard Section 20.4.5 - Template class auto_ptr.
+template <class X>
+class vcl_auto_ptr
+{
+ template <class Y> struct auto_ptr_ref
+ {
+ vcl_auto_ptr<Y>& p_;
+ explicit auto_ptr_ref(vcl_auto_ptr<Y>& p): p_(p) {}
+ };
+ X* x_;
+public:
+ typedef X element_type;
+
+ template <class Y>
+ vcl_auto_ptr(vcl_auto_ptr<Y>& a) throw(): x_(a.release()) {}
+ template <class Y>
+ vcl_auto_ptr& operator=(vcl_auto_ptr<Y>& a) throw()
+ { reset(a.release()); return *this; }
+
+ explicit vcl_auto_ptr(X* p=0) throw(): x_(p) {}
+ vcl_auto_ptr(vcl_auto_ptr& a) throw(): x_(a.release()) {}
+ vcl_auto_ptr& operator=(vcl_auto_ptr& a) throw() { reset(a.release()); return *this; }
+ ~vcl_auto_ptr() throw() { delete get(); }
+
+ X& operator*() const throw() { return *get(); }
+ X* operator->() const throw() { return get(); }
+ X* get() const throw() { return x_; }
+ X* release() throw() { X* x = x_; x_ = 0; return x; }
+ void reset(X* p=0) throw() { if(get() != p) { delete get(); x_ = p; } }
+
+ vcl_auto_ptr(auto_ptr_ref<X> r) throw(): x_(r.p_.release()) {}
+ template <class Y> operator auto_ptr_ref<Y>() throw() { return *this; }
+ template <class Y> operator vcl_auto_ptr<Y>() throw() { return release(); }
+ vcl_auto_ptr& operator=(auto_ptr_ref<X> r) throw() { x_ = r.p_.release(); return *this; }
+};
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland56/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/vcl/borland56/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..0f033e9b61b69f9458e0256eec59655cdd8dbaa9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland56/CMakeLists.txt
@@ -0,0 +1 @@
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl/borland56 "(\\.h|\\.txx)$")
diff --git a/Utilities/ITK/Utilities/vxl/vcl/borland56/vcl_complex.h b/Utilities/ITK/Utilities/vxl/vcl/borland56/vcl_complex.h
new file mode 100644
index 0000000000000000000000000000000000000000..858aa2000cd327cfb2039dc7bf6675dd087661ca
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/borland56/vcl_complex.h
@@ -0,0 +1,40 @@
+#ifndef vcl_borland56_complex_h_
+#define vcl_borland56_complex_h_
+
+#include <complex>
+
+#ifdef vcl_generic_complex_STD
+ ** error **
+#else
+# define vcl_generic_complex_STD std
+#endif
+
+// Borland C++ 5.6 switches between Rogue Wave and stlport based on
+// the _USE_OLD_RW_STL macro. A bug in the compiler prevents the
+// stlport definitions of the complex<T> overloads of standard math
+// functions from being included in the std namespace by a
+// "using namespace _STL" present in the included headers.
+// We add them explicitly. - Brad King
+#if !defined(_USE_OLD_RW_STL)
+namespace std
+{
+ using _STL::abs;
+ using _STL::arg;
+ using _STL::polar;
+ using _STL::sqrt;
+ using _STL::exp;
+ using _STL::log;
+ using _STL::log10;
+ using _STL::pow;
+ using _STL::sin;
+ using _STL::cos;
+ using _STL::tan;
+ using _STL::sinh;
+ using _STL::cosh;
+ using _STL::tanh;
+}
+#endif
+
+#include "../generic/vcl_complex.h"
+
+#endif // vcl_borland56_complex_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.README b/Utilities/ITK/Utilities/vxl/vcl/config.README
new file mode 100644
index 0000000000000000000000000000000000000000..fde2efd82a508357172c6d3d8155e21e97cc03a7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.README
@@ -0,0 +1,4 @@
+The purpose of the config.$build_tag directories is to hold
+files generated by the configure script. Apart from platforms
+where configure is not used (e.g. Windows) these directories
+are generated and thus should not be under CVS control.
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_compiler.h b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_compiler.h
new file mode 100644
index 0000000000000000000000000000000000000000..66c996b24f17e6bb6033b009b1d41273bf9b1ba3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_compiler.h
@@ -0,0 +1,623 @@
+#ifndef vcl_config_compiler_h_config_stlport_win32_vc60_
+#define vcl_config_compiler_h_config_stlport_win32_vc60_
+//:
+// \file
+// This file is *not* generated.
+
+//----------------------------------------------------------------------
+// syntax-like things.
+
+//: VCL_HAS_BOOL
+// Set to 1 if "bool" is accepted by the compiler as a built-in type.
+#define VCL_HAS_BOOL 1
+
+
+//: VCL_HAS_DYNAMIC_CAST
+//
+// True if the compiler supports dynamic cast.
+//
+#define VCL_HAS_DYNAMIC_CAST 1
+
+
+//: VCL_HAS_RTTI
+//
+// True if the compiler supports RTTI, viz the 'typeid' function.
+//
+#define VCL_HAS_RTTI 0
+
+
+//: VCL_HAS_TYPENAME
+//
+// True if the compiler supports the "typename" keyword
+//
+#define VCL_HAS_TYPENAME 1
+
+
+//: VCL_HAS_EXPORT
+//
+// True if the compiler supports the "export" keyword. FIXME.
+//
+#define VCL_HAS_EXPORT 0
+
+
+//: VCL_HAS_MUTABLE
+//
+// True if the compiler supports the "mutable" keyword
+//
+#define VCL_HAS_MUTABLE 1
+
+
+//: VCL_HAS_EXPLICIT
+//
+// True if the compiler supports the "explicit" keyword
+//
+#define VCL_HAS_EXPLICIT 1
+
+
+//: VCL_FOR_SCOPE_HACK:
+//
+// True if the compiler uses old-style 'for' loop scoping.
+// Setting this nonzero causes the Henderson trick to be used.
+#define VCL_FOR_SCOPE_HACK 1
+
+
+//: VCL_COMPLEX_POW_WORKS
+//
+// It appears several programmers have (independently)
+// not realised their lack of knowledge of complex numbers.
+// pow(complex(-1,0),0.5) should return (0,1) not (Nan,0), etc.
+#define VCL_COMPLEX_POW_WORKS 1
+
+
+//: VCL_DEFAULT_VALUE(x)
+//
+// Used to provide default values for function args in definition
+// Some compilers (GCC272) require defaults in template function definitions
+// Other compilers (VC50) disallow defaults in both decls and defs
+
+//#define VCL_DEFAULT_VALUE(x) /* no need */
+//#define VCL_DEFAULT_VALUE(x) = x
+#define VCL_DEFAULT_VALUE(x) /* no need */
+
+
+//----------------------------------------------------------------------
+// constant initializer issues.
+
+//: VCL_STATIC_CONST_INIT_INT_DECL(x)
+//
+// ANSI allows
+// \code
+// class A {
+// static const int x = 27;
+// };
+// \endcode
+// And there is a speed advantage, so we want to use it where supported.
+// However, the standard also requires (9.4.2/4) that the constant be
+// defined in namespace scope. (That is, space must be allocated.)
+// To make matters worse, some compilers (at least VC 7) mistakenly
+// allocate storage without the definition in namespace scope,
+// which results in multiply defined symbols.
+// To use the macro, use VCL_STATIC_CONST_INIT_INT_DECL in the class
+// definition (header file). This declares the constant.
+// \code
+// class A {
+// static const int x VCL_STATIC_CONST_INIT_INT_DECL(27);
+// };
+// \endcode
+// Use VCL_STATIC_CONST_INIT_INT_DEFN in some .cxx file to define
+// the constant, but only if VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// evaluates to false.
+// \code
+// #if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// const int A::x VCL_STATIC_CONST_INIT_INT_DEFN(27);
+// #endif
+// \endcode
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_INT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_INT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_INT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_INT
+# define VCL_CAN_STATIC_CONST_INIT_INT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_INT
+#define VCL_STATIC_CONST_INIT_INT_DECL(x) = x
+#define VCL_STATIC_CONST_INIT_INT_DEFN(x) /* initialized at declaration */
+#define VCL_STATIC_CONST_INIT_INT_NO_DEFN 1
+#else
+#define VCL_STATIC_CONST_INIT_INT_DECL(x) /* not allowed */
+#define VCL_STATIC_CONST_INIT_INT_DEFN(x) = x
+#define VCL_STATIC_CONST_INIT_INT_NO_DEFN 0
+#endif
+
+
+//: VCL_STATIC_CONST_INIT_FLOAT(x)
+//
+// GCC allows the above, but with floating point types, ANSI doesn't.
+// Again, we'll use it if we've got it.
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_FLOAT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_FLOAT
+# define VCL_CAN_STATIC_CONST_INIT_FLOAT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_FLOAT
+#define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) = x
+#define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) /* initialized at declaration */
+#define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#else
+#define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) /* not allowed */
+#define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) = x
+#define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#endif
+
+
+//----------------------------------------------------------------------
+// various template issues.
+
+//: VCL_HAS_MEMBER_TEMPLATES
+//
+// True if the compiler supports template members of template classes. e.g.
+// \code
+// template <class U> class A {
+// template <class V> void f(V);
+// }
+// \endcode
+#define VCL_HAS_MEMBER_TEMPLATES 1
+
+
+//: VCL_CAN_DO_PARTIAL_SPECIALIZATION
+//
+// True if the compiler supports partial specializations of templates. e.g.
+// \code
+// template <class T>
+// class vector<T*> : public vector<void *> { .. inline methods .. };
+// \endcode
+//
+#define VCL_CAN_DO_PARTIAL_SPECIALIZATION 0
+
+
+//: VCL_DEFINE_SPECIALIZATION
+//
+// In order to *define* a template (function or class) specialization, the
+// definition must be preceded by "template <>" on ISO-conforming compilers.
+// Some compilers (eg gcc 2.7.2) make no distinction between an instance
+// of a templated function and a function with the same name and signature,
+// and so do not support the use of "template <>". Use VCL_DEFINE_SPECIALIZATION
+// instead.
+//
+// Note that you DO NOT need to forward declare a specialization. E.g. if
+// foo.h says "template <class T> void foo(T *);" and foo.cxx specializes
+// void foo<int>(int *), the client doesn't need to know that the template
+// symbol he links against is a specialization.
+
+//#define VCL_DEFINE_SPECIALIZATION /* template <> */
+//#define VCL_DEFINE_SPECIALIZATION template <>
+#define VCL_DEFINE_SPECIALIZATION template <>
+
+
+//: VCL_CANNOT_SPECIALIZE_CV
+//
+// Template specialization considers top-level cv-qualifiers of the
+// argument type. For example, A<int> and A<int const> are distinct
+// types. Some compilers (eg Borland 5.5) do not make this distinction.
+// Specializations using top-level cv-qualifiers should not be defined
+// in addition to the unqualified equivalents unless
+// VCL_CANNOT_SPECIALIZE_CV is false.
+//#define VCL_CANNOT_SPECIALIZE_CV 1 /* cannot specialize with cv-qualifiers */
+//#define VCL_CANNOT_SPECIALIZE_CV 0 /* can specialize with cv-qualifiers */
+#define VCL_CANNOT_SPECIALIZE_CV 0
+
+
+//: VCL_TEMPLATE_MATCHES_TOO_OFTEN
+//
+// A function template is selected by overload resolution only if no
+// non-template requires equal or better conversions. Some compilers
+// (eg MSVC 6.x and 7.0, Borland 5.5 and 5.6) select the template
+// incorrectly in a case like this:
+// \code
+// class A {};
+// template <class T> void f(T);
+// void f(const A&);
+// void g() { f(A()); } // should call non-template
+// \endcode
+//
+// The work-around is to explicitly give the template a worse
+// conversion than the non-templated overloads:
+// \code
+// class A {};
+// template <class T> inline void f(T t) { f(t, 1); }
+// template <class T> void f(T t, long);
+// void f(const A&, int);
+// void g() { f(A()); } // will call non-template
+// \endcode
+// In this example, the inline one-argument template will always be
+// called, which will call the real function with an "int" passed to
+// the second argument. The templated two-argument function has a
+// "long" second argument while the others have "int". Therefore, the
+// template will be chosen only if no non-templates match.
+//
+// The VCL_TEMPLATE_MATCHES_TOO_OFTEN macro is set to 1
+// if this work-around is required and 0 otherwise.
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1 /* need work-around */
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 0 /* do not need it */
+#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1
+
+
+//: VCL_HAS_SLICED_DESTRUCTOR_BUG
+//
+// Consider this example code that creates a temporary in the call to f:
+// \code
+// struct A { A(); A(const A&); ~A(); };
+// struct B: public A { B(); B(const B& b); ~B(); };
+// struct C { operator B(); };
+// void f(A);
+// void g(C c) { f(c); } // fails to call ~B() on 2nd temporary B
+// \endcode
+// Compilers will call c.operator B() to implement the conversion
+// necessary to call f(c). Some compilers will then create a
+// temporary A by copy-constructing the temporary B to bind the
+// argument of f. Others will create a second temporary B by
+// copy-constructing the first temporary B and bind the A-portion of
+// the object to the argument of f. Some compilers (at least Intel
+// C++ 7.0 and 7.1) will create a second temporary B but forget to
+// call ~B() when destroying it. This can cause resource leaks.
+//
+// The VCL_HAS_SLICED_DESTRUCTOR_BUG is set to 1 if this bug exists in
+// the compiler and 0 otherwise.
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 1 /* bug exists */
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0 /* bug does not exist */
+#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0
+
+
+//: VCL_NULL_TMPL_ARGS
+//
+// Define to <> for compilers that require them in friend template function
+// declarations (i.e., EGCS, VC C++.NET 2003).
+
+//#define VCL_NULL_TMPL_ARGS /* <> */
+//#define VCL_NULL_TMPL_ARGS <>
+#define VCL_NULL_TMPL_ARGS /* <> */
+
+
+//----------------------------------------------------------------------
+// template instantiation
+
+//: VCL_ALLOWS_INLINE_INSTANTIATION
+//
+// True if the compiler allows explicit instantiation of inline
+// function templates. The native SGI CC 7.2.1 does not.
+#define VCL_ALLOWS_INLINE_INSTANTIATION 1
+
+
+//: VCL_NEEDS_INLINE_INSTANTIATION
+//
+// True if the compiler needs explicit instantiation of inline
+// function templates. gcc 2.7.2 (with -fno-implicit-templates) does.
+#define VCL_NEEDS_INLINE_INSTANTIATION 0
+
+
+//: VCL_DO_NOT_INSTANTIATE(text, ret)
+//
+// If a method is defined on some template, but makes no sense for some
+// instances of that template, the compiler should not complain unless the
+// method is actually used. For example
+// \code
+// template <class T>
+// class T {
+// int bad_method() {
+// return T::f(); // Requires T to have static method f
+// }
+// };
+// \endcode
+//
+// The language allows you to use a T<int> even though int::f() is garbage,
+// *providing* you never call T.bad_method().
+//
+// Most compilers don't implement that yet, so the solution is to provide a
+// dummy specialization of T::bad_method that returns something mundane and
+// stops the standard bad_method from being generated. For this, use:
+// \code
+// VCL_DO_NOT_INSTANTIATE(int T::bad_method(), some_return_value)
+// \endcode
+// if the function is void, use VCL_VOID_RETURN as the return value
+
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) template <> text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) /* no need -- magic compiler */
+//FIXME #define VCL_DO_NOT_INSTANTIATE(text, ret) @VCL_DO_NOT_INSTANTIATE@
+#define VCL_DO_NOT_INSTANTIATE(text, ret) \
+VCL_DEFINE_SPECIALIZATION \
+text { return ret; }
+
+
+//: VCL_UNINSTANTIATE_SPECIALIZATION(symbol)
+//
+// OK, various compilers do various silly things about instantiation of
+// functions/methods that have been specialized. Use this macro to tell
+// the compiler not to generate code for methods which have been specialized
+// \code
+// VCL_UNINSTANTIATE_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed after the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) @pragma do_not_instantiate text@
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) /* no need - sensible compiler */
+//FIXME #define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) @VCL_UNINSTANTIATE_SPECIALIZATION@
+#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) // which compiler needs this ?
+
+
+//: VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol)
+//
+// gcc is sensible about specializations if it has seen the definition,
+// but if it's in another file, need to use extern to tell it.
+// \code
+// VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed before the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) extern symbol;
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* no need */
+//FIXME #define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) @VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION@
+#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* never used */
+
+
+//: VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol)
+//
+// Some compilers (e.g. gcc 2.7.2) do not accept a templated definition
+// of static members, as in
+// \code
+// template <class T>
+// struct A {
+// A() { }
+// static char *fmt;
+// };
+//
+// template <class T>
+// char *A<T>::fmt = 0;
+//
+// template struct A<int>;
+// \endcode
+// The way round this is to supply an explicit definition for every
+// instance of the class needed.
+//
+// Put the templated definition like this
+// \code
+// #if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+// template <class T>
+// char *A<T>::fmt = 0;
+// #endif
+// \endcode
+// and place
+// \code
+// VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(int A<int>::fmt = 0)
+// \endcode
+// before the
+// \code
+// template class A<int>;
+// \endcode
+// with
+// \code
+// VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(A<int>::var)
+// \endcode
+// afterwards.
+
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* no need */
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+//
+#define VCL_CAN_DO_STATIC_TEMPLATE_MEMBER 1
+#if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+#else
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) // which compiler needs this ?
+#endif
+
+
+//: VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER
+//
+// Some compilers (e.g. SunPro 5.0) do not accept non-type template
+// parameters in function templates. E.g.
+// \code
+// template <class T, int n> struct vicky { T data[n]; } // can do
+//
+// template <class T, int n>
+// void a_function_template(vicky<T, n> const &) { ... } // cannot
+// \endcode
+#define VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER 1
+
+
+//----------------------------------------------------------------------
+// overload resolution problems.
+
+//: VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+//
+// On some compilers (in particular gcc 2.7.2.3), the compiler doesn't
+// know how to cast a templated derived class to a templated base class
+// (eg. vnl_matrix_fixed<3,3,double> -> vnl_matrix<double>) when doing overload
+// resolution. Making the overloaded function a friend of the class makes
+// the problem go away.
+//
+// True if the compiler needs this hack.
+
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 1
+#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+
+
+//: VCL_OVERLOAD_CAST
+//
+// Some compilers (gcc 2.7.2.3 and SGI native 6.0) often won't perform
+// certain implicit casts. E.g. casting a templated derived class to a
+// templated base class (see above), or even realizing that
+// "template void foo(float const * const *, float * const *, int, int)"
+// can be called with parameters of type "(float **, float **, int, int)".
+//
+// To fix the code, it is tempting to add an explicit cast and get on
+// with things, but that would throw away the checking performed by more
+// helpful compilers. Use VCL_OVERLOAD_CAST instead.
+
+//#define VCL_OVERLOAD_CAST(T, x) ((T)(x))
+//#define VCL_OVERLOAD_CAST(T, x) (x)
+#define VCL_OVERLOAD_CAST(T, x) (x)
+
+
+//----------------------------------------------------------------------
+// stuff
+
+
+//: VCL_NO_STATIC_DATA_MEMBERS
+//
+// True if compiler does not support static data members in template classes.
+//
+#define VCL_NO_STATIC_DATA_MEMBERS 0
+
+
+//: VCL_HAS_TEMPLATE_SYMBOLS
+//
+// True if the compiler mangles function template instances differently
+// from non-templated functions with the same name and signature.
+// This is correct behaviour.
+//
+#define VCL_HAS_TEMPLATE_SYMBOLS 0
+
+
+//----------------------------------------------------------------------
+// default template arguments
+
+//: VCL_DEFAULT_TMPL_ARG(arg)
+//
+// It is wrong to provide a default for a template parameter in two
+// declarations in the same scope (14.1.12), e.g.
+// \code
+// template <class S, class T = int> class X;
+// template <class S, class T = int> class X { /* ... */ };
+// \endcode
+// is wrong.
+// However, some older compilers insist on seeing the default argument
+// again when defining a class body or instantiating.
+// To satisfy them, use this macro as follows :
+// \code
+// template <class S, class T VCL_DEFAULT_TMPL_ARG(= int)> X { /* ... */ };
+// template X<double VCL_DEFAULT_TMPL_ARG(, int)>;
+// \endcode
+//
+// It's possible we need two macros, one for redeclaration and
+// one for instantiation.
+
+//#define VCL_DEFAULT_TMPL_ARG(arg) /* no need */
+//#define VCL_DEFAULT_TMPL_ARG(arg) arg
+#define VCL_DEFAULT_TMPL_ARG(arg)
+
+//
+#define VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER 1
+#define VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER 1
+
+// VCL_DFL_TYPE_PARAM_STLDECL(A, a) and VCL_DFL_TMPL_PARAM_STLDECL(A, a)
+// EGCS doesn't like definition of default types, viz:
+// \code
+// template <class A = default> class vector;
+// template <class A = default> class vector { ... };
+// \endcode
+// This macro is used to say "define if not previously defined, like
+// \code
+// template <VCL_DFL_TYPE_PARAM_STLDECL(A,a)> class vector { ... };
+// \endcode
+
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) __DFL_TYPE_PARAM(A,a)
+//FIXME #define VCL_DFL_TYPE_PARAM_STLDECL(A,a) @VCL_DFL_TYPE_PARAM_STLDECL@
+//
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) __STL_DFL_TMPL_PARAM(A,a)
+//FIXME #define VCL_DFL_TMPL_PARAM_STLDECL(A,a) @VCL_DFL_TMPL_PARAM_STLDECL@
+
+
+// VCL_DFL_TMPL_ARG(class)
+// Similarly, when instantiating a templated class with a default
+// template argument, some compilers don't like the redeclaration of
+// that argument, while others insist on it.
+// In such cases, specify the default argument as follows:
+// \code
+// template class vector <int VCL_DFL_TMPL_ARG(default_iterator) >;
+// \endcode
+// (Note the missing comma after int: it is inside the macro.)
+
+//#define VCL_DFL_TMPL_ARG(classname) , classname
+//#define VCL_DFL_TMPL_ARG(classname) /* , classname */
+//#define VCL_DFL_TMPL_ARG(classname) __DFL_TMPL_ARG(classname)
+//FIXME #define VCL_DFL_TMPL_ARG(classname) @VCL_DFL_TMPL_ARG@
+
+
+//: VCL_SUNPRO_CLASS_SCOPE_HACK(A)
+//
+// Nice one. Can't use std::vector<T> in a class on SunPro 5, must use
+// std::vector<T, std::allocator<T> >. Of course, we cannot expect that other
+// compilers call the default allocator std::allocator<T>, so we must use
+// a macro. I could call it something generic, like
+// VCL_CLASS_SCOPE_HACK, but to be honest, it's a sunpro problem,
+// they deserve the blame.
+// Usage (the comma is inside the macro) :
+// \code
+// vector<T VCL_SUNPRO_CLASS_SCOPE_HACK(std::allocator<T >)>
+// \endcode
+
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) , A
+#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+
+
+//----------------------------------------------------------------------
+// exception and namespace issues
+
+
+//: VCL_HAS_EXCEPTIONS
+// Set to true if the compiler supports the use of exceptions.
+#define VCL_HAS_EXCEPTIONS 1
+
+
+//: VCL_HAS_NAMESPACES
+// Set to true if the compiler supports the use of namespaces.
+#define VCL_HAS_NAMESPACES 1
+
+
+//: VCL_ALLOWS_NAMESPACE_STD
+// Set to true if the compiler allows namespace std:: for the standard library.
+#define VCL_ALLOWS_NAMESPACE_STD 0
+
+
+//: VCL_NEEDS_NAMESPACE_STD
+// Set to true if the compiler needs namespace std:: for the standard library.
+#define VCL_NEEDS_NAMESPACE_STD 0
+
+//----------------------------------------------------------------------
+// infinity issues
+
+//: VCL_NUMERIC_LIMITS_HAS_INFINITY
+// Set to true if there is a numeric_limits and it reports having an floating point infinity.
+#define VCL_NUMERIC_LIMITS_HAS_INFINITY 1
+
+//: VCL_PROCESSOR_HAS_INFINITY
+// Set to true if the processor really does have an infinity.
+// Although this is strictly not a C++ issue, some platforms' versions of
+// numeric_limits<double> imply that there is no infinity, when there is.
+#define VCL_PROCESSOR_HAS_INFINITY 1
+
+//----------------------------------------------------------------------
+// signedness of char
+
+//: VCL_CHAR_IS_SIGNED
+// Set to true if the type "char" is signed.
+#define VCL_CHAR_IS_SIGNED 1
+
+//----------------------------------------------------------------------
+// architecture macros removed -- they're not in the C++ standard
+
+#endif // vcl_config_compiler_h_config_stlport_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_headers.h b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_headers.h
new file mode 100644
index 0000000000000000000000000000000000000000..f0807720cde78f5726c04d7088b52b52e54f83eb
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_headers.h
@@ -0,0 +1,66 @@
+#ifndef vcl_config_headers_h_config_stlport_win32_vc60_
+#define vcl_config_headers_h_config_stlport_win32_vc60_
+//:
+// \file
+// This file either is or was generated from vcl_config_headers.h.in
+
+//--------------------------------------------------------------------------------
+
+//: standard header files.
+#define VCL_CXX_HAS_HEADER_CASSERT 1
+#define VCL_CXX_HAS_HEADER_CISO646 1
+#define VCL_CXX_HAS_HEADER_CSETJMP 1
+#define VCL_CXX_HAS_HEADER_CSTDIO 1
+#define VCL_CXX_HAS_HEADER_CTIME 1
+#define VCL_CXX_HAS_HEADER_CCTYPE 1
+#define VCL_CXX_HAS_HEADER_CLIMITS 1
+#define VCL_CXX_HAS_HEADER_CSIGNAL 1
+#define VCL_CXX_HAS_HEADER_CSTDLIB 1
+#define VCL_CXX_HAS_HEADER_CWCHAR 1
+#define VCL_CXX_HAS_HEADER_CERRNO 1
+#define VCL_CXX_HAS_HEADER_CLOCALE 1
+#define VCL_CXX_HAS_HEADER_CSTDARG 1
+#define VCL_CXX_HAS_HEADER_CSTRING 1
+#define VCL_CXX_HAS_HEADER_CWCTYPE 1
+#define VCL_CXX_HAS_HEADER_CFLOAT 1
+#define VCL_CXX_HAS_HEADER_CMATH 1
+#define VCL_CXX_HAS_HEADER_CSTDDEF 1
+#define VCL_CXX_HAS_HEADER_ALGORITHM 1
+#define VCL_CXX_HAS_HEADER_IOMANIP 1
+#define VCL_CXX_HAS_HEADER_LIST 1
+#define VCL_CXX_HAS_HEADER_OSTREAM 1
+#define VCL_CXX_HAS_HEADER_STREAMBUF 1
+#define VCL_CXX_HAS_HEADER_BITSET 1
+#define VCL_CXX_HAS_HEADER_IOS 1
+#define VCL_CXX_HAS_HEADER_LOCALE 1
+#define VCL_CXX_HAS_HEADER_QUEUE 1
+#define VCL_CXX_HAS_HEADER_STRING 1
+#define VCL_CXX_HAS_HEADER_COMPLEX 1
+#define VCL_CXX_HAS_HEADER_IOSFWD 1
+#define VCL_CXX_HAS_HEADER_MAP 1
+#define VCL_CXX_HAS_HEADER_SET 1
+#define VCL_CXX_HAS_HEADER_TYPEINFO 1
+#define VCL_CXX_HAS_HEADER_DEQUE 1
+#define VCL_CXX_HAS_HEADER_IOSTREAM 1
+#define VCL_CXX_HAS_HEADER_MEMORY 1
+#define VCL_CXX_HAS_HEADER_SSTREAM 1
+#define VCL_CXX_HAS_HEADER_UTILITY 1
+#define VCL_CXX_HAS_HEADER_EXCEPTION 1
+#define VCL_CXX_HAS_HEADER_ISTREAM 1
+#define VCL_CXX_HAS_HEADER_NEW 1
+#define VCL_CXX_HAS_HEADER_STACK 1
+#define VCL_CXX_HAS_HEADER_VALARRAY 1
+#define VCL_CXX_HAS_HEADER_FSTREAM 1
+#define VCL_CXX_HAS_HEADER_ITERATOR 1
+#define VCL_CXX_HAS_HEADER_NUMERIC 1
+#define VCL_CXX_HAS_HEADER_STDEXCEPT 1
+#define VCL_CXX_HAS_HEADER_VECTOR 1
+#define VCL_CXX_HAS_HEADER_FUNCTIONAL 1
+#define VCL_CXX_HAS_HEADER_LIMITS 1
+#define VCL_CXX_HAS_HEADER_STRSTREAM 1
+
+#define VCL_CXX_HAS_HEADER_ISO646_H 1
+
+//--------------------------------------------------------------------------------
+
+#endif // vcl_config_headers_h_config_stlport_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_manual.h b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_manual.h
new file mode 100644
index 0000000000000000000000000000000000000000..2c3927536293da9bbf7fa1b794ec19da0c90d889
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vcl_config_manual.h
@@ -0,0 +1,15 @@
+#ifndef vcl_config_manual_h_config_stlport_win32_vc60_
+#define vcl_config_manual_h_config_stlport_win32_vc60_
+
+// This file is *not* generated.
+
+#define VCL_USE_NATIVE_STL 1
+
+#define VCL_USE_NATIVE_COMPLEX 1
+
+#define VCL_USE_IMPLICIT_TEMPLATES 1
+
+// Use STL port stl libraries.
+#define VCL_STLPORT 1
+
+#endif // vcl_config_manual_h_config_stlport_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vxl_config.h b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vxl_config.h
new file mode 100644
index 0000000000000000000000000000000000000000..ebf76083e543f5760355b0b84389abdadaa65c64
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.stlport.win32-vc60/vxl_config.h
@@ -0,0 +1,166 @@
+#ifndef vxl_config_h_config_stlport_win32_vc60_
+#define vxl_config_h_config_stlport_win32_vc60_
+
+/* This file was *not* generated from vxl_config.h.in */
+/* It is maintained manually. */
+
+/* -------------------- machine word characteristics */
+
+/* these are 0 or 1, never empty. */
+#define VXL_LITTLE_ENDIAN 1
+#define VXL_BIG_ENDIAN 0
+
+/* we can't just use typedefs, because on systems where there are */
+/* no 64bit integers we have to #define vxl_int_64 to `void' in */
+/* order to catch illegitimate uses. However, typedefs are superior */
+/* to #defines, especially for the two keyword types, so we use */
+/* typedefs for the valid cases. */
+
+#define VXL_HAS_BYTE 1
+#define VXL_BYTE_STRING "char"
+#if 1
+ typedef signed char vxl_sbyte;
+ typedef unsigned char vxl_byte;
+#else
+# define vxl_sbyte void
+# define vxl_byte void
+#endif
+
+#define VXL_HAS_INT_8 1
+#define VXL_INT_8_STRING "char"
+#if 1
+ typedef char vxl_int_8;
+ typedef signed char vxl_sint_8;
+ typedef unsigned char vxl_uint_8;
+#else
+# define vxl_int_8 void
+# define vxl_sint_8 void
+# define vxl_uint_8 void
+#endif
+
+#define VXL_HAS_INT_16 1
+#define VXL_INT_16_STRING "short"
+#if 1
+ typedef short vxl_int_16;
+ typedef signed short vxl_sint_16;
+ typedef unsigned short vxl_uint_16;
+#else
+# define vxl_int_16 void
+# define vxl_sint_16 void
+# define vxl_uint_16 void
+#endif
+
+#define VXL_HAS_INT_32 1
+#define VXL_INT_32_STRING "int"
+#if 1
+ typedef int vxl_int_32;
+ typedef signed int vxl_sint_32;
+ typedef unsigned int vxl_uint_32;
+#else
+# define vxl_int_32 void
+# define vxl_sint_32 void
+# define vxl_uint_32 void
+#endif
+
+#define VXL_HAS_INT_64 0
+#define VXL_INT_64_STRING "void"
+#if 0
+ typedef void vxl_int_64;
+ typedef signed void vxl_sint_64;
+ typedef unsigned void vxl_uint_64;
+#else
+# define vxl_int_64 void
+# define vxl_sint_64 void
+# define vxl_uint_64 void
+#endif
+
+#define VXL_INT_64_IS_LONG 0
+
+#define VXL_HAS_IEEE_32 1
+#define VXL_IEEE_32_STRING "float"
+#if 1
+ typedef float vxl_ieee_32;
+#else
+# define vxl_ieee_32 void
+#endif
+
+#define VXL_HAS_IEEE_64 1
+#define VXL_IEEE_64_STRING "double"
+#if 1
+ typedef double vxl_ieee_64;
+#else
+# define vxl_ieee_64 void
+#endif
+
+#define VXL_HAS_IEEE_96 0
+#define VXL_IEEE_96_STRING "void"
+#if 0
+ typedef void vxl_ieee_96;
+#else
+# define vxl_ieee_96 void
+#endif
+
+#define VXL_HAS_IEEE_128 0
+#define VXL_IEEE_128_STRING "void"
+#if 0
+ typedef void vxl_ieee_128;
+#else
+# define vxl_ieee_128 void
+#endif
+
+/* -------------------- operating system services */
+
+#define VXL_HAS_PTHREAD_H 0
+#define VXL_HAS_SEMAPHORE_H 0
+
+/* -------------------- library quirks */
+
+/* these should be 1 if the symbol in question is declared */
+/* in the relevant header file and 0 otherwise. */
+
+#define VXL_UNISTD_HAS_USECONDS_T 0
+#define VXL_UNISTD_HAS_INTPTR_T 0
+#define VXL_UNISTD_HAS_UALARM 1
+#define VXL_UNISTD_HAS_USLEEP 1
+#define VXL_UNISTD_HAS_LCHOWN 1
+#define VXL_UNISTD_HAS_PREAD 1
+#define VXL_UNISTD_HAS_PWRITE 1
+#define VXL_UNISTD_HAS_TELL 1
+
+/* true if <stdlib.h> declares qsort() */
+#define VXL_STDLIB_HAS_QSORT 1
+
+/* true if <stdlib.h> declares lrand48() */
+#define VXL_STDLIB_HAS_LRAND48 1 /* ? */
+
+/* true if <stdlib.h> declares drand48() */
+#define VXL_STDLIB_HAS_DRAND48 0
+
+/* true if <stdlib.h> declares srand48() */
+#define VXL_STDLIB_HAS_SRAND48 0
+
+/* true if <ieeefp.h> declares finite() */
+#define VXL_IEEEFP_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEF 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEL 0 /* ? */
+
+/* true if <math.h> declares sqrtf() for the C compiler */
+#define VXL_C_MATH_HAS_SQRTF 0 /* ? */
+
+/* true if usleep() returns void */
+#define VXL_UNISTD_USLEEP_IS_VOID 0
+
+/* true if gettime() takes two arguments */
+#define VXL_TWO_ARG_GETTIME 0
+
+/* true if <ieeefp.h> is available */
+#define VXL_HAS_IEEEFP_H 1
+
+#endif /* vxl_config_h_config_stlport_win32_vc60_ */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_compiler.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_compiler.h
new file mode 100644
index 0000000000000000000000000000000000000000..7c0162652e43148c0b80b7e16359267fd3bbf5e3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_compiler.h
@@ -0,0 +1,633 @@
+#ifndef vcl_config_compiler_h_config_win32_vc60_
+#define vcl_config_compiler_h_config_win32_vc60_
+//:
+// \file
+// This file is *not* generated.
+
+//----------------------------------------------------------------------
+// syntax-like things.
+
+//: VCL_HAS_BOOL
+// Set to 1 if "bool" is accepted by the compiler as a built-in type.
+#define VCL_HAS_BOOL 1
+
+
+//: VCL_HAS_DYNAMIC_CAST
+//
+// True if the compiler supports dynamic cast.
+//
+#define VCL_HAS_DYNAMIC_CAST 1
+
+
+//: VCL_HAS_RTTI
+//
+// True if the compiler supports RTTI, viz the 'typeid' function.
+//
+#define VCL_HAS_RTTI 0
+
+
+//: VCL_HAS_TYPENAME
+//
+// True if the compiler supports the "typename" keyword
+//
+#define VCL_HAS_TYPENAME 1
+
+
+//: VCL_HAS_EXPORT
+//
+// True if the compiler supports the "export" keyword. FIXME.
+//
+#define VCL_HAS_EXPORT 0
+
+
+//: VCL_HAS_MUTABLE
+//
+// True if the compiler supports the "mutable" keyword
+//
+#define VCL_HAS_MUTABLE 1
+
+
+//: VCL_HAS_EXPLICIT
+//
+// True if the compiler supports the "explicit" keyword
+//
+#define VCL_HAS_EXPLICIT 1
+
+
+//: VCL_FOR_SCOPE_HACK:
+//
+// True if the compiler uses old-style 'for' loop scoping.
+// Setting this nonzero causes the Henderson trick to be used.
+#define VCL_FOR_SCOPE_HACK 1
+
+
+//: VCL_COMPLEX_POW_WORKS
+//
+// It appears several programmers have (independently)
+// not realised their lack of knowledge of complex numbers.
+// pow(complex(-1,0),0.5) should return (0,1) not (Nan,0), etc.
+#define VCL_COMPLEX_POW_WORKS 0
+
+
+//: VCL_DEFAULT_VALUE(x)
+//
+// Used to provide default values for function args in definition
+// Some compilers (GCC272) require defaults in template function definitions
+// Other compilers (VC50) disallow defaults in both decls and defs
+
+//#define VCL_DEFAULT_VALUE(x) /* no need */
+//#define VCL_DEFAULT_VALUE(x) = x
+#define VCL_DEFAULT_VALUE(x) /* no need */
+
+
+//----------------------------------------------------------------------
+// constant initializer issues.
+
+//: VCL_STATIC_CONST_INIT_INT_DECL(x)
+//
+// ANSI allows
+// \code
+// class A {
+// static const int x = 27;
+// };
+// \endcode
+// And there is a speed advantage, so we want to use it where supported.
+// However, the standard also requires (9.4.2/4) that the constant be
+// defined in namespace scope. (That is, space must be allocated.)
+// To make matters worse, some compilers (at least VC 7) mistakenly
+// allocate storage without the definition in namespace scope,
+// which results in multiply defined symbols.
+// To use the macro, use VCL_STATIC_CONST_INIT_INT_DECL in the class
+// definition (header file). This declares the constant.
+// \code
+// class A {
+// static const int x VCL_STATIC_CONST_INIT_INT_DECL(27);
+// };
+// \endcode
+// Use VCL_STATIC_CONST_INIT_INT_DEFN in some .cxx file to define
+// the constant, but only if VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// evaluates to false.
+// \code
+// #if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// const int A::x VCL_STATIC_CONST_INIT_INT_DEFN(27);
+// #endif
+// \endcode
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_INT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_INT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_INT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_INT
+# define VCL_CAN_STATIC_CONST_INIT_INT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_INT
+# define VCL_STATIC_CONST_INIT_INT_DECL(x) = x
+# define VCL_STATIC_CONST_INIT_INT_DEFN(x) /* initialized at declaration */
+# define VCL_STATIC_CONST_INIT_INT_NO_DEFN 0
+#else
+# define VCL_STATIC_CONST_INIT_INT_DECL(x) /* not allowed */
+# define VCL_STATIC_CONST_INIT_INT_DEFN(x) = x
+# define VCL_STATIC_CONST_INIT_INT_NO_DEFN 0
+#endif
+
+
+//: VCL_STATIC_CONST_INIT_FLOAT(x)
+//
+// GCC allows the above, but with floating point types, ANSI doesn't.
+// Again, we'll use it if we've got it.
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_FLOAT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_FLOAT
+# define VCL_CAN_STATIC_CONST_INIT_FLOAT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_FLOAT
+# define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) = x
+# define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) /* initialized at declaration */
+# define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#else
+# define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) /* not allowed */
+# define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) = x
+# define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#endif
+
+
+//----------------------------------------------------------------------
+// various template issues.
+
+//: VCL_HAS_MEMBER_TEMPLATES
+//
+// True if the compiler supports template members of template classes. e.g.
+// \code
+// template <class U> class A {
+// template <class V> void f(V);
+// }
+// \endcode
+#define VCL_HAS_MEMBER_TEMPLATES 1
+
+
+//: VCL_CAN_DO_PARTIAL_SPECIALIZATION
+//
+// True if the compiler supports partial specializations of templates. e.g.
+// \code
+// template <class T>
+// class vector<T*> : public vector<void *> { .. inline methods .. };
+// \endcode
+//
+#define VCL_CAN_DO_PARTIAL_SPECIALIZATION 0
+
+
+//: VCL_DEFINE_SPECIALIZATION
+//
+// In order to *define* a template (function or class) specialization, the
+// definition must be preceded by "template <>" on ISO-conforming compilers.
+// Some compilers (eg gcc 2.7.2) make no distinction between an instance
+// of a templated function and a function with the same name and signature,
+// and so do not support the use of "template <>". Use VCL_DEFINE_SPECIALIZATION
+// instead.
+//
+// Note that you DO NOT need to forward declare a specialization. E.g. if
+// foo.h says "template <class T> void foo(T *);" and foo.cxx specializes
+// void foo<int>(int *), the client doesn't need to know that the template
+// symbol he links against is a specialization.
+
+//#define VCL_DEFINE_SPECIALIZATION /* template <> */
+//#define VCL_DEFINE_SPECIALIZATION template <>
+#if defined(__ICL)
+# define VCL_DEFINE_SPECIALIZATION /* template <> */
+#else
+# define VCL_DEFINE_SPECIALIZATION template <>
+#endif
+
+
+//: VCL_CANNOT_SPECIALIZE_CV
+//
+// Template specialization considers top-level cv-qualifiers of the
+// argument type. For example, A<int> and A<int const> are distinct
+// types. Some compilers (eg Borland 5.5) do not make this distinction.
+// Specializations using top-level cv-qualifiers should not be defined
+// in addition to the unqualified equivalents unless
+// VCL_CANNOT_SPECIALIZE_CV is false.
+//#define VCL_CANNOT_SPECIALIZE_CV 1 /* cannot specialize with cv-qualifiers */
+//#define VCL_CANNOT_SPECIALIZE_CV 0 /* can specialize with cv-qualifiers */
+#define VCL_CANNOT_SPECIALIZE_CV 0
+
+
+//: VCL_TEMPLATE_MATCHES_TOO_OFTEN
+//
+// A function template is selected by overload resolution only if no
+// non-template requires equal or better conversions. Some compilers
+// (eg MSVC 6.x and 7.0, Borland 5.5 and 5.6) select the template
+// incorrectly in a case like this:
+// \code
+// class A {};
+// template <class T> void f(T);
+// void f(const A&);
+// void g() { f(A()); } // should call non-template
+// \endcode
+//
+// The work-around is to explicitly give the template a worse
+// conversion than the non-templated overloads:
+// \code
+// class A {};
+// template <class T> inline void f(T t) { f(t, 1); }
+// template <class T> void f(T t, long);
+// void f(const A&, int);
+// void g() { f(A()); } // will call non-template
+// \endcode
+// In this example, the inline one-argument template will always be
+// called, which will call the real function with an "int" passed to
+// the second argument. The templated two-argument function has a
+// "long" second argument while the others have "int". Therefore, the
+// template will be chosen only if no non-templates match.
+//
+// The VCL_TEMPLATE_MATCHES_TOO_OFTEN macro is set to 1
+// if this work-around is required and 0 otherwise.
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1 /* need work-around */
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 0 /* do not need it */
+// !!! different from VC71
+#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1
+
+
+//: VCL_HAS_SLICED_DESTRUCTOR_BUG
+//
+// Consider this example code that creates a temporary in the call to f:
+// \code
+// struct A { A(); A(const A&); ~A(); };
+// struct B: public A { B(); B(const B& b); ~B(); };
+// struct C { operator B(); };
+// void f(A);
+// void g(C c) { f(c); } // fails to call ~B() on 2nd temporary B
+// \endcode
+// Compilers will call c.operator B() to implement the conversion
+// necessary to call f(c). Some compilers will then create a
+// temporary A by copy-constructing the temporary B to bind the
+// argument of f. Others will create a second temporary B by
+// copy-constructing the first temporary B and bind the A-portion of
+// the object to the argument of f. Some compilers (at least Intel
+// C++ 7.0 and 7.1) will create a second temporary B but forget to
+// call ~B() when destroying it. This can cause resource leaks.
+//
+// The VCL_HAS_SLICED_DESTRUCTOR_BUG is set to 1 if this bug exists in
+// the compiler and 0 otherwise.
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 1 /* bug exists */
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0 /* bug does not exist */
+#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0
+
+
+//: VCL_NULL_TMPL_ARGS
+//
+// Define to <> for compilers that require them in friend template function
+// declarations (i.e., EGCS, VC C++.NET 2003).
+
+//#define VCL_NULL_TMPL_ARGS /* <> */
+//#define VCL_NULL_TMPL_ARGS <>
+// !!! different from VC71
+#define VCL_NULL_TMPL_ARGS /* <> */
+
+
+//----------------------------------------------------------------------
+// template instantiation
+
+//: VCL_ALLOWS_INLINE_INSTANTIATION
+//
+// True if the compiler allows explicit instantiation of inline
+// function templates. The native SGI CC 7.2.1 does not.
+#define VCL_ALLOWS_INLINE_INSTANTIATION 1
+
+
+//: VCL_NEEDS_INLINE_INSTANTIATION
+//
+// True if the compiler needs explicit instantiation of inline
+// function templates. gcc 2.7.2 (with -fno-implicit-templates) does.
+#define VCL_NEEDS_INLINE_INSTANTIATION 0
+
+
+//: VCL_DO_NOT_INSTANTIATE(text, ret)
+//
+// If a method is defined on some template, but makes no sense for some
+// instances of that template, the compiler should not complain unless the
+// method is actually used. For example
+// \code
+// template <class T>
+// class T {
+// int bad_method() {
+// return T::f(); // Requires T to have static method f
+// }
+// };
+// \endcode
+//
+// The language allows you to use a T<int> even though int::f() is garbage,
+// *providing* you never call T.bad_method().
+//
+// Most compilers don't implement that yet, so the solution is to provide a
+// dummy specialization of T::bad_method that returns something mundane and
+// stops the standard bad_method from being generated. For this, use:
+// \code
+// VCL_DO_NOT_INSTANTIATE(int T::bad_method(), some_return_value)
+// \endcode
+// if the function is void, use VCL_VOID_RETURN as the return value
+
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) template <> text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) /* no need -- magic compiler */
+//FIXME #define VCL_DO_NOT_INSTANTIATE(text, ret)
+#define VCL_DO_NOT_INSTANTIATE(text, ret) \
+VCL_DEFINE_SPECIALIZATION \
+text { return ret; }
+
+
+//: VCL_UNINSTANTIATE_SPECIALIZATION(symbol)
+//
+// OK, various compilers do various silly things about instantiation of
+// functions/methods that have been specialized. Use this macro to tell
+// the compiler not to generate code for methods which have been specialized
+// \code
+// VCL_UNINSTANTIATE_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed after the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) @pragma do_not_instantiate text@
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) /* no need - sensible compiler */
+//FIXME #define VCL_UNINSTANTIATE_SPECIALIZATION(symbol)
+#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) // which compiler needs this ?
+
+
+//: VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol)
+//
+// gcc is sensible about specializations if it has seen the definition,
+// but if it's in another file, need to use extern to tell it.
+// \code
+// VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed before the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) extern symbol;
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* no need */
+//FIXME #define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol)
+#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* never used */
+
+
+//: VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol)
+//
+// Some compilers (e.g. gcc 2.7.2) do not accept a templated definition
+// of static members, as in
+// \code
+// template <class T>
+// struct A {
+// A() { }
+// static char *fmt;
+// };
+//
+// template <class T>
+// char *A<T>::fmt = 0;
+//
+// template struct A<int>;
+// \endcode
+// The way round this is to supply an explicit definition for every
+// instance of the class needed.
+//
+// Put the templated definition like this
+// \code
+// #if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+// template <class T>
+// char *A<T>::fmt = 0;
+// #endif
+// \endcode
+// and place
+// \code
+// VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(int A<int>::fmt = 0)
+// \endcode
+// before the
+// \code
+// template class A<int>;
+// \endcode
+// with
+// \code
+// VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(A<int>::var)
+// \endcode
+// afterwards.
+
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* no need */
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+//
+#define VCL_CAN_DO_STATIC_TEMPLATE_MEMBER 1
+#if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+#else
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) // which compiler needs this ?
+#endif
+
+
+//: VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER
+//
+// Some compilers (e.g. SunPro 5.0) do not accept non-type template
+// parameters in function templates. E.g.
+// \code
+// template <class T, int n> struct vicky { T data[n]; } // can do
+//
+// template <class T, int n>
+// void a_function_template(vicky<T, n> const &) { ... } // cannot
+// \endcode
+#define VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER 1
+
+
+//----------------------------------------------------------------------
+// overload resolution problems.
+
+//: VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+//
+// On some compilers (in particular gcc 2.7.2.3), the compiler doesn't
+// know how to cast a templated derived class to a templated base class
+// (eg. vnl_matrix_fixed<3,3,double> -> vnl_matrix<double>) when doing overload
+// resolution. Making the overloaded function a friend of the class makes
+// the problem go away.
+//
+// True if the compiler needs this hack.
+
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 1
+#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+
+
+//: VCL_OVERLOAD_CAST
+//
+// Some compilers (gcc 2.7.2.3 and SGI native 6.0) often won't perform
+// certain implicit casts. E.g. casting a templated derived class to a
+// templated base class (see above), or even realizing that
+// "template void foo(float const * const *, float * const *, int, int)"
+// can be called with parameters of type "(float **, float **, int, int)".
+//
+// To fix the code, it is tempting to add an explicit cast and get on
+// with things, but that would throw away the checking performed by more
+// helpful compilers. Use VCL_OVERLOAD_CAST instead.
+
+//#define VCL_OVERLOAD_CAST(T, x) ((T)(x))
+//#define VCL_OVERLOAD_CAST(T, x) (x)
+#define VCL_OVERLOAD_CAST(T, x) (x)
+
+
+//----------------------------------------------------------------------
+// stuff
+
+
+//: VCL_NO_STATIC_DATA_MEMBERS
+//
+// True if compiler does not support static data members in template classes.
+//
+#define VCL_NO_STATIC_DATA_MEMBERS 0
+
+
+//: VCL_HAS_TEMPLATE_SYMBOLS
+//
+// True if the compiler mangles function template instances differently
+// from non-templated functions with the same name and signature.
+// This is correct behaviour.
+//
+#define VCL_HAS_TEMPLATE_SYMBOLS 0
+
+
+//----------------------------------------------------------------------
+// default template arguments
+
+//: VCL_DEFAULT_TMPL_ARG(arg)
+//
+// It is wrong to provide a default for a template parameter in two
+// declarations in the same scope (14.1.12), e.g.
+// \code
+// template <class S, class T = int> class X;
+// template <class S, class T = int> class X { /* ... */ };
+// \endcode
+// is wrong.
+// However, some older compilers insist on seeing the default argument
+// again when defining a class body or instantiating.
+// To satisfy them, use this macro as follows :
+// \code
+// template <class S, class T VCL_DEFAULT_TMPL_ARG(= int)> X { /* ... */ };
+// template X<double VCL_DEFAULT_TMPL_ARG(, int)>;
+// \endcode
+//
+// It's possible we need two macros, one for redeclaration and
+// one for instantiation.
+
+//#define VCL_DEFAULT_TMPL_ARG(arg) /* no need */
+//#define VCL_DEFAULT_TMPL_ARG(arg) arg
+#define VCL_DEFAULT_TMPL_ARG(arg)
+
+//
+#define VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER 1
+#define VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER 1
+
+// VCL_DFL_TYPE_PARAM_STLDECL(A, a) and VCL_DFL_TMPL_PARAM_STLDECL(A, a)
+// EGCS doesn't like definition of default types, viz:
+// \code
+// template <class A = default> class vector;
+// template <class A = default> class vector { ... };
+// \endcode
+// This macro is used to say "define if not previously defined, like
+// \code
+// template <VCL_DFL_TYPE_PARAM_STLDECL(A,a)> class vector { ... };
+// \endcode
+
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) __DFL_TYPE_PARAM(A,a)
+//FIXME #define VCL_DFL_TYPE_PARAM_STLDECL(A,a)
+//
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) __STL_DFL_TMPL_PARAM(A,a)
+//FIXME #define VCL_DFL_TMPL_PARAM_STLDECL(A,a)
+
+
+// VCL_DFL_TMPL_ARG(class)
+// Similarly, when instantiating a templated class with a default
+// template argument, some compilers don't like the redeclaration of
+// that argument, while others insist on it.
+// In such cases, specify the default argument as follows:
+// \code
+// template class vector <int VCL_DFL_TMPL_ARG(default_iterator) >;
+// \endcode
+// (Note the missing comma after int: it is inside the macro.)
+
+//#define VCL_DFL_TMPL_ARG(classname) , classname
+//#define VCL_DFL_TMPL_ARG(classname) /* , classname */
+//#define VCL_DFL_TMPL_ARG(classname) __DFL_TMPL_ARG(classname)
+//FIXME #define VCL_DFL_TMPL_ARG(classname)
+
+
+//: VCL_SUNPRO_CLASS_SCOPE_HACK(A)
+//
+// Nice one. Can't use std::vector<T> in a class on SunPro 5, must use
+// std::vector<T, std::allocator<T> >. Of course, we cannot expect that other
+// compilers call the default allocator std::allocator<T>, so we must use
+// a macro. I could call it something generic, like
+// VCL_CLASS_SCOPE_HACK, but to be honest, it's a sunpro problem,
+// they deserve the blame.
+// Usage (the comma is inside the macro) :
+// \code
+// vector<T VCL_SUNPRO_CLASS_SCOPE_HACK(std::allocator<T >)>
+// \endcode
+
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) , A
+#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+
+
+//----------------------------------------------------------------------
+// exception and namespace issues
+
+
+//: VCL_HAS_EXCEPTIONS
+// Set to true if the compiler supports the use of exceptions.
+#define VCL_HAS_EXCEPTIONS 1
+
+
+//: VCL_HAS_NAMESPACES
+// Set to true if the compiler supports the use of namespaces.
+#define VCL_HAS_NAMESPACES 1
+
+
+//: VCL_ALLOWS_NAMESPACE_STD
+// Set to true if the compiler allows namespace std:: for the standard library.
+// !!! different from VC7
+#define VCL_ALLOWS_NAMESPACE_STD 0
+
+
+//: VCL_NEEDS_NAMESPACE_STD
+// Set to true if the compiler needs namespace std:: for the standard library.
+// !!! different from VC7
+#define VCL_NEEDS_NAMESPACE_STD 0
+
+
+//----------------------------------------------------------------------
+// infinity issues
+
+//: VCL_NUMERIC_LIMITS_HAS_INFINITY
+// Set to true if there is a numeric_limits and it reports having an floating point infinity.
+#define VCL_NUMERIC_LIMITS_HAS_INFINITY 1
+
+//: VCL_PROCESSOR_HAS_INFINITY
+// Set to true if the processor really does have an infinity.
+// Although this is strictly not a C++ issue, some platforms' versions of
+// numeric_limits<double> imply that there is no infinity, when there is.
+#define VCL_PROCESSOR_HAS_INFINITY 1
+
+//----------------------------------------------------------------------
+// signedness of char
+
+//: VCL_CHAR_IS_SIGNED
+// Set to true if the type "char" is signed.
+#define VCL_CHAR_IS_SIGNED 1
+
+//----------------------------------------------------------------------
+
+// architecture macros removed -- they're not in the C++ standard
+
+#endif // vcl_config_compiler_h_config_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_headers.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_headers.h
new file mode 100644
index 0000000000000000000000000000000000000000..982694232f813ff565a719116eb3f5ade4ffaabf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_headers.h
@@ -0,0 +1,65 @@
+#ifndef vcl_config_headers_h_config_win32_vc60_
+#define vcl_config_headers_h_config_win32_vc60_
+
+// This file either is or was generated from vcl_config_headers.h.in
+
+//--------------------------------------------------------------------------------
+
+// standard header files.
+#define VCL_CXX_HAS_HEADER_CASSERT 1
+#define VCL_CXX_HAS_HEADER_CISO646 1
+#define VCL_CXX_HAS_HEADER_CSETJMP 1
+#define VCL_CXX_HAS_HEADER_CSTDIO 1
+#define VCL_CXX_HAS_HEADER_CTIME 1
+#define VCL_CXX_HAS_HEADER_CCTYPE 1
+#define VCL_CXX_HAS_HEADER_CLIMITS 1
+#define VCL_CXX_HAS_HEADER_CSIGNAL 1
+#define VCL_CXX_HAS_HEADER_CSTDLIB 1
+#define VCL_CXX_HAS_HEADER_CWCHAR 1
+#define VCL_CXX_HAS_HEADER_CERRNO 1
+#define VCL_CXX_HAS_HEADER_CLOCALE 1
+#define VCL_CXX_HAS_HEADER_CSTDARG 1
+#define VCL_CXX_HAS_HEADER_CSTRING 1
+#define VCL_CXX_HAS_HEADER_CWCTYPE 1
+#define VCL_CXX_HAS_HEADER_CFLOAT 1
+#define VCL_CXX_HAS_HEADER_CMATH 1
+#define VCL_CXX_HAS_HEADER_CSTDDEF 1
+#define VCL_CXX_HAS_HEADER_ALGORITHM 1
+#define VCL_CXX_HAS_HEADER_IOMANIP 1
+#define VCL_CXX_HAS_HEADER_LIST 1
+#define VCL_CXX_HAS_HEADER_OSTREAM 1
+#define VCL_CXX_HAS_HEADER_STREAMBUF 1
+#define VCL_CXX_HAS_HEADER_BITSET 1
+#define VCL_CXX_HAS_HEADER_IOS 1
+#define VCL_CXX_HAS_HEADER_LOCALE 1
+#define VCL_CXX_HAS_HEADER_QUEUE 1
+#define VCL_CXX_HAS_HEADER_STRING 1
+#define VCL_CXX_HAS_HEADER_COMPLEX 1
+#define VCL_CXX_HAS_HEADER_IOSFWD 1
+#define VCL_CXX_HAS_HEADER_MAP 1
+#define VCL_CXX_HAS_HEADER_SET 1
+#define VCL_CXX_HAS_HEADER_TYPEINFO 1
+#define VCL_CXX_HAS_HEADER_DEQUE 1
+#define VCL_CXX_HAS_HEADER_IOSTREAM 1
+#define VCL_CXX_HAS_HEADER_MEMORY 1
+#define VCL_CXX_HAS_HEADER_SSTREAM 1
+#define VCL_CXX_HAS_HEADER_UTILITY 1
+#define VCL_CXX_HAS_HEADER_EXCEPTION 1
+#define VCL_CXX_HAS_HEADER_ISTREAM 1
+#define VCL_CXX_HAS_HEADER_NEW 1
+#define VCL_CXX_HAS_HEADER_STACK 1
+#define VCL_CXX_HAS_HEADER_VALARRAY 1
+#define VCL_CXX_HAS_HEADER_FSTREAM 1
+#define VCL_CXX_HAS_HEADER_ITERATOR 1
+#define VCL_CXX_HAS_HEADER_NUMERIC 1
+#define VCL_CXX_HAS_HEADER_STDEXCEPT 1
+#define VCL_CXX_HAS_HEADER_VECTOR 1
+#define VCL_CXX_HAS_HEADER_FUNCTIONAL 1
+#define VCL_CXX_HAS_HEADER_LIMITS 1
+#define VCL_CXX_HAS_HEADER_STRSTREAM 1
+
+#define VCL_CXX_HAS_HEADER_ISO646_H 1
+
+//--------------------------------------------------------------------------------
+
+#endif // vcl_config_headers_h_config_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_manual.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_manual.h
new file mode 100644
index 0000000000000000000000000000000000000000..7700c5214d5b6d1854d373cde1644d6c683d0991
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vcl_config_manual.h
@@ -0,0 +1,14 @@
+#ifndef vcl_config_manual_h_config_win32_vc60_
+#define vcl_config_manual_h_config_win32_vc60_
+
+// This file is *not* generated. It must be consistent
+// with vcl_config_manual.h.in, though. See same file
+// for explanation of the meaning of these macros.
+
+#define VCL_USE_NATIVE_STL 1
+
+#define VCL_USE_NATIVE_COMPLEX 1
+
+#define VCL_USE_IMPLICIT_TEMPLATES 1
+
+#endif // vcl_config_manual_h_config_win32_vc60_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vxl_config.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vxl_config.h
new file mode 100644
index 0000000000000000000000000000000000000000..72616b722928b474120d6bac1aa49d448281423f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc60/vxl_config.h
@@ -0,0 +1,169 @@
+#ifndef vxl_config_h_config_win32_vc60_
+#define vxl_config_h_config_win32_vc60_
+
+/* This file was *not* generated from vxl_config.h.in */
+/* It is maintained manually. */
+
+/* -------------------- machine word characteristics */
+
+/* these are 0 or 1, never empty. */
+#define VXL_LITTLE_ENDIAN 1
+#define VXL_BIG_ENDIAN 0
+
+/* we can't just use typedefs, because on systems where there are */
+/* no 64bit integers we have to #define vxl_int_64 to `void' in */
+/* order to catch illegitimate uses. However, typedefs are superior */
+/* to #defines, especially for the two keyword types, so we use */
+/* typedefs for the valid cases. */
+
+#define VXL_HAS_BYTE 1
+#define VXL_BYTE_STRING "char"
+#if 1
+ typedef signed char vxl_sbyte;
+ typedef unsigned char vxl_byte;
+#else
+# define vxl_sbyte void
+# define vxl_byte void
+#endif
+
+#define VXL_HAS_INT_8 1
+#define VXL_INT_8_STRING "char"
+#if 1
+ typedef char vxl_int_8;
+ typedef signed char vxl_sint_8;
+ typedef unsigned char vxl_uint_8;
+#else
+# define vxl_int_8 void
+# define vxl_sint_8 void
+# define vxl_uint_8 void
+#endif
+
+#define VXL_HAS_INT_16 1
+#define VXL_INT_16_STRING "short"
+#if 1
+ typedef short vxl_int_16;
+ typedef signed short vxl_sint_16;
+ typedef unsigned short vxl_uint_16;
+#else
+# define vxl_int_16 void
+# define vxl_sint_16 void
+# define vxl_uint_16 void
+#endif
+
+#define VXL_HAS_INT_32 1
+#define VXL_INT_32_STRING "int"
+#if 1
+ typedef int vxl_int_32;
+ typedef signed int vxl_sint_32;
+ typedef unsigned int vxl_uint_32;
+#else
+# define vxl_int_32 void
+# define vxl_sint_32 void
+# define vxl_uint_32 void
+#endif
+
+#define VXL_HAS_INT_64 0
+/* !!! different from VC7 */
+#define VXL_INT_64_STRING "void"
+#if 0
+ typedef void vxl_int_64;
+ typedef signed void vxl_sint_64;
+ typedef unsigned void vxl_uint_64;
+#else
+# define vxl_int_64 void
+# define vxl_sint_64 void
+# define vxl_uint_64 void
+#endif
+
+#define VXL_INT_64_IS_LONG 0
+
+#define VXL_HAS_IEEE_32 1
+#define VXL_IEEE_32_STRING "float"
+#if 1
+ typedef float vxl_ieee_32;
+#else
+# define vxl_ieee_32 void
+#endif
+
+#define VXL_HAS_IEEE_64 1
+#define VXL_IEEE_64_STRING "double"
+#if 1
+ typedef double vxl_ieee_64;
+#else
+# define vxl_ieee_64 void
+#endif
+
+#define VXL_HAS_IEEE_96 0
+#define VXL_IEEE_96_STRING "void"
+#if 0
+ typedef void vxl_ieee_96;
+#else
+# define vxl_ieee_96 void
+#endif
+
+#define VXL_HAS_IEEE_128 0
+#define VXL_IEEE_128_STRING "void"
+#if 0
+ typedef void vxl_ieee_128;
+#else
+# define vxl_ieee_128 void
+#endif
+
+/* -------------------- operating system services */
+
+#define VXL_HAS_PTHREAD_H 0
+#define VXL_HAS_SEMAPHORE_H 0
+
+/* -------------------- library quirks */
+
+/* these should be 1 if the symbol in question is declared */
+/* in the relevant header file and 0 otherwise. */
+
+#define VXL_UNISTD_HAS_USECONDS_T 0
+#define VXL_UNISTD_HAS_INTPTR_T 0
+#define VXL_UNISTD_HAS_UALARM 1
+#define VXL_UNISTD_HAS_USLEEP 1
+#define VXL_UNISTD_HAS_LCHOWN 1
+#define VXL_UNISTD_HAS_PREAD 1
+#define VXL_UNISTD_HAS_PWRITE 1
+#define VXL_UNISTD_HAS_TELL 1
+
+/* true if <stdlib.h> declares qsort() */
+#define VXL_STDLIB_HAS_QSORT 1
+
+/* true if <stdlib.h> declares lrand48() */
+/* !!! different from VC7 */
+#define VXL_STDLIB_HAS_LRAND48 1 /* ? */
+
+/* true if <stdlib.h> declares drand48() */
+#define VXL_STDLIB_HAS_DRAND48 0
+
+/* true if <stdlib.h> declares srand48() */
+#define VXL_STDLIB_HAS_SRAND48 0
+
+/* true if <ieeefp.h> declares finite() */
+#define VXL_IEEEFP_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEF 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEL 0 /* ? */
+
+/* true if <math.h> declares sqrtf() for the C compiler */
+#define VXL_C_MATH_HAS_SQRTF 0 /* ? */
+
+/* true if usleep() returns void */
+#define VXL_UNISTD_USLEEP_IS_VOID 0
+
+/* true if gettime() takes two arguments */
+#define VXL_TWO_ARG_GETTIME 0
+
+/* true if <ieeefp.h> is available */
+/* !!! different from VC7 */
+#define VXL_HAS_IEEEFP_H 1
+
+#endif /* vxl_config_h_config_win32_vc60_ */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_compiler.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_compiler.h
new file mode 100644
index 0000000000000000000000000000000000000000..0a45efedfb984a8b24ac988e97303fec39a44fff
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_compiler.h
@@ -0,0 +1,634 @@
+#ifndef vcl_config_compiler_h_config_win32_vc70_
+#define vcl_config_compiler_h_config_win32_vc70_
+//:
+// \file
+// This file is *not* generated.
+
+//----------------------------------------------------------------------
+// syntax-like things.
+
+//: VCL_HAS_BOOL
+// Set to 1 if "bool" is accepted by the compiler as a built-in type.
+#define VCL_HAS_BOOL 1
+
+
+//: VCL_HAS_DYNAMIC_CAST
+//
+// True if the compiler supports dynamic cast.
+//
+#define VCL_HAS_DYNAMIC_CAST 1
+
+
+//: VCL_HAS_RTTI
+//
+// True if the compiler supports RTTI, viz the 'typeid' function.
+//
+#define VCL_HAS_RTTI 0
+
+
+//: VCL_HAS_TYPENAME
+//
+// True if the compiler supports the "typename" keyword
+//
+#define VCL_HAS_TYPENAME 1
+
+
+//: VCL_HAS_EXPORT
+//
+// True if the compiler supports the "export" keyword. FIXME.
+//
+#define VCL_HAS_EXPORT 0
+
+
+//: VCL_HAS_MUTABLE
+//
+// True if the compiler supports the "mutable" keyword
+//
+#define VCL_HAS_MUTABLE 1
+
+
+//: VCL_HAS_EXPLICIT
+//
+// True if the compiler supports the "explicit" keyword
+//
+#define VCL_HAS_EXPLICIT 1
+
+
+//: VCL_FOR_SCOPE_HACK:
+//
+// True if the compiler uses old-style 'for' loop scoping.
+// Setting this nonzero causes the Henderson trick to be used.
+#define VCL_FOR_SCOPE_HACK 1
+
+
+//: VCL_COMPLEX_POW_WORKS
+//
+// It appears several programmers have (independently)
+// not realised their lack of knowledge of complex numbers.
+// pow(complex(-1,0),0.5) should return (0,1) not (Nan,0), etc.
+#define VCL_COMPLEX_POW_WORKS 0
+
+
+//: VCL_DEFAULT_VALUE(x)
+//
+// Used to provide default values for function args in definition
+// Some compilers (GCC272) require defaults in template function definitions
+// Other compilers (VC50) disallow defaults in both decls and defs
+
+//#define VCL_DEFAULT_VALUE(x) /* no need */
+//#define VCL_DEFAULT_VALUE(x) = x
+#define VCL_DEFAULT_VALUE(x) /* no need */
+
+
+//----------------------------------------------------------------------
+// constant initializer issues.
+
+//: VCL_STATIC_CONST_INIT_INT_DECL(x)
+//
+// ANSI allows
+// \code
+// class A {
+// static const int x = 27;
+// };
+// \endcode
+// And there is a speed advantage, so we want to use it where supported.
+// However, the standard also requires (9.4.2/4) that the constant be
+// defined in namespace scope. (That is, space must be allocated.)
+// To make matters worse, some compilers (at least VC 7) mistakenly
+// allocate storage without the definition in namespace scope,
+// which results in multiply defined symbols.
+// To use the macro, use VCL_STATIC_CONST_INIT_INT_DECL in the class
+// definition (header file). This declares the constant.
+// \code
+// class A {
+// static const int x VCL_STATIC_CONST_INIT_INT_DECL(27);
+// };
+// \endcode
+// Use VCL_STATIC_CONST_INIT_INT_DEFN in some .cxx file to define
+// the constant, but only if VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// evaluates to false.
+// \code
+// #if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+// const int A::x VCL_STATIC_CONST_INIT_INT_DEFN(27);
+// #endif
+// \endcode
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_INT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_INT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_INT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_INT
+# define VCL_CAN_STATIC_CONST_INIT_INT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_INT
+# define VCL_STATIC_CONST_INIT_INT_DECL(x) = x
+# define VCL_STATIC_CONST_INIT_INT_DEFN(x) /* initialized at declaration */
+# define VCL_STATIC_CONST_INIT_INT_NO_DEFN 0
+#else
+# define VCL_STATIC_CONST_INIT_INT_DECL(x) /* not allowed */
+# define VCL_STATIC_CONST_INIT_INT_DEFN(x) = x
+# define VCL_STATIC_CONST_INIT_INT_NO_DEFN 0
+#endif
+
+
+//: VCL_STATIC_CONST_INIT_FLOAT(x)
+//
+// GCC allows the above, but with floating point types, ANSI doesn't.
+// Again, we'll use it if we've got it.
+//
+// In order to be able to query the setting of this, one actually must
+// define VCL_CAN_STATIC_CONST_INIT_FLOAT to either 0 or 1.
+
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 1 /* allowed */
+//#define VCL_CAN_STATIC_CONST_INIT_FLOAT 0 /* not allowed */
+#ifndef VCL_CAN_STATIC_CONST_INIT_FLOAT
+# define VCL_CAN_STATIC_CONST_INIT_FLOAT 0
+#endif
+#if VCL_CAN_STATIC_CONST_INIT_FLOAT
+# define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) = x
+# define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) /* initialized at declaration */
+# define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#else
+# define VCL_STATIC_CONST_INIT_FLOAT_DECL(x) /* not allowed */
+# define VCL_STATIC_CONST_INIT_FLOAT_DEFN(x) = x
+# define VCL_STATIC_CONST_INIT_FLOAT_NO_DEFN 0
+#endif
+
+
+//----------------------------------------------------------------------
+// various template issues.
+
+//: VCL_HAS_MEMBER_TEMPLATES
+//
+// True if the compiler supports template members of template classes. e.g.
+// \code
+// template <class U> class A {
+// template <class V> void f(V);
+// }
+// \endcode
+#define VCL_HAS_MEMBER_TEMPLATES 1
+
+
+//: VCL_CAN_DO_PARTIAL_SPECIALIZATION
+//
+// True if the compiler supports partial specializations of templates. e.g.
+// \code
+// template <class T>
+// class vector<T*> : public vector<void *> { .. inline methods .. };
+// \endcode
+//
+#define VCL_CAN_DO_PARTIAL_SPECIALIZATION 0
+
+
+//: VCL_DEFINE_SPECIALIZATION
+//
+// In order to *define* a template (function or class) specialization, the
+// definition must be preceded by "template <>" on ISO-conforming compilers.
+// Some compilers (eg gcc 2.7.2) make no distinction between an instance
+// of a templated function and a function with the same name and signature,
+// and so do not support the use of "template <>". Use VCL_DEFINE_SPECIALIZATION
+// instead.
+//
+// Note that you DO NOT need to forward declare a specialization. E.g. if
+// foo.h says "template <class T> void foo(T *);" and foo.cxx specializes
+// void foo<int>(int *), the client doesn't need to know that the template
+// symbol he links against is a specialization.
+
+//#define VCL_DEFINE_SPECIALIZATION /* template <> */
+//#define VCL_DEFINE_SPECIALIZATION template <>
+// !!! different from VC6
+#define VCL_DEFINE_SPECIALIZATION template <>
+
+
+//: VCL_CANNOT_SPECIALIZE_CV
+//
+// Template specialization considers top-level cv-qualifiers of the
+// argument type. For example, A<int> and A<int const> are distinct
+// types. Some compilers (eg Borland 5.5) do not make this distinction.
+// Specializations using top-level cv-qualifiers should not be defined
+// in addition to the unqualified equivalents unless
+// VCL_CANNOT_SPECIALIZE_CV is false.
+//#define VCL_CANNOT_SPECIALIZE_CV 1 /* cannot specialize with cv-qualifiers */
+//#define VCL_CANNOT_SPECIALIZE_CV 0 /* can specialize with cv-qualifiers */
+#define VCL_CANNOT_SPECIALIZE_CV 0
+
+
+//: VCL_TEMPLATE_MATCHES_TOO_OFTEN
+//
+// A function template is selected by overload resolution only if no
+// non-template requires equal or better conversions. Some compilers
+// (eg MSVC 6.x and 7.0, Borland 5.5 and 5.6) select the template
+// incorrectly in a case like this:
+// \code
+// class A {};
+// template <class T> void f(T);
+// void f(const A&);
+// void g() { f(A()); } // should call non-template
+// \endcode
+//
+// The work-around is to explicitly give the template a worse
+// conversion than the non-templated overloads:
+// \code
+// class A {};
+// template <class T> inline void f(T t) { f(t, 1); }
+// template <class T> void f(T t, long);
+// void f(const A&, int);
+// void g() { f(A()); } // will call non-template
+// \endcode
+// In this example, the inline one-argument template will always be
+// called, which will call the real function with an "int" passed to
+// the second argument. The templated two-argument function has a
+// "long" second argument while the others have "int". Therefore, the
+// template will be chosen only if no non-templates match.
+//
+// The VCL_TEMPLATE_MATCHES_TOO_OFTEN macro is set to 1
+// if this work-around is required and 0 otherwise.
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1 /* need work-around */
+//#define VCL_TEMPLATE_MATCHES_TOO_OFTEN 0 /* do not need it */
+#ifdef VCL_VC71 // If C++.NET 2003 Version 7.1
+# define VCL_TEMPLATE_MATCHES_TOO_OFTEN 0
+#else
+# define VCL_TEMPLATE_MATCHES_TOO_OFTEN 1
+#endif
+
+
+//: VCL_HAS_SLICED_DESTRUCTOR_BUG
+//
+// Consider this example code that creates a temporary in the call to f:
+// \code
+// struct A { A(); A(const A&); ~A(); };
+// struct B: public A { B(); B(const B& b); ~B(); };
+// struct C { operator B(); };
+// void f(A);
+// void g(C c) { f(c); } // fails to call ~B() on 2nd temporary B
+// \endcode
+// Compilers will call c.operator B() to implement the conversion
+// necessary to call f(c). Some compilers will then create a
+// temporary A by copy-constructing the temporary B to bind the
+// argument of f. Others will create a second temporary B by
+// copy-constructing the first temporary B and bind the A-portion of
+// the object to the argument of f. Some compilers (at least Intel
+// C++ 7.0 and 7.1) will create a second temporary B but forget to
+// call ~B() when destroying it. This can cause resource leaks.
+//
+// The VCL_HAS_SLICED_DESTRUCTOR_BUG is set to 1 if this bug exists in
+// the compiler and 0 otherwise.
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 1 /* bug exists */
+//#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0 /* bug does not exist */
+#define VCL_HAS_SLICED_DESTRUCTOR_BUG 0
+
+
+//: VCL_NULL_TMPL_ARGS
+//
+// Define to <> for compilers that require them in friend template function
+// declarations (i.e., EGCS, VC C++.NET 2003).
+
+#ifdef VCL_VC71 // If C++.NET 2003 Version 7.1
+# define VCL_NULL_TMPL_ARGS <>
+#else
+# define VCL_NULL_TMPL_ARGS /* <> */
+#endif
+
+
+//----------------------------------------------------------------------
+// template instantiation
+
+//: VCL_ALLOWS_INLINE_INSTANTIATION
+//
+// True if the compiler allows explicit instantiation of inline
+// function templates. The native SGI CC 7.2.1 does not.
+#define VCL_ALLOWS_INLINE_INSTANTIATION 1
+
+
+//: VCL_NEEDS_INLINE_INSTANTIATION
+//
+// True if the compiler needs explicit instantiation of inline
+// function templates. gcc 2.7.2 (with -fno-implicit-templates) does.
+#define VCL_NEEDS_INLINE_INSTANTIATION 0
+
+
+//: VCL_DO_NOT_INSTANTIATE(text, ret)
+//
+// If a method is defined on some template, but makes no sense for some
+// instances of that template, the compiler should not complain unless the
+// method is actually used. For example
+// \code
+// template <class T>
+// class T {
+// int bad_method() {
+// return T::f(); // Requires T to have static method f
+// }
+// };
+// \endcode
+//
+// The language allows you to use a T<int> even though int::f() is garbage,
+// *providing* you never call T.bad_method().
+//
+// Most compilers don't implement that yet, so the solution is to provide a
+// dummy specialization of T::bad_method that returns something mundane and
+// stops the standard bad_method from being generated. For this, use:
+// \code
+// VCL_DO_NOT_INSTANTIATE(int T::bad_method(), some_return_value)
+// \endcode
+// if the function is void, use VCL_VOID_RETURN as the return value
+
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) template <> text { return ret; }
+//#define VCL_DO_NOT_INSTANTIATE(text, ret) /* no need -- magic compiler */
+//FIXME #define VCL_DO_NOT_INSTANTIATE(text, ret)
+#define VCL_DO_NOT_INSTANTIATE(text, ret) \
+VCL_DEFINE_SPECIALIZATION \
+text { return ret; }
+
+
+//: VCL_UNINSTANTIATE_SPECIALIZATION(symbol)
+//
+// OK, various compilers do various silly things about instantiation of
+// functions/methods that have been specialized. Use this macro to tell
+// the compiler not to generate code for methods which have been specialized
+// \code
+// VCL_UNINSTANTIATE_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed after the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) @pragma do_not_instantiate text@
+//#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) /* no need - sensible compiler */
+//FIXME #define VCL_UNINSTANTIATE_SPECIALIZATION(symbol)
+#define VCL_UNINSTANTIATE_SPECIALIZATION(symbol) // which compiler needs this ?
+
+
+//: VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol)
+//
+// gcc is sensible about specializations if it has seen the definition,
+// but if it's in another file, need to use extern to tell it.
+// \code
+// VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(int T::specialized_method())
+// \endcode
+// It should be placed before the "template class A<T>;"
+
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) extern symbol;
+//#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* no need */
+//FIXME #define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol)
+#define VCL_UNINSTANTIATE_UNSEEN_SPECIALIZATION(symbol) /* never used */
+
+
+//: VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol)
+//
+// Some compilers (e.g. gcc 2.7.2) do not accept a templated definition
+// of static members, as in
+// \code
+// template <class T>
+// struct A {
+// A() { }
+// static char *fmt;
+// };
+//
+// template <class T>
+// char *A<T>::fmt = 0;
+//
+// template struct A<int>;
+// \endcode
+// The way round this is to supply an explicit definition for every
+// instance of the class needed.
+//
+// Put the templated definition like this
+// \code
+// #if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+// template <class T>
+// char *A<T>::fmt = 0;
+// #endif
+// \endcode
+// and place
+// \code
+// VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(int A<int>::fmt = 0)
+// \endcode
+// before the
+// \code
+// template class A<int>;
+// \endcode
+// with
+// \code
+// VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(A<int>::var)
+// \endcode
+// afterwards.
+
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* no need */
+//#define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+//
+#define VCL_CAN_DO_STATIC_TEMPLATE_MEMBER 1
+#if VCL_CAN_DO_STATIC_TEMPLATE_MEMBER
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) /* */
+#else
+# define VCL_INSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) symbol;
+# define VCL_UNINSTANTIATE_STATIC_TEMPLATE_MEMBER(symbol) // which compiler needs this ?
+#endif
+
+
+//: VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER
+//
+// Some compilers (e.g. SunPro 5.0) do not accept non-type template
+// parameters in function templates. E.g.
+// \code
+// template <class T, int n> struct vicky { T data[n]; } // can do
+//
+// template <class T, int n>
+// void a_function_template(vicky<T, n> const &) { ... } // cannot
+// \endcode
+#define VCL_CAN_DO_NON_TYPE_FUNCTION_TEMPLATE_PARAMETER 1
+
+
+//----------------------------------------------------------------------
+// overload resolution problems.
+
+//: VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD
+//
+// On some compilers (in particular gcc 2.7.2.3), the compiler doesn't
+// know how to cast a templated derived class to a templated base class
+// (eg. vnl_matrix_fixed<3,3,double> -> vnl_matrix<double>) when doing overload
+// resolution. Making the overloaded function a friend of the class makes
+// the problem go away.
+//
+// True if the compiler needs this hack.
+
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+//#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 1
+#define VCL_NEED_FRIEND_FOR_TEMPLATE_OVERLOAD 0
+
+
+//: VCL_OVERLOAD_CAST
+//
+// Some compilers (gcc 2.7.2.3 and SGI native 6.0) often won't perform
+// certain implicit casts. E.g. casting a templated derived class to a
+// templated base class (see above), or even realizing that
+// "template void foo(float const * const *, float * const *, int, int)"
+// can be called with parameters of type "(float **, float **, int, int)".
+//
+// To fix the code, it is tempting to add an explicit cast and get on
+// with things, but that would throw away the checking performed by more
+// helpful compilers. Use VCL_OVERLOAD_CAST instead.
+
+//#define VCL_OVERLOAD_CAST(T, x) ((T)(x))
+//#define VCL_OVERLOAD_CAST(T, x) (x)
+#define VCL_OVERLOAD_CAST(T, x) (x)
+
+
+//----------------------------------------------------------------------
+// stuff
+
+
+//: VCL_NO_STATIC_DATA_MEMBERS
+//
+// True if compiler does not support static data members in template classes.
+//
+#define VCL_NO_STATIC_DATA_MEMBERS 0
+
+
+//: VCL_HAS_TEMPLATE_SYMBOLS
+//
+// True if the compiler mangles function template instances differently
+// from non-templated functions with the same name and signature.
+// This is correct behaviour.
+//
+#define VCL_HAS_TEMPLATE_SYMBOLS 0
+
+
+//----------------------------------------------------------------------
+// default template arguments
+
+//: VCL_DEFAULT_TMPL_ARG(arg)
+//
+// It is wrong to provide a default for a template parameter in two
+// declarations in the same scope (14.1.12), e.g.
+// \code
+// template <class S, class T = int> class X;
+// template <class S, class T = int> class X { /* ... */ };
+// \endcode
+// is wrong.
+// However, some older compilers insist on seeing the default argument
+// again when defining a class body or instantiating.
+// To satisfy them, use this macro as follows :
+// \code
+// template <class S, class T VCL_DEFAULT_TMPL_ARG(= int)> X { /* ... */ };
+// template X<double VCL_DEFAULT_TMPL_ARG(, int)>;
+// \endcode
+//
+// It's possible we need two macros, one for redeclaration and
+// one for instantiation.
+
+//#define VCL_DEFAULT_TMPL_ARG(arg) /* no need */
+//#define VCL_DEFAULT_TMPL_ARG(arg) arg
+#define VCL_DEFAULT_TMPL_ARG(arg)
+
+//
+#define VCL_CAN_DO_COMPLETE_DEFAULT_TYPE_PARAMETER 1
+#define VCL_CAN_DO_TEMPLATE_DEFAULT_TYPE_PARAMETER 1
+
+// VCL_DFL_TYPE_PARAM_STLDECL(A, a) and VCL_DFL_TMPL_PARAM_STLDECL(A, a)
+// EGCS doesn't like definition of default types, viz:
+// \code
+// template <class A = default> class vector;
+// template <class A = default> class vector { ... };
+// \endcode
+// This macro is used to say "define if not previously defined, like
+// \code
+// template <VCL_DFL_TYPE_PARAM_STLDECL(A,a)> class vector { ... };
+// \endcode
+
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TYPE_PARAM_STLDECL(A,a) __DFL_TYPE_PARAM(A,a)
+//FIXME #define VCL_DFL_TYPE_PARAM_STLDECL(A,a)
+//
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A = a
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) A /* = a */
+//#define VCL_DFL_TMPL_PARAM_STLDECL(A,a) __STL_DFL_TMPL_PARAM(A,a)
+//FIXME #define VCL_DFL_TMPL_PARAM_STLDECL(A,a)
+
+
+// VCL_DFL_TMPL_ARG(class)
+// Similarly, when instantiating a templated class with a default
+// template argument, some compilers don't like the redeclaration of
+// that argument, while others insist on it.
+// In such cases, specify the default argument as follows:
+// \code
+// template class vector <int VCL_DFL_TMPL_ARG(default_iterator) >;
+// \endcode
+// (Note the missing comma after int: it is inside the macro.)
+
+//#define VCL_DFL_TMPL_ARG(classname) , classname
+//#define VCL_DFL_TMPL_ARG(classname) /* , classname */
+//#define VCL_DFL_TMPL_ARG(classname) __DFL_TMPL_ARG(classname)
+//FIXME #define VCL_DFL_TMPL_ARG(classname)
+
+
+//: VCL_SUNPRO_CLASS_SCOPE_HACK(A)
+//
+// Nice one. Can't use std::vector<T> in a class on SunPro 5, must use
+// std::vector<T, std::allocator<T> >. Of course, we cannot expect that other
+// compilers call the default allocator std::allocator<T>, so we must use
+// a macro. I could call it something generic, like
+// VCL_CLASS_SCOPE_HACK, but to be honest, it's a sunpro problem,
+// they deserve the blame.
+// Usage (the comma is inside the macro) :
+// \code
+// vector<T VCL_SUNPRO_CLASS_SCOPE_HACK(std::allocator<T >)>
+// \endcode
+
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+//#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) , A
+#define VCL_SUNPRO_CLASS_SCOPE_HACK(A) /* , A */
+
+
+//----------------------------------------------------------------------
+// exception and namespace issues
+
+
+//: VCL_HAS_EXCEPTIONS
+// Set to true if the compiler supports the use of exceptions.
+#define VCL_HAS_EXCEPTIONS 1
+
+
+//: VCL_HAS_NAMESPACES
+// Set to true if the compiler supports the use of namespaces.
+#define VCL_HAS_NAMESPACES 1
+
+
+//: VCL_ALLOWS_NAMESPACE_STD
+// Set to true if the compiler allows namespace std:: for the standard library.
+// !!! different from VC6
+#define VCL_ALLOWS_NAMESPACE_STD 1
+
+
+//: VCL_NEEDS_NAMESPACE_STD
+// Set to true if the compiler needs namespace std:: for the standard library.
+// !!! different from VC6
+#define VCL_NEEDS_NAMESPACE_STD 1
+
+
+//----------------------------------------------------------------------
+// infinity issues
+
+//: VCL_NUMERIC_LIMITS_HAS_INFINITY
+// Set to true if there is a numeric_limits and it reports having an floating point infinity.
+#define VCL_NUMERIC_LIMITS_HAS_INFINITY 1
+
+//: VCL_PROCESSOR_HAS_INFINITY
+// Set to true if the processor really does have an infinity.
+// Although this is strictly not a C++ issue, some platforms' versions of
+// numeric_limits<double> imply that there is no infinity, when there is.
+#define VCL_PROCESSOR_HAS_INFINITY 1
+
+//----------------------------------------------------------------------
+// signedness of char
+
+//: VCL_CHAR_IS_SIGNED
+// Set to true if the type "char" is signed.
+#define VCL_CHAR_IS_SIGNED 1
+
+//----------------------------------------------------------------------
+
+// architecture macros removed -- they're not in the C++ standard
+
+#endif // vcl_config_compiler_h_config_win32_vc70_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_headers.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_headers.h
new file mode 100644
index 0000000000000000000000000000000000000000..5027d7976e8e64c6be999f94c1bd0a3181c1f999
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_headers.h
@@ -0,0 +1,65 @@
+#ifndef vcl_config_headers_h_config_win32_vc70_
+#define vcl_config_headers_h_config_win32_vc70_
+
+// This file is *not* generated.
+
+//--------------------------------------------------------------------------------
+
+// standard header files.
+#define VCL_CXX_HAS_HEADER_CASSERT 1
+#define VCL_CXX_HAS_HEADER_CISO646 1
+#define VCL_CXX_HAS_HEADER_CSETJMP 1
+#define VCL_CXX_HAS_HEADER_CSTDIO 1
+#define VCL_CXX_HAS_HEADER_CTIME 1
+#define VCL_CXX_HAS_HEADER_CCTYPE 1
+#define VCL_CXX_HAS_HEADER_CLIMITS 1
+#define VCL_CXX_HAS_HEADER_CSIGNAL 1
+#define VCL_CXX_HAS_HEADER_CSTDLIB 1
+#define VCL_CXX_HAS_HEADER_CWCHAR 1
+#define VCL_CXX_HAS_HEADER_CERRNO 1
+#define VCL_CXX_HAS_HEADER_CLOCALE 1
+#define VCL_CXX_HAS_HEADER_CSTDARG 1
+#define VCL_CXX_HAS_HEADER_CSTRING 1
+#define VCL_CXX_HAS_HEADER_CWCTYPE 1
+#define VCL_CXX_HAS_HEADER_CFLOAT 1
+#define VCL_CXX_HAS_HEADER_CMATH 1
+#define VCL_CXX_HAS_HEADER_CSTDDEF 1
+#define VCL_CXX_HAS_HEADER_ALGORITHM 1
+#define VCL_CXX_HAS_HEADER_IOMANIP 1
+#define VCL_CXX_HAS_HEADER_LIST 1
+#define VCL_CXX_HAS_HEADER_OSTREAM 1
+#define VCL_CXX_HAS_HEADER_STREAMBUF 1
+#define VCL_CXX_HAS_HEADER_BITSET 1
+#define VCL_CXX_HAS_HEADER_IOS 1
+#define VCL_CXX_HAS_HEADER_LOCALE 1
+#define VCL_CXX_HAS_HEADER_QUEUE 1
+#define VCL_CXX_HAS_HEADER_STRING 1
+#define VCL_CXX_HAS_HEADER_COMPLEX 1
+#define VCL_CXX_HAS_HEADER_IOSFWD 1
+#define VCL_CXX_HAS_HEADER_MAP 1
+#define VCL_CXX_HAS_HEADER_SET 1
+#define VCL_CXX_HAS_HEADER_TYPEINFO 1
+#define VCL_CXX_HAS_HEADER_DEQUE 1
+#define VCL_CXX_HAS_HEADER_IOSTREAM 1
+#define VCL_CXX_HAS_HEADER_MEMORY 1
+#define VCL_CXX_HAS_HEADER_SSTREAM 1
+#define VCL_CXX_HAS_HEADER_UTILITY 1
+#define VCL_CXX_HAS_HEADER_EXCEPTION 1
+#define VCL_CXX_HAS_HEADER_ISTREAM 1
+#define VCL_CXX_HAS_HEADER_NEW 1
+#define VCL_CXX_HAS_HEADER_STACK 1
+#define VCL_CXX_HAS_HEADER_VALARRAY 1
+#define VCL_CXX_HAS_HEADER_FSTREAM 1
+#define VCL_CXX_HAS_HEADER_ITERATOR 1
+#define VCL_CXX_HAS_HEADER_NUMERIC 1
+#define VCL_CXX_HAS_HEADER_STDEXCEPT 1
+#define VCL_CXX_HAS_HEADER_VECTOR 1
+#define VCL_CXX_HAS_HEADER_FUNCTIONAL 1
+#define VCL_CXX_HAS_HEADER_LIMITS 1
+#define VCL_CXX_HAS_HEADER_STRSTREAM 1
+
+#define VCL_CXX_HAS_HEADER_ISO646_H 1
+
+//--------------------------------------------------------------------------------
+
+#endif // vcl_config_headers_h_config_win32_vc70_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_manual.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_manual.h
new file mode 100644
index 0000000000000000000000000000000000000000..e3666db195b817bb15a035c3a807927d693d2082
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vcl_config_manual.h
@@ -0,0 +1,14 @@
+#ifndef vcl_config_manual_h_config_win32_vc70_
+#define vcl_config_manual_h_config_win32_vc70_
+
+// This file is *not* generated. It must be consistent
+// with vcl_config_manual.h.in, though. See same file
+// for explanation of the meaning of these macros.
+
+#define VCL_USE_NATIVE_STL 1
+
+#define VCL_USE_NATIVE_COMPLEX 1
+
+#define VCL_USE_IMPLICIT_TEMPLATES 1
+
+#endif // vcl_config_manual_h_config_win32_vc70_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vxl_config.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vxl_config.h
new file mode 100644
index 0000000000000000000000000000000000000000..23988598ce1f0d7f1237b5c7ef04d99cc9de62b1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vc70/vxl_config.h
@@ -0,0 +1,169 @@
+#ifndef vxl_config_h_config_win32_vc70_
+#define vxl_config_h_config_win32_vc70_
+
+/* This file was *not* generated from vxl_config.h.in */
+/* It is maintained manually. */
+
+/* -------------------- machine word characteristics */
+
+/* these are 0 or 1, never empty. */
+#define VXL_LITTLE_ENDIAN 1
+#define VXL_BIG_ENDIAN 0
+
+/* we can't just use typedefs, because on systems where there are */
+/* no 64bit integers we have to #define vxl_int_64 to `void' in */
+/* order to catch illegitimate uses. However, typedefs are superior */
+/* to #defines, especially for the two keyword types, so we use */
+/* typedefs for the valid cases. */
+
+#define VXL_HAS_BYTE 1
+#define VXL_BYTE_STRING "char"
+#if 1
+ typedef signed char vxl_sbyte;
+ typedef unsigned char vxl_byte;
+#else
+# define vxl_sbyte void
+# define vxl_byte void
+#endif
+
+#define VXL_HAS_INT_8 1
+#define VXL_INT_8_STRING "char"
+#if 1
+ typedef char vxl_int_8;
+ typedef signed char vxl_sint_8;
+ typedef unsigned char vxl_uint_8;
+#else
+# define vxl_int_8 void
+# define vxl_sint_8 void
+# define vxl_uint_8 void
+#endif
+
+#define VXL_HAS_INT_16 1
+#define VXL_INT_16_STRING "short"
+#if 1
+ typedef short vxl_int_16;
+ typedef signed short vxl_sint_16;
+ typedef unsigned short vxl_uint_16;
+#else
+# define vxl_int_16 void
+# define vxl_sint_16 void
+# define vxl_uint_16 void
+#endif
+
+#define VXL_HAS_INT_32 1
+#define VXL_INT_32_STRING "int"
+#if 1
+ typedef int vxl_int_32;
+ typedef signed int vxl_sint_32;
+ typedef unsigned int vxl_uint_32;
+#else
+# define vxl_int_32 void
+# define vxl_sint_32 void
+# define vxl_uint_32 void
+#endif
+
+#define VXL_HAS_INT_64 1
+/* !!! different from VC6 */
+#define VXL_INT_64_STRING "__int64"
+#if 1
+ typedef __int64 vxl_int_64;
+ typedef __int64 vxl_sint_64;
+ typedef unsigned __int64 vxl_uint_64;
+#else
+# define vxl_int_64 void
+# define vxl_sint_64 void
+# define vxl_uint_64 void
+#endif
+
+#define VXL_INT_64_IS_LONG 0
+
+#define VXL_HAS_IEEE_32 1
+#define VXL_IEEE_32_STRING "float"
+#if 1
+ typedef float vxl_ieee_32;
+#else
+# define vxl_ieee_32 void
+#endif
+
+#define VXL_HAS_IEEE_64 1
+#define VXL_IEEE_64_STRING "double"
+#if 1
+ typedef double vxl_ieee_64;
+#else
+# define vxl_ieee_64 void
+#endif
+
+#define VXL_HAS_IEEE_96 0
+#define VXL_IEEE_96_STRING "void"
+#if 0
+ typedef void vxl_ieee_96;
+#else
+# define vxl_ieee_96 void
+#endif
+
+#define VXL_HAS_IEEE_128 0
+#define VXL_IEEE_128_STRING "void"
+#if 0
+ typedef void vxl_ieee_128;
+#else
+# define vxl_ieee_128 void
+#endif
+
+/* -------------------- operating system services */
+
+#define VXL_HAS_PTHREAD_H 0
+#define VXL_HAS_SEMAPHORE_H 0
+
+/* -------------------- library quirks */
+
+/* these should be 1 if the symbol in question is declared */
+/* in the relevant header file and 0 otherwise. */
+
+#define VXL_UNISTD_HAS_USECONDS_T 0
+#define VXL_UNISTD_HAS_INTPTR_T 0
+#define VXL_UNISTD_HAS_UALARM 1
+#define VXL_UNISTD_HAS_USLEEP 1
+#define VXL_UNISTD_HAS_LCHOWN 1
+#define VXL_UNISTD_HAS_PREAD 1
+#define VXL_UNISTD_HAS_PWRITE 1
+#define VXL_UNISTD_HAS_TELL 1
+
+/* true if <stdlib.h> declares qsort() */
+#define VXL_STDLIB_HAS_QSORT 1
+
+/* true if <stdlib.h> declares lrand48() */
+/* !!! different from VC6 */
+#define VXL_STDLIB_HAS_LRAND48 0
+
+/* true if <stdlib.h> declares drand48() */
+#define VXL_STDLIB_HAS_DRAND48 0
+
+/* true if <stdlib.h> declares srand48() */
+#define VXL_STDLIB_HAS_SRAND48 0
+
+/* true if <ieeefp.h> declares finite() */
+#define VXL_IEEEFP_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEF 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITE 0 /* ? */
+
+/* true if <math.h> declares finite() */
+#define VXL_C_MATH_HAS_FINITEL 0 /* ? */
+
+/* true if <math.h> declares sqrtf() for the C compiler */
+#define VXL_C_MATH_HAS_SQRTF 0 /* ? */
+
+/* true if usleep() returns void */
+#define VXL_UNISTD_USLEEP_IS_VOID 0
+
+/* true if gettime() takes two arguments */
+#define VXL_TWO_ARG_GETTIME 0
+
+/* true if <ieeefp.h> is available */
+/* !!! different from VC6 */
+#define VXL_HAS_IEEEFP_H 0
+
+#endif /* vxl_config_h_config_win32_vc70_ */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_compiler.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_compiler.h
new file mode 100644
index 0000000000000000000000000000000000000000..4a7b9b76a7464c35ab01aefe2f37753793fe898a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_compiler.h
@@ -0,0 +1,18 @@
+#ifndef vcl_config_compiler_h_config_win32_
+#define vcl_config_compiler_h_config_win32_
+//:
+// \file
+// This file is *not* generated.
+
+#ifndef _MSC_VER
+ ** error **
+#else
+# if _MSC_VER >=1300
+# include "vc70/vcl_config_compiler.h"
+# else //_MSC_VER >=1200
+# include "vc60/vcl_config_compiler.h"
+# endif
+#endif
+
+
+#endif // vcl_config_compiler_h_config_win32_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_headers.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_headers.h
new file mode 100644
index 0000000000000000000000000000000000000000..bbf2f12a5cd48bed11da671d5da5ca082fb73a35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_headers.h
@@ -0,0 +1,16 @@
+#ifndef vcl_config_headers_h_config_win32_
+#define vcl_config_headers_h_config_win32_
+
+// This file is *not* generated.
+
+#ifndef _MSC_VER
+ ** error **
+#else
+# if _MSC_VER >=1300
+# include "vc70/vcl_config_headers.h"
+# else //_MSC_VER >=1200
+# include "vc60/vcl_config_headers.h"
+# endif
+#endif
+
+#endif // vcl_config_headers_h_config_win32_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_manual.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_manual.h
new file mode 100644
index 0000000000000000000000000000000000000000..5c8688deb4a5d7ca573bd23c1086bbd34b3aa4dd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vcl_config_manual.h
@@ -0,0 +1,18 @@
+#ifndef vcl_config_manual_h_config_win32_
+#define vcl_config_manual_h_config_win32_
+
+// This file is *not* generated. It must be consistent
+// with vcl_config_manual.h.in, though. See same file
+// for explanation of the meaning of these macros.
+
+#ifndef _MSC_VER
+ ** error **
+#else
+# if _MSC_VER >=1300
+# include "vc70/vcl_config_manual.h"
+# else //_MSC_VER >=1200
+# include "vc60/vcl_config_manual.h"
+# endif
+#endif
+
+#endif // vcl_config_manual_h_config_win32_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/config.win32/vxl_config.h b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vxl_config.h
new file mode 100644
index 0000000000000000000000000000000000000000..6d1bca61bb712f368b71e7a79da2a7c17c81cd4f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/config.win32/vxl_config.h
@@ -0,0 +1,17 @@
+#ifndef vxl_config_h_config_win32_
+#define vxl_config_h_config_win32_
+
+/* This file was *not* generated from vxl_config.h.in */
+/* It is maintained manually. */
+
+#ifndef _MSC_VER
+ ** error **
+#else
+# if _MSC_VER >=1300
+# include "vc70/vxl_config.h"
+# else //_MSC_VER >=1200
+# include "vc60/vxl_config.h"
+# endif
+#endif
+
+#endif /* vxl_config_h_config_win32_ */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/doc/algorithm.txt b/Utilities/ITK/Utilities/vxl/vcl/doc/algorithm.txt
new file mode 100644
index 0000000000000000000000000000000000000000..b989c94f9c68616412aefcd14ea7fb1d7c89dc55
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/doc/algorithm.txt
@@ -0,0 +1,233 @@
+// -*- c++ -*-
+// From CD2, Dec 96
+
+#define VCL_SWAP_INSTANTIATE(T)
+#define VCL_OPERATOR_NE_INSTANTIATE(T)
+#define VCL_CONTAINABLE_INSTANTIATE(T)
+#define VCL_FIND_INSTANTIATE(I, T)
+#define VCL_FIND_IF_INSTANTIATE(I, T)
+#define VCL_SORT_INSTANTIATE(I)
+#define VCL_COPY_INSTANTIATE(Inp, Out)
+#define VCL_COPY_BACKWARD_INSTANTIATE(Inp, Out)
+
+Header <algorithm> synopsis
+
+// Fwd: forward iterator
+// Inp: input iterator
+
+// subclause _lib.alg.nonmodifying_, non-modifying sequence operations:
+template<class InputIterator, class Function, class T, class Predicate>
+
+Function for_each(Inp first, Inp last, Function f);
+Inp find(Inp first, Inp last, const T& value);
+Inp find_if(Inp first, Inp last, Predicate pred);
+Fwd1 find_end(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2);
+Fwd1 find_end(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2, BinaryPredicate pred);
+Fwd1 find_first_of(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2);
+Fwd1 find_first_of(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2, BinaryPredicate pred);
+Fwd adjacent_find(Fwd first, Fwd last);
+Fwd adjacent_find(Fwd first, Fwd last, BinaryPredicate pred);
+
+difference_type count(Inp first, Inp last, const T& value);
+difference_type count_if(Inp first, Inp last, Predicate pred);
+pair<Inp1, Inp2> mismatch(Inp1 first1, Inp1 last1, Inp2 first2);
+pair<Inp1, Inp2> mismatch(Inp1 first1, Inp1 last1, Inp2 first2, BinaryPredicate pred);
+bool equal(Inp1 first1, Inp1 last1, Inp2 first2);
+bool equal(Inp1 first1, Inp1 last1, Inp2 first2, BinaryPredicate pred);
+
+Fwd1 search(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2);
+Fwd1 search(Fwd1 first1, Fwd1 last1, Fwd2 first2, Fwd2 last2, BinaryPredicate pred);
+Fwd search_n(Fwd first, Fwd last, Size count, const T& value);
+Fwd1 search_n(Fwd first, Fwd last, Size count, const T& value, BinaryPredicate pred);
+
+// subclause _lib.alg.modifying.operations_, modifying sequence operations:
+// _lib.alg.copy_, copy:
+template<class Inp, class OutputIterator>
+OutputIterator copy(Inp first, Inp last, OutputIterator result);
+template<class BidirectionalIterator1, class BidirectionalIterator2>
+BidirectionalIterator2
+copy_backward(BidirectionalIterator1 first, BidirectionalIterator1 last, BidirectionalIterator2 result);
+// _lib.alg.swap_, swap:
+template<class T> void swap(T& a, T& b);
+template<class Fwd1, class Fwd2>
+Fwd2 swap_ranges(Fwd1 first1, Fwd1 last1, Fwd2 first2);
+template<class Fwd1, class Fwd2>
+void iter_swap(Fwd1 a, Fwd2 b);
+template<class Inp, class OutputIterator, class UnaryOperation>
+OutputIterator transform(Inp first, Inp last, OutputIterator result, UnaryOperation op);
+template<class Inp1, class Inp2, class OutputIterator, class BinaryOperation>
+OutputIterator transform(Inp1 first1, Inp1 last1, Inp2 first2, OutputIterator result, BinaryOperation binary_op);
+template<class Fwd, class T>
+void replace(Fwd first, Fwd last, const T& old_value, const T& new_value);
+template<class Fwd, class Predicate, class T>
+void replace_if(Fwd first, Fwd last, Predicate pred, const T& new_value);
+template<class Inp, class OutputIterator, class T>
+OutputIterator replace_copy(Inp first, Inp last, OutputIterator result, const T& old_value, const T& new_value);
+template<class Iterator, class OutputIterator, class Predicate, class T>
+OutputIterator replace_copy_if(Iterator first, Iterator last, OutputIterator result, Predicate pred, const T& new_value);
+
+template<class Fwd, class T>
+void fill(Fwd first, Fwd last, const T& value);
+template<class OutputIterator, class Size, class T>
+void fill_n(OutputIterator first, Size n, const T& value);
+template<class Fwd, class Generator>
+void generate(Fwd first, Fwd last, Generator gen);
+template<class OutputIterator, class Size, class Generator>
+void generate_n(OutputIterator first, Size n, Generator gen);
+template<class Fwd, class T>
+Fwd remove(Fwd first, Fwd last, const T& value);
+template<class Fwd, class Predicate>
+Fwd remove_if(Fwd first, Fwd last, Predicate pred);
+template<class Inp, class OutputIterator, class T>
+OutputIterator remove_copy(Inp first, Inp last, OutputIterator result, const T& value);
+template<class Inp, class OutputIterator, class Predicate>
+OutputIterator remove_copy_if(Inp first, Inp last, OutputIterator result, Predicate pred);
+template<class Fwd>
+Fwd unique(Fwd first, Fwd last);
+template<class Fwd, class BinaryPredicate>
+Fwd unique(Fwd first, Fwd last, BinaryPredicate pred);
+template<class Inp, class OutputIterator>
+OutputIterator unique_copy(Inp first, Inp last, OutputIterator result);
+template<class Inp, class OutputIterator, class BinaryPredicate>
+OutputIterator unique_copy(Inp first, Inp last, OutputIterator result, BinaryPredicate pred);
+template<class BidirectionalIterator>
+void reverse(BidirectionalIterator first, BidirectionalIterator last);
+template<class BidirectionalIterator, class OutputIterator>
+OutputIterator reverse_copy(BidirectionalIterator first, BidirectionalIterator last, OutputIterator result);
+template<class Fwd>
+void rotate(Fwd first, Fwd middle, Fwd last);
+template<class Fwd, class OutputIterator>
+OutputIterator rotate_copy(Fwd first, Fwd middle, Fwd last, OutputIterator result);
+template<class RandomAccessIterator>
+void random_shuffle(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class RandomNumberGenerator>
+void random_shuffle(RandomAccessIterator first, RandomAccessIterator last, RandomNumberGenerator& rand);
+
+// _lib.alg.partitions_, partitions:
+template<class BidirectionalIterator, class Predicate>
+BidirectionalIterator partition(BidirectionalIterator first, BidirectionalIterator last, Predicate pred);
+template<class BidirectionalIterator, class Predicate>
+BidirectionalIterator stable_partition(BidirectionalIterator first, BidirectionalIterator last, Predicate pred);
+// subclause _lib.alg.sorting_, sorting and related operations:
+// _lib.alg.sort_, sorting:
+template<class RandomAccessIterator>
+void sort(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void sort(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+template<class RandomAccessIterator>
+void stable_sort(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void stable_sort(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+template<class RandomAccessIterator>
+void partial_sort(RandomAccessIterator first, RandomAccessIterator middle, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void partial_sort(RandomAccessIterator first, RandomAccessIterator middle, RandomAccessIterator last, Compare comp);
+template<class Inp, class RandomAccessIterator>
+RandomAccessIterator
+partial_sort_copy(Inp first, Inp last, RandomAccessIterator result_first, RandomAccessIterator result_last);
+template<class Inp, class RandomAccessIterator, class Compare>
+RandomAccessIterator
+partial_sort_copy(Inp first, Inp last, RandomAccessIterator result_first, RandomAccessIterator result_last, Compare comp);
+template<class RandomAccessIterator>
+void nth_element(RandomAccessIterator first, RandomAccessIterator nth, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void nth_element(RandomAccessIterator first, RandomAccessIterator nth, RandomAccessIterator last, Compare comp);
+// _lib.alg.binary.search_, binary search:
+template<class Fwd, class T>
+Fwd lower_bound(Fwd first, Fwd last, const T& value);
+template<class Fwd, class T, class Compare>
+Fwd lower_bound(Fwd first, Fwd last, const T& value, Compare comp);
+
+template<class Fwd, class T>
+Fwd upper_bound(Fwd first, Fwd last, const T& value);
+template<class Fwd, class T, class Compare>
+Fwd upper_bound(Fwd first, Fwd last, const T& value, Compare comp);
+template<class Fwd, class T>
+pair<Fwd, Fwd>
+equal_range(Fwd first, Fwd last, const T& value);
+template<class Fwd, class T, class Compare>
+pair<Fwd, Fwd>
+equal_range(Fwd first, Fwd last, const T& value, Compare comp);
+template<class Fwd, class T>
+bool binary_search(Fwd first, Fwd last, const T& value);
+template<class Fwd, class T, class Compare>
+bool binary_search(Fwd first, Fwd last, const T& value, Compare comp);
+// _lib.alg.merge_, merge:
+template<class Inp1, class Inp2, class OutputIterator>
+OutputIterator merge(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result);
+template<class Inp1, class Inp2, class OutputIterator, class Compare>
+OutputIterator merge(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result, Compare comp);
+template<class BidirectionalIterator>
+void inplace_merge(BidirectionalIterator first, BidirectionalIterator middle, BidirectionalIterator last);
+template<class BidirectionalIterator, class Compare>
+void inplace_merge(BidirectionalIterator first, BidirectionalIterator middle, BidirectionalIterator last, Compare comp);
+// _lib.alg.set.operations_, set operations:
+template<class Inp1, class Inp2>
+bool includes(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2);
+template<class Inp1, class Inp2, class Compare>
+bool includes(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, Compare comp);
+template<class Inp1, class Inp2, class OutputIterator>
+OutputIterator set_union(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result);
+template<class Inp1, class Inp2, class OutputIterator, class Compare>
+OutputIterator set_union(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result, Compare comp);
+
+template<class Inp1, class Inp2, class OutputIterator>
+OutputIterator set_intersection(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result);
+template<class Inp1, class Inp2, class OutputIterator, class Compare>
+OutputIterator set_intersection(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result, Compare comp);
+template<class Inp1, class Inp2, class OutputIterator>
+OutputIterator set_difference(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result);
+template<class Inp1, class Inp2, class OutputIterator, class Compare>
+OutputIterator set_difference(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result, Compare comp);
+template<class Inp1, class Inp2, class OutputIterator>
+OutputIterator
+set_symmetric_difference(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result);
+template<class Inp1, class Inp2, class OutputIterator, class Compare>
+OutputIterator
+set_symmetric_difference(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, OutputIterator result, Compare comp);
+// _lib.alg.heap.operations_, heap operations:
+template<class RandomAccessIterator>
+void push_heap(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void push_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+template<class RandomAccessIterator>
+void pop_heap(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void pop_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+template<class RandomAccessIterator>
+void make_heap(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void make_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+template<class RandomAccessIterator>
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last);
+template<class RandomAccessIterator, class Compare>
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp);
+
+// _lib.alg.min.max_, minimum and maximum:
+template<class T> const T& min(const T& a, const T& b);
+template<class T, class Compare>
+const T& min(const T& a, const T& b, Compare comp);
+template<class T> const T& max(const T& a, const T& b);
+template<class T, class Compare>
+const T& max(const T& a, const T& b, Compare comp);
+template<class Fwd>
+Fwd min_element(Fwd first, Fwd last);
+template<class Fwd, class Compare>
+Fwd min_element(Fwd first, Fwd last, Compare comp);
+template<class Fwd>
+Fwd max_element(Fwd first, Fwd last);
+template<class Fwd, class Compare>
+Fwd max_element(Fwd first, Fwd last, Compare comp);
+template<class Inp1, class Inp2>
+bool lexicographical_compare(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2);
+template<class Inp1, class Inp2, class Compare>
+bool lexicographical_compare(Inp1 first1, Inp1 last1, Inp2 first2, Inp2 last2, Compare comp);
+// _lib.alg.permutation.generators_, permutations
+template<class BidirectionalIterator>
+bool next_permutation(BidirectionalIterator first, BidirectionalIterator last);
+template<class BidirectionalIterator, class Compare>
+bool next_permutation(BidirectionalIterator first, BidirectionalIterator last, Compare comp);
+template<class BidirectionalIterator>
+bool prev_permutation(BidirectionalIterator first, BidirectionalIterator last);
+template<class BidirectionalIterator, class Compare>
+bool prev_permutation(BidirectionalIterator first, BidirectionalIterator last, Compare comp);
diff --git a/Utilities/ITK/Utilities/vxl/vcl/doc/conversions.txt b/Utilities/ITK/Utilities/vxl/vcl/doc/conversions.txt
new file mode 100644
index 0000000000000000000000000000000000000000..923f1f5f73a97a88116acb2e98c4e58ebd60ae3a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/doc/conversions.txt
@@ -0,0 +1,8 @@
+
+Conversions
+
+old new
+
+<cool/char.h> <vcl_cstring.h>
+<cool/Array.h> <vcl_vector.h>
+<cool/HashTable.h> <vcl_map.h>
diff --git a/Utilities/ITK/Utilities/vxl/vcl/doc/function.txt b/Utilities/ITK/Utilities/vxl/vcl/doc/function.txt
new file mode 100644
index 0000000000000000000000000000000000000000..53765d9d69c3e25d8d41db7e6f96bcf4e9ca44cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/doc/function.txt
@@ -0,0 +1,5 @@
+// -*- c++ -*-
+
+#define VCL_UNARY_INSTANTIATE(T)
+#define VCL_LESS_INSTANTIATE(T)
+#define VCL_COMPARISONS_INSTANTIATE(T)
diff --git a/Utilities/ITK/Utilities/vxl/vcl/doc/pair.txt b/Utilities/ITK/Utilities/vxl/vcl/doc/pair.txt
new file mode 100644
index 0000000000000000000000000000000000000000..636c47a174c73f7cfb28b3a7be469c8ade420f62
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/doc/pair.txt
@@ -0,0 +1,4 @@
+// -*- c++ -*-
+
+#define VCL_PAIR_INSTANTIATE(T1, T2)
+#define VCL_PAIR_const_INSTANTIATE(T1, T2)
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/vcl/egcs/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..0e2674b9a4fe25ade713c6992a22223ba902946b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/CMakeLists.txt
@@ -0,0 +1 @@
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl/egcs "(\\.h|\\.txx)$")
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_algorithm.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_algorithm.txx
new file mode 100644
index 0000000000000000000000000000000000000000..300b020f75ba3e9b792e52482d08f531fc0b2732
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_algorithm.txx
@@ -0,0 +1,33 @@
+#ifndef vcl_egcs_algorithm_txx_
+#define vcl_egcs_algorithm_txx_
+
+#include <vcl_algorithm.h>
+
+#define VCL_COPY_INSTANTIATE(Inp, Out) \
+template Out std::copy(Inp, Inp, Out)
+
+#define VCL_COPY_BACKWARD_INSTANTIATE(I, O)
+
+#define VCL_SWAP_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(void swap(T&, T&))
+
+#define VCL_OPERATOR_NE_INSTANTIATE(T)
+
+#define VCL_CONTAINABLE_INSTANTIATE(T)
+
+#define VCL_LESS_INSTANTIATE(T) \
+template struct less<T >
+
+#define VCL_FIND_INSTANTIATE(I, T) \
+template I std::find(I, I, T const&)
+
+#define VCL_SORT_INSTANTIATE(I, T) \
+template void __final_insertion_sort(I, I); \
+template void __introsort_loop(I, I, I, int)
+#define VCL_SORT_INSTANTIATE_CMP(I, T, C) \
+/* fix it if you need it */
+
+#define VCL_FIND_IF_INSTANTIATE(I, P) \
+template I find_if(I, I, P)
+
+#endif // vcl_egcs_algorithm_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_complex.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_complex.txx
new file mode 100644
index 0000000000000000000000000000000000000000..9bb5be185a7264361563dcece74e9e6182ac539a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_complex.txx
@@ -0,0 +1,43 @@
+#ifndef vcl_egcs_complex_txx_
+#define vcl_egcs_complex_txx_
+
+#include <vcl_complex.h>
+
+#include <std/complext.cc>
+
+#define VCL_COMPLEX_INSTANTIATE_INLINE(T) template T
+
+#undef VCL_COMPLEX_INSTANTIATE
+#define VCL_COMPLEX_INSTANTIATE(FLOAT) \
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(bool operator==(complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT imag(complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT real(complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > sqrt (complex<FLOAT >const& x));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator + (complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator + (complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator + (FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator - (complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator - (complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator - (FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator * (complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator * (complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator * (FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator / (complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator / (complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > operator / (FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > polar (FLOAT,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > pow (complex<FLOAT >const&,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > pow (complex<FLOAT >const&,FLOAT));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > pow (complex<FLOAT >const&,int));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > pow (FLOAT,complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > exp (complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(complex<FLOAT > log (complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT arg (complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT abs (complex<FLOAT >const&));\
+VCL_COMPLEX_INSTANTIATE_INLINE(FLOAT norm (complex<FLOAT >const&));\
+template complex<FLOAT >& __doadv (complex<FLOAT >* ths, const complex<FLOAT >& y);\
+template vcl_ostream& operator<<(vcl_ostream &, complex<FLOAT > const &)
+
+#endif // vcl_egcs_complex_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_deque.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_deque.txx
new file mode 100644
index 0000000000000000000000000000000000000000..a848850843d922ee5edeed0067c7a7c4c568bee1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_deque.txx
@@ -0,0 +1,10 @@
+#ifndef vcl_egcs_deque_cxx_
+#define vcl_egcs_deque_cxx_
+
+#include <vcl_deque.h>
+
+#undef VCL_DEQUE_INSTANTIATE
+#define VCL_DEQUE_INSTANTIATE(T) \
+template class deque<T >
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_functional.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_functional.txx
new file mode 100644
index 0000000000000000000000000000000000000000..80312b93b25d88d65c0a7a95d132ea616ac022a2
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_functional.txx
@@ -0,0 +1,4 @@
+#ifndef vcl_egcs_functional_txx_
+#define vcl_egcs_functional_txx_
+
+#endif // vcl_egcs_functional_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_iterator.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_iterator.txx
new file mode 100644
index 0000000000000000000000000000000000000000..49f4386a1ef31c400f62b9adad7b1df816532fd9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_iterator.txx
@@ -0,0 +1,39 @@
+#ifndef vcl_egcs_iterator_txx_
+#define vcl_egcs_iterator_txx_
+/*
+ fsm
+*/
+
+#include <vcl_iterator.h>
+
+#define INSTANTIATE_TAGS(I, TAG) \
+VCL_INSTANTIATE_INLINE(TAG iterator_category(I const &))
+
+#define INSTANTIATE_ITER_FWD(ForwardIterator) \
+INSTANTIATE_OPERATOR_NE(ForwardIterator);\
+INSTANTIATE_TAGS(ForwardIterator, forward_iterator_tag)
+
+#define INSTANTIATE_ITER_BD_Distance(BidirectionalIterator,Distance) \
+VCL_INSTANTIATE_INLINE(void advance(BidirectionalIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(BidirectionalIterator&,Distance,bidirectional_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void distance(BidirectionalIterator,BidirectionalIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(BidirectionalIterator,BidirectionalIterator const&,Distance&,bidirectional_iterator_tag))
+
+#define INSTANTIATE_ITER_BD(BidirectionalIterator) \
+INSTANTIATE_ITER_BD_Distance(BidirectionalIterator, BidirectionalIterator::difference_type);\
+INSTANTIATE_OPERATOR_NE(BidirectionalIterator);\
+INSTANTIATE_TAGS(BidirectionalIterator, bidirectional_iterator_tag)
+
+#define INSTANTIATE_ITER_RA_Distance(RandomAccessIterator,Distance) \
+VCL_INSTANTIATE_INLINE(void advance(RandomAccessIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(RandomAccessIterator&,Distance,random_access_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void distance(RandomAccessIterator,RandomAccessIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(RandomAccessIterator const&,RandomAccessIterator const&,\
+ Distance&,random_access_iterator_tag))
+
+#define INSTANTIATE_ITER_RA(RandomAccessIterator) \
+INSTANTIATE_ITER_RA_Distance(RandomAccessIterator, vcl_ptrdiff_t);\
+INSTANTIATE_OPERATOR_NE(RandomAccessIterator);\
+INSTANTIATE_TAGS(RandomAccessIterator, random_access_iterator_tag)
+
+#endif // vcl_egcs_iterator_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_list.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_list.txx
new file mode 100644
index 0000000000000000000000000000000000000000..94af187ecc3a20677bfb7a247eb6198bc7fd5fa0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_list.txx
@@ -0,0 +1,29 @@
+#ifndef vcl_egcs_list_txx_
+#define vcl_egcs_list_txx_
+
+#include <vcl_list.h>
+
+// MT: Member template
+
+#define VCL_LIST_INSTANTIATE_MT_InputIterator(T, InputIterator) \
+template list<T >::list(InputIterator first, InputIterator last); \
+template void list<T >::insert(list<T >::iterator, InputIterator, InputIterator)
+
+#undef VCL_LIST_INSTANTIATE
+#define VCL_LIST_INSTANTIATE(T) \
+template class list<T >;\
+VCL_LIST_INSTANTIATE_MT_InputIterator(T, list<T >::iterator);\
+VCL_LIST_INSTANTIATE_MT_InputIterator(T, list<T >::const_iterator)
+
+#if 0 // commented out
+#ifdef __STL_MEMBER_TEMPLATES
+#define INSTANTIATE_LIST_MT_InputIterator(T, InputIterator) \
+template list<T >::list(InputIterator first, InputIterator last);\
+template void list<T >::insert(list<T >::iterator position, InputIterator first, InputIterator last);\
+template void list<T >::range_initialize(InputIterator first, InputIterator last)
+#else
+#define INSTANTIATE_LIST_MT_InputIterator(T, InputIterator) /* no-op */
+#endif
+#endif // 0
+
+#endif // vcl_egcs_list_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_map.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_map.txx
new file mode 100644
index 0000000000000000000000000000000000000000..428e9d64558812fa5b7f29b829b9fcd04e1fcf17
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_map.txx
@@ -0,0 +1,35 @@
+#ifndef vcl_egcs_map_txx_
+#define vcl_egcs_map_txx_
+
+#include <vcl_map.h>
+
+// Macro to instantiate the underlying rb_tree and its member templates.
+//template class rb_tree<Key,pair<Key const,T >,select1st<pair<Key const,T > >,Comp,__default_alloc_template<true,0> >
+#define VCL_MAP_INSTANTIATE_RB_TREE_tagged(tag, Key, T, Comp) \
+template class rb_tree<Key,pair<Key const,T >,select1st<pair<Key const,T > >,Comp,__default_alloc_template<true,0> >;\
+typedef rb_tree<Key,pair<Key const,T >,select1st<pair<Key const,T > >,Comp,__default_alloc_template<true,0> > cont##tag;\
+template void cont##tag::insert_unique(cont##tag::iterator, cont##tag::iterator)
+#define VCL_MAP_INSTANTIATE_RB_TREE_passthrough(tag, Key, T, Comp) \
+VCL_MAP_INSTANTIATE_RB_TREE_tagged(tag, Key, T, Comp)
+#define VCL_MAP_INSTANTIATE_RB_TREE(Key, T, Comp) \
+VCL_MAP_INSTANTIATE_RB_TREE_passthrough(__LINE__, Key, T, Comp)
+
+// Macro to instantiate something.
+#define VCL_MAP_INSTANTIATE_MT_InputIterator(maptype, Key, T, Comp, InputIterator) \
+template maptype<Key, T, Comp >::maptype(InputIterator, InputIterator);\
+template maptype<Key, T, Comp >::maptype(InputIterator first, InputIterator last, Comp const&);\
+template void maptype<Key, T, Comp >::insert(InputIterator first, InputIterator last)
+
+// Macro to instantiate vcl_map<Key, T, Comp>
+#undef VCL_MAP_INSTANTIATE
+#define VCL_MAP_INSTANTIATE(Key, T, Comp) \
+template class vcl_map<Key, T, Comp >; \
+VCL_MAP_INSTANTIATE_MT_InputIterator(map, Key, T, Comp, vcl_map<Key VCL_COMMA T VCL_COMMA Comp >::iterator); \
+VCL_MAP_INSTANTIATE_RB_TREE(Key, T, Comp)
+
+// Macro to instantiate vcl_multimap<Key, T, Comp>
+#undef VCL_MULTIMAP_INSTANTIATE
+#define VCL_MULTIMAP_INSTANTIATE(Key, T, Comp) \
+template class vcl_multimap<Key, T, Comp >
+
+#endif // vcl_egcs_map_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_set.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_set.txx
new file mode 100644
index 0000000000000000000000000000000000000000..928f83fd53906eac04828ce0172ce202c8e560e3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_set.txx
@@ -0,0 +1,15 @@
+#ifndef vcl_egcs_set_txx_
+#define vcl_egcs_set_txx_
+
+#include <vcl_set.h>
+
+#define VCL_SET_INSTANTIATE_ITERATOR(InputIterator, Distance) \
+template void distance (InputIterator , InputIterator , Distance& )
+
+#undef VCL_SET_INSTANTIATE
+#define VCL_SET_INSTANTIATE(T, Comp) \
+template class vcl_set<T, Comp >; \
+template class rb_tree<T, T, vcl_identity<T >, Comp >; \
+VCL_SET_INSTANTIATE_ITERATOR(vcl_set<T VCL_COMMA Comp >::iterator, unsigned)
+
+#endif // vcl_egcs_set_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_string.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_string.txx
new file mode 100644
index 0000000000000000000000000000000000000000..9f5e916793b15ef089a9bdc58b7f46a6f3f9f983
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_string.txx
@@ -0,0 +1,26 @@
+#ifndef vcl_egcs_string_txx_
+#define vcl_egcs_string_txx_
+/*
+ fsm
+*/
+
+#include <vcl_string.h>
+
+#undef VCL_BASIC_STRING_INSTANTIATE
+
+#if VCL_HAS_TEMPLATE_SYMBOLS
+# define VCL_BASIC_STRING_INSTANTIATE(charT, Traits) // no need -- in libstdc++
+#else
+# define VCL_BASIC_STRING_INSTANTIATE(charT, Traits) \
+template class basic_string<charT, Traits >; \
+template basic_string<charT,Traits > &basic_string<charT,Traits >::replace(char*, char*, char *, char*);\
+template basic_string<charT,Traits > &basic_string<charT,Traits >::replace(char*, char*, char const*, char const*);\
+template basic_string<charT,Traits > &basic_string<charT,Traits >::replace(vcl_size_t, vcl_size_t,\
+ basic_string<charT,Traits > const&,\
+ vcl_size_t, vcl_size_t);\
+template basic_string<charT,Traits > &basic_string<charT,Traits >::replace(vcl_size_t, vcl_size_t, char const*, vcl_size_t);\
+template basic_string<charT,Traits > &basic_string<charT,Traits >::replace(vcl_size_t, vcl_size_t, vcl_size_t, char); \
+template vcl_ostream& operator<<(vcl_ostream&, basic_string<charT, Traits > const &)
+#endif
+
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_utility.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_utility.txx
new file mode 100644
index 0000000000000000000000000000000000000000..6d2e44b2499af1502e704a470ae991e7396bf42c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_utility.txx
@@ -0,0 +1,14 @@
+#ifndef vcl_egcs_utility_txx_
+#define vcl_egcs_utility_txx_
+
+#include <vcl_utility.h>
+
+#undef VCL_PAIR_INSTANTIATE
+#define VCL_PAIR_INSTANTIATE(T1, T2) \
+template class vcl_pair<T1, T2 >
+
+// swap can't be defined if either T1 or T2 is a const type
+#define VCL_PAIR_INSTANTIATE_const(T1, T2) \
+template class vcl_pair<T1, T2 >
+
+#endif // vcl_egcs_utility_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_vector.txx b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_vector.txx
new file mode 100644
index 0000000000000000000000000000000000000000..4ad0987894fe82ac90a226638fa57eb4bf667118
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/egcs/vcl_vector.txx
@@ -0,0 +1,26 @@
+#ifndef vcl_egcs_vector_txx_
+#define vcl_egcs_vector_txx_
+
+#include <vcl_vector.h>
+#include <vcl_algorithm.txx>
+#include <vcl_iterator.h>
+
+#define VCL_VECTOR_STLINST_uninitialized_copy(Inp, Fwd, Size) \
+template Fwd __uninitialized_copy_aux(Inp, Inp, Fwd, __false_type);\
+template pair<Inp, Fwd> __uninitialized_copy_n(Inp, Size, Fwd, vcl_input_iterator_tag);\
+VCL_INSTANTIATE_INLINE(Fwd uninitialized_copy(Inp, Inp, Fwd))
+
+
+#undef VCL_VECTOR_INSTANTIATE
+#define VCL_VECTOR_INSTANTIATE(T) \
+template vector<T >::iterator __uninitialized_fill_n_aux(vector<T >::iterator, vector<T >::size_type, T const &, __false_type); \
+template void fill(vector<T >::iterator, vector<T >::iterator, T const &); \
+template vector<T >::iterator fill_n(vector<T >::iterator, vector<T >::size_type, T const &);\
+/* VCL_COPY_INSTANTIATE(vector<T >::const_iterator, vector<T >::iterator); */ \
+VCL_VECTOR_STLINST_uninitialized_copy(vector<T >::iterator, vector<T >::iterator, vector<T >::size_type);\
+VCL_VECTOR_STLINST_uninitialized_copy(vector<T >::const_iterator, vector<T >::iterator, vector<T >::size_type);\
+template \
+void vector<T, __default_alloc_template< true, 0 > >::range_insert(T *, T *, T *, vcl_forward_iterator_tag); \
+template class vector<T >
+
+#endif // vcl_egcs_vector_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/CMakeLists.txt b/Utilities/ITK/Utilities/vxl/vcl/emulation/CMakeLists.txt
new file mode 100644
index 0000000000000000000000000000000000000000..8c72fdd42b96cfe9f8b9dd02bafe26806d921407
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/CMakeLists.txt
@@ -0,0 +1 @@
+INSTALL_FILES(${VXL_INSTALL_ROOT}/vcl/emulation "(\\.h|\\.txx)$")
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/README-STL b/Utilities/ITK/Utilities/vxl/vcl/emulation/README-STL
new file mode 100644
index 0000000000000000000000000000000000000000..fbc0f26f4763524ce5501914bb7b346889af7e7e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/README-STL
@@ -0,0 +1,26 @@
+
+[multi]map<Key, T, Compare, Alloc>
+ value_type = pair<const Key, T>
+ binary_function<value_type, value_type, bool>
+ rep_type = rb_tree<Key, value_type, select1st<value_type>, Compare, Alloc>;
+
+ pair<iterator,bool>
+ pair<iterator,iterator>
+ pair<const_iterator,const_iterator>
+
+ external ==, <
+
+[multi]set<Key, Compare>
+ rb_tree<Key, Key, identity<Key>, Compare, Alloc>
+ pair<iterator, bool>
+ pair<iterator, iterator>
+
+
+rb_tree<Key, Value, GetKey, Compare, Alloc>:
+ __rb_tree_node<Value>
+ __rb_tree_iterator<Value>
+ __rb_tree_const_iterator<Value>
+ __rb_tree_base<Value,Alloc>
+ simple_alloc<__rb_tree_node<Value>, Alloc>
+ reverse_bidirectional_iterator<iterator, Value, reference, difference_type>
+ reverse_bidirectional_iterator<const_iterator, value_type, const_reference, difference_type>
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/egcs-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/egcs-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..a7dad233486c27a674e49881276651cb9ce01d8d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/egcs-stlconf.h
@@ -0,0 +1,317 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+# define VCL_GCC_EGCS
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <stlcomp.h>
+# else
+// auto-configured section
+
+// if compiler is running -fexceptions, assume they are to be used.
+#ifdef __EXCEPTIONS
+# undef __STL_NO_EXCEPTIONS
+# define __STL_USE_EXCEPTIONS 1
+#else
+# define __STL_NO_EXCEPTIONS
+# undef __STL_USE_EXCEPTIONS
+#endif
+
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+# define __STL_BOOL_KEYWORD 1
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+//# define __STL_DEFAULT_TEMPLATE_PARAM 1
+/* # undef __STL_DEFAULT_TYPE_PARAM */
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+/* # undef __STL_WEAK_ATTRIBUTE */
+/* # undef __STL_BASE_MATCH_BUG */
+/* # undef __STL_NESTED_TYPE_PARAM_BUG */
+/* # undef __STL_UNUSED_REQUIRED_BUG */
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+# define __STL_BASE_TYPEDEF_BUG
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+# define __STL_FULL_SPEC_SYNTAX 1
+# define __STL_BAD_ALLOC_DEFINED 1
+/* # undef __STL_DEBUG_ALLOC */
+# define __STL_MEMBER_TEMPLATES 1
+/* # undef __STL_FRIEND_TEMPLATES */
+# define __STL_CLASS_PARTIAL_SPECIALIZATION 1
+# define __STL_FUNC_PARTIAL_ORDERING 1
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 1
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-272-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-272-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..db5620781ead0e7942298e10f3d5c27e707bc0da
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-272-stlconf.h
@@ -0,0 +1,332 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <stlcomp.h>
+# else
+// auto-configured section
+
+// define that to disable these features
+/* # undef __STL_NO_EXCEPTIONS */
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+// #ifdef linux
+// #define __STL_USE_MALLOC 1
+// #endif
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+# define __STL_BOOL_KEYWORD 1
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+/* # undef __STL_DEFAULT_TEMPLATE_PARAM */
+# define __STL_DEFAULT_TYPE_PARAM 1
+/* # undef __STL_STATIC_TEMPLATE_DATA */
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+# define __STL_WEAK_ATTRIBUTE 0 /* awf */
+# define __STL_BASE_MATCH_BUG 1
+# define __STL_NESTED_TYPE_PARAM_BUG 1
+/* # undef __STL_UNUSED_REQUIRED_BUG */
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+/* # undef __STL_BASE_TYPEDEF_BUG */
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+/* # undef __STL_FULL_SPEC_SYNTAX */
+/* # undef __STL_BAD_ALLOC_DEFINED */
+/* # undef __STL_DEBUG_ALLOC */
+/* # undef __STL_MEMBER_TEMPLATES */
+/* # undef __STL_FRIEND_TEMPLATES */
+/* # undef __STL_CLASS_PARTIAL_SPECIALIZATION */
+/* # undef __STL_FUNC_PARTIAL_ORDERING */
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 0
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 1
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// default parameters as template types derived from arguments ( not always supported )
+# if ! defined (__STL_DEFAULT_TEMPLATE_PARAM)
+# define __DFL_TMPL_PARAM( classname, defval ) class classname
+# define __DFL_TMPL_ARG(classname) , classname
+# else
+# define __STL_DEFAULT_TYPE_PARAM 1
+# define __DFL_TMPL_PARAM( classname, defval ) class classname = defval
+# define __DFL_TMPL_ARG(classname)
+# endif
+
+// default parameters as complete types
+# if defined ( __STL_DEFAULT_TYPE_PARAM )
+# define __DFL_TYPE_PARAM( classname, defval ) class classname = defval
+# define __DFL_TYPE_ARG(classname)
+# else
+# define __DFL_TYPE_PARAM( classname, defval ) class classname
+# define __DFL_TYPE_ARG(classname) , classname
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-2800-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-2800-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..103bc3bacf65fb2402b4c836c0bac5cdb6ba6164
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-2800-stlconf.h
@@ -0,0 +1,294 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+// define that to disable these features
+/* # undef __STL_NO_EXCEPTIONS */
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+# define __STL_BOOL_KEYWORD 1
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+/* # undef __STL_DEFAULT_TEMPLATE_PARAM */
+# define __STL_DEFAULT_TYPE_PARAM 1
+/* # undef __STL_STATIC_TEMPLATE_DATA */
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+# define __STL_WEAK_ATTRIBUTE 0 /* awf */
+# define __STL_BASE_MATCH_BUG 1
+# define __STL_NESTED_TYPE_PARAM_BUG 1
+/* # undef __STL_UNUSED_REQUIRED_BUG */
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+/* # undef __STL_BASE_TYPEDEF_BUG */
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+/* # undef __STL_FULL_SPEC_SYNTAX */
+/* # undef __STL_BAD_ALLOC_DEFINED */
+/* # undef __STL_DEBUG_ALLOC */
+/* # undef __STL_MEMBER_TEMPLATES */
+/* # undef __STL_FRIEND_TEMPLATES */
+/* # undef __STL_CLASS_PARTIAL_SPECIALIZATION */
+/* # undef __STL_FUNC_PARTIAL_ORDERING */
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 0
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 1
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __SGI_STL_STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-281-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-281-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..b9141ea2613ac908ecb03b427e06dce089fe05d8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-281-stlconf.h
@@ -0,0 +1,317 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <stlcomp.h>
+# else
+// auto-configured section
+
+// if compiler is running -fexceptions, assume they are to be used.
+#ifdef __EXCEPTIONS
+# undef __STL_NO_EXCEPTIONS
+# define __STL_USE_EXCEPTIONS 1
+#else
+# define __STL_NO_EXCEPTIONS
+# undef __STL_USE_EXCEPTIONS
+#endif
+
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+# define __STL_BOOL_KEYWORD 1
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+/* # undef __STL_DEFAULT_TEMPLATE_PARAM */
+/* # undef __STL_DEFAULT_TYPE_PARAM */
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+/* # undef __STL_WEAK_ATTRIBUTE */
+/* # undef __STL_BASE_MATCH_BUG */
+/* # undef __STL_NESTED_TYPE_PARAM_BUG */
+/* # undef __STL_UNUSED_REQUIRED_BUG */
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+/* # undef __STL_BASE_TYPEDEF_BUG */
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+# define __STL_FULL_SPEC_SYNTAX 1
+# define __STL_BAD_ALLOC_DEFINED 1
+/* # undef __STL_DEBUG_ALLOC */
+# define __STL_MEMBER_TEMPLATES 1
+/* # undef __STL_FRIEND_TEMPLATES */
+# define __STL_CLASS_PARTIAL_SPECIALIZATION 1
+# define __STL_FUNC_PARTIAL_ORDERING 1
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 1
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-295-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-295-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..a7dad233486c27a674e49881276651cb9ce01d8d
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/gcc-295-stlconf.h
@@ -0,0 +1,317 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+# define VCL_GCC_EGCS
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <stlcomp.h>
+# else
+// auto-configured section
+
+// if compiler is running -fexceptions, assume they are to be used.
+#ifdef __EXCEPTIONS
+# undef __STL_NO_EXCEPTIONS
+# define __STL_USE_EXCEPTIONS 1
+#else
+# define __STL_NO_EXCEPTIONS
+# undef __STL_USE_EXCEPTIONS
+#endif
+
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+# define __STL_BOOL_KEYWORD 1
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+//# define __STL_DEFAULT_TEMPLATE_PARAM 1
+/* # undef __STL_DEFAULT_TYPE_PARAM */
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+/* # undef __STL_WEAK_ATTRIBUTE */
+/* # undef __STL_BASE_MATCH_BUG */
+/* # undef __STL_NESTED_TYPE_PARAM_BUG */
+/* # undef __STL_UNUSED_REQUIRED_BUG */
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+# define __STL_BASE_TYPEDEF_BUG
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+# define __STL_FULL_SPEC_SYNTAX 1
+# define __STL_BAD_ALLOC_DEFINED 1
+/* # undef __STL_DEBUG_ALLOC */
+# define __STL_MEMBER_TEMPLATES 1
+/* # undef __STL_FRIEND_TEMPLATES */
+# define __STL_CLASS_PARTIAL_SPECIALIZATION 1
+# define __STL_FUNC_PARTIAL_ORDERING 1
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 1
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/sgi-CC-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/sgi-CC-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..b71ae6c6d69d9c7828906d6c0efb3a975f49dee1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/sgi-CC-stlconf.h
@@ -0,0 +1,325 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+// define that to disable these features
+#define __STL_NO_EXCEPTIONS
+#undef __STL_USE_EXCEPTIONS
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+#define __STL_EAGER_TYPECHECK 1
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+
+// Later SGI compilers define _BOOL
+#ifdef _BOOL
+#define __STL_BOOL_KEYWORD
+#endif
+
+/* # undef __STL_BOOL_KEYWORD */
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+# define __STL_DEFAULT_TEMPLATE_PARAM
+# define __STL_DEFAULT_TYPE_PARAM 1
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+/* # undef __STL_TYPENAME */
+/* # undef __STL_EXPLICIT */
+/* # undef __STL_USE_EXCEPTIONS */
+/* # undef __STL_EXCEPTION_SPEC */
+/* # undef __STL_WEAK_ATTRIBUTE */
+# define __STL_BASE_MATCH_BUG 1
+/* # undef __STL_NESTED_TYPE_PARAM_BUG */
+# define __STL_UNUSED_REQUIRED_BUG 1
+
+#ifndef _COMPILER_VERSION
+# define __STL_UNINITIALIZABLE_PRIVATE
+#endif
+
+# define __STL_BASE_TYPEDEF_BUG
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+
+/* # undef __STL_NEW_HEADER_NAMES */
+/* # undef __STL_NEW_STYLE_CASTS */
+/* # undef __STL_WCHAR_T */
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+/* # undef __STL_FULL_SPEC_SYNTAX */
+/* # undef __STL_BAD_ALLOC_DEFINED */
+/* # undef __STL_DEBUG_ALLOC */
+/* # undef __STL_MEMBER_TEMPLATES */
+/* # undef __STL_FRIEND_TEMPLATES */
+/* # undef __STL_CLASS_PARTIAL_SPECIALIZATION */
+/* # undef __STL_FUNC_PARTIAL_ORDERING */
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 1
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters as template types derived from arguments ( not always supported )
+# if ! defined (__STL_DEFAULT_TEMPLATE_PARAM)
+# define __DFL_TMPL_PARAM( classname, defval ) class classname
+# define __DFL_TMPL_ARG(classname) , classname
+# else
+# define __STL_DEFAULT_TYPE_PARAM 1
+# define __DFL_TMPL_PARAM( classname, defval ) class classname = defval
+# define __DFL_TMPL_ARG(classname)
+# endif
+
+// default parameters as complete types
+# if defined ( __STL_DEFAULT_TYPE_PARAM )
+# define __DFL_TYPE_PARAM( classname, defval ) class classname = defval
+# define __DFL_TYPE_ARG(classname)
+# else
+# define __DFL_TYPE_PARAM( classname, defval ) class classname
+# define __DFL_TYPE_ARG(classname) , classname
+# endif
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/stlcomp.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/stlcomp.h
new file mode 100644
index 0000000000000000000000000000000000000000..b955339c2b7c225baa1694d53871d42764af50a7
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/stlcomp.h
@@ -0,0 +1,387 @@
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __STLCOMP_H
+# define __STLCOMP_H
+
+//==========================================================
+// Features selection
+
+// Uncomment that to disable exception handling
+// # define __STL_NO_EXCEPTIONS 1
+
+// Uncomment that to disable std namespace usage
+// # define __STL_NO_NAMESPACES 1
+
+// Comment that to not include defalloc.h ( no defaults changed )
+# define __STL_USE_DEFALLOC 1
+
+// Uncomment that to to use new-based allocator as default
+// # define __STL_USE_NEWALLOC 1
+
+// Uncomment this to use malloc-based allocator as default
+// # define __STL_USE_MALLOC 1
+
+// Uncomment this to disable using std by default
+// # define __STL_NO_USING_STD 1
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+// # define __STL_USE_ABBREVS 1
+
+// set this to force checked allocators
+// # define __STL_DEBUG_ALLOC 1
+
+// Mostly correct guess
+# define __STL_UINT32_T unsigned long
+
+//==========================================================
+
+//==========================================================
+// default values of autoconf flags
+//==========================================================
+
+// the values choosen here as defaults try to give
+// maximum functionality on the most conservative settings
+
+// Uncomment this if your compiler supports "bool"
+// # define __STL_BOOL_KEYWORD 1
+
+// Uncomment this if your compiler has "bool" keyword reserved
+// # define __STL_RESERVED_BOOL_KEYWORD 1
+
+// Comment this if your compiler doesn't support that
+# define __STL_DEFAULT_TEMPLATE_PARAM 1
+// Uncomment this if your compiler support only complete types as
+// default parameters
+// # define __STL_DEFAULT_TYPE_PARAM 1
+
+// Comment this if your compiler lacks static data
+// members template declarations
+// Uncomment next line if your compiler supports __attribute__((weak))
+# define __STL_STATIC_TEMPLATE_DATA 1
+// # define __STL_WEAK_ATTRIBUTE 1
+
+// Uncomment this if your C library has lrand48() function
+// # define __STL_RAND48 1
+// Uncomment this if your compiler can't inline while(), for()
+// # define __STL_LOOP_INLINE_PROBLEMS 1
+
+// Uncomment this if your compiler supports namespaces
+// # define __STL_NAMESPACES 1
+
+// Uncomment this if your compiler supports typename
+// # define __STL_TYPENAME 1
+
+// Uncomment this if your compiler supports mutable
+// # define __STL_MUTABLE 1
+
+// Uncomment if const_cast<> is available
+// # define __STL_NEW_STYLE_CASTS 1
+
+// Uncomment this if your compiler supports explicit constructors
+// # define __STL_EXPLICIT 1
+
+// Uncomment this if your compiler supports exceptions
+// # define __STL_EXCEPTIONS 1
+
+// Uncomment this if your compiler supports exception specifications
+// with reduced overhead ( e.g. inlines them, not vice versa)
+// # define __STL_EXCEPTION_SPEC
+
+// Uncomment if long long is available
+// # define __STL_LONG_LONG 1
+
+// Uncomment this for wchar_t functinality
+// # define __STL_WCHAR_T 1
+
+// Uncomment if needed full specialization syntax : template <> struct ....
+// # define __STL_FULL_SPEC_SYNTAX 1
+
+// Uncomment if bad_alloc defined in <new>
+// # define __STL_BAD_ALLOC_DEFINED 1
+
+// Uncomment if member templates available
+// # define __STL_MEMBER_TEMPLATES 1
+
+// Uncomment if member templates available
+// # define __STL_FRIEND_TEMPLATES 1
+
+// Uncomment if available
+// # define __STL_CLASS_PARTIAL_SPECIALIZATION 1
+
+// Uncomment if available
+// # define __STL_FUNC_PARTIAL_ORDERING 1
+
+// Uncomment if available
+// # define __STL_AUTOMATIC_TYPE_TRAITS 1
+
+// Uncomment if getting errors compiling mem_fun* adaptors
+// # define __STL_MEMBER_POINTER_PARAM_BUG 1
+
+// All these settings don't affect performance/functionality
+// Comment them if your compiler has no problems.
+# define __STL_BASE_MATCH_BUG 1
+// # define __STL_NESTED_TYPE_PARAM_BUG 1
+# define __STL_UNUSED_REQUIRED_BUG 1
+# define __STL_UNINITIALIZABLE_PRIVATE 1
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+// if your compiler have serious problems with typedefs, try this one
+// # define __STL_BASE_TYPEDEF_BUG 1
+//==========================================================
+
+//==========================================================
+// per-version compiler features recognition
+//==========================================================
+
+// reporting of incompatibility
+# define __GIVE_UP_WITH_STL(message) void give_up() \
+ { upgrade_the_compiler_to_use_STL;}
+
+
+# if defined(__sgi) && !defined(__GNUC__)
+# if defined(_BOOL) || ! ((_MIPS_ISA < 2) || defined (_ABIO32))
+# define __STL_BOOL_KEYWORD
+# endif
+# if defined(_TYPENAME)
+# define __STL_TYPENAME
+# endif
+# ifdef _PARTIAL_SPECIALIZATION_OF_CLASS_TEMPLATES
+# define __STL_CLASS_PARTIAL_SPECIALIZATION
+# endif
+# ifdef _MEMBER_TEMPLATES
+# define __STL_MEMBER_TEMPLATES
+# endif
+# ifdef __EXCEPTIONS
+# define __STL_USE_EXCEPTIONS
+# endif
+# if !defined(_NOTHREADS) && !defined(_PTHREADS)
+# define __STL_SGI_THREADS
+# endif
+# endif
+
+
+// AIX xlC, is there more specific define ?
+#if defined(_AIX)
+# define __STL_RESERVED_BOOL_KEYWORD 1
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# undef __STL_DEFAULT_TYPE_PARAM
+# undef __STL_NAMESPACES
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# define __STL_UNINITIALIZABLE_PRIVATE 1
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# undef __STL_CONST_CONSTRUCTOR_BUG
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+#endif
+
+// Microsoft Visual C++ 4.0, 4.1, 4.2, 5.0
+# if defined(_MSC_VER)
+// comment this one to try experimantal allocator
+// # define __STL_USE_NEWALLOC 1
+# undef __STL_BOOL_KEYWORD
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# undef __STL_BASE_MATCH_BUG
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# ifdef _CPPUNWIND
+# define __STL_USE_EXCEPTIONS
+# endif
+# if defined ( _MT )
+# define __STL_WIN32THREADS
+# endif
+# if ( _MSC_VER>=1000 )
+# define __STL_NAMESPACES 1
+# define __STL_NEW_STYLE_CASTS 1
+# undef __STL_CONST_CONSTRUCTOR_BUG
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+# define __STL_LONG_DOUBLE 1
+# if ( _MSC_VER<=1010 )
+// "bool" is reserved in MSVC 4.1 while <yvals.h> absent, so :
+# define __STL_RESERVED_BOOL_KEYWORD 1
+# define __STL_USE_ABBREVS 1
+# else
+# define __STL_YVALS_H 1
+# define __STL_BAD_ALLOC_DEFINED 1
+# endif
+# endif
+# if (_MSC_VER >= 1100) // MSVC 5.0
+# define __STL_DEFAULT_TEMPLATE_PARAM 1
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+# define __STL_MUTABLE 1
+# endif
+# endif
+
+// Borland C++ ( 5.x )
+# if defined ( __BORLANDC__ )
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# if ( __BORLANDC__ < 0x500 )
+# undef __STL_BOOL_KEYWORD
+# undef __STL_NAMESPACES
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# undef __STL_NESTED_TYPE_PARAM_BUG
+# undef __STL_BASE_MATCH_BUG
+# define __STL_NESTED_TYPE_PARAM_BUG 1
+# define __STL_BASE_MATCH_BUG 1
+# else
+# define __STL_BOOL_KEYWORD 1
+# define __STL_DEFAULT_TYPE_PARAM 1
+# define __STL_NAMESPACES 1
+# define __STL_EXPLICIT 1
+# define __STL_TYPENAME 1
+# define __STL_USE_EXCEPTIONS 1
+# define __STL_NEW_STYLE_CASTS
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+# define __STL_WCHAR_T 1
+# define __STL_NEW_HEADER_NAMES 1
+# undef __STL_CONST_CONSTRUCTOR_BUG
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+# endif
+# undef __STL_LOOP_INLINE_PROBLEMS
+# define __STL_LOOP_INLINE_PROBLEMS 1
+// empty exception spec make things worse in BC, so:
+# undef __STL_EXCEPTION_SPEC
+# endif
+
+# if defined(__SUNPRO_CC)
+# if ( __SUNPRO_CC <= 0x420 )
+ // SUNPro C++ 4.1 and above
+# undef __STL_BOOL_KEYWORD
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# undef __STL_NAMESPACES
+# define __STL_USE_EXCEPTIONS 1
+# undef __STL_EXCEPTION_SPEC
+# define __STL_EXCEPTION_SPEC 1
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# define __STL_UNINITIALIZABLE_PRIVATE 1
+# define __STL_LONG_LONG 1
+# define __STL_WCHAR_T 1
+ // SUNPro C++ prior to 4.1
+# if ( __SUNPRO_CC < 0x410 )
+ // hard times ;(
+# define __STL_BASE_MATCH_BUG 1
+# define __STL_BASE_TYPEDEF_BUG 1
+# if ( __SUNPRO_CC < 0x401 )
+ __GIVE_UP_WITH_STL(SUNPRO_401)
+# endif
+# else
+# if ( __SUNPRO_CC >= 0x420 )
+# define __STL_FULL_SPEC_SYNTAX 1
+# endif
+# endif
+
+# endif
+# endif
+
+// g++ 2.7.x and above
+# if defined (__GNUC__ )
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# define __STL_BOOL_KEYWORD 1
+// cygnus have a lot of version, let's assume the best.
+// no specific definitions known except this one
+# if defined (__CYGWIN32__)
+# define __CYGNUS_GCC__
+# endif
+
+# if ! ( __GNUC__ > 2 || __GNUC_MINOR__ > 7 || defined (__CYGNUS_GCC__) )
+// Will it work with 2.6 ? I doubt it.
+# if ( __GNUC_MINOR__ < 7 )
+ __GIVE_UP_WITH_STL(GCC_272);
+# endif
+# undef __STL_NAMESPACES
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# define __STL_DEFAULT_TYPE_PARAM 1
+# undef __STL_STATIC_TEMPLATE_DATA
+# define __STL_NESTED_TYPE_PARAM_BUG 1
+# undef __STL_STATIC_TEMPLATE_DATA
+# define __STL_BASE_MATCH_BUG 1
+// unused operators are required (forward)
+# undef __STL_EXPLICIT
+# define __STL_EXPLICIT 1
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# define __STL_UNINITIALIZABLE_PRIVATE 1
+# undef __STL_CONST_CONSTRUCTOR_BUG
+# undef __STL_LONG_LONG
+# undef __STL_WCHAR_T
+# define __STL_LONG_LONG 1
+# define __STL_WCHAR_T 1
+# define __STL_MUTABLE 1
+# define __STL_NEW_STYLE_CASTS 1
+// default for gcc-2.7.2 is no exceptions, let's follow it
+# endif /* __GNUC__ > 2 */
+
+// cygnus gcc may be as advanced as that
+# if defined ( __CYGNUS_GCC__ )
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# define __STL_DEFAULT_TEMPLATE_PARAM 1
+# undef __STL_STATIC_TEMPLATE_DATA
+# define __STL_STATIC_TEMPLATE_DATA 1
+# undef __STL_NAMESPACES
+# define __STL_EXPLICIT 1
+# define __STL_TYPENAME 1
+# endif
+
+// static template data members workaround strategy for gcc tries
+// to use weak symbols.
+// if you don't want to use that, #define __STL_WEAK_ATTRIBUTE=0 ( you'll
+// have to put "#define __PUT_STATIC_DATA_MEMBERS_HERE" line in one of your
+// compilation unit ( or CFLAGS for it ) _before_ including any STL header ).
+# if !(defined (__STL_STATIC_TEMPLATE_DATA) || defined (__STL_WEAK_ATTRIBUTE ))
+// systems using GNU ld or format that supports weak symbols
+// may use "weak" attribute
+// Linux & Solaris ( x86 & SPARC ) are being auto-recognized here
+# if defined(__STL_GNU_LD) || defined(__ELF__) || \
+ (( defined (__SVR4) || defined ( __svr4__ )) && \
+ ( defined (sun) || defined ( __sun__ )))
+# define __STL_WEAK_ATTRIBUTE 1
+# endif
+# endif /* __STL_WEAK_ATTRIBUTE */
+
+# endif /* __GNUC__ */
+
+
+# if defined (__WATCOM_CPLUSPLUS__)
+# if (__WATCOM_CPLUSPLUS__ >= 1100 )
+// Can define if you enable /xs compiler option
+//# if 0
+//# define __STL_EXCEPTIONS 1
+//# define __STL_EXCEPTION_SPEC 1
+//# else
+//# undef __STL_EXCEPTIONS
+//# undef __STL_EXCEPTION_SPEC
+//# endif
+# define __STL_NESTED_TYPE_PARAM_BUG 1
+# define __STL_BOOL_KEYWORD 1
+# undef __STL_DEFAULT_TEMPLATE_PARAM
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_EXPLICIT 1
+# undef __STL_BASE_MATCH_BUG
+# undef __STL_BASE_TYPEDEF_BUG
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# define __STL_CONST_CONSTRUCTOR_BUG 1
+# define __STL_NEW_HEADER_NAMES 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_MUTABLE 1
+# define __STL_NEW_STYLE_CASTS 1
+# undef __STL_UNUSED_REQUIRED_BUG
+# endif
+# endif /* __WATCOM_CPLUSPLUS__ */
+
+# undef __GIVE_UP_WITH_STL
+
+#endif // __STLCOMP_H
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC4.1-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC4.1-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..becd51fef7f18f69efebaaee67d4ff18874f7ad5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC4.1-stlconf.h
@@ -0,0 +1,311 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <config/stlcomp.h>
+# else
+// auto-configured section
+
+// define that to disable these features
+/* # undef __STL_NO_EXCEPTIONS */
+/* # undef __STL_NO_NAMESPACES */
+
+// select allocation method you like
+/* # undef __STL_USE_MALLOC */
+/* # undef __STL_USE_NEWALLOC */
+
+// this one is not mandatory, just enabled
+/* # undef __STL_USE_DEFALLOC */
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+/* # undef __STL_NO_USING_STD */
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+/* # undef __STL_USE_ABBREVS */
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned int
+/* # undef __STL_BOOL_KEYWORD */
+/* # undef __STL_RESERVED_BOOL_KEYWORD */
+/* # undef __STL_YVALS_H */
+/* # undef __STL_DEFAULT_TEMPLATE_PARAM */
+/* # undef __STL_DEFAULT_TYPE_PARAM */
+# define __STL_STATIC_TEMPLATE_DATA 0
+// # define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_RAND48 1
+/* # undef __STL_LOOP_INLINE_PROBLEMS */
+/* # undef __STL_NAMESPACES */
+/* # undef __STL_TYPENAME */
+/* # undef __STL_EXPLICIT */
+# define __STL_USE_EXCEPTIONS 1
+# define __STL_EXCEPTION_SPEC 1
+/* # undef __STL_WEAK_ATTRIBUTE */
+/* # undef __STL_BASE_MATCH_BUG */
+/* # undef __STL_NESTED_TYPE_PARAM_BUG */
+# define __STL_UNUSED_REQUIRED_BUG 1
+/* # undef __STL_UNINITIALIZABLE_PRIVATE */
+/* # undef __STL_BASE_TYPEDEF_BUG */
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+/* # undef __STL_CONST_CONSTRUCTOR_BUG */
+
+/* # undef __STL_NEW_HEADER_NAMES */
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_WCHAR_T 1
+# define __STL_LONG_LONG 1
+# define __STL_LONG_DOUBLE 1
+/* # undef __STL_MUTABLE */
+# define __STL_FULL_SPEC_SYNTAX 1
+/* # undef __STL_BAD_ALLOC_DEFINED */
+/* # undef __STL_DEBUG_ALLOC */
+/* # undef __STL_MEMBER_TEMPLATES */
+/* # undef __STL_FRIEND_TEMPLATES */
+/* # undef __STL_CLASS_PARTIAL_SPECIALIZATION */
+/* # undef __STL_FUNC_PARTIAL_ORDERING */
+/* # undef __STL_AUTOMATIC_TYPE_TRAITS */
+/* # undef __STL_MEMBER_POINTER_PARAM_BUG */
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 1
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+/* # undef __STL_BASE_TYPEDEF_OUTSIDE_BUG */
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC5.0-stlconf.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC5.0-stlconf.h
new file mode 100644
index 0000000000000000000000000000000000000000..dd13154bd52f54e1a69485bc66b37003713e64e8
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/sun-CC5.0-stlconf.h
@@ -0,0 +1,310 @@
+/* stlconf.h. Generated automatically by configure. */
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_STLCONF_H
+# define __SGI_STL_STLCONF_H
+
+# define __AUTO_CONFIGURED 1
+
+//==========================================================
+// Getting proper values of autoconf flags
+// if you ran 'configure', __AUTO_CONFIGURED is set to 1 and
+// specific compiler fetures will be used.
+// Otherwise, the <stlcomp.h> header will be included for per-version
+// features recognition.
+//==========================================================
+# if defined ( BYPASS_AUTOCONF_SETTINGS ) || ! defined (__AUTO_CONFIGURED)
+// per-version compiler features recognition
+# include <config/stlcomp.h>
+# else
+// auto-configured section
+
+// define that to disable these features
+# undef __STL_NO_EXCEPTIONS
+# undef __STL_NO_NAMESPACES
+
+// select allocation method you like
+# undef __STL_USE_MALLOC
+# undef __STL_USE_NEWALLOC
+
+// this one is not mandatory, just enabled
+# undef __STL_USE_DEFALLOC
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+# undef __STL_NO_USING_STD
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+# undef __STL_USE_ABBREVS
+
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned
+# define __STL_BOOL_KEYWORD 1
+// # undef __STL_RESERVED_BOOL_KEYWORD
+// # undef __STL_YVALS_H
+// # undef __STL_DEFAULT_TEMPLATE_PARAM
+// # undef __STL_DEFAULT_TYPE_PARAM
+// # undef __STL_STATIC_TEMPLATE_DATA
+# undef __STL_RAND48
+# undef __STL_LOOP_INLINE_PROBLEMS
+# undef __STL_NAMESPACES
+# define __STL_TYPENAME
+# undef __STL_EXPLICIT
+# undef __STL_USE_EXCEPTIONS
+# undef __STL_EXCEPTION_SPEC
+# undef __STL_WEAK_ATTRIBUTE
+# undef __STL_BASE_MATCH_BUG
+# undef __STL_NESTED_TYPE_PARAM_BUG
+# undef __STL_UNUSED_REQUIRED_BUG
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# undef __STL_BASE_TYPEDEF_BUG
+# undef __STL_BASE_TYPEDEF_OUTSIDE_BUG
+# undef __STL_CONST_CONSTRUCTOR_BUG
+
+# undef __STL_NEW_HEADER_NAMES
+# undef __STL_NEW_STYLE_CASTS
+# undef __STL_WCHAR_T
+# undef __STL_LONG_LONG
+# undef __STL_LONG_DOUBLE
+# undef __STL_MUTABLE
+# undef __STL_FULL_SPEC_SYNTAX
+# undef __STL_BAD_ALLOC_DEFINED
+# undef __STL_DEBUG_ALLOC
+# undef __STL_MEMBER_TEMPLATES
+# undef __STL_FRIEND_TEMPLATES
+# undef __STL_CLASS_PARTIAL_SPECIALIZATION
+# undef __STL_FUNC_PARTIAL_ORDERING
+# undef __STL_AUTOMATIC_TYPE_TRAITS
+# undef __STL_MEMBER_POINTER_PARAM_BUG
+# endif /* AUTO_CONFIGURED */
+
+//==========================================================
+
+//==========================================================
+// final workaround tuning based on given flags
+//==========================================================
+
+// some justification
+
+# if !defined ( __STL_STATIC_TEMPLATE_DATA )
+# define __STL_STATIC_TEMPLATE_DATA 0
+# if !defined ( __STL_WEAK_ATTRIBUTE )
+# define __STL_WEAK_ATTRIBUTE 0
+# endif
+# endif
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+# undef __STL_BASE_TYPEDEF_OUTSIDE_BUG
+# define __STL_BASE_TYPEDEF_OUTSIDE_BUG 1
+# endif
+
+// features tuning
+# ifdef __STL_DEBUG
+# define __STL_ASSERTIONS 1
+# endif
+
+# ifdef __STL_ASSERTIONS
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); vcl_abort(); }
+# else
+# define __stl_assert(expr)
+# endif
+
+# ifdef __STL_DEBUG
+# define __stl_verbose_assert(expr,diagnostic) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL error : %s\n%s:%d STL assertion failure: %s\n",\
+ __FILE__, __LINE__ , diagnostic, __FILE__, __LINE__ , # expr ); vcl_abort(); }
+
+# define __stl_debug_check(expr) __stl_assert(expr)
+# define __stl_debug_do(expr) expr
+# else
+# define __stl_verbose_assert(expr,diagnostic) __stl_assert(expr)
+# define __stl_debug_check(expr)
+# define __stl_debug_do(expr)
+# endif
+
+# ifdef __STL_RAND48
+# define __rand lrand48
+# else
+# define __rand rand
+# endif
+
+// tuning of static template data members workaround
+# if ( __STL_STATIC_TEMPLATE_DATA < 1 )
+// ignore __PUT directive in this case
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+# define __DECLARE_INSTANCE(type,item,init) type item __attribute__ (( weak )) = init
+# else
+# ifdef __PUT_STATIC_DATA_MEMBERS_HERE
+# define __DECLARE_INSTANCE(type,item,init) type item = init
+# else
+# define __DECLARE_INSTANCE(type,item,init)
+# endif /* __PUT_STATIC_DATA_MEMBERS_HERE */
+# endif /* __STL_WEAK_ATTRIBUTE */
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+// default parameters workaround tuning
+# if defined ( __STL_DEFAULT_TYPE_PARAM ) || ( defined ( __STL_NAMESPACES )&&! defined (__STL_NO_NAMESPACES))
+# define __WORKAROUND_RENAME(X) X
+# else
+# define __WORKAROUND_RENAME(X) __##X
+# endif
+
+// namespace selection
+# if defined (__STL_NAMESPACES) && ! defined (__STL_NO_NAMESPACES)
+
+// change this if don't think that is standard enough ;)
+# define __STL_NAMESPACE std
+# define __BEGIN_STL_NAMESPACE namespace __STL_NAMESPACE {
+# define __STL_USING_NAMESPACE using namespace __STL_NAMESPACE;
+
+# ifdef __STL_NO_USING_STD
+# define __USING_NAMESPACE
+# else
+# define __USING_NAMESPACE using namespace __STL_NAMESPACE;
+# endif
+# ifdef __STL_DEFAULT_TYPE_PARAM
+# define __STL_FULL_NAMESPACE __STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# else
+# define __STL_FULL_NAMESPACE sgi_full
+# define __BEGIN_STL_FULL_NAMESPACE namespace __STL_FULL_NAMESPACE {
+# define __END_STL_FULL_NAMESPACE };
+# endif
+# define __END_STL_NAMESPACE }; __USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __STL_FULL_NAMESPACE::__WORKAROUND_RENAME(X)
+# else /* __STL_NAMESPACES */
+# define __STL_NAMESPACE
+# define __STL_FULL_NAMESPACE
+# define __BEGIN_STL_NAMESPACE
+# define __END_STL_NAMESPACE
+# define __BEGIN_STL_FULL_NAMESPACE
+# define __END_STL_FULL_NAMESPACE
+# define __STL_USING_NAMESPACE
+ // workaround tuning
+# define __FULL_NAME(X) __WORKAROUND_RENAME(X)
+# endif /* __STL_NAMESPACES */
+
+# define __STL_NAME(name) vcl_##name // Lo Russo Graziano <Graziano.LoRusso@CSELT.IT>
+
+
+// advanced keywords usage
+# ifdef __STL_NEW_STYLE_CASTS
+# define __CONST_CAST(x,y) const_cast<x>(y)
+# else
+# define __CONST_CAST(x,y) ((x)y)
+# endif
+
+# ifndef __STL_TYPENAME
+# define typename
+# endif
+
+# ifndef __STL_EXPLICIT
+# define explicit
+# endif
+
+# ifdef __STL_MUTABLE
+# define __ASSIGN_MUTABLE(type,x,y) x=y
+# else
+# define __ASSIGN_MUTABLE(type,x,y) __CONST_CAST(type,x)=y
+# define mutable
+# endif
+
+// exception-specific macros.
+// most of them require double parens : (())
+# if defined ( __STL_NO_EXCEPTIONS) || ! defined (__STL_USE_EXCEPTIONS)
+# define IUEg__TRY
+# define IUEg__CATCH(x) if (false)
+# define IUEg__THROW(arg)
+# define IUEg__RETHROW
+# else
+# define IUEg__CATCH(x) catch x
+# define IUEg__TRY try
+# define IUEg__THROW(arg) throw arg
+# define IUEg__RETHROW throw
+# endif
+
+// throw specification ( used in inline constructors
+// to improve efficiency some compilers )
+// param count is variable, parens used.
+# if defined ( __STL_NO_EXCEPTIONS ) || ! defined ( __STL_EXCEPTION_SPEC )
+# define IUEg__THROWS(x)
+# else
+# define IUEg__THROWS(x) throw x
+# endif
+
+# if defined (__STL_LOOP_INLINE_PROBLEMS)
+# define INLINE_LOOP
+# else
+# define INLINE_LOOP inline
+# endif
+
+#if defined ( __STL_UNINITIALIZABLE_PRIVATE )
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+# ifdef __STL_FULL_SPEC_SYNTAX
+# define __STL_FULL_SPECIALIZATION template<>
+# else
+# define __STL_FULL_SPECIALIZATION
+# endif
+
+# define __IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define __IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define __IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+#define __IMPORT_SUPER_COPY_ASSIGNMENT(__derived_name) \
+ __derived_name(const self& x) : super(x) {} \
+ __derived_name(const super& x) : super(x) {} \
+ self& operator=(const self& x) { \
+ super::operator=(x); \
+ return *this; \
+ } \
+ self& operator=(const super& x) { \
+ super::operator=(x); \
+ return *this; \
+ }
+
+# if defined (__STL_BASE_TYPEDEF_OUTSIDE_BUG) || defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define __CONTAINER_SUPER_TYPEDEFS \
+ __IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+# else
+# define __CONTAINER_SUPER_TYPEDEFS
+# endif
+
+//==========================================================
+
+#endif /* __STLCONF_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algobase.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algobase.h
new file mode 100644
index 0000000000000000000000000000000000000000..35baace72608c2cd227e13a9acc5e60085ecb243
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algobase.h
@@ -0,0 +1,500 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Exception Handling:
+ * Copyright (c) 1997
+ * Mark of the Unicorn, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Mark of the Unicorn makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Adaptation:
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_algobase_h
+#define vcl_emulation_algobase_h
+
+#include <vcl_cstring.h>
+//#include <vcl_climits.h>
+#include "vcl_functional.h"
+#include "vcl_pair.h"
+#include "vcl_iterator.h"
+#include <vcl_new.h>
+
+# if defined ( __BORLANDC__ ) && defined ( __NO_NAMESPACES )
+# include <vcl_cstdlib.h>
+# endif
+
+template <class T>
+inline void vcl_swap(T& a, T& b) { T tmp = a; a = b; b = tmp; }
+
+template <class ForwardIterator1, class ForwardIterator2, class T>
+inline void __iter_swap(const ForwardIterator1& a, const ForwardIterator2& b, T*)
+{
+ vcl_swap((T&)*a,(T&)*b);
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+inline void iter_swap(const ForwardIterator1& a, const ForwardIterator2& b)
+{
+ __iter_swap(a, b, value_type(a));
+}
+
+# if !( defined ( __STL_NO_NAMESPACES ) && defined ( __MINMAX_DEFINED ) )
+# define __MINMAX_DEFINED
+template <class T>
+inline const T& vcl_min(const T& a, const T& b) { return b < a ? b : a; }
+
+template <class T>
+inline const T& vcl_max(const T& a, const T& b) { return a < b ? b : a; }
+# endif
+
+template <class T, class Compare>
+inline const T& vcl_min(const T& a, const T& b, Compare comp) { return comp(b, a) ? b : a; }
+
+template <class T, class Compare>
+inline const T& vcl_max(const T& a, const T& b, Compare comp) { return comp(a, b) ? b : a; }
+
+template <class InputIterator, class Distance>
+INLINE_LOOP void __distance(InputIterator first, const InputIterator& last,
+ Distance& n, vcl_input_iterator_tag)
+{
+ while (first != last) { ++first; ++n; }
+}
+
+template <class ForwardIterator, class Distance>
+INLINE_LOOP void __distance(ForwardIterator first, const ForwardIterator& last,
+ Distance& n,
+ vcl_forward_iterator_tag)
+{
+ while (first != last) { ++first; ++n; }
+}
+
+template <class BidirectionalIterator, class Distance>
+INLINE_LOOP void __distance(BidirectionalIterator first,
+ const BidirectionalIterator& last,
+ Distance& n, vcl_bidirectional_iterator_tag)
+{
+ while (first != last) { ++first; ++n; }
+}
+
+template <class RandomAccessIterator, class Distance>
+inline void __distance(const RandomAccessIterator& first,
+ const RandomAccessIterator& last,
+ Distance& n, vcl_random_access_iterator_tag)
+{
+ n += last - first;
+}
+
+template <class InputIterator, class Distance>
+inline void vcl_distance(InputIterator first, InputIterator last, Distance& n)
+{
+ __distance(first, last, n, iterator_category(first));
+}
+
+template <class InputIterator, class Distance>
+INLINE_LOOP void __advance(InputIterator& i, Distance n, vcl_input_iterator_tag)
+{
+ while (n--) ++i;
+}
+
+template <class ForwardIterator, class Distance>
+INLINE_LOOP void __advance(ForwardIterator& i, Distance n, vcl_forward_iterator_tag)
+{
+ while (n--) ++i;
+}
+
+template <class BidirectionalIterator, class Distance>
+INLINE_LOOP void __advance(BidirectionalIterator& i, Distance n, vcl_bidirectional_iterator_tag)
+{
+ if (n > 0) while (n--) ++i;
+ else while (n++) --i;
+}
+
+template <class RandomAccessIterator, class Distance>
+inline void __advance(RandomAccessIterator& i, Distance n,
+ vcl_random_access_iterator_tag)
+{
+ i += n;
+}
+
+template <class InputIterator, class Distance>
+inline void vcl_advance(InputIterator& i, Distance n)
+{
+ __advance(i, n, iterator_category(i));
+}
+
+#ifdef _MSC_VER
+#if _MSC_VER == 1100
+#define VC50_DESTRUCTOR_BUG
+#endif
+#endif
+template <class T>
+inline void vcl_destroy(T* pointer)
+{
+// horrible VC50 compiler will leak with stl containers
+// of objects, upgrade to VC60
+// DO NOT CHANGE BACK TO ifndef VC60
+// This is defined by the VC50 compiler and only the VC50 compiler
+
+#ifndef VC50_DESTRUCTOR_BUG
+ pointer->~T();
+#endif
+#ifdef __STL_SHRED_BYTE
+ vcl_fill_n((char*)pointer, sizeof(T), STL_SHRED_BYTE);
+#endif
+}
+
+template <class T1, class T2>
+inline void vcl_construct(T1* p, const T2& value)
+{
+#ifdef __STL_SHRED_BYTE
+ vcl_fill_n((char*)p, sizeof(T1), STL_SHRED_BYTE);
+#endif
+ new (p) T1(value);
+}
+
+template <class T>
+inline void __default_construct(T* p)
+{
+#ifdef __STL_SHRED_BYTE
+ vcl_fill_n((char*)p, sizeof(T), STL_SHRED_BYTE);
+#endif
+ new (p) T();
+}
+
+template <class ForwardIterator>
+INLINE_LOOP void vcl_destroy(ForwardIterator first, ForwardIterator last)
+{
+ while (first != last) { vcl_destroy(&*first); ++first; }
+}
+
+template <class InputIterator, class ForwardIterator>
+INLINE_LOOP ForwardIterator vcl_uninitialized_copy(InputIterator first,
+ InputIterator last,
+ ForwardIterator result)
+{
+ __stl_debug_check(__check_range(first, last));
+# if defined ( __STL_USE_EXCEPTIONS )
+ ForwardIterator resultBase = result;
+# endif
+ IUEg__TRY
+ {
+ for (; first != last; ++result, ++first )
+ vcl_construct(&*result, *first);
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...)
+ {
+ vcl_destroy( resultBase, result );
+ throw;
+ }
+# endif
+ return result;
+}
+
+template <class ForwardIterator, class T>
+INLINE_LOOP void
+vcl_uninitialized_fill(ForwardIterator first, ForwardIterator last,
+ const T& x)
+{
+ __stl_debug_check(__check_range(first, last));
+# if defined ( __STL_USE_EXCEPTIONS )
+ ForwardIterator saveFirst = first;
+# endif
+ IUEg__TRY
+ {
+ for (; first != last; ++first )
+ vcl_construct( &*first, x );
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...)
+ {
+ vcl_destroy(saveFirst, first);
+ throw;
+ }
+# endif
+}
+
+template <class ForwardIterator, class Size, class T>
+INLINE_LOOP ForwardIterator vcl_uninitialized_fill_n(ForwardIterator first, Size n,
+ const T& x)
+{
+# if defined ( __STL_USE_EXCEPTIONS )
+ ForwardIterator saveFirst = first;
+# endif
+ IUEg__TRY
+ {
+ while (n--) { vcl_construct(&*first, x); ++first; }
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...)
+ {
+ vcl_destroy(saveFirst, first);
+ throw;
+ }
+# endif
+ return first;
+}
+
+// fbp : extension
+template <class ForwardIterator>
+INLINE_LOOP void
+__default_initialize(ForwardIterator first, ForwardIterator last)
+{
+ __stl_debug_check(__check_range(first, last));
+# if defined ( __STL_USE_EXCEPTIONS )
+ ForwardIterator saveFirst = first;
+# endif
+ IUEg__TRY
+ {
+ for (; first != last; ++first )
+ __default_construct(&*first);
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...)
+ {
+ vcl_destroy(saveFirst, first);
+ throw;
+ }
+# endif
+}
+
+template <class ForwardIterator, class Size>
+INLINE_LOOP ForwardIterator __default_initialize_n(ForwardIterator first, Size n)
+{
+# if defined ( __STL_USE_EXCEPTIONS )
+ ForwardIterator saveFirst = first;
+# endif
+ IUEg__TRY
+ {
+ while (n--) { __default_construct(&*first); ++first; }
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...)
+ {
+ vcl_destroy(saveFirst, first);
+ throw;
+ }
+# endif
+ return first;
+}
+
+template <class InputIterator, class OutputIterator>
+INLINE_LOOP OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, vcl_input_iterator_tag)
+{
+ for (; first != last; ++result, ++first)
+ *result = *first;
+ return result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, vcl_forward_iterator_tag)
+{
+ return __copy(first, last, result, vcl_input_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, vcl_bidirectional_iterator_tag)
+{
+ return __copy(first, last, result, vcl_input_iterator_tag());
+}
+
+template <class RandomAccessIterator, class OutputIterator, class Distance>
+INLINE_LOOP OutputIterator
+__copy_d(RandomAccessIterator first, RandomAccessIterator last,
+ OutputIterator result, Distance*)
+{
+ for (Distance n = last - first; n > 0; --n, ++result, ++first)
+ *result = *first;
+ return result;
+}
+
+template <class RandomAccessIterator, class OutputIterator>
+inline OutputIterator
+__copy(RandomAccessIterator first, RandomAccessIterator last,
+ OutputIterator result, vcl_random_access_iterator_tag)
+{
+ return __copy_d(first, last, result, distance_type(first));
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator vcl_copy(InputIterator first, InputIterator last,
+ OutputIterator result)
+{
+ __stl_debug_check(__check_range(first, last));
+ return __copy(first, last, result, iterator_category(first));
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2>
+INLINE_LOOP BidirectionalIterator2 vcl_copy_backward(BidirectionalIterator1 first,
+ BidirectionalIterator1 last,
+ BidirectionalIterator2 result)
+{
+ __stl_debug_check(__check_range(first, last));
+ while (first != last) *--result = *--last;
+ return result;
+}
+
+template <class ForwardIterator, class T>
+INLINE_LOOP void
+vcl_fill(ForwardIterator first, ForwardIterator last, const T& value)
+{
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first)
+ *first = value;
+}
+
+template <class OutputIterator, class Size, class T>
+INLINE_LOOP OutputIterator
+vcl_fill_n(OutputIterator first, Size n, const T& value)
+{
+ for (; n > 0; --n, ++first)
+ *first = value;
+ return first;
+}
+
+template <class InputIterator1, class InputIterator2>
+INLINE_LOOP vcl_pair<InputIterator1, InputIterator2> vcl_mismatch(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ while (first1 != last1 && *first1 == *first2) { ++first1; ++first2; }
+ return vcl_pair<InputIterator1, InputIterator2>(first1, first2);
+}
+
+template <class InputIterator1, class InputIterator2, class BinaryPredicate>
+INLINE_LOOP vcl_pair<InputIterator1, InputIterator2> vcl_mismatch(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ BinaryPredicate binary_pred)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ while (first1 != last1 && binary_pred(*first1, *first2)) { ++first1; ++first2; }
+ return vcl_pair<InputIterator1, InputIterator2>(first1, first2);
+}
+
+template <class InputIterator1, class InputIterator2>
+INLINE_LOOP bool vcl_equal(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ for (; first1 != last1; ++first1, ++first2)
+ if (!(*first1 == *first2))
+ return false;
+ return true;
+}
+
+template <class InputIterator1, class InputIterator2, class BinaryPredicate>
+INLINE_LOOP bool vcl_equal(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, BinaryPredicate binary_pred)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ for (; first1 != last1; ++first1, ++first2)
+ if (!binary_pred(*first1, *first2))
+ return false;
+ return true;
+}
+
+template <class InputIterator1, class InputIterator2>
+INLINE_LOOP bool
+vcl_lexicographical_compare(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ for (;first1 != last1 && first2 != last2;++first1,++first2)
+ {
+ if (*first1 < *first2) return true;
+ if (*first2 < *first1) return false;
+ }
+ return first1 == last1 && first2 != last2;
+}
+
+template <class InputIterator1, class InputIterator2, class Compare>
+INLINE_LOOP bool
+vcl_lexicographical_compare(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ Compare comp)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ for (; first1 != last1 && first2 != last2; ++first2, ++first1)
+ {
+ if (comp(*first1, *first2)) return true;
+ if (comp(*first2, *first1)) return false;
+ }
+ return first1 == last1 && first2 != last2;
+}
+
+inline bool
+vcl_lexicographical_compare(unsigned char* first1, unsigned char* last1,
+ unsigned char* first2, unsigned char* last2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ vcl_size_t len1 = last1 - first1; // awf removed const
+ vcl_size_t len2 = last2 - first2;
+ const int result = vcl_memcmp(first1, first2, vcl_min(len1, len2));
+ return result != 0 ? result < 0 : len1 < len2;
+}
+
+inline bool vcl_lexicographical_compare(char* first1, char* last1,
+ char* first2, char* last2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+#if CHAR_MAX == SCHAR_MAX
+ return vcl_lexicographical_compare((signed char*) first1, (signed char*) last1,
+ (signed char*) first2, (signed char*) last2);
+#else
+ return vcl_lexicographical_compare((unsigned char*) first1,
+ (unsigned char*) last1,
+ (unsigned char*) first2,
+ (unsigned char*) last2);
+#endif
+}
+
+#endif // vcl_emulation_algobase_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.h
new file mode 100644
index 0000000000000000000000000000000000000000..51885c3c26f1c6523d2f8bcd951e24055af3579c
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.h
@@ -0,0 +1,2844 @@
+#ifndef vcl_emulation_algorithm_h_
+#define vcl_emulation_algorithm_h_
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Exception Handling:
+ * Copyright (c) 1997
+ * Mark of the Unicorn, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Mark of the Unicorn makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Adaptation:
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+//#include <vcl_cstdlib.h>
+//#include <vcl_climits.h>
+#include "vcl_algobase.h"
+#include "vcl_heap.h"
+#include "vcl_tempbuf.h"
+#define vcl_remove vcl_remove
+
+template <class T>
+inline const T& __median(const T& a, const T& b, const T& c) {
+ if (a < b)
+ if (b < c)
+ return b;
+ else if (a < c)
+ return c;
+ else
+ return a;
+ else if (a < c)
+ return a;
+ else if (b < c)
+ return c;
+ else
+ return b;
+}
+
+template <class T, class Compare>
+inline const T& __median(const T& a, const T& b, const T& c, Compare comp) {
+ if (comp(a, b))
+ if (comp(b, c))
+ return b;
+ else if (comp(a, c))
+ return c;
+ else
+ return a;
+ else if (comp(a, c))
+ return a;
+ else if (comp(b, c))
+ return c;
+ else
+ return b;
+}
+
+template <class InputIterator, class Function>
+inline
+Function vcl_for_each(InputIterator first, InputIterator last, Function f) {
+ __stl_debug_check(__check_range(first, last));
+ for (;first != last;++first) f(*first);
+ return f;
+}
+
+template <class InputIterator, class T>
+inline
+InputIterator vcl_find(InputIterator first, InputIterator last, const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ while (first != last && *first != value) ++first;
+ return first;
+}
+
+template <class InputIterator, class Predicate>
+inline
+InputIterator vcl_find_if(InputIterator first, InputIterator last,
+ Predicate pred) {
+ __stl_debug_check(__check_range(first, last));
+ while (first != last && !pred(*first)) ++first;
+ return first;
+}
+
+template <class ForwardIterator>
+inline
+ForwardIterator vcl_adjacent_find(ForwardIterator first, ForwardIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return last;
+ ForwardIterator next = first;
+ while (++next != last) {
+ if (*first == *next) return first;
+ first = next;
+ }
+ return last;
+}
+
+template <class ForwardIterator, class BinaryPredicate>
+inline
+ForwardIterator vcl_adjacent_find(ForwardIterator first, ForwardIterator last,
+ BinaryPredicate binary_pred) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return last;
+ ForwardIterator next = first;
+ while (++next != last) {
+ if (binary_pred(*first, *next)) return first;
+ first = next;
+ }
+ return last;
+}
+
+template <class InputIterator, class T, class Size>
+inline
+void vcl_count(InputIterator first, InputIterator last, const T& value,
+ Size& n) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first)
+ if (*first == value) ++n;
+}
+
+template <class InputIterator, class Predicate, class Size>
+inline
+void vcl_count_if(InputIterator first, InputIterator last, Predicate pred,
+ Size& n) {
+ __stl_debug_check(__check_range(first, last));
+ for (;first != last;++first)
+ if (pred(*first)) ++n;
+}
+
+template <class ForwardIterator1, class ForwardIterator2, class Distance1, class Distance2>
+inline
+ForwardIterator1 __search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ Distance1*, Distance2*) {
+ Distance1 d1 = 0;
+ vcl_distance(first1, last1, d1);
+ Distance2 d2 = 0;
+ vcl_distance(first2, last2, d2);
+
+ if (d1 < d2) return last1;
+
+ ForwardIterator1 current1 = first1;
+ ForwardIterator2 current2 = first2;
+
+ while (current2 != last2)
+ if (*current1++ != *current2++)
+ if (d1-- == d2)
+ return last1;
+ else {
+ current1 = ++first1;
+ current2 = first2;
+ }
+ return (current2 == last2) ? first1 : last1;
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+inline ForwardIterator1 vcl_search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2)
+{
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ return __search(first1, last1, first2, last2, distance_type(first1),
+ distance_type(first2));
+}
+
+template <class ForwardIterator1, class ForwardIterator2, class BinaryPredicate, class Distance1, class Distance2>
+inline
+ForwardIterator1 __search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ BinaryPredicate binary_pred, Distance1*, Distance2*) {
+ Distance1 d1 = 0;
+ vcl_distance(first1, last1, d1);
+ Distance2 d2 = 0;
+ vcl_distance(first2, last2, d2);
+
+ if (d1 < d2) return last1;
+
+ ForwardIterator1 current1 = first1;
+ ForwardIterator2 current2 = first2;
+
+ while (current2 != last2)
+ if (!binary_pred(*current1++, *current2++))
+ if (d1-- == d2)
+ return last1;
+ else {
+ current1 = ++first1;
+ current2 = first2;
+ }
+ return (current2 == last2) ? first1 : last1;
+}
+
+template <class ForwardIterator1, class ForwardIterator2, class BinaryPredicate>
+inline ForwardIterator1 vcl_search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ BinaryPredicate binary_pred) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ return __search(first1, last1, first2, last2, binary_pred,
+ distance_type(first1), distance_type(first2));
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+inline
+ForwardIterator2 vcl_swap_ranges(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2) {
+ __stl_debug_check(__check_range(first1, last1));
+ for (;first1 != last1;++first1,++first2) iter_swap(first1, first2);
+ return first2;
+}
+
+template <class InputIterator, class OutputIterator, class UnaryOperation>
+inline
+OutputIterator vcl_transform(InputIterator first, InputIterator last,
+ OutputIterator result, UnaryOperation op) {
+ __stl_debug_check(__check_range(first, last));
+ for (;first != last;++first,++result) *result = op(*first);
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class BinaryOperation>
+inline
+OutputIterator vcl_transform(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, OutputIterator result,
+ BinaryOperation binary_op) {
+ __stl_debug_check(__check_range(first1, last1));
+ for (;first1 != last1;++first1,++first2,++result) *result = binary_op(*first1, *first2);
+ return result;
+}
+
+template <class ForwardIterator, class T>
+inline
+void vcl_replace(ForwardIterator first, ForwardIterator last, const T& old_value,
+ const T& new_value) {
+ __stl_debug_check(__check_range(first, last));
+ while (first != last) {
+ if (*first == old_value) *first = new_value;
+ ++first;
+ }
+}
+
+template <class ForwardIterator, class Predicate, class T>
+inline
+void vcl_replace_if(ForwardIterator first, ForwardIterator last, Predicate pred,
+ const T& new_value) {
+ __stl_debug_check(__check_range(first, last));
+ while (first != last) {
+ if (pred(*first)) *first = new_value;
+ ++first;
+ }
+}
+
+template <class InputIterator, class OutputIterator, class T>
+inline
+OutputIterator vcl_replace_copy(InputIterator first, InputIterator last,
+ OutputIterator result, const T& old_value,
+ const T& new_value) {
+ __stl_debug_check(__check_range(first, last));
+ for (;first != last;++first,++result) {
+ *result = *first == old_value ? new_value : *first;
+ }
+ return result;
+}
+
+template <class Iterator, class OutputIterator, class Predicate, class T>
+inline
+OutputIterator vcl_replace_copy_if(Iterator first, Iterator last,
+ OutputIterator result, Predicate pred,
+ const T& new_value) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first,++result) {
+ *result = pred(*first) ? new_value : *first;
+ }
+ return result;
+}
+
+template <class ForwardIterator, class Generator>
+inline
+void vcl_generate(ForwardIterator first, ForwardIterator last, Generator gen) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first) *first = gen();
+}
+
+template <class OutputIterator, class Size, class Generator>
+inline
+OutputIterator vcl_generate_n(OutputIterator first, Size n, Generator gen) {
+ for (; n > 0; --n, ++first) *first = gen();
+ return first;
+}
+
+template <class InputIterator, class OutputIterator, class T>
+inline
+OutputIterator vcl_remove_copy(InputIterator first, InputIterator last,
+ OutputIterator result, const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first) {
+ if (*first != value) {
+ *result = *first;
+ ++result;
+ }
+ }
+ return result;
+}
+
+template <class InputIterator, class OutputIterator, class Predicate>
+inline
+OutputIterator vcl_remove_copy_if(InputIterator first, InputIterator last,
+ OutputIterator result, Predicate pred) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first) {
+ if (!pred(*first)) {
+ *result = *first;
+ ++result;
+ }
+ }
+ return result;
+}
+
+template <class ForwardIterator, class T>
+inline
+ForwardIterator vcl_remove(ForwardIterator first, ForwardIterator last, const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ first = vcl_find(first, last, value);
+ ForwardIterator next = first;
+ return first == last ? first : vcl_remove_copy(++next, last, first, value);
+}
+
+template <class ForwardIterator, class Predicate>
+inline
+ForwardIterator vcl_remove_if(ForwardIterator first, ForwardIterator last, Predicate pred) {
+ __stl_debug_check(__check_range(first, last));
+ first = vcl_find_if(first, last, pred);
+ ForwardIterator next = first;
+ return first == last ? first : vcl_remove_copy_if(++next, last, first, pred);
+}
+
+template <class InputIterator, class ForwardIterator>
+inline
+ForwardIterator __unique_copy(InputIterator first, InputIterator last,
+ ForwardIterator result, vcl_forward_iterator_tag) {
+ *result = *first;
+ while (++first != last)
+ if (*result != *first) *++result = *first;
+ return ++result;
+}
+
+template <class InputIterator, class BidirectionalIterator>
+inline BidirectionalIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ BidirectionalIterator result,
+ vcl_bidirectional_iterator_tag) {
+ return __unique_copy(first, last, result, vcl_forward_iterator_tag());
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result,
+ vcl_random_access_iterator_tag) {
+ return __unique_copy(first, last, result, vcl_forward_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator, class T>
+inline
+OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ *result = value;
+ while (++first != last)
+ if (value != *first) {
+ value = *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ vcl_output_iterator_tag) {
+ return __unique_copy(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator vcl_unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ return __unique_copy(first, last, result, iterator_category(result));
+}
+template <class InputIterator, class ForwardIterator, class BinaryPredicate>
+inline
+ForwardIterator __unique_copy(InputIterator first, InputIterator last,
+ ForwardIterator result,
+ BinaryPredicate binary_pred,
+ vcl_forward_iterator_tag) {
+ *result = *first;
+ while (++first != last)
+ if (!binary_pred(*result, *first)) *++result = *first;
+ return ++result;
+}
+
+template <class InputIterator, class BidirectionalIterator, class BinaryPredicate>
+inline BidirectionalIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ BidirectionalIterator result,
+ BinaryPredicate binary_pred,
+ vcl_bidirectional_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred,
+ vcl_forward_iterator_tag());
+}
+
+template <class InputIterator, class RandomAccessIterator, class BinaryPredicate>
+inline RandomAccessIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result,
+ BinaryPredicate binary_pred,
+ vcl_random_access_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred,
+ vcl_forward_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate, class T>
+inline
+OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred, T*) {
+ T value = *first;
+ *result = value;
+ while (++first != last)
+ if (!binary_pred(value, *first)) {
+ value = *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate>
+inline OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred,
+ vcl_output_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate>
+inline OutputIterator vcl_unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ return __unique_copy(first, last, result, binary_pred,
+ iterator_category(result));
+}
+
+template <class ForwardIterator>
+inline
+ForwardIterator vcl_unique(ForwardIterator first, ForwardIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ first = vcl_adjacent_find(first, last);
+ return vcl_unique_copy(first, last, first);
+}
+
+template <class ForwardIterator, class BinaryPredicate>
+inline
+ForwardIterator vcl_unique(ForwardIterator first, ForwardIterator last,
+ BinaryPredicate binary_pred) {
+ __stl_debug_check(__check_range(first, last));
+ first = vcl_adjacent_find(first, last, binary_pred);
+ return vcl_unique_copy(first, last, first, binary_pred);
+}
+
+template <class BidirectionalIterator>
+inline
+void __reverse(BidirectionalIterator first, BidirectionalIterator last,
+ vcl_bidirectional_iterator_tag) {
+ while (true)
+ if (first == last || first == --last)
+ return;
+ else {
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+template <class RandomAccessIterator>
+inline
+void __reverse(RandomAccessIterator first, RandomAccessIterator last,
+ vcl_random_access_iterator_tag) {
+ for (; first < last; ++first) iter_swap(first, --last);
+}
+
+template <class BidirectionalIterator>
+inline void vcl_reverse(BidirectionalIterator first, BidirectionalIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ __reverse(first, last, iterator_category(first));
+}
+
+template <class BidirectionalIterator, class OutputIterator>
+INLINE_LOOP OutputIterator vcl_reverse_copy(BidirectionalIterator first,
+ BidirectionalIterator last,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++result) *result = *--last;
+ return result;
+}
+
+template <class ForwardIterator, class Distance>
+inline
+void __rotate(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last, Distance*, vcl_forward_iterator_tag) {
+ for (ForwardIterator i = middle; true; ) {
+ iter_swap(first, i);
+ ++first;
+ ++i;
+ if (first == middle) {
+ if (i == last) return;
+ middle = i;
+ } else if (i == last)
+ i = middle;
+ }
+}
+
+template <class BidirectionalIterator, class Distance>
+inline
+void __rotate(BidirectionalIterator first, BidirectionalIterator middle,
+ BidirectionalIterator last, Distance*,
+ vcl_bidirectional_iterator_tag) {
+ vcl_reverse(first, middle);
+ vcl_reverse(middle, last);
+ vcl_reverse(first, last);
+}
+
+template <class EuclideanRingElement>
+inline
+EuclideanRingElement __gcd(EuclideanRingElement m, EuclideanRingElement n)
+{
+ while (n != 0) {
+ EuclideanRingElement t = m % n;
+ m = n;
+ n = t;
+ }
+ return m;
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline
+void __rotate_cycle(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator initial, Distance shift, T*) {
+ T value = *initial;
+ RandomAccessIterator ptr1 = initial;
+ RandomAccessIterator ptr2 = ptr1 + shift;
+ while (ptr2 != initial) {
+ *ptr1 = *ptr2;
+ ptr1 = ptr2;
+ if (last - ptr2 > shift)
+ ptr2 += shift;
+ else
+ ptr2 = first + (shift - (last - ptr2));
+ }
+ *ptr1 = value;
+}
+
+template <class RandomAccessIterator, class Distance>
+INLINE_LOOP void __rotate(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, Distance*,
+ vcl_random_access_iterator_tag) {
+ Distance n = __gcd(last - first, middle - first);
+ while (n--)
+ __rotate_cycle(first, last, first + n, middle - first,
+ value_type(first));
+}
+
+template <class ForwardIterator>
+inline void vcl_rotate(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last) {
+ __stl_debug_check(__check_range(middle,first, last));
+ if (first == middle || middle == last) return;
+ __rotate(first, middle, last, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class OutputIterator>
+inline
+OutputIterator vcl_rotate_copy(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last, OutputIterator result) {
+ __stl_debug_check(__check_range(middle, first, last));
+ return vcl_copy(first, middle, vcl_copy(middle, last, result));
+}
+
+template <class RandomAccessIterator, class Distance>
+inline
+void __random_shuffle(RandomAccessIterator first, RandomAccessIterator last,
+ Distance*) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ iter_swap(i, first + Distance(__rand() % ((i - first) + 1)));
+}
+
+template <class RandomAccessIterator>
+inline void vcl_random_shuffle(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ __random_shuffle(first, last, distance_type(first));
+}
+
+template <class RandomAccessIterator, class RandomNumberGenerator>
+inline
+void vcl_random_shuffle(RandomAccessIterator first, RandomAccessIterator last,
+ RandomNumberGenerator& rand) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ iter_swap(i, first + rand((i - first) + 1));
+}
+
+template <class ForwardIterator, class OutputIterator, class Distance>
+inline
+OutputIterator vcl_random_sample_n(ForwardIterator first, ForwardIterator last,
+ OutputIterator out, const Distance n)
+{
+ __stl_debug_check(__check_range(first, last));
+ Distance remaining = 0;
+ vcl_distance(first, last, remaining);
+ Distance m = vcl_min(n, remaining);
+
+ while (m > 0) {
+ if (__rand() % remaining < m) {
+ *out = *first;
+ ++out;
+ --m;
+ }
+
+ --remaining;
+ ++first;
+ }
+ return out;
+}
+
+template <class ForwardIterator, class OutputIterator, class Distance, class RandomNumberGenerator>
+inline
+OutputIterator vcl_random_sample_n(ForwardIterator first, ForwardIterator last,
+ OutputIterator out, const Distance n,
+ RandomNumberGenerator& rand)
+{
+ __stl_debug_check(__check_range(first, last));
+ Distance remaining = 0;
+ vcl_distance(first, last, remaining);
+ Distance m = vcl_min(n, remaining);
+
+ while (m > 0) {
+ if (rand(remaining) < m) {
+ *out = *first;
+ --m;
+ ++out;
+ }
+
+ --remaining;
+ ++first;
+ }
+ return out;
+}
+
+template <class InputIterator, class RandomAccessIterator, class Distance>
+inline
+RandomAccessIterator __random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out,
+ const Distance n)
+{
+ Distance m = 0;
+ Distance t = n;
+ for (; first != last && m < n; ++m,++first)
+ out[m] = *first;
+
+ while (first != last) {
+ ++t;
+ Distance M = __rand() % t;
+ if (M < n)
+ out[M] = *first;
+ ++first;
+ }
+
+ return out + m;
+}
+
+template <class InputIterator, class RandomAccessIterator, class RandomNumberGenerator, class Distance>
+inline
+RandomAccessIterator __random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out,
+ RandomNumberGenerator& rand,
+ const Distance n)
+{
+ Distance m = 0;
+ Distance t = n;
+ for (; first != last && m < n; ++m,++first)
+ out[m] = *first;
+
+ while (first != last) {
+ ++t;
+ Distance M = rand(t);
+ if (M < n)
+ out[M] = *first;
+ ++first;
+ }
+
+ return out + m;
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator
+vcl_random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out_first, RandomAccessIterator out_last)
+{
+ __stl_debug_check(__check_range(first, last));
+ return __random_sample(first, last, out_first, out_last - out_first);
+}
+
+template <class InputIterator, class RandomAccessIterator, class RandomNumberGenerator>
+inline RandomAccessIterator
+vcl_random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out_first, RandomAccessIterator out_last,
+ RandomNumberGenerator& rand)
+{
+ __stl_debug_check(__check_range(first, last));
+ return __random_sample(first, last, out_first, rand, out_last - out_first);
+}
+
+template <class BidirectionalIterator, class Predicate>
+inline
+BidirectionalIterator vcl_partition(BidirectionalIterator first,
+ BidirectionalIterator last, Predicate pred) {
+ __stl_debug_check(__check_range(first, last));
+ while (true) {
+ while (true)
+ if (first == last)
+ return first;
+ else if (pred(*first))
+ ++first;
+ else
+ break;
+ --last;
+ while (true)
+ if (first == last)
+ return first;
+ else if (!pred(*last))
+ --last;
+ else
+ break;
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+template <class ForwardIterator, class Predicate, class Distance>
+inline
+ForwardIterator __inplace_stable_partition(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, Distance len) {
+ if (len == 1) return pred(*first) ? last : first;
+ ForwardIterator middle = first;
+ vcl_advance(middle, len / 2);
+ ForwardIterator
+ first_cut = __inplace_stable_partition(first, middle, pred, len / 2);
+ ForwardIterator
+ second_cut = __inplace_stable_partition(middle, last, pred,
+ len - len / 2);
+ rotate(first_cut, middle, second_cut);
+ len = 0;
+ vcl_distance(middle, second_cut, len);
+ vcl_advance(first_cut, len);
+ return first_cut;
+}
+
+template <class ForwardIterator, class Predicate, class Distance, class T>
+inline
+ForwardIterator __stable_partition_adaptive(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, Distance len,
+ __stl_tempbuf<T,Distance>& buffer) {
+ typedef typename __stl_tempbuf<T,Distance>::pointer Pointer;
+ Distance fill_pointer = buffer.size();
+ if (len <= buffer.capacity()) {
+ len = 0;
+ ForwardIterator result1 = first;
+ Pointer result2 = buffer.begin();
+ for (; first != last && len < fill_pointer; ++first)
+ if (pred(*first)) {
+ *result1 = *first;
+ ++result1;
+ }
+ else {
+ *result2++ = *first;
+ ++len;
+ }
+ if (first != last) {
+ raw_storage_iterator<Pointer, T> result3(result2);
+ IUEg__TRY {
+ for (; first != last; ++first)
+ if (pred(*first)) {
+ *result1 = *first;
+ ++result1;
+ }
+ else {
+ *result3 = *first;
+ ++len;
+ ++result3;
+ }
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...) {
+ buffer.adjust_size(len);
+ throw;
+ }
+# endif
+ buffer.adjust_size(len);
+ }
+ vcl_copy(buffer.begin(), buffer.begin() + len, result1);
+ return result1;
+ }
+ ForwardIterator middle = first;
+ vcl_advance(middle, len / 2);
+ ForwardIterator first_cut = __stable_partition_adaptive
+ (first, middle, pred, len / 2, buffer);
+ ForwardIterator second_cut = __stable_partition_adaptive
+ (middle, last, pred, len - len / 2, buffer);
+ vcl_rotate(first_cut, middle, second_cut);
+ len = 0;
+ vcl_distance(middle, second_cut, len);
+ vcl_advance(first_cut, len);
+ return first_cut;
+}
+
+template <class ForwardIterator, class Predicate, class T, class Distance>
+inline
+ForwardIterator __stable_partition(ForwardIterator first, ForwardIterator last,
+ Predicate pred, Distance len,
+ __stl_tempbuf<T, Distance>& buffer) {
+ if ( buffer.capacity() >0 )
+ return __stable_partition_adaptive(first, last, pred, len, buffer);
+ else
+ return __inplace_stable_partition(first, last, pred, len);
+}
+
+template <class ForwardIterator, class Predicate, class Distance, class T>
+inline ForwardIterator __stable_partition_aux(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, Distance*, T*) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ __stl_tempbuf<T,Distance> buf(len);
+ return __stable_partition(first, last, pred, len, buf);
+}
+
+template <class ForwardIterator, class Predicate>
+inline ForwardIterator stable_partition(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred) {
+ __stl_debug_check(__check_range(first, last));
+ return __stable_partition_aux(first, last, pred, distance_type(first),value_type(first));
+}
+
+template <class RandomAccessIterator, class T>
+inline
+RandomAccessIterator __unguarded_partition(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T pivot) {
+ while (1) {
+ while (*first < pivot) {
+ ++first;
+ }
+ --last;
+ while (pivot < *last) --last;
+ if (!(first < last)) {
+ return first;
+ }
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline
+RandomAccessIterator __unguarded_partition(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T pivot, Compare comp) {
+ while (1) {
+ while (comp(*first, pivot)) ++first;
+ --last;
+ while (comp(pivot, *last)) --last;
+ if (!(first < last)) return first;
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+# define __stl_threshold 16
+
+template <class RandomAccessIterator, class T>
+inline
+void __unguarded_linear_insert(RandomAccessIterator last, T value) {
+ RandomAccessIterator next = last;
+ --next;
+ while (value < *next) {
+ *last = *next;
+ last = next;
+ --next;
+ }
+ *last = value;
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline
+void __unguarded_linear_insert(RandomAccessIterator last, T value,
+ Compare comp) {
+ RandomAccessIterator next = last;
+ --next;
+ while (comp(value , *next)) {
+ *last = *next;
+ last = next;
+ --next;
+ }
+ *last = value;
+}
+
+template <class RandomAccessIterator, class T>
+inline void __linear_insert(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ T value = *last;
+ if (value < *first) {
+ vcl_copy_backward(first, last, last + 1);
+ *first = value;
+ } else
+ __unguarded_linear_insert(last, value);
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline void __linear_insert(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Compare comp) {
+ T value = *last;
+ if (comp(value, *first)) {
+ vcl_copy_backward(first, last, last + 1);
+ *first = value;
+ } else
+ __unguarded_linear_insert(last, value, comp);
+}
+
+template <class RandomAccessIterator>
+inline
+void __insertion_sort(RandomAccessIterator first, RandomAccessIterator last) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ __linear_insert(first, i, value_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+inline
+void __insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ __linear_insert(first, i, value_type(first), comp);
+}
+
+template <class RandomAccessIterator, class T>
+inline
+void __unguarded_insertion_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ for (RandomAccessIterator i = first; i != last; ++i)
+ __unguarded_linear_insert(i, T(*i));
+}
+
+template <class RandomAccessIterator>
+inline void __unguarded_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __unguarded_insertion_sort_aux(first, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline
+void __unguarded_insertion_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T*, Compare comp) {
+ for (RandomAccessIterator i = first; i != last; ++i)
+ __unguarded_linear_insert(i, T(*i), comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void __unguarded_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ Compare comp) {
+ __unguarded_insertion_sort_aux(first, last, value_type(first), comp);
+}
+
+template <class RandomAccessIterator>
+inline
+void __final_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ if (last - first > __stl_threshold) {
+ __insertion_sort(first, first + __stl_threshold);
+ __unguarded_insertion_sort(first + __stl_threshold, last);
+ } else
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline
+void __final_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (last - first > __stl_threshold) {
+ __insertion_sort(first, first + __stl_threshold, comp);
+ __unguarded_insertion_sort(first + __stl_threshold, last, comp);
+ } else
+ __insertion_sort(first, last, comp);
+}
+
+template <class Size>
+inline
+Size __lg(Size n) {
+ Size k;
+ for (k = 0; n != 1; n = n / 2) ++k;
+ return k;
+}
+
+template <class RandomAccessIterator, class T, class Size>
+inline
+void __introsort_loop(RandomAccessIterator first,
+ RandomAccessIterator last, T*,
+ Size depth_limit) {
+ while (last - first > __stl_threshold) {
+ if (depth_limit == 0) {
+ vcl_partial_sort(first, last, last);
+ return;
+ }
+ --depth_limit;
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1))));
+ __introsort_loop(cut, last, value_type(first), depth_limit);
+ last = cut;
+ }
+}
+
+template <class RandomAccessIterator, class T, class Size, class Compare>
+inline
+void __introsort_loop(RandomAccessIterator first,
+ RandomAccessIterator last, T*,
+ Size depth_limit, Compare comp) {
+ while (last - first > __stl_threshold) {
+ if (depth_limit == 0) {
+ vcl_partial_sort(first, last, last, comp);
+ return;
+ }
+ --depth_limit;
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1), comp)), comp);
+ __introsort_loop(cut, last, value_type(first), depth_limit, comp);
+ last = cut;
+ }
+}
+
+template <class RandomAccessIterator>
+inline void vcl_sort(RandomAccessIterator first, RandomAccessIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first==last) return;
+ __introsort_loop(first, last, value_type(first), __lg(last - first) * 2);
+ __final_insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_sort(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return;
+ __introsort_loop(first, last, value_type(first), __lg(last - first) * 2, comp);
+ __final_insertion_sort(first, last, comp);
+}
+
+
+template <class RandomAccessIterator>
+inline
+void __inplace_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ if (last - first < 15) {
+ __insertion_sort(first, last);
+ return;
+ }
+ RandomAccessIterator middle = first + (last - first) / 2;
+ __inplace_stable_sort(first, middle);
+ __inplace_stable_sort(middle, last);
+ __merge_without_buffer(first, middle, last, middle - first, last - middle);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline
+void __inplace_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (last - first < 15) {
+ __insertion_sort(first, last, comp);
+ return;
+ }
+ RandomAccessIterator middle = first + (last - first) / 2;
+ __inplace_stable_sort(first, middle, comp);
+ __inplace_stable_sort(middle, last, comp);
+ __merge_without_buffer(first, middle, last, middle - first,
+ last - middle, comp);
+}
+
+template <class RandomAccessIterator1, class RandomAccessIterator2, class Distance>
+inline
+void __merge_sort_loop(RandomAccessIterator1 first,
+ RandomAccessIterator1 last,
+ RandomAccessIterator2 result, Distance step_size) {
+ Distance two_step = 2 * step_size;
+
+ while (last - first >= two_step) {
+ result = merge(first, first + step_size,
+ first + step_size, first + two_step, result);
+ first += two_step;
+ }
+ Distance len(last-first); // VC++ temporary ref warning
+ step_size = vcl_min(len, step_size);
+ merge(first, first + step_size, first + step_size, last, result);
+}
+
+template <class RandomAccessIterator1, class RandomAccessIterator2, class Distance, class Compare>
+inline
+void __merge_sort_loop(RandomAccessIterator1 first,
+ RandomAccessIterator1 last,
+ RandomAccessIterator2 result, Distance step_size,
+ Compare comp) {
+ Distance two_step = 2 * step_size;
+
+ while (last - first >= two_step) {
+ result = merge(first, first + step_size,
+ first + step_size, first + two_step, result, comp);
+ first += two_step;
+ }
+ Distance len(last-first); // VC++ temporary ref warning
+ step_size = vcl_min(len, step_size);
+
+ merge(first, first + step_size, first + step_size, last, result, comp);
+}
+
+const int __stl_chunk_size = 7;
+
+template <class RandomAccessIterator, class Distance>
+inline
+void __chunk_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Distance chunk_size) {
+ while (last - first >= chunk_size) {
+ __insertion_sort(first, first + chunk_size);
+ first += chunk_size;
+ }
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator, class Distance, class Compare>
+inline
+void __chunk_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ Distance chunk_size, Compare comp) {
+ while (last - first >= chunk_size) {
+ __insertion_sort(first, first + chunk_size, comp);
+ first += chunk_size;
+ }
+ __insertion_sort(first, last, comp);
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline
+void __merge_sort_with_buffer(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T, Distance>& buffer) {
+ typedef typename __stl_tempbuf<T,Distance>::pointer Pointer;
+ Distance len = last - first;
+ Pointer buffer_last = buffer.begin() + len;
+
+ Distance step_size = __stl_chunk_size;
+ __chunk_insertion_sort(first, last, step_size);
+
+ while (step_size < len) {
+ __merge_sort_loop(first, last, buffer.begin(), step_size);
+ step_size *= 2;
+ __merge_sort_loop(buffer.begin(), buffer_last, first, step_size);
+ step_size *= 2;
+ }
+}
+
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+inline
+void __merge_sort_with_buffer(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T, Distance>& buffer,
+ Compare comp) {
+ typedef typename __stl_tempbuf<T,Distance>::pointer Pointer;
+ Distance len = last - first;
+ Pointer buffer_last = buffer.begin() + len;
+
+ Distance step_size = __stl_chunk_size;
+ __chunk_insertion_sort(first, last, step_size, comp);
+
+ while (step_size < len) {
+ __merge_sort_loop(first, last, buffer.begin(), step_size, comp);
+ step_size *= 2;
+ __merge_sort_loop(buffer.begin(), buffer_last, first, step_size, comp);
+ step_size *= 2;
+ }
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline
+void __stable_sort_adaptive(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T,Distance>& buffer) {
+ Distance len = (last - first + 1) / 2;
+ RandomAccessIterator middle = first + len;
+ if (len > buffer.capacity()) {
+ __stable_sort_adaptive(first, middle, buffer);
+ __stable_sort_adaptive(middle, last, buffer);
+ } else {
+ __merge_sort_with_buffer(first, middle, buffer);
+ __merge_sort_with_buffer(middle, last, buffer);
+ }
+ __merge_adaptive(first, middle, last, Distance(middle - first),
+ Distance(last - middle), buffer);
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+inline
+void __stable_sort_adaptive(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T,Distance>& buffer,
+ Compare comp) {
+ Distance len = (last - first + 1) / 2;
+ RandomAccessIterator middle = first + len;
+ if (len > buffer.capacity()) {
+ __stable_sort_adaptive(first, middle, buffer, comp);
+ __stable_sort_adaptive(middle, last, buffer, comp);
+ } else {
+ __merge_sort_with_buffer(first, middle, buffer, comp);
+ __merge_sort_with_buffer(middle, last, buffer, comp);
+ }
+ __merge_adaptive(first, middle, last, Distance(middle - first),
+ Distance(last - middle), buffer, comp);
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline void __stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T,Distance>& buffer) {
+ if (buffer.capacity() == 0) {
+ __inplace_stable_sort(first, last);
+ }
+ else {
+ Distance len(last-first); // VC++ temporary ref warning
+ len = vcl_min(buffer.capacity(), len);
+ vcl_uninitialized_copy(first, first + len, buffer.begin());
+ buffer.adjust_size(len);
+ __stable_sort_adaptive(first, last, buffer);
+ }
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+inline void __stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ __stl_tempbuf<T,Distance>& buffer, Compare comp) {
+ if (buffer.capacity() == 0) {
+ __inplace_stable_sort(first, last, comp);
+ }
+ else {
+ Distance len(last-first); // VC++ temporary ref warning
+ len = vcl_min(buffer.capacity(), len);
+ vcl_uninitialized_copy(first, first + len, buffer.begin());
+ buffer.adjust_size(len);
+ __stable_sort_adaptive(first, last, buffer, comp);
+ }
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline void __stable_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Distance*) {
+ __stl_tempbuf<T,Distance> buffer(Distance(last - first));
+ __stable_sort(first, last, buffer);
+}
+
+template <class RandomAccessIterator, class T, class Distance, class Compare>
+inline void __stable_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Distance*,
+ Compare comp) {
+ __stl_tempbuf<T,Distance> buffer(Distance(last - first));
+ __stable_sort(first, last, buffer,comp);
+}
+
+template <class RandomAccessIterator>
+inline void vcl_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ __stable_sort_aux(first, last, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ __stable_sort_aux(first, last, value_type(first), distance_type(first),
+ comp);
+}
+
+template <class RandomAccessIterator, class T>
+inline
+void __partial_sort(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, T*) {
+ vcl_make_heap(first, middle);
+ for (RandomAccessIterator i = middle; i < last; ++i)
+ if (*i < *first)
+ __pop_heap(first, middle, i, T(*i), distance_type(first));
+ sort_heap(first, middle);
+}
+
+template <class RandomAccessIterator>
+inline void vcl_partial_sort(RandomAccessIterator first,
+ RandomAccessIterator middle,
+ RandomAccessIterator last) {
+ __stl_debug_check(__check_range(middle,first, last));
+ __partial_sort(first, middle, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline
+void __partial_sort(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, T*, Compare comp) {
+ vcl_make_heap(first, middle, comp);
+ for (RandomAccessIterator i = middle; i < last; ++i)
+ if (comp(*i, *first))
+ __pop_heap(first, middle, i, T(*i), comp, distance_type(first));
+ sort_heap(first, middle, comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_partial_sort(RandomAccessIterator first,
+ RandomAccessIterator middle,
+ RandomAccessIterator last, Compare comp) {
+ __stl_debug_check(__check_range(middle,first, last));
+ __partial_sort(first, middle, last, value_type(first), comp);
+}
+
+template <class InputIterator, class RandomAccessIterator, class Distance, class T>
+inline
+RandomAccessIterator __partial_sort_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last,
+ Distance*, T*) {
+ if (result_first == result_last) return result_last;
+ RandomAccessIterator result_real_last = result_first;
+ for (; first != last && result_real_last != result_last; ++result_real_last,++first)
+ *result_real_last = *first;
+ vcl_make_heap(result_first, result_real_last);
+ while (first != last) {
+ if (*first < *result_first)
+ __adjust_heap(result_first, Distance(0),
+ Distance(result_real_last - result_first), T(*first));
+ ++first;
+ }
+ vcl_sort_heap(result_first, result_real_last);
+ return result_real_last;
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator
+vcl_partial_sort_copy(InputIterator first, InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last) {
+ __stl_debug_check(__check_range(first, last));
+ __stl_debug_check(__check_range(result_first, result_last));
+ return __partial_sort_copy(first, last, result_first, result_last,
+ distance_type(result_first), value_type(first));
+}
+
+template <class InputIterator, class RandomAccessIterator, class Compare, class Distance, class T>
+inline
+RandomAccessIterator __partial_sort_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last,
+ Compare comp, Distance*, T*) {
+ if (result_first == result_last) return result_last;
+ RandomAccessIterator result_real_last = result_first;
+ for (; first != last && result_real_last != result_last; ++result_real_last,++first)
+ *result_real_last = *first;
+ vcl_make_heap(result_first, result_real_last, comp);
+ while (first != last) {
+ if (comp(*first, *result_first))
+ __adjust_heap(result_first, Distance(0),
+ Distance(result_real_last - result_first), T(*first),
+ comp);
+ ++first;
+ }
+ vcl_sort_heap(result_first, result_real_last, comp);
+ return result_real_last;
+}
+
+template <class InputIterator, class RandomAccessIterator, class Compare>
+inline RandomAccessIterator
+vcl_partial_sort_copy(InputIterator first, InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last, Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ __stl_debug_check(__check_range(result_first, result_last));
+ return __partial_sort_copy(first, last, result_first, result_last, comp,
+ distance_type(result_first), value_type(first));
+}
+
+template <class RandomAccessIterator, class T>
+inline
+void __nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, T*) {
+ while (last - first > 3) {
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1))));
+ if (cut <= nth)
+ first = cut;
+ else
+ last = cut;
+ }
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator>
+inline void vcl_nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last) {
+ __stl_debug_check(__check_range(nth,first, last));
+ __nth_element(first, nth, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline
+void __nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, T*, Compare comp) {
+ while (last - first > 3) {
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1), comp)), comp);
+ if (cut <= nth)
+ first = cut;
+ else
+ last = cut;
+ }
+ __insertion_sort(first, last, comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, Compare comp) {
+ __stl_debug_check(__check_range(nth, first, last));
+ __nth_element(first, nth, last, value_type(first), comp);
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline
+ForwardIterator __lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Distance*,
+ vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (*middle < value) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline ForwardIterator __lower_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Distance*,
+ vcl_bidirectional_iterator_tag) {
+ return __lower_bound(first, last, value, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline
+RandomAccessIterator __lower_bound(RandomAccessIterator first,
+ RandomAccessIterator last, const T& value,
+ Distance*, vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (*middle < value) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T>
+inline ForwardIterator vcl_lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ return __lower_bound(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline
+ForwardIterator __lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (comp(*middle, value)) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline ForwardIterator __lower_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_bidirectional_iterator_tag) {
+ return __lower_bound(first, last, value, comp, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+inline
+RandomAccessIterator __lower_bound(RandomAccessIterator first,
+ RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(*middle, value)) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline ForwardIterator vcl_lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ return __lower_bound(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline
+ForwardIterator __upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Distance*,
+ vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (value < *middle)
+ len = half;
+ else {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline ForwardIterator __upper_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Distance*,
+ vcl_bidirectional_iterator_tag) {
+ return __upper_bound(first, last, value, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline
+RandomAccessIterator __upper_bound(RandomAccessIterator first,
+ RandomAccessIterator last, const T& value,
+ Distance*, vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (value < *middle)
+ len = half;
+ else {
+ first = middle + 1;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T>
+inline ForwardIterator vcl_upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ return __upper_bound(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline
+ForwardIterator __upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (comp(value, *middle))
+ len = half;
+ else {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline ForwardIterator __upper_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_bidirectional_iterator_tag) {
+ return __upper_bound(first, last, value, comp, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+inline
+RandomAccessIterator __upper_bound(RandomAccessIterator first,
+ RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(value, *middle))
+ len = half;
+ else {
+ first = middle + 1;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline ForwardIterator vcl_upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ return __upper_bound(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline
+vcl_pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Distance*, vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (*middle < value) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else if (value < *middle)
+ len = half;
+ else {
+ left = vcl_lower_bound(first, middle, value);
+ vcl_advance(first, len);
+ right = vcl_upper_bound(++middle, first, value);
+ return vcl_pair<ForwardIterator, ForwardIterator>(left, right);
+ }
+ }
+ return vcl_pair<ForwardIterator, ForwardIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline vcl_pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Distance*, vcl_bidirectional_iterator_tag) {
+ return __equal_range(first, last, value, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline
+vcl_pair<RandomAccessIterator, RandomAccessIterator>
+__equal_range(RandomAccessIterator first, RandomAccessIterator last,
+ const T& value, Distance*, vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (*middle < value) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else if (value < *middle)
+ len = half;
+ else {
+ left = vcl_lower_bound(first, middle, value);
+ right = vcl_upper_bound(++middle, first + len, value);
+ return vcl_pair<RandomAccessIterator, RandomAccessIterator>(left, right);
+ }
+ }
+ return vcl_pair<RandomAccessIterator, RandomAccessIterator>(first, first);
+}
+
+template <class ForwardIterator, class T>
+inline vcl_pair<ForwardIterator, ForwardIterator>
+vcl_equal_range(ForwardIterator first, ForwardIterator last, const T& value) {
+ __stl_debug_check(__check_range(first, last));
+ return __equal_range(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline
+vcl_pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp, Distance*, vcl_forward_iterator_tag) {
+ Distance len = 0;
+ vcl_distance(first, last, len);
+ Distance half;
+ ForwardIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ vcl_advance(middle, half);
+ if (comp(*middle, value)) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else if (comp(value, *middle))
+ len = half;
+ else {
+ left = vcl_lower_bound(first, middle, value, comp);
+ vcl_advance(first, len);
+ right = vcl_upper_bound(++middle, first, value, comp);
+ return vcl_pair<ForwardIterator, ForwardIterator>(left, right);
+ }
+ }
+ return vcl_pair<ForwardIterator, ForwardIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline vcl_pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp, Distance*, vcl_bidirectional_iterator_tag) {
+ return __equal_range(first, last, value, comp, (Distance*)0,
+ vcl_forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+inline
+vcl_pair<RandomAccessIterator, RandomAccessIterator>
+__equal_range(RandomAccessIterator first, RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ vcl_random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(*middle, value)) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else if (comp(value, *middle))
+ len = half;
+ else {
+ left = vcl_lower_bound(first, middle, value, comp);
+ right = vcl_upper_bound(++middle, first + len, value, comp);
+ return vcl_pair<RandomAccessIterator, RandomAccessIterator>(left, right);
+ }
+ }
+ return vcl_pair<RandomAccessIterator, RandomAccessIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline vcl_pair<ForwardIterator, ForwardIterator>
+vcl_equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ return __equal_range(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T>
+inline
+bool vcl_binary_search(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ ForwardIterator i = vcl_lower_bound(first, last, value);
+ return i != last && !(value < *i);
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline
+bool vcl_binary_search(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp) {
+ ForwardIterator i = vcl_lower_bound(first, last, value, comp);
+ return i != last && !comp(value, *i);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+inline
+OutputIterator vcl_merge(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ for (; first1 != last1 && first2 != last2; ++result)
+ if (*first2 < *first1)
+ *result = *first2++;
+ else
+ *result = *first1++;
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class Compare>
+inline
+OutputIterator vcl_merge(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ for (; first1 != last1 && first2 != last2; ++result)
+ if (comp(*first2, *first1))
+ *result = *first2++;
+ else
+ *result = *first1++;
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class BidirectionalIterator, class Distance>
+inline
+void __merge_without_buffer(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last,
+ Distance len1, Distance len2) {
+ if (len1 == 0 || len2 == 0) return;
+ if (len1 + len2 == 2) {
+ if (*middle < *first) iter_swap(first, middle);
+ return;
+ }
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ vcl_advance(first_cut, len11);
+ second_cut = vcl_lower_bound(middle, last, *first_cut);
+ vcl_distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ vcl_advance(second_cut, len22);
+ first_cut = vcl_upper_bound(first, middle, *second_cut);
+ vcl_distance(first, first_cut, len11);
+ }
+ vcl_rotate(first_cut, middle, second_cut);
+ BidirectionalIterator new_middle = first_cut;
+ vcl_advance(new_middle, len22);
+ __merge_without_buffer(first, first_cut, new_middle, len11, len22);
+ __merge_without_buffer(new_middle, second_cut, last, len1 - len11,
+ len2 - len22);
+}
+
+template <class BidirectionalIterator, class Distance, class Compare>
+inline
+void __merge_without_buffer(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last,
+ Distance len1, Distance len2, Compare comp) {
+ if (len1 == 0 || len2 == 0) return;
+ if (len1 + len2 == 2) {
+ if (comp(*middle, *first)) iter_swap(first, middle);
+ return;
+ }
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ vcl_advance(first_cut, len11);
+ second_cut = vcl_lower_bound(middle, last, *first_cut, comp);
+ vcl_distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ vcl_advance(second_cut, len22);
+ first_cut = vcl_upper_bound(first, middle, *second_cut, comp);
+ vcl_distance(first, first_cut, len11);
+ }
+ vcl_rotate(first_cut, middle, second_cut);
+ BidirectionalIterator new_middle = first_cut;
+ vcl_advance(new_middle, len22);
+ __merge_without_buffer(first, first_cut, new_middle, len11, len22, comp);
+ __merge_without_buffer(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, comp);
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2, class Distance>
+inline
+BidirectionalIterator1 __rotate_adaptive(BidirectionalIterator1 first,
+ BidirectionalIterator1 middle,
+ BidirectionalIterator1 last,
+ Distance len1, Distance len2,
+ BidirectionalIterator2 buffer,
+ Distance buffer_size) {
+ BidirectionalIterator2 buffer_end;
+ if (len1 > len2 && len2 <= buffer_size) {
+ buffer_end = vcl_copy(middle, last, buffer);
+ vcl_copy_backward(first, middle, last);
+ return vcl_copy(buffer, buffer_end, first);
+ } else if (len1 <= buffer_size) {
+ buffer_end = vcl_copy(first, middle, buffer);
+ vcl_copy(middle, last, first);
+ return vcl_copy_backward(buffer, buffer_end, last);
+ } else {
+ vcl_rotate(first, middle, last);
+ vcl_advance(first, len2);
+ return first;
+ }
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2, class BidirectionalIterator3>
+inline
+BidirectionalIterator3 __merge_backward(BidirectionalIterator1 first1,
+ BidirectionalIterator1 last1,
+ BidirectionalIterator2 first2,
+ BidirectionalIterator2 last2,
+ BidirectionalIterator3 result) {
+ if (first1 == last1) return vcl_copy_backward(first2, last2, result);
+ if (first2 == last2) return vcl_copy_backward(first1, last1, result);
+ --last1;
+ --last2;
+ while (true) {
+ if (*last2 < *last1) {
+ *--result = *last1;
+ if (first1 == last1) return vcl_copy_backward(first2, ++last2, result);
+ --last1;
+ } else {
+ *--result = *last2;
+ if (first2 == last2) return vcl_copy_backward(first1, ++last1, result);
+ --last2;
+ }
+ }
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2, class BidirectionalIterator3, class Compare>
+inline
+BidirectionalIterator3 __merge_backward(BidirectionalIterator1 first1,
+ BidirectionalIterator1 last1,
+ BidirectionalIterator2 first2,
+ BidirectionalIterator2 last2,
+ BidirectionalIterator3 result,
+ Compare comp) {
+ if (first1 == last1) return vcl_copy_backward(first2, last2, result);
+ if (first2 == last2) return vcl_copy_backward(first1, last1, result);
+ --last1;
+ --last2;
+ while (true) {
+ if (comp(*last2, *last1)) {
+ *--result = *last1;
+ if (first1 == last1) return vcl_copy_backward(first2, ++last2, result);
+ --last1;
+ } else {
+ *--result = *last2;
+ if (first2 == last2) return vcl_copy_backward(first1, ++last1, result);
+ --last2;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class T>
+inline
+void __merge_adaptive(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ __stl_tempbuf<T,Distance>& buffer) {
+ typedef typename __stl_tempbuf<T,Distance>::pointer Pointer;
+ if (len1 <= len2 && len1 <= buffer.capacity()) {
+ Pointer end_buffer = vcl_copy(first, middle, buffer.begin());
+ merge(buffer.begin(), end_buffer, middle, last, first);
+ } else if (len2 <= buffer.capacity()) {
+ Pointer end_buffer = vcl_copy(middle, last, buffer.begin());
+ __merge_backward(first, middle, buffer.begin(), end_buffer, last);
+ } else {
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ vcl_advance(first_cut, len11);
+ second_cut = vcl_lower_bound(middle, last, *first_cut);
+ vcl_distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ vcl_advance(second_cut, len22);
+ first_cut = vcl_upper_bound(first, middle, *second_cut);
+ vcl_distance(first, first_cut, len11);
+ }
+ BidirectionalIterator new_middle =
+ __rotate_adaptive(first_cut, middle, second_cut, len1 - len11,
+ len22, buffer.begin(), buffer.capacity());
+ __merge_adaptive(first, first_cut, new_middle, len11, len22, buffer);
+ __merge_adaptive(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, buffer);
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class T, class Compare>
+inline
+void __merge_adaptive(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ __stl_tempbuf<T,Distance>& buffer, Compare comp) {
+ typedef typename __stl_tempbuf<T,Distance>::pointer Pointer;
+ if (len1 <= len2 && len1 <= buffer.capacity()) {
+ Pointer end_buffer = vcl_copy(first, middle, buffer.begin());
+ merge(buffer.begin(), end_buffer, middle, last, first, comp);
+ } else if (len2 <= buffer.capacity()) {
+ Pointer end_buffer = vcl_copy(middle, last, buffer.begin());
+ __merge_backward(first, middle, buffer.begin(), end_buffer, last, comp);
+ } else {
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ vcl_advance(first_cut, len11);
+ second_cut = vcl_lower_bound(middle, last, *first_cut, comp);
+ vcl_distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ vcl_advance(second_cut, len22);
+ first_cut = vcl_upper_bound(first, middle, *second_cut, comp);
+ vcl_distance(first, first_cut, len11);
+ }
+ BidirectionalIterator new_middle =
+ __rotate_adaptive(first_cut, middle, second_cut, len1 - len11,
+ len22, buffer.begin(), buffer.capacity());
+ __merge_adaptive(first, first_cut, new_middle, len11, len22, buffer,comp);
+ __merge_adaptive(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, buffer, comp);
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class T>
+inline
+void __inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ __stl_tempbuf<T,Distance>& buffer) {
+ if (buffer.capacity() == 0) {
+ __merge_without_buffer(first, middle, last, len1, len2);
+ }
+ else {
+ Distance len(len1+len2); // VC++ temporary ref warning
+ len = vcl_min(buffer.capacity(), len);
+ __default_initialize_n(buffer.begin(), len);
+// vcl_uninitialized_fill_n(buffer.begin(), len, *first);
+ buffer.adjust_size(len);
+ __merge_adaptive(first, middle, last, len1, len2, buffer);
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class T, class Compare>
+inline
+void __inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ __stl_tempbuf<T,Distance>& buffer, Compare comp) {
+ if (buffer.capacity() == 0) {
+ __merge_without_buffer(first, middle, last, len1, len2, comp);
+ }
+ else {
+ Distance len(len1+len2);
+ len = vcl_min(buffer.capacity(), len);
+ __default_initialize_n(buffer.begin(), len);
+// vcl_uninitialized_fill_n(buffer.begin(), len, *first);
+ buffer.adjust_size(len);
+ __merge_adaptive(first, middle, last, len1, len2, buffer,comp);
+ }
+}
+
+template <class BidirectionalIterator, class T, class Distance>
+inline void __inplace_merge_aux(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, T*, Distance*) {
+ Distance len1 = 0;
+ vcl_distance(first, middle, len1);
+ Distance len2 = 0;
+ vcl_distance(middle, last, len2);
+ __stl_tempbuf<T,Distance> buf(len1 + len2);
+ __inplace_merge(first, middle, last, len1, len2, buf);
+}
+
+template <class BidirectionalIterator, class T, class Distance, class Compare>
+inline void __inplace_merge_aux(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, T*, Distance*,
+ Compare comp) {
+ Distance len1 = 0;
+ vcl_distance(first, middle, len1);
+ Distance len2 = 0;
+ vcl_distance(middle, last, len2);
+ __stl_tempbuf<T,Distance> buf(len1 + len2);
+ __inplace_merge(first, middle, last, len1, len2, buf, comp);
+}
+
+template <class BidirectionalIterator>
+inline void inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last) {
+ __stl_debug_check(__check_range(middle, first, last));
+ if (first == middle || middle == last) return;
+ __inplace_merge_aux(first, middle, last, value_type(first),
+ distance_type(first));
+}
+
+template <class BidirectionalIterator, class Compare>
+inline void inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Compare comp) {
+ __stl_debug_check(__check_range(middle, first, last));
+ if (first == middle || middle == last) return;
+ __inplace_merge_aux(first, middle, last, value_type(first),
+ distance_type(first), comp);
+}
+
+template <class InputIterator1, class InputIterator2>
+inline
+bool includes(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (*first2 < *first1)
+ return false;
+ else if (*first1 < *first2)
+ ++first1;
+ else
+ ++first1, ++first2;
+
+ return first2 == last2;
+}
+
+template <class InputIterator1, class InputIterator2, class Compare>
+inline
+bool includes(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first2, *first1))
+ return false;
+ else if (comp(*first1, *first2))
+ ++first1;
+ else
+ ++first1, ++first2;
+
+ return first2 == last2;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+inline
+OutputIterator set_union(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+// __stl_debug_check(__check_not_range(result,first1, last1));
+ for (; first1 != last1 && first2 != last2; ++result)
+ if (*first1 < *first2) {
+ *result = *first1; ++first1;
+ }
+ else if (*first2 < *first1) {
+ *result = *first2; ++first2;
+ }
+ else {
+ *result = *first1++;
+ ++first2;
+ }
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class Compare>
+inline
+OutputIterator set_union(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ for (; first1 != last1 && first2 != last2; ++result)
+ if (comp(*first1, *first2)) {
+ *result = *first1; ++first1;
+ }
+ else if (comp(*first2, *first1)) {
+ *result = *first2; ++first2;
+ }
+ else {
+ *result = *first1;
+ ++first1;
+ ++first2;
+ }
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+inline
+OutputIterator set_intersection(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2)
+ ++first1;
+ else if (*first2 < *first1)
+ ++first2;
+ else {
+ *result = *first1;
+ ++result;
+ ++first1;
+ ++first2;
+ }
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class Compare>
+inline
+OutputIterator set_intersection(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2))
+ ++first1;
+ else if (comp(*first2, *first1))
+ ++first2;
+ else {
+ *result = *first1;
+ ++first2;
+ ++result;
+ ++first1;
+ }
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+inline
+OutputIterator set_difference(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2) {
+ *result = *first1;
+ ++result;
+ ++first1;
+ }
+ else if (*first2 < *first1)
+ ++first2;
+ else {
+ ++first1;
+ ++first2;
+ }
+ return vcl_copy(first1, last1, result);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class Compare>
+inline
+OutputIterator set_difference(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2)) {
+ *result = *first1;
+ ++result;
+ ++first1;
+ }
+ else if (comp(*first2, *first1))
+ ++first2;
+ else {
+ ++first1;
+ ++first2;
+ }
+ return vcl_copy(first1, last1, result);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+inline
+OutputIterator set_symmetric_difference(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ InputIterator2 last2,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2) {
+ *result = *first1;
+ ++result;
+ ++first1;
+ }
+ else if (*first2 < *first1) {
+ *result = *first2;
+ ++result;
+ ++first2;
+ }
+ else {
+ ++first1;
+ ++first2;
+ }
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator, class Compare>
+inline
+OutputIterator set_symmetric_difference(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ __stl_debug_check(__check_range(first1, last1));
+ __stl_debug_check(__check_range(first2, last2));
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2)) {
+ *result = *first1;
+ ++result;
+ ++first1;
+ }
+ else if (comp(*first2, *first1)) {
+ *result = *first2;
+ ++result;
+ ++first2;
+ }
+ else {
+ ++first1;
+ ++first2;
+ }
+ return vcl_copy(first2, last2, vcl_copy(first1, last1, result));
+}
+
+template <class ForwardIterator>
+inline
+ForwardIterator vcl_max_element(ForwardIterator first, ForwardIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (*result < *first) result = first;
+ return result;
+}
+
+template <class ForwardIterator, class Compare>
+inline
+ForwardIterator vcl_max_element(ForwardIterator first, ForwardIterator last,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (comp(*result, *first)) result = first;
+ return result;
+}
+
+template <class ForwardIterator>
+inline
+ForwardIterator min_element(ForwardIterator first, ForwardIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (*first < *result) result = first;
+ return result;
+}
+
+template <class ForwardIterator, class Compare>
+inline
+ForwardIterator min_element(ForwardIterator first, ForwardIterator last,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (comp(*first, *result)) result = first;
+ return result;
+}
+
+template <class BidirectionalIterator>
+inline
+bool next_permutation(BidirectionalIterator first,
+ BidirectionalIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for (;;) {
+ BidirectionalIterator ii = i;
+ if (*--i < *ii) {
+ BidirectionalIterator j = last;
+ while (!(*i < *--j));
+ iter_swap(i, j);
+ vcl_reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ vcl_reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Compare>
+inline
+bool next_permutation(BidirectionalIterator first, BidirectionalIterator last,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for (;;) {
+ BidirectionalIterator ii = i;
+ if (comp(*--i, *ii)) {
+ BidirectionalIterator j = last;
+ while (!comp(*i, *--j));
+ iter_swap(i, j);
+ vcl_reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ vcl_reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator>
+inline
+bool prev_permutation(BidirectionalIterator first,
+ BidirectionalIterator last) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for (;;) {
+ BidirectionalIterator ii = i;
+ if (*ii < *--i) {
+ BidirectionalIterator j = last;
+ while (!(*--j < *i));
+ iter_swap(i, j);
+ vcl_reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ vcl_reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Compare>
+inline
+bool prev_permutation(BidirectionalIterator first, BidirectionalIterator last,
+ Compare comp) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for (;;) {
+ BidirectionalIterator ii = i;
+ if (comp(*ii, *--i)) {
+ BidirectionalIterator j = last;
+ while (!comp(*--j, *i));
+ iter_swap(i, j);
+ vcl_reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ vcl_reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class InputIterator, class T>
+inline
+T vcl_accumulate(InputIterator first, InputIterator last, T init) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first)
+ init = init + *first;
+ return init;
+}
+
+template <class InputIterator, class T, class BinaryOperation>
+inline
+T vcl_accumulate(InputIterator first, InputIterator last, T init,
+ BinaryOperation binary_op) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first)
+ init = binary_op(init, *first);
+ return init;
+}
+
+template <class InputIterator1, class InputIterator2, class T>
+inline
+T vcl_inner_product(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, T init) {
+ __stl_debug_check(__check_range(first1, last1));
+ for (; first1 != last1; ++first1,++first2)
+ init = init + (*first1 * *first2);
+ return init;
+}
+
+template <class InputIterator1, class InputIterator2, class T, class BinaryOperation1, class BinaryOperation2>
+inline
+T vcl_inner_product(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, T init, BinaryOperation1 binary_op1,
+ BinaryOperation2 binary_op2) {
+ __stl_debug_check(__check_range(first1, last1));
+ for (; first1 != last1; ++first1,++first2)
+ init = binary_op1(init, binary_op2(*first1, *first2));
+ return init;
+}
+
+template <class InputIterator, class OutputIterator, class T>
+INLINE_LOOP OutputIterator __partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ while (++first != last) {
+ value = value + *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline
+OutputIterator vcl_partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ *result = *first;
+ return __partial_sum(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class T, class BinaryOperation>
+INLINE_LOOP OutputIterator __partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, T*,
+ BinaryOperation binary_op) {
+ T value = *first;
+ while (++first != last) {
+ value = binary_op(value, *first);
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryOperation>
+inline
+OutputIterator vcl_partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, BinaryOperation binary_op) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ *result = *first;
+ return __partial_sum(first, last, result, value_type(first), binary_op);
+}
+
+template <class InputIterator, class OutputIterator, class T>
+INLINE_LOOP OutputIterator __adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ while (++first != last) {
+ T tmp = *first;
+ *++result = tmp - value;
+ value = tmp;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline
+OutputIterator vcl_adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ *result = *first;
+ return __adjacent_difference(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class T, class BinaryOperation>
+INLINE_LOOP OutputIterator __adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result, T*,
+ BinaryOperation binary_op) {
+ T value = *first;
+ while (++first != last) {
+ T tmp = *first;
+ *++result = binary_op(tmp, value);
+ value = tmp;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryOperation>
+inline
+OutputIterator vcl_adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryOperation binary_op) {
+ __stl_debug_check(__check_range(first, last));
+ if (first == last) return result;
+ *result = *first;
+ return __adjacent_difference(first, last, result, value_type(first),
+ binary_op);
+}
+
+template <class ForwardIterator, class T>
+inline
+void vcl_iota(ForwardIterator first, ForwardIterator last, T value) {
+ __stl_debug_check(__check_range(first, last));
+ for (; first != last; ++first,++value) *first = value;
+}
+
+template <class RandomAccessIterator, class Distance>
+inline
+bool __is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Distance*)
+{
+ const Distance n = last - first;
+
+ Distance parent = 0;
+ for (Distance child = 1; child < n; ++child) {
+ if (first[parent] < first[child])
+ return false;
+ if (child % 2 == 0)
+ ++parent;
+ }
+ return true;
+}
+
+template <class RandomAccessIterator>
+inline bool vcl_is_heap(RandomAccessIterator first, RandomAccessIterator last)
+{
+ __stl_debug_check(__check_range(first, last));
+ return __is_heap(first, last, distance_type(first));
+}
+
+
+template <class RandomAccessIterator, class Distance, class StrictWeakOrdering>
+inline
+bool __is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ StrictWeakOrdering comp,
+ Distance*)
+{
+ const Distance n = last - first;
+
+ Distance parent = 0;
+ for (Distance child = 1; child < n; ++child) {
+ if (comp(first[parent], first[child]))
+ return false;
+ if (child % 2 == 0)
+ ++parent;
+ }
+ return true;
+}
+
+template <class RandomAccessIterator, class StrictWeakOrdering>
+inline bool vcl_is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ StrictWeakOrdering comp)
+{
+ __stl_debug_check(__check_range(first, last));
+ return __is_heap(first, last, comp, distance_type(first));
+}
+
+
+template <class ForwardIterator>
+inline
+bool vcl_is_sorted(ForwardIterator first, ForwardIterator last)
+{
+ __stl_debug_check(__check_range(first, last));
+ if (first == last)
+ return true;
+
+ ForwardIterator next = first;
+ for (++next; next != last; first = next, ++next) {
+ if (*next < *first)
+ return false;
+ }
+
+ return true;
+}
+
+template <class ForwardIterator, class StrictWeakOrdering>
+inline
+bool vcl_is_sorted(ForwardIterator first, ForwardIterator last,
+ StrictWeakOrdering comp)
+{
+ __stl_debug_check(__check_range(first, last));
+ if (first == last)
+ return true;
+
+ ForwardIterator next = first;
+ for (++next; next != last; first = next, ++next) {
+ if (comp(*next, *first))
+ return false;
+ }
+
+ return true;
+}
+
+# undef __stl_threshold
+
+#endif // vcl_emulation_algorithm_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.txx
new file mode 100644
index 0000000000000000000000000000000000000000..d57c7534d5e14211079efd7d868aae1ac9d56abf
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_algorithm.txx
@@ -0,0 +1,47 @@
+#ifndef vcl_emulation_algorithm_txx_
+#define vcl_emulation_algorithm_txx_
+
+#include <vcl_algorithm.h>
+
+#undef VCL_SWAP_INSTANTIATE
+#define VCL_SWAP_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(void vcl_swap(T&, T&))
+
+#undef VCL_OPERATOR_NE_INSTANTIATE
+#define VCL_OPERATOR_NE_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(bool operator!=(T const&, T const &))
+
+#define VCL_CONTAINABLE_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(void vcl_construct(T *, T const &)); \
+VCL_INSTANTIATE_INLINE(void vcl_destroy(T *))
+//;VCL_SWAP_INSTANTIATE(T)
+
+//SGI CC does not allow explicit instantiation of inlines.
+//So use "VCL_INSTANTIATE_INLINE" instead of "template".
+#define VCL_FIND_INSTANTIATE(I, T) \
+VCL_INSTANTIATE_INLINE( I vcl_find(I, I, T const&) )
+
+#define VCL_REMOVE_INSTANTIATE(I, T) \
+VCL_INSTANTIATE_INLINE( I vcl_remove(I, I, T const&) )
+
+// I is a random access iterator.
+// this works for vector<double>::iterator with gcc 2.7 and irix6-CC-n32 :
+#define VCL_SORT_INSTANTIATE(I, T) \
+VCL_INSTANTIATE_INLINE( void vcl_sort(I, I ) )
+#define VCL_SORT_INSTANTIATE_CMP(I, T, C) \
+VCL_INSTANTIATE_INLINE( void vcl_sort(I, I, C ) )
+
+#undef VCL_COPY_INSTANTIATE
+#define VCL_COPY_INSTANTIATE(Inp, Out) \
+VCL_INSTANTIATE_INLINE(Out vcl_copy(Inp, Inp, Out))
+
+#undef VCL_COPY_BACKWARD_INSTANTIATE
+#define VCL_COPY_BACKWARD_INSTANTIATE(Inp, Out) \
+VCL_INSTANTIATE_INLINE(Out vcl_copy_backward(Inp, Inp, Out))
+
+#define VCL_FIND_IF_INSTANTIATE(I, P) \
+VCL_INSTANTIATE_INLINE(I vcl_find_if(I, I, P))
+
+#define VCL_UNIQUE_INSTANTIATE(I) /* */
+
+#endif // vcl_emulation_algorithm_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.cxx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..39ee6ea23b21c10769d8da2921317afe61f769cd
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.cxx
@@ -0,0 +1,35 @@
+// This is vcl/emulation/vcl_alloc.cxx
+#include <vcl_compiler.h>
+#if !VCL_USE_NATIVE_STL
+
+#define __PUT_STATIC_DATA_MEMBERS_HERE
+
+#include "vcl_alloc.h"
+#include "vcl_list.h"
+#include "vcl_map.h"
+#include "vcl_multimap.h"
+#include "vcl_set.h"
+#include "vcl_multiset.h"
+#include "vcl_tree.h"
+#include "vcl_algorithm.h"
+
+// STL
+template class __malloc_alloc<0>;
+
+#ifdef __STL_USE_NEWALLOC
+template class __new_alloc<0>;
+#else
+#ifndef __STL_USE_MALLOC
+template class __alloc<false, 0>;
+template class __alloc<true, 0>;
+#endif
+#endif
+
+#include <vcl_iostream.h>
+void vcl_alloc_throw_bad_alloc(char const *FILE, int LINE)
+{
+ vcl_cerr << FILE << ":" << LINE << " : out of memory\n";
+ vcl_exit(1);
+}
+
+#endif // VCL_USE_NATIVE_STL
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.h
new file mode 100644
index 0000000000000000000000000000000000000000..d89abe922327f0be5c56bcb51823f195c05b2d70
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_alloc.h
@@ -0,0 +1,801 @@
+/*
+ * Copyright (c) 1996-1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+#ifndef vcl_emulation_alloc_h
+#define vcl_emulation_alloc_h
+//:
+// \file
+// \brief This implements some standard node allocators
+//
+// These are \b NOT the same as the allocators in the C++ draft standard or in
+// in the original STL. They do not encapsulate different pointer
+// types; indeed we assume that there is only one pointer type.
+// The allocation primitives are intended to allocate individual objects,
+// not larger arenas as with the original STL allocators.
+//
+// \verbatim
+// Modifications
+// 180598 AWF Indented ifdefs properly. Very important task that.
+// \endverbatim
+
+#include "vcl_stlconf.h"
+
+#ifndef __ALLOC
+# define __ALLOC vcl_alloc
+#endif
+
+//#include <vcl_cstdlib.h>
+#include <vcl_cstddef.h>
+#include <vcl_cstring.h>
+#include <vcl_cassert.h>
+
+#ifndef __RESTRICT
+# define __RESTRICT
+#endif
+
+#if !defined(_PTHREADS) && !defined(_NOTHREADS) \
+ && !defined(__STL_SGI_THREADS) && !defined(__STL_WIN32THREADS)
+# define _NOTHREADS
+#endif
+
+#include "vcl_bool.h"
+
+#if !defined ( __STL_NO_EXCEPTIONS )
+# if defined (__STL_BAD_ALLOC_DEFINED)
+# include <vcl_new.h>
+# else
+ struct bad_alloc {};
+# endif
+# define __THROW_BAD_ALLOC throw bad_alloc()
+#elif !defined(__THROW_BAD_ALLOC)
+extern void vcl_alloc_throw_bad_alloc(char const *, int);
+# define __THROW_BAD_ALLOC vcl_alloc_throw_bad_alloc(__FILE__, __LINE__)
+#endif
+
+# if defined ( __STL_USE_ABBREVS )
+// ugliness is intentional - to reduce conflicts probability
+# define __malloc_alloc vcl_MA
+# define __alloc vcl_DA
+# endif
+
+//: Allocator adaptor to check size arguments for debugging.
+// Reports errors using assert. Checking can be disabled with
+// NDEBUG, but it's far better to just use the underlying allocator
+// instead when no checking is desired.
+// There is some evidence that this can confuse Purify.
+template <class Alloc>
+class debug_alloc
+{
+ public:
+ typedef Alloc allocator_type;
+ typedef typename Alloc::value_type value_type; //awf for SGI
+ private:
+#if !__STL_EAGER_TYPECHECK
+ enum {
+ type_size=sizeof(Alloc::value_type), // awf
+ safe_size=(type_size>0 ? type_size :1),
+ extra_chunk=8/safe_size+(int)(8%safe_size>0),
+ extra = 8
+ };
+#else
+#define type_size (sizeof(Alloc::value_type))
+#define safe_size (type_size()>0 ? type_size() :1)
+#define extra_chunk (8/safe_size+(int)(8%safe_size>0))
+#define extra 8
+#endif
+
+ // Size of space used to store size. Note that this must be
+ // large enough to preserve alignment.
+ public:
+ static void * allocate(vcl_size_t n)
+ {
+ char *result = (char *)allocator_type::allocate(n + extra_chunk);
+ *(vcl_size_t *)result = n;
+ return result + extra;
+ }
+
+ static void deallocate(void *p, vcl_size_t n)
+ {
+ char * real_p = (char *)p - extra;
+ assert(*(vcl_size_t *)real_p == n);
+ allocator_type::deallocate(real_p, n + extra);
+ }
+
+ static void *
+ reallocate(void *p, vcl_size_t old_sz, vcl_size_t new_sz)
+ {
+ char * real_p = (char *)p - extra;
+ assert(*(vcl_size_t *)real_p == old_sz);
+ char * result = (char *)
+ allocator_type::reallocate(real_p, old_sz + extra_chunk, new_sz + extra_chunk);
+ *(vcl_size_t *)result = new_sz;
+ return result + extra;
+ }
+#undef type_size
+#undef safe_size
+#undef extra_chunk
+#undef extra
+};
+
+// That is an adaptor for working with any alloc provided below
+template<class T, class Alloc>
+class vcl_simple_alloc
+{
+ typedef Alloc alloc_type;
+ public:
+ typedef typename Alloc::value_type alloc_value_type; // awf
+ typedef T value_type;
+
+#if !__STL_EAGER_TYPECHECK
+ enum {
+ chunk = sizeof(value_type)/sizeof(alloc_value_type)+(sizeof(value_type)%sizeof(alloc_value_type)>0)
+ };
+#else
+ // note: any out-of-line template definitions will not see this.
+#define chunk (sizeof(value_type)/sizeof(alloc_value_type)+(sizeof(value_type)%sizeof(alloc_value_type)>0))
+#endif
+ static value_type *allocate(vcl_size_t n) { return 0 == n? 0 : (value_type*) alloc_type::allocate(n * chunk); }
+ static value_type *allocate(void) { return (value_type*) alloc_type::allocate(chunk); }
+ static void deallocate(value_type *p, vcl_size_t n) { if (0 != n) alloc_type::deallocate(p, n * chunk); }
+ static void deallocate(value_type *p) { alloc_type::deallocate(p, chunk); }
+#undef chunk
+};
+
+
+// New-based allocator. Typically slower than default alloc below.
+// Typically thread-safe and more storage efficient.
+template <int inst>
+class __new_alloc
+{
+ public:
+ // this one is needed for proper vcl_simple_alloc wrapping
+ typedef char value_type;
+ static void* allocate(vcl_size_t n) { return 0 == n ? 0 : ::operator new(n);}
+ static void* reallocate(void *p, vcl_size_t old_sz, vcl_size_t new_sz)
+ {
+ void* result = allocate(new_sz);
+ vcl_size_t copy_sz = new_sz > old_sz? old_sz : new_sz;
+ vcl_memcpy(result, p, copy_sz);
+ deallocate(p, old_sz);
+ return result;
+ }
+ static void deallocate(void* p) { ::operator delete(p); }
+ static void deallocate(void* p, vcl_size_t) { ::operator delete(p); }
+};
+
+typedef __new_alloc<0> new_alloc;
+
+// Malloc-based allocator. Typically slower than default alloc below.
+// Typically thread-safe and more storage efficient.
+
+typedef void (* __oom_handler_type)();
+
+template <int inst>
+class __malloc_alloc
+{
+ private:
+ static void *oom_malloc(vcl_size_t);
+ static void *oom_realloc(void *, vcl_size_t);
+ static __oom_handler_type oom_handler;
+
+ public:
+ // this one is needed for proper vcl_simple_alloc wrapping
+ typedef char value_type;
+
+ static void * allocate(vcl_size_t n)
+ {
+ void *result = malloc(n);
+ if (0 == result) result = oom_malloc(n);
+ return result;
+ }
+
+ static void deallocate(void *p, vcl_size_t /* n */) { free(p); }
+
+ static void * reallocate(void *p, vcl_size_t /* old_sz */, vcl_size_t new_sz)
+ {
+ void * result = realloc(p, new_sz);
+ if (0 == result) result = oom_realloc(p, new_sz);
+ return result;
+ }
+
+ static __oom_handler_type set_malloc_handler(__oom_handler_type f)
+ {
+ __oom_handler_type old = oom_handler;
+ oom_handler = f;
+ return old;
+ }
+};
+
+// malloc_alloc out-of-memory handling
+# if ( __STL_STATIC_TEMPLATE_DATA > 0 )
+template <int inst>
+__oom_handler_type __malloc_alloc<inst>::oom_handler=(__oom_handler_type)0;
+# else
+__DECLARE_INSTANCE(__oom_handler_type, __malloc_alloc<0>::oom_handler,0);
+# endif /* ( __STL_STATIC_TEMPLATE_DATA > 0 ) */
+
+template <int inst>
+void * __malloc_alloc<inst>::oom_malloc(vcl_size_t n)
+{
+ __oom_handler_type my_malloc_handler;
+ void *result = 0;
+
+ while (!result) {
+ my_malloc_handler = oom_handler;
+ if (0 == my_malloc_handler) { __THROW_BAD_ALLOC; }
+ (*my_malloc_handler)();
+ result = malloc(n);
+ }
+ return result;
+}
+
+template <int inst>
+void * __malloc_alloc<inst>::oom_realloc(void *p, vcl_size_t n)
+{
+ __oom_handler_type my_malloc_handler;
+ void *result = 0;
+
+ while (!result) {
+ my_malloc_handler = oom_handler;
+ if (0 == my_malloc_handler) { __THROW_BAD_ALLOC; }
+ (*my_malloc_handler)();
+ result = realloc(p, n);
+ }
+ return result;
+}
+
+typedef __malloc_alloc<0> vcl_malloc_alloc;
+
+# if defined ( __STL_USE_NEWALLOC )
+# if defined ( __STL_DEBUG_ALLOC )
+ typedef debug_alloc<new_alloc> vcl_alloc;
+# else
+ typedef new_alloc vcl_alloc;
+# endif
+ typedef new_alloc single_client_alloc;
+ typedef new_alloc multithreaded_alloc;
+# else /* ! __STL_USE_NEWALLOC */
+# ifdef __STL_USE_MALLOC
+# if defined ( __STL_DEBUG_ALLOC )
+ typedef debug_alloc<vcl_malloc_alloc> vcl_alloc;
+# else
+ typedef vcl_malloc_alloc vcl_alloc;
+# endif
+typedef vcl_malloc_alloc single_client_alloc;
+typedef vcl_malloc_alloc multithreaded_alloc;
+# else /* ! __STL_USE_MALLOC */
+// global-level stuff
+
+// fbp : put all this stuff here
+# ifdef _NOTHREADS
+// Thread-unsafe
+# define __NODE_ALLOCATOR_LOCK
+# define __NODE_ALLOCATOR_UNLOCK
+# define __NODE_ALLOCATOR_THREADS false
+# define __VOLATILE
+# else /* ! _NOTHREADS */
+# ifdef _PTHREADS
+ // POSIX Threads
+ // This is dubious, since this is likely to be a high contention
+ // lock. The Posix standard appears to require an implemention
+ // that makes convoy effects likely. Performance may not be
+ // adequate.
+# include <pthread.h>
+// pthread_mutex_t __node_allocator_lock = PTHREAD_MUTEX_INITIALIZER;
+# define __NODE_ALLOCATOR_LOCK \
+ if (threads) pthread_mutex_lock(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_UNLOCK \
+ if (threads) pthread_mutex_unlock(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // Needed at -O3 on SGI
+# endif /* _PTHREADS */
+# ifdef __STL_WIN32THREADS
+# if !defined (__STL_WINDOWS_H_INCLUDED)
+# define NOMINMAX
+//# include <windows.h>
+# undef min
+# undef max
+# endif
+# ifndef WIN32_LEAN_AND_MEAN
+# define WIN32_LEAN_AND_MEAN
+# endif
+ // include windows.h outside #if !defined (__STL_WINDOWS_H_INCLUDED)
+ // because including windows.h can cause the #if/#endif nesting
+ // to exceed the maximum supported by Visual C++ (and windows.h
+ // has an #ifndef _WINDOWS_ / #endif guard)
+# include <windows.h>
+// CRITICAL_SECTION __node_allocator_lock;
+// bool __node_allocator_lock_initialized;
+// this one is needed to ensure correct initialization order
+// and to avoid excess instances
+ struct __stl_critical_section_wrapper {
+ CRITICAL_SECTION section;
+ __stl_critical_section_wrapper() {
+ InitializeCriticalSection(§ion);
+ }
+ };
+# define __NODE_ALLOCATOR_LOCK \
+ EnterCriticalSection(&__node_allocator_lock.section)
+# define __NODE_ALLOCATOR_UNLOCK \
+ LeaveCriticalSection(&__node_allocator_lock.section)
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // may not be needed
+# endif /* __STL_WIN32THREADS */
+# ifdef __STL_SGI_THREADS
+ // This should work without threads, with sproc threads, or with
+ // pthreads. It is suboptimal in all cases.
+ // It is unlikely to even compile on nonSGI machines.
+# include <malloc.h>
+# define __NODE_ALLOCATOR_LOCK if (threads && __us_rsthread_malloc) \
+ { __lock(&__node_allocator_lock); }
+# define __NODE_ALLOCATOR_UNLOCK if (threads && __us_rsthread_malloc) \
+ { __unlock(&__node_allocator_lock); }
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // Needed at -O3 on SGI
+# endif /* __STL_SGI_THREADS */
+# endif /* _NOTHREADS */
+
+ // Default node allocator.
+ // With a reasonable compiler, this should be roughly as fast as the
+ // original STL class-specific allocators, but with less fragmentation.
+ // Default_alloc_template parameters are experimental and MAY
+ // DISAPPEAR in the future. Clients should just use vcl_alloc for now.
+ //
+ // Important implementation properties:
+ // 1. If the client request an object of size > __MAX_BYTES, the resulting
+ // object will be obtained directly from malloc.
+ // 2. In all other cases, we allocate an object of size exactly
+ // ROUND_UP(requested_size). Thus the client has enough size
+ // information that we can return the object to the proper free vcl_list
+ // without permanently losing part of the object.
+ //
+
+ // The first template parameter specifies whether more than one thread
+ // may use this allocator. It is safe to allocate an object from
+ // one instance of a default_alloc and deallocate it with another
+ // one. This effectively transfers its ownership to the second one.
+ // This may have undesirable effects on reference locality.
+ // The second parameter is unreferenced and serves only to allow the
+ // creation of multiple default_alloc instances.
+ // Node that containers built on different allocator instances have
+ // different types, limiting the utility of this approach.
+# if defined ( __SUNPRO_CC ) || defined ( _AIX )
+ // breaks if we make these template class members:
+ enum {__ALIGN = 8};
+ enum {__MAX_BYTES = 128};
+ enum {__NFREELISTS = __MAX_BYTES/__ALIGN};
+# endif
+
+ template <bool threads, int inst>
+ class __alloc
+ {
+ __PRIVATE:
+ // Really we should use static const int x = N
+ // instead of enum { x = N }, but few compilers accept the former.
+# if ! (defined ( __SUNPRO_CC ) || defined ( _AIX ))
+ enum {__ALIGN = 8};
+ enum {__MAX_BYTES = 128};
+ enum {__NFREELISTS = __MAX_BYTES/__ALIGN};
+# endif
+
+
+ private:
+ static vcl_size_t ROUND_UP(vcl_size_t bytes) { return (((bytes) + __ALIGN-1) & ~(__ALIGN - 1)); }
+ __PRIVATE:
+ union obj;
+ friend union obj;
+ union obj {
+ union obj * free_list_link;
+ char client_data[1]; /* The client sees this. */
+ };
+ private:
+# if defined ( __SUNPRO_CC ) || defined ( _AIX )
+ static obj * __VOLATILE free_list[];
+ // Specifying a size results in duplicate def for 4.1
+# else
+ static obj * __VOLATILE free_list[__NFREELISTS];
+# endif
+ static vcl_size_t FREELIST_INDEX(vcl_size_t bytes) { return (((bytes) + __ALIGN-1)/__ALIGN - 1); }
+
+ // Returns an object of size n, and optionally adds to size n free vcl_list.
+ static void *refill(vcl_size_t n);
+ // Allocates a chunk for nobjs of size size. nobjs may be reduced
+ // if it is inconvenient to allocate the requested number.
+ static char *chunk_alloc(vcl_size_t size, int &nobjs);
+
+ // Chunk allocation state.
+ static char *start_free;
+ static char *end_free;
+ static vcl_size_t heap_size;
+
+# ifdef __STL_SGI_THREADS
+ static volatile unsigned long __node_allocator_lock;
+ static void __lock(volatile unsigned long *);
+ static inline void __unlock(volatile unsigned long *);
+# endif
+
+# ifdef _PTHREADS
+ static pthread_mutex_t __node_allocator_lock;
+# endif
+
+# ifdef __STL_WIN32THREADS
+ static __stl_critical_section_wrapper __node_allocator_lock;
+# endif
+
+ class lock
+ {
+ public:
+ lock() { __NODE_ALLOCATOR_LOCK; }
+ ~lock() { __NODE_ALLOCATOR_UNLOCK; }
+ };
+ friend class lock;
+
+ public:
+ // this one is needed for proper vcl_simple_alloc wrapping
+ typedef char value_type;
+
+ /* n must be > 0 */
+ static void * allocate(vcl_size_t n)
+ {
+ obj * __VOLATILE * my_free_list;
+ obj * __RESTRICT result;
+
+ if (n > __MAX_BYTES) {
+ return vcl_malloc_alloc::allocate(n);
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ // Acquire the lock here with a constructor call.
+ // This ensures that it is released in exit or during stack
+ // unwinding.
+ /*REFERENCED*/
+# if !defined (_NOTHREADS)
+ lock lock_instance;
+# endif
+ result = *my_free_list;
+ if (result == 0) {
+ void *r = refill(ROUND_UP(n));
+ return r;
+ }
+ *my_free_list = result -> free_list_link;
+ return result;
+ };
+
+ /* p may not be 0 */
+ static void deallocate(void *p, vcl_size_t n)
+ {
+ obj *q = (obj *)p;
+ obj * __VOLATILE * my_free_list;
+
+ if (n > __MAX_BYTES) {
+ vcl_malloc_alloc::deallocate(p, n);
+ return;
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ // acquire lock
+# if !defined (_NOTHREADS)
+ /*REFERENCED*/
+ lock lock_instance;
+# endif
+ q -> free_list_link = *my_free_list;
+ *my_free_list = q;
+ // lock is released here
+ }
+
+ static void * reallocate(void *p, vcl_size_t old_sz, vcl_size_t new_sz);
+ };
+
+ typedef __alloc<__NODE_ALLOCATOR_THREADS, 0> node_alloc;
+# if defined ( __STL_DEBUG_ALLOC )
+ typedef debug_alloc<node_alloc> vcl_alloc;
+# else
+ typedef node_alloc vcl_alloc;
+# endif
+ typedef __alloc<false, 0> single_client_alloc;
+ typedef __alloc<true, 0> multithreaded_alloc;
+
+ /* We allocate memory in large chunks in order to avoid fragmenting */
+ /* the malloc heap too much. */
+ /* We assume that size is properly aligned. */
+ /* We hold the allocation lock. */
+ template <bool threads, int inst>
+ char*
+ __alloc<threads, inst>::chunk_alloc(vcl_size_t size, int& nobjs)
+ {
+ char * result;
+ vcl_size_t total_bytes = size * nobjs;
+ vcl_size_t bytes_left = end_free - start_free;
+
+ if (bytes_left >= total_bytes)
+ {
+ result = start_free;
+ start_free += total_bytes;
+ return result;
+ }
+ else if (bytes_left >= size)
+ {
+ nobjs = bytes_left/size;
+ total_bytes = size * nobjs;
+ result = start_free;
+ start_free += total_bytes;
+ return result;
+ }
+ else
+ {
+ vcl_size_t bytes_to_get = 2 * total_bytes + ROUND_UP(heap_size >> 4);
+ // Try to make use of the left-over piece.
+ if (bytes_left > 0)
+ {
+ obj * __VOLATILE * my_free_list = free_list + FREELIST_INDEX(bytes_left);
+ ((obj *)start_free) -> free_list_link = *my_free_list;
+ *my_free_list = (obj *)start_free;
+ }
+ start_free = (char *)malloc(bytes_to_get);
+ if (0 == start_free)
+ {
+ obj * __VOLATILE * my_free_list, *p;
+ // Try to make do with what we have. That can't
+ // hurt. We do not try smaller requests, since that tends
+ // to result in disaster on multi-process machines.
+ for (int i = size; i <= __MAX_BYTES; i += __ALIGN)
+ {
+ my_free_list = free_list + FREELIST_INDEX(i);
+ p = *my_free_list;
+ if (0 != p)
+ {
+ *my_free_list = p -> free_list_link;
+ start_free = (char *)p;
+ end_free = start_free + i;
+ return chunk_alloc(size, nobjs);
+ // Any leftover piece will eventually make it to the
+ // right free vcl_list.
+ }
+ }
+ start_free = (char *)vcl_malloc_alloc::allocate(bytes_to_get);
+ // This should either throw an
+ // exception or remedy the situation. Thus we assume it
+ // succeeded.
+ }
+ heap_size += bytes_to_get;
+ end_free = start_free + bytes_to_get;
+ return chunk_alloc(size, nobjs);
+ }
+ }
+
+ /* Returns an object of size n, and optionally adds to size n free vcl_list.*/
+ /* We assume that n is properly aligned. */
+ /* We hold the allocation lock. */
+ template <bool threads, int inst>
+ void* __alloc<threads, inst>::refill(vcl_size_t n)
+ {
+ int nobjs = 20;
+ char * chunk = chunk_alloc(n, nobjs);
+ obj * __VOLATILE * my_free_list;
+ obj * result;
+ obj * current_obj, * next_obj;
+ int i;
+
+ if (1 == nobjs) return chunk;
+ my_free_list = free_list + FREELIST_INDEX(n);
+
+ /* Build free vcl_list in chunk */
+ result = (obj *)chunk;
+ *my_free_list = next_obj = (obj *)(chunk + n);
+ for (i = 1; true; i++)
+ {
+ current_obj = next_obj;
+ next_obj = (obj *)((char *)next_obj + n);
+ if (nobjs - 1 == i) { current_obj -> free_list_link = 0; break; }
+ else { current_obj -> free_list_link = next_obj; }
+ }
+ return result;
+ }
+
+ template <bool threads, int inst>
+ void*
+ __alloc<threads, inst>::reallocate(void *p,
+ vcl_size_t old_sz,
+ vcl_size_t new_sz)
+ {
+ void * result;
+ vcl_size_t copy_sz;
+
+ if (old_sz > __MAX_BYTES && new_sz > __MAX_BYTES)
+ return realloc(p, new_sz);
+ if (ROUND_UP(old_sz) == ROUND_UP(new_sz)) return p;
+ result = allocate(new_sz);
+ copy_sz = new_sz > old_sz? old_sz : new_sz;
+ vcl_memcpy(result, p, copy_sz);
+ deallocate(p, old_sz);
+ return result;
+ }
+
+# ifdef __STL_SGI_THREADS
+# include <mutex.h>
+# include <vcl_ctime.h>
+ // Somewhat generic lock implementations. We need only test-and-set
+ // and some way to sleep. These should work with both SGI pthreads
+ // and sproc threads. They may be useful on other systems.
+# if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64)) || defined(__GNUC__)
+# define __test_and_set(l,v) test_and_set(l,v)
+# endif
+
+ template <bool threads, int inst>
+ void
+ __alloc<threads, inst>::__lock(volatile unsigned long *lock)
+ {
+ const unsigned low_spin_max = 30; // spin cycles if we suspect uniprocessor
+ const unsigned high_spin_max = 1000; // spin cycles for multiprocessor
+ static unsigned spin_max = low_spin_max;
+ unsigned my_spin_max;
+ static unsigned last_spins = 0;
+ unsigned my_last_spins;
+ static struct timespec ts = {0, 1000};
+ unsigned junk;
+# define __ALLOC_PAUSE junk *= junk; junk *= junk; junk *= junk; junk *= junk
+ if (!__test_and_set((unsigned long *)lock, 1)) return;
+ my_spin_max = spin_max;
+ my_last_spins = last_spins;
+ for (int i = 0; i < my_spin_max; i++)
+ {
+ if (i < my_last_spins/2 || *lock) {
+ __ALLOC_PAUSE;
+ continue;
+ }
+ if (!__test_and_set((unsigned long *)lock, 1)) {
+ // got it!
+ // Spinning worked. Thus we're probably not being scheduled
+ // against the other process with which we were contending.
+ // Thus it makes sense to spin longer the next time.
+ last_spins = i;
+ spin_max = high_spin_max;
+ return;
+ }
+ }
+ // We are probably being scheduled against the other process. Sleep.
+ spin_max = low_spin_max;
+ for (;;) {
+ if (!__test_and_set((unsigned long *)lock, 1)) return;
+ nanosleep(&ts, 0);
+ }
+ }
+
+ template <bool threads, int inst>
+ inline void
+ __alloc<threads, inst>::__unlock(volatile unsigned long *lock)
+ {
+# if defined(__GNUC__) && __mips >= 3
+ asm("sync");
+ *lock = 0;
+# elif __mips >= 3 && (defined (_ABIN32) || defined(_ABI64))
+ __lock_release(lock);
+# else
+ *lock = 0;
+ // This is not sufficient on many multiprocessors, since
+ // writes to protected variables and the lock may be reordered.
+# endif
+ }
+# endif /* ! __STL_SGI_THREADS */
+
+# if ( __STL_STATIC_TEMPLATE_DATA > 0 )
+
+# ifdef _PTHREADS
+ template <bool threads, int inst>
+ pthread_mutex_t
+ __alloc<threads, inst>::__node_allocator_lock
+ = PTHREAD_MUTEX_INITIALIZER;
+# endif
+
+# ifdef __STL_SGI_THREADS
+ template <bool threads, int inst>
+ volatile unsigned long
+ __alloc<threads, inst>::__node_allocator_lock = 0;
+# endif
+
+ template <bool threads, int inst>
+ char *__alloc<threads, inst>::start_free = 0;
+
+ template <bool threads, int inst>
+ char *__alloc<threads, inst>::end_free = 0;
+
+ template <bool threads, int inst>
+ vcl_size_t __alloc<threads, inst>::heap_size = 0;
+
+ template <bool threads, int inst>
+ typename __alloc<threads, inst>::obj * __VOLATILE
+ __alloc<threads, inst>::free_list[
+# if ! (defined ( __SUNPRO_CC ) || defined ( _AIX ))
+ __alloc<threads, inst>::__NFREELISTS]
+# else
+ __NFREELISTS]
+# endif
+ = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, };
+ // The 16 zeros are necessary to make version 4.1 of the SunPro
+ // compiler happy. Otherwise it appears to allocate too little
+ // space for the array.
+
+# ifdef __STL_WIN32THREADS
+ template <bool threads, int inst>
+ __stl_critical_section_wrapper
+ __alloc<threads, inst>::__node_allocator_lock;
+# endif
+# else /* ( __STL_STATIC_TEMPLATE_DATA > 0 ) */
+ __DECLARE_INSTANCE(char *, single_client_alloc::start_free,0);
+ __DECLARE_INSTANCE(char *, single_client_alloc::end_free,0);
+ __DECLARE_INSTANCE(vcl_size_t, single_client_alloc::heap_size,0);
+# if defined ( __SUNPRO_CC ) || defined ( _AIX )
+ __DECLARE_INSTANCE(single_client_alloc::obj * __VOLATILE,
+ single_client_alloc::free_list[__NFREELISTS],
+ {0});
+# else
+ __DECLARE_INSTANCE(single_client_alloc::obj * __VOLATILE,
+ single_client_alloc::free_list[single_client_alloc::__NFREELISTS],
+ {0});
+# endif
+ __DECLARE_INSTANCE(char *, multithreaded_alloc::start_free,0);
+ __DECLARE_INSTANCE(char *, multithreaded_alloc::end_free,0);
+ __DECLARE_INSTANCE(vcl_size_t, multithreaded_alloc::heap_size,0);
+# if defined ( __SUNPRO_CC ) || defined ( _AIX )
+ __DECLARE_INSTANCE(multithreaded_alloc::obj * __VOLATILE,
+ multithreaded_alloc::free_list[__NFREELISTS],
+ {0});
+# else
+ __DECLARE_INSTANCE(multithreaded_alloc::obj * __VOLATILE,
+ multithreaded_alloc::free_list[multithreaded_alloc::__NFREELISTS],
+ {0});
+# endif
+# ifdef __STL_WIN32THREADS
+ __DECLARE_INSTANCE(__stl_critical_section_wrapper,
+ single_client_alloc::__node_allocator_lock,
+ __stl_critical_section_wrapper());
+ __DECLARE_INSTANCE(__stl_critical_section_wrapper,
+ multithreaded_alloc::__node_allocator_lock,
+ __stl_critical_section_wrapper());
+# endif
+# ifdef _PTHREADS
+ __DECLARE_INSTANCE(pthread_mutex_t,
+ single_client_alloc::__node_allocator_lock,
+ PTHREAD_MUTEX_INITIALIZER);
+ __DECLARE_INSTANCE(pthread_mutex_t,
+ multithreaded_alloc::__node_allocator_lock,
+ PTHREAD_MUTEX_INITIALIZER);
+# endif
+# ifdef __STL_SGI_THREADS
+ __DECLARE_INSTANCE(volatile unsigned long,
+ single_client_alloc::__node_allocator_lock,
+ 0);
+ __DECLARE_INSTANCE(volatile unsigned long,
+ multithreaded_alloc::__node_allocator_lock,
+ 0);
+# endif
+
+# endif /* __STL_STATIC_TEMPLATE_DATA */
+
+# endif /* ! __STL_USE_MALLOC */
+# endif /* ! __STL_USE_NEWALLOC */
+
+# if defined ( __STL_USE_DEFALLOC )
+# include "vcl_defalloc.h"
+# endif
+
+#endif // vcl_emulation_alloc_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bool.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bool.h
new file mode 100644
index 0000000000000000000000000000000000000000..fab8abe98e4a715313bb1edd5c689bc9333c88a5
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bool.h
@@ -0,0 +1,102 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Silicon Graphics
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+
+#ifndef vcl_emulation_bool_h
+#define vcl_emulation_bool_h
+
+// include compiler settings
+#include "vcl_stlconf.h"
+
+// some final tweaking ( should not be in stlconf.h to avoid
+// clobbering by configure
+
+#if ! defined ( __STL_NAMESPACES )
+# define __STL_NO_NAMESPACES 1
+#endif
+
+#if ! defined ( __STL_USE_EXCEPTIONS )
+# undef __STL_NO_EXCEPTIONS
+# define __STL_NO_EXCEPTIONS 1
+#endif
+
+#if defined ( __STL_NO_EXCEPTIONS )
+# undef __STL_USE_EXCEPTIONS
+#endif
+
+#if defined (__STL_WIN32THREADS) && !defined (_NOTHREADS) \
+ && !defined(__STL_USE_MALLOC) && !defined (__STL_USE_NEWALLOC) && !defined (__STL_BOOL_KEYWORD)
+# define __STL_WINDOWS_H_INCLUDED
+# define NOMINMAX
+# define Arg rpc_Arg
+#ifndef WIN32_LEAN_AND_MEAN
+ #define WIN32_LEAN_AND_MEAN
+#endif
+# include <windows.h>
+# undef Arg
+# undef min
+# undef max
+// This must precede bool.h
+#endif
+
+#ifndef bool
+ // <awf> : target handles bool anyway
+# if defined(__STL_YVALS_H)
+# include <yvals.h>
+# else
+# if ! defined(__STL_BOOL_KEYWORD)
+# if defined (__STL_RESERVED_BOOL_KEYWORD)
+# define bool int
+# else
+ typedef int bool;
+# endif
+# define true 1
+# define false 0
+# endif /* __STL_BOOL_KEYWORD */
+# endif
+#endif
+
+#undef __STL_BOOL_KEYWORD
+#undef __STL_RESERVED_BOOL_KEYWORD
+#undef __STL_YVALS_H
+#undef __STL_LOOP_INLINE_PROBLEMS
+#undef __STL_TYPENAME
+#undef __STL_EXPLICIT
+#undef __AUTO_CONFIGURED
+#undef __STL_FULL_SPEC_SYNTAX
+
+#endif // vcl_emulation_bool_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bvector.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bvector.h
new file mode 100644
index 0000000000000000000000000000000000000000..4b35435bf5b9057bf73576f6a4c368959d1b8c13
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_bvector.h
@@ -0,0 +1,502 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+// vcl_vector<bool> is replaced by vcl_bit_vector at present because partial
+// specialization is not yet implemented.
+
+#ifndef vcl_emulation_bvector_h
+#define vcl_emulation_bvector_h
+
+#include <vcl_cstddef.h>
+#include "vcl_algobase.h"
+#include "vcl_alloc.h"
+
+#define __WORD_BIT (int(CHAR_BIT*sizeof(unsigned int)))
+
+// fbp : give a chance to overload vcl_allocator
+# if ! defined ( Alloc )
+# define __AUTO_BVEC_ALLOC
+# define Alloc vcl_alloc
+# endif
+
+class __bvec_iterator;
+class __bvec_const_iterator;
+
+class __bvec_reference {
+ friend class __bvec_iterator;
+ friend class __bvec_const_iterator;
+ typedef __bvec_reference reference;
+protected:
+ unsigned int* p;
+ unsigned int mask;
+ __bvec_reference(unsigned int* x, unsigned int y) : p(x), mask(y) {}
+public:
+ __bvec_reference() : p(0), mask(0) {}
+ operator bool() const { return !(!(*p & mask)); }
+ reference& operator=(bool x) {
+ if (x)
+ *p |= mask;
+ else
+ *p &= ~mask;
+ return *this;
+ }
+ reference& operator=(const reference& x) { return *this = bool(x); }
+ bool operator==(const reference& x) const {
+ return bool(*this) == bool(x);
+ }
+ bool operator<(const reference& x) const {
+ return ! bool(*this) && bool(x); // was: bool(*this) < bool(x);
+ }
+ void flip() { *p ^= mask; }
+};
+
+
+class __bvec_iterator {
+ friend class vcl_bit_vector;
+ friend class __bvec_const_iterator;
+ typedef __bvec_iterator iterator;
+ typedef __bvec_const_iterator const_iterator;
+ typedef __bvec_reference reference;
+ typedef bool const_reference;
+ typedef bool value_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef vcl_size_t size_type;
+protected:
+ unsigned int* p;
+ unsigned int offset;
+ void bump_up() {
+ if (offset++ == __WORD_BIT - 1) {
+ offset = 0;
+ ++p;
+ }
+ }
+ void bump_down() {
+ if (offset-- == 0) {
+ offset = __WORD_BIT - 1;
+ --p;
+ }
+ }
+public:
+ __bvec_iterator() : p(0), offset(0) {}
+ __bvec_iterator(unsigned int* x, unsigned int y) : p(x), offset(y) {}
+ reference operator*() const { return reference(p, 1U << offset); }
+ iterator& operator++() {
+ bump_up();
+ return *this;
+ }
+ iterator operator++(int) {
+ iterator tmp = *this;
+ bump_up();
+ return tmp;
+ }
+ iterator& operator--() {
+ bump_down();
+ return *this;
+ }
+ iterator operator--(int) {
+ iterator tmp = *this;
+ bump_down();
+ return tmp;
+ }
+ iterator& operator+=(difference_type i) {
+ difference_type n = i + offset;
+ p += n / __WORD_BIT;
+ n = n % __WORD_BIT;
+ if (n < 0) {
+ offset = n + __WORD_BIT;
+ --p;
+ } else
+ offset = n;
+ return *this;
+ }
+ iterator& operator-=(difference_type i) {
+ *this += -i;
+ return *this;
+ }
+ iterator operator+(difference_type i) const {
+ iterator tmp = *this;
+ return tmp += i;
+ }
+ iterator operator-(difference_type i) const {
+ iterator tmp = *this;
+ return tmp -= i;
+ }
+ difference_type operator-(iterator x) const {
+ return __WORD_BIT * (p - x.p) + offset - x.offset;
+ }
+ reference operator[](difference_type i) { return *(*this + i); }
+ bool operator==(const iterator& x) const {
+ return p == x.p && offset == x.offset;
+ }
+ bool operator!=(const iterator& x) const {
+ return p != x.p || offset != x.offset;
+ }
+ bool operator<(iterator x) const {
+ return p < x.p || (p == x.p && offset < x.offset);
+ }
+};
+
+class __bvec_const_iterator
+{
+ friend class vcl_bit_vector;
+ typedef __bvec_iterator iterator;
+ typedef __bvec_const_iterator const_iterator;
+ typedef __bvec_reference reference;
+ typedef bool value_type;
+ typedef bool const_reference;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef vcl_size_t size_type;
+protected:
+ unsigned int* p;
+ unsigned int offset;
+ void bump_up() {
+ if (offset++ == __WORD_BIT - 1) {
+ offset = 0;
+ ++p;
+ }
+ }
+ void bump_down() {
+ if (offset-- == 0) {
+ offset = __WORD_BIT - 1;
+ --p;
+ }
+ }
+public:
+ __bvec_const_iterator() : p(0), offset(0) {}
+ __bvec_const_iterator(unsigned int* x, unsigned int y) : p(x), offset(y) {}
+ __bvec_const_iterator(const iterator& x) : p(x.p), offset(x.offset) {}
+ const_reference operator*() const {
+ return reference(p, 1U << offset);
+ }
+ const_iterator& operator++() {
+ bump_up();
+ return *this;
+ }
+ const_iterator operator++(int) {
+ const_iterator tmp = *this;
+ bump_up();
+ return tmp;
+ }
+ const_iterator& operator--() {
+ bump_down();
+ return *this;
+ }
+ const_iterator operator--(int) {
+ const_iterator tmp = *this;
+ bump_down();
+ return tmp;
+ }
+ const_iterator& operator+=(difference_type i) {
+ difference_type n = i + offset;
+ p += n / __WORD_BIT;
+ n = n % __WORD_BIT;
+ if (n < 0) {
+ offset = n + __WORD_BIT;
+ --p;
+ } else
+ offset = n;
+ return *this;
+ }
+ const_iterator& operator-=(difference_type i) {
+ *this += -i;
+ return *this;
+ }
+ const_iterator operator+(difference_type i) const {
+ const_iterator tmp = *this;
+ return tmp += i;
+ }
+ const_iterator operator-(difference_type i) const {
+ const_iterator tmp = *this;
+ return tmp -= i;
+ }
+ difference_type operator-(const_iterator x) const {
+ return __WORD_BIT * (p - x.p) + offset - x.offset;
+ }
+ const_reference operator[](difference_type i) {
+ return *(*this + i);
+ }
+ bool operator==(const const_iterator& x) const {
+ return p == x.p && offset == x.offset;
+ }
+ bool operator!=(const const_iterator& x) const {
+ return p != x.p || offset != x.offset;
+ }
+ bool operator<(const_iterator x) const {
+ return p < x.p || (p == x.p && offset < x.offset);
+ }
+};
+
+inline vcl_random_access_iterator_tag
+iterator_category(const __bvec_iterator&) {return vcl_random_access_iterator_tag();}
+inline vcl_random_access_iterator_tag
+iterator_category(const __bvec_const_iterator&) {return vcl_random_access_iterator_tag();}
+inline vcl_ptrdiff_t*
+distance_type(const __bvec_iterator&) {return (vcl_ptrdiff_t*)0;}
+inline vcl_ptrdiff_t*
+distance_type(const __bvec_const_iterator&) {return (vcl_ptrdiff_t*)0;}
+inline bool* value_type(const __bvec_iterator&) {return (bool*)0;}
+inline bool* value_type(const __bvec_const_iterator&) {return (bool*)0;}
+
+class vcl_bit_vector {
+public:
+ typedef bool value_type;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef __bvec_iterator iterator;
+ typedef __bvec_const_iterator const_iterator;
+ typedef __bvec_reference reference;
+ typedef bool const_reference;
+
+ typedef vcl_reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+ typedef vcl_reverse_iterator<iterator, value_type, reference, difference_type>
+ reverse_iterator;
+protected:
+ typedef vcl_simple_alloc<unsigned int, Alloc> data_allocator;
+ iterator start;
+ iterator finish;
+ unsigned int* end_of_storage;
+ unsigned int* bit_alloc(size_type n) {
+ return data_allocator::allocate((n + __WORD_BIT - 1)/__WORD_BIT);
+ }
+ void deallocate() {
+ if (start.p)
+ data_allocator::deallocate(start.p, end_of_storage - start.p);
+ }
+ void initialize(size_type n) {
+ unsigned int* q = bit_alloc(n);
+ end_of_storage = q + (n + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ finish = start + n;
+ }
+ void insert_aux(iterator position, bool x) {
+ if (finish.p != end_of_storage) {
+ copy_backward(position, finish, finish + 1);
+ *position = x;
+ ++finish;
+ } else {
+ size_type len = size() ? 2 * size() : __WORD_BIT;
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ *i++ = x;
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ typedef vcl_bit_vector self;
+public:
+ iterator begin() { return start; }
+ const_iterator begin() const { return start; }
+ iterator end() { return finish; }
+ const_iterator end() const { return finish; }
+
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+
+ size_type size() const { return size_type(end() - begin()); }
+ size_type max_size() const { return size_type(-1); }
+ size_type capacity() const {
+ return size_type(const_iterator(end_of_storage, 0) - begin());
+ }
+ bool empty() const { return begin() == end(); }
+ reference operator[](size_type n) { return *(begin() + n); }
+ const_reference operator[](size_type n) const { return *(begin() + n); }
+ vcl_bit_vector() : start(iterator()), finish(iterator()), end_of_storage(0) {}
+ vcl_bit_vector(size_type n, bool value = bool()) {
+ initialize(n);
+ fill(start.p, end_of_storage, value ? ~0 : 0);
+ }
+ vcl_bit_vector(const self& x) {
+ initialize(x.size());
+ copy(x.begin(), x.end(), start);
+ }
+ vcl_bit_vector(const_iterator first, const_iterator last) {
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ initialize(n);
+ copy(first, last, start);
+ }
+ vcl_bit_vector(const bool* first, const bool* last) {
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ initialize(n);
+ copy(first, last, start);
+ }
+ ~vcl_bit_vector() { deallocate(); }
+ self& operator=(const self& x) {
+ if (&x == this) return *this;
+ if (x.size() > capacity()) {
+ deallocate();
+ initialize(x.size());
+ }
+ copy(x.begin(), x.end(), begin());
+ finish = begin() + x.size();
+ return *this;
+ }
+ void reserve(size_type n) {
+ if (capacity() < n) {
+ unsigned int* q = bit_alloc(n);
+ finish = copy(begin(), end(), iterator(q, 0));
+ deallocate();
+ start = iterator(q, 0);
+ end_of_storage = q + (n + __WORD_BIT - 1)/__WORD_BIT;
+ }
+ }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(end() - 1); }
+ const_reference back() const { return *(end() - 1); }
+ void push_back(bool x) {
+ if (finish.p != end_of_storage)
+ *finish++ = x;
+ else
+ insert_aux(end(), x);
+ }
+ void swap(vcl_bit_vector& x) {
+ vcl_swap(start, x.start);
+ vcl_swap(finish, x.finish);
+ vcl_swap(end_of_storage, x.end_of_storage);
+ }
+ iterator insert(iterator position, bool x = bool()) {
+ size_type n = position - begin();
+ if (finish.p != end_of_storage && position == end())
+ *finish++ = x;
+ else
+ insert_aux(position, x);
+ return begin() + n;
+ }
+ void insert(iterator position, const_iterator first,
+ const_iterator last) {
+ if (first == last) return;
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ copy(first, last, position);
+ finish += n;
+ } else {
+ size_type len = size() + vcl_max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ i = copy(first, last, i);
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ void insert(iterator position, const bool* first, const bool* last) {
+ if (first == last) return;
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ copy(first, last, position);
+ finish += n;
+ } else {
+ size_type len = size() + vcl_max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ i = copy(first, last, i);
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ void insert(iterator position, size_type n, bool x) {
+ if (n == 0) return;
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ fill(position, position + n, x);
+ finish += n;
+ } else {
+ size_type len = size() + vcl_max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ fill_n(i, n, x);
+ finish = copy(position, end(), i + n);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ void pop_back() { --finish; }
+ void erase(iterator position) {
+ if (position + 1 != end())
+ copy(position + 1, end(), position);
+ --finish;
+ }
+ void erase(iterator first, iterator last) {
+ finish = copy(last, end(), first);
+ }
+};
+
+inline bool operator==(const vcl_bit_vector& x, const vcl_bit_vector& y) {
+ return x.size() == y.size() && vcl_equal(x.begin(), x.end(), y.begin());
+}
+
+inline bool operator<(const vcl_bit_vector& x, const vcl_bit_vector& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+inline void swap(vcl_bit_vector::reference x, vcl_bit_vector::reference y) {
+ bool tmp = x;
+ x = y;
+ y = tmp;
+}
+
+# undef __WORD_BIT
+
+# if defined ( __AUTO_BVEC_ALLOC )
+# undef Alloc
+# endif
+
+#endif // vcl_emulation_bvector_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_ciso646.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_ciso646.h
new file mode 100644
index 0000000000000000000000000000000000000000..cff825c8f1a68977618e7f9a0fff807ce2f8be69
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_ciso646.h
@@ -0,0 +1,16 @@
+#ifndef vcl_emulation_ciso646_h_
+#define vcl_emulation_ciso646_h_
+
+#define and &&
+#define and_eq &=
+#define bitand &
+#define bitor |
+#define compl ~
+#define not !
+#define not_eq !=
+#define or ||
+#define or_eq |=
+#define xor ^
+#define xor_eq ^=
+
+#endif // vcl_emulation_ciso646_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.h
new file mode 100644
index 0000000000000000000000000000000000000000..ca5d79c46f427bc0c00705c2f6bed0d04180297e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.h
@@ -0,0 +1,439 @@
+//:
+// \file
+// \brief definition and instantiations macro for complex<TYPE>
+//
+// \verbatim
+// Modifications
+// 200498 AWF Now GCC uses this complex as well.
+// \endverbatim
+
+
+#ifndef vcl_emulation_complex_h
+#define vcl_emulation_complex_h
+#define VCL_COMPLEX_AVAILABLE
+
+#include <vcl_cmath.h>
+#include <vcl_iostream.h>
+
+// The Sunpro 4.2 compiler has a bug that it will not instantiate
+// inline friend functions with global linkage, so we remove
+// all the inline's while instantiation is taking place.
+
+#if defined(VCL_SUNPRO_CC) && defined(INSTANTIATE_TEMPLATES)
+# define inline
+#endif
+
+// implementation of class vcl_complex<FLOAT>, copied from g++ 2.7.2 - PVR
+
+#if defined (VCL_VC50)
+template <class FLOAT> class vcl_complex;
+#endif
+
+template <class FLOAT>
+class vcl_complex
+{
+ public:
+ typedef FLOAT value_type;
+ vcl_complex (FLOAT r = 0, FLOAT i = 0): re (r), im (i) { }
+#if VCL_HAS_MEMBER_TEMPLATES
+ template <class T>
+ vcl_complex (vcl_complex<T> const& that): re(that.real()), im(that.imag()) {}
+#else
+ vcl_complex (vcl_complex<float> const& that): re(FLOAT(that.real())), im(FLOAT(that.imag())) {}
+ vcl_complex (vcl_complex<double>const& that): re(FLOAT(that.real())), im(FLOAT(that.imag())) {}
+#endif
+
+ vcl_complex& operator += (const vcl_complex&);
+ vcl_complex& operator -= (const vcl_complex&);
+ vcl_complex& operator *= (const vcl_complex&);
+ vcl_complex& operator /= (const vcl_complex&);
+ FLOAT real () const { return re; }
+ FLOAT imag () const { return im; }
+ private:
+ FLOAT re, im;
+};
+
+
+template <class FLOAT>
+inline vcl_complex<FLOAT>&
+vcl_complex<FLOAT>::operator += (const vcl_complex<FLOAT>& r)
+{
+ re += r.real();
+ im += r.imag();
+ return *this;
+}
+
+template <class FLOAT>
+inline vcl_complex<FLOAT>&
+vcl_complex<FLOAT>::operator -= (const vcl_complex<FLOAT>& r)
+{
+ re -= r.real();
+ im -= r.imag();
+ return *this;
+}
+
+template <class FLOAT>
+inline vcl_complex<FLOAT>&
+vcl_complex<FLOAT>::operator *= (const vcl_complex<FLOAT>& r)
+{
+ FLOAT f = re * r.real() - im * r.imag();
+ im = re * r.imag() + im * r.real();
+ re = f;
+ return *this;
+}
+
+template <class FLOAT>
+inline vcl_complex<FLOAT>&
+vcl_complex<FLOAT>::operator /= (const vcl_complex<FLOAT>& y)
+{
+ FLOAT ar = (FLOAT) vcl_abs (y.real());
+ FLOAT ai = (FLOAT) vcl_abs (y.imag());
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = y.real() / y.imag();
+ d = y.imag() * (t*t + 1L);
+ nr = (re * t + im) / d;
+ ni = (im * t - re) / d;
+ }
+ else
+ {
+ t = y.imag() / y.real();
+ d = y.real() * (t*t + 1L);
+ nr = (re + im * t) / d;
+ ni = (im - re * t) / d;
+ }
+ re = nr;
+ im = ni;
+ return *this;
+}
+
+template <class FLOAT> inline FLOAT
+vcl_real (vcl_complex<FLOAT> const& x) { return x.real(); }
+
+template <class FLOAT> inline FLOAT
+vcl_imag (vcl_complex<FLOAT> const& x) { return x.imag(); }
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator + (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x.real() + y.real(), x.imag() + y.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator + (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return vcl_complex<FLOAT> (x.real() + y, x.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator + (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x + y.real(), y.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator - (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x.real() - y.real(), x.imag() - y.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator - (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return vcl_complex<FLOAT> (x.real() - y, x.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator - (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x - y.real(), - y.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator * (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x.real() * y.real() - x.imag() * y.imag(),
+ x.real() * y.imag() + x.imag() * y.real());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator * (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return vcl_complex<FLOAT> (x.real() * y, x.imag() * y);
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator * (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return vcl_complex<FLOAT> (x * y.real(), x * y.imag());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator / (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return vcl_complex<FLOAT> (x.real() / y, x.imag() / y);
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator + (const vcl_complex<FLOAT>& x)
+{
+ return x;
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator - (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (-x.real(), -x.imag());
+}
+
+template <class FLOAT> inline bool
+operator == (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ return x.real() == y.real() && x.imag() == y.imag();
+}
+
+template <class FLOAT> inline bool
+operator == (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return x.real() == y && x.imag() == 0;
+}
+
+template <class FLOAT> inline bool
+operator == (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return x == y.real() && y.imag() == 0;
+}
+
+template <class FLOAT> inline bool
+operator != (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ return x.real() != y.real() || x.imag() != y.imag();
+}
+
+template <class FLOAT> inline bool
+operator != (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return x.real() != y || x.imag() != 0;
+}
+
+template <class FLOAT> inline bool
+operator != (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return x != y.real() || y.imag() != 0;
+}
+
+template <class FLOAT> inline FLOAT
+vcl_abs (const vcl_complex<FLOAT>& x)
+{
+ return (FLOAT) hypot (x.real(), x.imag());
+}
+
+template <class FLOAT> inline FLOAT
+vcl_arg (const vcl_complex<FLOAT>& x)
+{
+ return (FLOAT) atan2 (x.imag(), x.real());
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_polar (FLOAT r, FLOAT t)
+{
+ return vcl_complex<FLOAT> (r * cos (t), r * sin (t));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_conj (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (x.real(), -x.imag());
+}
+
+template <class FLOAT> inline FLOAT
+vcl_norm (const vcl_complex<FLOAT>& x)
+{
+ return x.real() * x.real() + x.imag() * x.imag();
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_cos (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (cos (x.real()) * cosh (x.imag()),
+ - sin (x.real()) * sinh (x.imag()));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_cosh (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (cosh (x.real()) * cos (x.imag()),
+ sinh (x.real()) * sin (x.imag()));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_exp (const vcl_complex<FLOAT>& x)
+{
+ return vcl_polar (FLOAT (exp (x.real())), x.imag());
+}
+
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_log (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (log (abs (x)), (FLOAT) atan2 (x.imag(), x.real()));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_pow (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ FLOAT logr = log (abs (x));
+ FLOAT t = (FLOAT) atan2 (x.imag(), x.real()); // was arg, but sunCC messed up WAH
+
+ return vcl_polar (FLOAT (exp (logr * y.real() - y.imag() * t)),
+ FLOAT (y.imag() * logr + y.real() * t));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_pow (const vcl_complex<FLOAT>& x, FLOAT y)
+{
+ return exp (FLOAT (y) * log (x));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_pow (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ return exp (y * FLOAT (log (x)));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_sin (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (sin (x.real()) * cosh (x.imag()),
+ cos (x.real()) * sinh (x.imag()));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_sinh (const vcl_complex<FLOAT>& x)
+{
+ return vcl_complex<FLOAT> (sinh (x.real()) * cos (x.imag()),
+ cosh (x.real()) * sin (x.imag()));
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator / (const vcl_complex<FLOAT>& x, const vcl_complex<FLOAT>& y)
+{
+ FLOAT ar = vcl_abs (y.real());
+ FLOAT ai = vcl_abs (y.imag());
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = y.real() / y.imag();
+ d = y.imag() * (t*t + 1L);
+ nr = (x.real() * t + x.imag()) / d;
+ ni = (x.imag() * t - x.real()) / d;
+ }
+ else
+ {
+ t = y.imag() / y.real();
+ d = y.real() * (t*t + 1L);
+ nr = (x.real() + x.imag() * t) / d;
+ ni = (x.imag() - x.real() * t) / d;
+ }
+ return vcl_complex<FLOAT> (nr, ni);
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+operator / (FLOAT x, const vcl_complex<FLOAT>& y)
+{
+ FLOAT ar = vcl_abs (y.real());
+ FLOAT ai = vcl_abs (y.imag());
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = y.real() / y.imag();
+ d = y.imag() * (1 + t*t);
+ nr = x * t / d;
+ ni = -x / d;
+ }
+ else
+ {
+ t = y.imag() / y.real();
+ d = y.real() * (1 + t*t);
+ nr = x / d;
+ ni = -x * t / d;
+ }
+ return vcl_complex<FLOAT> (nr, ni);
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_pow (const vcl_complex<FLOAT>& xin, int y)
+{
+ vcl_complex<FLOAT> r = 1.0;
+ vcl_complex<FLOAT> x = xin;
+ if (y < 0)
+ {
+ y = -y;
+ x = ((FLOAT)1)/x;
+ }
+ while (y)
+ {
+ if (y & 1) r *= x;
+ if (y >>= 1) x *= x;
+ }
+ return r;
+}
+
+template <class FLOAT> inline vcl_complex<FLOAT>
+vcl_sqrt (const vcl_complex<FLOAT>& x)
+{
+ FLOAT r = vcl_abs (x);
+ FLOAT nr, ni;
+ if (r == 0.0)
+ nr = ni = r;
+ else if (x.real() > 0)
+ {
+ nr = sqrt (0.5 * (r + x.real()));
+ ni = x.imag() / nr / 2;
+ }
+ else
+ {
+ ni = sqrt (0.5 * (r - x.real()));
+ if (x.imag() < 0)
+ ni = - ni;
+ nr = x.imag() / ni / 2;
+ }
+ return vcl_complex<FLOAT> (nr, ni);
+}
+
+template <class FLOAT>
+inline
+vcl_ostream& operator << (vcl_ostream& o, vcl_complex<FLOAT> const& x)
+{
+ o << x.real();
+ if (x.imag()) {
+ if (x.imag() > 0)
+ o << '+';
+ o << x.imag() << 'i';
+ }
+ return o;
+}
+
+template <class FLOAT>
+inline
+vcl_istream& operator >> (vcl_istream& o, vcl_complex<FLOAT>& x)
+{
+ FLOAT r, i;
+ o >> r >> i;
+ x = vcl_complex<FLOAT>(r,i);
+ return o;
+}
+
+#ifdef VCL_SUNPRO_CC
+#ifdef INSTANTIATE_TEMPLATES
+#undef inline
+#endif
+#endif
+// ANSI complex types
+#define __STD_COMPLEX
+
+#endif // vcl_emulation_complex_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.txx
new file mode 100644
index 0000000000000000000000000000000000000000..1dda8c42635f0131067a9b367d7a6bd6b0fcf6f9
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_complex.txx
@@ -0,0 +1,55 @@
+#ifndef vcl_emulation_complex_txx_
+#define vcl_emulation_complex_txx_
+//-*- c++ -*-------------------------------------------------------------------
+//
+// Module: complex
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: MOT
+//
+//-----------------------------------------------------------------------------
+
+// Including emulation/complex.txx implies emulation/complex.h is included
+#include "vcl_complex.h"
+
+#ifdef VCL_SUNPRO_CC
+#undef VCL_INSTANTIATE_INLINE
+#define VCL_INSTANTIATE_INLINE(fn_decl) template fn_decl
+#endif
+
+#undef VCL_COMPLEX_INSTANTIATE
+#define VCL_COMPLEX_INSTANTIATE(FLOAT) \
+template class vcl_complex<FLOAT >; \
+VCL_INSTANTIATE_INLINE(vcl_ostream& operator<<(vcl_ostream&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(bool operator==(vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(bool operator==(FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(bool operator==(vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(FLOAT vcl_imag(vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(FLOAT vcl_real(vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_sqrt (vcl_complex<FLOAT >const& x));\
+VCL_INSTANTIATE_INLINE(vcl_complex<float > operator + (vcl_complex<FLOAT > const &)); \
+VCL_INSTANTIATE_INLINE(vcl_complex<float > operator - (vcl_complex<FLOAT > const &)); \
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator + (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator - (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator * (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > operator / (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_polar (FLOAT,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,FLOAT));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (vcl_complex<FLOAT >const&,int));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_pow (FLOAT,vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_exp (vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_log (vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(FLOAT vcl_arg (vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(FLOAT vcl_abs (vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(FLOAT vcl_norm (vcl_complex<FLOAT >const&));\
+VCL_INSTANTIATE_INLINE(vcl_complex<FLOAT > vcl_conj (vcl_complex<FLOAT >const&))
+
+#endif // vcl_emulation_complex_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_config_stlcomp.h.vc50 b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_config_stlcomp.h.vc50
new file mode 100644
index 0000000000000000000000000000000000000000..5f5ffc436834d9ce8607f23f6e1893fb92c2355a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_config_stlcomp.h.vc50
@@ -0,0 +1,54 @@
+#ifndef __STLCOMP_H
+# define __STLCOMP_H
+// Settings for Visual C++ 5.0
+
+// define that to disable these features
+# undef __STL_NO_EXCEPTIONS
+# undef __STL_NO_NAMESPACES
+
+// select allocation method you like
+// uncomment this one to abandon experimantal allocator
+// #define __STL_USE_NEWALLOC
+
+// this one is not mandatory, just enabled
+#define __STL_USE_DEFALLOC 1
+
+// define NO_USING_STD if don't want using STL namespace by default
+// new-style-headers define that to get proper behaviour
+// # define __STL_NO_USING_STD
+
+// define __STL_USE_ABBREVS if your linker has trouble with long
+// external symbols
+// # define __STL_USE_ABBREVS 1
+
+// set this to force checked allocators
+// # define __STL_DEBUG_ALLOC 1
+
+// unsigned 32-bit integer type
+# define __STL_UINT32_T unsigned long
+
+
+# undef __STL_BOOL_KEYWORD
+# undef __STL_UNINITIALIZABLE_PRIVATE
+# undef __STL_BASE_MATCH_BUG
+# undef __STL_BASE_TYPEDEF_OUTSIDE_BUG
+# define __STL_STATIC_TEMPLATE_DATA 1
+# define __STL_DEFAULT_TEMPLATE_PARAM 1
+
+# define __STL_TYPENAME 1
+# define __STL_EXPLICIT 1
+# define __STL_MUTABLE 1
+
+# define __STL_NAMESPACES 1
+# define __STL_NEW_STYLE_CASTS 1
+# define __STL_LONG_DOUBLE 1
+# define __STL_YVALS_H 1
+# define __STL_BAD_ALLOC_DEFINED 1
+# ifdef _CPPUNWIND
+# define __STL_USE_EXCEPTIONS
+# endif
+# ifdef _MT
+# define __STL_WIN32THREADS
+# endif
+
+# endif /* STLCOMP_H */
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_defalloc.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_defalloc.h
new file mode 100644
index 0000000000000000000000000000000000000000..7270ac0fbe0a2b161310927bceffa75749718005
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_defalloc.h
@@ -0,0 +1,96 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_defalloc_h
+#define vcl_emulation_defalloc_h
+
+#include <vcl_new.h>
+#include <vcl_cstddef.h>
+//#include <vcl_cstdlib.h>
+//#include <vcl_climits.h>
+#include "vcl_alloc.h"
+#include "vcl_algobase.h"
+
+// This file is obsolete; provided only for backward compatibility
+// with code that use vcl_allocator<T>
+
+template <class T>
+inline T* allocate(vcl_size_t size, T*) {
+ return 0 == size ? 0 : ::operator new(size*sizeof(T));
+}
+
+template <class T>
+inline void deallocate(T* buffer) {
+ ::operator delete buffer;
+}
+
+template <class T>
+inline void deallocate(T* buffer, vcl_size_t) {
+ ::operator delete buffer;
+}
+
+template <class T>
+class vcl_allocator : public vcl_alloc {
+ typedef vcl_alloc super;
+public:
+ typedef T value_type;
+ typedef T* pointer;
+ typedef const T* const_pointer;
+ typedef T& reference;
+ typedef const T& const_reference;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ static T* allocate(vcl_size_t n) { return (T*)super::allocate(n * sizeof(T));}
+//static T* allocate(void) { return super::allocate(sizeof(T)); }
+ static void deallocate(T *p, vcl_size_t n) { super::deallocate(p, n * sizeof(T)); }
+//static void deallocate(T *p) { super::deallocate(p); }
+ static pointer address(reference x) { return (pointer)&x; }
+ static const_pointer address(const_reference x) {
+ return (const_pointer)&x;
+ }
+ static size_type max_size() {
+ size_type sz((vcl_size_t)(-1)/sizeof(T));
+ size_type msz(1);
+ return vcl_max(msz, sz);
+ }
+ // CD2 requires that
+ static T* allocate(vcl_size_t n, const void* ) { return (T*)super::allocate(n * sizeof(T));}
+ void construct(pointer p, const value_type& val) { vcl_construct(p, val); }
+ void destroy(pointer p) { vcl_destroy(p); }
+};
+
+template<class T1, class T2> inline
+bool operator==(const vcl_allocator<T1>&, const vcl_allocator<T2>&) { return true; }
+template<class T1, class T2> inline
+bool operator!=(const vcl_allocator<T1>&, const vcl_allocator<T2>&) { return false; }
+
+__STL_FULL_SPECIALIZATION class vcl_allocator<void> {
+public:
+ typedef void* pointer;
+ typedef const void* const_pointer;
+};
+
+#endif // vcl_emulation_defalloc_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.h
new file mode 100644
index 0000000000000000000000000000000000000000..bc4627da0dbcf4b2f5fc4edd9bbc90b67c7e74a1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.h
@@ -0,0 +1,921 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Exception Handling:
+ * Copyright (c) 1997
+ * Mark of the Unicorn, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Mark of the Unicorn makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Adaptation:
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_deque_h
+#define vcl_emulation_deque_h
+
+#include <vcl_cstddef.h>
+#include "vcl_algobase.h"
+#include "vcl_alloc.h"
+
+# if defined ( __STL_USE_ABBREVS )
+# define __deque_iterator dQIt
+# define __deque_const_iterator dQcIt
+# endif
+
+inline vcl_size_t __deque_buf_size(vcl_size_t sz)
+{
+ return sz < 4096 ? vcl_size_t(4096 / sz) : vcl_size_t(1);
+}
+
+template <class T> struct __deque_iterator;
+template <class T> struct __deque_const_iterator;
+template <class T> struct __deque_data;
+
+template <class T>
+struct __deque_iterator_base
+{
+ private:
+ typedef __deque_iterator_base<T> self;
+ public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef pointer* map_pointer;
+
+ pointer current;
+ pointer first;
+ pointer last;
+ map_pointer node;
+
+ static size_type buffer_size() { return __deque_buf_size(sizeof(value_type)); }
+ void construct(pointer x, map_pointer y)
+ {
+ current=x; first=*y; last=(*y + buffer_size()); node=y;
+ }
+ void construct() { current=0; first=0; last=0; node=0; }
+ void construct(const self& x)
+ {
+ current=x.current; first=x.first; last=x.last; node=x.node;
+ }
+ __deque_iterator_base(pointer x, map_pointer y) { construct(x,y);}
+ __deque_iterator_base() : current(0), first(0), last(0), node(0) {}
+ difference_type operator-(const self& x) const
+ {
+ return node == x.node
+ ? current - x.current
+ : difference_type(buffer_size() * (node - x.node - 1) +
+ (current - first) + (x.last - x.current));
+ }
+ void operator++()
+ {
+ __stl_debug_check(__check_advance(*this,1));
+ if (++current == last)
+ {
+ first = *(++node);
+ current = first;
+ last = first + buffer_size();
+ }
+ }
+ void operator--()
+ {
+ __stl_debug_check(__check_advance(*this,-1));
+ if (current == first)
+ {
+ first = *(--node);
+ last = first + buffer_size();
+ current = last;
+ }
+ --current;
+ }
+ void operator+=(difference_type n)
+ {
+ __stl_debug_check(__check_advance(*this,n));
+ difference_type offset = n + (current - first);
+ difference_type num_node_to_jump = offset >= 0
+ ? offset / buffer_size()
+ : -((-offset + (difference_type)buffer_size() - 1) / (difference_type)buffer_size());
+ if (num_node_to_jump == 0)
+ current += n;
+ else
+ {
+ node = node + num_node_to_jump;
+ first = *node;
+ last = first + buffer_size();
+ current = first + (offset - num_node_to_jump * buffer_size());
+ }
+ }
+
+ bool operator==(const self& x) const
+ {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return current == x.current ||
+ ((current == first || x.current == x.first) && *this - x == 0);
+ }
+ bool operator!=(const self& x) const {return !(*this == x); }
+ bool operator<(const self& x) const
+ {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return (node == x.node) ? (current < x.current) : (node < x.node);
+ }
+};
+
+template <class T>
+struct __deque_iterator : public __deque_iterator_base<T>
+{
+ private:
+ typedef __deque_iterator_base<T> super;
+ public:
+ typedef __deque_iterator<T> iterator;
+ typedef __deque_const_iterator<T> const_iterator;
+ __deque_iterator() {}
+ __deque_iterator(typename pointer x, typename map_pointer y) : super(x,y) {}
+ // <awf>
+ __IMPORT_CONTAINER_TYPEDEFS(super)
+ // </awf>
+
+ value_type& operator*() const { __stl_debug_check(__check_dereferenceable(*this)); return *current; }
+ difference_type operator-(const iterator& x) const { return super::operator-(x); }
+ iterator& operator++() { super::operator++(); return *this; }
+ iterator operator++(int) { iterator tmp = *this; ++*this; return tmp; }
+ iterator& operator--() { super::operator--(); return *this; }
+ iterator operator--(int) { iterator tmp = *this; --*this; return tmp; }
+ iterator& operator+=(difference_type n) { super::operator+=(n); return *this; }
+ iterator& operator-=(difference_type n) { return *this += -n; }
+ iterator operator+(difference_type n) const { iterator tmp = *this; return tmp += n; }
+ iterator operator-(difference_type n) const { iterator tmp = *this; return tmp -= n; }
+ reference operator[](difference_type n) const { return *(*this + n); }
+ bool operator==(const iterator& x) const { return super::operator==(x); }
+ bool operator!=(const iterator& x) const { return !(*this == x); }
+ bool operator<(const iterator& x) const { return super::operator<(x); }
+};
+
+
+template <class T>
+struct __deque_const_iterator : public __deque_iterator_base<T>
+{
+ private:
+ typedef __deque_iterator_base<T> super;
+ public:
+ typedef __deque_iterator<T> iterator;
+ typedef __deque_const_iterator<T> const_iterator;
+ __deque_const_iterator() {}
+ __deque_const_iterator(typename pointer x, typename map_pointer y) : super(x,y) {}
+ __deque_const_iterator(const iterator& x) : super(x) {}
+ typename const_reference operator*() const { return *current; }
+ typename difference_type operator-(const const_iterator& x) const { return super::operator-(x); }
+ const_iterator& operator++() { super::operator++(); return *this; }
+ const_iterator operator++(int) { const_iterator tmp = *this; ++*this; return tmp; }
+ const_iterator& operator--() { super::operator--(); return *this; }
+ const_iterator operator--(int) { const_iterator tmp = *this; --*this; return tmp; }
+ const_iterator& operator+=(typename difference_type n) { super::operator+=(n); return *this; }
+ const_iterator& operator-=(typename difference_type n) { return *this += -n; }
+ const_iterator operator+(typename difference_type n) const { const_iterator tmp = *this; return tmp += n; }
+ const_iterator operator-(typename difference_type n) const { const_iterator tmp = *this; return tmp -= n; }
+ typename const_reference operator[](typename difference_type n) const { return *(*this + n); }
+ bool operator==(const const_iterator& x) const { return super::operator==(x); }
+ bool operator!=(const const_iterator& x) const {return !(*this == x); }
+ bool operator<(const const_iterator& x) const { return super::operator<(x); }
+};
+
+template <class T>
+inline vcl_random_access_iterator_tag
+iterator_category(const __deque_iterator<T>&)
+{
+ return vcl_random_access_iterator_tag();
+}
+
+template <class T>
+inline T*
+value_type(const __deque_iterator<T>&)
+{
+ return (T*) 0;
+}
+
+template <class T>
+inline vcl_ptrdiff_t*
+distance_type(const __deque_iterator<T>&)
+{
+ return (vcl_ptrdiff_t*) 0;
+}
+
+template <class T>
+inline vcl_random_access_iterator_tag
+iterator_category(const __deque_const_iterator<T>&)
+{
+ return vcl_random_access_iterator_tag();
+}
+
+template <class T>
+inline T*
+value_type(const __deque_const_iterator<T>&)
+{
+ return (T*) 0;
+}
+
+template <class T>
+inline vcl_ptrdiff_t*
+distance_type(const __deque_const_iterator<T>&)
+{
+ return (vcl_ptrdiff_t*) 0;
+}
+
+template <class T>
+struct __deque_data
+{
+ typedef T value_type;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef T** map_pointer;
+ protected:
+ __deque_iterator<T> start;
+ __deque_iterator<T> finish;
+ size_type length;
+ map_pointer map;
+ size_type map_size;
+ public:
+ __deque_data() : start(), finish(), length(0), map(0), map_size(0) {
+ __stl_debug_do(safe_init(this));
+ __stl_debug_do(start.safe_init(this));
+ __stl_debug_do(finish.safe_init(this));
+ }
+ ~__deque_data() {
+ __stl_debug_do(invalidate()); __stl_debug_do(start.invalidate());
+ __stl_debug_do(finish.invalidate());
+ }
+};
+
+template <class T, class Alloc>
+class __deque_base : public __deque_data <T> {
+ typedef __deque_base<T,Alloc> self;
+ public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef vcl_size_t size_type;
+ typedef Alloc allocator_type;
+ protected:
+ static size_type buffer_size() {
+ return __deque_buf_size(sizeof(value_type)); }
+ static size_type init_map_size() {
+ return __deque_buf_size(sizeof(pointer)); }
+ inline void deallocate_at_begin();
+ public:
+ typedef vcl_simple_alloc<value_type*, allocator_type> map_allocator;
+ typedef vcl_simple_alloc<value_type, allocator_type> data_allocator;
+ __deque_base() {}
+ ~__deque_base() { clear(); }
+ void pop_front() {
+ vcl_destroy(start.current);
+ ++start.current;
+ --length;
+ if ((length == 0) || start.current == start.last)
+ deallocate_at_begin();
+ }
+ void clear() { while (length!=0) pop_front(); }
+};
+
+template <class T , class Alloc>
+void __deque_base<T, Alloc>::deallocate_at_begin() {
+ data_allocator::deallocate(*start.node++, buffer_size());
+ if (length==0) {
+ if (finish.current == finish.first)
+ data_allocator::deallocate(*start.node, buffer_size());
+ start.construct();
+ finish.construct();
+ map_allocator::deallocate(__deque_data<T>::map, map_size);
+ }
+ else
+ start.construct(*start.node, start.node);
+}
+
+__BEGIN_STL_FULL_NAMESPACE
+# define vcl_deque __WORKAROUND_RENAME(vcl_deque)
+
+template <class T, VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_deque : public __deque_base<T,Alloc>
+{
+ typedef __deque_base<T, Alloc> super;
+ typedef vcl_deque<T, Alloc> self;
+ public:
+ typedef T value_type;
+ typedef vcl_size_t size_type;
+ typedef value_type* pointer;
+ typedef const value_type* const_pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef __deque_iterator<T> iterator;
+ typedef __deque_const_iterator<T> const_iterator;
+ typedef vcl_reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+ typedef vcl_reverse_iterator<iterator, value_type, reference, difference_type>
+ reverse_iterator;
+ protected:
+ typedef pointer* map_pointer;
+ inline void allocate_at_begin();
+ inline void allocate_at_end();
+ inline void deallocate_at_end();
+ public:
+ vcl_deque() { }
+ iterator begin() { return start; }
+ const_iterator begin() const { return start; }
+ iterator end() { return finish; }
+ const_iterator end() const { return finish; }
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const { return const_reverse_iterator(end()); }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const { return const_reverse_iterator(begin()); }
+ bool empty() const { return length == 0; }
+ size_type size() const { return length; }
+ size_type max_size() const { return size_type(-1); }
+ reference operator[](size_type n) { return *(begin() + n); }
+ const_reference operator[](size_type n) const { return *(begin() + n); }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(end() - 1); }
+ const_reference back() const { return *(end() - 1); }
+ private:
+
+# if defined (__STL_USE_EXCEPTIONS)
+ inline void push_back_cleanup(int steps_remaining);
+ inline void push_front_cleanup(int steps_remaining, bool allocated_at_begin);
+ class push_back_protector;
+ friend class push_back_protector;
+ class push_back_protector
+ {
+ typedef vcl_deque<T,Alloc> deque_type;
+ deque_type *container;
+ int steps_remaining;
+ public:
+ push_back_protector(deque_type* d) : container(d), steps_remaining(2) {}
+ ~push_back_protector() { if (steps_remaining) container->push_back_cleanup(steps_remaining); }
+ void constructed() { steps_remaining = 1; }
+ void done() { steps_remaining = 0; }
+ };
+
+ class push_front_protector;
+ friend class push_front_protector;
+ class push_front_protector
+ {
+ typedef vcl_deque<T,Alloc> deque_type;
+ deque_type *container;
+ int steps_remaining;
+ bool allocated_at_begin;
+ public:
+ push_front_protector(deque_type* d, bool alloc_at_begin)
+ : container(d), steps_remaining(2), allocated_at_begin(alloc_at_begin) {}
+ ~push_front_protector() { if (steps_remaining ) container->push_front_cleanup(steps_remaining, allocated_at_begin); }
+ void constructed() { steps_remaining = 1; }
+ void done() { steps_remaining = 0; }
+ };
+# else
+ class push_front_protector
+ {
+ public:
+ push_front_protector(void*, bool=bool()){}
+ ~push_front_protector() {}
+ void constructed() {}
+ void done() {}
+ };
+ typedef push_front_protector push_back_protector;
+# endif
+
+ public:
+ void push_back(const T& x)
+ {
+ if (empty()) allocate_at_end();
+ push_back_protector protector(this);
+ vcl_construct(finish.current, x);
+ protector.constructed();
+ ++finish.current;
+ ++length;
+ if (finish.current == finish.last) allocate_at_end();
+ protector.done();
+ __stl_debug_do(invalidate_all());
+ }
+ void push_front(const T& x)
+ {
+ bool alloc_at_begin = empty() || start.current == start.first;
+ if (alloc_at_begin) allocate_at_begin();
+ push_front_protector protector(this, alloc_at_begin);
+ --start.current;
+ vcl_construct(start.current, x);
+ protector.constructed();
+ ++length;
+ if (finish.current == finish.last) allocate_at_end();
+ protector.done();
+ __stl_debug_do(invalidate_all());
+ }
+ void pop_front()
+ {
+ __stl_debug_do(invalidate_iterator(start));
+ super::pop_front();
+ }
+ void pop_back()
+ {
+ __stl_debug_do(invalidate_iterator(finish));
+ if (finish.current == finish.first) deallocate_at_end();
+ --finish.current;
+ vcl_destroy(finish.current);
+ --length;
+ if (empty()) deallocate_at_end();
+ }
+ void swap(vcl_deque<T, Alloc>& x)
+ {
+ vcl_swap(start, x.start);
+ vcl_swap(finish, x.finish);
+ vcl_swap(length, x.length);
+ vcl_swap(__deque_data<T>::map, x.map);
+ vcl_swap(map_size, x.map_size);
+ __stl_debug_do(swap_owners(x));
+ }
+ inline iterator insert(iterator position, const T& x);
+ iterator insert(iterator position) { return insert(position, T()); }
+ inline void insert(iterator position, size_type n, const T& x);
+//template <class Iterator> void insert(iterator position,
+// Iterator first, Iterator last);
+ inline void insert(iterator position, const T* first, const T* last);
+ inline void insert(iterator position, const_iterator first, const_iterator last);
+ inline void erase(iterator position);
+ inline void erase(iterator first, iterator last);
+ void resize(size_type new_size, const T& x)
+ {
+ if (new_size < size())
+ erase(begin() + new_size, end());
+ else
+ insert(end(), new_size - size(), x);
+ }
+ void resize(size_type new_size) { resize(new_size, T()); }
+ public:
+ vcl_deque(size_type n, const T& value) { insert(begin(), n, value); }
+ explicit vcl_deque(size_type n) { insert(begin(), n, T()); }
+//template <class Iterator> vcl_deque(Iterator first, Iterator last);
+ vcl_deque(const T* first, const T* last) { vcl_copy(first, last, vcl_back_inserter(*this)); }
+ vcl_deque(const_iterator first, const_iterator last) { vcl_copy(first, last, vcl_back_inserter(*this)); }
+ vcl_deque(const self& x) { vcl_copy(x.begin(), x.end(), vcl_back_inserter(*this)); }
+ self& operator=(const self& x)
+ {
+ if (this != &x) {
+ if (size() >= x.size())
+ erase(vcl_copy(x.begin(), x.end(), begin()), end());
+ else
+ vcl_copy(x.begin() + size(), x.end(),
+ vcl_inserter(*this, vcl_copy(x.begin(), x.begin() + size(), begin())));
+ __stl_debug_do(invalidate_all());
+ }
+ return *this;
+ }
+ ~vcl_deque() {}
+};
+
+# if defined ( __STL_NESTED_TYPE_PARAM_BUG )
+// qualified references
+# define __iterator__ __deque_iterator<T>
+# define iterator __iterator__
+# define const_iterator __deque_const_iterator<T>
+# define size_type vcl_size_t
+# else
+# define __iterator__ vcl_deque<T,Alloc>::iterator
+# endif
+
+# if defined (__STL_USE_EXCEPTIONS)
+template <class T , class Alloc>
+inline void
+vcl_deque<T, Alloc>::push_front_cleanup(int steps_remaining, bool allocated_at_begin)
+{
+ if (steps_remaining == 1) { // construct succeeded?
+ destroy(start.current);
+ --length;
+ }
+ ++start.current;
+ if (allocated_at_begin)
+ deallocate_at_begin();
+}
+
+template <class T , class Alloc>
+inline void
+vcl_deque<T, Alloc>::push_back_cleanup(int steps_remaining)
+{
+ if (steps_remaining == 1) {
+ destroy(finish.current - 1);
+ --length;
+ }
+ if (empty()) deallocate_at_end();
+}
+
+# endif
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::allocate_at_begin()
+{
+ pointer p = data_allocator::allocate(buffer_size());
+ IUEg__TRY
+ {
+ if (!empty())
+ {
+ if (start.node == __deque_data<T>::map)
+ {
+ difference_type i = finish.node - start.node;
+ size_type old_map_size = map_size;
+ map_pointer tmp = map_allocator::allocate((i+1)*2);
+ map_size = (i+1)*2;
+ // need not worry on pointers copy
+ vcl_copy(start.node, finish.node + 1, tmp + map_size / 4 + 1);
+ __deque_data<T>::map = tmp;
+ map_allocator::deallocate(__deque_data<T>::map, old_map_size);
+ __deque_data<T>::map[map_size / 4] = p;
+ start.construct(p + buffer_size(), __deque_data<T>::map + map_size / 4);
+ finish.construct(finish.current, __deque_data<T>::map + map_size / 4 + i + 1);
+ }
+ else
+ {
+ *--start.node = p;
+ start.construct(p + buffer_size(), start.node);
+ }
+ }
+ else
+ {
+ size_type new_map_size = init_map_size();
+ __deque_data<T>::map = map_allocator::allocate(new_map_size);
+ map_size = new_map_size;
+ __deque_data<T>::map[map_size / 2] = p;
+ start.construct(p + buffer_size() / 2 + 1, __deque_data<T>::map + map_size / 2);
+ finish.construct(start);
+ }
+ }
+#if defined (__STL_USE_EXCEPTIONS)
+ catch(...)
+ {
+ data_allocator::deallocate(p, buffer_size());
+ throw;
+ }
+#endif
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::allocate_at_end()
+{
+ pointer p = data_allocator::allocate(buffer_size());
+ IUEg__TRY
+ {
+ if (!empty())
+ {
+ if (finish.node == __deque_data<T>::map + map_size - 1)
+ {
+ difference_type i = finish.node - start.node;
+ size_type old_map_size = map_size;
+ map_pointer tmp = map_allocator::allocate((i + 1) * 2);
+ map_size = (i + 1) * 2;
+ vcl_copy(start.node, finish.node + 1, tmp + map_size / 4);
+ map_allocator::deallocate(__deque_data<T>::map, old_map_size);
+ __deque_data<T>::map = tmp;
+ __deque_data<T>::map[map_size / 4 + i + 1] = p;
+ start.construct(start.current, __deque_data<T>::map + map_size / 4);
+ finish.construct(p, __deque_data<T>::map + map_size / 4 + i + 1);
+ }
+ else
+ {
+ *++finish.node = p;
+ finish.construct(p, finish.node);
+ }
+ }
+ else
+ {
+ size_type new_map_size = init_map_size();
+ __deque_data<T>::map = map_allocator::allocate(new_map_size);
+ map_size = new_map_size;
+ __deque_data<T>::map[map_size / 2] = p;
+ start.construct(p + buffer_size() / 2, __deque_data<T>::map + map_size / 2);
+ finish.construct(start);
+ }
+ }
+# if defined (__STL_USE_EXCEPTIONS)
+ catch(...)
+ {
+ data_allocator::deallocate(p, buffer_size());
+ throw;
+ }
+# endif
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::deallocate_at_end()
+{
+ data_allocator::deallocate(*finish.node--, buffer_size());
+ if (empty())
+ {
+ start.construct();
+ finish.construct();
+ map_allocator::deallocate(__deque_data<T>::map, map_size);
+ }
+ else
+ finish.construct(*finish.node + buffer_size(), finish.node);
+}
+
+template <class T , class Alloc>
+typename __iterator__
+vcl_deque<T, Alloc>::insert(iterator position, const T& x)
+{
+ __stl_verbose_assert(position.owner()==this,__STL_MSG_NOT_OWNER);
+ if (position == begin()) {
+ push_front(x);
+ return begin();
+ } else if (position == end()) {
+ push_back(x);
+ return end() - 1;
+ } else {
+ difference_type index = position - begin();
+ if ((size_type)index < length / 2) {
+ push_front(*begin());
+ vcl_copy(begin() + 2, begin() + index + 1, begin() + 1);
+ }
+ else {
+ push_back(*(end() - 1));
+ vcl_copy_backward(begin() + index, end() - 2, end() - 1);
+ }
+ *(begin() + index) = x;
+ return begin() + index;
+ }
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::insert(iterator position, size_type n, const T& x)
+{
+ __stl_verbose_assert(position.owner()==this,__STL_MSG_NOT_OWNER);
+ difference_type index = position - begin();
+ difference_type remainder = length - index;
+ if (remainder > index)
+ {
+ if (n > (size_type)index)
+ {
+ difference_type m = n - index;
+ while (m-- > 0) push_front(x);
+ difference_type i = index;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_fill(begin() + n, begin() + n + index, x);
+ }
+ else
+ {
+ difference_type i = n;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_copy(begin() + n + n, begin() + n + index, begin() + n);
+ vcl_fill(begin() + index, begin() + n + index, x);
+ }
+ }
+ else
+ {
+ difference_type orig_len = index + remainder;
+ if (n > (size_type)remainder)
+ {
+ difference_type m = n - remainder;
+ while (m-- > 0) push_back(x);
+ difference_type i = 0;
+ while (i < remainder) push_back(*(begin() + index + i++));
+ vcl_fill(begin() + index, begin() + orig_len, x);
+ }
+ else
+ {
+ difference_type i = 0;
+ while ((size_type)i < n) push_back(*(begin() + orig_len - n + i++));
+ vcl_copy_backward(begin() + index, begin() + orig_len - n,
+ begin() + orig_len);
+ vcl_fill(begin() + index, begin() + index + n, x);
+ }
+ }
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::insert(iterator position, const T* first, const T* last)
+{
+ __stl_verbose_assert(position.owner()==this,__STL_MSG_NOT_OWNER);
+ __stl_debug_check(__check_range(first,last));
+ difference_type index = position - begin();
+ difference_type remainder = length - index;
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ if (remainder > index)
+ {
+ if (n > (size_type)index)
+ {
+ const T* m = last - index;
+ while (m != first) push_front(*--m);
+ difference_type i = index;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_copy(last - index, last, begin() + n);
+ }
+ else
+ {
+ difference_type i = n;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_copy(begin() + n + n, begin() + n + index, begin() + n);
+ vcl_copy(first, last, begin() + index);
+ }
+ }
+ else
+ {
+ difference_type orig_len = index + remainder;
+ if (n > (size_type)remainder)
+ {
+ const T* m = first + remainder;
+ while (m != last) push_back(*m++);
+ difference_type i = 0;
+ while (i < remainder) push_back(*(begin() + index + i++));
+ vcl_copy(first, first + remainder, begin() + index);
+ }
+ else
+ {
+ difference_type i = 0;
+ while ((size_type)i < n) push_back(*(begin() + orig_len - n + i++));
+ vcl_copy_backward(begin() + index, begin() + orig_len - n,
+ begin() + orig_len);
+ vcl_copy(first, last, begin() + index);
+ }
+ }
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::insert(iterator position, const_iterator first, const_iterator last)
+{
+ __stl_verbose_assert(position.owner()==this,__STL_MSG_NOT_OWNER);
+ __stl_debug_check(__check_range(first,last));
+ difference_type index = position - begin();
+ difference_type remainder = length - index;
+ size_type n = 0;
+ vcl_distance(first, last, n);
+ if (remainder > index)
+ {
+ if (n > (size_type)index)
+ {
+ const_iterator m = last - index;
+ while (m != first) push_front(*--m);
+ difference_type i = index;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_copy(last - index, last, begin() + n);
+ }
+ else
+ {
+ difference_type i = n;
+ while (i--) push_front(*(begin() + n - 1));
+ vcl_copy(begin() + n + n, begin() + n + index, begin() + n);
+ vcl_copy(first, last, begin() + index);
+ }
+ }
+ else
+ {
+ difference_type orig_len = index + remainder;
+ if (n > (size_type)remainder)
+ {
+ const_iterator m = first + remainder;
+ while (m != last) push_back(*m++);
+ difference_type i = 0;
+ while (i < remainder) push_back(*(begin() + index + i++));
+ vcl_copy(first, first + remainder, begin() + index);
+ }
+ else
+ {
+ difference_type i = 0;
+ while ((size_type)i < n) push_back(*(begin() + orig_len - n + i++));
+ vcl_copy_backward(begin() + index, begin() + orig_len - n,
+ begin() + orig_len);
+ vcl_copy(first, last, begin() + index);
+ }
+ }
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::erase(iterator position)
+{
+ __stl_debug_check(__check_range(position,begin(), end()-1));
+ if (end() - position > position - begin()) {
+ vcl_copy_backward(begin(), position, position + 1);
+ pop_front();
+ } else {
+ vcl_copy(position + 1, end(), position);
+ pop_back();
+ }
+}
+
+template <class T , class Alloc>
+void vcl_deque<T, Alloc>::erase(iterator first, iterator last)
+{
+ __stl_debug_check(__check_range(first,last, start, finish));
+ difference_type n = last - first;
+ if (end() - last > first - begin()) {
+ vcl_copy_backward(begin(), first, last);
+ while (n-- > 0) pop_front();
+ }
+ else {
+ vcl_copy(last, end(), first);
+ while (n-- > 0) pop_back();
+ }
+}
+
+
+# undef __iterator__
+# undef iterator
+# undef const_iterator
+# undef size_type
+
+// do a cleanup
+# undef vcl_deque
+__END_STL_FULL_NAMESPACE
+# define __deque__ __FULL_NAME(vcl_deque)
+
+# if !defined ( __STL_DEFAULT_TYPE_PARAM)
+// provide a "default" vcl_deque adaptor
+template <class T>
+class vcl_deque : public __deque__<T,vcl_alloc>
+{
+ typedef vcl_deque<T> self;
+ public:
+ typedef __deque__<T,vcl_alloc> super;
+ __CONTAINER_SUPER_TYPEDEFS
+ __IMPORT_SUPER_COPY_ASSIGNMENT(vcl_deque)
+ vcl_deque() : super() { }
+ explicit vcl_deque(size_type n, const T& value) : super(n, value) { }
+ explicit vcl_deque(size_type n) : super(n) { }
+ vcl_deque(const T* first, const T* last) : super(first, last) { }
+ vcl_deque(const_iterator first, const_iterator last) : super(first, last) { }
+ ~vcl_deque() { }
+};
+
+# if defined (__STL_BASE_MATCH_BUG)
+template <class T>
+inline bool
+operator==(const vcl_deque<T>& x, const vcl_deque<T>& y)
+{
+ typedef typename vcl_deque<T>::super super;
+ return operator == ((const super&)x,(const super&)y);
+}
+
+template <class T>
+inline bool
+operator<(const vcl_deque<T>& x, const vcl_deque<T>& y)
+{
+ typedef typename vcl_deque<T>::super super;
+ return operator < ((const super&)x,(const super&)y);
+}
+# endif
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+template <class T, class Alloc>
+inline
+bool operator==(const __deque__<T, Alloc>& x, const __deque__<T, Alloc>& y)
+{
+ return x.size() == y.size() && vcl_equal(x.begin(), x.end(), y.begin());
+}
+
+template <class T, class Alloc>
+inline
+bool operator<(const __deque__<T, Alloc>& x, const __deque__<T, Alloc>& y)
+{
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class T, class Alloc>
+inline void vcl_swap(__deque__<T,Alloc>& a, __deque__<T,Alloc>& b) { a.swap(b); }
+# endif
+
+#endif // vcl_emulation_deque_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.txx
new file mode 100644
index 0000000000000000000000000000000000000000..50cc490333e088ece79e79bae9103e9f8b00c3b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_deque.txx
@@ -0,0 +1,29 @@
+#ifndef vcl_emulation_deque_txx_
+#define vcl_emulation_deque_txx_
+
+#include "vcl_deque.h"
+#include "vcl_algorithm.txx"
+#include "vcl_iterator.txx"
+
+#if !defined ( __STL_DEFAULT_TYPE_PARAM )
+#define __DEQUE_INSTANTIATE(T) \
+ template class __deque__<T,vcl_alloc >;\
+ template class vcl_deque<T >
+#else
+#define __DEQUE_INSTANTIATE(T) \
+ template class vcl_deque<T , vcl_alloc >
+#endif
+
+#undef VCL_DEQUE_INSTANTIATE
+#define VCL_DEQUE_INSTANTIATE(T) \
+template struct __deque_iterator<T >;\
+template struct __deque_const_iterator<T >;\
+__DEQUE_INSTANTIATE(T);\
+template class __deque_base<T , vcl_alloc >;\
+template class vcl_reverse_bidirectional_iterator<__deque_iterator<T >, T , T &, vcl_ptrdiff_t>;\
+template class vcl_reverse_bidirectional_iterator<__deque_const_iterator<T >, T , T const &, vcl_ptrdiff_t>;\
+/* VCL_FILL_INSTANTIATE(vcl_deque<T >::iterator, T); */\
+VCL_ITER_RA_INSTANTIATE(__deque_iterator<T >);\
+VCL_ITER_RA_INSTANTIATE(__deque_const_iterator<T >)
+
+#endif // vcl_emulation_deque_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.h
new file mode 100644
index 0000000000000000000000000000000000000000..eefdd3e405d4c174049f86571bdbeabc8d62eb7b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.h
@@ -0,0 +1,589 @@
+#ifndef vcl_emulation_functional_h
+#define vcl_emulation_functional_h
+#define FUNCTION_H // why?
+
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#include <vcl_cstddef.h>
+#include "vcl_bool.h"
+
+#if 0
+// fsm: these function templates are non-standard, or rather, the
+// standard ones live in namespace std::rel_ops.
+template <class T>
+inline bool operator!=(const T& x, const T& y) { return !(x == y); }
+
+template <class T>
+inline bool operator>(const T& x, const T& y) { return y < x; }
+
+template <class T>
+inline bool operator<=(const T& x, const T& y) { return !(y < x); }
+
+template <class T>
+inline bool operator>=(const T& x, const T& y) { return !(x < y); }
+#endif
+
+template <class Arg, class Result>
+struct vcl_unary_function
+{
+ typedef Arg argument_type;
+ typedef Result result_type;
+};
+
+template <class Arg1, class Arg2, class Result>
+struct vcl_binary_function
+{
+ typedef Arg1 first_argument_type;
+ typedef Arg2 second_argument_type;
+ typedef Result result_type;
+};
+
+template <class T>
+struct vcl_plus : public vcl_binary_function<T, T, T>
+{
+ T operator()(const T& x, const T& y) const { return x + y; }
+};
+
+template <class T>
+struct vcl_minus : public vcl_binary_function<T, T, T>
+{
+ T operator()(const T& x, const T& y) const { return x - y; }
+};
+
+template <class T>
+struct vcl_multiplies : public vcl_binary_function<T, T, T>
+{
+ T operator()(const T& x, const T& y) const { return x * y; }
+};
+
+template <class T>
+struct vcl_divides : public vcl_binary_function<T, T, T>
+{
+ T operator()(const T& x, const T& y) const { return x / y; }
+};
+
+template <class T>
+struct vcl_modulus : public vcl_binary_function<T, T, T>
+{
+ T operator()(const T& x, const T& y) const { return x % y; }
+};
+
+template <class T>
+struct vcl_negate : public vcl_unary_function<T, T>
+{
+ T operator()(const T& x) const { return -x; }
+};
+
+template <class T>
+struct vcl_equal_to : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x == y; }
+};
+
+template <class T>
+struct vcl_not_equal_to : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x != y; }
+};
+
+template <class T>
+struct vcl_greater : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x > y; }
+};
+
+template <class T>
+struct vcl_less : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x < y; }
+};
+
+template <class T>
+struct vcl_greater_equal : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x >= y; }
+};
+
+template <class T>
+struct vcl_less_equal : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x <= y; }
+};
+
+template <class T>
+struct vcl_logical_and : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x && y; }
+};
+
+template <class T>
+struct vcl_logical_or : public vcl_binary_function<T, T, bool>
+{
+ bool operator()(const T& x, const T& y) const { return x || y; }
+};
+
+template <class T>
+struct vcl_logical_not : public vcl_unary_function<T, bool>
+{
+ bool operator()(const T& x) const { return !x; }
+};
+
+# if defined (__STL_BASE_TYPEDEF_BUG)
+// this workaround is needed for SunPro 4.0.1
+// suggested by "Martin Abernethy" <gma@paston.co.uk>:
+
+// We have to introduce the XXary_predicate_aux structures in order to
+// access the argument and return types of predicate functions supplied
+// as type parameters. SUN C++ 4.0.1 compiler gives errors for template type parameters
+// of the form 'name1::name2', where name1 is itself a type parameter.
+
+template <class Operation>
+struct vcl__unary_fun_aux : private Operation
+{
+ typedef typename Operation::argument_type argument_type;
+ typedef typename Operation::result_type result_type;
+};
+
+template <class Operation>
+struct vcl__binary_fun_aux : private Operation
+{
+ typedef typename Operation::first_argument_type first_argument_type;
+ typedef typename Operation::second_argument_type second_argument_type;
+ typedef typename Operation::result_type result_type;
+};
+
+# define __UNARY_ARG(Operation,type) vcl__unary_fun_aux<Operation>::type
+# define __BINARY_ARG(Operation,type) vcl__binary_fun_aux<Operation>::type
+# else
+# define __UNARY_ARG(Operation,type) Operation::type
+# define __BINARY_ARG(Operation,type) Operation::type
+# endif
+
+template <class Predicate>
+class vcl_unary_negate : public vcl_unary_function<typename __UNARY_ARG(Predicate,argument_type), bool>
+{
+ protected:
+ Predicate pred;
+ public:
+ explicit vcl_unary_negate(const Predicate& x) : pred(x) {}
+ bool operator()(const argument_type& x) const { return !pred(x); }
+};
+
+template <class Predicate>
+inline vcl_unary_negate<Predicate> not1(const Predicate& pred)
+{
+ return vcl_unary_negate<Predicate>(pred);
+}
+
+template <class Predicate>
+class vcl_binary_negate
+ : public vcl_binary_function<typename __BINARY_ARG(Predicate,first_argument_type),
+ typename __BINARY_ARG(Predicate,second_argument_type),
+ bool>
+{
+ protected:
+ Predicate pred;
+ public:
+ explicit vcl_binary_negate(const Predicate& x) : pred(x) {}
+ bool operator()(const first_argument_type& x,
+ const second_argument_type& y) const { return !pred(x, y); }
+};
+
+template <class Predicate>
+inline vcl_binary_negate<Predicate> not2(const Predicate& pred)
+{
+ return vcl_binary_negate<Predicate>(pred);
+}
+
+template <class Operation>
+class vcl_binder1st :
+ public vcl_unary_function<typename __BINARY_ARG(Operation,second_argument_type),
+ typename __BINARY_ARG(Operation,result_type) >
+{
+ protected:
+ Operation op;
+ typename __BINARY_ARG(Operation,first_argument_type) value;
+ public:
+ vcl_binder1st(const Operation& x,
+ const typename __BINARY_ARG(Operation,first_argument_type)& y)
+ : op(x), value(y) {}
+ typename result_type operator()(const argument_type& x) const { return op(value, x); }
+};
+
+template <class Operation, class T>
+vcl_binder1st<Operation> bind1st(const Operation& op, const T& x)
+{
+ typedef typename __BINARY_ARG(Operation,first_argument_type) arg_type;
+ return vcl_binder1st<Operation>(op, arg_type(x));
+}
+
+template <class Operation>
+class vcl_binder2nd :
+ public vcl_unary_function<typename __BINARY_ARG(Operation,first_argument_type),
+ typename __BINARY_ARG(Operation,result_type)>
+{
+ protected:
+ Operation op;
+ typename __BINARY_ARG(Operation,second_argument_type) value;
+ public:
+ vcl_binder2nd(const Operation& x,
+ const typename __BINARY_ARG(Operation,second_argument_type)& y)
+ : op(x), value(y) {}
+ typename result_type operator()(const argument_type& x) const { return op(x, value); }
+};
+
+template <class Operation, class T>
+vcl_binder2nd<Operation> bind2nd(const Operation& op, const T& x)
+{
+ typedef typename __BINARY_ARG(Operation,second_argument_type) arg_type;
+ return vcl_binder2nd<Operation>(op, arg_type(x));
+}
+
+template <class Operation1, class Operation2>
+class vcl_unary_compose :
+ public vcl_unary_function<typename __UNARY_ARG(Operation2,argument_type),
+ typename __UNARY_ARG(Operation1,result_type)>
+{
+ protected:
+ Operation1 op1;
+ Operation2 op2;
+ public:
+ vcl_unary_compose(const Operation1& x, const Operation2& y) : op1(x), op2(y) {}
+ typename __UNARY_ARG(Operation1,result_type)
+ operator()(const typename __UNARY_ARG(Operation2,argument_type)& x) const { return op1(op2(x)); }
+};
+
+template <class Operation1, class Operation2>
+inline vcl_unary_compose<Operation1, Operation2> compose1(const Operation1& op1,
+ const Operation2& op2)
+{
+ return vcl_unary_compose<Operation1, Operation2>(op1, op2);
+}
+
+template <class Operation1, class Operation2, class Operation3>
+class vcl_binary_compose :
+ public vcl_unary_function<typename __UNARY_ARG(Operation2,argument_type),
+ typename __BINARY_ARG(Operation1,result_type)>
+{
+ protected:
+ Operation1 op1;
+ Operation2 op2;
+ Operation3 op3;
+ public:
+ vcl_binary_compose(const Operation1& x, const Operation2& y,
+ const Operation3& z) : op1(x), op2(y), op3(z) { }
+ typename __BINARY_ARG(Operation1,result_type)
+ operator()(const typename __UNARY_ARG(Operation2,argument_type)& x) const { return op1(op2(x), op3(x)); }
+};
+
+template <class Operation1, class Operation2, class Operation3>
+inline vcl_binary_compose<Operation1, Operation2, Operation3>
+compose2(const Operation1& op1, const Operation2& op2, const Operation3& op3)
+{
+ return vcl_binary_compose<Operation1, Operation2, Operation3>(op1, op2, op3);
+}
+
+template <class Arg, class Result>
+class vcl_pointer_to_unary_function : public vcl_unary_function<Arg, Result>
+{
+ protected:
+ Result (*ptr)(Arg);
+ public:
+ vcl_pointer_to_unary_function() {}
+ explicit vcl_pointer_to_unary_function(Result (*x)(Arg)) : ptr(x) {}
+ Result operator()(Arg x) const { return ptr(x); }
+};
+
+template <class Arg, class Result>
+inline vcl_pointer_to_unary_function<Arg, Result> ptr_fun(Result (*x)(Arg))
+{
+ return vcl_pointer_to_unary_function<Arg, Result>(x);
+}
+
+template <class Arg1, class Arg2, class Result>
+class vcl_pointer_to_binary_function : public vcl_binary_function<Arg1, Arg2, Result>
+{
+ protected:
+ Result (*ptr)(Arg1, Arg2);
+ public:
+ vcl_pointer_to_binary_function() {}
+ explicit vcl_pointer_to_binary_function(Result (*x)(Arg1, Arg2)) : ptr(x) {}
+ Result operator()(Arg1 x, Arg2 y) const { return ptr(x, y); }
+};
+
+template <class Arg1, class Arg2, class Result>
+inline vcl_pointer_to_binary_function<Arg1, Arg2, Result>
+ptr_fun(Result (*x)(Arg1, Arg2))
+{
+ return vcl_pointer_to_binary_function<Arg1, Arg2, Result>(x);
+}
+
+template <class T>
+struct vcl_identity : public vcl_unary_function<T, T>
+{
+ public:
+ const T& operator()(const T& x) const { return x; }
+};
+
+template <class Pair>
+struct vcl_select1st : public vcl_unary_function<Pair, typename Pair::first_type>
+{
+ const typename Pair::first_type& operator()(const Pair& x) const { return x.first; }
+};
+
+template <class Pair>
+struct vcl_select2nd : public vcl_unary_function<Pair, typename Pair::second_type>
+{
+ const typename Pair::second_type& operator()(const Pair& x) const { return x.second; }
+};
+
+template <class Arg1, class Arg2>
+struct vcl_project1st : public vcl_binary_function<Arg1, Arg2, Arg1>
+{
+ Arg1 operator()(const Arg1& x, const Arg2&) const { return x; }
+};
+
+template <class Arg1, class Arg2>
+struct vcl_project2nd : public vcl_binary_function<Arg1, Arg2, Arg2>
+{
+ Arg2 operator()(const Arg1&, const Arg2& y) const { return y; }
+};
+
+// SGI extension (constant functions)
+
+template <class Result>
+struct vcl_constant_void_fun
+{
+ typedef Result result_type;
+ result_type val;
+ vcl_constant_void_fun(const result_type& v) : val(v) {}
+ const result_type& operator()() const { return val; }
+};
+
+template <class Result, VCL_DFL_TMPL_PARAM_STLDECL(Argument, Result) >
+struct vcl_constant_unary_fun : public vcl_unary_function<Argument, Result>
+{
+# if defined (__STL_BASE_TYPEDEF_BUG)
+ typedef vcl_unary_function<Argument, Result> super;
+ typedef typename super::result_type result_type;
+ typedef typename super::argument_type argument_type;
+# endif
+ result_type val;
+ vcl_constant_unary_fun(const result_type& v) : val(v) {}
+ const result_type& operator()(const argument_type&) const { return val; }
+};
+
+template <class Result, VCL_DFL_TMPL_PARAM_STLDECL(Arg1,Result), VCL_DFL_TMPL_PARAM_STLDECL(Arg2,Arg1) >
+struct vcl_constant_binary_fun : public vcl_binary_function<Arg1, Arg2, Result>
+{
+# if defined (__STL_BASE_TYPEDEF_BUG)
+ typedef vcl_binary_function<Arg1, Arg2, Result> super;
+ typedef typename super::result_type result_type;
+ typedef typename super::first_argument_type first_argument_type;
+ typedef typename super::second_argument_type second_argument_type;
+# endif
+ result_type val;
+ vcl_constant_binary_fun(const result_type& v) : val(v) {}
+ const result_type& operator()(const first_argument_type&,
+ const second_argument_type&) const { return val; }
+};
+
+template <class Result>
+inline vcl_constant_void_fun<Result> constant0(const Result& val)
+{
+ return vcl_constant_void_fun<Result>(val);
+}
+
+template <class Result>
+inline vcl_constant_unary_fun<Result VCL_DFL_TMPL_ARG(Result) > constant1(const Result& val)
+{
+ return vcl_constant_unary_fun<Result, Result>(val);
+}
+
+template <class Result>
+inline vcl_constant_binary_fun<Result
+ VCL_DFL_TMPL_ARG(Result) VCL_DFL_TMPL_ARG(Result) > constant2(const Result& val)
+{
+ return vcl_constant_binary_fun<Result VCL_DFL_TMPL_ARG(Result) VCL_DFL_TMPL_ARG(Result) >(val);
+}
+
+// SGI extension (subtractive range)
+
+// Note: this code assumes that T is 32-bit unsigned integer.
+template < class T >
+class vcl__subtractive_rng_t : public vcl_unary_function<T, T>
+{
+ private:
+ T table[55];
+ vcl_size_t index1;
+ vcl_size_t index2;
+ public:
+ vcl__subtractive_rng_t(T seed) { initialize(seed); }
+ vcl__subtractive_rng_t() { initialize(161803398u); }
+
+ T operator()(T limit)
+ {
+ index1 = (index1 + 1) % 55;
+ index2 = (index2 + 1) % 55;
+ table[index1] = table[index1] - table[index2];
+ return table[index1] % limit;
+ }
+ inline void initialize(T seed);
+};
+
+template <class T>
+void vcl__subtractive_rng_t<T>::initialize(T seed)
+{
+ T k = 1;
+ table[54] = seed;
+ vcl_size_t i;
+ for (i = 0; i < 54; i++)
+ {
+ vcl_size_t ii = (21 * (i + 1) % 55) - 1;
+ table[ii] = k;
+ k = seed - k;
+ seed = table[ii];
+ }
+ for (int loop = 0; loop < 4; loop++)
+ for (i = 0; i < 55; i++)
+ table[i] = table[i] - table[(1 + i + 30) % 55];
+ index1 = 0;
+ index2 = 31;
+}
+
+typedef vcl__subtractive_rng_t<__STL_UINT32_T> vcl_subtractive_rng;
+
+
+// 20.3.8 Adaptors for pointers to members [lib.member.pointer.adaptors]
+
+// vcl_mem_fun_t calls the member vcl_function it is initialized with given a
+// pointer argument.
+template <class Class, class Result>
+class vcl_mem_fun_t : public vcl_unary_function<Class*, Result>
+{
+ protected:
+ typedef Result (Class::*fun_type)(void);
+ fun_type ptr;
+ public:
+ vcl_mem_fun_t() {}
+ explicit vcl_mem_fun_t(fun_type p) : ptr(p) {}
+ Result operator()(Class* x) const { return (x->*ptr)();}
+};
+
+// vcl_mem_fun1_t calls the member vcl_function it is initialized with given a
+// pointer argument and an additional argument of the appropriate type.
+template <class Class, class Arg, class Result>
+class vcl_mem_fun1_t: public vcl_binary_function<Class*, Arg, Result>
+{
+ protected:
+ typedef Result (Class::*fun_type)(Arg);
+ fun_type ptr;
+ public:
+ vcl_mem_fun1_t() {}
+ explicit vcl_mem_fun1_t(fun_type p) : ptr(p) {}
+ Result operator()(Class* x, Arg a) const { return (x->*ptr)(a);}
+};
+
+// vcl_mem_fun_ref_t calls the member vcl_function it is initialized with given a
+// reference argument.
+template <class Class, class Result>
+class vcl_mem_fun_ref_t : public vcl_unary_function<Class, Result>
+{
+ protected:
+ typedef Result (Class::*fun_type)(void);
+ fun_type ptr;
+ public:
+ vcl_mem_fun_ref_t() {}
+ explicit vcl_mem_fun_ref_t(fun_type p) : ptr(p) {}
+ Result operator()(Class& x) const { return (x.*ptr)();}
+};
+
+// vcl_mem_fun1_ref_t calls the member vcl_function it is initialized with given
+// a reference argument and an additional argument of the appropriate
+// type.
+template <class Class, class Arg, class Result>
+class vcl_mem_fun1_ref_t: public vcl_binary_function<Class, Arg, Result>
+{
+ protected:
+ typedef Result (Class::*fun_type)(Arg);
+ fun_type ptr;
+ public:
+ vcl_mem_fun1_ref_t() {}
+ explicit vcl_mem_fun1_ref_t(fun_type p) : ptr(p) {}
+ Result operator()(Class& x, Arg a) const { return (x.*ptr)(a);}
+};
+
+# if !defined (__STL_MEMBER_POINTER_PARAM_BUG)
+// mem_fun(&X::f) returns an object through which X::f can be called
+// given a pointer to an X followed by the argument required for f (if
+// any).
+template <class Class, class Result>
+inline vcl_mem_fun_t <Class, Result>
+mem_fun(Result (Class::*ptr)(void))
+{
+ return vcl_mem_fun_t<Class, Result>(ptr);
+}
+
+template <class Class, class Arg, class Result>
+inline vcl_mem_fun1_t <Class, Arg, Result>
+mem_fun1(Result (Class::*ptr)(Arg))
+{
+ return vcl_mem_fun1_t<Class, Arg, Result>(ptr);
+}
+
+// mem_fun_ref(&X::f) returns an object through which X::f can be called
+// given a reference to an X followed by the argument required for f (if
+// any).
+template <class Class, class Result>
+inline vcl_mem_fun_ref_t<Class, Result>
+mem_fun_ref(Result (Class::*ptr)(void))
+{
+ return vcl_mem_fun_ref_t<Class, Result>(ptr);
+}
+
+template <class Class, class Arg, class Result>
+inline vcl_mem_fun1_ref_t<Class, Arg, Result>
+mem_fun1_ref(Result (Class::*ptr)(Arg))
+{
+ return vcl_mem_fun1_ref_t<Class, Arg, Result>(ptr);
+}
+
+# endif
+
+#endif // vcl_emulation_functional_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.txx
new file mode 100644
index 0000000000000000000000000000000000000000..82252362b301179591674398095441f15b700d35
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functional.txx
@@ -0,0 +1,24 @@
+#ifndef vcl_emulation_functional_txx_
+#define vcl_emulation_functional_txx_
+/*
+ fsm
+*/
+#include <vcl_functional.h>
+
+// --- Unary templates ---
+// Templates with one type mentioned, no requirements on type
+
+#define VCL_UNARY_INSTANTIATE(T) \
+template struct vcl_identity<T >
+
+#define VCL_LESS_INSTANTIATE(T) \
+template struct vcl_less<T >; \
+VCL_UNARY_INSTANTIATE(vcl_less<T >)
+
+#define VCL_COMPARISONS_INSTANTIATE(T) \
+VCL_OPERATOR_NE_INSTANTIATE(T);\
+VCL_INSTANTIATE_INLINE(bool operator > (T const &, T const &));\
+VCL_INSTANTIATE_INLINE(bool operator <= (T const &, T const &));\
+VCL_INSTANTIATE_INLINE(bool operator >= (T const &, T const &))
+
+#endif // vcl_emulation_functional_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functionx.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functionx.h
new file mode 100644
index 0000000000000000000000000000000000000000..7e591c0aa991c75ec37a2b154e5109bf0781daff
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_functionx.h
@@ -0,0 +1,157 @@
+/*
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_functionx_h
+#define vcl_emulation_functionx_h
+
+#include "vcl_functional.h"
+
+// This header provides various non-standard functional extensions
+// Some of them have to be specializations.
+
+
+// Extension : void function
+
+// used as adaptor's return/argument type,
+// to allow binders/composers usage
+# ifndef __VOID_TAG_DEFINED
+# define __VOID_TAG_DEFINED
+ struct __void_tag {};
+# endif
+
+template <class Result>
+struct void_function {
+ typedef Result result_type;
+ typedef __void_tag argument_type;
+};
+
+template <class Result>
+class pointer_to_void_function : public vcl_unary_function<__void_tag,Result> {
+protected:
+ Result (*ptr)();
+public:
+ explicit pointer_to_void_function(Result (*x)()) : ptr(x) {}
+ Result operator()(__void_tag = __void_tag()) const { return ptr(); }
+};
+
+// to feed composers
+template <class Arg1>
+struct projectvoid : public vcl_unary_function<Arg1,__void_tag> {
+ result_type operator()(const Arg1& x) const { return result_type(); }
+};
+
+template <class Result>
+pointer_to_void_function<Result> ptr_fun(Result (*x)()) {
+ return pointer_to_void_function<Result>(x);
+}
+
+// generators binding
+
+template <class Operation, class Generator>
+class binder1st_gen :
+public vcl_unary_function<typename __BINARY_ARG(Operation,second_argument_type),
+ typename __BINARY_ARG(Operation,result_type)> {
+protected:
+ Operation op;
+ Generator gen;
+public:
+ binder1st_gen(const Operation& x, const Generator& y) : op(x), gen(y) {}
+ result_type operator()(const argument_type& x) const {
+ return op(gen(),x);
+ }
+};
+
+template <class Operation,class Generator>
+inline binder1st_gen<Operation, Generator>
+bind1st_gen(const Operation& op, const Generator& gen)
+{
+ return binder1st_gen<Operation,Generator>(op,gen);
+}
+
+template <class Operation, class Generator>
+class binder2nd_gen :
+public vcl_unary_function<typename __BINARY_ARG(Operation,first_argument_type),
+ typename __BINARY_ARG(Operation,result_type)> {
+protected:
+ Operation op;
+ Generator gen;
+public:
+ binder2nd_gen(const Operation& x, const Generator& y) : op(x), gen(y) {}
+ result_type operator()(const argument_type& x) const {
+ return op(x, gen());
+ }
+};
+
+template <class Operation,class Generator>
+inline binder2nd_gen<Operation, Generator>
+bind2nd_gen(const Operation& op, const Generator& gen)
+{
+ return binder2nd_gen<Operation,Generator>(op,gen);
+}
+
+// 20.3.8 Adaptors for pointers to members [lib.member.pointer.adaptors]
+// const versions for some compilers
+// normally, you won't need them. Names are non-standard, so beware.
+
+template <class Class, class Result>
+class mem_fun_const_ref_t : public vcl_unary_function<const Class, Result> {
+protected:
+ typedef Result (Class::*fun_type)(void) const;
+ fun_type ptr;
+public:
+ explicit mem_fun_const_ref_t(fun_type p) : ptr(p) {}
+ Result operator()(const Class& x) const { return (x.*ptr)();}
+};
+
+template <class Class, class Arg, class Result>
+class mem_fun1_const_ref_t: public vcl_binary_function<const Class, Arg, Result> {
+public:
+protected:
+ typedef Result (Class::*fun_type)(Arg) const;
+ fun_type ptr;
+public:
+ explicit mem_fun1_const_ref_t(fun_type p) : ptr(p) {}
+ Result operator()(const Class& x, Arg a) const { return (x.*ptr)(a);}
+};
+
+template <class Class, class Result>
+inline mem_fun_const_ref_t<Class, Result>
+mem_fun_const_ref(Result (Class::*ptr)(void) const) {
+ return mem_fun_const_ref_t<Class, Result>(ptr);
+}
+
+template <class Class, class Arg, class Result>
+inline mem_fun1_const_ref_t<Class, Arg, Result>
+mem_fun1_const_ref(Result (Class::*ptr)(Arg) const) {
+ return mem_fun1_const_ref_t<Class, Arg, Result>(ptr);
+}
+
+// macros to declare functional objects for pointers to members
+#define mem_fun_macro(Result,Class,Func) \
+struct : public vcl_unary_function<Class*,Result> \
+{ Result operator()(Class* obj) const { return obj->Func(); }}
+
+#define mem_fun1_macro(Result,Class,Func,Param) \
+struct : public vcl_binary_function<Class*, Param,Result> \
+{ Result operator()(Class* obj, Param p) const { return obj->Func(p); }}
+
+#define mem_fun_ref_macro(Result,Class,Func) \
+struct : public vcl_unary_function<Class,Result> \
+{ Result operator()(Class& obj) const { return obj.Func(); }}
+
+#define mem_fun1_ref_macro(Result,Class,Func,Param) \
+struct : public vcl_binary_function<Class, Param,Result> \
+{ Result operator()(Class& obj, Param p) const { return obj.Func(p); }}
+
+#endif // vcl_emulation_functionx_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash.txx
new file mode 100644
index 0000000000000000000000000000000000000000..350f59c9c536ffd1fcd92b9c671eb2981f1d33d1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash.txx
@@ -0,0 +1,14 @@
+#ifndef vcl_emulation_hash_txx_
+#define vcl_emulation_hash_txx_
+#include <vcl_compiler.h>
+#include "vcl_algorithm.txx"
+#include "vcl_iterator.txx"
+#include "vcl_vector.txx"
+
+// --- Feature testing ---
+#ifdef __STL_LOOP_INLINE_PROBLEMS
+#define VCL_INSTANTIATE_INLINE_LOOP(f) template f
+#else
+#define VCL_INSTANTIATE_INLINE_LOOP(f) VCL_INSTANTIATE_INLINE(f)
+#endif
+#endif // vcl_emulation_hash_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.h
new file mode 100644
index 0000000000000000000000000000000000000000..9805ead04f55d487d417bcaa7423bd9f271c09b4
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.h
@@ -0,0 +1,402 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_hash_map_h
+#define vcl_emulation_hash_map_h
+
+#include <vcl_functional.h>
+//#include <vcl_alloc.h>
+#include "vcl_hashtable.h"
+#include "vcl_alloc.h"
+
+#ifdef __FULL_NAME
+# define VCL_FULL_NAME(x) __FULL_NAME(x)
+# define VCL_IMPORT_CONTAINER_TYPEDEFS(super) __IMPORT_CONTAINER_TYPEDEFS(super)
+# define VCL_IMPORT_ITERATORS(super) __IMPORT_ITERATORS(super)
+# define VCL_IMPORT_REVERSE_ITERATORS(super) __IMPORT_REVERSE_ITERATORS(super)
+#else
+// Using emulated hashtable, but not stlconf -- mini stlconf is built here
+
+#define VCL_FULL_NAME(x) x
+
+# define VCL_IMPORT_CONTAINER_TYPEDEFS(super) \
+ typedef typename super::value_type value_type; \
+ typedef typename super::reference reference; \
+ typedef typename super::size_type size_type; \
+ typedef typename super::const_reference const_reference; \
+ typedef typename super::difference_type difference_type;
+
+# define VCL_IMPORT_ITERATORS(super) \
+ typedef typename super::iterator iterator; \
+ typedef typename super::const_iterator const_iterator;
+
+# define VCL_IMPORT_REVERSE_ITERATORS(super) \
+ typedef typename super::const_reverse_iterator const_reverse_iterator; \
+ typedef typename super::reverse_iterator reverse_iterator;
+
+# ifndef __STL_DEFAULT_TYPE_PARAM
+# define vcl_hash_map VCL_hash_map__
+# define vcl_hash_multimap VCL_hash_multimap__
+# endif
+#endif
+
+//# define vcl_hash_map vcl_hM
+//# define vcl_hash_multimap vcl_hmM
+
+template <class Key, class T,
+ VCL_DFL_TMPL_PARAM_STLDECL(HashFcn,vcl_hash<Key>),
+ VCL_DFL_TMPL_PARAM_STLDECL(EqualKey,vcl_equal_to<Key>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_hash_map
+{
+private:
+ typedef vcl_select1st<vcl_pair<const Key, T> > sel1st;
+ typedef vcl_hashtable<vcl_pair<const Key, T>, Key, HashFcn, sel1st, EqualKey, Alloc> ht;
+ typedef vcl_hash_map<Key, T, HashFcn, EqualKey, Alloc> self;
+public:
+ VCL_IMPORT_CONTAINER_TYPEDEFS(ht)
+ VCL_IMPORT_ITERATORS(ht)
+ typedef typename ht::key_type key_type;
+ typedef typename ht::hasher hasher;
+ typedef typename ht::key_equal key_equal;
+ typedef T data_type;
+ typedef typename ht::pointer pointer;
+ typedef typename ht::const_pointer const_pointer;
+private:
+ ht rep;
+
+public:
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+public:
+ vcl_hash_map() : rep(100, hasher(), key_equal()) {}
+ vcl_hash_map(size_type n) : rep(n, hasher(), key_equal()) {}
+ vcl_hash_map(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ vcl_hash_map(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+ vcl_hash_map(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+ vcl_hash_map(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(self& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const vcl_hash_map<Key,T,HashFcn,EqualKey,Alloc>&,
+ const vcl_hash_map<Key,T,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() { return rep.begin(); }
+ iterator end() { return rep.end(); }
+ const_iterator begin() const { return rep.begin(); }
+ const_iterator end() const { return rep.end(); }
+
+public:
+ vcl_pair<iterator, bool> insert(const value_type& obj)
+ { return rep.insert_unique(obj); }
+ void insert(const value_type* f, const value_type* l) { rep.insert_unique(f,l); }
+ void insert(const_iterator f, const_iterator l) { rep.insert_unique(f, l); }
+ vcl_pair<iterator, bool> insert_noresize(const value_type& obj)
+ { return rep.insert_unique_noresize(obj); }
+
+ iterator find(const key_type& key) { return rep.find(key); }
+ const_iterator find(const key_type& key) const { return rep.find(key); }
+
+ T& operator[](const key_type& key)
+ {
+ value_type val(key, T());
+ return rep.find_or_insert(val).second;
+ }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ vcl_pair<iterator, iterator> equal_range(const key_type& key)
+ { return rep.equal_range(key); }
+ vcl_pair<const_iterator, const_iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+
+template <class Key, class T, VCL_DFL_TMPL_PARAM_STLDECL(HashFcn,vcl_hash<Key>),
+ VCL_DFL_TMPL_PARAM_STLDECL(EqualKey,vcl_equal_to<Key>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_hash_multimap
+{
+private:
+ typedef vcl_hashtable<vcl_pair<const Key, T>, Key, HashFcn,
+ vcl_select1st<vcl_pair<const Key, T> >, EqualKey, Alloc> ht;
+ typedef vcl_hash_multimap<Key, T, HashFcn, EqualKey, Alloc> self;
+public:
+ VCL_IMPORT_CONTAINER_TYPEDEFS(ht)
+ VCL_IMPORT_ITERATORS(ht)
+ typedef typename ht::key_type key_type;
+ typedef typename ht::hasher hasher;
+ typedef typename ht::key_equal key_equal;
+ typedef T data_type;
+ typedef typename ht::pointer pointer;
+ typedef typename ht::const_pointer const_pointer;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+private:
+ ht rep;
+
+public:
+ vcl_hash_multimap() : rep(100, hasher(), key_equal()) {}
+ vcl_hash_multimap(size_type n) : rep(n, hasher(), key_equal()) {}
+ vcl_hash_multimap(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ vcl_hash_multimap(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+ vcl_hash_multimap(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+ vcl_hash_multimap(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(self& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const vcl_hash_multimap<Key,T,HashFcn,EqualKey,Alloc>&,
+ const vcl_hash_multimap<Key,T,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() { return rep.begin(); }
+ iterator end() { return rep.end(); }
+ const_iterator begin() const { return rep.begin(); }
+ const_iterator end() const { return rep.end(); }
+
+public:
+ iterator insert(const value_type& obj) { return rep.insert_equal(obj); }
+ void insert(const value_type* f, const value_type* l) { rep.insert_equal(f,l); }
+ void insert(const_iterator f, const_iterator l) { rep.insert_equal(f, l); }
+ iterator insert_noresize(const value_type& obj)
+ { return rep.insert_equal_noresize(obj); }
+
+ iterator find(const key_type& key) { return rep.find(key); }
+ const_iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ vcl_pair<iterator, iterator> equal_range(const key_type& key)
+ { return rep.equal_range(key); }
+ vcl_pair<const_iterator, const_iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+template <class Key, class T, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const vcl_hash_map<Key, T, HashFcn, EqualKey, Alloc>& hm1,
+ const vcl_hash_map<Key, T, HashFcn, EqualKey, Alloc>& hm2)
+{
+ return hm1.rep == hm2.rep;
+}
+
+template <class Key, class T, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const vcl_hash_multimap<Key, T, HashFcn, EqualKey, Alloc>& hm1,
+ const vcl_hash_multimap<Key, T, HashFcn, EqualKey, Alloc>& hm2)
+{
+ return hm1.rep == hm2.rep;
+}
+
+// do a cleanup
+# undef vcl_hash_map
+# undef vcl_hash_multimap
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class Key, class T, class HashFcn, class EqualKey, class Alloc>
+inline void swap(VCL_hash_map__<Key, T, HashFcn, EqualKey, Alloc>& a,
+ VCL_hash_map__<Key, T, HashFcn, EqualKey, Alloc>& b) { a.swap(b); }
+template <class Key, class T, class HashFcn, class EqualKey, class Alloc>
+inline void swap(VCL_hash_multimap__<Key, T, HashFcn, EqualKey, Alloc>& a,
+ VCL_hash_multimap__<Key, T, HashFcn, EqualKey, Alloc>& b) { a.swap(b); }
+# endif
+
+# ifndef __STL_DEFAULT_TYPE_PARAM
+
+// provide a "default" vcl_hash_map adaptor
+template <class Key, class T, class HashFcn, class EqualKey >
+class vcl_hash_map : public VCL_hash_map__<Key, T, HashFcn, EqualKey, vcl_alloc >
+{
+ typedef vcl_hash_map<Key, T, HashFcn, EqualKey> self;
+public:
+//rick typedef typename VCL_hash_map__<Key, T, HashFcn, EqualKey, vcl_alloc> super;
+ typedef VCL_hash_map__<Key, T, HashFcn, EqualKey, vcl_alloc> super;
+ VCL_IMPORT_CONTAINER_TYPEDEFS(super)
+ typedef typename super::key_type key_type;
+ typedef typename super::hasher hasher;
+ typedef typename super::key_equal key_equal;
+ //rick typedef typename T data_type;
+ typedef T data_type;
+ typedef typename super::pointer pointer;
+ typedef typename super::const_pointer const_pointer;
+ vcl_hash_map() {}
+ vcl_hash_map(size_type n) : super(n) {}
+ vcl_hash_map(size_type n, const hasher& hf) : super(n, hf) {}
+ vcl_hash_map(size_type n, const hasher& hf, const key_equal& eql): super(n, hf, eql) {}
+ vcl_hash_map(const value_type* f, const value_type* l) : super(f,l) {}
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n): super(f,l,n) {}
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf) : super(f,l,n,hf) {}
+ vcl_hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f,l,n,hf, eql) {}
+ vcl_hash_map(const_iterator f, const_iterator l) : super(f,l) { }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n) : super(f,l,n) { }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf) : super(f, l, n, hf) { }
+ vcl_hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f, l, n, hf, eql) { }
+ friend inline bool operator==(const self& hm1, const self& hm2);
+};
+
+
+template <class Key, class T, class HashFcn, class EqualKey >
+inline bool operator==(const vcl_hash_map<Key, T, HashFcn,EqualKey>& hm1,
+ const vcl_hash_map<Key, T, HashFcn,EqualKey>& hm2)
+{
+ typedef vcl_hash_map<Key, T, HashFcn,EqualKey>::super super;
+ return (const super&)hm1 == (const super&)hm2;
+}
+
+// provide a "default" vcl_hash_multimap adaptor
+template <class Key, class T, class HashFcn, class EqualKey >
+class vcl_hash_multimap : public VCL_hash_multimap__<Key, T, HashFcn, EqualKey, vcl_alloc>
+{
+ typedef vcl_hash_multimap<Key, T, HashFcn, EqualKey> self;
+public:
+ typedef VCL_hash_multimap__<Key, T, HashFcn, EqualKey, vcl_alloc> super;
+ VCL_IMPORT_CONTAINER_TYPEDEFS(super)
+ typedef typename super::key_type key_type;
+ typedef typename super::hasher hasher;
+ typedef typename super::key_equal key_equal;
+ typedef T data_type;
+ typedef typename super::pointer pointer;
+ typedef typename super::const_pointer const_pointer;
+ vcl_hash_multimap() {}
+ vcl_hash_multimap(size_type n) : super(n) {}
+ vcl_hash_multimap(size_type n, const hasher& hf) : super(n, hf) {}
+ vcl_hash_multimap(size_type n, const hasher& hf, const key_equal& eql): super(n, hf, eql) {}
+ vcl_hash_multimap(const value_type* f, const value_type* l) : super(f,l) {}
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n): super(f,l,n) {}
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf) : super(f,l,n,hf) {}
+ vcl_hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f,l,n,hf, eql) {}
+
+ vcl_hash_multimap(const_iterator f, const_iterator l) : super(f,l) { }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n) : super(f,l,n) { }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf) : super(f, l, n, hf) { }
+ vcl_hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f, l, n, hf, eql) { }
+ friend inline bool operator==(const self& hm1, const self& hm2);
+};
+
+template <class Key, class T, class HashFcn, class EqualKey >
+inline bool operator==(const vcl_hash_multimap<Key, T, HashFcn,EqualKey>& hm1,
+ const vcl_hash_multimap<Key, T, HashFcn,EqualKey>& hm2)
+{
+ typedef vcl_hash_multimap<Key, T, HashFcn,EqualKey>::super super;
+ return (const super&)hm1 == (const super&)hm2;
+}
+
+# endif /* VCL_STL_DEFAULT_TYPE_PARAM */
+
+#define VCL_HASH_MAP_INSTANTIATE \
+extern "please include emulation/vcl_hash_map.txx instead"
+
+#endif // vcl_emulation_hash_map_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.txx
new file mode 100644
index 0000000000000000000000000000000000000000..30c867d1ce3df2922a573339d3fc35a08d8330b1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_map.txx
@@ -0,0 +1,79 @@
+// -*- c++ -*-
+#ifndef vcl_emulation_hash_map_txx_
+#define vcl_emulation_hash_map_txx_
+
+#include <vcl_compiler.h>
+#include "vcl_hash_map.h"
+#include "vcl_hash.txx"
+#include "vcl_pair.txx"
+#include "vcl_functional.txx"
+
+/////////////////////////////////////////////////////////////////////////////
+
+// --- Hash Map ---
+
+// * You can't call VCL_HASH_MAP_INSTANTIATE twice from within the same macro
+// as the __LINE__ will be the same.
+
+// This macro ensures that the type is usable as a key for a hash map.
+#define VCL_HASHKEY_INSTANTIATE(Key) \
+template struct vcl_equal_to<Key >
+
+// Then this macro may be used to instantiate the specific hash_maps.
+#undef VCL_HASH_MAP_INSTANTIATE
+#define VCL_HASH_MAP_INSTANTIATE(Key, Value, Hash, Comp) \
+template class vcl_hash_map<Key, Value, Hash, Comp VCL_DFL_TMPL_ARG(vcl_alloc) >; \
+template class vcl_hash_multimap<Key, Value, Hash, Comp VCL_DFL_TMPL_ARG(vcl_alloc) >; \
+VCL_HASHTABLE_MAP_PAIR_INSTANTIATE(Key, Value, Hash, Comp, __LINE__)
+
+// This macro uses the TAG to generate unique (within this compilation
+// unit) typedef names.
+#define VCL_HASH_MAP_TAG_INSTANTIATE(Key, Value, Hash, Comp, TAG) \
+template class vcl_hash_map<Key, Value, Hash, Comp VCL_DFL_TMPL_ARG(vcl_alloc) >; \
+template class vcl_hash_multimap<Key, Value, Hash, Comp VCL_DFL_TMPL_ARG(vcl_alloc) >; \
+VCL_HASHTABLE_MAP_PAIR_INSTANTIATE(Key, Value, Hash, Comp, TAG)
+
+// This "identity" passthru gets __LINE__ expanded
+#define VCL_HASHTABLE_MAP_PAIR_INSTANTIATE(Key, Value, Hash, Comp, TAG) \
+VCL_HASHTABLE_MAP_PAIR_INSTANTIATEx(Key, Value, Hash, Comp, TAG)
+
+// Here is where the pair for the hash_map is instantiated.
+#define VCL_HASHTABLE_MAP_PAIR_INSTANTIATEx(Key, Value, Hash, Comp, TAG) \
+typedef vcl_pair<const Key, Value > HTPairc ## TAG; \
+VCL_HASHTABLE_PAIR_INSTANTIATE(Key, HTPairc ## TAG, Hash, Comp, TAG)
+
+// And here is where the hashtable of key/value gets instantiated.
+#define VCL_HASHTABLE_PAIR_INSTANTIATE(T, HTPair, Hash, Comp, TAG) \
+VCL_HASHTABLE_INSTANTIATE(T, HTPair, vcl_select1st<HTPair >, Hash, Comp, TAG)
+
+/////////////////////////////////////////////////////////////////////////////
+
+
+// --- HASH TABLE ---
+#define VCL_HASHTABLE_INSTANTIATE(Key, Value, GetKey, Hash, Compare, TAG) \
+template class vcl_hashtable<Value, Key, Hash, GetKey, Compare, vcl_alloc >; \
+template class vcl_hashtable_base< Value, vcl_alloc >; \
+template struct vcl_hashtable_iterator<Value, Key, Hash, GetKey, Compare, vcl_alloc >; \
+typedef vcl_hashtable_iterator<Value, Key, Hash, GetKey, Compare, vcl_alloc > HTIter ## TAG; \
+VCL_UNARY_INSTANTIATE(Hash); \
+VCL_UNARY_INSTANTIATE(Compare); \
+VCL_UNARY_INSTANTIATE(GetKey); \
+VCL_ITER_FWD_INSTANTIATE(HTIter ## TAG); \
+VCL_PAIR_INSTANTIATE(HTIter ## TAG, bool); \
+VCL_PAIR_INSTANTIATE(HTIter ## TAG, HTIter ## TAG); \
+template struct vcl_hashtable_const_iterator<Value, Key, Hash, GetKey, Compare, vcl_alloc >; \
+typedef vcl_hashtable_const_iterator<Value, Key, Hash, GetKey, Compare, vcl_alloc > HTIterc ## TAG; \
+VCL_ITER_FWD_INSTANTIATE(HTIterc ## TAG); \
+VCL_INSTANTIATE_INLINE(void vcl_distance(HTIterc ## TAG, HTIterc ## TAG, vcl_size_t&)); \
+VCL_INSTANTIATE_INLINE(void __distance(HTIterc ## TAG, HTIterc ## TAG const &, vcl_size_t &, vcl_forward_iterator_tag)); \
+VCL_PAIR_INSTANTIATE(HTIterc ## TAG, bool); \
+VCL_PAIR_INSTANTIATE(HTIterc ## TAG, HTIterc ## TAG); \
+template struct vcl_hashtable_node<Value >; \
+typedef vcl_hashtable_node<Value > HTNode ## TAG; \
+typedef vcl_hashtable_node<Value >* HTNodeP ## TAG; \
+VCL_UNARY_INSTANTIATE(HTNodeP ## TAG); \
+VCL_UNARY_INSTANTIATE(HTNodeP ## TAG *); \
+VCL_CONTAINABLE_INSTANTIATE(HTNodeP ## TAG); \
+VCL_VECTOR_INSTANTIATE(HTNodeP ## TAG)
+
+#endif // vcl_emulation_hash_map_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_set.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_set.h
new file mode 100644
index 0000000000000000000000000000000000000000..32bf476b53a9f54edd8233515a82c549ce3d1370
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hash_set.h
@@ -0,0 +1,381 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_hash_set_h
+#define vcl_emulation_hash_set_h
+
+#include "vcl_hashtable.h"
+
+__BEGIN_STL_FULL_NAMESPACE
+# define vcl_hash_set __WORKAROUND_RENAME(vcl_hash_set)
+# define vcl_hash_multiset __WORKAROUND_RENAME(vcl_hash_multiset)
+
+template <class Value, VCL_DFL_TMPL_PARAM_STLDECL(HashFcn,vcl_hash<Value>),
+ VCL_DFL_TMPL_PARAM_STLDECL(EqualKey,vcl_equal_to<Value>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_hash_set
+{
+private:
+ typedef vcl_hashtable<Value, Value, HashFcn, vcl_identity<Value>,
+ EqualKey, Alloc> ht;
+ typedef vcl_hash_set<Value, HashFcn, EqualKey, Alloc> self;
+public:
+ typedef typename ht::key_type key_type;
+ typedef typename ht::value_type value_type;
+ typedef typename ht::hasher hasher;
+ typedef typename ht::key_equal key_equal;
+
+ typedef typename ht::size_type size_type;
+ typedef typename ht::difference_type difference_type;
+ typedef typename ht::const_pointer pointer;
+ typedef typename ht::const_pointer const_pointer;
+ typedef typename ht::const_reference reference;
+ typedef typename ht::const_reference const_reference;
+ // SunPro bug
+ typedef typename ht::const_iterator const_iterator;
+ typedef const_iterator iterator;
+
+ // vc6 addition
+ typedef typename ht::iterator ht_iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+private:
+ ht rep;
+
+public:
+ vcl_hash_set() : rep(100, hasher(), key_equal()) {}
+ vcl_hash_set(size_type n) : rep(n, hasher(), key_equal()) {}
+ vcl_hash_set(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ vcl_hash_set(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+ vcl_hash_set(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+ vcl_hash_set(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(self& hs) { rep.swap(hs.rep); }
+ friend inline bool operator==(const vcl_hash_set<Value,HashFcn,EqualKey,Alloc>&,
+ const vcl_hash_set<Value,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() const { return rep.begin(); }
+ iterator end() const { return rep.end(); }
+
+public:
+ vcl_pair<iterator, bool> insert(const value_type& obj)
+ {
+#ifdef VC50
+ vcl_pair< ht::iterator, bool> p = rep.insert_unique(obj);
+#else
+ vcl_pair<typename ht::iterator, bool> p = rep.insert_unique(obj);
+#endif
+ return vcl_pair<iterator, bool>(p.first, p.second);
+ }
+ void insert(const value_type* f, const value_type* l) { rep.insert_unique(f,l); }
+ void insert(const_iterator f, const_iterator l) { rep.insert_unique(f, l); }
+ vcl_pair<iterator, bool> insert_noresize(const value_type& obj)
+ {
+#ifdef VC50
+ vcl_pair<ht::iterator, bool> p = rep.insert_unique_noresize(obj);
+#else
+ vcl_pair<typename ht::iterator, bool> p = rep.insert_unique_noresize(obj);
+#endif
+ return vcl_pair<iterator, bool>(p.first, p.second);
+ }
+
+ iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ vcl_pair<iterator, iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+
+template <class Value, VCL_DFL_TMPL_PARAM_STLDECL(HashFcn,vcl_hash<Value>),
+ VCL_DFL_TMPL_PARAM_STLDECL(EqualKey,vcl_equal_to<Value>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_hash_multiset
+{
+private:
+ typedef vcl_hashtable<Value, Value, HashFcn, vcl_identity<Value>,
+ EqualKey, Alloc> ht;
+ typedef vcl_hash_multiset<Value, HashFcn, EqualKey, Alloc> self;
+public:
+ typedef typename ht::key_type key_type;
+ typedef typename ht::value_type value_type;
+ typedef typename ht::hasher hasher;
+ typedef typename ht::key_equal key_equal;
+
+ typedef typename ht::size_type size_type;
+ typedef typename ht::difference_type difference_type;
+ typedef typename ht::const_pointer pointer;
+ typedef typename ht::const_pointer const_pointer;
+ typedef typename ht::const_reference reference;
+ typedef typename ht::const_reference const_reference;
+
+ typedef typename ht::const_iterator const_iterator;
+ // SunPro bug
+ typedef const_iterator iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+private:
+ ht rep;
+
+public:
+ vcl_hash_multiset() : rep(100, hasher(), key_equal()) {}
+ vcl_hash_multiset(size_type n) : rep(n, hasher(), key_equal()) {}
+ vcl_hash_multiset(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ vcl_hash_multiset(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+ vcl_hash_multiset(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+ vcl_hash_multiset(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(self& hs) { rep.swap(hs.rep); }
+ friend inline bool operator==(const vcl_hash_multiset<Value,HashFcn,EqualKey,Alloc>&,
+ const vcl_hash_multiset<Value,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() const { return rep.begin(); }
+ iterator end() const { return rep.end(); }
+
+public:
+ iterator insert(const value_type& obj) { return rep.insert_equal(obj); }
+ void insert(const value_type* f, const value_type* l) { rep.insert_equal(f,l); }
+ void insert(const_iterator f, const_iterator l) { rep.insert_equal(f, l); }
+ iterator insert_noresize(const value_type& obj)
+ { return rep.insert_equal_noresize(obj); }
+
+ iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ vcl_pair<iterator, iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+__END_STL_FULL_NAMESPACE
+
+// do a cleanup
+# undef vcl_hash_set
+# undef vcl_hash_multiset
+// provide a uniform way to access full functionality
+# define __hash_set__ __FULL_NAME(vcl_hash_set)
+# define __hash_multiset__ __FULL_NAME(vcl_hash_multiset)
+
+template <class Value, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const __hash_set__<Value, HashFcn, EqualKey, Alloc>& hs1,
+ const __hash_set__<Value, HashFcn, EqualKey, Alloc>& hs2)
+{
+ return hs1.rep == hs2.rep;
+}
+
+template <class Value, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const __hash_multiset__<Value, HashFcn, EqualKey, Alloc>& hs1,
+ const __hash_multiset__<Value, HashFcn, EqualKey, Alloc>& hs2)
+{
+ return hs1.rep == hs2.rep;
+}
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class Value, class HashFcn, class EqualKey, class Alloc>
+inline void swap(__hash_multiset__<Value, HashFcn, EqualKey, Alloc>& a,
+ __hash_multiset__<Value, HashFcn, EqualKey, Alloc>& b) { a.swap(b); }
+template <class Value, class HashFcn, class EqualKey, class Alloc>
+inline void swap(__hash_set__<Value, HashFcn, EqualKey, Alloc>& a,
+ __hash_set__<Value, HashFcn, EqualKey, Alloc>& b) { a.swap(b); }
+# endif
+
+# ifndef __STL_DEFAULT_TYPE_PARAM
+// provide a "default" vcl_hash_set adaptor
+template <class Value, class HashFcn, class EqualKey >
+class vcl_hash_set : public __hash_set__<Value, HashFcn, EqualKey, vcl_alloc>
+{
+ typedef vcl_hash_set<Value, HashFcn, EqualKey> self;
+public:
+ typedef __hash_set__<Value, HashFcn, EqualKey, vcl_alloc> super;
+ __IMPORT_CONTAINER_TYPEDEFS(super)
+ typedef typename super::key_type key_type;
+ typedef typename super::hasher hasher;
+ typedef typename super::key_equal key_equal;
+ typedef typename super::pointer pointer;
+ typedef typename super::const_pointer const_pointer;
+ vcl_hash_set() {}
+ vcl_hash_set(size_type n) : super(n) {}
+ vcl_hash_set(size_type n, const hasher& hf) : super(n, hf) {}
+ vcl_hash_set(size_type n, const hasher& hf, const key_equal& eql): super(n, hf, eql) {}
+
+ vcl_hash_set(const value_type* f, const value_type* l) : super(f,l) {}
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n): super(f,l,n) {}
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf) : super(f,l,n,hf) {}
+ vcl_hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f,l,n,hf, eql) {}
+
+ vcl_hash_set(const_iterator f, const_iterator l) : super(f,l) { }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n) : super(f,l,n) { }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf) : super(f, l, n, hf) { }
+ vcl_hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f, l, n, hf, eql) { }
+ friend inline bool operator==(const self& hs1, const self& hs2);
+};
+
+template <class Value, class HashFcn,class EqualKey >
+inline bool operator==(const vcl_hash_set<Value, HashFcn,EqualKey>& hs1,
+ const vcl_hash_set<Value, HashFcn,EqualKey>& hs2)
+{
+ typedef vcl_hash_set<Value, HashFcn,EqualKey>::super super;
+ return (const super&)hs1 == (const super&)hs2;
+}
+
+// provide a "default" vcl_hash_multiset adaptor
+template <class Value, class HashFcn, class EqualKey >
+class vcl_hash_multiset : public __hash_multiset__<Value, HashFcn, EqualKey, vcl_alloc>
+{
+ typedef vcl_hash_multiset<Value, HashFcn, EqualKey> self;
+public:
+ typedef __hash_multiset__<Value, HashFcn, EqualKey, vcl_alloc> super;
+ __IMPORT_CONTAINER_TYPEDEFS(super)
+ typedef typename super::key_type key_type;
+ typedef typename super::hasher hasher;
+ typedef typename super::key_equal key_equal;
+ typedef typename super::pointer pointer;
+ typedef typename super::const_pointer const_pointer;
+
+ vcl_hash_multiset() {}
+ vcl_hash_multiset(size_type n) : super(n) {}
+ vcl_hash_multiset(size_type n, const hasher& hf) : super(n, hf) {}
+ vcl_hash_multiset(size_type n, const hasher& hf, const key_equal& eql): super(n, hf, eql) {}
+
+ vcl_hash_multiset(const value_type* f, const value_type* l) : super(f,l) {}
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n): super(f,l,n) {}
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf) : super(f,l,n,hf) {}
+ vcl_hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f,l,n,hf, eql) {}
+
+ vcl_hash_multiset(const_iterator f, const_iterator l) : super(f,l) { }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n) : super(f,l,n) { }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf) : super(f, l, n, hf) { }
+ vcl_hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql) : super(f, l, n, hf, eql) { }
+ friend inline bool operator==(const self& hs1, const self& hs2);
+};
+
+template <class Value, class HashFcn,class EqualKey >
+inline bool operator==(const vcl_hash_multiset<Value, HashFcn,EqualKey>& hs1,
+ const vcl_hash_multiset<Value, HashFcn,EqualKey>& hs2)
+{
+ typedef vcl_hash_multiset<Value, HashFcn,EqualKey>::super super;
+ return (const super&)hs1 == (const super&)hs2;
+}
+
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+#endif // vcl_emulation_hash_set_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.cxx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..66683f5ab16a197cbcce1aae5528f6c46ef428f3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.cxx
@@ -0,0 +1,21 @@
+#include <vcl_compiler.h>
+#if !VCL_USE_NATIVE_STL
+
+#include "vcl_hashtable.h"
+
+#if ( __STL_STATIC_TEMPLATE_DATA > 0 ) && ! defined (VCL_WIN32)
+
+//template struct __stl_prime<false>;
+
+const unsigned long VCL_prime<false>::list_[] =
+{
+ 53, 97, 193, 389, 769,
+ 1543, 3079, 6151, 12289, 24593,
+ 49157, 98317, 196613, 393241, 786433,
+ 1572869, 3145739, 6291469, 12582917, 25165843,
+ 50331653, 100663319, 201326611, 402653189, 805306457,
+ 1610612741, 3221225473U, 4294967291U
+};
+
+#endif
+#endif // VCL_USE_NATIVE_STL
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.h
new file mode 100644
index 0000000000000000000000000000000000000000..07376ca7f4235d4fde3516fe440d05636523628e
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_hashtable.h
@@ -0,0 +1,1011 @@
+// This is vcl/emulation/vcl_hashtable.h
+//
+// Copyright (c) 1996
+// Silicon Graphics Computer Systems, Inc.
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Silicon Graphics makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+//
+// Copyright (c) 1994
+// Hewlett-Packard Company
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Hewlett-Packard Company makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+// Exception Handling:
+// Copyright (c) 1997
+// Mark of the Unicorn, Inc.
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Mark of the Unicorn makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+// Adaptation:
+// Copyright (c) 1997
+// Moscow Center for SPARC Technology
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Moscow Center for SPARC Technology makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+#ifndef vcl_emulation_hashtable_h
+#define vcl_emulation_hashtable_h
+
+// Hashtable class, used to implement the hashed associative containers
+// vcl_hash_set, vcl_hash_map, vcl_hash_multiset, and vcl_hash_multimap.
+
+
+//#include <vcl_cstdlib.h>
+
+#include "vcl_alloc.h"
+#include <vcl_algorithm.h>
+#include <vcl_iterator.h>
+#include <vcl_vector.h>
+#include "vcl_pair.h"
+#include <vcl_exception.h>
+//#include <vcl_memory.h>
+
+#if defined ( __STL_USE_ABBREVS )
+# define vcl_hashtable_iterator hTIt
+# define vcl_hashtable_const_iterator hTcIt
+# define vcl_hashtable_node hTN
+# define vcl_hashtable_base hTB
+# define vcl_hashtable hT
+#endif
+
+#if defined(VCL_EMULATION_STLCONF_H_INCLUDED)
+#define VCL_debug_do(x) __stl_debug_do(x)
+#define VCL_debug_check(x) __stl_debug_check(x)
+#define VCL_verbose_assert(expr, msg) __stl_verbose_assert(expr, msg)
+#else
+#define VCL_debug_do(x)
+#define VCL_debug_check(x)
+#define VCL_verbose_assert(expr, msg)
+#endif
+
+template <class Key> struct vcl_hash { };
+
+inline vcl_size_t VCL_hash_string(const char* s)
+{
+ unsigned long h = 0;
+ for (; *s; ++s)
+ h = 5*h + *s;
+
+ return vcl_size_t(h);
+}
+
+struct vcl_hash<char*>
+{
+ vcl_size_t operator()(const char* s) const { return VCL_hash_string(s); }
+};
+
+struct vcl_hash<const char*>
+{
+ vcl_size_t operator()(const char* s) const { return VCL_hash_string(s); }
+};
+
+struct vcl_hash<char> {
+ vcl_size_t operator()(char x) const { return x; }
+};
+struct vcl_hash<unsigned char> {
+ vcl_size_t operator()(unsigned char x) const { return x; }
+};
+struct vcl_hash<signed char> {
+ vcl_size_t operator()(unsigned char x) const { return x; }
+};
+struct vcl_hash<short> {
+ vcl_size_t operator()(short x) const { return x; }
+};
+struct vcl_hash<unsigned short> {
+ vcl_size_t operator()(unsigned short x) const { return x; }
+};
+struct vcl_hash<int> {
+ vcl_size_t operator()(int x) const { return x; }
+};
+struct vcl_hash<unsigned int> {
+ vcl_size_t operator()(unsigned int x) const { return x; }
+};
+struct vcl_hash<long> {
+ vcl_size_t operator()(long x) const { return x; }
+};
+struct vcl_hash<unsigned long> {
+ vcl_size_t operator()(unsigned long x) const { return x; }
+};
+
+template <class Value>
+struct vcl_hashtable_node
+{
+ typedef vcl_hashtable_node<Value> self;
+ self* next;
+ Value val;
+};
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey , VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc)>
+class vcl_hashtable;
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+struct vcl_hashtable_iterator;
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+struct vcl_hashtable_const_iterator;
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+struct vcl_hashtable_iterator
+{
+ typedef vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> hash_table;
+ typedef vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> iterator;
+ typedef vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> const_iterator;
+ typedef vcl_hashtable_node<Value> node;
+ typedef vcl_size_t size_type;
+ typedef Value& reference;
+ typedef const Value& const_reference;
+
+ node* cur;
+ hash_table* ht;
+
+ vcl_hashtable_iterator(node* n, hash_table* tab) : cur(n), ht(tab) {}
+ vcl_hashtable_iterator() {}
+ reference operator*() const {
+ VCL_verbose_assert(valid() && cur!=0,__STL_MSG_NOT_DEREFERENCEABLE);
+ return cur->val;
+ }
+ inline iterator& operator++();
+ inline iterator operator++(int);
+ bool operator==(const iterator& it) const {
+ VCL_debug_check(__check_same_owner(*this,it));
+ return cur == it.cur;
+ }
+ bool operator!=(const iterator& it) const {
+ VCL_debug_check(__check_same_owner(*this,it));
+ return cur != it.cur;
+ }
+};
+
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+struct vcl_hashtable_const_iterator
+{
+ typedef vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> hash_table;
+ typedef vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> iterator;
+ typedef vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> const_iterator;
+ typedef vcl_hashtable_node<Value> node;
+ typedef vcl_size_t size_type;
+ typedef Value& reference;
+ typedef const Value& const_reference;
+
+ const node* cur;
+ const hash_table* ht;
+
+ vcl_hashtable_const_iterator(const node* n, const hash_table* tab) : cur(n), ht(tab) {}
+ vcl_hashtable_const_iterator() {}
+ vcl_hashtable_const_iterator(const iterator& it) : cur(it.cur), ht(it.ht) {}
+
+ const_reference operator*() const {
+ VCL_verbose_assert(valid() && cur!=0,__STL_MSG_NOT_DEREFERENCEABLE);
+ return cur->val;
+ }
+ inline const_iterator& operator++();
+ inline const_iterator operator++(int);
+ bool operator==(const const_iterator& it) const {
+ VCL_debug_check(__check_same_owner(*this,it));
+ return cur == it.cur;
+ }
+ bool operator!=(const const_iterator& it) const {
+ VCL_debug_check(__check_same_owner(*this,it));
+ return cur != it.cur;
+ }
+};
+
+// Note: assumes long is at least 32 bits.
+// fbp: try to avoid intances in every module
+enum { VCL_num_primes = 28 };
+
+#if ( __STL_STATIC_TEMPLATE_DATA > 0 ) && ! defined (VCL_WIN32)
+# define VCL_prime_list VCL_prime<false>::list_
+ template <bool dummy> struct VCL_prime { public: static const unsigned long list_[]; };
+//rick put vcl_list in single .o dummy here so array constant parses
+// template <bool dummy>
+// const unsigned long VCL_prime<dummy>::list_[] =
+ static const unsigned long VCL_prime_list_dummy[VCL_num_primes] =
+# else
+# if ( __STL_WEAK_ATTRIBUTE > 0 )
+ extern const unsigned long VCL_prime_list[VCL_num_primes] __attribute__((weak)) =
+# else
+ // give up
+ static const unsigned long VCL_prime_list[VCL_num_primes] =
+# endif // __STL_WEAK_ATTRIBUTE
+#endif // __STL_STATIC_TEMPLATE_DATA
+{
+ 53, 97, 193, 389, 769,
+ 1543, 3079, 6151, 12289, 24593,
+ 49157, 98317, 196613, 393241, 786433,
+ 1572869, 3145739, 6291469, 12582917, 25165843,
+ 50331653, 100663319, 201326611, 402653189, 805306457,
+ 1610612741, 3221225473U, 4294967291U
+};
+
+inline unsigned long VCL_next_prime(unsigned long n)
+{
+ const unsigned long* first = VCL_prime_list;
+ const unsigned long* last = VCL_prime_list;
+ last += VCL_num_primes;
+ const unsigned long* pos = vcl_lower_bound(first, last, n);
+ return pos == last ? *(last - 1) : *pos;
+}
+
+template <class Value, class Alloc>
+class vcl_hashtable_base
+{
+ private:
+ typedef Value value_type;
+ typedef vcl_size_t size_type;
+ typedef vcl_hashtable_node<Value> node;
+ typedef vcl_simple_alloc<node, Alloc> node_allocator;
+ public: // These are public to get around restriction on protected access
+ typedef vcl_vector<VCL_SUNPRO_ALLOCATOR_HACK(node*) > buckets_type;
+ buckets_type buckets; // awf killed optional allocator
+ size_type num_elements;
+ protected:
+ inline void clear();
+
+ node* new_node(const value_type& obj)
+ {
+ node* n = node_allocator::allocate();
+ vcl_try {
+ new (&(n->val)) value_type(obj);
+ }
+ vcl_catch_all {
+ node_allocator::deallocate(n);
+ vcl_throw "";
+ }
+ n->next = 0;
+ return n;
+ }
+
+ void delete_node(node* n)
+ {
+#define vcli_destroy(T, p) ((T*)p)->~T()
+ vcli_destroy(Value, &(n->val));
+#undef vcli_destroy
+ node_allocator::deallocate(n);
+ }
+
+ inline void copy_from(const vcl_hashtable_base<Value,Alloc>& ht);
+
+ public: // These are public to get around restriction on protected access
+ vcl_hashtable_base() : num_elements(0) { }
+ ~vcl_hashtable_base() { clear(); VCL_debug_do(invalidate()); }
+};
+
+
+// forward declarations
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc> class vcl_hashtable;
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+ bool operator== (vcl_hashtable<Value,Key,HashFcn,ExtractKey,EqualKey,Alloc>const&,
+ vcl_hashtable<Value,Key,HashFcn,ExtractKey,EqualKey,Alloc>const&);
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+class vcl_hashtable : protected vcl_hashtable_base<Value, Alloc>
+{
+ typedef vcl_hashtable_base<Value, Alloc> super;
+ typedef vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> self;
+ public:
+ typedef Key key_type;
+ typedef Value value_type;
+ typedef HashFcn hasher;
+ typedef EqualKey key_equal;
+
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef value_type* pointer;
+ typedef const value_type* const_pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+
+ hasher hash_funct() const { return hashfun; }
+ key_equal key_eq() const { return equals; }
+
+ private:
+ hasher hashfun;
+ key_equal equals;
+ ExtractKey get_key;
+
+ typedef vcl_hashtable_node<Value> node;
+ typedef vcl_simple_alloc<node, Alloc> node_allocator;
+
+ public:
+ typedef vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> iterator;
+ typedef vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey,Alloc> const_iterator;
+ friend struct
+ vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>;
+ friend struct
+ vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>;
+
+ public:
+ vcl_hashtable(size_type n,
+ const HashFcn& hf,
+ const EqualKey& eql,
+ const ExtractKey& ext)
+ : hashfun(hf), equals(eql), get_key(ext)
+ {
+ VCL_debug_do(safe_init(this));
+ initialize_buckets(n);
+ }
+
+ vcl_hashtable(size_type n,
+ const HashFcn& hf,
+ const EqualKey& eql)
+ : hashfun(hf), equals(eql), get_key(ExtractKey())
+ {
+ VCL_debug_do(safe_init(this));
+ initialize_buckets(n);
+ }
+
+ vcl_hashtable(const self& ht)
+ : hashfun(ht.hashfun), equals(ht.equals), get_key(ht.get_key)
+ {
+ VCL_debug_do(safe_init(this));
+ copy_from(ht);
+ }
+
+ self& operator= (const self& ht)
+ {
+ if (&ht != this) {
+ hashfun = ht.hashfun;
+ equals = ht.equals;
+ get_key = ht.get_key;
+ clear();
+ buckets.clear();
+ copy_from(ht);
+ }
+ return *this;
+ }
+
+ ~vcl_hashtable() {}
+
+ size_type size() const { return num_elements; }
+ size_type max_size() const { return size_type(-1); }
+ bool empty() const { return size() == 0; }
+
+ void swap(self& ht)
+ {
+ vcl_swap(hashfun, ht.hashfun);
+ vcl_swap(equals, ht.equals);
+ vcl_swap(get_key, ht.get_key);
+ buckets.swap(ht.buckets);
+ vcl_swap(num_elements, ht.num_elements);
+ VCL_debug_do(swap_owners(ht));
+ }
+
+ iterator begin()
+ {
+ for (size_type n = 0; n < buckets.size(); ++n)
+ if (buckets[n])
+ return iterator(buckets[n], this);
+ return end();
+ }
+
+ iterator end() { return iterator((node*)0, this); }
+
+ const_iterator begin() const
+ {
+ for (size_type n = 0; n < buckets.size(); ++n)
+ if (buckets[n])
+ return const_iterator(buckets[n], this);
+ return end();
+ }
+
+ const_iterator end() const { return const_iterator((node*)0, this); }
+
+ bool operator== VCL_NULL_TMPL_ARGS (const self& ht2) const
+ {
+ if (buckets.size() != ht2.buckets.size())
+ return false;
+ for (int n = 0; n < buckets.size(); ++n) {
+ typename node* cur1 = buckets[n];
+ typename node* cur2 = ht2.buckets[n];
+ for (; cur1 && cur2 && cur1->val == cur2->val;
+ cur1 = cur1->next, cur2 = cur2->next)
+ {}
+ if (cur1 || cur2)
+ return false;
+ }
+ return true;
+ }
+
+ public:
+
+ size_type bucket_count() const { return buckets.size(); }
+
+ size_type max_bucket_count() const
+ { return VCL_prime_list[VCL_num_primes - 1]; }
+
+ size_type elems_in_bucket(size_type bucket) const
+ {
+ size_type result = 0;
+ for (node* cur = buckets[bucket]; cur; cur = cur->next)
+ result += 1;
+ return result;
+ }
+
+ vcl_pair<iterator, bool> insert_unique(const value_type& obj)
+ {
+ resize(num_elements + 1);
+ return insert_unique_noresize(obj);
+ }
+
+ iterator insert_equal(const value_type& obj)
+ {
+ resize(num_elements + 1);
+ return insert_equal_noresize(obj);
+ }
+
+ inline vcl_pair<iterator, bool> insert_unique_noresize(const value_type& obj);
+ inline iterator insert_equal_noresize(const value_type& obj);
+
+ void insert_unique(const value_type* f, const value_type* l)
+ {
+ size_type n = l - f;
+ resize(num_elements + n);
+ for (; n > 0; --n)
+ insert_unique_noresize(*f++);
+ }
+
+ void insert_equal(const value_type* f, const value_type* l)
+ {
+ size_type n = l - f;
+ resize(num_elements + n);
+ for (; n > 0; --n)
+ insert_equal_noresize(*f++);
+ }
+
+#if defined(VCL_WIN32)
+ static void vcl_distance(const_iterator f, const_iterator l, size_type& n) {
+ while (f != l) { ++f; ++n; }
+ }
+#endif
+
+
+ void insert_unique(const_iterator f, const_iterator l)
+ {
+ size_type n = 0;
+ vcl_distance(f, l, n);
+ resize(num_elements + n);
+ for (; n > 0; --n)
+ insert_unique_noresize(*f++);
+ }
+
+ void insert_equal(const_iterator f, const_iterator l)
+ {
+ size_type n = 0;
+ vcl_distance(f, l, n);
+ resize(num_elements + n);
+ for (; n > 0; --n)
+ insert_equal_noresize(*f++);
+ }
+
+ inline reference find_or_insert(const value_type& obj);
+
+ iterator find(const key_type& key)
+ {
+ size_type n = bkt_num_key(key);
+ node* first;
+ for ( first = buckets[n];
+ first && !equals(get_key(first->val), key);
+ first = first->next)
+ {}
+ return iterator(first, this);
+ }
+
+ const_iterator find(const key_type& key) const
+ {
+ size_type n = bkt_num_key(key);
+ const node* first;
+ for ( first = buckets[n];
+ first && !equals(get_key(first->val), key);
+ first = first->next)
+ {}
+ return const_iterator(first, this);
+ }
+
+ size_type count(const key_type& key) const
+ {
+ const size_type n = bkt_num_key(key);
+ size_type result = 0;
+
+ for (const node* cur = buckets[n]; cur; cur = cur->next)
+ if (equals(get_key(cur->val), key))
+ ++result;
+ return result;
+ }
+
+ inline vcl_pair<iterator, iterator> equal_range(const key_type& key);
+ inline vcl_pair<const_iterator, const_iterator> equal_range(const key_type& key) const;
+
+ inline size_type erase(const key_type& key);
+ inline void erase(const iterator& it);
+ inline void erase(iterator first, iterator last);
+
+ inline void erase(const const_iterator& it);
+ inline void erase(const_iterator first, const_iterator last);
+
+ inline void resize(size_type num_elements_hint);
+ void clear() { super::clear(); VCL_debug_do(invalidate_all()); }
+ private:
+ size_type next_size(size_type n) const { return VCL_next_prime(n); }
+
+ void initialize_buckets(size_type n)
+ {
+ const size_type n_buckets = next_size(n);
+ buckets.reserve(n_buckets);
+ buckets.insert(buckets.end(), n_buckets, (node*) 0);
+ num_elements = 0;
+ }
+ size_type bkt_num_key(const key_type& key) const{ return bkt_num_key(key, buckets.size()); }
+
+ size_type bkt_num(const value_type& obj) const { return bkt_num_key(get_key(obj)); }
+
+ size_type bkt_num_key(const key_type& key, vcl_size_t n) const { return hashfun(key) % n; }
+
+ size_type bkt_num(const value_type& obj, vcl_size_t n) const { return bkt_num_key(get_key(obj), n); }
+ inline void erase_bucket(const size_type n, node* first, node* last);
+ inline void erase_bucket(const size_type n, node* last);
+};
+
+// fbp: these defines are for outline methods definitions.
+// needed to definitions to be portable. Should not be used in method bodies.
+
+# if defined ( __STL_NESTED_TYPE_PARAM_BUG )
+# define __difference_type__ vcl_ptrdiff_t
+# define __size_type__ vcl_size_t
+# define __value_type__ Value
+# define __key_type__ Key
+# define __node__ vcl_hashtable_node<Value>
+# define __reference__ Value&
+# else
+# define __difference_type__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::difference_type
+# define __size_type__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::size_type
+# define __value_type__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::value_type
+# define __key_type__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::key_type
+# define __node__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::node
+# define __reference__ vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::reference
+# endif
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&
+vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::operator++()
+{
+ const node* old = cur;
+ VCL_verbose_assert(old!=0,__STL_MSG_INVALID_ADVANCE);
+ cur = cur->next;
+ if (!cur) {
+ size_type bucket = ht->bkt_num(old->val);
+ while (!cur && ++bucket < ht->buckets.size())
+ cur = ht->buckets[bucket];
+ }
+ return *this;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>
+vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::operator++(int)
+{
+ iterator tmp = *this;
+ ++*this;
+ return tmp;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&
+vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::operator++()
+{
+ const node* old = cur;
+ VCL_verbose_assert(old!=0,__STL_MSG_INVALID_ADVANCE);
+ cur = cur->next;
+ if (!cur) {
+ size_type bucket = ht->bkt_num(old->val);
+ while (!cur && ++bucket < ht->buckets.size())
+ cur = ht->buckets[bucket];
+ }
+ return *this;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>
+vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::operator++(int)
+{
+ const_iterator tmp = *this;
+ ++*this;
+ return tmp;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_forward_iterator_tag
+iterator_category (const vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return vcl_forward_iterator_tag();
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline Value*
+value_type(const vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return (Value*) 0;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_ptrdiff_t*
+distance_type(const vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return (vcl_ptrdiff_t*) 0;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_forward_iterator_tag
+iterator_category (const vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return vcl_forward_iterator_tag();
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline Value*
+value_type(const vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return (Value*) 0;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline vcl_ptrdiff_t*
+distance_type(const vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>&)
+{
+ return (vcl_ptrdiff_t*) 0;
+}
+
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+vcl_pair<vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>, bool>
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::insert_unique_noresize(const __value_type__& obj)
+{
+ const size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj)))
+ return vcl_pair<iterator, bool>(iterator(cur, this), false);
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return vcl_pair<iterator, bool>(iterator(tmp, this), true);
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::insert_equal_noresize(const __value_type__& obj)
+{
+ const size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj))) {
+ node* tmp = new_node(obj);
+ tmp->next = cur->next;
+ cur->next = tmp;
+ ++num_elements;
+ return iterator(tmp, this);
+ }
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return iterator(tmp, this);
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+typename __reference__
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::find_or_insert(const __value_type__& obj)
+{
+ resize(num_elements + 1);
+
+ size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj)))
+ return cur->val;
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return tmp->val;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+vcl_pair<vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>,
+ vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> >
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::equal_range(const __key_type__& key)
+{
+ typedef vcl_pair<iterator, iterator> pii;
+ const size_type n = bkt_num_key(key);
+
+ for (node* first = buckets[n]; first; first = first->next) {
+ if (equals(get_key(first->val), key)) {
+ for (node* cur = first->next; cur; cur = cur->next)
+ if (!equals(get_key(cur->val), key))
+ return pii(iterator(first, this), iterator(cur, this));
+ for (size_type m = n + 1; m < buckets.size(); ++m)
+ if (buckets[m])
+ return pii(iterator(first, this),
+ iterator(buckets[m], this));
+ return pii(iterator(first, this), end());
+ }
+ }
+ return pii(end(), end());
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+vcl_pair<vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>,
+ vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> >
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::equal_range(const __key_type__& key) const
+{
+ typedef vcl_pair<const_iterator, const_iterator> pii;
+ const size_type n = bkt_num_key(key);
+
+ for (const node* first = buckets[n]; first; first = first->next) {
+ if (equals(get_key(first->val), key)) {
+ for (const node* cur = first->next; cur; cur = cur->next)
+ if (!equals(get_key(cur->val), key))
+ return pii(const_iterator(first, this),
+ const_iterator(cur, this));
+ for (size_type m = n + 1; m < buckets.size(); ++m)
+ if (buckets[m])
+ return pii(const_iterator(first, this),
+ const_iterator(buckets[m], this));
+ return pii(const_iterator(first, this), end());
+ }
+ }
+ return pii(end(), end());
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+typename __size_type__
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase(const __key_type__& key)
+{
+ const size_type n = bkt_num_key(key);
+ node* first = buckets[n];
+ size_type erased = 0;
+
+ if (first) {
+ node* cur = first;
+ node* next = cur->next;
+ while (next) {
+ if (equals(get_key(next->val), key)) {
+ cur->next = next->next;
+ delete_node(next);
+ next = cur->next;
+ ++erased;
+ }
+ else {
+ cur = next;
+ next = cur->next;
+ }
+ }
+ if (equals(get_key(first->val), key)) {
+ buckets[n] = first->next;
+ delete_node(first);
+ ++erased;
+ }
+ }
+ num_elements -= erased;
+ return erased;
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase(
+ const vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>& it)
+{
+ VCL_verbose_assert(it.owner()==this, __STL_MSG_NOT_OWNER);
+ node* const p = it.cur;
+ if (p) {
+ const size_type n = bkt_num(p->val);
+ node* cur = buckets[n];
+
+ if (cur == p) {
+ buckets[n] = cur->next;
+ delete_node(cur);
+ --num_elements;
+ }
+ else {
+ node* next = cur->next;
+ while (next) {
+ if (next == p) {
+ cur->next = next->next;
+ delete_node(next);
+ --num_elements;
+ break;
+ }
+ else {
+ cur = next;
+ next = cur->next;
+ }
+ }
+ }
+ }
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase(
+ vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> first,
+ vcl_hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> last)
+{
+ size_type f_bucket = first.cur ? bkt_num(first.cur->val) : buckets.size();
+ size_type l_bucket = last.cur ? bkt_num(last.cur->val) : buckets.size();
+ VCL_debug_check(__check_if_owner(this,first)&&__check_if_owner(this,last));
+ VCL_verbose_assert(f_bucket <= l_bucket, __STL_MSG_INVALID_RANGE);
+ if (first.cur == last.cur)
+ return;
+ else if (f_bucket == l_bucket)
+ erase_bucket(f_bucket, first.cur, last.cur);
+ else {
+ erase_bucket(f_bucket, first.cur, 0);
+ for (size_type n = f_bucket + 1; n < l_bucket; ++n)
+ erase_bucket(n, 0);
+ if (l_bucket != buckets.size())
+ erase_bucket(l_bucket, last.cur);
+ }
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase(
+ vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> first,
+ vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc> last)
+{
+ erase(iterator(__CONST_CAST(node*,first.cur),
+ __CONST_CAST(self*,first.ht)),
+ iterator(__CONST_CAST(node*,last.cur),
+ __CONST_CAST(self*,last.ht)));
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+inline void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase(
+ const vcl_hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>& it)
+{
+ erase(iterator(__CONST_CAST(node*,it.cur),
+ __CONST_CAST(self*,it.ht)));
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::resize(__size_type__ num_elements_hint)
+{
+ const size_type old_n = buckets.size();
+ if (num_elements_hint > old_n) {
+ const size_type n = next_size(num_elements_hint);
+ if (n > old_n) {
+ typename vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::buckets_type tmp(n, (node*)0);
+ for (size_type bucket = 0; bucket < old_n; ++bucket) {
+ node* first = buckets[bucket];
+ while (first) {
+ size_type new_bucket = bkt_num(first->val, n);
+ buckets[bucket] = first->next;
+ first->next = tmp[new_bucket];
+ tmp[new_bucket] = first;
+ first = buckets[bucket];
+ }
+ }
+ buckets.clear();
+ buckets.swap(tmp);
+ }
+ }
+}
+
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase_bucket(
+ const vcl_size_t n,
+ vcl_hashtable_node<Value>* first,
+ vcl_hashtable_node<Value>* last)
+{
+ node* cur = buckets[n];
+ if (cur == first)
+ erase_bucket(n, last);
+ else {
+ node* next;
+ for (next = cur->next; next != first; cur = next, next = cur->next)
+ ;
+ while (next) {
+ cur->next = next->next;
+ delete_node(next);
+ next = cur->next;
+ --num_elements;
+ }
+ }
+}
+
+template <class Value, class Key, class HashFcn, class ExtractKey, class EqualKey, class Alloc>
+void
+vcl_hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>::erase_bucket(
+ const vcl_size_t n,
+ vcl_hashtable_node<Value>* last)
+{
+ node* cur = buckets[n];
+ while (cur != last) {
+ node* next = cur->next;
+ delete_node(cur);
+ cur = next;
+ buckets[n] = cur;
+ --num_elements;
+ }
+}
+
+template <class Value, class Alloc>
+void vcl_hashtable_base<Value, Alloc>::clear()
+{
+ for (size_type i = 0; i < buckets.size(); ++i) {
+ node* cur = buckets[i];
+ while (cur != 0) {
+ node* next = cur->next;
+ delete_node(cur);
+ cur = next;
+ }
+ buckets[i] = 0;
+ }
+ num_elements = 0;
+}
+
+
+template <class Value, class Alloc>
+void vcl_hashtable_base<Value, Alloc>::copy_from(const vcl_hashtable_base<Value, Alloc>& ht)
+{
+ buckets.reserve(ht.buckets.size());
+ buckets.insert(buckets.end(), ht.buckets.size(), (node*) 0);
+ for (size_type i = 0; i < ht.buckets.size(); ++i) {
+ const node* cur = ht.buckets[i];
+ if (cur) {
+ node* copy = new_node(cur->val);
+ buckets[i] = copy;
+ ++num_elements;
+
+ for (node* next = cur->next; next; cur = next, next = cur->next) {
+ copy->next = new_node(next->val);
+ ++num_elements;
+ copy = copy->next;
+ }
+ }
+ }
+}
+
+# undef __difference_type__
+# undef __size_type__
+# undef __value_type__
+# undef __key_type__
+# undef __node__
+
+#endif // vcl_emulation_hashtable_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_heap.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_heap.h
new file mode 100644
index 0000000000000000000000000000000000000000..3eaca5849e5de1794e0f92d89b8764136cb4a252
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_heap.h
@@ -0,0 +1,215 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+
+#ifndef vcl_emulation_heap_h
+#define vcl_emulation_heap_h
+
+#include "vcl_bool.h"
+
+template <class RandomAccessIterator, class Distance, class T>
+inline
+void __push_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance topIndex, T value) {
+ Distance parent = (holeIndex - 1) / 2;
+ while (holeIndex > topIndex && *(first + parent) < value) {
+ *(first + holeIndex) = *(first + parent);
+ holeIndex = parent;
+ parent = (holeIndex - 1) / 2;
+ }
+ *(first + holeIndex) = value;
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline void __push_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, Distance*, T*) {
+ __push_heap(first, Distance((last - first) - 1), Distance(0),
+ T(*(last - 1)));
+}
+
+template <class RandomAccessIterator>
+inline void vcl_push_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __push_heap_aux(first, last, distance_type(first), value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+inline
+void __push_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance topIndex, T value, Compare comp) {
+ Distance parent = (holeIndex - 1) / 2;
+ while (holeIndex > topIndex && comp(*(first + parent), value)) {
+ *(first + holeIndex) = *(first + parent);
+ holeIndex = parent;
+ parent = (holeIndex - 1) / 2;
+ }
+ *(first + holeIndex) = value;
+}
+
+template <class RandomAccessIterator, class Compare, class Distance, class T>
+inline void __push_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp, Distance*, T*) {
+ __push_heap(first, Distance((last - first) - 1), Distance(0),
+ T(*(last - 1)), comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_push_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp) {
+ __push_heap_aux(first, last, comp, distance_type(first), value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline
+void __adjust_heap(RandomAccessIterator first, Distance holeIndex, Distance len, T value) {
+ Distance topIndex = holeIndex;
+ Distance secondChild = 2 * holeIndex + 2;
+ while (secondChild < len) {
+ if (*(first + secondChild) < *(first + (secondChild - 1)))
+ secondChild--;
+ *(first + holeIndex) = *(first + secondChild);
+ holeIndex = secondChild;
+ secondChild = 2 * (secondChild + 1);
+ }
+ if (secondChild == len) {
+ *(first + holeIndex) = *(first + (secondChild - 1));
+ holeIndex = secondChild - 1;
+ }
+ __push_heap(first, holeIndex, topIndex, value);
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline void __pop_heap(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator result, T value, Distance*) {
+ *result = *first;
+ __adjust_heap(first, Distance(0), Distance(last - first), value);
+}
+
+template <class RandomAccessIterator, class T>
+inline void __pop_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ __pop_heap(first, last - 1, last - 1, T(*(last - 1)), distance_type(first));
+}
+
+template <class RandomAccessIterator>
+inline void vcl_pop_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __pop_heap_aux(first, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+inline
+void __adjust_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance len, T value, Compare comp) {
+ Distance topIndex = holeIndex;
+ Distance secondChild = 2 * holeIndex + 2;
+ while (secondChild < len) {
+ if (comp(*(first + secondChild), *(first + (secondChild - 1))))
+ secondChild--;
+ *(first + holeIndex) = *(first + secondChild);
+ holeIndex = secondChild;
+ secondChild = 2 * (secondChild + 1);
+ }
+ if (secondChild == len) {
+ *(first + holeIndex) = *(first + (secondChild - 1));
+ holeIndex = secondChild - 1;
+ }
+ __push_heap(first, holeIndex, topIndex, value, comp);
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+inline void __pop_heap(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator result, T value, Compare comp, Distance*) {
+ *result = *first;
+ __adjust_heap(first, Distance(0), Distance(last - first), value, comp);
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline void __pop_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Compare comp) {
+ __pop_heap(first, last - 1, last - 1, T(*(last - 1)), comp,
+ distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_pop_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp) {
+ __pop_heap_aux(first, last, value_type(first), comp);
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline
+void __make_heap(RandomAccessIterator first, RandomAccessIterator last, T*,
+ Distance*) {
+ if (last - first < 2) return;
+ Distance len = last - first;
+ Distance parent = (len - 2)/2;
+
+ while (true) {
+ __adjust_heap(first, parent, len, T(*(first + parent)));
+ if (parent == 0) return;
+ parent--;
+ }
+}
+
+template <class RandomAccessIterator>
+inline void vcl_make_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __make_heap(first, last, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare, class T, class Distance>
+inline
+void __make_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp, T*, Distance*) {
+ if (last - first < 2) return;
+ Distance len = last - first;
+ Distance parent = (len - 2)/2;
+
+ while (true) {
+ __adjust_heap(first, parent, len, T(*(first + parent)), comp);
+ if (parent == 0) return;
+ parent--;
+ }
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void vcl_make_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp) {
+ __make_heap(first, last, comp, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator>
+inline
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ while (last - first > 1) vcl_pop_heap(first, last--);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last, Compare comp) {
+ while (last - first > 1) vcl_pop_heap(first, last--, comp);
+}
+
+#endif // vcl_emulation_heap_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.h
new file mode 100644
index 0000000000000000000000000000000000000000..5c83ddf9c402de3a15216065496bc5f921499140
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.h
@@ -0,0 +1,568 @@
+//
+// Copyright (c) 1994
+// Hewlett-Packard Company
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Hewlett-Packard Company makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+//
+// Copyright (c) 1996
+// Silicon Graphics Computer Systems, Inc.
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Silicon Graphics makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+// Copyright (c) 1997
+// Moscow Center for SPARC Technology
+//
+// Permission to use, copy, modify, distribute and sell this software
+// and its documentation for any purpose is hereby granted without fee,
+// provided that the above copyright notice appear in all copies and
+// that both that copyright notice and this permission notice appear
+// in supporting documentation. Moscow Center for SPARC Technology makes no
+// representations about the suitability of this software for any
+// purpose. It is provided "as is" without express or implied warranty.
+//
+
+#ifndef vcl_emulation_iterator_h
+#define vcl_emulation_iterator_h
+
+#include <vcl_cstddef.h>
+#include <vcl_iostream.h>
+#include "vcl_functional.h"
+
+#if defined ( __STL_USE_ABBREVS )
+// ugliness is intentional - to reduce conflicts
+# define vcl_input_iterator_tag InItT
+# define vcl_output_iterator_tag OuItT
+# define vcl_bidirectional_iterator_tag BdItT
+# define vcl_random_access_iterator_tag RaItT
+# define vcl_forward_iterator FwIt
+# define vcl_input_iterator InIt
+# define vcl_output_iterator OuIt
+# define vcl_bidirectional_iterator BdIt
+# define vcl_random_access_iterator RaIt
+# define vcl_reverse_bidirectional_iterator rBdIt
+# define vcl_reverse_iterator rIt
+# define vcl_back_insert_iterator bIIt
+# define vcl_front_insert_iterator fIIt
+# define vcl_raw_storage_iterator rSIt
+# define vcl_istream_iterator iSIt
+# define vcl_ostream_iterator oSIt
+#endif
+
+struct vcl_input_iterator_tag {};
+struct vcl_output_iterator_tag { vcl_output_iterator_tag() {} };
+struct vcl_forward_iterator_tag {};
+struct vcl_bidirectional_iterator_tag { vcl_bidirectional_iterator_tag() {} };
+struct vcl_random_access_iterator_tag {};
+
+template <class T, class Distance> struct vcl_input_iterator {};
+struct vcl_output_iterator {};
+template <class T, class Distance> struct vcl_forward_iterator {};
+template <class T, class Distance> struct vcl_bidirectional_iterator {};
+template <class T, class Distance> struct vcl_random_access_iterator {};
+
+template <class T, class Distance>
+inline vcl_input_iterator_tag
+iterator_category(const vcl_input_iterator<T, Distance>&) {
+ return vcl_input_iterator_tag();
+}
+
+inline vcl_output_iterator_tag
+iterator_category(const vcl_output_iterator&) {
+ return vcl_output_iterator_tag();
+}
+
+template <class T, class Distance>
+inline vcl_forward_iterator_tag
+iterator_category(const vcl_forward_iterator<T, Distance>&) {
+ return vcl_forward_iterator_tag();
+}
+
+template <class T, class Distance>
+inline vcl_bidirectional_iterator_tag
+iterator_category(const vcl_bidirectional_iterator<T, Distance>&) {
+ return vcl_bidirectional_iterator_tag();
+}
+
+template <class T, class Distance>
+inline vcl_random_access_iterator_tag
+iterator_category(const vcl_random_access_iterator<T, Distance>&) {
+ return vcl_random_access_iterator_tag();
+}
+
+template <class T>
+inline vcl_random_access_iterator_tag
+iterator_category(const T*) {
+ return vcl_random_access_iterator_tag();
+}
+
+template <class T, class Distance>
+inline T*
+value_type(const vcl_input_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T*
+value_type(const vcl_forward_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T*
+value_type(const vcl_bidirectional_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T*
+value_type(const vcl_random_access_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T>
+inline T*
+value_type(const T*) { return (T*)(0); }
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const vcl_input_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const vcl_forward_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const vcl_bidirectional_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const vcl_random_access_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T>
+inline vcl_ptrdiff_t*
+distance_type(const T*) { return (vcl_ptrdiff_t*)(0); }
+
+template <class Container>
+class vcl_back_insert_iterator {
+protected:
+ typedef typename Container::value_type value_type;
+ Container* container;
+public:
+ vcl_back_insert_iterator(Container& x) : container(&x) {}
+ vcl_back_insert_iterator<Container>&
+ operator=(const value_type& value) {
+ container->push_back(value);
+ return *this;
+ }
+ vcl_back_insert_iterator<Container>& operator*() { return *this; }
+ vcl_back_insert_iterator<Container>& operator++() { return *this; }
+ vcl_back_insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline vcl_output_iterator_tag
+iterator_category(const vcl_back_insert_iterator<Container>&)
+{
+ return vcl_output_iterator_tag();
+}
+
+template <class Container>
+inline vcl_back_insert_iterator<Container>
+vcl_back_inserter(Container& x) {
+ return vcl_back_insert_iterator<Container>(x);
+}
+
+template <class Container>
+class vcl_front_insert_iterator {
+protected:
+ Container* container;
+public:
+ vcl_front_insert_iterator(Container& x) : container(&x) {}
+ vcl_front_insert_iterator<Container>&
+ operator=(const typename Container::value_type& value) {
+ container->push_front(value);
+ return *this;
+ }
+ vcl_front_insert_iterator<Container>& operator*() { return *this; }
+ vcl_front_insert_iterator<Container>& operator++() { return *this; }
+ vcl_front_insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline vcl_output_iterator_tag
+iterator_category(const vcl_front_insert_iterator<Container>&)
+{
+ return vcl_output_iterator_tag();
+}
+
+template <class Container>
+inline vcl_front_insert_iterator<Container>
+front_inserter(Container& x) {
+ return vcl_front_insert_iterator<Container>(x);
+}
+
+template <class Container>
+class vcl_insert_iterator {
+protected:
+ Container* container;
+ typename Container::iterator iter;
+public:
+ vcl_insert_iterator(Container& x, typename Container::iterator i)
+ : container(&x), iter(i) {}
+ vcl_insert_iterator<Container>&
+ operator=(const typename Container::value_type& value) {
+ iter = container->insert(iter, value);
+ ++iter;
+ return *this;
+ }
+ vcl_insert_iterator<Container>& operator*() { return *this; }
+ vcl_insert_iterator<Container>& operator++() { return *this; }
+ vcl_insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline vcl_output_iterator_tag
+iterator_category(const vcl_insert_iterator<Container>&)
+{
+ return vcl_output_iterator_tag();
+}
+
+template <class Container, class Iterator>
+inline vcl_insert_iterator<Container> vcl_inserter(Container& x, Iterator i) {
+ typedef typename Container::iterator iter;
+ return vcl_insert_iterator<Container>(x, iter(i));
+}
+
+// Forward declarations
+template <class BidirectionalIterator, class T, class Reference, class Distance> class vcl_reverse_bidirectional_iterator;
+template <class BidirectionalIterator, class T, class Reference, class Distance> inline bool operator==
+ (
+ const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>& x,
+ const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>& y);
+
+template <class BidirectionalIterator, class T,
+ VCL_DFL_TMPL_PARAM_STLDECL(Reference, T& ),
+ VCL_DFL_TYPE_PARAM_STLDECL(Distance, vcl_ptrdiff_t)>
+class vcl_reverse_bidirectional_iterator {
+ typedef vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference,
+ Distance> self;
+ friend bool operator== VCL_NULL_TMPL_ARGS (const self& x, const self& y);
+protected:
+ BidirectionalIterator current;
+public:
+ vcl_reverse_bidirectional_iterator() {}
+ vcl_reverse_bidirectional_iterator(const BidirectionalIterator&x): current(x) {}
+ BidirectionalIterator base() { return current; }
+ Reference operator*() const {
+ BidirectionalIterator tmp = current;
+ return *--tmp;
+ }
+ self& operator++() {
+ --current;
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ --current;
+ return tmp;
+ }
+ self& operator--() {
+ ++current;
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ ++current;
+ return tmp;
+ }
+};
+
+
+template <class BidirectionalIterator, class T, class Reference, class Distance>
+inline vcl_bidirectional_iterator_tag
+iterator_category(const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>&) {
+ return vcl_bidirectional_iterator_tag();
+}
+
+template <class BidirectionalIterator, class T, class Reference, class Distance>
+inline T*
+value_type(const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>&) {
+ return (T*) 0;
+}
+
+template <class BidirectionalIterator, class T, class Reference, class Distance>
+inline Distance*
+distance_type(const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>&) {
+ return (Distance*) 0;
+}
+
+template <class BidirectionalIterator, class T, class Reference, class Distance>
+inline bool operator==
+ (
+ const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>& x,
+ const vcl_reverse_bidirectional_iterator<BidirectionalIterator, T, Reference, Distance>& y)
+{
+ return x.current == y.current;
+}
+
+// Forward declarations
+template <class RandomAccessIterator, class T, class Reference, class Distance> class vcl_reverse_iterator;
+template <class RandomAccessIterator, class T, class Reference, class Distance> inline bool operator==
+ (
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& y);
+template <class RandomAccessIterator, class T, class Reference, class Distance> inline bool operator<
+ (
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& y);
+template <class RandomAccessIterator, class T, class Reference, class Distance> inline Distance operator-
+ (
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& y);
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+ inline vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance> operator+
+ (
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>& y);
+
+template <class RandomAccessIterator, class T,
+ VCL_DFL_TMPL_PARAM_STLDECL(Reference,T&),
+ VCL_DFL_TYPE_PARAM_STLDECL(Distance,vcl_ptrdiff_t)>
+class vcl_reverse_iterator
+{
+ typedef Distance distance_type;
+ typedef vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance> self;
+ friend bool operator== VCL_NULL_TMPL_ARGS (const self& x, const self& y);
+ friend bool operator< VCL_NULL_TMPL_ARGS (const self& x, const self& y);
+ friend Distance operator- VCL_NULL_TMPL_ARGS (const self& x, const self& y);
+ friend self operator+ VCL_NULL_TMPL_ARGS (Distance n, const self& x);
+ protected:
+ RandomAccessIterator current;
+ public:
+ vcl_reverse_iterator() {}
+ vcl_reverse_iterator(const RandomAccessIterator& x) : current(x) {}
+ RandomAccessIterator base() const { return current; }
+ Reference operator*() const { return *(current - 1); }
+ self& operator++() {
+ --current;
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ --current;
+ return tmp;
+ }
+ self& operator--() {
+ ++current;
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ ++current;
+ return tmp;
+ }
+ self operator+(distance_type n) const {
+ return self(current - n);
+ }
+ self& operator+=(distance_type n) {
+ current -= n;
+ return *this;
+ }
+ self operator-(distance_type n) const {
+ return self(current + n);
+ }
+ self& operator-=(distance_type n) {
+ current += n;
+ return *this;
+ }
+ Reference operator[](distance_type n) { return *(*this + n); }
+};
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline vcl_random_access_iterator_tag
+iterator_category(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return vcl_random_access_iterator_tag();
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline T* value_type(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return (T*) 0;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline Distance* distance_type(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return (Distance*) 0;
+}
+
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline bool operator==(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+ return x.current == y.current;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline bool operator<(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+ return y.current < x.current;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline Distance operator-(const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const vcl_reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+// return y.current - x.current;
+ return y.base() - x.base();
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>
+operator+(Distance n,
+ const vcl_reverse_iterator<RandomAccessIterator, T, Reference,
+ Distance>& x) {
+ return vcl_reverse_iterator<RandomAccessIterator, T, Reference, Distance>
+ (x.current - n);
+}
+
+
+template <class ForwardIterator, class T>
+class vcl_raw_storage_iterator {
+protected:
+ ForwardIterator iter;
+public:
+ explicit vcl_raw_storage_iterator(const ForwardIterator& x) : iter(x) {}
+ vcl_raw_storage_iterator<ForwardIterator, T>& operator*() { return *this; }
+ vcl_raw_storage_iterator<ForwardIterator, T>& operator=(const T& element) {
+ construct(&*iter, element);
+ return *this;
+ }
+ vcl_raw_storage_iterator<ForwardIterator, T>& operator++() {
+ ++iter;
+ return *this;
+ }
+ vcl_raw_storage_iterator<ForwardIterator, T> operator++(int) {
+ vcl_raw_storage_iterator<ForwardIterator, T> tmp = *this;
+ ++iter;
+ return tmp;
+ }
+};
+
+template <class ForwardIterator, class T>
+inline vcl_output_iterator_tag
+iterator_category(const vcl_raw_storage_iterator<ForwardIterator, T>&)
+{
+ return vcl_output_iterator_tag();
+}
+
+// Forward declarations
+template <class T, class Distance> class vcl_istream_iterator;
+template <class T, class Distance> inline bool operator==(
+ const vcl_istream_iterator<T, Distance>& x,
+ const vcl_istream_iterator<T, Distance>& y);
+
+template <class T, VCL_DFL_TYPE_PARAM_STLDECL(Distance, vcl_ptrdiff_t)>
+class vcl_istream_iterator {
+ friend bool operator== VCL_NULL_TMPL_ARGS
+ (const vcl_istream_iterator<T, Distance>& x,
+ const vcl_istream_iterator<T, Distance>& y);
+protected:
+ vcl_istream* stream;
+ T value;
+ bool end_marker;
+ void read() {
+ end_marker = bool(*stream);
+ if (end_marker) *stream >> value;
+ end_marker = bool(*stream);
+ }
+public:
+ vcl_istream_iterator() : stream(&vcl_cin), end_marker(false) {}
+ vcl_istream_iterator(vcl_istream& s) : stream(&s) { read(); }
+ const T& operator*() const { return value; }
+ vcl_istream_iterator<T, Distance>& operator++() {
+ read();
+ return *this;
+ }
+ vcl_istream_iterator<T, Distance> operator++(int) {
+ vcl_istream_iterator<T, Distance> tmp = *this;
+ read();
+ return tmp;
+ }
+};
+
+template <class T, class Distance>
+inline vcl_input_iterator_tag
+iterator_category(const vcl_istream_iterator<T, Distance>&) {
+ return vcl_input_iterator_tag();
+}
+
+template <class T, class Distance>
+inline T* value_type(const vcl_istream_iterator<T, Distance>&) { return (T*) 0; }
+
+template <class T, class Distance>
+inline Distance* distance_type(const vcl_istream_iterator<T, Distance>&) {
+ return (Distance*) 0;
+}
+
+template <class T, class Distance>
+inline
+bool operator==(const vcl_istream_iterator<T, Distance>& x,
+ const vcl_istream_iterator<T, Distance>& y) {
+ return x.stream == y.stream && x.end_marker == y.end_marker ||
+ x.end_marker == false && y.end_marker == false;
+}
+
+template <class T>
+class vcl_ostream_iterator {
+protected:
+ vcl_ostream* stream;
+ char* string;
+public:
+ vcl_ostream_iterator(vcl_ostream& s) : stream(&s), string(0) {}
+ vcl_ostream_iterator(vcl_ostream& s, char* c) : stream(&s), string(c) {}
+ vcl_ostream_iterator<T>& operator=(const T& value) {
+ *stream << value;
+ if (string) *stream << string;
+ return *this;
+ }
+ vcl_ostream_iterator<T>& operator*() { return *this; }
+ vcl_ostream_iterator<T>& operator++() { return *this; }
+ vcl_ostream_iterator<T>& operator++(int) { return *this; }
+};
+
+template <class T>
+inline vcl_output_iterator_tag
+iterator_category(const vcl_ostream_iterator<T>&) {
+ return vcl_output_iterator_tag();
+}
+
+#endif // vcl_emulation_iterator_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.txx
new file mode 100644
index 0000000000000000000000000000000000000000..c5c1f788ea1709014b6293b00efe178f14102975
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_iterator.txx
@@ -0,0 +1,44 @@
+//-*- c++ -*-
+#ifndef vcl_emulation_iterator_txx_
+#define vcl_emulation_iterator_txx_
+
+#include "vcl_iterator.h"
+#include "vcl_algorithm.txx"
+
+#define VCL_TAGS_INSTANTIATE(I, TAG) \
+VCL_INSTANTIATE_INLINE(TAG iterator_category(I const &))
+
+#define VCL_ITER_FWD_INSTANTIATE(ForwardIterator) \
+VCL_OPERATOR_NE_INSTANTIATE(ForwardIterator)\
+VCL_TAGS_INSTANTIATE(ForwardIterator, vcl_forward_iterator_tag)
+
+#define VCL_ITER_BD_INSTANTIATE_Distance(BidirectionalIterator, Distance) \
+VCL_INSTANTIATE_INLINE(void vcl_advance(BidirectionalIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(BidirectionalIterator&,Distance,vcl_bidirectional_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void vcl_distance(BidirectionalIterator,BidirectionalIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(BidirectionalIterator,BidirectionalIterator const&,Distance&,vcl_bidirectional_iterator_tag))
+
+#define VCL_ITER_BD_INSTANTIATE(BidirectionalIterator) \
+VCL_ITER_BD_INSTANTIATE_Distance(BidirectionalIterator, BidirectionalIterator::difference_type) \
+VCL_OPERATOR_NE_INSTANTIATE(BidirectionalIterator)\
+VCL_TAGS_INSTANTIATE(BidirectionalIterator, vcl_bidirectional_iterator_tag)
+
+#define VCL_ITER_RA_INSTANTIATE_Distance(RandomAccessIterator, Distance) \
+VCL_INSTANTIATE_INLINE(void vcl_advance(RandomAccessIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(RandomAccessIterator&,Distance,vcl_random_access_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void vcl_distance(RandomAccessIterator,RandomAccessIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(RandomAccessIterator const&,RandomAccessIterator const&,\
+ Distance&,vcl_random_access_iterator_tag))
+
+#define VCL_ITER_RA_INSTANTIATE(RandomAccessIterator) \
+VCL_ITER_RA_INSTANTIATE_Distance(RandomAccessIterator, vcl_ptrdiff_t) \
+VCL_OPERATOR_NE_INSTANTIATE(RandomAccessIterator)\
+VCL_TAGS_INSTANTIATE(RandomAccessIterator, vcl_random_access_iterator_tag)
+
+#define VCL_ITER_BD_Distance_INSTANTIATE(BidirectionalIterator, Distance) \
+VCL_INSTANTIATE_INLINE(void vcl_advance(BidirectionalIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(BidirectionalIterator&,Distance,vcl_bidirectional_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void vcl_distance(BidirectionalIterator,BidirectionalIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(BidirectionalIterator,BidirectionalIterator const&,Distance&,vcl_bidirectional_iterator_tag))
+
+#endif // vcl_emulation_iterator_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.cxx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..68d0f5984e88f1bcdaace27031fcd3d43627c2b6
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.cxx
@@ -0,0 +1,436 @@
+// This is vcl/emulation/vcl_limits.cxx
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma implementation
+#endif
+//
+// numeric_limits for STL versions that don't have them.
+// Author: Andrew W. Fitzgibbon, Oxford RRG
+// Created: 28 Aug 96
+//
+//-----------------------------------------------------------------------------
+#include <vcl_compiler.h>
+#if !VCL_CXX_HAS_HEADER_LIMITS || !VCL_USE_NATIVE_STL || (!VCL_NUMERIC_LIMITS_HAS_INFINITY && VCL_PROCESSOR_HAS_INFINITY)
+
+#include "vcl_limits.h"
+#include <vxl_config.h> // for VXL_BIG_ENDIAN
+
+// ----------------------------------------------------------------------
+// Constants for int
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<int>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<int>::digits VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<int>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<int>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<int>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<int>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<int>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<int>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-31);
+const int vcl_numeric_limits<int>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-9);
+const int vcl_numeric_limits<int>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<int>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<int>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<int>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<int>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<int>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<int>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+
+// ----------------------------------------------------------------------
+// Constants for long
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<long>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<long>::digits VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<long>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<long>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<long>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<long>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-31);
+const int vcl_numeric_limits<long>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-9);
+const int vcl_numeric_limits<long>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<long>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<long>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<long>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants for unsigned long
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<unsigned long>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned long>::digits VCL_STATIC_CONST_INIT_INT_DEFN(sizeof(unsigned long) * 8 );
+const int vcl_numeric_limits<unsigned long>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN( (digits * 301) / 1000 );
+const bool vcl_numeric_limits<unsigned long>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned long>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned long>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<unsigned long>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-31);
+const int vcl_numeric_limits<unsigned long>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-9);
+const int vcl_numeric_limits<unsigned long>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<unsigned long>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<unsigned long>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned long>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned long>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned long>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<unsigned long>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants for unsigned short
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<unsigned short>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned short>::digits VCL_STATIC_CONST_INIT_INT_DEFN(sizeof(unsigned short) * 8 );
+const int vcl_numeric_limits<unsigned short>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN( (digits * 301) / 1000 );
+const bool vcl_numeric_limits<unsigned short>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned short>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned short>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<unsigned short>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-31);
+const int vcl_numeric_limits<unsigned short>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-9);
+const int vcl_numeric_limits<unsigned short>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(31);
+const int vcl_numeric_limits<unsigned short>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(9);
+const bool vcl_numeric_limits<unsigned short>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned short>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned short>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned short>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<unsigned short>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants for short
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<short>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<short>::digits VCL_STATIC_CONST_INIT_INT_DEFN(15);
+const int vcl_numeric_limits<short>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN(5);
+const bool vcl_numeric_limits<short>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<short>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<short>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<short>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<short>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-15);
+const int vcl_numeric_limits<short>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-5);
+const int vcl_numeric_limits<short>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(15);
+const int vcl_numeric_limits<short>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(5);
+const bool vcl_numeric_limits<short>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<short>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<short>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<short>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<short>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants for signed char
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<signed char>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<signed char>::digits VCL_STATIC_CONST_INIT_INT_DEFN(7);
+const int vcl_numeric_limits<signed char>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN(3);
+const bool vcl_numeric_limits<signed char>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<signed char>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<signed char>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<signed char>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<signed char>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-7);
+const int vcl_numeric_limits<signed char>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-3);
+const int vcl_numeric_limits<signed char>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(7);
+const int vcl_numeric_limits<signed char>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(3);
+const bool vcl_numeric_limits<signed char>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<signed char>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<signed char>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<signed char>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<signed char>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants for unsigned char
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<unsigned char>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned char>::digits VCL_STATIC_CONST_INIT_INT_DEFN(8);
+const int vcl_numeric_limits<unsigned char>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN(3);
+const bool vcl_numeric_limits<unsigned char>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned char>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<unsigned char>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<unsigned char>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-8);
+const int vcl_numeric_limits<unsigned char>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-3);
+const int vcl_numeric_limits<unsigned char>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(8);
+const int vcl_numeric_limits<unsigned char>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(3);
+const bool vcl_numeric_limits<unsigned char>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned char>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<unsigned char>::traps VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<unsigned char>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const vcl_float_round_style vcl_numeric_limits<unsigned char>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_toward_zero);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants and functions for double
+
+union vcl_numeric_limits_double_nan {
+ double nan;
+ unsigned char x[8];
+
+ vcl_numeric_limits_double_nan() {
+#if VXL_BIG_ENDIAN
+ x[0] = 0x7f;
+ x[1] = x[2] = x[3] = x[4] = x[5] = x[6] = x[7] = 0xff;
+#else
+ x[7] = 0x7f;
+ x[0] = x[1] = x[2] = x[3] = x[4] = x[5] = x[6] = 0xff;
+#endif
+ }
+};
+static vcl_numeric_limits_double_nan dnan;
+
+union vcl_numeric_limits_double_inf {
+ double inf;
+ unsigned char x[8];
+
+ vcl_numeric_limits_double_inf() {
+#ifdef __alpha__ // Alpha throws a floating exception when evaluating IEEE Inf
+ x[7] = 0x7f; x[6] = 0xef;
+ x[0] = x[1] = x[2] = x[3] = x[4] = x[5] = 0xff;
+#elif VXL_BIG_ENDIAN
+ x[0] = 0x7f; x[1] = 0xf0;
+ x[2] = x[3] = x[4] = x[5] = x[6] = x[7] = 0x00;
+#else
+ x[7] = 0x7f; x[6] = 0xf0;
+ x[0] = x[1] = x[2] = x[3] = x[4] = x[5] = 0x00;
+#endif
+ }
+};
+static vcl_numeric_limits_double_inf dinf;
+
+double vcl_numeric_limits<double>::infinity()
+{
+ return dinf.inf;
+}
+
+double vcl_numeric_limits<double>::quiet_NaN()
+{
+ return dnan.nan;
+}
+
+double vcl_numeric_limits<double>::signaling_NaN()
+{
+ return quiet_NaN();
+}
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<double>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<double>::digits VCL_STATIC_CONST_INIT_INT_DEFN(53);
+const int vcl_numeric_limits<double>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN( 15);
+const bool vcl_numeric_limits<double>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<double>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const int vcl_numeric_limits<double>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<double>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-1021);
+const int vcl_numeric_limits<double>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-307);
+const int vcl_numeric_limits<double>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(1024);
+const int vcl_numeric_limits<double>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(308);
+const bool vcl_numeric_limits<double>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<double>::traps VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<double>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const vcl_float_round_style vcl_numeric_limits<double>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_to_nearest);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants and functions for long double
+
+static const unsigned int szl = sizeof(long double);
+
+union vcl_numeric_limits_long_double_nan {
+ long double nan;
+ unsigned char x[szl];
+
+ vcl_numeric_limits_long_double_nan() {
+ for (unsigned int i=0; i<szl; ++i) x[i] = 0xff;
+#if VXL_BIG_ENDIAN
+ x[0] = 0x7f;
+#else
+ x[szl-1] = 0x7f;
+#endif
+ }
+};
+static vcl_numeric_limits_long_double_nan ldnan;
+
+union vcl_numeric_limits_long_double_inf {
+ long double inf;
+ unsigned char x[szl];
+
+ vcl_numeric_limits_long_double_inf() {
+ for (unsigned int i=0; i<szl; ++i) x[i] = 0x00;
+#ifdef __alpha__ // Alpha throws a floating exception when evaluating IEEE Inf
+ x[szl-1] = 0x7f; x[szl-2] = 0xef;
+ for (unsigned int i=0; i<szl-2; ++i) x[i] = 0xff;
+#elif VXL_BIG_ENDIAN
+ x[0] = 0x7f; x[1] = 0xf0;
+#else
+ x[szl-1] = 0x7f; x[szl-2] = 0xf0;
+ if (szl == 12) // intel
+ x[9]=x[11]=0x7f, x[8]=x[10]=0xff, x[7] = 0x80;
+#endif
+ }
+};
+static vcl_numeric_limits_long_double_inf ldinf;
+
+long double vcl_numeric_limits<long double>::infinity()
+{
+ return ldinf.inf;
+}
+
+long double vcl_numeric_limits<long double>::quiet_NaN()
+{
+ return ldnan.nan;
+}
+
+long double vcl_numeric_limits<long double>::signaling_NaN()
+{
+ return quiet_NaN();
+}
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<long double>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<long double>::digits VCL_STATIC_CONST_INIT_INT_DEFN((int)(85-10*szl+.75*szl*szl));
+const int vcl_numeric_limits<long double>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN((int)(9-3.5*szl+.25*szl*szl-5));
+// this is 15, 21, and 35 for sizes 8, 12, and 16.
+const bool vcl_numeric_limits<long double>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long double>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const int vcl_numeric_limits<long double>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<long double>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-1021);
+const int vcl_numeric_limits<long double>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-307);
+const int vcl_numeric_limits<long double>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(1024);
+const int vcl_numeric_limits<long double>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(308);
+const bool vcl_numeric_limits<long double>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<long double>::traps VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<long double>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const vcl_float_round_style vcl_numeric_limits<long double>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_to_nearest);
+#endif
+
+// ----------------------------------------------------------------------
+// Constants and functions for float
+
+union vcl_numeric_limits_float_nan {
+ float nan;
+ unsigned char x[4];
+
+ vcl_numeric_limits_float_nan() {
+#if VXL_BIG_ENDIAN
+ x[0] = 0x7f; x[1] = x[2] = x[3] = 0xff;
+#else
+ x[3] = 0x7f; x[0] = x[1] = x[2] = 0xff;
+#endif
+ }
+};
+static vcl_numeric_limits_float_nan fnan;
+
+union vcl_numeric_limits_float_inf {
+ float inf;
+ unsigned char x[4];
+
+ vcl_numeric_limits_float_inf() {
+#ifdef __alpha__ // Alpha throws a floating exception when evaluating IEEE Inf
+ x[3] = 0x7f; x[2] = 0x7f; x[1] = x[0] = 0xff;
+#elif VXL_BIG_ENDIAN
+ x[0] = 0x7f; x[1] = 0x80; x[2] = x[3] = 0x00;
+#else
+ x[3] = 0x7f; x[2] = 0x80; x[1] = x[0] = 0x00;
+#endif
+ }
+};
+static vcl_numeric_limits_float_inf finf;
+
+float vcl_numeric_limits<float>::infinity()
+{
+ return finf.inf;
+}
+
+float vcl_numeric_limits<float>::quiet_NaN()
+{
+ return fnan.nan;
+}
+
+float vcl_numeric_limits<float>::signaling_NaN()
+{
+ return quiet_NaN();
+}
+
+#if !VCL_STATIC_CONST_INIT_INT_NO_DEFN
+const bool vcl_numeric_limits<float>::is_specialized VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const int vcl_numeric_limits<float>::digits VCL_STATIC_CONST_INIT_INT_DEFN(24);
+const int vcl_numeric_limits<float>::digits10 VCL_STATIC_CONST_INIT_INT_DEFN( 6);
+const bool vcl_numeric_limits<float>::is_signed VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::is_integer VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<float>::is_exact VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const int vcl_numeric_limits<float>::radix VCL_STATIC_CONST_INIT_INT_DEFN(2);
+const int vcl_numeric_limits<float>::min_exponent VCL_STATIC_CONST_INIT_INT_DEFN(-125);
+const int vcl_numeric_limits<float>::min_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(-37);
+const int vcl_numeric_limits<float>::max_exponent VCL_STATIC_CONST_INIT_INT_DEFN(128);
+const int vcl_numeric_limits<float>::max_exponent10 VCL_STATIC_CONST_INIT_INT_DEFN(38);
+const bool vcl_numeric_limits<float>::has_infinity VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::has_denorm VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<float>::is_iec559 VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::is_bounded VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::is_modulo VCL_STATIC_CONST_INIT_INT_DEFN(false);
+const bool vcl_numeric_limits<float>::traps VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const bool vcl_numeric_limits<float>::tinyness_before VCL_STATIC_CONST_INIT_INT_DEFN(true);
+const vcl_float_round_style vcl_numeric_limits<float>::round_style VCL_STATIC_CONST_INIT_INT_DEFN(vcl_round_to_nearest);
+#endif
+
+#endif // !VCL_CXX_HAS_HEADER_LIMITS || !VCL_USE_NATIVE_STL || (!VCL_NUMERIC_LIMITS_HAS_INFINITY && VCL_PROCESSOR_HAS_INFINITY)
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.h
new file mode 100644
index 0000000000000000000000000000000000000000..86738ba59dc896bccd7f56418f39433070a418d0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_limits.h
@@ -0,0 +1,607 @@
+// This is vcl/emulation/vcl_limits.h
+#ifndef emulation_vcl_limits_h_
+#define emulation_vcl_limits_h_
+#ifdef VCL_NEEDS_PRAGMA_INTERFACE
+#pragma interface
+#endif
+//:
+// \file
+// \brief Standard limits for numeric datatypes
+//
+// Implementation of the May 96 ANSI Draft Working Paper (DWP)
+// numeric_limits class. Numbering in
+// the documentation below refers to section 18.2 of the DWP.
+//
+// \author Andrew W. Fitzgibbon, Oxford RRG
+// \date 28 Aug 96
+//
+// \verbatim
+// Modifications
+// LSB (Manchester) 23/3/01 Documentation tidied
+// Feb.2002 - Peter Vanroose - brief doxygen comment placed on single line
+// Jan.2003 - Peter Vanroose - bug fix in infinity() and NaN(): LITTLE_ENDIAN
+// \endverbatim
+//
+//-----------------------------------------------------------------------------
+
+#include <vcl_compiler.h>
+
+//: 18.2.1.3 Type float_round_style [lib.round.style]
+
+enum vcl_float_round_style {
+ vcl_round_indeterminate = -1,
+ vcl_round_toward_zero = 0,
+ vcl_round_to_nearest = 1,
+ vcl_round_toward_infinity = 2,
+ vcl_round_toward_neg_infinity = 3
+};
+
+#ifdef infinity
+# error
+#endif
+
+//: Standard limits for numeric datatypes
+// Implementation of the May 96 ANSI Draft Working Paper (DWP)
+// numeric_limits class. Numbering in
+// the documentation below refers to section 18.2 of the DWP.
+//
+// When specializing this class, note that 9.4.2 in the '98 C++
+// standard requires that the static constants be defined
+// somewhere. (See vcl_numeric_limits.cxx)
+//
+template<class T>
+class vcl_numeric_limits
+{
+ public:
+
+ //: Distinguishes between scalar types, which have specialisations, and non-scalar types, which don't.
+ static const bool is_specialized;
+
+ //: Minimum finite value.
+ // Equivalent to CHAR_MIN, SHRT_MIN, FLT_MIN, DBL_MIN, etc.
+ //
+ // For floating types with denormalization, returns the minimum positive
+ // normalized value, denorm_min().
+ //
+ // Meaningful for all specializations in which is_bounded == true, or
+ // is_bounded == false && is_signed == false.
+ static T min();
+
+ //: Maximum finite value.
+ // Equivalent to CHAR_MAX, SHRT_MAX, FLT_MAX, DBL_MAX, etc.
+ // Meaningful for all specializations in which is_bounded == true.
+ static T max();
+
+ //: Number of radix digits which can be represented without change.
+ // For built-in integer types, the number of non-sign bits in the representation.
+ // For floating point types, the number of radix digits in the mantissa.
+ // Equivalent to FLT_MANT_DIG, DBL_MANT_DIG, LDBL_MANT_DIG.
+ static const int digits;
+
+ //: Number of base 10 digits which can be represented without change.
+ // Equivalent to FLT_DIG, DBL_DIG, LDBL_DIG.
+ // Meaningful for all specializations in which is_bounded == true.
+ static const int digits10;
+
+ //: True if the type is signed.
+ static const bool is_signed;
+
+ //: True if the type is integer
+ static const bool is_integer;
+
+ //: True if the type uses an exact representation.
+ // All integer types are exact, but not vice versa.
+ // For example, rational and fixed-exponent
+ // representations are exact but not integer.
+ static const bool is_exact;
+
+ //:
+ // For floating types, specifies the base or radix of the exponent
+ // representation (often 2). Equivalent to FLT_RADIX.
+ // For integer types, specifies the base of the representation -
+ // distinguishes types with bases other than 2 (e.g. BCD).
+ static const int radix;
+
+ //: Machine epsilon.
+ // The difference between 1 and the least value greater
+ // than 1 that is representable. Equivalent to FLT_EPSILON, DBL_EPSILON,
+ // LDBL_EPSILON.
+ // Meaningful only for floating point types.
+ static T epsilon();
+
+ //: Measure of the maximum rounding error.
+ // This has a precise definition in
+ // the Language Independent Arithmetic (LIA-1) standard. Required by LIA-1.
+ static T round_error();
+
+ //: Minimum negative integer such that radix raised to that power is in range.
+ // Equivalent to FLT_MIN_EXP, DBL_MIN_EXP, LDBL_MIN_EXP.
+ // Meaningful only for floating point types.
+ static const int min_exponent;
+
+ //: Minimum negative integer such that 10 raised to that power is in range.
+ // Equivalent to FLT_MIN_10_EXP, DBL_MIN_10_EXP, LDBL_MIN_10_EXP.
+ // Meaningful only for floating point types.
+ static const int min_exponent10;
+
+ //: Maximum positive integer such that radix raised to that power is in range.
+ // Equivalent to FLT_MAX_EXP, DBL_MAX_EXP, LDBL_MAX_EXP.
+ // Meaningful only for floating point types.
+ static const int max_exponent;
+
+ //: Maximum positive integer such that 10 raised to that power is in range.
+ // Equivalent to FLT_MAX_10_EXP, DBL_MAX_10_EXP, LDBL_MAX_10_EXP.
+ // Meaningful only for floating point types.
+ static const int max_exponent10;
+
+ //: True if the type has a representation for positive infinity.
+ // Meaningful only for floating point types.
+ // Shall be true for all specializations in which is_iec559 == true.
+ static const bool has_infinity;
+
+ //: True if the type has a representation for a quiet (non-signaling).
+ // ``Not a Number.''. RLIA
+ // Meaningful only for floating point types.
+ // Shall be true for all specializations in which is_iec559 == true.
+ static const bool has_quiet_NaN;
+
+ //: True if the type has a representation for a signaling.
+ // ``Not a Number.''.
+ // Meaningful only for floating point types.
+ // Shall be true for all specializations in which is_iec559 == true.
+ static const bool has_signaling_NaN;
+
+ //: True if the type allows denormalized values (variable number of exponent bits).
+ // Meaningful only for floating point types.
+ static const bool has_denorm;
+
+ //: Representation of positive infinity, if available.
+ static T infinity();
+
+ //: Representation of a quiet ``Not a Number,'' if available.
+ static T quiet_NaN();
+
+ //: Representation of a signaling ``Not a Number,'' if available.
+ static T signaling_NaN();
+
+ //: Minimum positive denormalized value.
+ // Meaningful for all floating point types.
+ // In specializations for which has_denorm == false, returns the minimum
+ // positive normalized value.
+ // For types with has_denorm == false, the member denorm_min() shall
+ // return the same value as the member min().
+ static T denorm_min();
+
+ //: True if and only if the type adheres to IEC 559 standard.
+ // International Electrotechnical Commission standard 559 is the same as IEEE 754.
+ static const bool is_iec559;
+
+ //: True if the set of values representable by the type is finite.
+ // All built-in types are bounded, this member would be false for arbitrary
+ // precision types.
+ static const bool is_bounded;
+
+ //: True if the type is modulo.
+ // A type is modulo if it is possible to add two positive numbers and have
+ // a result which wraps around to a third number which is less.
+ // Generally, this is false for floating types, true for unsigned integers,
+ // and true for signed integers on most machines.
+ static const bool is_modulo;
+
+ //: True if trapping is implemented for the type.
+ static const bool traps;
+
+ //: True if tinyness is detected before rounding. Refer to IEC 559.
+ static const bool tinyness_before;
+
+ //: The rounding style for the type. Equivalent to FLT_ROUNDS.
+ // Specializations for integer types shall return round_toward_zero.
+ static const vcl_float_round_style round_style;
+};
+
+// SPECIALIZATIONS :
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<int>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static int min() { return -0x7fffffff; }
+ inline static int max() { return 0x7fffffff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-31);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-9);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<unsigned int>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static unsigned int min() { return 0; }
+ inline static unsigned int max() { return 0xffffffff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(sizeof(unsigned long) * 8 );
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL( (digits * 301) / 1000 );
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-31);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-9);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<long>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static int min() { return -0x7fffffff; }
+ inline static int max() { return 0x7fffffff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-31);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-9);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<unsigned long>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static unsigned int min() { return 0; }
+ inline static unsigned int max() { return 0xffffffff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(sizeof(unsigned long) * 8 );
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL( (digits * 301) / 1000 );
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-31);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-9);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<unsigned short >
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static unsigned int min() { return 0; }
+ inline static unsigned int max() { return 0xffff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(sizeof(unsigned short) * 8 );
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL( (digits * 301) / 1000 );
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-31);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-9);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(31);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(9);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<short >
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static int min() { return -0x7fff; }
+ inline static int max() { return 0x7fff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(5);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-15);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-5);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(5);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<signed char >
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static int min() { return -0x80; }
+ inline static int max() { return 0x7f; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(7);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(3);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-15);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-5);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(5);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<unsigned char >
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static int min() { return 0x0; }
+ inline static int max() { return 0xff; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(8);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(3);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static int epsilon() { return 0; }
+ inline static int round_error() { return 0; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-15);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-5);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(5);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static int infinity() { return max(); }
+ static int quiet_NaN();
+ static int signaling_NaN();
+ inline static int denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_toward_zero);
+};
+
+#if VCL_CHAR_IS_SIGNED
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<char>: public vcl_numeric_limits<signed char> {};
+#else
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<char>: public vcl_numeric_limits<unsigned char> {};
+#endif
+
+// IEEE 754 single precision
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<float>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static float min() { return 1.17549435E-38F; }
+ inline static float max() { return 3.40282347E+38F; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(24);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(6);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static float epsilon() { return 1.19209290E-07F; }
+ inline static float round_error() { return 0.5F; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-125);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-37);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(128);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(38);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static float infinity();
+ static float quiet_NaN();
+ static float signaling_NaN();
+ inline static float denorm_min() { return min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_to_nearest);
+};
+
+
+// IEEE 754 double precision with denorm
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<double>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static double min() { return 2.2250738585072014e-308; }
+ inline static double max() { return 1.7976931348623157e+308; }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(53);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static double epsilon() { return 2.220446049250313e-16; }
+ inline static double round_error() { return 0.5; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-1021);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-307);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(1024);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(308);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static double infinity();
+ static double quiet_NaN();
+ static double signaling_NaN();
+ inline static double denorm_min() { return /* 5e-324 */ min(); }
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_to_nearest);
+};
+
+
+VCL_DEFINE_SPECIALIZATION
+class vcl_numeric_limits<long double>
+{
+ public:
+ static const bool is_specialized VCL_STATIC_CONST_INIT_INT_DECL(true);
+ inline static long double max() { return 1.7976931348623157e+308; }
+ inline static long double min() { return 2.2250738585072014e-308; }
+ inline static long double denorm_min() { return min(); }
+ static const int digits VCL_STATIC_CONST_INIT_INT_DECL(53);
+ static const int digits10 VCL_STATIC_CONST_INIT_INT_DECL(15);
+ static const bool is_signed VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_integer VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool is_exact VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const int radix VCL_STATIC_CONST_INIT_INT_DECL(2);
+ inline static long double epsilon() { return 2.220446049250313e-16; } // TODO: should become dependent of sizeof(long double)
+ inline static long double round_error() { return 0.5; }
+ static const int min_exponent VCL_STATIC_CONST_INIT_INT_DECL(-1021);
+ static const int min_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(-307);
+ static const int max_exponent VCL_STATIC_CONST_INIT_INT_DECL(1024);
+ static const int max_exponent10 VCL_STATIC_CONST_INIT_INT_DECL(308);
+ static const bool has_infinity VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_quiet_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_signaling_NaN VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool has_denorm VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static long double infinity();
+ static long double quiet_NaN();
+ static long double signaling_NaN();
+ static const bool is_iec559 VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_bounded VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool is_modulo VCL_STATIC_CONST_INIT_INT_DECL(false);
+ static const bool traps VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const bool tinyness_before VCL_STATIC_CONST_INIT_INT_DECL(true);
+ static const vcl_float_round_style round_style VCL_STATIC_CONST_INIT_INT_DECL(vcl_round_to_nearest);
+};
+
+#endif // emulation_vcl_limits_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.h
new file mode 100644
index 0000000000000000000000000000000000000000..406fa97e9b54c98dc766135baf6396d3a34badaa
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.h
@@ -0,0 +1,644 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Exception Handling:
+ * Copyright (c) 1997
+ * Mark of the Unicorn, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Mark of the Unicorn makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Adaptation:
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_list_h
+#define vcl_emulation_list_h
+
+#include <vcl_new.h>
+#include <vcl_cstddef.h>
+#include "vcl_algobase.h"
+#include "vcl_iterator.h"
+#include "vcl_alloc.h"
+
+# if defined ( __STL_USE_ABBREVS )
+# define __list_iterator LIt
+# define __list_const_iterator LcIt
+# endif
+
+template <class T> struct __list_iterator;
+template <class T> struct __list_const_iterator;
+
+template <class T>
+struct __list_node {
+ typedef void* void_pointer;
+ void_pointer next;
+ void_pointer prev;
+ T data;
+};
+
+template<class T>
+struct __list_iterator {
+ typedef __list_iterator<T> iterator;
+ typedef __list_const_iterator<T> const_iterator;
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef __list_node<T>* link_type;
+
+ link_type node;
+
+ __list_iterator(link_type x) : node(x) {}
+ __list_iterator() {}
+ bool operator==(const iterator& x) const {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return node == x.node;
+ }
+ bool operator!=(const iterator& x) const {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return node != x.node;
+ }
+ reference operator*() const {
+ __stl_verbose_assert(node!=owner(), __STL_MSG_NOT_DEREFERENCEABLE);
+ return (*node).data;
+ }
+ iterator& operator++() {
+ __stl_verbose_assert(node!=owner(), __STL_MSG_INVALID_ADVANCE);
+ node = (link_type)((*node).next);
+ return *this;
+ }
+ iterator operator++(int) {
+ iterator tmp = *this;
+ ++*this;
+ return tmp;
+ }
+ iterator& operator--() {
+ node = (link_type)((*node).prev);
+ __stl_verbose_assert(node!=owner(), __STL_MSG_INVALID_ADVANCE);
+ return *this;
+ }
+ iterator operator--(int) {
+ iterator tmp = *this;
+ --*this;
+ return tmp;
+ }
+};
+
+template<class T>
+struct __list_const_iterator {
+ typedef __list_iterator<T> iterator;
+ typedef __list_const_iterator<T> const_iterator;
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef __list_node<T>* link_type;
+
+ link_type node;
+
+ __list_const_iterator(link_type x) : node(x) {}
+ __list_const_iterator(const iterator& x) : node(x.node) {}
+ __list_const_iterator() {}
+ bool operator==(const const_iterator& x) const {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return node == x.node;
+ }
+ bool operator!=(const const_iterator& x) const {
+ __stl_debug_check(__check_same_owner(*this,x));
+ return node != x.node;
+ }
+ const_reference operator*() const {
+ __stl_verbose_assert(node!=owner(), __STL_MSG_NOT_DEREFERENCEABLE);
+ return (*node).data; }
+ const_iterator& operator++() {
+ __stl_verbose_assert(node!=owner(), __STL_MSG_INVALID_ADVANCE);
+ node = (link_type)((*node).next);
+ return *this;
+ }
+ const_iterator operator++(int) {
+ const_iterator tmp = *this;
+ ++*this;
+ return tmp;
+ }
+ const_iterator& operator--() {
+ node = (link_type)((*node).prev);
+ __stl_verbose_assert(node!=owner(), __STL_MSG_INVALID_ADVANCE);
+ return *this;
+ }
+ const_iterator operator--(int) {
+ const_iterator tmp = *this;
+ --*this;
+ return tmp;
+ }
+};
+
+template <class T>
+inline vcl_bidirectional_iterator_tag
+iterator_category(const __list_iterator<T>&) {
+ return vcl_bidirectional_iterator_tag();
+}
+
+template <class T>
+inline T*
+value_type(const __list_iterator<T>&) {
+ return (T*) 0;
+}
+
+template <class T>
+inline vcl_ptrdiff_t*
+distance_type(const __list_iterator<T>&) {
+ return (vcl_ptrdiff_t*) 0;
+}
+
+template <class T>
+inline vcl_bidirectional_iterator_tag
+iterator_category(const __list_const_iterator<T>&) {
+ return vcl_bidirectional_iterator_tag();
+}
+
+template <class T>
+inline T*
+value_type(const __list_const_iterator<T>&) {
+ return (T*) 0;
+}
+
+template <class T>
+inline vcl_ptrdiff_t*
+distance_type(const __list_const_iterator<T>&) {
+ return (vcl_ptrdiff_t*) 0;
+}
+
+template <class T, class Alloc>
+class __list_base {
+ typedef __list_base<T,Alloc> self;
+ typedef T value_type;
+ typedef vcl_size_t size_type;
+ typedef __list_node<T> list_node;
+ typedef list_node* link_type;
+protected:
+ typedef vcl_simple_alloc<list_node, Alloc> list_node_allocator;
+ link_type node;
+ size_type length;
+public:
+ __list_base() {
+ node = get_node();
+ (*node).next = node;
+ (*node).prev = node;
+ length=0;
+ __stl_debug_do(iter_list.safe_init(node));
+ }
+
+ ~__list_base() {
+ clear();
+ put_node(node);
+ __stl_debug_do(iter_list.invalidate());
+ }
+protected:
+ link_type get_node() { return list_node_allocator::allocate(); }
+ void put_node(link_type p) { list_node_allocator::deallocate(p); }
+ inline void clear();
+};
+
+template <class T, class Alloc>
+void __list_base<T, Alloc>::clear()
+{
+ link_type cur = (link_type) node->next;
+ while (cur != node) {
+ link_type tmp = cur;
+ cur = (link_type) cur->next;
+ vcl_destroy(&(tmp->data));
+ put_node(tmp);
+ }
+ __stl_debug_do(invalidate_all());
+}
+
+__BEGIN_STL_FULL_NAMESPACE
+# define list __WORKAROUND_RENAME(list)
+
+template <class T, VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_list : protected __list_base<T, Alloc> {
+ typedef __list_base<T, Alloc> super;
+ typedef vcl_list<T, Alloc> self;
+protected:
+ typedef void* void_pointer;
+public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef __list_node<T> list_node;
+ typedef list_node* link_type;
+ typedef vcl_size_t size_type;
+ typedef vcl_ptrdiff_t difference_type;
+ typedef __list_iterator<T> iterator;
+ typedef __list_const_iterator<T> const_iterator;
+ typedef vcl_reverse_bidirectional_iterator<const_iterator, value_type,
+ const_reference, difference_type>
+ const_reverse_iterator;
+ typedef vcl_reverse_bidirectional_iterator<iterator, value_type, reference,
+ difference_type>
+ reverse_iterator;
+
+protected:
+ link_type make_node(const T& x) {
+ link_type tmp = get_node();
+ IUEg__TRY {
+ vcl_construct(&((*tmp).data), x);
+ }
+# if defined ( __STL_USE_EXCEPTIONS )
+ catch(...) {
+ put_node(tmp);
+ throw;
+ }
+# endif
+ return tmp;
+ }
+public:
+ vcl_list() {}
+ iterator begin() { return (link_type)((*node).next); }
+ const_iterator begin() const { return (link_type)((*node).next); }
+ iterator end() { return node; }
+ const_iterator end() const { return node; }
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const { return const_reverse_iterator(end()); }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const { return const_reverse_iterator(begin()); }
+ bool empty() const { return length == 0; }
+ size_type size() const { return length; }
+ size_type max_size() const { return size_type(-1); }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(--end()); }
+ const_reference back() const { return *(--end()); }
+ void swap(vcl_list<T, Alloc>& x) {
+ __stl_debug_do(iter_list.swap_owners(x.iter_list));
+ vcl_swap(node, x.node);
+ vcl_swap(length, x.length);
+ }
+ iterator insert(iterator position, const T& x) {
+ __stl_debug_check(__check_if_owner(node,position));
+ link_type tmp = make_node(x);
+ (*tmp).next = position.node;
+ (*tmp).prev = (*position.node).prev;
+ (*(link_type((*position.node).prev))).next = tmp;
+ (*position.node).prev = tmp;
+ ++length;
+ return tmp;
+ }
+ iterator insert(iterator position) { return insert(position, T()); }
+ inline void insert(iterator position, const T* first, const T* last);
+ inline void insert(iterator position, const_iterator first, const_iterator last);
+ inline void insert(iterator position, size_type n, const T& x);
+ void push_front(const T& x) { insert(begin(), x); }
+ void push_back(const T& x) { insert(end(), x); }
+ void erase(iterator position) {
+ __stl_debug_check(__check_if_owner(node,position));
+ __stl_verbose_assert(position.node!=node, __STL_MSG_ERASE_PAST_THE_END);
+ (*(link_type((*position.node).prev))).next = (*position.node).next;
+ (*(link_type((*position.node).next))).prev = (*position.node).prev;
+ vcl_destroy(&(*position.node).data);
+ put_node(position.node);
+ --length;
+ __stl_debug_do(invalidate_iterator(position));
+ }
+ inline void erase(iterator first, iterator last);
+ inline void resize(size_type new_size, const T& x);
+ void resize(size_type new_size) { resize(new_size, T()); }
+ inline void clear();
+
+ void pop_front() { erase(begin()); }
+ void pop_back() {
+ iterator tmp = end();
+ erase(--tmp);
+ }
+ explicit vcl_list(size_type n, const T& value) {
+ insert(begin(), n, value);
+ }
+ explicit vcl_list(size_type n) {
+ insert(begin(), n, T());
+ }
+ vcl_list(const T* first, const T* last) {
+ insert(begin(), first, last);
+ }
+ vcl_list(const_iterator first, const_iterator last) {
+ insert(begin(), first, last);
+ }
+ vcl_list(const self& x) {
+ insert(begin(), x.begin(), x.end());
+ }
+ ~vcl_list() {}
+ inline self& operator=(const self& x);
+
+protected:
+ void transfer(iterator position, iterator first, iterator last) {
+ if (position.node != last.node) {
+ (*(link_type((*last.node).prev))).next = position.node;
+ (*(link_type((*first.node).prev))).next = last.node;
+ (*(link_type((*position.node).prev))).next = first.node;
+ link_type tmp = link_type((*position.node).prev);
+ (*position.node).prev = (*last.node).prev;
+ (*last.node).prev = (*first.node).prev;
+ (*first.node).prev = tmp;
+ }
+ }
+
+public:
+ void splice(iterator position, vcl_list<T, Alloc>& x) {
+ __stl_verbose_assert(&x!=this, __STL_MSG_INVALID_ARGUMENT);
+ __stl_debug_check(__check_if_owner(node,position));
+ if (!x.empty()) {
+ transfer(position, x.begin(), x.end());
+ length += x.length;
+ x.length = 0;
+ __stl_debug_do(x.invalidate_all());
+ }
+ }
+ void splice(iterator position, vcl_list<T, Alloc>& x, iterator i) {
+ __stl_debug_check(__check_if_owner(node,position) &&
+ __check_if_owner(x.node ,i));
+ __stl_verbose_assert(i.node!=i.owner(), __STL_MSG_NOT_DEREFERENCEABLE);
+ iterator j = i;
+ if (position == i || position == ++j) return;
+ transfer(position, i, j);
+ ++length;
+ --x.length;
+ __stl_debug_do(x.invalidate_iterator(i));
+ }
+ void splice(iterator position, vcl_list<T, Alloc>& x, iterator first, iterator last) {
+ __stl_debug_check(__check_if_owner(node, position));
+ __stl_verbose_assert(first.owner()==x.node && last.owner()==x.node,
+ __STL_MSG_NOT_OWNER);
+ if (first != last) {
+ if (&x != this) {
+ difference_type n = 0;
+ vcl_distance(first, last, n);
+ x.length -= n;
+ length += n;
+ }
+ transfer(position, first, last);
+ __stl_debug_do(x.invalidate_all());
+ }
+ }
+ inline void remove(const T& value);
+ inline void unique();
+ inline void merge(vcl_list<T, Alloc>& x);
+ inline void reverse();
+ inline void sort();
+};
+
+# if defined (__STL_NESTED_TYPE_PARAM_BUG)
+# define iterator __list_iterator<T>
+# define const_iterator __list_const_iterator<T>
+# define size_type vcl_size_t
+# endif
+
+template <class T, class Alloc>
+INLINE_LOOP void vcl_list<T, Alloc>::insert(iterator position, const T* first, const T* last) {
+ for (; first != last; ++first) insert(position, *first);
+}
+
+template <class T, class Alloc>
+INLINE_LOOP void vcl_list<T, Alloc>::insert(iterator position, const_iterator first,
+ const_iterator last) {
+ for (; first != last; ++first) insert(position, *first);
+}
+
+template <class T, class Alloc>
+INLINE_LOOP void vcl_list<T, Alloc>::insert(iterator position, size_type n, const T& x) {
+ while (n--) insert(position, x);
+}
+
+template <class T, class Alloc>
+INLINE_LOOP void vcl_list<T, Alloc>::erase(iterator first, iterator last) {
+ while (first != last) erase(first++);
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::resize(size_type new_size, const T& x)
+{
+ if (new_size < size()) {
+ iterator f;
+ if (new_size < size() / 2) {
+ f = begin();
+ vcl_advance(f, new_size);
+ }
+ else {
+ f = end();
+ vcl_advance(f, difference_type(size()) - difference_type(new_size));
+ }
+ erase(f, end());
+ }
+ else
+ insert(end(), new_size - size(), x);
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::clear()
+{
+ super::clear();
+ node->next = node;
+ node->prev = node;
+ length = 0;
+}
+
+template <class T, class Alloc>
+#ifdef __SUNPRO_CC
+inline
+#endif
+vcl_list<T, Alloc>& vcl_list<T, Alloc>::operator=(const vcl_list<T, Alloc>& x) {
+ if (this != &x) {
+ iterator first1 = begin();
+ iterator last1 = end();
+ const_iterator first2 = x.begin();
+ const_iterator last2 = x.end();
+ while (first1 != last1 && first2 != last2) *first1++ = *first2++;
+ if (first2 == last2)
+ erase(first1, last1);
+ else
+ insert(last1, first2, last2);
+ __stl_debug_do(invalidate_all());
+ }
+ return *this;
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::remove(const T& value) {
+ iterator first = begin();
+ iterator last = end();
+ while (first != last) {
+ iterator next = first;
+ ++next;
+ if (*first == value) erase(first);
+ first = next;
+ }
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::unique() {
+ iterator first = begin();
+ iterator last = end();
+ if (first == last) return;
+ iterator next = first;
+ while (++next != last) {
+ if (*first == *next)
+ erase(next);
+ else
+ first = next;
+ next = first;
+ }
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::merge(vcl_list<T, Alloc>& x) {
+ iterator first1 = begin();
+ iterator last1 = end();
+ iterator first2 = x.begin();
+ iterator last2 = x.end();
+ while (first1 != last1 && first2 != last2)
+ if (*first2 < *first1) {
+ iterator next = first2;
+ transfer(first1, first2, ++next);
+ first2 = next;
+ } else
+ ++first1;
+ if (first2 != last2) transfer(last1, first2, last2);
+ length += x.length;
+ x.length= 0;
+ __stl_debug_do(x.invalidate_all());
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::reverse() {
+ if (size() < 2) return;
+ iterator first(begin());
+ for (++first; first != end();) {
+ iterator old = first++;
+ transfer(begin(), old, first);
+ }
+ __stl_debug_do(invalidate_all());
+}
+
+template <class T, class Alloc>
+void vcl_list<T, Alloc>::sort() {
+ if (size() < 2) return;
+ vcl_list<T, Alloc> carry;
+ vcl_list<T, Alloc> counter[64];
+ int fill = 0;
+ while (!empty()) {
+ carry.splice(carry.begin(), *this, begin());
+ int i = 0;
+ while (i < fill && !counter[i].empty()) {
+ counter[i].merge(carry);
+ carry.swap(counter[i++]);
+ }
+ carry.swap(counter[i]);
+ if (i == fill) ++fill;
+ }
+
+ for (int i = 1; i < fill; ++i) counter[i].merge(counter[i-1]);
+ swap(counter[fill-1]);
+ __stl_debug_do(invalidate_all());
+}
+
+# if defined ( __STL_NESTED_TYPE_PARAM_BUG )
+# undef iterator
+# undef const_iterator
+# undef size_type
+# endif
+
+// do a cleanup
+# undef vcl_list
+# define __list__ __FULL_NAME(vcl_list)
+__END_STL_FULL_NAMESPACE
+
+#if !defined ( __STL_DEFAULT_TYPE_PARAM )
+// provide a "default" vcl_list adaptor
+template <class T>
+class vcl_list : public __list__<T,vcl_alloc>
+{
+ typedef vcl_list<T> self;
+public:
+ typedef __list__<T,vcl_alloc> super;
+ __CONTAINER_SUPER_TYPEDEFS
+ __IMPORT_SUPER_COPY_ASSIGNMENT(vcl_list)
+ typedef super::link_type link_type;
+ vcl_list() { }
+ explicit vcl_list(size_type n, const T& value) : super(n, value) { }
+ explicit vcl_list(size_type n) : super(n) { }
+ vcl_list(const T* first, const T* last) : super(first, last) { }
+ vcl_list(const_iterator first, const_iterator last) : super(first, last) { }
+};
+
+# if defined (__STL_BASE_MATCH_BUG)
+template <class T>
+inline bool operator==(const vcl_list<T>& x, const vcl_list<T>& y) {
+ typedef typename vcl_list<T>::super super;
+ return operator == ((const super&)x,(const super&)y);
+}
+
+template <class T>
+inline bool operator<(const vcl_list<T>& x, const vcl_list<T>& y) {
+ typedef typename vcl_list<T>::super super;
+ return operator < ((const super&)x,(const super&)y);
+}
+# endif
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+template <class T, class Alloc>
+inline bool operator==(const __list__<T, Alloc>& x, const __list__<T, Alloc>& y) {
+ return x.size() == y.size() && vcl_equal(x.begin(), x.end(), y.begin());
+}
+
+template <class T, class Alloc>
+inline bool operator<(const __list__<T, Alloc>& x, const __list__<T, Alloc>& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class T, class Alloc>
+inline void vcl_swap(__list__<T,Alloc>& a, __list__<T,Alloc>& b) { a.swap(b); }
+# endif
+
+#endif // vcl_emulation_list_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.txx
new file mode 100644
index 0000000000000000000000000000000000000000..78008c34f1d0bce4d95666e2f35e60b7a1b78a4a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_list.txx
@@ -0,0 +1,32 @@
+#ifndef vcl_emulation_list_txx_
+#define vcl_emulation_list_txx_
+
+#include "vcl_list.h"
+#include "vcl_algorithm.txx"
+#include "vcl_iterator.txx"
+
+#if !defined ( __STL_DEFAULT_TYPE_PARAM )
+#define __LIST_INSTANTIATE(T) \
+ template class __list__<T,vcl_alloc >;\
+ template class vcl_list<T >
+#else
+#define __LIST_INSTANTIATE(T) \
+ template class vcl_list<T , vcl_alloc >
+#endif
+
+#undef VCL_LIST_INSTANTIATE
+#define VCL_LIST_INSTANTIATE(T) \
+template struct __list_node<T >;\
+template struct __list_iterator<T >;\
+template struct __list_const_iterator<T >;\
+__LIST_INSTANTIATE(T);\
+template class __list_base<T , vcl_alloc >;\
+template class vcl_reverse_bidirectional_iterator<__list_iterator<T >, T , T &, vcl_ptrdiff_t>;\
+template class vcl_reverse_bidirectional_iterator<__list_const_iterator<T >, T , T const &, vcl_ptrdiff_t>;\
+VCL_SWAP_INSTANTIATE(__list_node<T >*);\
+VCL_ITER_BD_INSTANTIATE(__list_iterator<T >);\
+VCL_ITER_BD_Distance_INSTANTIATE(__list_iterator<T >, vcl_size_t);\
+VCL_ITER_BD_INSTANTIATE(__list_const_iterator<T >);\
+template class vcl_simple_alloc<__list_node<T >, vcl_alloc >
+
+#endif // vcl_emulation_list_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.h
new file mode 100644
index 0000000000000000000000000000000000000000..f5784f98f9d4045bc274f9c56a4316a927c58b17
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.h
@@ -0,0 +1,208 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_map_h
+#define vcl_emulation_map_h
+
+#include "vcl_tree.h"
+
+__BEGIN_STL_FULL_NAMESPACE
+#define vcl_map __WORKAROUND_RENAME(vcl_map)
+
+template <class Key, class T, VCL_DFL_TMPL_PARAM_STLDECL(Compare,vcl_less<Key>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_map
+{
+ typedef vcl_map<Key, T, Compare, Alloc> self;
+ public:
+ typedef Key key_type;
+ typedef T data_type;
+ typedef vcl_pair<const Key, T> value_type;
+ typedef Compare key_compare;
+
+ class value_compare : public vcl_binary_function<value_type, value_type, bool>
+ {
+ friend class vcl_map<Key, T, Compare, Alloc>;
+ protected :
+ Compare comp;
+ value_compare(Compare c) : comp(c) {}
+ public:
+ bool operator()(const value_type& x, const value_type& y) const { return comp(x.first, y.first); }
+ };
+
+ private:
+ typedef rb_tree<key_type, value_type,
+ vcl_select1st<value_type>, key_compare, Alloc> rep_type;
+ public:
+ typedef typename rep_type::reference reference;
+ typedef typename rep_type::const_reference const_reference;
+ typedef typename rep_type::iterator iterator;
+ typedef typename rep_type::const_iterator const_iterator;
+ typedef typename rep_type::reverse_iterator reverse_iterator;
+ typedef typename rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef typename rep_type::size_type size_type;
+ typedef typename rep_type::difference_type difference_type;
+
+ private:
+ rep_type t; // red-black vcl_tree representing vcl_map
+
+ // allocation/deallocation
+ public:
+ vcl_map() : t(Compare()) {}
+ explicit vcl_map(const Compare& comp) : t(comp) {}
+ vcl_map(const value_type* first, const value_type* last) :
+ t(Compare()) { t.insert_unique(first, last); }
+ vcl_map(const value_type* first, const value_type* last,
+ const Compare& comp) : t(comp) { t.insert_unique(first, last); }
+ vcl_map(const_iterator first, const_iterator last) :
+ t(Compare()) { t.insert_unique(first, last); }
+ vcl_map(const_iterator first, const_iterator last,
+ const Compare& comp) : t(comp) { t.insert_unique(first, last); }
+ vcl_map(const vcl_map<Key, T, Compare, Alloc>& x) : t(x.t) {}
+ vcl_map<Key, T, Compare, Alloc>& operator=(const vcl_map<Key, T, Compare, Alloc>& x)
+ {
+ t = x.t;
+ return *this;
+ }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return value_compare(t.key_comp()); }
+ iterator begin() { return t.begin(); }
+ const_iterator begin() const { return t.begin(); }
+ iterator end() { return t.end(); }
+ const_iterator end() const { return t.end(); }
+ reverse_iterator rbegin() { return t.rbegin(); }
+ const_reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() { return t.rend(); }
+ const_reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ T& operator[](const key_type& k) { return (*((insert(value_type(k, T()))).first)).second; }
+ void swap(vcl_map<Key, T, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+
+ // <awf>
+ typedef vcl_pair<iterator,bool> pair_iterator_bool;
+ // </awf>
+
+ vcl_pair<iterator,bool> insert(const value_type& x) { return t.insert_unique(x); }
+ iterator insert(iterator position, const value_type& x) { return t.insert_unique(position, x); }
+ void insert(const value_type* first, const value_type* last) { t.insert_unique(first, last); }
+ void insert(const_iterator first, const_iterator last) { t.insert_unique(first, last); }
+ void erase(iterator position) { t.erase(position); }
+ size_type erase(const key_type& x) { return t.erase(x); }
+ void erase(iterator first, iterator last) { t.erase(first, last); }
+ void clear() { t.clear(); }
+
+ // vcl_map operations:
+
+ iterator find(const key_type& x) { return t.find(x); }
+ const_iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) {return t.lower_bound(x); }
+ const_iterator lower_bound(const key_type& x) const { return t.lower_bound(x); }
+ iterator upper_bound(const key_type& x) {return t.upper_bound(x); }
+ const_iterator upper_bound(const key_type& x) const { return t.upper_bound(x); }
+
+ vcl_pair<iterator,iterator> equal_range(const key_type& x) { return t.equal_range(x); }
+ vcl_pair<const_iterator,const_iterator> equal_range(const key_type& x) const { return t.equal_range(x); }
+ bool operator==(const self& y) const { return t == y.t; }
+ bool operator< (const self& y) const { return t < y.t; }
+ // debug
+ bool __rb_verify() const { return t.__rb_verify(); }
+};
+__END_STL_FULL_NAMESPACE
+
+// do a cleanup
+# undef vcl_map
+# define __map__ __FULL_NAME(vcl_map)
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class Key, class T, class Compare, class Alloc>
+inline void vcl_swap(__map__<Key, T, Compare, Alloc>& a,
+ __map__<Key, T, Compare, Alloc>& b) { a.swap(b); }
+# endif
+
+// provide a way to access full functionality
+# ifndef __STL_DEFAULT_TYPE_PARAM
+// provide a "default" vcl_map adaptor
+template <class Key, class T, class Compare>
+class vcl_map : public __map__<Key, T, Compare, vcl_alloc>
+{
+ typedef vcl_map<Key, T, Compare> self;
+ public:
+ typedef __map__<Key, T, Compare, vcl_alloc> super;
+ __CONTAINER_SUPER_TYPEDEFS
+ __IMPORT_SUPER_COPY_ASSIGNMENT(vcl_map)
+ vcl_map() : super(Compare()) {}
+ explicit vcl_map(const Compare& comp) : super(comp) {}
+ vcl_map(const typename super::value_type* first, const typename super::value_type* last) :
+ super(first, last, Compare()) { }
+ vcl_map(const typename super::value_type* first, const typename super::value_type* last,
+ const Compare& comp) : super(first, last, comp) { }
+ vcl_map(typename super::const_iterator first, typename super::const_iterator last) :
+ super(first, last, Compare()) { }
+ vcl_map(typename super::const_iterator first, typename super::const_iterator last,
+ const Compare& comp) : super(first, last, comp) { }
+};
+
+# if defined (__STL_BASE_MATCH_BUG)
+template <class Key, class T, class Compare>
+inline bool operator==(const vcl_map<Key, T, Compare>& x,
+ const vcl_map<Key, T, Compare>& y)
+{
+ typedef typename vcl_map<Key, T, Compare>::super super;
+ return operator==((const super&)x,(const super&)y);
+}
+
+template <class Key, class T, class Compare>
+inline bool operator<(const vcl_map<Key, T, Compare>& x,
+ const vcl_map<Key, T, Compare>& y)
+{
+ typedef typename vcl_map<Key, T, Compare>::super super;
+ return operator < ((const super&)x,(const super&)y);
+}
+# endif
+
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+#endif // vcl_emulation_map_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.txx
new file mode 100644
index 0000000000000000000000000000000000000000..e1171775b0a5d333a6cc9843be839eb28063f45a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_map.txx
@@ -0,0 +1,39 @@
+#ifndef vcl_emulation_map_txx_
+#define vcl_emulation_map_txx_
+
+#include "vcl_map.h"
+#include "vcl_multimap.h"
+
+#include "vcl_rbtree.txx"
+
+// --- vcl_map ---
+
+// * You can't call VCL_MAP_INSTANTIATE twice from within the same macro
+// as the __LINE__ will be the same.
+
+#undef VCL_MAP_INSTANTIATE
+#define VCL_MAP_INSTANTIATE(T, Key, Comp) \
+template class vcl_map<T, Key, Comp VCL_DFL_TMPL_ARG(vcl_alloc) >;\
+/*fsm: the multimap should be instantiated with VCL_MULTIMAP_INSTANTIATE */ \
+/*template class vcl_multimap<T,Key,Comp VCL_DFL_TMPL_ARG(vcl_alloc) >;*/ \
+VCL_RBTREE_MAP_PAIR_INSTANTIATE(T, Key, __LINE__)
+
+// This "identity" passthru gets __LINE__ expanded
+#define VCL_RBTREE_MAP_PAIR_INSTANTIATE(T, Key, TAG) VCL_RBTREE_MAP_PAIRx_INSTANTIATE(T, Key, TAG)
+
+#define VCL_RBTREE_MAP_PAIRx_INSTANTIATE(T, Key, TAG) \
+typedef vcl_pair<T const, Key > RBPairc ## TAG;\
+VCL_PAIR_const_INSTANTIATE(T const, Key);\
+VCL_RBTREE_PAIR_INSTANTIATE(T, RBPairc ## TAG)
+
+#define VCL_RBTREE_PAIR_INSTANTIATE(T, RBPair) \
+VCL_RBTREE_INSTANTIATE(T,RBPair,vcl_select1st<RBPair >,vcl_less<T >);\
+VCL_RBTREE_VALUE_INSTANTIATE(RBPair)
+
+// -------------------- multimap
+
+#undef VCL_MULTIMAP_INSTANTIATE
+#define VCL_MULTIMAP_INSTANTIATE(T, Key, Comp) \
+template class vcl_multimap<T, Key, Comp >
+
+#endif // vcl_emulation_map_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.h
new file mode 100644
index 0000000000000000000000000000000000000000..b21b2774f6852632a8ea718582f1a9e6ccb8501b
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.h
@@ -0,0 +1,197 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_multimap_h
+#define vcl_emulation_multimap_h
+
+#include "vcl_tree.h"
+
+__BEGIN_STL_FULL_NAMESPACE
+#define vcl_multimap __WORKAROUND_RENAME(vcl_multimap)
+
+template <class Key, class T, VCL_DFL_TMPL_PARAM_STLDECL(Compare,vcl_less<Key>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_multimap
+{
+ typedef vcl_multimap<Key, T, Compare, Alloc> self;
+ public:
+ typedef Key key_type;
+ typedef T data_type;
+ typedef vcl_pair<const Key, T> value_type;
+ typedef Compare key_compare;
+
+ class value_compare : public vcl_binary_function<value_type, value_type, bool>
+ {
+ friend class vcl_multimap<Key, T, Compare, Alloc>;
+ protected:
+ Compare comp;
+ value_compare(Compare c) : comp(c) {}
+ public:
+ bool operator()(const value_type& x, const value_type& y) const { return comp(x.first, y.first); }
+ };
+
+ private:
+ typedef rb_tree<key_type, value_type,
+ vcl_select1st<value_type>, key_compare, Alloc> rep_type;
+ public:
+ typedef typename rep_type::pointer pointer;
+ typedef typename rep_type::reference reference;
+ typedef typename rep_type::const_reference const_reference;
+ typedef typename rep_type::iterator iterator;
+ typedef typename rep_type::const_iterator const_iterator;
+ typedef typename rep_type::reverse_iterator reverse_iterator;
+ typedef typename rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef typename rep_type::size_type size_type;
+ typedef typename rep_type::difference_type difference_type;
+
+ private:
+ rep_type t; // red-black vcl_tree representing vcl_multimap
+
+ public:
+ // allocation/deallocation
+ vcl_multimap() : t(Compare()) {}
+ explicit vcl_multimap(const Compare& comp) : t(comp) {}
+ vcl_multimap(const value_type* first, const value_type* last) :
+ t(Compare()) { t.insert_equal(first, last); }
+ vcl_multimap(const value_type* first, const value_type* last,
+ const Compare& comp) : t(comp) { t.insert_equal(first, last); }
+ vcl_multimap(const_iterator first, const_iterator last) :
+ t(Compare()) { t.insert_equal(first, last); }
+ vcl_multimap(const_iterator first, const_iterator last,
+ const Compare& comp) : t(comp) { t.insert_equal(first, last); }
+ vcl_multimap(const self& x) : t(x.t) { }
+ self& operator=(const self& x) { t = x.t; return *this; }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return value_compare(t.key_comp()); }
+ iterator begin() { return t.begin(); }
+ const_iterator begin() const { return t.begin(); }
+ iterator end() { return t.end(); }
+ const_iterator end() const { return t.end(); }
+ reverse_iterator rbegin() { return t.rbegin(); }
+ const_reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() { return t.rend(); }
+ const_reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ void swap(vcl_multimap<Key, T, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+
+ iterator insert(const value_type& x) { return t.insert_equal(x); }
+ iterator insert(iterator position, const value_type& x) { return t.insert_equal(position, x); }
+ void insert(const value_type* first, const value_type* last) { t.insert_equal(first, last); }
+ void insert(const_iterator first, const_iterator last) { t.insert_equal(first, last); }
+ void erase(iterator position) { t.erase(position); }
+ size_type erase(const key_type& x) { return t.erase(x); }
+ void erase(iterator first, iterator last) { t.erase(first, last); }
+ void clear() { t.clear(); }
+
+ // vcl_multimap operations:
+
+ iterator find(const key_type& x) { return t.find(x); }
+ const_iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) {return t.lower_bound(x); }
+ const_iterator lower_bound(const key_type& x) const { return t.lower_bound(x); }
+ iterator upper_bound(const key_type& x) {return t.upper_bound(x); }
+ const_iterator upper_bound(const key_type& x) const { return t.upper_bound(x); }
+ vcl_pair<iterator,iterator> equal_range(const key_type& x) { return t.equal_range(x); }
+ vcl_pair<const_iterator,const_iterator> equal_range(const key_type& x) const { return t.equal_range(x); }
+ bool operator==(const self& y) const { return t == y.t; }
+ bool operator< (const self& y) const { return t < y.t; }
+};
+__END_STL_FULL_NAMESPACE
+
+// do a cleanup
+# undef vcl_multimap
+// provide a way to access full functionality
+# define __multimap__ __FULL_NAME(vcl_multimap)
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class Key, class T, class Compare, class Alloc>
+inline void swap(__multimap__<Key, T, Compare, Alloc>& a,
+ __multimap__<Key, T, Compare, Alloc>& b) { a.swap(b); }
+# endif
+
+# if !defined(MULTIMAP_H) && !defined(__STL_DEFAULT_TYPE_PARAM) && ( !defined(__STL_NAMESPACES) || defined(__STL_NO_NAMESPACES) )
+// provide a "default" vcl_multimap adaptor
+template <class Key, class T, class Compare>
+class vcl_multimap : public __multimap__<Key, T, Compare, vcl_alloc>
+{
+ typedef vcl_multimap<Key, T, Compare> self;
+ public:
+ typedef __multimap__<Key, T, Compare, vcl_alloc> super;
+ __CONTAINER_SUPER_TYPEDEFS
+ // copy & assignment from super
+ __IMPORT_SUPER_COPY_ASSIGNMENT(vcl_multimap)
+ vcl_multimap() : super(Compare()) {}
+ explicit vcl_multimap(const Compare& comp) : super(comp) {}
+ vcl_multimap(const typename super::value_type* first, const typename super::value_type* last) :
+ super(first, last, Compare()) { }
+ vcl_multimap(const typename super::value_type* first, const typename super::value_type* last,
+ const Compare& comp) : super(first, last, comp) { }
+ vcl_multimap(typename super::const_iterator first, typename super::const_iterator last) :
+ super(first, last, Compare()) { }
+ vcl_multimap(typename super::const_iterator first, typename super::const_iterator last,
+ const Compare& comp) : super(first, last, comp) { }
+};
+
+# if defined (__STL_BASE_MATCH_BUG)
+template <class Key, class T, class Compare>
+inline bool operator==(const vcl_multimap<Key, T, Compare>& x,
+ const vcl_multimap<Key, T, Compare>& y)
+{
+ typedef __multimap__<Key,T,Compare,vcl_alloc> super;
+ return (const super&)x == (const super&)y;
+}
+
+template <class Key, class T, class Compare>
+inline bool operator<(const vcl_multimap<Key, T, Compare>& x,
+ const vcl_multimap<Key, T, Compare>& y)
+{
+ typedef __multimap__<Key,T,Compare,vcl_alloc> super;
+ return (const super&)x < (const super&)y;
+}
+# endif
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+#endif // vcl_emulation_multimap_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.txx
new file mode 100644
index 0000000000000000000000000000000000000000..386464d23603b9cba5be30c06effa5bb7e894ee1
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multimap.txx
@@ -0,0 +1,10 @@
+#ifndef vcl_emulation_multimap_txx_
+#define vcl_emulation_multimap_txx_
+
+#include "vcl_multimap.h"
+
+#undef VCL_MULTIMAP_INSTANTIATE
+#define VCL_MULTIMAP_INSTANTIATE(T, Key, Comp) \
+template class vcl_multimap<T, Key, Comp >
+
+#endif // vcl_emulation_multimap_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multiset.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multiset.h
new file mode 100644
index 0000000000000000000000000000000000000000..423be736ede43053fec69fbc37bb21c03b37442a
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_multiset.h
@@ -0,0 +1,186 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_multiset_h
+#define vcl_emulation_multiset_h
+
+#include "vcl_tree.h"
+
+__BEGIN_STL_FULL_NAMESPACE
+#define vcl_multiset __WORKAROUND_RENAME(vcl_multiset)
+
+template <class Key, VCL_DFL_TMPL_PARAM_STLDECL(Compare,vcl_less<Key>),
+ VCL_DFL_TYPE_PARAM_STLDECL(Alloc,vcl_alloc) >
+class vcl_multiset
+{
+ typedef vcl_multiset<Key,Compare,Alloc> self;
+ public:
+ typedef Key key_type;
+ typedef Key value_type;
+ typedef Compare key_compare;
+ typedef Compare value_compare;
+ typedef rb_tree<key_type, value_type,
+ vcl_identity<value_type>,
+ key_compare, Alloc> rep_type;
+ typedef typename rep_type::const_pointer pointer;
+ typedef typename rep_type::const_reference reference;
+ typedef typename rep_type::const_reference const_reference;
+ typedef typename rep_type::const_iterator const_iterator;
+ // SunPro bug
+# ifdef __SUNPRO_CC
+ typedef const_iterator iterator;
+# else
+ typedef typename rep_type::const_iterator iterator;
+# endif
+ typedef typename rep_type::const_reverse_iterator reverse_iterator;
+ typedef typename rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef typename rep_type::size_type size_type;
+ typedef typename rep_type::difference_type difference_type;
+
+ private:
+ rep_type t; // red-black vcl_tree representing vcl_multiset
+
+ // allocation/deallocation
+ public:
+ vcl_multiset() : t(Compare()) {}
+ explicit vcl_multiset(const Compare& comp) : t(comp) {}
+ vcl_multiset(const value_type* first, const value_type* last) :
+ t(Compare()) { t.insert_equal(first, last); }
+ vcl_multiset(const value_type* first, const value_type* last,
+ const Compare& comp) : t(comp) { t.insert_equal(first, last); }
+ vcl_multiset(const_iterator first, const_iterator last ) :
+ t(Compare()) { t.insert_equal(first, last); }
+ vcl_multiset(const_iterator first, const_iterator last,
+ const Compare& comp) : t(comp) { t.insert_equal(first, last); }
+ vcl_multiset(const self& x) : t(x.t) {}
+ self& operator=(const self& x) { t = x.t; return *this; }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return t.key_comp(); }
+ iterator begin() const { return t.begin(); }
+ iterator end() const { return t.end(); }
+ reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ void swap(self& x) { t.swap(x.t); }
+
+ // insert/erase
+ iterator insert(const value_type& x) { return t.insert_equal(x); }
+ iterator insert(iterator position, const value_type& x) { return t.insert_equal((typename rep_type::iterator&)position, x); }
+ void insert(const value_type* first, const value_type* last) { t.insert_equal(first, last); }
+ void insert(const_iterator first, const_iterator last) { t.insert_equal(first, last); }
+ void erase(iterator position) { t.erase((typename rep_type::iterator&)position); }
+ size_type erase(const key_type& x) { return t.erase(x); }
+ void erase(iterator first, iterator last)
+ {
+ t.erase((typename rep_type::iterator&)first,
+ (typename rep_type::iterator&)last);
+ }
+ void clear() { t.clear(); }
+
+ // vcl_multiset operations:
+
+ iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) const { return t.lower_bound(x); }
+ iterator upper_bound(const key_type& x) const { return t.upper_bound(x); }
+ vcl_pair<iterator,iterator> equal_range(const key_type& x) const { return t.equal_range(x); }
+ bool operator==(const self& y) const { return t == y.t; }
+ bool operator< (const self& y) const { return t < y.t; }
+};
+__END_STL_FULL_NAMESPACE
+
+// do a cleanup
+# undef vcl_multiset
+// provide a way to access full functionality
+# define __multiset__ __FULL_NAME(vcl_multiset)
+
+# if defined (__STL_CLASS_PARTIAL_SPECIALIZATION )
+template <class Key, class Compare, class Alloc>
+inline void swap(__multiset__<Key, Compare, Alloc>& a,
+ __multiset__<Key, Compare, Alloc>& b) { a.swap(b); }
+# endif
+
+# ifndef __STL_DEFAULT_TYPE_PARAM
+// provide a "default" vcl_multiset adaptor
+template <class Key, class Compare>
+class vcl_multiset : public __multiset__<Key, Compare, vcl_alloc>
+{
+ typedef vcl_multiset<Key,Compare> self;
+ public:
+ typedef __multiset__<Key, Compare, vcl_alloc> super;
+ __CONTAINER_SUPER_TYPEDEFS
+ // copy & assignment from super
+ __IMPORT_SUPER_COPY_ASSIGNMENT(vcl_multiset)
+ explicit vcl_multiset() : super(Compare()) {}
+ explicit vcl_multiset(const Compare& comp) : super(comp) {}
+ vcl_multiset(const value_type* first, const value_type* last) :
+ super(first, last, Compare()) { }
+ vcl_multiset(const value_type* first, const value_type* last,
+ const Compare& comp) : super(first, last, comp) { }
+ vcl_multiset(const_iterator first, const_iterator last) :
+ super(first, last, Compare()) { }
+ vcl_multiset(const_iterator first, const_iterator last,
+ const Compare& comp) : super(first, last, comp) { }
+};
+
+# if defined (__STL_BASE_MATCH_BUG)
+template <class Key, class Compare>
+inline bool operator==(const vcl_multiset<Key, Compare>& x,
+ const vcl_multiset<Key, Compare>& y)
+{
+ typedef __multiset__<Key,Compare,vcl_alloc> super;
+ return (const super&)x == (const super&)y;
+}
+
+template <class Key, class Compare>
+inline bool operator<(const vcl_multiset<Key, Compare>& x,
+ const vcl_multiset<Key, Compare>& y)
+{
+ typedef __multiset__<Key,Compare,vcl_alloc> super;
+ return (const super&)x < (const super&)y;
+}
+# endif
+
+# endif /* __STL_DEFAULT_TYPE_PARAM */
+
+#endif // vcl_emulation_multiset_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_new.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_new.h
new file mode 100644
index 0000000000000000000000000000000000000000..46a23cf2e8a9c5024a6600e8c40412599ffda8a0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_new.h
@@ -0,0 +1,14 @@
+#ifndef vcl_emulation_new_h_
+#define vcl_emulation_new_h_
+/*
+ fsm
+*/
+
+#include <vcl_compiler.h>
+
+#include <new.h>
+
+// for vcl_destroy() and vcl_construct() :
+#include "vcl_algobase.h"
+
+#endif // vcl_emulation_new_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_pair.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_pair.h
new file mode 100644
index 0000000000000000000000000000000000000000..99123a9844835febf61d9db5b1f2270b74a4b8df
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_pair.h
@@ -0,0 +1,78 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_pair_h
+#define vcl_emulation_pair_h
+
+#include "vcl_bool.h"
+
+#undef struct
+template <class T1, class T2>
+class vcl_pair {
+ public:
+ typedef T1 first_type;
+ typedef T2 second_type;
+
+ T1 first;
+ T2 second;
+# if defined ( __STL_CONST_CONSTRUCTOR_BUG )
+ vcl_pair() : first(T1()), second(T2()) {}
+# else
+ vcl_pair() {}
+# endif
+ vcl_pair(const T1& a, const T2& b) : first(a), second(b) {}
+ // some compilers need that
+ vcl_pair(const vcl_pair<T1,T2>& o) : first(o.first), second(o.second) {}
+};
+
+template <class T1, class T2>
+inline bool operator==(const vcl_pair<T1, T2>& x, const vcl_pair<T1, T2>& y) {
+ return x.first == y.first && x.second == y.second;
+}
+
+template <class T1, class T2>
+inline bool operator<(const vcl_pair<T1, T2>& x, const vcl_pair<T1, T2>& y) {
+ return (x.first < y.first) || (!(y.first < x.first) && x.second < y.second);
+}
+
+template <class T1, class T2>
+inline vcl_pair<T1, T2> make_pair(const T1& x, const T2& y) {
+ return vcl_pair<T1, T2>(x, y);
+}
+
+#endif // vcl_emulation_pair_h
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree.txx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree.txx
new file mode 100644
index 0000000000000000000000000000000000000000..d1e6a38c205397c762ce7278358b265f142a7f2f
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree.txx
@@ -0,0 +1,83 @@
+#ifndef vcl_emulation_rbtree_txx_
+#define vcl_emulation_rbtree_txx_
+
+#include "vcl_algorithm.txx"
+#include "vcl_iterator.txx"
+#include "vcl_utility.txx"
+
+//-*- c++ -*-
+// --- Feature testing ---
+#ifdef __STL_LOOP_INLINE_PROBLEMS
+#define VCL_INSTANTIATE_INLINE_LOOP(f) template f
+#else
+#define VCL_INSTANTIATE_INLINE_LOOP(f) VCL_INSTANTIATE_INLINE(f)
+#endif
+
+// --- Unary templates ---
+// Templates with one type mentioned, no requirements on type
+
+#define VCL_OPERATOR_NE_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(bool operator!=(T const&, T const &))
+
+#undef VCL_COMPARISONS_INSTANTIATE
+#define VCL_COMPARISONS_INSTANTIATE(T) \
+VCL_OPERATOR_NE_INSTANTIATE(T) \
+VCL_INSTANTIATE_INLINE(bool operator > (T const &, T const &)); \
+VCL_INSTANTIATE_INLINE(bool operator <= (T const &, T const &)); \
+VCL_INSTANTIATE_INLINE(bool operator >= (T const &, T const &))
+
+// --- Iterators ---
+
+#define VCL_TAGS_INSTANTIATE(I, TAG) \
+VCL_INSTANTIATE_INLINE(TAG iterator_category(I const &))
+
+#define VCL_ITER_FWD_INSTANTIATE(ForwardIterator) \
+VCL_OPERATOR_NE_INSTANTIATE(ForwardIterator)\
+VCL_TAGS_INSTANTIATE(ForwardIterator, vcl_forward_iterator_tag)
+
+#if 0
+#define VCL_ITER_BD_Distance_INSTANTIATE(BidirectionalIterator, Distance) \
+VCL_INSTANTIATE_INLINE(void vcl_advance(BidirectionalIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(BidirectionalIterator&,Distance,vcl_bidirectional_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void vcl_distance(BidirectionalIterator,BidirectionalIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(BidirectionalIterator,BidirectionalIterator const&,Distance&,vcl_bidirectional_iterator_tag))
+
+#define VCL_ITER_RA_Distance_INSTANTIATE(RandomAccessIterator, Distance) \
+VCL_INSTANTIATE_INLINE(void vcl_advance(RandomAccessIterator&,Distance));\
+VCL_INSTANTIATE_INLINE(void __advance(RandomAccessIterator&,Distance,vcl_random_access_iterator_tag));\
+VCL_INSTANTIATE_INLINE(void vcl_distance(RandomAccessIterator,RandomAccessIterator,Distance&));\
+VCL_INSTANTIATE_INLINE(void __distance(RandomAccessIterator const&,RandomAccessIterator const&,\
+ Distance&,vcl_random_access_iterator_tag))
+#endif
+
+// --- Vcl_List ---
+
+#define STLINST_uninitialized_copy(I, F) \
+VCL_INSTANTIATE_INLINE_LOOP(F uninitialized_copy(I, I, F))
+
+
+/////////////////////////////////////////////////////////////////////////////
+
+
+// --- RB TREE ---
+#define VCL_RBTREE_INSTANTIATE(Key, Value, GetKey, Compare) \
+template class rb_tree<Key, Value, GetKey, Compare, vcl_alloc >
+
+#define VCL_RBTREE_VALUE_INSTANTIATE(Value) \
+template class __rb_tree_base<Value, vcl_alloc >;\
+template struct __rb_tree_iterator<Value >;\
+template struct __rb_tree_const_iterator<Value >;\
+template class vcl_simple_alloc<__rb_tree_node<Value >, vcl_alloc >;\
+VCL_ITER_BD_Distance_INSTANTIATE(__rb_tree_iterator<Value >, vcl_size_t);\
+VCL_ITER_BD_Distance_INSTANTIATE(__rb_tree_const_iterator<Value >, vcl_size_t);\
+VCL_OPERATOR_NE_INSTANTIATE(__rb_tree_const_iterator<Value >) \
+VCL_OPERATOR_NE_INSTANTIATE(__rb_tree_iterator<Value >) \
+VCL_PAIR_INSTANTIATE(__rb_tree_iterator<Value >, __rb_tree_iterator<Value > ); \
+VCL_PAIR_INSTANTIATE(__rb_tree_const_iterator<Value >, __rb_tree_const_iterator<Value > ); \
+VCL_PAIR_INSTANTIATE(__rb_tree_const_iterator<Value >, bool ); \
+VCL_PAIR_INSTANTIATE(__rb_tree_iterator<Value >, bool ); \
+template class vcl_reverse_bidirectional_iterator<__rb_tree_const_iterator<Value >, Value, Value const &, vcl_ptrdiff_t>;\
+template class vcl_reverse_bidirectional_iterator<__rb_tree_iterator<Value >, Value, Value &, vcl_ptrdiff_t>;\
+VCL_SWAP_INSTANTIATE(__rb_tree_node<Value > *)
+
+#endif // vcl_emulation_rbtree_txx_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree_instances.cxx b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree_instances.cxx
new file mode 100644
index 0000000000000000000000000000000000000000..40fdf58cd68228f22d11f4dfc29e38093211d587
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rbtree_instances.cxx
@@ -0,0 +1,5 @@
+// This is vcl/emulation/vcl_rbtree_instances.cxx
+#include <vcl_compiler.h>
+#if !VCL_USE_NATIVE_STL
+#include "vcl_tree.h"
+#endif
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rel_ops.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rel_ops.h
new file mode 100644
index 0000000000000000000000000000000000000000..238306ce775bc11771091a62031448ac52f3b1d3
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_rel_ops.h
@@ -0,0 +1,16 @@
+#ifndef vcl_emulation_rel_ops_h_
+#define vcl_emulation_rel_ops_h_
+
+template <class T>
+inline bool operator!=(const T& x, const T& y) { return !(x == y); }
+
+template <class T>
+inline bool operator> (const T& x, const T& y) { return (y < x); }
+
+template <class T>
+inline bool operator<=(const T& x, const T& y) { return !(y < x); }
+
+template <class T>
+inline bool operator>=(const T& x, const T& y) { return !(x < y); }
+
+#endif // vcl_emulation_rel_ops_h_
diff --git a/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_set.h b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_set.h
new file mode 100644
index 0000000000000000000000000000000000000000..2fe400157bfd4f797b46fb01baaf51ec732157a0
--- /dev/null
+++ b/Utilities/ITK/Utilities/vxl/vcl/emulation/vcl_set.h
@@ -0,0 +1,191 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+/*
+ *
+ * Copyright (c) 1997
+ * Moscow Center for SPARC Technology
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Moscow Center for SPARC Technology makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef vcl_emulation_set_h
+#define vcl_emulation_set_h
+
+#include "vcl_tree.h"
+
+__BEGIN_STL_FULL_NAMESPACE
+#define vcl_set __WORKAROUND_RENAME(vcl_set)
+template <